TH for making 'labels' named tuples

LabelsTH.hs

{-# LANGUAGE DataKinds, FlexibleInstances, TemplateHaskell, TypeFamilies, TypeOperators #-}

module LabelsTH where

import ClassyPrelude
import Language.Haskell.TH
import Labels ((:=))

typeForFieldname :: String -> Type
typeForFieldname "x" = ConT ''Int
typeForFieldname "y" = ConT ''Bool
typeForFieldname x = error $ x <> " is not a grid field name"

partForFieldname :: String -> Type
partForFieldname fieldName =
  AppT (AppT (ConT ''(:=)) (LitT (StrTyLit fieldName))) (typeForFieldname fieldName)

-- | Given list of field names, produces the type for the Labels named tuple with the named fields and their
-- associated types defined by 'typeForFieldname'.
-- E.g. @labelsQ ["y", "x"]@ produces ("y" := Bool, "x" := Int).
labelsQ :: [String] -> TypeQ
labelsQ fieldNames =
  let parts = partForFieldname <$> fieldNames
      numParts = length parts
  in pure $ foldl' AppT (TupleT numParts) parts