Disallow users to write instances of KnownNat and KnownSym

As noted in #12837, these classes are special and the user should
not be able to define their own instances.

Test Plan: Validate

Reviewers: adamgundry, goldfire, mpickering, austin, bgamari

Reviewed By: goldfire, mpickering

Subscribers: goldfire, mpickering, thomie

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

GHC Trac Issues: #12837

4 files changed, 37 insertions, 7 deletions

diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index dbc818b140..8d8d23dd77 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -46,7 +46,8 @@ import Class
 import Var
 import VarEnv
 import VarSet
-import PrelNames  ( typeableClassName, genericClassNames )
+import PrelNames  ( typeableClassName, genericClassNames
+                  , knownNatClassName, knownSymbolClassName )
 import Bag
 import BasicTypes
 import DynFlags
@@ -518,9 +519,10 @@ doClsInstErrorChecks inst_info
          -- In hs-boot files there should be no bindings
       ; failIfTc (is_boot && not no_binds) badBootDeclErr
 
-         -- Handwritten instances of the poly-kinded Typeable
-         -- class are always forbidden
-      ; failIfTc (clas_nm == typeableClassName) typeable_err
+         -- Handwritten instances of any rejected
+         -- class is always forbidden
+         -- #12837
+      ; failIfTc (clas_nm `elem` rejectedClassNames) clas_err
 
          -- Check for hand-written Generic instances (disallowed in Safe Haskell)
       ; when (clas_nm `elem` genericClassNames) $
@@ -538,11 +540,14 @@ doClsInstErrorChecks inst_info
                          text "Replace the following instance:")
                       2 (pprInstanceHdr ispec)
 
-    -- Report an error or a warning for a Typeable instances.
+    -- Report an error or a warning for certain class instances.
     -- If we are working on an .hs-boot file, we just report a warning,
     -- and ignore the instance.  We do this, to give users a chance to fix
     -- their code.
-    typeable_err = text "Class" <+> quotes (ppr clas_nm)
+    rejectedClassNames = [ typeableClassName
+                         , knownNatClassName
+                         , knownSymbolClassName ]
+    clas_err = text "Class" <+> quotes (ppr clas_nm)
                     <+> text "does not support user-specified instances"
 
 {-
diff --git a/testsuite/tests/typecheck/should_fail/T12837.hs b/testsuite/tests/typecheck/should_fail/T12837.hs
new file mode 100644
index 0000000000..414d3331ee
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T12837.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+module T12837 where
+
+import GHC.TypeLits
+import Data.Typeable
+
+data K = K
+
+instance Typeable K
+instance KnownNat n
+instance KnownSymbol n
diff --git a/testsuite/tests/typecheck/should_fail/T12837.stderr b/testsuite/tests/typecheck/should_fail/T12837.stderr
new file mode 100644
index 0000000000..893575f08c
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T12837.stderr
@@ -0,0 +1,12 @@
+
+T12837.hs:10:1: error:
+    • Class ‘Typeable’ does not support user-specified instances
+    • In the instance declaration for ‘Typeable K’
+    
+T12837.hs:11:1: error:
+    • Class ‘KnownNat’ does not support user-specified instances
+    • In the instance declaration for ‘KnownNat n’
+
+T12837.hs:12:1: error:
+    • Class ‘KnownSymbol’ does not support user-specified instances
+    • In the instance declaration for ‘KnownSymbol n’
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 69add40cab..df3f5c8aa5 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -432,4 +432,5 @@ test('T12529', normal, compile_fail, [''])
 test('T12729', normal, compile_fail, [''])
 test('T12803', normal, compile_fail, [''])
 test('T12042', extra_clean(['T12042a.hi', 'T12042a.o', 'T12042.hi-boot', 'T12042.o-boot']), multimod_compile_fail, ['T12042', ''])
-test('T12966', normal, compile_fail, [''])
\ No newline at end of file
+test('T12966', normal, compile_fail, [''])
+test('T12837', normal, compile_fail, [''])