summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2015-12-04 12:11:43 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2015-12-04 14:21:34 +0000
commit31b482bfa68ec8524c4039a33ba55f0aaf02dc0b (patch)
treeb5f683c4814680feac6253319e9b0a9805f71488
parent1160dc516f8b27249d819665883409ee270a743f (diff)
downloadhaskell-31b482bfa68ec8524c4039a33ba55f0aaf02dc0b.tar.gz
Minor refactoring of user type errors
* Remove unused Kind result of getUserTypeErrorMsg * Rename isUserErrorTy --> userTypeError_maybe
-rw-r--r--compiler/typecheck/TcErrors.hs4
-rw-r--r--compiler/typecheck/TcRnTypes.hs6
-rw-r--r--compiler/types/Type.hs11
3 files changed, 11 insertions, 10 deletions
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 156b1ff3e7..ad389b2711 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -499,8 +499,8 @@ mkUserTypeError ctxt ct = mkErrorMsgFromCt ctxt ct
$ important
$ pprUserTypeErrorTy
$ case getUserTypeErrorMsg ct of
- Just (_,msg) -> msg
- Nothing -> pprPanic "mkUserTypeError" (ppr ct)
+ Just msg -> msg
+ Nothing -> pprPanic "mkUserTypeError" (ppr ct)
mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM ErrMsg)
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index f66399dd11..0e8f682082 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -1661,14 +1661,14 @@ isTypeHoleCt _ = False
-- 1. TypeError msg
-- 2. TypeError msg ~ Something (and the other way around)
-- 3. C (TypeError msg) (for any parameter of class constraint)
-getUserTypeErrorMsg :: Ct -> Maybe (Kind, Type)
+getUserTypeErrorMsg :: Ct -> Maybe Type
getUserTypeErrorMsg ct
| Just (_,t1,t2) <- getEqPredTys_maybe ctT = oneOf [t1,t2]
| Just (_,ts) <- getClassPredTys_maybe ctT = oneOf ts
- | otherwise = isUserErrorTy ctT
+ | otherwise = userTypeError_maybe ctT
where
ctT = ctPred ct
- oneOf xs = msum (map isUserErrorTy xs)
+ oneOf xs = msum (map userTypeError_maybe xs)
isUserTypeErrorCt :: Ct -> Bool
isUserTypeErrorCt ct = case getUserTypeErrorMsg ct of
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 13ac503d35..f7493f3817 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -39,7 +39,7 @@ module Type (
mkNumLitTy, isNumLitTy,
mkStrLitTy, isStrLitTy,
- isUserErrorTy, pprUserTypeErrorTy,
+ userTypeError_maybe, pprUserTypeErrorTy,
coAxNthLHS,
@@ -460,10 +460,11 @@ isStrLitTy _ = Nothing
-- | Is this type a custom user error?
-- If so, give us the kind and the error message.
-isUserErrorTy :: Type -> Maybe (Kind,Type)
-isUserErrorTy t = do (tc,[k,msg]) <- splitTyConApp_maybe t
- guard (tyConName tc == errorMessageTypeErrorFamName)
- return (k,msg)
+userTypeError_maybe :: Type -> Maybe Type
+userTypeError_maybe t
+ = do { (tc, [_kind, msg]) <- splitTyConApp_maybe t
+ ; guard (tyConName tc == errorMessageTypeErrorFamName)
+ ; return msg }
-- | Render a type corresponding to a user type error into a SDoc.
pprUserTypeErrorTy :: Type -> SDoc