From 00d3ecf0775c1a3f1ab8495e5e125f21d450394e Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Fri, 29 Mar 2024 10:57:16 +0000
Subject: [PATCH] EPA: Extend StringLiteral range to include trailing commas
This goes slightly against the exact printing philosophy where
trailing decorations should be in an annotation, but the
practicalities of adding it to the WarningTxt environment, and the
problems caused by deviating do not make a more principles approach
worthwhile.
---
compiler/GHC/Parser.y | 3 ++-
utils/check-exact/ExactPrint.hs | 6 +++++-
2 files changed, 7 insertions(+), 2 deletions(-)
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 6ad6c6a12aec..ec3fbc5e3ff0 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -4559,7 +4559,8 @@ addTrailingCommaN (L anns a) span = do
return (L anns' a)
addTrailingCommaS :: Located StringLiteral -> EpaLocation -> Located StringLiteral
-addTrailingCommaS (L l sl) span = L l (sl { sl_tc = Just (epaLocationRealSrcSpan span) })
+addTrailingCommaS (L l sl) span
+ = L (widenSpan l [AddEpAnn AnnComma span]) (sl { sl_tc = Just (epaLocationRealSrcSpan span) })
-- -------------------------------------
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index d4dc76269684..c96c5dfba721 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -652,6 +652,10 @@ printSourceText :: (Monad m, Monoid w) => SourceText -> String -> EP w m ()
printSourceText (NoSourceText) txt = printStringAdvance txt >> return ()
printSourceText (SourceText txt) _ = printStringAdvance (unpackFS txt) >> return ()
+printSourceTextAA :: (Monad m, Monoid w) => SourceText -> String -> EP w m ()
+printSourceTextAA (NoSourceText) txt = printStringAtAA (EpaDelta (SameLine 0) []) txt >> return ()
+printSourceTextAA (SourceText txt) _ = printStringAtAA (EpaDelta (SameLine 0) []) (unpackFS txt) >> return ()
+
-- ---------------------------------------------------------------------
printStringAtSs :: (Monad m, Monoid w) => SrcSpan -> String -> EP w m ()
@@ -2099,7 +2103,7 @@ instance ExactPrint StringLiteral where
setAnnotationAnchor a _ _ _ = a
exact l@(StringLiteral src fs mcomma) = do
- printSourceText src (show (unpackFS fs))
+ printSourceTextAA src (show (unpackFS fs))
mapM_ (\r -> printStringAtRs r ",") mcomma
return l
--
GitLab