TallerGhostWalt
TallerGhostWalt

Reputation: 464

Running template haskell in template haskell

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

Answers (1)

TallerGhostWalt
TallerGhostWalt

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

Related Questions