Permit empty closed type families

Fixes #9840 and #10306, and includes an alternative resolution to #8028.
This permits empty closed type families, and documents them in the user
guide. It updates the Haddock submodule to support the API change.

Test Plan: Added `indexed-types/should_compile/T9840` and updated
`indexed-types/should_fail/ClosedFam4` and `th/T8028`.

Reviewers: austin, simonpj, goldfire

Reviewed By: goldfire

Subscribers: bgamari, jstolarek, thomie, goldfire

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

GHC Trac Issues: #9840, #10306

12 files changed, 84 insertions, 9 deletions

diff --git a/testsuite/tests/indexed-types/should_compile/T9840.hs b/testsuite/tests/indexed-types/should_compile/T9840.hs
new file mode 100644
index 0000000000..2584be6a99
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T9840.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T9840 where
+
+import T9840a
+
+type family X :: * -> * where
+
+type family F (a :: * -> *) where
+
+foo :: G (F X) -> G (F X)
+foo x = x
diff --git a/testsuite/tests/indexed-types/should_compile/T9840.hs-boot b/testsuite/tests/indexed-types/should_compile/T9840.hs-boot
new file mode 100644
index 0000000000..36fb05892e
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T9840.hs-boot
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T9840 where
+
+-- X is an abstract type family (it might be empty or not, though it
+-- will turn out to be empty when we check the hs file)
+type family X :: * -> * where ..
+
+-- F is known to be empty in the hs-boot file
+type family F (a :: * -> *) where
diff --git a/testsuite/tests/indexed-types/should_compile/T9840a.hs b/testsuite/tests/indexed-types/should_compile/T9840a.hs
new file mode 100644
index 0000000000..dab6e044f5
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T9840a.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T9840a where
+
+import {-# SOURCE #-} T9840
+
+type family G a where
+
+bar :: X a -> X a
+bar = id
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T
index 20f2c0a07b..27bb8532b5 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -249,6 +249,10 @@ test('Sock', normal, compile, [''])
 test('T9211', normal, compile, [''])
 test('T9747', normal, compile, [''])
 test('T9582', normal, compile, [''])
+test('T9840',
+     extra_clean(['T9840.hi-boot', 'T9840.o-boot', 'T9840a.hi', 'T9840a.o']),
+     multimod_compile,
+     ['T9840', '-v0'])
 test('T9090', normal, compile, [''])
 test('T10020', normal, compile, [''])
 test('T10079', normal, compile, [''])
diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam4.hs b/testsuite/tests/indexed-types/should_fail/ClosedFam4.hs
index 348278ecb2..a170cfa2ad 100644
--- a/testsuite/tests/indexed-types/should_fail/ClosedFam4.hs
+++ b/testsuite/tests/indexed-types/should_fail/ClosedFam4.hs
@@ -2,4 +2,4 @@
 
 module ClosedFam4 where
 
-type family Foo a where ..
\ No newline at end of file
+type family Foo a where ..
diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr b/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr
index 2ba73e19ab..ac68f1acde 100644
--- a/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr
+++ b/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr
@@ -1,5 +1,5 @@
 
 ClosedFam4.hs:5:1:
-    You may omit the equations in a closed type family
+    You may define an abstract closed type family
     only in a .hs-boot file
     In the type family declaration for ‘Foo’
diff --git a/testsuite/tests/th/T10306.hs b/testsuite/tests/th/T10306.hs
new file mode 100644
index 0000000000..b93114b61c
--- /dev/null
+++ b/testsuite/tests/th/T10306.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE TemplateHaskell, TypeFamilies #-}
+
+module T10306 where
+
+import Language.Haskell.TH
+import GHC.TypeLits
+
+-- Attempting to reify a built-in type family like (+) previously
+-- caused a crash, because it has no equations
+$(do x <- reify ''(+)
+     case x of
+       FamilyI (ClosedTypeFamilyD _ _ _ []) _ -> return []
+       _                                      -> error $ show x
+ )
diff --git a/testsuite/tests/th/T8028.hs b/testsuite/tests/th/T8028.hs
index fec993a596..6145428aaf 100644
--- a/testsuite/tests/th/T8028.hs
+++ b/testsuite/tests/th/T8028.hs
@@ -1,7 +1,17 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, TypeFamilies #-}
 
 module T8028 where
 
 import T8028a
 
-$(x)
\ No newline at end of file
+import Language.Haskell.TH
+
+$(x)
+
+-- Check that the empty closed type family F produced by $(x) can
+-- subsequently be reified
+$(do f <- reify ''F
+     case f of
+       FamilyI (ClosedTypeFamilyD _ _ _ []) _ -> return []
+       _                                      -> error $ show f
+ )
diff --git a/testsuite/tests/th/T8028.stderr b/testsuite/tests/th/T8028.stderr
deleted file mode 100644
index 20cf1c7cf2..0000000000
--- a/testsuite/tests/th/T8028.stderr
+++ /dev/null
@@ -1,4 +0,0 @@
-
-T8028.hs:7:3:
-    Illegal empty closed type family
-    When splicing a TH declaration: type family F_0 where
diff --git a/testsuite/tests/th/TH_abstractFamily.hs b/testsuite/tests/th/TH_abstractFamily.hs
new file mode 100644
index 0000000000..78d7e43931
--- /dev/null
+++ b/testsuite/tests/th/TH_abstractFamily.hs
@@ -0,0 +1,11 @@
+module TH_abstractFamily where
+
+import Language.Haskell.TH
+
+-- Empty closed type families are okay...
+ds1 :: Q [Dec]
+ds1 = [d| type family F a where |]
+
+-- ...but abstract ones should result in a type error
+ds2 :: Q [Dec]
+ds2 = [d| type family G a where .. |]
diff --git a/testsuite/tests/th/TH_abstractFamily.stderr b/testsuite/tests/th/TH_abstractFamily.stderr
new file mode 100644
index 0000000000..c0aa8d274b
--- /dev/null
+++ b/testsuite/tests/th/TH_abstractFamily.stderr
@@ -0,0 +1,5 @@
+
+TH_abstractFamily.hs:11:7:
+    abstract closed type family not (yet) handled by Template Haskell
+      type family G a where
+        ..
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 3bc738667d..b7c241990a 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -285,7 +285,7 @@ test('ClosedFam2TH', normal, compile, ['-v0'])
 
 test('T8028',
      extra_clean(['T8028a.hi', 'T8028a.o']),
-     multimod_compile_fail,
+     multimod_compile,
      ['T8028', '-v0 ' + config.ghc_th_way_flags])
 
 test('TH_Roles1', normal, compile_fail, ['-v0'])
@@ -360,3 +360,6 @@ test('T8624', normal, run_command, ['$MAKE -s --no-print-directory T8624'])
 test('TH_Lift', normal, compile, ['-v0'])
 test('T10047', normal, ghci_script, ['T10047.script'])
 test('T10019', normal, ghci_script, ['T10019.script'])
+test('T10306', normal, compile, ['-v0'])
+
+test('TH_abstractFamily', normal, compile_fail, [''])