Fix #8773.

To make a role annotation on a class asserting a role other than
nominal, you now need -XIncoherentInstances. See the ticket for
more information as to why this is a good idea.

(cherry picked from commit 13829758)

compiler/typecheck/TcTyClsDecls.lhs

@@ -1694,6 +1694,15 @@ checkValidRoleAnnots role_annots thing
                 ; checkTc (type_vars `equalLength` the_role_annots)
                           (wrongNumberOfRoles type_vars decl)
                 ; _ <- zipWith3M checkRoleAnnot type_vars the_role_annots type_roles
+                -- Representational or phantom roles for class parameters
+                -- quickly lead to incoherence. So, we require
+                -- IncoherentInstances to have them. See #8773.
+                ; incoherent_roles_ok <- xoptM Opt_IncoherentInstances
+                ; checkTc (  incoherent_roles_ok
+                          || (not $ isClassTyCon tc)
+                          || (all (== Nominal) type_roles))
+                          incoherentRoles
+                  
                 ; lint <- goptM Opt_DoCoreLinting
                 ; when lint $ checkValidRoles tc }
 
@@ -2180,6 +2189,11 @@ needXRoleAnnotations tc
   = ptext (sLit "Illegal role annotation for") <+> ppr tc <> char ';' $$
     ptext (sLit "did you intend to use RoleAnnotations?")
 
+incoherentRoles :: SDoc
+incoherentRoles = (text "Roles other than" <+> quotes (text "nominal") <+>
+                   text "for class parameters can lead to incoherence.") $$
+                  (text "Use IncoherentInstances to allow this; bad role found")
+
 addTyThingCtxt :: TyThing -> TcM a -> TcM a
 addTyThingCtxt thing
   = addErrCtxt ctxt

testsuite/tests/roles/should_compile/Roles14.hs

+{-# LANGUAGE RoleAnnotations, IncoherentInstances #-}
+
+module Roles12 where
+
+type role C2 representational
+class C2 a where
+  meth2 :: a -> a

testsuite/tests/roles/should_compile/Roles14.stderr

+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+  C2 :: * -> Constraint
+  class C2 a
+    Roles: [representational]
+    RecFlag NonRecursive
+    meth2 :: a -> a
+COERCION AXIOMS
+  axiom Roles12.NTCo:C2 :: C2 a = a -> a
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
+
+==================== Typechecker ====================
+

testsuite/tests/roles/should_compile/Roles4.hs

@@ -6,10 +6,6 @@ type role C1 nominal
 class C1 a where
   meth1 :: a -> a
 
-type role C2 representational
-class C2 a where
-  meth2 :: a -> a
-
 type Syn1 a = [a]
 
 class C3 a where

testsuite/tests/roles/should_compile/Roles4.stderr

@@ -5,11 +5,6 @@ TYPE CONSTRUCTORS
     Roles: [nominal]
     RecFlag NonRecursive
     meth1 :: a -> a
-  C2 :: * -> Constraint
-  class C2 a
-    Roles: [representational]
-    RecFlag NonRecursive
-    meth2 :: a -> a
   C3 :: * -> Constraint
   class C3 a
     Roles: [nominal]
@@ -19,7 +14,6 @@ TYPE CONSTRUCTORS
   type Syn1 a = [a]
 COERCION AXIOMS
   axiom Roles4.NTCo:C1 :: C1 a = a -> a
-  axiom Roles4.NTCo:C2 :: C2 a = a -> a
   axiom Roles4.NTCo:C3 :: C3 a = a -> Syn1 a
 Dependent modules: []
 Dependent packages: [base, ghc-prim, integer-gmp]

testsuite/tests/roles/should_compile/all.T

@@ -3,4 +3,5 @@ test('Roles2', only_ways('normal'), compile, ['-ddump-tc'])
 test('Roles3', only_ways('normal'), compile, ['-ddump-tc'])
 test('Roles4', only_ways('normal'), compile, ['-ddump-tc'])
 test('Roles13', only_ways('normal'), compile, ['-ddump-simpl -dsuppress-uniques'])
+test('Roles14', only_ways('normal'), compile, ['-ddump-tc'])
 test('RolesIArray', only_ways('normal'), compile, [''])
\ No newline at end of file

testsuite/tests/roles/should_fail/T8773.hs

+{-# LANGUAGE RoleAnnotations #-}
+
+module T8773 where
+
+type role C2 representational
+class C2 a where
+  meth2 :: a -> a

testsuite/tests/roles/should_fail/T8773.stderr

+
+T8773.hs:5:1:
+    Roles other than ‛nominal’ for class parameters can lead to incoherence.
+    Use IncoherentInstances to allow this; bad role found
+    while checking a role annotation for ‛C2’

testsuite/tests/roles/should_fail/all.T

@@ -7,3 +7,4 @@ test('Roles11', normal, compile_fail, [''])
 test('Roles12',
      extra_clean(['Roles12.o-boot', 'Roles12.hi-boot']),
      run_command, ['$MAKE --no-print-directory -s Roles12'])
+test('T8773', normal, compile_fail, [''])
\ No newline at end of file