From 6f380f2be632620e91bfe92101ca5266bc2e8bdb Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Sun, 19 Mar 2023 18:13:06 +0000
Subject: [PATCH] Change behaviour: Less par-spacing for function application
---
data/10-structured/expression-basic.blt | 12 +--
data/10-structured/fundecl.blt | 10 +--
data/15-regressions.blt | 64 +++++++++-------
data/30-tests-context-free.blt | 75 ++++++++++---------
data/40-indent-policy-multiple.blt | 13 ++--
.../Brittany/Internal/ToBriDoc/Decl.hs | 2 +-
.../Brittany/Internal/ToBriDoc/Expr.hs | 56 +++++++-------
7 files changed, 125 insertions(+), 107 deletions(-)
diff --git a/data/10-structured/expression-basic.blt b/data/10-structured/expression-basic.blt
index 3a5d208..e33c05b 100644
--- a/data/10-structured/expression-basic.blt
+++ b/data/10-structured/expression-basic.blt
@@ -40,14 +40,16 @@ describe "app" $ do
func = klajsdas klajsdas klajsdas
#test 2
-func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+func =
lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
#test 3
-func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd lakjsdlajsdljas
- lakjsdlajsdljas
- lakjsdlajsdljas
+func =
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd lakjsdlajsdljas
+ lakjsdlajsdljas
+ lakjsdlajsdljas
###
#group expression.basic.sections
diff --git a/data/10-structured/fundecl.blt b/data/10-structured/fundecl.blt
index 3f455bb..e336401 100644
--- a/data/10-structured/fundecl.blt
+++ b/data/10-structured/fundecl.blt
@@ -71,12 +71,10 @@ func x
#test multiple-clauses-3
func x
- | very long guard, another rather long guard that refers to x = nontrivial
- expression
- foo
- bar
- alsdkjlasdjlasj
- | otherwise = 0
+ | very long guard, another rather long guard that refers to x
+ = nontrivial expression foo bar alsdkjlasdjlasj
+ | otherwise
+ = 0
#test multiple-clauses-4
func x
diff --git a/data/15-regressions.blt b/data/15-regressions.blt
index 32cf6fe..40e9502 100644
--- a/data/15-regressions.blt
+++ b/data/15-regressions.blt
@@ -169,9 +169,10 @@ readMergePersConfig path shouldCreate conf = do
Right x -> return x
return $ fileConf Semigroup.<> conf
| shouldCreate -> do
- liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap
- (Option . Just . runIdentity)
- staticDefaultConfig
+ liftIO
+ $ ByteString.writeFile path
+ $ Data.Yaml.encode
+ $ cMap (Option . Just . runIdentity) staticDefaultConfig
return $ conf
| otherwise -> do
return conf
@@ -305,21 +306,23 @@ parserCompactLocation =
[ try
$ [ ParseRelAbs (Text.Read.read digits) _ _
| digits <- many1 digit
- , rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe
- [ case divPart of
- Nothing -> Left $ Text.Read.read digits
- Just ddigits ->
- Right $ Text.Read.read digits % Text.Read.read ddigits
- | digits <- many1 digit
- , divPart <- optionMaybe (string "/" *> many1 digit)
- ]
+ , rel1 :: Maybe (Either Int (Ratio Int)) <-
+ optionMaybe
+ [ case divPart of
+ Nothing -> Left $ Text.Read.read digits
+ Just ddigits ->
+ Right $ Text.Read.read digits % Text.Read.read ddigits
+ | digits <- many1 digit
+ , divPart <- optionMaybe (string "/" *> many1 digit)
+ ]
]
]
#test opapp-specialcasing-1
-func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo
- foooooooooooooooooooooooooooooooo
- foooooooooooooooooooooooooooooooo
+func =
+ fooooooooooooooooooooooooooooooooo
+ $ foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
#test opapp-specialcasing-2
func =
@@ -338,8 +341,9 @@ func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo
parserPrim =
[ r
| r <-
- [ SGPPrimFloat $ bool id (0 -) minus $ readGnok "parserPrim"
- (d1 ++ d2 ++ d3 ++ d4)
+ [ SGPPrimFloat
+ $ bool id (0 -) minus
+ $ readGnok "parserPrim" (d1 ++ d2 ++ d3 ++ d4)
| d2 <- string "."
, d3 <- many1 (oneOf "0123456789")
, _ <- string "f"
@@ -444,8 +448,9 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
[ docLines
$ [ docForceSingleline
$ docSeq (patPartInline ++ [guardPart, return binderDoc])
- , docEnsureIndent BrIndentRegular $ docForceSingleline $ return
- body
+ , docEnsureIndent BrIndentRegular
+ $ docForceSingleline
+ $ return body
]
++ wherePartMultiLine
| [(guards, body, _bodyRaw)] <- [clauseDocs]
@@ -457,10 +462,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
func = do
let foo = if
| Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO
- -> max
- (defLen - 0.2) -- TODO
- (defLen * 0.8)
- | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO
+ -> max (defLen - 0.2) -- TODO
+ (defLen * 0.8)
+ | otherwise
+ -> max (defLen - 0.05) (defLen * 0.95) -- TODO
return True
#test issue 49
@@ -656,13 +661,14 @@ jaicyhHumzo btrKpeyiFej mava = do
#test issue 214
-- brittany { lconfig_indentPolicy: IndentPolicyMultiple }
-foo = bar
- arg1 -- this is the first argument
- arg2 -- this is the second argument
- arg3 -- this is the third argument, now I'll skip one comment
- arg4
- arg5 -- this is the fifth argument
- arg6 -- this is the sixth argument
+foo =
+ bar
+ arg1 -- this is the first argument
+ arg2 -- this is the second argument
+ arg3 -- this is the third argument, now I'll skip one comment
+ arg4
+ arg5 -- this is the fifth argument
+ arg6 -- this is the sixth argument
#test issue 234
diff --git a/data/30-tests-context-free.blt b/data/30-tests-context-free.blt
index 56a779d..f71287b 100644
--- a/data/30-tests-context-free.blt
+++ b/data/30-tests-context-free.blt
@@ -430,12 +430,10 @@ func x
#test multiple-clauses-3
func x
- | very long guard, another rather long guard that refers to x = nontrivial
- expression
- foo
- bar
- alsdkjlasdjlasj
- | otherwise = 0
+ | very long guard, another rather long guard that refers to x
+ = nontrivial expression foo bar alsdkjlasdjlasj
+ | otherwise
+ = 0
#test multiple-clauses-4
func x
@@ -506,15 +504,17 @@ describe "app" $ do
func = klajsdas klajsdas klajsdas
#test 2
-func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+func =
lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
#test 3
-func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
- lakjsdlajsdljas
- lakjsdlajsdljas
- lakjsdlajsdljas
+func =
+ lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+ lakjsdlajsdljas
+ lakjsdlajsdljas
+ lakjsdlajsdljas
###
#group context-free/expression.basic.sections
@@ -1108,9 +1108,10 @@ readMergePersConfig path shouldCreate conf = do
Right x -> return x
return $ fileConf Semigroup.<> conf
| shouldCreate -> do
- liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap
- (Option . Just . runIdentity)
- staticDefaultConfig
+ liftIO
+ $ ByteString.writeFile path
+ $ Data.Yaml.encode
+ $ cMap (Option . Just . runIdentity) staticDefaultConfig
return $ conf
| otherwise -> do
return conf
@@ -1252,21 +1253,24 @@ parserCompactLocation =
[ try
$ [ ParseRelAbs (Text.Read.read digits) _ _
| digits <- many1 digit
- , rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe
- [ case divPart of
- Nothing -> Left $ Text.Read.read digits
- Just ddigits ->
- Right $ Text.Read.read digits % Text.Read.read ddigits
- | digits <- many1 digit
- , divPart <- optionMaybe (string "/" *> many1 digit)
- ]
+ , rel1 :: Maybe (Either Int (Ratio Int)) <-
+ optionMaybe
+ [ case divPart of
+ Nothing -> Left $ Text.Read.read digits
+ Just ddigits ->
+ Right $ Text.Read.read digits % Text.Read.read ddigits
+ | digits <- many1 digit
+ , divPart <- optionMaybe (string "/" *> many1 digit)
+ ]
]
]
#test opapp-specialcasing-1
-func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo
- foooooooooooooooooooooooooooooooo
- foooooooooooooooooooooooooooooooo
+func =
+ fooooooooooooooooooooooooooooooooo
+ $ foooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
#test opapp-specialcasing-2
func =
@@ -1286,9 +1290,9 @@ func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo
parserPrim =
[ r
| r <-
- [ SGPPrimFloat $ bool id (0 -) minus $ readGnok
- "parserPrim"
- (d1 ++ d2 ++ d3 ++ d4)
+ [ SGPPrimFloat
+ $ bool id (0 -) minus
+ $ readGnok "parserPrim" (d1 ++ d2 ++ d3 ++ d4)
| d2 <- string "."
, d3 <- many1 (oneOf "0123456789")
, _ <- string "f"
@@ -1370,8 +1374,9 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
[ docLines
$ [ docForceSingleline
$ docSeq (patPartInline ++ [guardPart, return binderDoc])
- , docEnsureIndent BrIndentRegular $ docForceSingleline $ return
- body
+ , docEnsureIndent BrIndentRegular
+ $ docForceSingleline
+ $ return body
]
++ wherePartMultiLine
| [(guards, body, _bodyRaw)] <- [clauseDocs]
@@ -1384,10 +1389,10 @@ func = do
let
foo = if
| Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO
- -> max
- (defLen - 0.2) -- TODO
- (defLen * 0.8)
- | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO
+ -> max (defLen - 0.2) -- TODO
+ (defLen * 0.8)
+ | otherwise
+ -> max (defLen - 0.05) (defLen * 0.95) -- TODO
return True
#test issue 49
diff --git a/data/40-indent-policy-multiple.blt b/data/40-indent-policy-multiple.blt
index b75c726..016be2b 100644
--- a/data/40-indent-policy-multiple.blt
+++ b/data/40-indent-policy-multiple.blt
@@ -34,9 +34,10 @@ foo = do
#test nested do-block
-- brittany { lconfig_indentAmount: 4, lconfig_indentPolicy: IndentPolicyMultiple }
-foo = asdyf8asdf
- "ajsdfas"
- [ asjdf asyhf $ do
- aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- ]
+foo =
+ asdyf8asdf
+ "ajsdfas"
+ [ asjdf asyhf $ do
+ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+ ]
diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs
index 8d90848..997e99b 100644
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs
@@ -545,7 +545,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses mWhereDocs hasCo
++ wherePartMultiLine
-- multiple clauses, each with the guard(s) in a single line, body
-- as a paragraph
- addAlternative
+ addAlternativeCond (not hasComments)
$ docLines
$ [ docAddBaseY BrIndentRegular
$ patPartParWrap
diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs
index f464936..29f5ab4 100644
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs
@@ -139,25 +139,21 @@ layoutExpr lexpr@(L _ expr) = do
<$> funcPatDocs
)
HsApp _ exp1 _ -> do
- let
- gather
- :: [ToBriDocM BriDocNumbered]
- -> LHsExpr GhcPs
- -> (LHsExpr GhcPs, [ToBriDocM BriDocNumbered])
- gather list = \case
- L _ (HsApp epAnn l r) -> gather
- (docHandleComms epAnn $ layoutExpr r : list) l
- x -> (x, list)
- let (headE, paramEs) = gather
- []
- lexpr
- let
- colsOrSequence = case headE of
- L _ (HsVar _ (L _ (Unqual occname))) ->
- docCols (ColApp $ Text.pack $ occNameString occname)
- _ -> docSeq
- headDoc <- shareDoc $ layoutExpr headE
- paramDocs <- shareDoc `mapM` paramEs
+ let gather
+ :: [(EpAnnCO, LHsExpr GhcPs)]
+ -> LHsExpr GhcPs
+ -> (LHsExpr GhcPs, [(EpAnnCO, LHsExpr GhcPs)])
+ gather list = \case
+ L _ (HsApp epAnn l r) -> gather ((epAnn, r) : list) l
+ x -> (x, list)
+ let (headE, paramEs) = gather [] lexpr
+ let colsOrSequence = case headE of
+ L _ (HsVar _ (L _ (Unqual occname))) ->
+ docCols (ColApp $ Text.pack $ occNameString occname)
+ _ -> docSeq
+ headDoc <- shareDoc $ layoutExpr headE
+ paramDocs <- forM paramEs $ \(epAnn, e) ->
+ shareDoc $ docHandleComms epAnn $ layoutExpr e
let hasComments = hasAnyCommentsConnected exp1
runFilteredAlternative $ do
-- foo x y
@@ -195,9 +191,16 @@ layoutExpr lexpr@(L _ expr) = do
-- foo
-- x
-- y
- addAlternative $ docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
- (docForceSingleline headDoc)
- (docNonBottomSpacing $ docLines paramDocs)
+ addAlternative $ do
+ let checkAllowPar = \case
+ (_, L _ ExplicitTuple{}) -> True
+ (_, L _ ExplicitList{}) -> True
+ (_, L _ HsPar{}) -> True
+ _ -> False
+ let wrap = if all checkAllowPar paramEs then docSetParSpacing else id
+ wrap $ docAddBaseY BrIndentRegular $ docPar
+ (docForceSingleline headDoc)
+ (docNonBottomSpacing $ docLines paramDocs)
-- ( multi
-- line
-- function
@@ -654,11 +657,14 @@ layoutExpr lexpr@(L _ expr) = do
, docAddBaseY BrIndentRegular
$ docPar elseDoc elseExprDoc
]
- HsMultiIf _ cases -> do
+ HsMultiIf epAnn cases -> do
binderDoc <- docLit $ Text.pack "->"
- let hasComments = hasAnyCommentsBelow lexpr
+ let hasComments =
+ hasAnyCommentsBelow epAnn
+ || any (\(L _ (GRHS gEpAnn _ _)) -> hasAnyCommentsBelow gEpAnn) cases
+ let posIf = obtainAnnPos epAnn AnnIf
docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
- (docLit $ Text.pack "if")
+ (docHandleComms posIf $ docLit $ Text.pack "if")
(layoutPatternBindFinal
Nothing
binderDoc