summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2022-03-04 16:13:53 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-03-07 14:06:52 -0500
commit273bc133a2f4d43be63dcfcf645e697d6fae8178 (patch)
treef88ae75a29a8407178b6c95124a650f3e3a1cce5
parent5b35ca58d94d07751ef2f810686f588ce9c0878a (diff)
downloadhaskell-273bc133a2f4d43be63dcfcf645e697d6fae8178.tar.gz
Fix reporting constraints in pprTcSolverReportMsg
'no_instance_msg' and 'no_deduce_msg' were omitting the first wanted.
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs40
-rw-r--r--testsuite/tests/impredicative/T17332.stderr2
2 files changed, 24 insertions, 18 deletions
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 84eea92b01..406cb87b24 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -1818,30 +1818,36 @@ pprTcSolverReportMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extr
where
main_msg
| null useful_givens
- = addArising orig no_instance_msg
+ = addArising orig (no_instance_msg <+> missing)
| otherwise
- = vcat [ addArising orig no_deduce_msg
- , vcat (pp_givens useful_givens) ]
+ = vcat (addArising orig (no_deduce_msg <+> missing)
+ : pp_givens useful_givens)
+
supplementary = case mb_extra of
Nothing
-> Left []
Just (CND_Extra level ty1 ty2)
-> mk_supplementary_ea_msg ctxt level ty1 ty2 orig
- (wanted, wanteds) = (errorItemPred item, map errorItemPred others)
orig = errorItemOrigin item
- no_instance_msg
- | null others
- , Just (tc, _) <- splitTyConApp_maybe wanted
- , isClassTyCon tc
- -- Don't say "no instance" for a constraint such as "c" for a type variable c.
- = text "No instance for" <+> pprParendType wanted
- | otherwise
- = text "Could not solve:" <+> pprTheta wanteds
- no_deduce_msg
- | null others
- = text "Could not deduce" <+> pprParendType wanted
- | otherwise
- = text "Could not deduce:" <+> pprTheta wanteds
+ wanteds = map errorItemPred (item:others)
+
+ no_instance_msg =
+ case wanteds of
+ [wanted] | Just (tc, _) <- splitTyConApp_maybe wanted
+ -- Don't say "no instance" for a constraint such as "c" for a type variable c.
+ , isClassTyCon tc -> text "No instance for"
+ _ -> text "Could not solve:"
+
+ no_deduce_msg =
+ case wanteds of
+ [_wanted] -> text "Could not deduce"
+ _ -> text "Could not deduce:"
+
+ missing =
+ case wanteds of
+ [wanted] -> pprParendType wanted
+ _ -> pprTheta wanteds
+
pprTcSolverReportMsg ctxt (AmbiguityPreventsSolvingCt item ambigs) =
pprTcSolverReportInfo ctxt (Ambiguity True ambigs) <+>
pprArising (errorItemOrigin item) $$
diff --git a/testsuite/tests/impredicative/T17332.stderr b/testsuite/tests/impredicative/T17332.stderr
index 7d0615ad4e..f614c289ce 100644
--- a/testsuite/tests/impredicative/T17332.stderr
+++ b/testsuite/tests/impredicative/T17332.stderr
@@ -1,5 +1,5 @@
T17332.hs:13:7: error:
- • Could not solve: () arising from a use of ‘MkDict’
+ • Could not solve: a arising from a use of ‘MkDict’
• In the expression: MkDict
In an equation for ‘aux’: aux = MkDict