[commit: ghc] master: Handle over-applied custom type errors too. (6ea24af)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6ea24af9f22f6ea661d79623135f4cd31e28c6a2/ghc

>---------------------------------------------------------------

commit 6ea24af9f22f6ea661d79623135f4cd31e28c6a2
Author: Iavor S. Diatchki <diatchki at galois.com>
Date:   Wed Jan 13 11:30:40 2016 -0800

    Handle over-applied custom type errors too.
    
    Consider
    
        type family F :: Type -> Type where
           F = TypeError (Text "Error")
    
    Now, if we see something like `F Int` we should still report the custom
    type error.


>---------------------------------------------------------------

6ea24af9f22f6ea661d79623135f4cd31e28c6a2
 compiler/typecheck/TcRnTypes.hs | 6 +++---
 compiler/types/Type.hs          | 5 ++++-
 2 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 6beff7f..430a97d 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -1733,9 +1733,9 @@ isTypeHoleCt (CHoleCan { cc_hole = TypeHole }) = True
 isTypeHoleCt _ = False
 
 -- | The following constraints are considered to be a custom type error:
---    1. TypeError msg
---    2. TypeError msg ~ Something  (and the other way around)
---    3. C (TypeError msg)          (for any parameter of class constraint)
+--    1. TypeError msg a b c
+--    2. TypeError msg a b c ~ Something (and the other way around)
+--    4. C (TypeError msg a b c)         (for any parameter of class constraint)
 getUserTypeErrorMsg :: Ct -> Maybe Type
 getUserTypeErrorMsg ct
   | Just (_,t1,t2) <- getEqPredTys_maybe ctT    = oneOf [t1,t2]
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 6a86f70..c727da6 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -707,7 +707,10 @@ isStrLitTy _                    = Nothing
 -- If so, give us the kind and the error message.
 userTypeError_maybe :: Type -> Maybe Type
 userTypeError_maybe t
-  = do { (tc, [_kind, msg]) <- splitTyConApp_maybe t
+  = do { (tc, _kind : msg : _) <- splitTyConApp_maybe t
+          -- There may be more than 2 arguments, if the type error is
+          -- used as a type constructor (e.g. at kind `Type -> Type`).
+
        ; guard (tyConName tc == errorMessageTypeErrorFamName)
        ; return msg }