summaryrefslogtreecommitdiff
path: root/testsuite/tests/th/TH_genExLib.hs
blob: 25091c4ecf9407045a8e37648d9b693ed75c27c0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

module TH_genExLib where

import Language.Haskell.TH

genAny :: Q Info -> Q [Dec]
genAny decl = do { d <- decl
		 ; case d of
		    ClassI (ClassD _ name _ _ decls) _ -> return [genAnyClass name decls]
		    _ -> error "genAny can be applied to classes only"
	}

genAnyClass :: Name -> [Dec] -> Dec
genAnyClass name decls
  = DataD [] anyName [] Nothing [constructor] []
  where
    anyName = mkName ("Any" ++ nameBase name ++ "1111")
    constructor = ForallC [PlainTV var_a] [AppT (ConT name) (VarT var_a)] $
		  NormalC anyName
			        [(Bang NoSourceUnpackedness NoSourceStrictness, VarT var_a)]
    var_a = mkName "a"