[Template-haskell] example of derive using Template Haskell?

Lemmih lemmih at gmail.com
Tue Jan 11 03:43:43 EST 2005


Hey Alex.

You write sugared Haskell inside [| |]. It's just an easier way of
constructing the various data structures.

'[| |]' creates a structure of type 'ExpQ'
Prelude Language.Haskell.TH> runQ [| 10 |] >>= print
LitE (IntegerL 10)

'[t| |]' creates a structure of type 'TypeQ'
Prelude Language.Haskell.TH> runQ [t| Maybe Int |] >>= print
AppT (ConT Data.Maybe.Maybe) (ConT GHC.Base.Int)

'[d| |]' creates a structure of type 'Q [Dec]'
Prelude Language.Haskell.TH> runQ [d| foo = "bar" |] >>= print
[ValD (VarP foo) (NormalB (LitE (StringL "bar"))) []]

This information is more or less available at
http://www.haskell.org/ghc/docs/latest/html/users_guide/template-haskell.html

On Mon, 10 Jan 2005 21:45:20 -0500 (Eastern Standard Time), S.
Alexander Jacobson <alex at alexjacobson.com> wrote:
[...]
>    fooFunc =  [d|funD "foo" [clause [] (normalB $ litE $ StringL "bar") [] ] |]
>    goo = [|2|]
> 
>    ---
> 
>    {-# OPTIONS -fglasgow-exts #-}
>    import Tth
>    foo = $(goo)
>    $(fooFunc)
> 
> If I eliminate the d in "[d|" I get an error about
> Dec conflicting with Exp.
[...]
When you do a toplevel splice then the variable you're splicing must
have type :: Q [Dec].

-- 
Friendly,
  Lemmih


More information about the template-haskell mailing list