From 0f6fb7d309cbe69dcd534c14155d68c981895ab2 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Thu, 29 Jul 2021 11:22:07 +0100
Subject: TypeError is OK on the RHS of a type synonym

We should not complain about TypeError in
  type T = TypeError blah

This fixes #20181

The error message for T13271 changes, because that test did
indeed have a type synonym with TypeError on the RHS
---
 compiler/GHC/Tc/Validity.hs                        | 11 +++++++---
 .../tests/indexed-types/should_fail/T13271.stderr  | 24 +++++++++++++++++++---
 testsuite/tests/typecheck/should_compile/T20181.hs |  8 ++++++++
 testsuite/tests/typecheck/should_compile/all.T     |  3 ++-
 4 files changed, 39 insertions(+), 7 deletions(-)
 create mode 100644 testsuite/tests/typecheck/should_compile/T20181.hs

diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index 3445270c9a..4c141ce082 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -241,7 +241,7 @@ wantAmbiguityCheck ctxt
       StandaloneKindSigCtxt{} -> False
       _            -> True
 
-checkUserTypeError :: Type -> TcM ()
+checkUserTypeError :: UserTypeCtxt -> Type -> TcM ()
 -- Check to see if the type signature mentions "TypeError blah"
 -- anywhere in it, and fail if so.
 --
@@ -250,7 +250,12 @@ checkUserTypeError :: Type -> TcM ()
 -- user-supplied one.  This is really only a half-baked fix;
 -- the other errors in checkValidType don't do tidying, and so
 -- may give bad error messages when given an inferred type.
-checkUserTypeError = check
+checkUserTypeError ctxt ty
+  | TySynCtxt {} <- ctxt  -- Do not complain about TypeError on the
+  = return ()             -- RHS of type synonyms. See #20181
+
+  | otherwise
+  = check ty
   where
   check ty
     | Just msg     <- userTypeError_maybe ty      = fail_with msg
@@ -393,7 +398,7 @@ checkValidType ctxt ty
        -- (and more complicated) errors in checkAmbiguity
        ; checkNoErrs $
          do { check_type ve ty
-            ; checkUserTypeError ty
+            ; checkUserTypeError ctxt ty
             ; traceTc "done ct" (ppr ty) }
 
        -- Check for ambiguous types.  See Note [When to call checkAmbiguity]
diff --git a/testsuite/tests/indexed-types/should_fail/T13271.stderr b/testsuite/tests/indexed-types/should_fail/T13271.stderr
index e28dcea3c2..5899110be4 100644
--- a/testsuite/tests/indexed-types/should_fail/T13271.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T13271.stderr
@@ -1,4 +1,22 @@
 
-T13271.hs:9:1: error:
-    • You can't do that!
-    • In the type synonym declaration for ‘T2’
+T13271.hs:12:3: error:
+    • Type family equation right-hand sides overlap; this violates
+      the family's injectivity annotation:
+        X 1 = T1 -- Defined at T13271.hs:12:3
+        X 2 = T2 -- Defined at T13271.hs:13:3
+    • In the equations for closed type family ‘X’
+      In the type family declaration for ‘X’
+
+T13271.hs:13:3: error:
+    • Type family equation violates the family's injectivity annotation.
+      RHS of injective type family equation cannot be a type family:
+        X 2 = T2 -- Defined at T13271.hs:13:3
+    • In the equations for closed type family ‘X’
+      In the type family declaration for ‘X’
+
+T13271.hs:13:3: error:
+    • The type family application ‘(TypeError ...)’
+        is no smaller than the instance head ‘X 2’
+      (Use UndecidableInstances to permit this)
+    • In the equations for closed type family ‘X’
+      In the type family declaration for ‘X’
diff --git a/testsuite/tests/typecheck/should_compile/T20181.hs b/testsuite/tests/typecheck/should_compile/T20181.hs
new file mode 100644
index 0000000000..889b3db149
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T20181.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE DataKinds #-}
+
+module T20181 where
+
+import GHC.TypeLits( TypeError, ErrorMessage(..) )
+
+-- This should be fine
+type Foo = TypeError (Text "foo")
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 83688dbb9b..7498e23a8e 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -793,5 +793,6 @@ test('T18481a', normal, compile, [''])
 test('T19775', normal, compile, [''])
 test('T17817b', normal, compile, [''])
 test('T20033', normal, compile, [''])
-
 test('TypeRepCon', normal, compile, ['-Woverlapping-patterns'])
+test('T20181', normal, compile, [''])
+
-- 
cgit v1.2.1