Minor comment updates and cleanup

ghc92
Lennart Spitzner 2023-04-20 21:19:00 +00:00
parent 56e7d6b5b9
commit 52e4658314
4 changed files with 61 additions and 24 deletions

View File

@ -260,7 +260,7 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) = do
let t' = fixPatternBindIdentifier match t let t' = fixPatternBindIdentifier match t
docLit t' docLit t'
_ -> pure Nothing _ -> pure Nothing
patDoc <- docHandleComms lmatch $ case (mIdDoc, patDocs) of patDoc <- docHandleComms lmatch $ case (mIdDoc, patDocs) of -- TODO92 we use lmatch twice here!
(Just idDoc, p1 : p2 : pr) | isInfix -> if null pr (Just idDoc, p1 : p2 : pr) | isInfix -> if null pr
then docCols then docCols
ColPatternsFuncInfix ColPatternsFuncInfix
@ -360,8 +360,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
, docSeparator , docSeparator
, docForceSingleline $ return w , docForceSingleline $ return w
] ]
, -- docMoveToKWDP annKeyWhere AnnWhere False -- TODO92 , docEnsureIndent whereIndent
docEnsureIndent whereIndent
$ docLines $ docLines
[ wrapBinds $ wrapWhere $ docLit $ Text.pack "where" [ wrapBinds $ wrapWhere $ docLit $ Text.pack "where"
, docEnsureIndent whereIndent , docEnsureIndent whereIndent
@ -372,7 +371,6 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
] ]
Just (wrapWhere, ws) -> Just (wrapWhere, ws) ->
fmap (pure . pure) fmap (pure . pure)
-- $ docMoveToKWDP annKeyWhere AnnWhere False -- TODO92
$ docEnsureIndent whereIndent $ docEnsureIndent whereIndent
$ docLines $ docLines
[ wrapBinds $ wrapWhere $ docLit $ Text.pack "where" [ wrapBinds $ wrapWhere $ docLit $ Text.pack "where"
@ -420,8 +418,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
[(grhsEpAnn, guards, body)] -> do [(grhsEpAnn, guards, body)] -> do
let grhsHasComms = hasAnyCommentsBelow grhsEpAnn let grhsHasComms = hasAnyCommentsBelow grhsEpAnn
let guardPart = docHandleComms grhsEpAnn $ singleLineGuardsDoc guards let guardPart = docHandleComms grhsEpAnn $ singleLineGuardsDoc guards
-- func x | null x = x + a + 2 where a = 1
-- or
-- func x | null x = x + a + b where
-- a = 1
-- b = 2
forM_ wherePart $ \wherePart' -> forM_ wherePart $ \wherePart' ->
-- one-line solution
addAlternativeCond (not hasComments && not grhsHasComms) $ docCols addAlternativeCond (not hasComments && not grhsHasComms) $ docCols
(ColBindingLine alignmentToken) (ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart]) [ docSeq (patPartInline ++ [guardPart])
@ -431,7 +433,18 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
, wherePart' , wherePart'
] ]
] ]
-- one-line solution + where in next line(s)
-- any below have this pattern:
-- …
-- where a = 1
-- or
-- …
-- where
-- a = 1
-- b = 1
-- func x | null x = do
-- stmt x
addAlternativeCond (not $ maybe False startsWithComments grhsEpAnn) addAlternativeCond (not $ maybe False startsWithComments grhsEpAnn)
$ docLines $ docLines
$ [ docCols $ [ docCols
@ -450,7 +463,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
-- two-line solution + where in next line(s) -- func x | null x =
-- x + a + 2
addAlternative addAlternative
$ docLines $ docLines
$ [ docForceSingleline $ [ docForceSingleline
@ -460,8 +474,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
$ return body $ return body
] ]
++ wherePartMultiLine ++ wherePartMultiLine
-- pattern and exactly one clause in single line, body as par; -- func x | null x
-- where in following lines -- = do
-- stmt x
-- log "abc"
addAlternative addAlternative
$ docLines $ docLines
$ [ docCols $ [ docCols
@ -480,7 +496,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
-- , docAddBaseY BrIndentRegular $ return body -- , docAddBaseY BrIndentRegular $ return body
-- ] -- ]
++ wherePartMultiLine ++ wherePartMultiLine
-- pattern and exactly one clause in single line, body in new line. -- func x | null x =
-- do
-- stmt1
-- stmt2 x
addAlternative addAlternative
$ docLines $ docLines
$ [ docSeq (patPartInline ++ [guardPart, return binderDoc]) $ [ docSeq (patPartInline ++ [guardPart, return binderDoc])
@ -496,8 +515,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
case mPatDoc of case mPatDoc of
Just patDoc | multipleClauses, indentPolicy == IndentPolicyFree -> Just patDoc | multipleClauses, indentPolicy == IndentPolicyFree ->
-- multiple clauses added in-paragraph, each in a single line -- multiple clauses added in-paragraph, each in a single line
-- example: foo | bar = baz -- func x | null x = baz
-- | lll = asd -- | otherwise = asd
addAlternative addAlternative
$ docLines $ docLines
$ [ docSeq $ [ docSeq
@ -524,7 +543,9 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
] ]
++ wherePartMultiLine ++ wherePartMultiLine
_ -> return () _ -> return ()
-- multiple clauses, each in a separate, single line -- func x y
-- | null x, null y = a + b
-- | otherwise = a - b
addAlternative addAlternative
$ docLines $ docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular
@ -550,8 +571,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
-- multiple clauses, each with the guard(s) in a single line, body -- func x y
-- as a paragraph -- | null x, null y = do
-- stmt x
-- stmt y
-- | otherwise -> do
-- abort
addAlternativeCond (not hasComments) addAlternativeCond (not hasComments)
$ docLines $ docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular
@ -572,8 +597,13 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
-- multiple clauses, each with the guard(s) in a single line, body -- func x y
-- in a new line as a paragraph -- | null x, null y
-- = do
-- stmt x
-- stmt y
-- | otherwise
-- = abort
addAlternative addAlternative
$ docLines $ docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular
@ -593,7 +623,14 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
] ]
] ]
++ wherePartMultiLine ++ wherePartMultiLine
-- conservative approach: everything starts on the left. -- func x y
-- | null x
-- , null y
-- = do
-- stmt x
-- stmt y
-- | otherwise
-- = abort
addAlternative addAlternative
$ docLines $ docLines
$ [ docAddBaseY BrIndentRegular $ [ docAddBaseY BrIndentRegular

View File

@ -672,8 +672,7 @@ layoutExpr lexpr@(L _ expr) = do
IndentPolicyLeft -> docLines noHangingBinds IndentPolicyLeft -> docLines noHangingBinds
IndentPolicyMultiple -> docLines noHangingBinds IndentPolicyMultiple -> docLines noHangingBinds
IndentPolicyFree -> docLines IndentPolicyFree -> docLines
[ -- TODO92 docNodeAnnKW lexpr (Just AnnLet) $ [ docSeq
docSeq
[ appSep $ letDoc [ appSep $ letDoc
, wrapBinds $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs , wrapBinds $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs
] ]
@ -683,8 +682,7 @@ layoutExpr lexpr@(L _ expr) = do
] ]
] ]
addAlternative $ docLines addAlternative $ docLines
[ -- TODO92 docNodeAnnKW lexpr (Just AnnLet) $ [ docAddBaseY BrIndentRegular $ docPar
docAddBaseY BrIndentRegular $ docPar
(letDoc) (letDoc)
(wrapBinds $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs) (wrapBinds $ docSetBaseAndIndent $ docLines $ pure <$> bindDocs)
, docAddBaseY BrIndentRegular , docAddBaseY BrIndentRegular

View File

@ -96,7 +96,9 @@ gatherOpTreeT hasParen hasComms commWrap locOpen locClose opExprList = \case
commWrap commWrap
locOpen locOpen
locClose locClose
((docLit $ printRdrNameWithAnns op1, callLayouter layout_type r1) : opExprList) ( (docLit $ printRdrNameWithAnns op1, callLayouter layout_type r1)
: opExprList
)
l1 l1
(L _ (HsParTy epAnn inner)) -> do (L _ (HsParTy epAnn inner)) -> do
let AnnParen _ spanOpen spanClose = anns epAnn let AnnParen _ spanOpen spanClose = anns epAnn

View File

@ -69,7 +69,7 @@ layoutStmt lstmt@(L _ stmt) = do
in wrapBinds $ f $ return bindDoc in wrapBinds $ f $ return bindDoc
] ]
, -- let , -- let
-- bind = expr -- bind = expr
docAddBaseY BrIndentRegular $ docPar docAddBaseY BrIndentRegular $ docPar
(docLit $ Text.pack "let") (docLit $ Text.pack "let")
(wrapBinds $ docSetBaseAndIndent $ return bindDoc) (wrapBinds $ docSetBaseAndIndent $ return bindDoc)