#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 <diatchki@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 } }}} -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11391#comment:8> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler