Using Template Haskell for deriving instances

[Derek Elkins]

On Tue, 15 Jul 2003 14:49:41 +0200
Carsten Schultz <carsten@gnocchi.dialup.fu-berlin.de> wrote:

> Hi,
> 
> is any workable example code for using Template Haskell to generate
> instance declarations available, eg the function `genEq' mentioned in
> the Template Haskell paper?

This is a module I made to warmup with TH.  Unfortunately, this was back
with 5.05 and I'm pretty sure the names and data structures have been
changed.  Hopefully, it's a relatively decent example of how to do this,
it did seem to work at the time.  When I work with TH again, I'd
like to make a fairly general deriving framework, however gmap
by itself might get you most of the way there.  Anyways, if you are
interested in TH you should probably join the Template Haskell mailing
list.

module GenNFData ( genNFData ) where

import Strategies
import Language.Haskell.THSyntax

{-
data Tree a b = EmptyTree | Leaf a | Branch b (Tree a b) (Tree a b)

$(genNFData $ reifyDecl Tree)
==>
instance (NFData a, NFData b) => NFData (Tree a b) where
    rnf EmptyTree = ()
    rnf (Leaf x) = rnf x
    rnf (Branch v l r) = seq (rnf v) (seq (rnf l) (rnf r))
-}

genNFData :: Decl -> Q [Dec]
genNFData dcl = do
    (Data _ nme vars ctors _) <- dcl
    x <- gensym "a"
    let vs = map tvar vars
        repNFD = namedTyCon "NFData" {-[t| NFData |]-}
        xs = foldl1 tapp (tcon (TconName nme) : vs)
    sequence [inst (ctxt $ map (tapp repNFD) vs) (tapp repNFD xs) 
                        [fun "rnf" (map mkRnf ctors)]]
  where mkRnf (Constr n []) = clause [pcon n []] (normal $ [| () |]) []
        mkRnf (Constr n as) = do
            ss <- mapM (const $ gensym "a	") as
            clause [pcon n (map pvar ss)] 
                (normal $ foldr1 (\x y -> [| seq $x $y |])
                                 (map (\x -> [| rnf $(var x) |]) ss))
                []