From 825ec425d4092b9c4c1267a9c5d503d01d374cc8 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Thu, 13 Feb 2020 18:38:18 +0100
Subject: [PATCH] Improve comments-affecting-layout behaviour for tuples (#231)
---
src-literatetests/15-regressions.blt | 22 +++++++++++++++++++
.../Brittany/Internal/LayouterBasics.hs | 20 +++++++++++++++++
.../Brittany/Internal/Layouters/Expr.hs | 5 ++++-
3 files changed, 46 insertions(+), 1 deletion(-)
diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt
index c61bb78..54b467d 100644
--- a/src-literatetests/15-regressions.blt
+++ b/src-literatetests/15-regressions.blt
@@ -802,3 +802,25 @@ zItazySunefp twgq nlyo lwojjoBiecao =
#test module initial comment
-- test
module MyModule where
+
+#test issue 231
+
+foo =
+ [ ("xxx", "xx")
+ , --
+ ("xx" , "xx")
+ --
+ , ("xx" , "xxxxx")
+ , ("xx" , "xx")
+ ]
+
+#test issue 231 not
+
+foo =
+ [ ("xx", "xx")
+ , ( "xx" --
+ , "xx"
+ )
+ , ("xx", "xxxxx")
+ , ("xx", "xx")
+ ]
diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
index 76ec7a3..d40fd6e 100644
--- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
+++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
@@ -66,6 +66,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
, allocateNode
, docSharedWrapper
, hasAnyCommentsBelow
+ , hasCommentsBetween
, hasAnyCommentsConnected
, hasAnyCommentsPrior
, hasAnyRegularCommentsConnected
@@ -299,6 +300,25 @@ hasAnyCommentsBelow ast@(L l _) =
List.any (\(c, _) -> ExactPrint.commentIdentifier c > l)
<$> astConnectedComments ast
+hasCommentsBetween
+ :: Data ast
+ => GHC.Located ast
+ -> AnnKeywordId
+ -> AnnKeywordId
+ -> ToBriDocM Bool
+hasCommentsBetween ast leftKey rightKey = do
+ mAnn <- astAnn ast
+ let go1 [] = False
+ go1 ((ExactPrint.G kw, _dp) : rest) | kw == leftKey = go2 rest
+ go1 (_ : rest) = go1 rest
+ go2 [] = False
+ go2 ((ExactPrint.AnnComment _, _dp) : _rest) = True
+ go2 ((ExactPrint.G kw, _dp) : _rest) | kw == rightKey = False
+ go2 (_ : rest) = go2 rest
+ case mAnn of
+ Nothing -> pure False
+ Just ann -> pure $ go1 $ ExactPrint.annsDP ann
+
-- | True if there are any comments that are connected to any node below (in AST
-- sense) the given node
hasAnyCommentsConnected :: Data ast => GHC.Located ast -> ToBriDocM Bool
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
index 1a02ab8..5a45899 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
@@ -528,7 +528,10 @@ layoutExpr lexpr@(L _ expr) = do
argDocs <- forM argExprs
$ docSharedWrapper
$ \(arg, exprM) -> docWrapNode arg $ maybe docEmpty layoutExpr exprM
- hasComments <- hasAnyCommentsBelow lexpr
+ hasComments <- orM
+ ( hasCommentsBetween lexpr AnnOpenP AnnCloseP
+ : map hasAnyCommentsBelow args
+ )
let (openLit, closeLit) = case boxity of
Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")")
Unboxed -> (docParenHashLSep, docParenHashRSep)