[GHC] #11391: TypeError is fragile

[GHC]

#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 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 }
  }}}

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11391#comment:8>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler