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
parent
5563cd4d93
commit
d29303d4cd
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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]
|
||||
)
|
||||
|
|
|
@ -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
|
||||
)
|
||||
|
|
Loading…
Reference in New Issue