module Apecs.TH
( makeWorld, makeWorldNoEC
)where
import Language.Haskell.TH
import Apecs.Util (EntityCounter)
genName :: String -> Q Name
genName s = mkName . show <$> newName s
makeWorldNoEC :: String -> [Name] -> Q [Dec]
makeWorldNoEC worldName cTypes = do
cTypesNames <- mapM (\t -> do rec <- genName "rec"; return (ConT t, rec)) cTypes
let wld = mkName worldName
has = mkName "Has"
sys = mkName "System"
wldDecl = DataD [] wld [] Nothing [RecC wld records] []
makeRecord (t,n) = (n, Bang NoSourceUnpackedness SourceStrict, ConT (mkName "Storage") `AppT` t)
records = makeRecord <$> cTypesNames
makeInstance (t,n) =
InstanceD Nothing [] ((ConT has `AppT` ConT wld) `AppT` t)
[ FunD (mkName "getStore") [Clause []
(NormalB$ ConE sys `AppE` (VarE (mkName "asks") `AppE` VarE n))
[] ]
]
initWorldName = mkName $ "init" ++ worldName
initSig = SigD initWorldName (AppT (ConT (mkName "IO")) (ConT wld))
initDecl = FunD initWorldName [Clause []
(NormalB$ iterate (\wE -> AppE (AppE (VarE $ mkName "<*>") wE) (VarE $ mkName "initStore")) (AppE (VarE $ mkName "return") (ConE wld)) !! length records)
[] ]
hasDecl = makeInstance <$> cTypesNames
return $ wldDecl : initSig : initDecl : hasDecl
makeWorld :: String -> [Name] -> Q [Dec]
makeWorld worldName cTypes = makeWorldNoEC worldName (cTypes ++ [''EntityCounter])