Add proper GADTs support to Template Haskell

Until now GADTs were supported in Template Haskell by encoding them using
normal data types.  This patch adds proper support for representing GADTs
in TH.

Test Plan: T10828

Reviewers: goldfire, austin, bgamari

Subscribers: thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D1465

GHC Trac Issues: #10828

32 files changed, 286 insertions, 55 deletions

diff --git a/testsuite/tests/overloadedrecflds/should_fail/T11103.hs b/testsuite/tests/overloadedrecflds/should_fail/T11103.hs
index 2ba8e41a22..2791dc4fca 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/T11103.hs
+++ b/testsuite/tests/overloadedrecflds/should_fail/T11103.hs
@@ -12,7 +12,7 @@ data S = MkS { foo :: Int }
 
 $(do info <- reify ''R
      case info of
-       TyConI (DataD _ _ _ [RecC _ [(foo_n, _, _), (bar_n, _, _)]] _)
+       TyConI (DataD _ _ _ _ [RecC _ [(foo_n, _, _), (bar_n, _, _)]] _)
          -> do { reify bar_n -- This is unambiguous
                ; reify foo_n -- This is ambiguous
                ; return []
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.hs
index e70c5db7b1..e97fdcea9a 100644
--- a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.hs
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.hs
@@ -6,7 +6,8 @@ import Language.Haskell.TH
 import Language.Haskell.TH.Syntax
 
 -- Splice in a datatype with field...
-$(return [DataD [] (mkName "R") [] [RecC (mkName "MkR") [(mkName "foo", NotStrict, ConT ''Int)]] []])
+$(return [DataD [] (mkName "R") [] Nothing
+          [RecC (mkName "MkR") [(mkName "foo", NotStrict, ConT ''Int)]] []])
 
 -- New TH story means reify only sees R if we do this:
 $(return [])
@@ -14,7 +15,7 @@ $(return [])
 -- ... and check that we can inspect it
 main = do  putStrLn $(do { info <- reify ''R
                          ; case info of
-                             TyConI (DataD _ _ _ [RecC _ [(n, _, _)]] _) ->
+                             TyConI (DataD _ _ _ _ [RecC _ [(n, _, _)]] _) ->
                                  do { info' <- reify n
                                     ; lift (pprint info ++ "\n" ++ pprint info')
                                     }
diff --git a/testsuite/tests/rts/T7919A.hs b/testsuite/tests/rts/T7919A.hs
index 4bca2add1f..4dc013aeff 100644
--- a/testsuite/tests/rts/T7919A.hs
+++ b/testsuite/tests/rts/T7919A.hs
@@ -19,6 +19,7 @@ largeData =
     (cxt [])
     (dataName)
     []
+    Nothing
     [normalC dataName (replicate size (((,) <$> notStrict) `ap` [t| Int |]))]
     (cxt [])
 
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang11_B.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang11_B.hs
index 8d81be6abc..ec4f7c9bbf 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang11_B.hs
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang11_B.hs
@@ -8,7 +8,7 @@ class Class a where
 
 mkSimpleClass :: Name -> Q [Dec]
 mkSimpleClass name = do
-	TyConI (DataD [] dname [] cs _) <- reify name
+	TyConI (DataD [] dname [] Nothing cs _) <- reify name
 	((NormalC conname []):_) <- return cs
 	ClassI (ClassD [] cname [_] [] [SigD mname _]) _ <- reify ''Class
 	return [InstanceD [] (AppT (ConT cname) (ConT dname)) [FunD mname
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12_B.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12_B.hs
index 1e5b2252cb..af7e5cf5b1 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12_B.hs
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12_B.hs
@@ -9,7 +9,7 @@ class Class a where
 
 mkSimpleClass :: Name -> Q [Dec]
 mkSimpleClass name = do
-	TyConI (DataD [] dname [] cs _) <- reify name
+	TyConI (DataD [] dname [] Nothing cs _) <- reify name
 	((NormalC conname []):_) <- return cs
 	ClassI (ClassD [] cname [_] [] [SigD mname _]) _ <- reify ''Class
 	return [InstanceD [] (AppT (ConT cname) (ConT dname)) [FunD mname
diff --git a/testsuite/tests/th/T10819_Lib.hs b/testsuite/tests/th/T10819_Lib.hs
index aa52a181fd..94f352efe7 100644
--- a/testsuite/tests/th/T10819_Lib.hs
+++ b/testsuite/tests/th/T10819_Lib.hs
@@ -2,5 +2,6 @@ module T10819_Lib where
 
 import Language.Haskell.TH.Syntax
 
-doSomeTH s tp drv = return [NewtypeD [] n [] (NormalC n [(NotStrict, ConT tp)]) drv]
+doSomeTH s tp drv = return [NewtypeD [] n [] Nothing
+                            (NormalC n [(NotStrict, ConT tp)]) drv]
   where n = mkName s
diff --git a/testsuite/tests/th/T10828.hs b/testsuite/tests/th/T10828.hs
new file mode 100644
index 0000000000..f01c5b9769
--- /dev/null
+++ b/testsuite/tests/th/T10828.hs
@@ -0,0 +1,61 @@
+{-# 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")]
+                   [ (NotStrict, VarT (mkName "a"))
+                   , (NotStrict, VarT (mkName "a"))]
+                   ( mkName "T" )
+                   [ VarT (mkName "a") ]
+           , ForallC [PlainTV (mkName "a"), PlainTV (mkName "b")]
+                     [AppT (AppT EqualityT (VarT $ mkName "a"  ) )
+                                           (ConT $ mkName "Int") ] $
+             RecGadtC [(mkName "MkC")]
+                  [ (mkName "foo", NotStrict, VarT (mkName "a"))
+                  , (mkName "bar", NotStrict, VarT (mkName "b"))]
+                  ( 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 [] } )
diff --git a/testsuite/tests/th/T10828.stderr b/testsuite/tests/th/T10828.stderr
new file mode 100644
index 0000000000..91653f9ab3
--- /dev/null
+++ b/testsuite/tests/th/T10828.stderr
@@ -0,0 +1,100 @@
+data family D_0 a_1 :: * -> *
+data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where
+    DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool
+data E_3 where MkE_4 :: forall a_5 . a_5 -> E_3
+data Foo_6 a_7 b_8 where
+    MkFoo_9, MkFoo'_10 :: forall a_11 b_12 . a_11 -> Foo_6 a_11 b_12
+newtype Bar_13 :: * -> GHC.Types.Bool -> *
+  = MkBar_14 :: forall a_15 b_16 . a_15 -> Bar_13 a_15 b_16
+data T10828.T (a_0 :: *) where
+    T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1
+    T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . Data.Type.Equality.~ a_2
+                                                                       GHC.Types.Int => {T10828.foo :: a_2,
+                                                                                         T10828.bar :: b_3} -> T10828.T GHC.Types.Int
+data T'_0 a_1 :: * where
+    MkT'_2 :: forall a_3 . a_3 -> a_3 -> T'_0 a_3
+    MkC'_4 :: forall a_5 b_6 . a_5 ~ GHC.Types.Int => {foo_7 :: a_5,
+                                                       bar_8 :: b_6} -> T'_0 GHC.Types.Int
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+  type role Bar representational phantom
+  newtype Bar a (b :: Bool) where
+    MkBar :: a -> Bar a b
+    Kind: GHC.Types.Type -> Bool -> GHC.Types.Type
+  data family D a0 b
+  data E where
+    MkE :: a0 -> E
+    Kind: *
+  type role Foo representational phantom
+  data Foo a0 b0 where
+    MkFoo :: a0 -> Foo a0 b0
+    MkFoo' :: a0 -> Foo a0 b0
+    Kind: * -> * -> *
+  type role T nominal
+  data T a where
+    MkT :: a -> a -> T a
+    MkC :: a1 ~ Int => {foo :: a1, bar :: b} -> T Int
+    Kind: * -> GHC.Types.Type
+COERCION AXIOMS
+  axiom T10828.NTCo:Bar :: Bar a b = a -- Defined at T10828.hs:9:4
+  axiom T10828.TFCo:R:DIntBool ::
+    D Int Bool = T10828.R:DIntBool -- Defined at T10828.hs:9:4
+FAMILY INSTANCES
+  data instance D Int Bool
+Dependent modules: []
+Dependent packages: [array-<VERSION>, base-<VERSION>, binary-<VERSION>,
+                     bytestring-<VERSION>, containers-<VERSION>, deepseq-<VERSION>,
+                     ghc-boot-<VERSION>, ghc-prim-<VERSION>, integer-<IMPL>-<VERSION>,
+                     pretty-<VERSION>, template-haskell-<VERSION>]
+
+==================== Typechecker ====================
+foo = ()
+bar = ()
+T10828.$tcT
+  = GHC.Types.TyCon 0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "T"#)
+T10828.$tc'MkT
+  = GHC.Types.TyCon
+      0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "'MkT"#)
+T10828.$tc'MkC
+  = GHC.Types.TyCon
+      0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "'MkC"#)
+T10828.$tc'DInt
+  = GHC.Types.TyCon
+      0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "'DInt"#)
+T10828.$tcBar
+  = GHC.Types.TyCon
+      0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "Bar"#)
+T10828.$tc'MkBar
+  = GHC.Types.TyCon
+      0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "'MkBar"#)
+T10828.$tcFoo
+  = GHC.Types.TyCon
+      0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "Foo"#)
+T10828.$tc'MkFoo
+  = GHC.Types.TyCon
+      0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "'MkFoo"#)
+T10828.$tc'MkFoo'
+  = GHC.Types.TyCon
+      0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "'MkFoo'"#)
+T10828.$tcE
+  = GHC.Types.TyCon 0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "E"#)
+T10828.$tc'MkE
+  = GHC.Types.TyCon
+      0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "'MkE"#)
+T10828.$tcD
+  = GHC.Types.TyCon 0## 0## T10828.$trModule
+      (GHC.Types.TrNameS "D"#)
+T10828.$trModule
+  = GHC.Types.Module
+      (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "T10828"#)
diff --git a/testsuite/tests/th/T10828a.hs b/testsuite/tests/th/T10828a.hs
new file mode 100644
index 0000000000..8bf13cfb04
--- /dev/null
+++ b/testsuite/tests/th/T10828a.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE TemplateHaskell, GADTs, ExplicitForAll, KindSignatures #-}
+
+module T10828a where
+
+import Language.Haskell.TH
+import System.IO
+
+-- attempting to place a kind signature on a H98 data type
+$( return
+   [ DataD [] (mkName "T")
+           [ PlainTV (mkName "a") ]
+           (Just StarT)
+           [ NormalC (mkName "MkT")
+                   [ (NotStrict, VarT (mkName "a"))
+                   , (NotStrict, VarT (mkName "a"))]
+           ]
+           [] ])
diff --git a/testsuite/tests/th/T10828a.stderr b/testsuite/tests/th/T10828a.stderr
new file mode 100644
index 0000000000..9c05b83190
--- /dev/null
+++ b/testsuite/tests/th/T10828a.stderr
@@ -0,0 +1,4 @@
+
+T10828a.hs:9:4:
+    Kind signatures are only allowed on GADTs
+    When splicing a TH declaration: data T a :: * = MkT a a
diff --git a/testsuite/tests/th/T10828b.hs b/testsuite/tests/th/T10828b.hs
new file mode 100644
index 0000000000..55d8889009
--- /dev/null
+++ b/testsuite/tests/th/T10828b.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE TemplateHaskell, GADTs, ExplicitForAll, KindSignatures #-}
+
+module T10828b where
+
+import Language.Haskell.TH
+import System.IO
+
+-- attempting to mix GADT and normal constructors
+$( return
+   [ DataD [] (mkName "T")
+           [ PlainTV (mkName "a") ]
+           (Just StarT)
+           [ NormalC (mkName "MkT")
+                   [ (NotStrict, VarT (mkName "a"))
+                   , (NotStrict, VarT (mkName "a"))]
+           , ForallC [PlainTV (mkName "a")]
+                     [AppT (AppT EqualityT (VarT $ mkName "a"  ) )
+                                           (ConT $ mkName "Int") ] $
+             RecGadtC [(mkName "MkC")]
+                  [ (mkName "foo", NotStrict, VarT (mkName "a"))
+                  , (mkName "bar", NotStrict, VarT (mkName "b"))]
+                  ( mkName "T" )
+                  [ ConT (mkName "Int") ]
+           ]
+           [] ])
diff --git a/testsuite/tests/th/T10828b.stderr b/testsuite/tests/th/T10828b.stderr
new file mode 100644
index 0000000000..bbc57dd3ab
--- /dev/null
+++ b/testsuite/tests/th/T10828b.stderr
@@ -0,0 +1,7 @@
+
+T10828b.hs:9:4:
+    Cannot mix GADT constructors with Haskell 98 constructors
+    When splicing a TH declaration:
+      data T a :: *
+    = MkT a a
+    | MkC :: forall a . a ~ Int => {foo :: a, bar :: b} -> T Int
diff --git a/testsuite/tests/th/T4188.stderr b/testsuite/tests/th/T4188.stderr
index bea2e80674..2e4155fd8b 100644
--- a/testsuite/tests/th/T4188.stderr
+++ b/testsuite/tests/th/T4188.stderr
@@ -1,9 +1,8 @@
 data T4188.T1 (a_0 :: *) = forall (b_1 :: *) . T4188.MkT1 a_0 b_1
 data T4188.T2 (a_0 :: *)
-    = forall (b_1 :: *) . (T4188.C a_0, T4188.C b_1) =>
-                          T4188.MkT2 a_0 b_1
-data T4188.T3 (x_0 :: *)
-    = forall (x_1 :: *) (y_2 :: *) . (x_0 ~ (x_1, y_2),
-                                      T4188.C x_1,
-                                      T4188.C y_2) =>
-                                     T4188.MkT3 x_1 y_2
+    = forall (b_1 :: *) . (T4188.C a_0, T4188.C b_1) => T4188.MkT2 a_0
+                                                                   b_1
+data T4188.T3 (x_0 :: *) where
+    T4188.MkT3 :: forall (x_1 :: *) (y_2 :: *) . (T4188.C x_1,
+                                                  T4188.C y_2) => x_1 -> y_2 -> T4188.T3 (x_1, y_2)
+
diff --git a/testsuite/tests/th/T5217.hs b/testsuite/tests/th/T5217.hs
index 9dd1f1cb3f..ea28c74921 100644
--- a/testsuite/tests/th/T5217.hs
+++ b/testsuite/tests/th/T5217.hs
@@ -1,11 +1,9 @@
-{-# LANGUAGE GADTs #-}

-

-module T5217 where

-import Language.Haskell.TH

-

-$([d| data T a b where { T1 :: Int -> T Int Char 

-                       ; T2 :: a -> T a a

-                       ; T3 :: a -> T [a] a

-                       ; T4 :: a -> b -> T b [a] } |])

-

-

+{-# LANGUAGE GADTs #-}
+
+module T5217 where
+import Language.Haskell.TH
+
+$([d| data T a b where { T1 :: Int -> T Int Char
+                       ; T2 :: a -> T a a
+                       ; T3 :: a -> T [a] a
+                       ; T4 :: a -> b -> T b [a] } |])
diff --git a/testsuite/tests/th/T5217.stderr b/testsuite/tests/th/T5217.stderr
index f69875b31f..fe9150d90b 100644
--- a/testsuite/tests/th/T5217.stderr
+++ b/testsuite/tests/th/T5217.stderr
@@ -7,7 +7,8 @@ T5217.hs:(6,3)-(9,53): Splicing declarations
             T4 :: a -> b -> T b [a] |]

   ======>

     data T a b

-      = (b ~ Char, a ~ Int) => T1 Int |

-        b ~ a => T2 a |

-        a ~ [b] => T3 b |

-        forall a. b ~ [a] => T4 a a

+      where

+        T1 :: Int -> T Int Char

+        T2 :: forall a. a -> T a a

+        T3 :: forall a. a -> T [a] a

+        T4 :: forall a b. a -> b -> T b [a]

diff --git a/testsuite/tests/th/T5290.hs b/testsuite/tests/th/T5290.hs
index 7973a13d24..50ad2d500c 100644
--- a/testsuite/tests/th/T5290.hs
+++ b/testsuite/tests/th/T5290.hs
@@ -5,4 +5,4 @@ module T5290 where
 import Language.Haskell.TH
 
 $( let n = mkName "T"
-   in return [DataD [] n [] [NormalC n [(Unpacked,ConT ''Int)]] []] )
+   in return [DataD [] n [] Nothing [NormalC n [(Unpacked,ConT ''Int)]] []] )
diff --git a/testsuite/tests/th/T5290.stderr b/testsuite/tests/th/T5290.stderr
index 2b4275d842..d6996d0799 100644
--- a/testsuite/tests/th/T5290.stderr
+++ b/testsuite/tests/th/T5290.stderr
@@ -1,5 +1,7 @@
-T5290.hs:(7,4)-(8,67): Splicing declarations
+T5290.hs:(7,4)-(8,75): Splicing declarations
     let n = mkName "T"
-    in return [DataD [] n [] [NormalC n [(Unpacked, ConT ''Int)]] []]
+    in
+      return
+        [DataD [] n [] Nothing [NormalC n [(Unpacked, ConT ''Int)]] []]
   ======>
     data T = T {-# UNPACK #-} !Int
diff --git a/testsuite/tests/th/T5665a.hs b/testsuite/tests/th/T5665a.hs
index eba5a1a168..b34131e974 100644
--- a/testsuite/tests/th/T5665a.hs
+++ b/testsuite/tests/th/T5665a.hs
@@ -1,6 +1,7 @@
-module T5665a where

-

-import Language.Haskell.TH

-

-doSomeTH s tp = return [NewtypeD [] n [] (NormalC n [(NotStrict, ConT tp)]) []]

-   where n = mkName s

+module T5665a where
+
+import Language.Haskell.TH
+
+doSomeTH s tp = return [NewtypeD [] n [] Nothing
+                        (NormalC n [(NotStrict, ConT tp)]) []]
+   where n = mkName s
diff --git a/testsuite/tests/th/T5984_Lib.hs b/testsuite/tests/th/T5984_Lib.hs
index c3abfa21f9..a929086dd2 100644
--- a/testsuite/tests/th/T5984_Lib.hs
+++ b/testsuite/tests/th/T5984_Lib.hs
@@ -5,9 +5,10 @@ module T5984_Lib where
 import Language.Haskell.TH
 
 nt :: Q [Dec]
-nt = return [NewtypeD [] foo [] (NormalC foo [(NotStrict, ConT ''Int)]) []]
+nt = return [NewtypeD [] foo [] Nothing
+             (NormalC foo [(NotStrict, ConT ''Int)]) []]
   where foo = mkName "Foo"
 
 dt :: Q [Dec]
-dt = return [DataD [] bar [] [NormalC bar [(NotStrict, ConT ''Int)]] []]
+dt = return [DataD [] bar [] Nothing [NormalC bar [(NotStrict, ConT ''Int)]] []]
   where bar = mkName "Bar"
diff --git a/testsuite/tests/th/T7241.hs b/testsuite/tests/th/T7241.hs
index 971a2678f8..8eee28004c 100644
--- a/testsuite/tests/th/T7241.hs
+++ b/testsuite/tests/th/T7241.hs
@@ -4,4 +4,4 @@ module T7241 where
 
 import Language.Haskell.TH
 
-$(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] []])
+$(newName "Foo" >>= \o -> return [DataD [] o [] Nothing [RecC o []] []])
diff --git a/testsuite/tests/th/T7532a.hs b/testsuite/tests/th/T7532a.hs
index 5a5f45adb7..42976b393c 100644
--- a/testsuite/tests/th/T7532a.hs
+++ b/testsuite/tests/th/T7532a.hs
@@ -11,5 +11,5 @@ class C a where
 bang :: DecsQ
 bang = return [
      InstanceD [] (AppT (ConT ''C) (ConT ''Int)) [
-         DataInstD [] ''D [ConT ''Int] [
-             NormalC (mkName "T") []] []]] 
+         DataInstD [] ''D [ConT ''Int] Nothing [
+             NormalC (mkName "T") []] []]]
diff --git a/testsuite/tests/th/T8499.hs b/testsuite/tests/th/T8499.hs
index 7829e99e53..29b9e1678c 100644
--- a/testsuite/tests/th/T8499.hs
+++ b/testsuite/tests/th/T8499.hs
@@ -5,7 +5,7 @@ module T8499 where
 
 import Language.Haskell.TH
 
-$( do TyConI (DataD _ _ [KindedTV tvb_a _] _ _) <- reify ''Maybe
+$( do TyConI (DataD _ _ [KindedTV tvb_a _] _ _ _) <- reify ''Maybe
       my_a <- newName "a"
       return [TySynD (mkName "SMaybe")
                      [KindedTV my_a (AppT (ConT ''Maybe) (VarT tvb_a))]
diff --git a/testsuite/tests/th/T8624.hs b/testsuite/tests/th/T8624.hs
index 49f67d5a33..eda7781132 100644
--- a/testsuite/tests/th/T8624.hs
+++ b/testsuite/tests/th/T8624.hs
@@ -4,4 +4,5 @@ module T8624 (THDec(..)) where
 
 import Language.Haskell.TH
 
-$(return [DataD [] (mkName "THDec") [] [NormalC (mkName "THDec") []] []])
+$(return [DataD [] (mkName "THDec") [] Nothing
+          [NormalC (mkName "THDec") []] []])
diff --git a/testsuite/tests/th/T8624.stdout b/testsuite/tests/th/T8624.stdout
index 82ea19598c..0dcc7b0718 100644
--- a/testsuite/tests/th/T8624.stdout
+++ b/testsuite/tests/th/T8624.stdout
@@ -1,2 +1,2 @@
--- T8624.hs:7:3-72: Splicing declarations
+-- T8624.hs:(7,3)-(8,43): Splicing declarations
 data THDec = THDec
diff --git a/testsuite/tests/th/TH_RichKinds2.stderr b/testsuite/tests/th/TH_RichKinds2.stderr
index 4f8729d53c..e141b40396 100644
--- a/testsuite/tests/th/TH_RichKinds2.stderr
+++ b/testsuite/tests/th/TH_RichKinds2.stderr
@@ -1,8 +1,9 @@
 
 TH_RichKinds2.hs:24:4: Warning:
-    data SMaybe_0 (t_1 :: k_0 -> *) (t_3 :: GHC.Base.Maybe k_0)
-    = forall . t_3 ~ 'GHC.Base.Nothing => SNothing_4
-    | forall a_5 . t_3 ~ 'GHC.Base.Just a_5 => SJust_6 (t_1 a_5)
+    data SMaybe_0 :: (k_0 -> *) -> GHC.Base.Maybe k_0 -> * where
+    SNothing_2 :: forall s_3 . SMaybe_0 s_3 'GHC.Base.Nothing
+    SJust_4 :: forall s_5 a_6 . (s_5 a_6) -> SMaybe_0 s_5
+                                                      'GHC.Base.Just a_6
 type instance TH_RichKinds2.Map f_7 '[] = '[]
 type instance TH_RichKinds2.Map f_8
                                 ('GHC.Types.: h_9 t_10) = 'GHC.Types.: (f_8 h_9)
diff --git a/testsuite/tests/th/TH_Roles1.hs b/testsuite/tests/th/TH_Roles1.hs
index d746fc9cd8..89d072c485 100644
--- a/testsuite/tests/th/TH_Roles1.hs
+++ b/testsuite/tests/th/TH_Roles1.hs
@@ -4,6 +4,6 @@ module TH_Roles1 where
 
 import Language.Haskell.TH
 
-$( return [ DataD [] (mkName "T") [PlainTV (mkName "a")] [] []
+$( return [ DataD [] (mkName "T") [PlainTV (mkName "a")] Nothing [] []
           , RoleAnnotD (mkName "T") [RepresentationalR] ] )
 
diff --git a/testsuite/tests/th/TH_Roles2.hs b/testsuite/tests/th/TH_Roles2.hs
index 30f4fc7631..3f7b535b49 100644
--- a/testsuite/tests/th/TH_Roles2.hs
+++ b/testsuite/tests/th/TH_Roles2.hs
@@ -4,6 +4,7 @@ module TH_Roles2 where
 
 import Language.Haskell.TH
 
-$( return [ DataD [] (mkName "T") [KindedTV (mkName "a") (VarT (mkName "k"))] [] []
+$( return [ DataD [] (mkName "T") [KindedTV (mkName "a") (VarT (mkName "k"))]
+            Nothing [] []
           , RoleAnnotD (mkName "T") [RepresentationalR] ] )
 
diff --git a/testsuite/tests/th/TH_dataD1.hs b/testsuite/tests/th/TH_dataD1.hs
index c28d38b370..1a51ac4aef 100644
--- a/testsuite/tests/th/TH_dataD1.hs
+++ b/testsuite/tests/th/TH_dataD1.hs
@@ -5,7 +5,8 @@ import Language.Haskell.TH
 
 ds :: Q [Dec]
 ds = [d|
-          $(do { d <- dataD (cxt []) (mkName "D") [] [normalC (mkName "K") []] (cxt [])
+          $(do { d <- dataD (cxt []) (mkName "D") [] Nothing
+                             [normalC (mkName "K") []] (cxt [])
                ; return [d]})
        |]
 
diff --git a/testsuite/tests/th/TH_genExLib.hs b/testsuite/tests/th/TH_genExLib.hs
index d439231815..5e1ee0bfc0 100644
--- a/testsuite/tests/th/TH_genExLib.hs
+++ b/testsuite/tests/th/TH_genExLib.hs
@@ -12,7 +12,7 @@ genAny decl = do { d <- decl
 
 genAnyClass :: Name -> [Dec] -> Dec
 genAnyClass name decls
-  = DataD [] anyName [] [constructor] []
+  = DataD [] anyName [] Nothing [constructor] []
   where
     anyName = mkName ("Any" ++ nameBase name ++ "1111")
     constructor = ForallC [PlainTV var_a] [AppT (ConT name) (VarT var_a)] $
diff --git a/testsuite/tests/th/TH_spliceDecl1.hs b/testsuite/tests/th/TH_spliceDecl1.hs
index 618218d3eb..94070a3c69 100644
--- a/testsuite/tests/th/TH_spliceDecl1.hs
+++ b/testsuite/tests/th/TH_spliceDecl1.hs
@@ -7,4 +7,4 @@ import Language.Haskell.TH
 
 
 -- splice a simple data declaration
-$(return [DataD [] (mkName "T") [] [NormalC (mkName "C") []] []])
+$(return [DataD [] (mkName "T") [] Nothing [NormalC (mkName "C") []] []])
diff --git a/testsuite/tests/th/TH_spliceDecl3_Lib.hs b/testsuite/tests/th/TH_spliceDecl3_Lib.hs
index 1b8d44e781..bc1c268197 100644
--- a/testsuite/tests/th/TH_spliceDecl3_Lib.hs
+++ b/testsuite/tests/th/TH_spliceDecl3_Lib.hs
@@ -4,8 +4,9 @@ where
 import Language.Haskell.TH
 
 rename' :: Dec -> Q [Dec]
-rename' (DataD ctxt tyName tyvars cons derivs) =
-  return [DataD ctxt (stripMod tyName) tyvars (map renameCons cons) derivs]
+rename' (DataD ctxt tyName tyvars ksig cons derivs) =
+  return [DataD ctxt (stripMod tyName) tyvars ksig
+          (map renameCons cons) derivs]
   where
     renameCons (NormalC conName tys) = NormalC (stripMod conName) tys
     --
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 45ee2df13b..5a55b6f0da 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -369,6 +369,13 @@ test('T10796a', normal, compile, ['-v0'])
 test('T10796b', normal, compile_fail, ['-v0'])
 test('T10811', normal, compile, ['-v0'])
 test('T10810', normal, compile, ['-v0'])
+test('T10828', normalise_version('array', 'base', 'binary', 'bytestring',
+                                 'containers', 'deepseq', 'ghc-boot',
+                                 'ghc-prim', 'integer-gmp', 'pretty',
+                                 'template-haskell'
+                              ), compile, ['-v0 -ddump-tc -dsuppress-uniques'])
+test('T10828a', normal, compile_fail, ['-v0'])
+test('T10828b', normal, compile_fail, ['-v0'])
 test('T10891', normal, compile, ['-v0'])
 test('T10945', normal, compile_fail, ['-v0'])
 test('T10946', expect_broken(10946), compile, ['-v0'])