module Air.Data.Record.SimpleLabel.TH (mkLabels, mkLabel) where
import Control.Monad
import Data.Char
import Language.Haskell.TH.Syntax
mkLabels :: [Name] -> Q [Dec]
mkLabels = liftM concat . mapM mkLabel
mkLabel :: Name -> Q [Dec]
mkLabel n = do
i <- reify n
let
cs' = case i of
TyConI (DataD _ _ _ cs _) -> cs
TyConI (NewtypeD _ _ _ c _) -> [c]
_ -> []
ls' = [ l | RecC _ ls <- cs', l <- ls ]
return (map mkLabel1 ls')
mkLabel1 :: VarStrictType -> Dec
mkLabel1 (name, _, _) =
let n = mkName $ "__" ++ nameBase name
in FunD n [Clause [] (NormalB (
AppE (AppE (VarE (mkName "label")) (VarE name))
(LamE [VarP (mkName "b"), VarP (mkName "a")]
(RecUpdE (VarE (mkName "a")) [(name, VarE (mkName "b"))]))
)) []]