From a1fa34ced8f317dcaa63babaf50040a7d8c68827 Mon Sep 17 00:00:00 2001
From: RyanGlScott <ryan.gl.scott@gmail.com>
Date: Mon, 11 Apr 2016 02:34:55 +0200
Subject: [PATCH] Filter out invisible kind arguments during TH reification
Previously, all kind arguments were being reified, which would cause
something like this:
```
type Id a = a
data Proxy (a :: Id k) = Proxy
```
to output
```
data Proxy (a :: Id * k) = Proxy
```
when `Proxy`'s `Info` is reified. The fix is simple: simply call
`filterOutInvisibleTypes` on the kind arguments of a kind synonym
application.
Fixes #11463.
Test Plan: ./validate
Reviewers: austin, bgamari, goldfire
Reviewed By: goldfire
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2081
GHC Trac Issues: #11463
(cherry picked from commit 02a5c580b6078630842f4c3db5d92631fada21e9)
---
compiler/typecheck/TcSplice.hs | 4 +++-
testsuite/tests/th/T11463.hs | 18 ++++++++++++++++++
testsuite/tests/th/T11463.stdout | 2 ++
testsuite/tests/th/all.T | 1 +
4 files changed, 24 insertions(+), 1 deletion(-)
create mode 100644 testsuite/tests/th/T11463.hs
create mode 100644 testsuite/tests/th/T11463.stdout
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index fc13b3ff55c6..5b9fbad97427 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -1649,12 +1649,14 @@ reifyKind ki
reify_kc_app :: TyCon -> [TyCoRep.Kind] -> TcM TH.Kind
reify_kc_app kc kis
- = fmap (mkThAppTs r_kc) (mapM reifyKind kis)
+ = fmap (mkThAppTs r_kc) (mapM reifyKind vis_kis)
where
r_kc | isTupleTyCon kc = TH.TupleT (tyConArity kc)
| kc `hasKey` listTyConKey = TH.ListT
| otherwise = TH.ConT (reifyName kc)
+ vis_kis = filterOutInvisibleTypes kc kis
+
reifyCxt :: [PredType] -> TcM [TH.Pred]
reifyCxt = mapM reifyPred
diff --git a/testsuite/tests/th/T11463.hs b/testsuite/tests/th/T11463.hs
new file mode 100644
index 000000000000..1faf5964f4d5
--- /dev/null
+++ b/testsuite/tests/th/T11463.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeInType #-}
+module Main where
+
+import Data.Kind
+import Language.Haskell.TH
+
+type Id1 a = a
+type Id2 k (a :: k) = a
+data Proxy1 (a :: Id1 k) = Proxy1
+data Proxy2 (a :: Id2 * k) = Proxy2
+
+$(return [])
+
+main :: IO ()
+main = do
+ putStrLn $(reify ''Proxy1 >>= stringE . pprint)
+ putStrLn $(reify ''Proxy2 >>= stringE . pprint)
diff --git a/testsuite/tests/th/T11463.stdout b/testsuite/tests/th/T11463.stdout
new file mode 100644
index 000000000000..d33038a10e5a
--- /dev/null
+++ b/testsuite/tests/th/T11463.stdout
@@ -0,0 +1,2 @@
+data Main.Proxy1 (a_0 :: Main.Id1 k_1) = Main.Proxy1
+data Main.Proxy2 (a_0 :: Main.Id2 * k_1) = Main.Proxy2
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index c398a3114809..905543073b3b 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -400,5 +400,6 @@ test('TH_finalizer', normal, compile, ['-v0'])
test('T10603', normal, compile, ['-ddump-splices -dsuppress-uniques'])
test('T11452', normal, compile_fail, ['-v0'])
test('T11145', normal, compile_fail, ['-v0 -dsuppress-uniques'])
+test('T11463', normal, compile_and_run, ['-v0 -dsuppress-uniques'])
test('T11680', normal, compile_fail, ['-v0'])
test('T11809', normal, compile, ['-v0'])
--
GitLab