From d29303d4cd128a166260ddc2ea416cda95f8aaa6 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Wed, 19 Apr 2023 13:11:26 +0000 Subject: [PATCH] Improve one HsLet layout - Allow parSpacing for single-clause layout - Allow par/sl layout when no where-clause was present (not sure why this was disabled in the first place) --- data/15-regressions.blt | 5 +- .../Brittany/Internal/S3_ToBriDocTools.hs | 17 +++++++ .../Brittany/Internal/ToBriDoc/Decl.hs | 47 +++++++++++-------- .../Haskell/Brittany/Internal/Types.hs | 2 +- 4 files changed, 49 insertions(+), 22 deletions(-) diff --git a/data/15-regressions.blt b/data/15-regressions.blt index e8c5ece..972ad84 100644 --- a/data/15-regressions.blt +++ b/data/15-regressions.blt @@ -917,8 +917,9 @@ alignColsLines layoutBriDocM bridocs = do -- colInfos `forM_` \colInfo -> do $ List.intersperse layoutWriteEnsureNewlineBlock $ colInfos <&> processInfo layoutBriDocM colMax processedMap where - (colInfos, finalState) = - StateS.runState (mergeBriDocs bridocs) (ColBuildState IntMapS.empty 0) + (colInfos, finalState) = StateS.runState + (mergeBriDocs bridocs) + (ColBuildState IntMapS.empty 0) -- maxZipper :: [Int] -> [Int] -> [Int] -- maxZipper [] ys = ys -- maxZipper xs [] = xs diff --git a/source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs b/source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs index eb851c1..5a41a01 100644 --- a/source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs +++ b/source/library/Language/Haskell/Brittany/Internal/S3_ToBriDocTools.hs @@ -242,6 +242,19 @@ hasCommentsBetween ast left right = do ) ast +startsWithComments :: EpAnn a -> Bool +startsWithComments = \case + EpAnnNotUsed -> False + EpAnn (GHC.Anchor srcSpan _) _ comms -> case comms of + EpaComments cs -> anyCheck cs + EpaCommentsBalanced comms1 comms2 -> anyCheck comms1 || anyCheck comms2 + where + anyCheck cs = + any + (\(L _ (GHC.EpaComment _ commSpan)) -> + GHC.realSrcSpanStart srcSpan == GHC.realSrcSpanStart commSpan + ) + cs -- mAnn <- astAnn ast @@ -523,6 +536,10 @@ instance DocHandleComms (EpAnn a) (ToBriDocM BriDocNumbered) where ) EpAnnNotUsed -> bdm +instance DocHandleComms (Maybe (EpAnn a)) (ToBriDocM BriDocNumbered) where + docHandleComms Nothing = id + docHandleComms (Just epAnn) = docHandleComms epAnn + instance DocHandleComms (GHC.RealSrcSpan) (ToBriDocM BriDocNumbered) where docHandleComms loc = docHandleComms (GHC.realSrcSpanStart loc) diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs index 04cd4ee..884262c 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs @@ -229,7 +229,7 @@ layoutLocalBinds binds = case binds of layoutGrhs :: LGRHS GhcPs (LHsExpr GhcPs) -> ToBriDocM - ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered + ( Maybe (EpAnn GrhsAnn) , [BriDocNumbered] , BriDocNumbered ) @@ -239,7 +239,7 @@ layoutGrhs (L _ (GRHS epAnn guards body)) = do [] -> pure [] _ -> docFlushCommsPost False posArrow $ callLayouter layout_stmt `mapM` guards bodyDoc <- callLayouter layout_expr body - return (docHandleComms epAnn, guardDocs, bodyDoc) + return (Just epAnn, guardDocs, bodyDoc) layoutPatternBind :: Maybe Text @@ -409,17 +409,18 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe clauseDocs <- case clauses of Left expr -> do e <- callLayouter layout_expr expr - pure [(id, [], e)] + pure [(Nothing, [], e)] Right grhss -> layoutGrhs `mapM` grhss runFilteredAlternative $ do case clauseDocs of - [(wrapClause, guards, body)] -> do - let guardPart = wrapClause $ singleLineGuardsDoc guards + [(grhsEpAnn, guards, body)] -> do + let grhsHasComms = hasAnyCommentsBelow grhsEpAnn + let guardPart = docHandleComms grhsEpAnn $ singleLineGuardsDoc guards forM_ wherePart $ \wherePart' -> -- one-line solution - addAlternativeCond (not hasComments) $ docCols + addAlternativeCond (not hasComments && not grhsHasComms) $ docCols (ColBindingLine alignmentToken) [ docSeq (patPartInline ++ [guardPart]) , docSeq @@ -429,13 +430,17 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe ] ] -- one-line solution + where in next line(s) - addAlternativeCond (Data.Maybe.isJust mWhereDocs) + addAlternativeCond (not $ maybe False startsWithComments grhsEpAnn) $ docLines $ [ docCols (ColBindingLine alignmentToken) [ docSeq (patPartInline ++ [guardPart]) , docSeq [ appSep $ return binderDoc + -- TODO I did it this way just to reduce test breakage, + -- but arguably we should modify tests instead. + -- I _think_ we really want to drop this alternative + -- when grhsHasComms , docForceParSpacing $ docAddBaseY BrIndentRegular $ return body @@ -499,7 +504,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe , docSetBaseY $ docLines $ clauseDocs - <&> \(wrapClause, guardDocs, bodyDoc) -> wrapClause $ do -- TODO92 + <&> \(epAnn, guardDocs, bodyDoc) -> docHandleComms epAnn $ do let guardPart = singleLineGuardsDoc guardDocs -- the docForceSingleline might seems superflous, but it -- helps the alternative resolving impl. @@ -525,7 +530,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe $ docLines $ map docSetBaseY $ clauseDocs - <&> \(wrapClause, guardDocs, bodyDoc) -> wrapClause $ do -- TODO92 + <&> \(epAnn, guardDocs, bodyDoc) -> docHandleComms epAnn $ do let guardPart = singleLineGuardsDoc guardDocs -- the docForceSingleline might seems superflous, but it -- helps the alternative resolving impl. @@ -552,8 +557,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe $ docLines $ map docSetBaseY $ clauseDocs - <&> \(wrapClause, guardDocs, bodyDoc) -> -- TODO92 - wrapClause $ docSeq + <&> \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92 + docHandleComms grhsEpAnn $ docSeq $ (case guardDocs of [] -> [] [g] -> @@ -587,15 +592,15 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe $ docLines $ map docSetBaseY $ clauseDocs - >>= \(wrapClause, guardDocs, bodyDoc) -> -- TODO92 + >>= \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92 (case guardDocs of - [] -> [wrapClause docEmpty] + [] -> [docHandleComms grhsEpAnn docEmpty] [g] -> - [ wrapClause $ docForceSingleline + [ docHandleComms grhsEpAnn $ docForceSingleline $ docSeq [appSep $ docLit $ Text.pack "|", return g] ] gs -> - [ wrapClause $ docForceSingleline + [ docHandleComms grhsEpAnn $ docForceSingleline $ docSeq $ [appSep $ docLit $ Text.pack "|"] ++ List.intersperse docCommaSep (return <$> gs) @@ -619,14 +624,18 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe $ docLines $ map docSetBaseY $ clauseDocs - >>= \(wrapClause, guardDocs, bodyDoc) -> -- TODO92 + >>= \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92 (case guardDocs of - [] -> [wrapClause docEmpty] + [] -> [docHandleComms grhsEpAnn docEmpty] [g] -> - [ wrapClause $ docSeq [appSep $ docLit $ Text.pack "|", return g] + [ docHandleComms grhsEpAnn + $ docSeq [appSep + $ docLit $ Text.pack "|", return g] ] (g1 : gr) -> - ( (wrapClause $ docSeq [appSep $ docLit $ Text.pack "|", return g1]) + ( ( docHandleComms grhsEpAnn + $ docSeq [appSep $ docLit $ Text.pack "|", return g1] + ) : (gr <&> \g -> docSeq [appSep $ docLit $ Text.pack ",", return g] ) diff --git a/source/library/Language/Haskell/Brittany/Internal/Types.hs b/source/library/Language/Haskell/Brittany/Internal/Types.hs index 7d8ce6a..6901ace 100644 --- a/source/library/Language/Haskell/Brittany/Internal/Types.hs +++ b/source/library/Language/Haskell/Brittany/Internal/Types.hs @@ -202,7 +202,7 @@ data Layouters = Layouters , layout_grhs :: GHC.LGRHS GhcPs (GHC.LHsExpr GhcPs) -> ToBriDocM - ( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered + ( Maybe (GHC.EpAnn GHC.GrhsAnn) , [BriDocNumbered] , BriDocNumbered )