Fix #14869 by being more mindful of Type vs. Constraint

Summary:
Before, we were using `isLiftedTypeKind` in `reifyType`
before checking if a type was `Constraint`. But as it turns out,
`isLiftedTypeKind` treats `Constraint` the same as `Type`, so every
occurrence of `Constraint` would be reified as `Type`! To make things
worse, the documentation for `isLiftedTypeKind` stated that it
treats `Constraint` //differently// from `Type`, which simply isn't
true.

This revises the documentation for `isLiftedTypeKind` to reflect
reality, and defers the `isLiftedTypeKind` check in `reifyType` so
that it does not accidentally swallow `Constraint`.

Test Plan: make test TEST=T14869

Reviewers: goldfire, bgamari

Reviewed By: goldfire

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #14869

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

3 files changed, 44 insertions, 0 deletions

diff --git a/testsuite/tests/th/T14869.hs b/testsuite/tests/th/T14869.hs
new file mode 100644
index 0000000000..c58d4e2720
--- /dev/null
+++ b/testsuite/tests/th/T14869.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+module T14869 where
+
+import Data.Kind
+import GHC.Exts
+import Language.Haskell.TH (pprint, reify, stringE)
+
+type MyConstraint = Constraint
+type MyLiftedRep  = LiftedRep
+
+type family Foo1 :: Type
+type family Foo2 :: Constraint
+type family Foo3 :: MyConstraint
+type family Foo4 :: TYPE MyLiftedRep
+
+$(pure [])
+
+foo1, foo2, foo3 :: String
+foo1 = $(reify ''Foo1 >>= stringE . pprint)
+foo2 = $(reify ''Foo2 >>= stringE . pprint)
+foo3 = $(reify ''Foo3 >>= stringE . pprint)
+foo4 = $(reify ''Foo4 >>= stringE . pprint)
diff --git a/testsuite/tests/th/T14869.stderr b/testsuite/tests/th/T14869.stderr
new file mode 100644
index 0000000000..a2776b8cc8
--- /dev/null
+++ b/testsuite/tests/th/T14869.stderr
@@ -0,0 +1,17 @@
+T14869.hs:19:3-9: Splicing declarations pure [] ======>
+T14869.hs:22:10-42: Splicing expression
+    reify ''Foo1 >>= stringE . pprint
+  ======>
+    "type family T14869.Foo1 :: *"
+T14869.hs:23:10-42: Splicing expression
+    reify ''Foo2 >>= stringE . pprint
+  ======>
+    "type family T14869.Foo2 :: Constraint"
+T14869.hs:24:10-42: Splicing expression
+    reify ''Foo3 >>= stringE . pprint
+  ======>
+    "type family T14869.Foo3 :: T14869.MyConstraint"
+T14869.hs:25:10-42: Splicing expression
+    reify ''Foo4 >>= stringE . pprint
+  ======>
+    "type family T14869.Foo4 :: *"
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index b51059ca1c..f391012d2b 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -404,5 +404,7 @@ test('T14838', [], multimod_compile,
 test('T14817', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T14843', normal, compile, ['-v0'])
 test('T13776', normal, compile, ['-ddump-splices -v0'])
+test('T14869', normal, compile,
+    ['-v0 -ddump-splices -dsuppress-uniques ' + config.ghc_th_way_flags])
 test('T14888', normal, compile,
     ['-v0 -ddump-splices -dsuppress-uniques ' + config.ghc_th_way_flags])