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
|
$ List.intersperse layoutWriteEnsureNewlineBlock
|
||||||
$ colInfos <&> processInfo layoutBriDocM colMax processedMap
|
$ colInfos <&> processInfo layoutBriDocM colMax processedMap
|
||||||
where
|
where
|
||||||
(colInfos, finalState) =
|
(colInfos, finalState) = StateS.runState
|
||||||
StateS.runState (mergeBriDocs bridocs) (ColBuildState IntMapS.empty 0)
|
(mergeBriDocs bridocs)
|
||||||
|
(ColBuildState IntMapS.empty 0)
|
||||||
-- maxZipper :: [Int] -> [Int] -> [Int]
|
-- maxZipper :: [Int] -> [Int] -> [Int]
|
||||||
-- maxZipper [] ys = ys
|
-- maxZipper [] ys = ys
|
||||||
-- maxZipper xs [] = xs
|
-- maxZipper xs [] = xs
|
||||||
|
|
|
@ -242,6 +242,19 @@ hasCommentsBetween ast left right = do
|
||||||
)
|
)
|
||||||
ast
|
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
|
-- mAnn <- astAnn ast
|
||||||
|
@ -523,6 +536,10 @@ instance DocHandleComms (EpAnn a) (ToBriDocM BriDocNumbered) where
|
||||||
)
|
)
|
||||||
EpAnnNotUsed -> bdm
|
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
|
instance DocHandleComms (GHC.RealSrcSpan) (ToBriDocM BriDocNumbered) where
|
||||||
docHandleComms loc = docHandleComms (GHC.realSrcSpanStart loc)
|
docHandleComms loc = docHandleComms (GHC.realSrcSpanStart loc)
|
||||||
|
|
||||||
|
|
|
@ -229,7 +229,7 @@ layoutLocalBinds binds = case binds of
|
||||||
layoutGrhs
|
layoutGrhs
|
||||||
:: LGRHS GhcPs (LHsExpr GhcPs)
|
:: LGRHS GhcPs (LHsExpr GhcPs)
|
||||||
-> ToBriDocM
|
-> ToBriDocM
|
||||||
( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
( Maybe (EpAnn GrhsAnn)
|
||||||
, [BriDocNumbered]
|
, [BriDocNumbered]
|
||||||
, BriDocNumbered
|
, BriDocNumbered
|
||||||
)
|
)
|
||||||
|
@ -239,7 +239,7 @@ layoutGrhs (L _ (GRHS epAnn guards body)) = do
|
||||||
[] -> pure []
|
[] -> pure []
|
||||||
_ -> docFlushCommsPost False posArrow $ callLayouter layout_stmt `mapM` guards
|
_ -> docFlushCommsPost False posArrow $ callLayouter layout_stmt `mapM` guards
|
||||||
bodyDoc <- callLayouter layout_expr body
|
bodyDoc <- callLayouter layout_expr body
|
||||||
return (docHandleComms epAnn, guardDocs, bodyDoc)
|
return (Just epAnn, guardDocs, bodyDoc)
|
||||||
|
|
||||||
layoutPatternBind
|
layoutPatternBind
|
||||||
:: Maybe Text
|
:: Maybe Text
|
||||||
|
@ -409,17 +409,18 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
|
||||||
clauseDocs <- case clauses of
|
clauseDocs <- case clauses of
|
||||||
Left expr -> do
|
Left expr -> do
|
||||||
e <- callLayouter layout_expr expr
|
e <- callLayouter layout_expr expr
|
||||||
pure [(id, [], e)]
|
pure [(Nothing, [], e)]
|
||||||
Right grhss -> layoutGrhs `mapM` grhss
|
Right grhss -> layoutGrhs `mapM` grhss
|
||||||
|
|
||||||
runFilteredAlternative $ do
|
runFilteredAlternative $ do
|
||||||
|
|
||||||
case clauseDocs of
|
case clauseDocs of
|
||||||
[(wrapClause, guards, body)] -> do
|
[(grhsEpAnn, guards, body)] -> do
|
||||||
let guardPart = wrapClause $ singleLineGuardsDoc guards
|
let grhsHasComms = hasAnyCommentsBelow grhsEpAnn
|
||||||
|
let guardPart = docHandleComms grhsEpAnn $ singleLineGuardsDoc guards
|
||||||
forM_ wherePart $ \wherePart' ->
|
forM_ wherePart $ \wherePart' ->
|
||||||
-- one-line solution
|
-- one-line solution
|
||||||
addAlternativeCond (not hasComments) $ docCols
|
addAlternativeCond (not hasComments && not grhsHasComms) $ docCols
|
||||||
(ColBindingLine alignmentToken)
|
(ColBindingLine alignmentToken)
|
||||||
[ docSeq (patPartInline ++ [guardPart])
|
[ docSeq (patPartInline ++ [guardPart])
|
||||||
, docSeq
|
, docSeq
|
||||||
|
@ -429,13 +430,17 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
-- one-line solution + where in next line(s)
|
-- one-line solution + where in next line(s)
|
||||||
addAlternativeCond (Data.Maybe.isJust mWhereDocs)
|
addAlternativeCond (not $ maybe False startsWithComments grhsEpAnn)
|
||||||
$ docLines
|
$ docLines
|
||||||
$ [ docCols
|
$ [ docCols
|
||||||
(ColBindingLine alignmentToken)
|
(ColBindingLine alignmentToken)
|
||||||
[ docSeq (patPartInline ++ [guardPart])
|
[ docSeq (patPartInline ++ [guardPart])
|
||||||
, docSeq
|
, docSeq
|
||||||
[ appSep $ return binderDoc
|
[ 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
|
, docForceParSpacing
|
||||||
$ docAddBaseY BrIndentRegular
|
$ docAddBaseY BrIndentRegular
|
||||||
$ return body
|
$ return body
|
||||||
|
@ -499,7 +504,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
|
||||||
, docSetBaseY
|
, docSetBaseY
|
||||||
$ docLines
|
$ docLines
|
||||||
$ clauseDocs
|
$ clauseDocs
|
||||||
<&> \(wrapClause, guardDocs, bodyDoc) -> wrapClause $ do -- TODO92
|
<&> \(epAnn, guardDocs, bodyDoc) -> docHandleComms epAnn $ do
|
||||||
let guardPart = singleLineGuardsDoc guardDocs
|
let guardPart = singleLineGuardsDoc guardDocs
|
||||||
-- the docForceSingleline might seems superflous, but it
|
-- the docForceSingleline might seems superflous, but it
|
||||||
-- helps the alternative resolving impl.
|
-- helps the alternative resolving impl.
|
||||||
|
@ -525,7 +530,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
|
||||||
$ docLines
|
$ docLines
|
||||||
$ map docSetBaseY
|
$ map docSetBaseY
|
||||||
$ clauseDocs
|
$ clauseDocs
|
||||||
<&> \(wrapClause, guardDocs, bodyDoc) -> wrapClause $ do -- TODO92
|
<&> \(epAnn, guardDocs, bodyDoc) -> docHandleComms epAnn $ do
|
||||||
let guardPart = singleLineGuardsDoc guardDocs
|
let guardPart = singleLineGuardsDoc guardDocs
|
||||||
-- the docForceSingleline might seems superflous, but it
|
-- the docForceSingleline might seems superflous, but it
|
||||||
-- helps the alternative resolving impl.
|
-- helps the alternative resolving impl.
|
||||||
|
@ -552,8 +557,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
|
||||||
$ docLines
|
$ docLines
|
||||||
$ map docSetBaseY
|
$ map docSetBaseY
|
||||||
$ clauseDocs
|
$ clauseDocs
|
||||||
<&> \(wrapClause, guardDocs, bodyDoc) -> -- TODO92
|
<&> \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92
|
||||||
wrapClause $ docSeq
|
docHandleComms grhsEpAnn $ docSeq
|
||||||
$ (case guardDocs of
|
$ (case guardDocs of
|
||||||
[] -> []
|
[] -> []
|
||||||
[g] ->
|
[g] ->
|
||||||
|
@ -587,15 +592,15 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
|
||||||
$ docLines
|
$ docLines
|
||||||
$ map docSetBaseY
|
$ map docSetBaseY
|
||||||
$ clauseDocs
|
$ clauseDocs
|
||||||
>>= \(wrapClause, guardDocs, bodyDoc) -> -- TODO92
|
>>= \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92
|
||||||
(case guardDocs of
|
(case guardDocs of
|
||||||
[] -> [wrapClause docEmpty]
|
[] -> [docHandleComms grhsEpAnn docEmpty]
|
||||||
[g] ->
|
[g] ->
|
||||||
[ wrapClause $ docForceSingleline
|
[ docHandleComms grhsEpAnn $ docForceSingleline
|
||||||
$ docSeq [appSep $ docLit $ Text.pack "|", return g]
|
$ docSeq [appSep $ docLit $ Text.pack "|", return g]
|
||||||
]
|
]
|
||||||
gs ->
|
gs ->
|
||||||
[ wrapClause $ docForceSingleline
|
[ docHandleComms grhsEpAnn $ docForceSingleline
|
||||||
$ docSeq
|
$ docSeq
|
||||||
$ [appSep $ docLit $ Text.pack "|"]
|
$ [appSep $ docLit $ Text.pack "|"]
|
||||||
++ List.intersperse docCommaSep (return <$> gs)
|
++ List.intersperse docCommaSep (return <$> gs)
|
||||||
|
@ -619,14 +624,18 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
|
||||||
$ docLines
|
$ docLines
|
||||||
$ map docSetBaseY
|
$ map docSetBaseY
|
||||||
$ clauseDocs
|
$ clauseDocs
|
||||||
>>= \(wrapClause, guardDocs, bodyDoc) -> -- TODO92
|
>>= \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92
|
||||||
(case guardDocs of
|
(case guardDocs of
|
||||||
[] -> [wrapClause docEmpty]
|
[] -> [docHandleComms grhsEpAnn docEmpty]
|
||||||
[g] ->
|
[g] ->
|
||||||
[ wrapClause $ docSeq [appSep $ docLit $ Text.pack "|", return g]
|
[ docHandleComms grhsEpAnn
|
||||||
|
$ docSeq [appSep
|
||||||
|
$ docLit $ Text.pack "|", return g]
|
||||||
]
|
]
|
||||||
(g1 : gr) ->
|
(g1 : gr) ->
|
||||||
( (wrapClause $ docSeq [appSep $ docLit $ Text.pack "|", return g1])
|
( ( docHandleComms grhsEpAnn
|
||||||
|
$ docSeq [appSep $ docLit $ Text.pack "|", return g1]
|
||||||
|
)
|
||||||
: (gr <&> \g ->
|
: (gr <&> \g ->
|
||||||
docSeq [appSep $ docLit $ Text.pack ",", return g]
|
docSeq [appSep $ docLit $ Text.pack ",", return g]
|
||||||
)
|
)
|
||||||
|
|
|
@ -202,7 +202,7 @@ data Layouters = Layouters
|
||||||
, layout_grhs
|
, layout_grhs
|
||||||
:: GHC.LGRHS GhcPs (GHC.LHsExpr GhcPs)
|
:: GHC.LGRHS GhcPs (GHC.LHsExpr GhcPs)
|
||||||
-> ToBriDocM
|
-> ToBriDocM
|
||||||
( ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
( Maybe (GHC.EpAnn GHC.GrhsAnn)
|
||||||
, [BriDocNumbered]
|
, [BriDocNumbered]
|
||||||
, BriDocNumbered
|
, BriDocNumbered
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue