From 83b13d61a09451b47389f9dd36aa269b0633a99a Mon Sep 17 00:00:00 2001 From: Lennart Spitzner 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