75b852ff07d92fa60ffccd3b28dd9a41b9da9688
[ghc.git] / testsuite / tests / th / T10828.hs
1 {-# LANGUAGE TemplateHaskell, GADTs, ExplicitForAll, KindSignatures,
2 TypeFamilies, DataKinds #-}
3
4 module T10828 where
5
6 import Language.Haskell.TH
7 import System.IO
8
9 $( do { decl <- [d| data family D a :: * -> *
10 data instance D Int Bool :: * where
11 DInt :: D Int Bool
12
13 data E where
14 MkE :: a -> E
15
16 data Foo a b where
17 MkFoo, MkFoo' :: a -> Foo a b
18
19 newtype Bar :: * -> Bool -> * where
20 MkBar :: a -> Bar a b
21 |]
22
23 ; runIO $ putStrLn (pprint decl) >> hFlush stdout
24 ; return decl }
25 )
26
27 -- data T a :: * where
28 -- MkT :: a -> a -> T a
29 -- MkC :: forall a b. (a ~ Int) => { foo :: a, bar :: b } -> T Int
30
31 $( return
32 [ DataD [] (mkName "T")
33 [ PlainTV (mkName "a") ]
34 (Just StarT)
35 [ GadtC [(mkName "MkT")]
36 [ ( Bang NoSourceUnpackedness NoSourceStrictness
37 , VarT (mkName "a")
38 )
39 , ( Bang NoSourceUnpackedness NoSourceStrictness
40 , VarT (mkName "a")
41 )
42 ]
43 ( mkName "T" )
44 [ VarT (mkName "a") ]
45 , ForallC [PlainTV (mkName "a"), PlainTV (mkName "b")]
46 [AppT (AppT EqualityT (VarT $ mkName "a" ) )
47 (ConT $ mkName "Int") ] $
48 RecGadtC [(mkName "MkC")]
49 [ ( mkName "foo"
50 , Bang NoSourceUnpackedness NoSourceStrictness
51 , VarT (mkName "a")
52 )
53 , ( mkName "bar"
54 , Bang NoSourceUnpackedness NoSourceStrictness
55 , VarT (mkName "b")
56 )
57 ]
58 ( mkName "T" )
59 [ ConT (mkName "Int") ] ]
60 [] ])
61
62 $( do { -- test reification
63 TyConI dec <- runQ $ reify (mkName "T")
64 ; runIO $ putStrLn (pprint dec) >> hFlush stdout
65
66 -- test quoting
67 ; d <- runQ $ [d|
68 data T' a :: * where
69 MkT' :: a -> a -> T' a
70 MkC' :: forall a b. (a ~ Int) => { foo :: a, bar :: b }
71 -> T' Int |]
72 ; runIO $ putStrLn (pprint d) >> hFlush stdout
73 ; return [] } )