#11391: TypeError is fragile
-------------------------------------+-------------------------------------
Reporter: bgamari | Owner: diatchki
Type: bug | Status: new
Priority: high | Milestone: 8.0.1
Component: Compiler (Type | Version: 8.0.1-rc1
checker) | Keywords:
Resolution: | CustomTypeErrors
Operating System: Unknown/Multiple | Architecture:
Type of failure: Incorrect | Unknown/Multiple
warning at compile-time | Test Case:
Blocked By: | Blocking:
Related Tickets: #9637 | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by simonpj):
Great work Iavor, thanks.
Always mention the ticket in the commit message! Then the ticket appears
in the Trac ticket automatically.
Also, could you add a regression test pls? (And update the "Test Case"
field of the ticket appropriately.)
Manually, the commit is
{{{
commit 6ea24af9f22f6ea661d79623135f4cd31e28c6a2
Author: Iavor S. Diatchki
---------------------------------------------------------------
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 } }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/11391#comment:8 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler