reify associated types when reifying typeclasses

As reported in Trac #10891, Template Haskell's `reify` was not generating Decls
for associated types. This patch fixes that.

Note that even though `reifyTyCon` function used in this patch returns some
type instances, I'm ignoring that.

Here's an example of how associated types are encoded with this patch:

(Simplified representation)

    class C a where
      type F a :: *

    -->

    OpenTypeFamilyD "F" ["a"]

With default type instances:

    class C a where
      type F a :: *
      type F a = a

    -->

    OpenTypeFamilyD "F" ["a"]
    TySynInstD "F" (TySynEqn [VarT "a"] "a")

Reviewed By: goldfire

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

GHC Trac Issues: #10891

4 files changed, 54 insertions, 0 deletions

diff --git a/testsuite/tests/th/T10891.hs b/testsuite/tests/th/T10891.hs
new file mode 100644
index 0000000000..d91caf94f6
--- /dev/null
+++ b/testsuite/tests/th/T10891.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T10891 where
+
+import Language.Haskell.TH
+import System.IO
+
+class C a where
+  f :: a -> Int
+
+class C' a where
+  type F a :: *
+  type F a = a
+  f' :: a -> Int
+
+class C'' a where
+  data Fd a :: *
+
+instance C' Int where
+  type F Int = Bool
+  f' = id
+
+instance C'' Int where
+  data Fd Int = B Bool | C Char
+
+$(return [])
+
+test :: ()
+test =
+  $(let
+      display :: Name -> Q ()
+      display q = do
+        i <- reify q
+        runIO (hPutStrLn stderr (pprint i) >> hFlush stderr)
+    in do
+      display ''C
+      display ''C'
+      display ''C''
+      [| () |])
diff --git a/testsuite/tests/th/T10891.stderr b/testsuite/tests/th/T10891.stderr
new file mode 100644
index 0000000000..874f4f0890
--- /dev/null
+++ b/testsuite/tests/th/T10891.stderr
@@ -0,0 +1,12 @@
+class T10891.C (a_0 :: *)
+    where T10891.f :: forall (a_0 :: *) . T10891.C a_0 =>
+                                          a_0 -> GHC.Types.Int
+class T10891.C' (a_0 :: *)
+    where type T10891.F (a_0 :: *) :: *
+          type T10891.F a_0 = a_0
+          T10891.f' :: forall (a_0 :: *) . T10891.C' a_0 =>
+                                           a_0 -> GHC.Types.Int
+instance T10891.C' GHC.Types.Int
+class T10891.C'' (a_0 :: *)
+    where data T10891.Fd (a_0 :: *) :: *
+instance T10891.C'' GHC.Types.Int
diff --git a/testsuite/tests/th/TH_reifyDecl1.stderr b/testsuite/tests/th/TH_reifyDecl1.stderr
index 503f5331f0..e65558774a 100644
--- a/testsuite/tests/th/TH_reifyDecl1.stderr
+++ b/testsuite/tests/th/TH_reifyDecl1.stderr
@@ -20,6 +20,8 @@ class TH_reifyDecl1.C2 (a_0 :: *)
                                                   a_0 -> GHC.Types.Int
 instance TH_reifyDecl1.C2 GHC.Types.Int
 class TH_reifyDecl1.C3 (a_0 :: *)
+    where type TH_reifyDecl1.AT1 (a_0 :: *) :: *
+          data TH_reifyDecl1.AT2 (a_0 :: *) :: *
 instance TH_reifyDecl1.C3 GHC.Types.Int
 type family TH_reifyDecl1.AT1 (a_0 :: *) :: *
 type instance TH_reifyDecl1.AT1 GHC.Types.Int = GHC.Types.Bool
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index f72cc30f81..9d4736c10f 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -359,3 +359,4 @@ test('T6018th', normal, compile_fail, ['-v0'])
 test('TH_namePackage', normal, compile_and_run, ['-v0'])
 test('T10811', normal, compile, ['-v0'])
 test('T10810', normal, compile, ['-v0'])
+test('T10891', normal, compile, ['-v0'])