Commit 8d00175f authored by mniip's avatar mniip Committed by Ben Gamari
Browse files

Less scary arity mismatch error message when deriving

Test Plan: Corrected a few tests to include the new message.

Reviewers: goldfire, austin, bgamari

Reviewed By: bgamari

Subscribers: goldfire, thomie

Differential Revision: https://phabricator.haskell.org/D2484

GHC Trac Issues: #12546
parent 6ea62427
......@@ -612,7 +612,7 @@ deriveTyData :: [TyVar] -> TyCon -> [Type] -- LHS of data or data instance
-- I.e. not standalone deriving
deriveTyData tvs tc tc_args deriv_pred
= setSrcSpan (getLoc (hsSigType deriv_pred)) $ -- Use loc of the 'deriving' item
do { (deriv_tvs, cls, cls_tys, cls_arg_kind)
do { (deriv_tvs, cls, cls_tys, cls_arg_kinds)
<- tcExtendTyVarEnv tvs $
tcHsDeriv deriv_pred
-- Deriving preds may (now) mention
......@@ -623,6 +623,9 @@ deriveTyData tvs tc tc_args deriv_pred
-- Typeable is special, because Typeable :: forall k. k -> Constraint
-- so the argument kind 'k' is not decomposable by splitKindFunTys
-- as is the case for all other derivable type classes
; when (length cls_arg_kinds /= 1) $
failWithTc (nonUnaryErr deriv_pred)
; let [cls_arg_kind] = cls_arg_kinds
; if className cls == typeableClassName
then do warnUselessTypeable
return []
......@@ -1305,6 +1308,10 @@ checkSideConditions dflags mtheta cls cls_tys rep_tc
classArgsErr :: Class -> [Type] -> SDoc
classArgsErr cls cls_tys = quotes (ppr (mkClassPred cls cls_tys)) <+> text "is not a class"
nonUnaryErr :: LHsSigType Name -> SDoc
nonUnaryErr ct = quotes (ppr ct)
<+> text "is not a unary constraint, as expected by a deriving clause"
nonStdErr :: Class -> SDoc
nonStdErr cls =
quotes (ppr cls)
......
......@@ -226,26 +226,25 @@ tc_hs_sig_type (HsIB { hsib_body = hs_ty
; return (mkSpecForAllTys tkvs ty) }
-----------------
tcHsDeriv :: LHsSigType Name -> TcM ([TyVar], Class, [Type], Kind)
tcHsDeriv :: LHsSigType Name -> TcM ([TyVar], Class, [Type], [Kind])
-- Like tcHsSigType, but for the ...deriving( C t1 ty2 ) clause
-- Returns the C, [ty1, ty2, and the kind of C's *next* argument
-- Returns the C, [ty1, ty2, and the kinds of C's remaining arguments
-- E.g. class C (a::*) (b::k->k)
-- data T a b = ... deriving( C Int )
-- returns ([k], C, [k, Int], k->k)
-- Also checks that (C ty1 ty2 arg) :: Constraint
-- if arg has a suitable kind
-- returns ([k], C, [k, Int], [k->k])
tcHsDeriv hs_ty
= do { arg_kind <- newMetaKindVar
= do { cls_kind <- newMetaKindVar
-- always safe to kind-generalize, because there
-- can be no covars in an outer scope
; ty <- checkNoErrs $
-- avoid redundant error report with "illegal deriving", below
tc_hs_sig_type hs_ty (mkFunTy arg_kind constraintKind)
tc_hs_sig_type hs_ty cls_kind
; ty <- kindGeneralizeType ty -- also zonks
; arg_kind <- zonkTcType arg_kind
; cls_kind <- zonkTcType cls_kind
; let (tvs, pred) = splitForAllTys ty
; let (args, _) = splitFunTys cls_kind
; case getClassPredTys_maybe pred of
Just (cls, tys) -> return (tvs, cls, tys, arg_kind)
Just (cls, tys) -> return (tvs, cls, tys, args)
Nothing -> failWithTc (text "Illegal deriving item" <+> quotes (ppr hs_ty)) }
tcHsClsInstType :: UserTypeCtxt -- InstDeclCtxt or SpecInstCtxt
......
......@@ -4,5 +4,5 @@ T7959.hs:5:1: error:
• In the stand-alone deriving instance for ‘A’
T7959.hs:6:17: error:
Expected kind ‘k0 -> Constraint, but ‘A’ has kind ‘Constraint’
‘A’ is not a unary constraint, as expected by a deriving clause
• In the data declaration for ‘B’
drvfail005.hs:4:13: error:
• Expecting one fewer arguments to ‘Show a’
Expected kind ‘k0 -> Constraint’,
but ‘Show a’ has kind ‘Constraint’
• ‘Show a’ is not a unary constraint, as expected by a deriving clause
• In the data declaration for ‘Test’
drvfail009.hs:10:31: error:
Expecting one more argument to ‘C’
Expected kind ‘* -> Constraint’,
but ‘C’ has kind ‘* -> * -> Constraint’
‘C’ is not a unary constraint, as expected by a deriving clause
In the newtype declaration for ‘T1’
drvfail009.hs:13:31: error:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment