Fix quoting 'type data' declarationswip/quote-typedata

The quote [d|type data T|] was ignoring the type data flag and
giving the same result as [d|data T|].
Instead, we now fail, until support for 'type data' in TH is implemented.

7 files changed, 23 insertions, 7 deletions

diff --git a/compiler/GHC/HsToCore/Errors/Ppr.hs b/compiler/GHC/HsToCore/Errors/Ppr.hs
index 745f701d8f..21be8d3d76 100644
--- a/compiler/GHC/HsToCore/Errors/Ppr.hs
+++ b/compiler/GHC/HsToCore/Errors/Ppr.hs
@@ -128,7 +128,7 @@ instance Diagnostic DsMessage where
              ThAmbiguousRecordUpdates fld
                -> mkMsg "Ambiguous record updates" (ppr fld)
              ThAbstractClosedTypeFamily decl
-               -> mkMsg "abstract closed type family" (ppr decl)
+               -> mkMsg "Abstract closed type family" (ppr decl)
              ThForeignLabel cls
                -> mkMsg "Foreign label" (doubleQuotes (ppr cls))
              ThForeignExport decl
@@ -168,6 +168,8 @@ instance Diagnostic DsMessage where
                -> mkMsg "Splices within declaration brackets" empty
              ThNonLinearDataCon
                -> mkMsg "Non-linear fields in data constructors" empty
+             ThTypeData
+               -> mkMsg "Type data" empty
          where
            mkMsg what doc =
              mkSimpleDecorated $
diff --git a/compiler/GHC/HsToCore/Errors/Types.hs b/compiler/GHC/HsToCore/Errors/Types.hs
index 8f6586fb45..25696f2a0e 100644
--- a/compiler/GHC/HsToCore/Errors/Types.hs
+++ b/compiler/GHC/HsToCore/Errors/Types.hs
@@ -175,6 +175,7 @@ data ThRejectionReason
   | ThWarningAndDeprecationPragmas [LIdP GhcRn]
   | ThSplicesWithinDeclBrackets
   | ThNonLinearDataCon
+  | ThTypeData
 
 data NegLiteralExtEnabled
   = YesUsingNegLiterals
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 00f770b6de..e057628687 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -528,11 +528,12 @@ repDataDefn tc opts
                                    ; ksig' <- repMaybeLTy ksig
                                    ; repNewtype cxt1 tc opts ksig' con'
                                                 derivs1 }
-           DataTypeCons _ cons -> do { ksig' <- repMaybeLTy ksig
-                               ; consL <- mapM repC cons
-                               ; cons1 <- coreListM conTyConName consL
-                               ; repData cxt1 tc opts ksig' cons1
-                                         derivs1 }
+           DataTypeCons td cons -> do { ksig' <- repMaybeLTy ksig
+                                      ; when td (notHandled ThTypeData)  -- see #22500
+                                      ; consL <- mapM repC cons
+                                      ; cons1 <- coreListM conTyConName consL
+                                      ; repData cxt1 tc opts ksig' cons1
+                                                derivs1 }
        }
 
 repSynDecl :: Core TH.Name -> Core [(M (TH.TyVarBndr ()))]
diff --git a/testsuite/tests/quotes/TH_abstractFamily.stderr b/testsuite/tests/quotes/TH_abstractFamily.stderr
index 27684e9424..5c83897009 100644
--- a/testsuite/tests/quotes/TH_abstractFamily.stderr
+++ b/testsuite/tests/quotes/TH_abstractFamily.stderr
@@ -1,5 +1,5 @@
 
 TH_abstractFamily.hs:11:7: error: [GHC-65904]
-    abstract closed type family not (yet) handled by Template Haskell
+    Abstract closed type family not (yet) handled by Template Haskell
       type family G a where
         ..
diff --git a/testsuite/tests/quotes/TH_typedata.hs b/testsuite/tests/quotes/TH_typedata.hs
new file mode 100644
index 0000000000..14cd3ac3be
--- /dev/null
+++ b/testsuite/tests/quotes/TH_typedata.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeData #-}
+module TH_typedata where
+
+import Language.Haskell.TH
+
+-- See #22500
+ds1 :: Q [Dec]
+ds1 = [d| type data T |]
diff --git a/testsuite/tests/quotes/TH_typedata.stderr b/testsuite/tests/quotes/TH_typedata.stderr
new file mode 100644
index 0000000000..8b2a41fa25
--- /dev/null
+++ b/testsuite/tests/quotes/TH_typedata.stderr
@@ -0,0 +1,3 @@
+
+TH_typedata.hs:8:7: error: [GHC-65904]
+    Type data not (yet) handled by Template Haskell
diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T
index ba580ccaf4..2c47b06502 100644
--- a/testsuite/tests/quotes/all.T
+++ b/testsuite/tests/quotes/all.T
@@ -38,6 +38,7 @@ test('TH_nested_splice', normal, compile, [''])
 test('TH_top_splice', normal, compile_fail, [''])
 test('TTH_top_splice', normal, compile_fail, [''])
 test('TH_double_splice', normal, compile_fail, [''])
+test('TH_typedata', normal, compile_fail, [''])
 test('T20688', normal, compile, ['-Wimplicit-lift -Werror'])
 test('T20893', normal, compile_and_run, [''])
 test('T21619', normal, compile, [''])