[commit: ghc] wip/custom-type-errors: Report a custom type error if a class parameter is (type error). (1ed610a)

[git at git.haskell.org]

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

On branch  : wip/custom-type-errors
Link       : http://ghc.haskell.org/trac/ghc/changeset/1ed610a0f7cf0014f1b87260abdde3e885ca8899/ghc

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

commit 1ed610a0f7cf0014f1b87260abdde3e885ca8899
Author: Iavor S. Diatchki <iavor.diatchki at gmail.com>
Date:   Sat Oct 31 11:51:23 2015 -0700

    Report a custom type error if a class parameter is (type error).
    
    If you try to show something that evaluates to type error, we'd like
    to see the type error, rather than saying
    "No instance for `Show (type error)`"


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

1ed610a0f7cf0014f1b87260abdde3e885ca8899
 compiler/typecheck/TcErrors.hs  | 3 +++
 compiler/typecheck/TcRnTypes.hs | 9 +++++----
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 80efe56..6aca014 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -465,6 +465,9 @@ mkUserTypeError ctxt ct = mkErrorMsgFromCt ctxt ct =<< render msgT
         | Just (_,_,t2) <- getEqPredTys_maybe ctT
         , Just msg      <- getMsg t2                 = msg
 
+        | Just (_,ts) <- getClassPredTys_maybe ctT
+        , msg : _ <- mapMaybe getMsg ts              = msg
+
         -- TypeError msg
         | Just msg      <- getMsg ctT                = msg
 
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 8c0153f..8212d0c 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -1445,12 +1445,13 @@ isTypeHoleCt _ = False
 
 -- | The following constraints are considered to be a custom type error:
 --    1. TypeError msg
---    2. TypeError msg ~ Something
---    3. Something ~ TypeError msg
+--    2. TypeError msg ~ Something  (and the other way around)
+--    3. C (TypeError msg)          (for any parameter of class constraint)
 isUserTypeErrorCt :: Ct -> Bool
 isUserTypeErrorCt ct
-  | Just (_,t1,t2) <- getEqPredTys_maybe ctT = isTyErr t1 || isTyErr t2
-  | otherwise                                = isTyErr ctT
+  | Just (_,t1,t2) <- getEqPredTys_maybe ctT    = isTyErr t1 || isTyErr t2
+  | Just (_,ts)    <- getClassPredTys_maybe ctT = any isTyErr ts
+  | otherwise                                   = isTyErr ctT
   where
   ctT       = ctPred ct
   isTyErr t = case splitTyConApp_maybe t of