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)
ghc92
Lennart Spitzner 2023-04-19 13:11:26 +00:00
parent 5563cd4d93
commit d29303d4cd
4 changed files with 49 additions and 22 deletions

View File

@ -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

View File

@ -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)

View File

@ -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]
)

View File

@ -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
)