Forbid standalone instances for built-in classes

  `check_special_inst_head` includes logic that disallows hand-written
  instances for built-in classes such as Typeable, KnownNat
  and KnownSymbol.
  However, it also allowed standalone deriving declarations. This was
  because we do want to allow standalone deriving instances with
  Typeable as they are harmless, but we certainly don't want to allow
  instances for e.g. KnownNat.

  This patch ensures that we don't allow derived instances for
  KnownNat, KnownSymbol (and also KnownChar, which was previously
  omitted entirely).

  Fixes #21087

8 files changed, 75 insertions, 14 deletions

diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index cad2ea1796..8be1944651 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -1385,21 +1385,24 @@ check_special_inst_head dflags is_boot is_sig ctxt clas cls_args
   , not is_boot
   = failWithTc (TcRnAbstractClassInst clas)
 
-  -- For Typeable, don't complain about instances for
-  -- standalone deriving; they are no-ops, and we warn about
-  -- it in GHC.Tc.Deriv.deriveStandalone.
+  -- Complain about hand-written instances of built-in classes
+  -- Typeable, KnownNat, KnownSymbol, Coercible, HasField.
+
+  -- Disallow hand-written Typeable instances, except that we
+  -- allow a standalone deriving declaration: they are no-ops,
+  -- and we warn about them in GHC.Tc.Deriv.deriveStandalone.
   | clas_nm == typeableClassName
   , not is_sig
     -- Note [Instances of built-in classes in signature files]
   , hand_written_bindings
   = failWithTc $ TcRnSpecialClassInst clas False
 
-  -- Handwritten instances of KnownNat/KnownSymbol
-  -- are forbidden outside of signature files (#12837)
-  | clas_nm `elem` [ knownNatClassName, knownSymbolClassName ]
-  , not is_sig
+  -- Handwritten instances of KnownNat/KnownChar/KnownSymbol
+  -- are forbidden outside of signature files (#12837).
+  -- Derived instances are forbidden completely (#21087).
+  | clas_nm `elem` [ knownNatClassName, knownSymbolClassName, knownCharClassName ]
+  , (not is_sig && hand_written_bindings) || derived_instance
     -- Note [Instances of built-in classes in signature files]
-  , hand_written_bindings
   = failWithTc $ TcRnSpecialClassInst clas False
 
   -- For the most part we don't allow
@@ -1438,12 +1441,18 @@ check_special_inst_head dflags is_boot is_sig ctxt clas cls_args
     ty_args = filterOutInvisibleTypes (classTyCon clas) cls_args
 
     hand_written_bindings
-        = case ctxt of
-            InstDeclCtxt stand_alone -> not stand_alone
-            SpecInstCtxt             -> False
-            DerivClauseCtxt          -> False
-            SigmaCtxt                -> False
-            _                        -> True
+      = case ctxt of
+          InstDeclCtxt standalone -> not standalone
+          SpecInstCtxt            -> False
+          DerivClauseCtxt         -> False
+          SigmaCtxt               -> False
+          _                       -> True
+
+    derived_instance
+      = case ctxt of
+            InstDeclCtxt standalone -> standalone
+            DerivClauseCtxt         -> True
+            _                       -> False
 
     check_h98_arg_shape = case ctxt of
                             SpecInstCtxt    -> False
diff --git a/testsuite/tests/deriving/should_fail/T21087.hs b/testsuite/tests/deriving/should_fail/T21087.hs
new file mode 100644
index 0000000000..730dbac153
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T21087.hs
@@ -0,0 +1,11 @@
+{-# language DataKinds #-}
+{-# language DerivingVia #-}
+{-# language TypeFamilies #-}
+
+module T21087 where
+
+import GHC.TypeLits
+
+data family Z :: k
+
+deriving via 0 instance KnownNat Z
diff --git a/testsuite/tests/deriving/should_fail/T21087.stderr b/testsuite/tests/deriving/should_fail/T21087.stderr
new file mode 100644
index 0000000000..8e40f6e641
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T21087.stderr
@@ -0,0 +1,4 @@
+
+T21087.hs:11:25: error:
+    • Class ‘KnownNat’ does not support user-specified instances.
+    • In the stand-alone deriving instance for ‘KnownNat Z’
diff --git a/testsuite/tests/deriving/should_fail/T21087b.hs b/testsuite/tests/deriving/should_fail/T21087b.hs
new file mode 100644
index 0000000000..522c1603a7
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T21087b.hs
@@ -0,0 +1,3 @@
+module T21087b where
+
+import {-# SOURCE #-} T21087b_aux
diff --git a/testsuite/tests/deriving/should_fail/T21087b.stderr b/testsuite/tests/deriving/should_fail/T21087b.stderr
new file mode 100644
index 0000000000..4caee4928e
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T21087b.stderr
@@ -0,0 +1,10 @@
+[1 of 3] Compiling T21087b_aux[boot] ( T21087b_aux.hs-boot, T21087b_aux.o-boot )
+
+T21087b_aux.hs-boot:11:25: error:
+    • Class ‘KnownNat’ does not support user-specified instances.
+    • In the stand-alone deriving instance for ‘KnownNat Z’
+[3 of 3] Compiling T21087b_aux      ( T21087b_aux.hs, T21087b_aux.o )
+
+T21087b_aux.hs:11:25: error:
+    • Class ‘KnownNat’ does not support user-specified instances.
+    • In the stand-alone deriving instance for ‘KnownNat Z’
diff --git a/testsuite/tests/deriving/should_fail/T21087b_aux.hs b/testsuite/tests/deriving/should_fail/T21087b_aux.hs
new file mode 100644
index 0000000000..2cccf704ea
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T21087b_aux.hs
@@ -0,0 +1,11 @@
+{-# language DataKinds #-}
+{-# language DerivingVia #-}
+{-# language TypeFamilies #-}
+
+module T21087b_aux where
+
+import GHC.TypeLits
+
+data family Z :: k
+
+deriving via 0 instance KnownNat Z
diff --git a/testsuite/tests/deriving/should_fail/T21087b_aux.hs-boot b/testsuite/tests/deriving/should_fail/T21087b_aux.hs-boot
new file mode 100644
index 0000000000..2cccf704ea
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T21087b_aux.hs-boot
@@ -0,0 +1,11 @@
+{-# language DataKinds #-}
+{-# language DerivingVia #-}
+{-# language TypeFamilies #-}
+
+module T21087b_aux where
+
+import GHC.TypeLits
+
+data family Z :: k
+
+deriving via 0 instance KnownNat Z
diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T
index 70bd0f9dbe..61d74b72b4 100644
--- a/testsuite/tests/deriving/should_fail/all.T
+++ b/testsuite/tests/deriving/should_fail/all.T
@@ -80,3 +80,5 @@ test('deriving-via-fail2', normal, compile_fail, [''])
 test('deriving-via-fail3', normal, compile_fail, [''])
 test('deriving-via-fail4', normal, compile_fail, [''])
 test('deriving-via-fail5', normal, compile_fail, [''])
+test('T21087', normal, compile_fail, [''])
+test('T21087b', [extra_files(['T21087b_aux.hs','T21087b_aux.hs-boot'])], multimod_compile_fail, ['T21087b', ''])