[commit: ghc] master: Attach the right location to pattern synonym error message (fixes Trac #8841) (96daafc)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/96daafc3305a691590b88c1175a8f45e5d327471/ghc

>---------------------------------------------------------------

commit 96daafc3305a691590b88c1175a8f45e5d327471
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Mar 6 11:32:55 2014 +0000

    Attach the right location to pattern synonym error message (fixes Trac #8841)


>---------------------------------------------------------------

96daafc3305a691590b88c1175a8f45e5d327471
 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 a126f0f..703e59d 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)