- pprInstsInFull tidy_dicts]
-
-complainCheck doc givens irreds
- = mappM zonkInst given_dicts_and_ips `thenM` \ givens' ->
- groupErrs (addNoInstanceErrs doc givens') irreds `thenM_`
- returnM ()
- where
- given_dicts_and_ips = filter (not . isMethod) givens
- -- Filter out methods, which are only added to
- -- the given set as an optimisation
-
-addNoInstanceErrs what_doc givens dicts
- = getDOpts `thenM` \ dflags ->
- tcGetInstEnv `thenM` \ inst_env ->
- let
- (tidy_env1, tidy_givens) = tidyInsts givens
- (tidy_env2, tidy_dicts) = tidyMoreInsts tidy_env1 dicts
-
- doc = vcat [addInstLoc dicts $
- sep [herald <+> pprInsts tidy_dicts,
- nest 4 $ ptext SLIT("from the context") <+> pprInsts tidy_givens],
- ambig_doc,
- ptext SLIT("Probable fix:"),
- nest 4 fix1,
- nest 4 fix2]
-
- herald = ptext SLIT("Could not") <+> unambig_doc <+> ptext SLIT("deduce")
- unambig_doc | ambig_overlap = ptext SLIT("unambiguously")
- | otherwise = empty
-
- -- The error message when we don't find a suitable instance
- -- is complicated by the fact that sometimes this is because
- -- there is no instance, and sometimes it's because there are
- -- too many instances (overlap). See the comments in TcEnv.lhs
- -- with the InstEnv stuff.
-
- ambig_doc
- | not ambig_overlap = empty
- | otherwise
- = vcat [ptext SLIT("The choice of (overlapping) instance declaration"),
- nest 4 (ptext SLIT("depends on the instantiation of") <+>
- quotes (pprWithCommas ppr (varSetElems (tyVarsOfInsts tidy_dicts))))]
-
- fix1 = sep [ptext SLIT("Add") <+> pprInsts tidy_dicts,
- ptext SLIT("to the") <+> what_doc]
-
- fix2 | null instance_dicts
- = empty
- | otherwise
- = ptext SLIT("Or add an instance declaration for") <+> pprInsts instance_dicts
-
- instance_dicts = [d | d <- tidy_dicts, isClassDict d, not (isTyVarDict d)]
- -- Insts for which it is worth suggesting an adding an instance declaration
- -- Exclude implicit parameters, and tyvar dicts
-
- -- Checks for the ambiguous case when we have overlapping instances
- ambig_overlap = any ambig_overlap1 dicts
- ambig_overlap1 dict
- | isClassDict dict
- = case lookupInstEnv dflags inst_env clas tys of
- NoMatch ambig -> ambig
- other -> False
- | otherwise = False
- where
- (clas,tys) = getDictClassTys dict
- in
- addErrTcM (tidy_env2, doc)