Make error when deriving an instance for a typeclass less misleading

Before, when you attempted to derive an instance for a typeclass,
e.g.,

```
class C1 (a :: Constraint) where
class C2 where

deriving instance C1 C2
```

GHC would complain that `C2`'s data constructors aren't in scope. But
that
makes no sense, since typeclasses don't have constructors! By refining
the
checks that GHC performs when deriving, we can make the error message a
little more sensible.

This also cleans up a related `DeriveAnyClass` infelicity. Before, you
wouldn't have been able to compile code like this:

```
import System.IO (Handle)
class C a
deriving instance C Handle
```

Since GHC was requiring that all data constructors of `Handle` be in
scope. But `DeriveAnyClass` doesn't even generate code that mentions
any data constructors, so this requirement is silly!

Fixes #11509.

Test Plan: make test TEST=T11509

Reviewers: simonpj, austin, bgamari

Reviewed By: simonpj, bgamari

Subscribers: thomie, simonpj

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

GHC Trac Issues: #11509

6 files changed, 85 insertions, 0 deletions

diff --git a/testsuite/tests/deriving/should_compile/T11509_2.hs b/testsuite/tests/deriving/should_compile/T11509_2.hs
new file mode 100644
index 0000000000..3071755db2
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T11509_2.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE StandaloneDeriving #-}
+module T11509_2 where
+
+import GHC.Exts (Constraint)
+
+class C1 (a :: Constraint) where
+class C2 where
+
+deriving instance C1 C2
diff --git a/testsuite/tests/deriving/should_compile/T11509_3.hs b/testsuite/tests/deriving/should_compile/T11509_3.hs
new file mode 100644
index 0000000000..c9e7263a2b
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T11509_3.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE StandaloneDeriving #-}
+module T11509_3 where
+
+import System.IO (Handle) -- A data type whose constructors are hidden
+
+class C a where
+
+deriving instance C Handle
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 1b4c8b36ad..26312df3e9 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -66,6 +66,8 @@ test('T11174', normal, compile, [''])
 test('T11416', normal, compile, [''])
 test('T11396', normal, compile, [''])
 test('T11357', normal, compile, [''])
+test('T11509_2', expect_fail, compile, [''])
+test('T11509_3', normal, compile, [''])
 test('T11732a', normal, compile, [''])
 test('T11732b', normal, compile, [''])
 test('T11732c', normal, compile, [''])
diff --git a/testsuite/tests/deriving/should_fail/T11509_1.hs b/testsuite/tests/deriving/should_fail/T11509_1.hs
new file mode 100644
index 0000000000..369f51ad39
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T11509_1.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE ConstraintKinds            #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures             #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE StaticPointers             #-}
+{-# LANGUAGE UndecidableInstances       #-}
+{-# LANGUAGE UndecidableSuperClasses    #-}
+module T11509 where
+
+import Data.Kind
+import Data.Typeable
+import GHC.StaticPtr
+
+{-------------------------------------------------------------------------------
+  Standard Cloud-Haskell-like infrastructure
+
+  See <https://ghc.haskell.org/trac/ghc/wiki/TypeableT> for a dicussion of 'SC'.
+-------------------------------------------------------------------------------}
+
+class Serializable a -- empty class, just for demonstration purposes
+
+instance Serializable a => Serializable [a]
+
+data Static :: * -> * where
+  StaticPtr :: StaticPtr a -> Static a
+  StaticApp :: Static (a -> b) -> Static a -> Static b
+
+staticApp :: StaticPtr (a -> b) -> Static a -> Static b
+staticApp = StaticApp .  StaticPtr
+
+data Dict :: Constraint -> * where
+  Dict :: c => Dict c
+
+class c => SC c where
+  dict :: Static (Dict c)
+
+instance (Typeable a, SC (Serializable a)) => SC (Serializable [a]) where
+  dict = aux `staticApp` dict
+    where
+      aux :: StaticPtr (Dict (Serializable a) -> Dict (Serializable [a]))
+      aux = static (\Dict -> Dict)
+
+{-------------------------------------------------------------------------------
+  Demonstrate the bug
+-------------------------------------------------------------------------------}
+
+newtype MyList a = MyList [a]
+
+deriving instance (Typeable a, SC (Serializable a)) => SC (Serializable (MyList a))
diff --git a/testsuite/tests/deriving/should_fail/T11509_1.stderr b/testsuite/tests/deriving/should_fail/T11509_1.stderr
new file mode 100644
index 0000000000..a50310e50b
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T11509_1.stderr
@@ -0,0 +1,7 @@
+
+T11509_1.hs:52:1: error:
+    • Can't make a derived instance of ‘SC (Serializable (MyList a))’:
+        ‘Serializable’ is a type class, and can only have a derived instance
+        if DeriveAnyClass is enabled
+    • In the stand-alone deriving instance for
+        ‘(Typeable a, SC (Serializable a)) => SC (Serializable (MyList a))’
diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T
index ce0cc0f155..5fec71eff5 100644
--- a/testsuite/tests/deriving/should_fail/all.T
+++ b/testsuite/tests/deriving/should_fail/all.T
@@ -64,5 +64,7 @@ test('T10598_fail3', normal, compile_fail, [''])
 test('T10598_fail4', normal, compile_fail, [''])
 test('T10598_fail5', normal, compile_fail, [''])
 test('T10598_fail6', normal, compile_fail, [''])
+test('T11509_1', [when(doing_ghci(), extra_hc_opts('-fobject-code'))],
+     compile_fail, [''])
 test('T12163', normal, compile_fail, [''])
 test('T12512', omit_ways(['ghci']), compile_fail, [''])