From 96daafc3305a691590b88c1175a8f45e5d327471 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Thu, 6 Mar 2014 11:32:55 +0000
Subject: [PATCH] Attach the right location to pattern synonym error message
(fixes Trac #8841)
---
compiler/typecheck/TcPatSyn.lhs | 9 ++++-----
1 file changed, 4 insertions(+), 5 deletions(-)
diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs
index a126f0f85f19..703e59dca4af 100644
--- a/compiler/typecheck/TcPatSyn.lhs
+++ b/compiler/typecheck/TcPatSyn.lhs
@@ -186,7 +186,7 @@ tcPatSynWrapper lname lpat dir args univ_tvs ex_tvs theta pat_ty
(Unidirectional, _) ->
return Nothing
(ImplicitBidirectional, Nothing) ->
- cannotInvertPatSynErr (unLoc lpat)
+ cannotInvertPatSynErr lpat
(ImplicitBidirectional, Just lexpr) ->
fmap Just $ tc_pat_syn_wrapper_from_expr lname lexpr args univ_tvs ex_tvs theta pat_ty }
@@ -281,10 +281,9 @@ asPatInPatSynErr pat
hang (ptext (sLit "Pattern synonym definition cannot contain as-patterns (@):"))
2 (ppr pat)
--- TODO: Highlight sub-pattern that causes the problem
-cannotInvertPatSynErr :: OutputableBndr name => Pat name -> TcM a
-cannotInvertPatSynErr pat
- = failWithTc $
+cannotInvertPatSynErr :: OutputableBndr name => LPat name -> TcM a
+cannotInvertPatSynErr (L loc pat)
+ = setSrcSpan loc $ failWithTc $
hang (ptext (sLit "Right-hand side of bidirectional pattern synonym cannot be used as an expression"))
2 (ppr pat)
--
GitLab