Reputation: 464
insertST :: StateDecoder -> SomeState -> Update SomeState SomeThing
insertST stDecoder st = ...
the stuff in StateDecoder can't be used in
$(makeAcidic ''SomeState ['insertST])
but if I declare a state and wrap it like this ...
myDecoder :: StateDecoder
myDecoder = ...
insertSomeState :: SomeState -> Update SomeState SomeThing
insertSomeState st = insertST someDecoder
Then it works
I have a lot of datatypes that follow this pattern so I thought I would write some TH to solve it.
mkWrappedAcid :: Name -> Name -> Q [Dec]
mkWrappedAcid decoder stname = do
insP@(FunD n _) <- insertMaker decoder stname
acidP <- mkAcidic stname [n]
return $[insP] ++ acidP
insertMaker :: Name -> Name -> Q [Dec]
insertMaker decoder stname = (funD istorename) [(clause [] (normalB insertStTH ) [] )
where
istorename = mkName.concat $ ["insert" , (nameBase stname)]
insertStTH = appE (varE 'insertST ) (varE decoder)
Which all works beautifully but when I try and run...
$(mkWrappedAcid 'myDecoder ''SomeState)
I get...
`insertSomeState' is not in scope at a reify
I know it has something to do with the staging problem in template haskell but I don't know how to solve it. It works if I do
$(mkWrappedAcid 'myDecoder ''SomeState)
$(makeAcidic ''SomeState ['insertSomeState])
But that doesn't help!
Upvotes: 4
Views: 145
Reputation: 464
Well I take user2407038 to be correct that it is impossible to do this directly, one workaround that I ended up using is to extract the routines that name the functions from the routines that create them. Then you can build a new template haskell piece that can be called after the creation of the first piece in the same module... My way worked something like this.
mkWrappedAcid :: Name -> Name -> Q [Dec]
mkWrappedAcid decoder stname = do
insP@(FunD n _) <- insertMaker decoder stname
acidP <- mkAcidic stname [n]
return $[insP] ++ acidP
insertMaker :: Name -> Name -> Q [Dec]
insertMaker decoder stname = (funD istorename) [(clause [] (normalB insertStTH ) [] )
where
istorename = mkName.concat $ ["insert" , (nameBase stname)]
insertStTH = appE (varE 'insertST ) (varE decoder)
Becomes ...
mkWrappedAcid :: Name -> Name -> Q [Dec]
mkWrappedAcid decoder stname = do
(Loc _ _ md _ _) <- location
makeAcidic storename (acidPathMaker md storename)
insertMaker :: Name -> Name -> Q [Dec]
insertMaker decoder stname = (funD istorename) [(clause [] (normalB insertStTH ) [])]
where
insertStTH = appE (varE 'insertST ) (varE decoder)
istorename = mkName.concat $ ["insert" , (nameBase stname)]
acidPathMaker md storename = [modulePlusIname]
where
inameString = nameBase (istorename storename)
modulePlusIname = mkName . concat $ [md , ".", inameString]
With this separation you can create the wrapped Acid States like...
$(acidPathMaker 'myDecoder ''SomeState)
$(mkWrappedAcid ''SomeState )
Which is just fine by me.
Upvotes: 1