+addTopIPErrs dicts
+ = groupErrs report tidy_dicts
+ where
+ (tidy_env, tidy_dicts) = tidyInsts dicts
+ report dicts = addErrTcM (tidy_env, mk_msg dicts)
+ mk_msg dicts = addInstLoc dicts (ptext SLIT("Unbound implicit parameter") <>
+ plural tidy_dicts <+> pprInsts tidy_dicts)
+
+addNoInstanceErrs :: Maybe SDoc -- Nothing => top level
+ -- Just d => d describes the construct
+ -> [Inst] -- What is given by the context or type sig
+ -> [Inst] -- What is wanted
+ -> TcM ()
+addNoInstanceErrs mb_what givens []
+ = returnM ()
+addNoInstanceErrs mb_what givens dicts
+ = -- Some of the dicts are here because there is no instances
+ -- and some because there are too many instances (overlap)
+ -- The first thing we do is separate them
+ getDOpts `thenM` \ dflags ->
+ tcGetInstEnvs `thenM` \ inst_envs ->
+ let
+ (tidy_env1, tidy_givens) = tidyInsts givens
+ (tidy_env2, tidy_dicts) = tidyMoreInsts tidy_env1 dicts
+
+ -- Run through the dicts, generating a message for each
+ -- overlapping one, but simply accumulating all the
+ -- no-instance ones so they can be reported as a group
+ (overlap_doc, no_inst_dicts) = foldl check_overlap (empty, []) tidy_dicts
+ check_overlap (overlap_doc, no_inst_dicts) dict
+ | not (isClassDict dict) = (overlap_doc, dict : no_inst_dicts)
+ | otherwise
+ = case lookupInstEnv dflags inst_envs clas tys of
+ res@(ms, _)
+ | length ms > 1 -> (mk_overlap_msg dict res $$ overlap_doc, no_inst_dicts)
+ | otherwise -> (overlap_doc, dict : no_inst_dicts) -- No match
+ -- NB: there can be exactly one match, in the case where we have
+ -- instance C a where ...
+ -- (In this case, lookupInst doesn't bother to look up,
+ -- unless -fallow-undecidable-instances is set.)
+ -- So we report this as "no instance" rather than "overlap"; the fix is
+ -- to specify -fallow-undecidable-instances, but we leave that to the programmer!
+ where
+ (clas,tys) = getDictClassTys dict
+ in
+ mk_probable_fix tidy_env2 mb_what no_inst_dicts `thenM` \ (tidy_env3, probable_fix) ->
+ let
+ no_inst_doc | null no_inst_dicts = empty
+ | otherwise = vcat [addInstLoc no_inst_dicts heading, probable_fix]
+ heading | null givens = ptext SLIT("No instance") <> plural no_inst_dicts <+>
+ ptext SLIT("for") <+> pprInsts no_inst_dicts
+ | otherwise = sep [ptext SLIT("Could not deduce") <+> pprInsts no_inst_dicts,
+ nest 2 $ ptext SLIT("from the context") <+> pprInsts tidy_givens]
+ in
+ addErrTcM (tidy_env3, no_inst_doc $$ overlap_doc)
+
+ where
+ mk_overlap_msg dict (matches, unifiers)
+ = vcat [ addInstLoc [dict] ((ptext SLIT("Overlapping instances for") <+> ppr dict)),
+ sep [ptext SLIT("Matching instances") <> colon,
+ nest 2 (pprDFuns (dfuns ++ unifiers))],
+ if null unifiers
+ then empty
+ else parens (ptext SLIT("The choice depends on the instantiation of") <+>
+ quotes (pprWithCommas ppr (varSetElems (tyVarsOfInst dict))))]
+ where
+ dfuns = [df | (_, (_,_,df)) <- matches]
+
+ mk_probable_fix tidy_env Nothing dicts -- Top level
+ = mkMonomorphismMsg tidy_env dicts
+ mk_probable_fix tidy_env (Just what) dicts -- Nested (type signatures, instance decls)
+ = returnM (tidy_env, sep [ptext SLIT("Probable fix:"), nest 2 fix1, nest 2 fix2])
+ where
+ fix1 = sep [ptext SLIT("Add") <+> pprInsts dicts,
+ ptext SLIT("to the") <+> what]
+
+ fix2 | null instance_dicts = empty
+ | otherwise = ptext SLIT("Or add an instance declaration for")
+ <+> pprInsts instance_dicts
+ instance_dicts = [d | d <- dicts, isClassDict d, not (isTyVarDict d)]
+ -- Insts for which it is worth suggesting an adding an instance declaration
+ -- Exclude implicit parameters, and tyvar dicts