diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 5931652edf965b97086d61587e175b005228928d..49111a919d3282382f9aebc111202cf5104613b5 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -1049,11 +1049,13 @@ inferConstraints cls inst_tys rep_tc rep_tc_args
where
-- Constraints arising from the arguments of each constructor
con_arg_constraints cls' get_constrained_tys
- = [ mkPredOrigin DerivOrigin (mkClassPred cls' [arg_ty])
+ = [ mkPredOrigin (DerivOriginDC data_con arg_n) (mkClassPred cls' [arg_ty])
| data_con <- tyConDataCons rep_tc,
- arg_ty <- ASSERT( isVanillaDataCon data_con )
- get_constrained_tys $
- dataConInstOrigArgTys data_con all_rep_tc_args,
+ (arg_n, arg_ty) <-
+ ASSERT( isVanillaDataCon data_con )
+ zip [1..] $
+ get_constrained_tys $
+ dataConInstOrigArgTys data_con all_rep_tc_args,
not (isUnLiftedType arg_ty) ]
-- No constraints for unlifted types
-- See Note [Deriving and unboxed types]
diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 83d38da7043f86d8ad1e7233e92bde1fa50c2ab9..e0be85f0ef81183e3d71b78ced13250d6c041064 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -1049,8 +1049,9 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
= ptext (sLit "Could not deduce") <+> pprParendType pred
drv_fixes = case orig of
- DerivOrigin -> [drv_fix]
- _ -> []
+ DerivOrigin -> [drv_fix]
+ DerivOriginDC {} -> [drv_fix]
+ _ -> []
drv_fix = hang (ptext (sLit "use a standalone 'deriving instance' declaration,"))
2 (ptext (sLit "so you can specify the instance context yourself"))
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 9fc2cebac971a903526f1e2e687ec6fda08030f0..1b38378d2e19688c528b98548b193241a8cae48d 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -90,7 +90,7 @@ import TcEvidence
import Type
import Class ( Class )
import TyCon ( TyCon )
-import DataCon ( DataCon, dataConUserType )
+import DataCon ( DataCon, dataConUserType, dataConOrigArgTys )
import TcType
import Annotations
import InstEnv
@@ -1779,6 +1779,8 @@ data CtOrigin
| ScOrigin -- Typechecking superclasses of an instance declaration
| DerivOrigin -- Typechecking deriving
+ | DerivOriginDC DataCon Int
+ -- Checking constraings arising from this data an and field index
| StandAloneDerivOrigin -- Typechecking stand-alone deriving
| DefaultOrigin -- Typechecking a default decl
| DoOrigin -- Arising from a do expression
@@ -1816,6 +1818,10 @@ pprO TupleOrigin = ptext (sLit "a tuple")
pprO NegateOrigin = ptext (sLit "a use of syntactic negation")
pprO ScOrigin = ptext (sLit "the superclasses of an instance declaration")
pprO DerivOrigin = ptext (sLit "the 'deriving' clause of a data type declaration")
+pprO (DerivOriginDC dc n) = hsep [ ptext (sLit "the"), speakNth n,
+ ptext (sLit "field of"), quotes (ppr dc),
+ parens (ptext (sLit "type") <+> quotes (ppr ty)) ]
+ where ty = dataConOrigArgTys dc !! (n-1)
pprO StandAloneDerivOrigin = ptext (sLit "a 'deriving' declaration")
pprO DefaultOrigin = ptext (sLit "a 'default' declaration")
pprO DoOrigin = ptext (sLit "a do statement")