T10828.hs 2.39 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
{-# LANGUAGE TemplateHaskell, GADTs, ExplicitForAll, KindSignatures,
             TypeFamilies, DataKinds #-}

module T10828 where

import Language.Haskell.TH
import System.IO

$( do { decl <- [d| data family D a :: * -> *
                    data instance D Int Bool :: * where
                         DInt :: D Int Bool

                    data E where
                      MkE :: a -> E

                    data Foo a b where
                      MkFoo, MkFoo' :: a -> Foo a b

                    newtype Bar :: * -> Bool -> * where
                      MkBar :: a -> Bar a b
                 |]

      ; runIO $ putStrLn (pprint decl) >> hFlush stdout
      ; return decl }
 )

-- data T a :: * where
--    MkT :: a -> a -> T a
--    MkC :: forall a b. (a ~ Int) => { foo :: a, bar :: b } -> T Int

$( return
   [ DataD [] (mkName "T")
           [ PlainTV (mkName "a") ]
           (Just StarT)
           [ GadtC [(mkName "MkT")]
36 37 38 39 40 41 42
                   [ ( Bang NoSourceUnpackedness NoSourceStrictness
                     , VarT (mkName "a")
                     )
                   , ( Bang NoSourceUnpackedness NoSourceStrictness
                     , VarT (mkName "a")
                     )
                   ]
43 44 45 46 47 48
                   ( mkName "T" )
                   [ VarT (mkName "a") ]
           , ForallC [PlainTV (mkName "a"), PlainTV (mkName "b")]
                     [AppT (AppT EqualityT (VarT $ mkName "a"  ) )
                                           (ConT $ mkName "Int") ] $
             RecGadtC [(mkName "MkC")]
49 50 51 52 53 54 55 56 57
                  [ ( mkName "foo"
                    , Bang NoSourceUnpackedness NoSourceStrictness
                    , VarT (mkName "a")
                    )
                  , ( mkName "bar"
                    , Bang NoSourceUnpackedness NoSourceStrictness
                    , VarT (mkName "b")
                    )
                  ]
58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
                  ( mkName "T" )
                  [ ConT (mkName "Int") ] ]
           [] ])

$( do { -- test reification
        TyConI dec <- runQ $ reify (mkName "T")
      ; runIO $ putStrLn (pprint dec) >> hFlush stdout

        -- test quoting
      ; d <- runQ $ [d|
             data T' a :: * where
                MkT' :: a -> a -> T' a
                MkC' :: forall a b. (a ~ Int) => { foo :: a, bar :: b }
                                              -> T' Int |]
      ; runIO $ putStrLn (pprint d) >> hFlush stdout
      ; return [] } )