Handle type data declarations in Template Haskell quotations and splices (fixes #22500)

This adds a TypeDataD constructor to the Template Haskell Dec type,
and ensures that the constructors it contains go in the TyCls namespace.

5 files changed, 32 insertions, 0 deletions

diff --git a/testsuite/tests/type-data/should_compile/TD_TH_splice.hs b/testsuite/tests/type-data/should_compile/TD_TH_splice.hs
new file mode 100644
index 0000000000..78b5495858
--- /dev/null
+++ b/testsuite/tests/type-data/should_compile/TD_TH_splice.hs
@@ -0,0 +1,18 @@
+-- Check that splicing in a quoted declaration has the same effect as
+-- giving the declaration directly.
+{-# LANGUAGE TemplateHaskell, TypeData, GADTs #-}
+
+module TD_TH_splice where
+
+import Data.Kind (Type)
+
+-- splice should be equivalent to giving the declaration directly
+$( [d| type data Nat = Zero | Succ Nat |] )
+
+data Vec :: Nat -> Type -> Type where
+    VNil :: Vec Zero a
+    VCons :: a -> Vec n a -> Vec (Succ n) a
+
+instance Functor (Vec n) where
+    fmap _ VNil = VNil
+    fmap f (VCons x xs) = VCons (f x) (fmap f xs)
diff --git a/testsuite/tests/type-data/should_compile/all.T b/testsuite/tests/type-data/should_compile/all.T
index b5e9810b00..7042676613 100644
--- a/testsuite/tests/type-data/should_compile/all.T
+++ b/testsuite/tests/type-data/should_compile/all.T
@@ -3,4 +3,5 @@ test('TDExistential', normal, compile, [''])
 test('TDGADT', normal, compile, [''])
 test('TDGoodConsConstraints', normal, compile, [''])
 test('TDVector', normal, compile, [''])
+test('TD_TH_splice', normal, compile, [''])
 test('T22315a', [extra_files(['T22315a/'])], multimod_compile, ['T22315a.Lib T22315a.Main', '-v0'])
diff --git a/testsuite/tests/type-data/should_run/T22500.hs b/testsuite/tests/type-data/should_run/T22500.hs
new file mode 100644
index 0000000000..471b6b1d2a
--- /dev/null
+++ b/testsuite/tests/type-data/should_run/T22500.hs
@@ -0,0 +1,9 @@
+-- Check that a quoted data type declaration is printed correctly
+{-# LANGUAGE TemplateHaskellQuotes, TypeData #-}
+
+module Main where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Ppr
+
+main = putStrLn . pprint =<< runQ [d| type data Nat = Zero | Succ Nat |]
diff --git a/testsuite/tests/type-data/should_run/T22500.stdout b/testsuite/tests/type-data/should_run/T22500.stdout
new file mode 100644
index 0000000000..eadaae2eeb
--- /dev/null
+++ b/testsuite/tests/type-data/should_run/T22500.stdout
@@ -0,0 +1,3 @@
+type data Nat_0
+    = Zero_1
+    | Succ_2 Nat_0
diff --git a/testsuite/tests/type-data/should_run/all.T b/testsuite/tests/type-data/should_run/all.T
index f1faf7796e..cc1bb25df1 100644
--- a/testsuite/tests/type-data/should_run/all.T
+++ b/testsuite/tests/type-data/should_run/all.T
@@ -1,2 +1,3 @@
 test('T22332a', exit_code(1), compile_and_run, [''])
 test('T22315b', extra_files(['T22315b.hs']), ghci_script, ['T22315b.script'])
+test('T22500', normal, compile_and_run, [''])