Given a mkStuff function that takes a Name and produces Stuff using typed TH:
{-# LANGUAGE LambdaCase #-}
module Example where
import Language.Haskell.TH (Code, Name, Q)
import qualified Language.Haskell.TH as TH
data Stuff = Stuff
{ tyName :: String
, isSynonym :: Bool
}
mkStuff :: Name -> Code Q Stuff
mkStuff nm = do
let tyName = TH.nameBase nm
TH.liftCode do
TH.reify nm >>= \case
TH.TyConI (TH.TySynD _nmSyn _tyVars _ty) -> do
TH.examineCode [||
Stuff
{ tyName
, isSynonym = True
}
||]
_other -> do
TH.examineCode [||
Stuff
{ tyName
, isSynonym = False
}
||]
How do I create Name values to pass to the typed splice? For example, this attempt:
module Demo where
import Scratch
type Foo = Int
x :: Stuff
x = $$(mkStuff ''Foo)
produces:
error:
• Untyped brackets may only appear in untyped splices.
• In the Template Haskell quotation ''Foo
In the typed splice: $$(mkStuff ''Foo)
|
| x = $$(mkStuff ''Foo)
|
Main.hs:9:6: error:
• ‘Foo’ is not in the type environment at a reify
• In the untyped splice: $(unTypeCode (mkStuff ''Foo))
|
9 | x = $(unTypeCode (mkStuff ''Foo))
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Edit: But this works:
module Demo where
import Example
import Language.Haskell.TH
type Foo = Int
$(pure [])
x = $(unTypeCode (mkStuff ''Foo))
Interesting - thank you. What’s the reason behind splitting up the type synonym and x with a dummy splice?
I also see that if I have the type synonym in one module and x in another that seems to work. I take it the dummy splice separates things in an equivalent way to separate modules from TH’s point of view?
Top-level declaration splices break up a source file into declaration groups. A declaration group is the group of declarations created by a top-level declaration splice, plus those following it, down to but not including the next top-level declaration splice. N.B. only top-level splices delimit declaration groups, not expression splices. The first declaration group in a module includes all top-level definitions down to but not including the first top-level declaration splice.
Each group is compiled just like a separately compiled module. That is:
Later groups can “see” declarations, and instance declarations, from earlier groups;
But earlier groups cannot “see” declarations, or instance declarations, from later groups.
Each declaration group is mutually recursive only within the group. Declaration groups can refer to definitions within previous groups, but not later ones.