mirror of
https://github.com/tweag/ormolu.git
synced 2024-10-05 17:37:11 +03:00
Remove unnecessary indentation from list comprehensions
This commit is contained in:
parent
27ec3fba23
commit
5c816dee59
@ -6,6 +6,9 @@
|
||||
* Don't require a trailing newline in `.ormolu` files. [Issue
|
||||
1122](https://github.com/tweag/ormolu/issues/1122).
|
||||
|
||||
* Remove unnecessary indentation from list comprehensions. [Issue
|
||||
966](https://github.com/tweag/ormolu/issues/966).
|
||||
|
||||
## Ormolu 0.7.5.0
|
||||
|
||||
* Switched to `ghc-lib-parser-9.10`, with the following new syntactic features/behaviors:
|
||||
|
@ -24,6 +24,11 @@ barbaz x y z w =
|
||||
]
|
||||
|
||||
a = do
|
||||
d <-
|
||||
[ x + 1
|
||||
| x <- b
|
||||
]
|
||||
|
||||
[ c
|
||||
| c <- d
|
||||
]
|
||||
|
@ -22,6 +22,11 @@ barbaz x y z w = [
|
||||
]
|
||||
|
||||
a = do
|
||||
d <-
|
||||
[ x + 1
|
||||
| x <- b
|
||||
]
|
||||
|
||||
[ c
|
||||
| c <- d ]
|
||||
|
||||
|
@ -382,7 +382,7 @@ p_hsCmd' isApp s = \case
|
||||
p_let p_hsCmd localBinds c
|
||||
HsCmdDo _ es -> do
|
||||
txt "do"
|
||||
p_stmts isApp cmdPlacement (p_hsCmd' NotApplicand S) es
|
||||
p_stmts S isApp cmdPlacement (p_hsCmd' NotApplicand) es
|
||||
|
||||
-- | Print a top-level command.
|
||||
p_hsCmdTop :: BracketStyle -> HsCmdTop GhcPs -> R ()
|
||||
@ -418,21 +418,22 @@ withSpacing f l = located l $ \x -> do
|
||||
_ -> setSpanMark (StatementSpan currentSpn)
|
||||
|
||||
p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
|
||||
p_stmt = p_stmt' exprPlacement p_hsExpr
|
||||
p_stmt = p_stmt' N exprPlacement (p_hsExpr' NotApplicand)
|
||||
|
||||
p_stmt' ::
|
||||
( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
|
||||
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
|
||||
) =>
|
||||
BracketStyle ->
|
||||
-- | Placer
|
||||
(body -> Placement) ->
|
||||
-- | Render
|
||||
(body -> R ()) ->
|
||||
(BracketStyle -> body -> R ()) ->
|
||||
-- | Statement to render
|
||||
Stmt GhcPs (LocatedA body) ->
|
||||
R ()
|
||||
p_stmt' placer render = \case
|
||||
LastStmt _ body _ _ -> located body render
|
||||
p_stmt' s placer render = \case
|
||||
LastStmt _ body _ _ -> located body (render s)
|
||||
BindStmt _ p f@(getLocA -> l) -> do
|
||||
located p p_pat
|
||||
space
|
||||
@ -442,9 +443,9 @@ p_stmt' placer render = \case
|
||||
| isOneLineSpan (mkSrcSpan (srcSpanEnd loc) (srcSpanStart l)) = placer (unLoc f)
|
||||
| otherwise = Normal
|
||||
switchLayout [loc, l] $
|
||||
placeHanging placement (located f render)
|
||||
placeHanging placement (located f (render N))
|
||||
ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer
|
||||
BodyStmt _ body _ _ -> located body render
|
||||
BodyStmt _ body _ _ -> located body (render s)
|
||||
LetStmt _ binds -> do
|
||||
txt "let"
|
||||
space
|
||||
@ -486,25 +487,26 @@ p_stmt' placer render = \case
|
||||
RecStmt {..} -> do
|
||||
txt "rec"
|
||||
space
|
||||
sitcc . located recS_stmts $ sepSemi (withSpacing (p_stmt' placer render))
|
||||
sitcc . located recS_stmts $ sepSemi (withSpacing (p_stmt' s placer render))
|
||||
|
||||
p_stmts ::
|
||||
( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
|
||||
Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
|
||||
) =>
|
||||
BracketStyle ->
|
||||
IsApplicand ->
|
||||
-- | Placer
|
||||
(body -> Placement) ->
|
||||
-- | Render
|
||||
(body -> R ()) ->
|
||||
(BracketStyle -> body -> R ()) ->
|
||||
-- | Statements to render
|
||||
LocatedL [LocatedA (Stmt GhcPs (LocatedA body))] ->
|
||||
R ()
|
||||
p_stmts isApp placer render es = do
|
||||
p_stmts s isApp placer render es = do
|
||||
breakpoint
|
||||
ub <- layoutToBraces <$> getLayout
|
||||
let p_stmtExt (relPos, stmt) =
|
||||
ub' $ withSpacing (p_stmt' placer render) stmt
|
||||
ub' $ withSpacing (p_stmt' s placer render) stmt
|
||||
where
|
||||
-- We need to set brace usage information for all but the last
|
||||
-- statement (e.g.in the case of nested do blocks).
|
||||
@ -743,30 +745,12 @@ p_hsExpr' isApp s = \case
|
||||
let doBody moduleName header = do
|
||||
forM_ moduleName $ \m -> atom m *> txt "."
|
||||
txt header
|
||||
p_stmts isApp exprPlacement (p_hsExpr' NotApplicand S) es
|
||||
compBody = brackets s . located es $ \xs -> do
|
||||
let p_parBody =
|
||||
sep
|
||||
(breakpoint >> txt "|" >> space)
|
||||
p_seqBody
|
||||
p_seqBody =
|
||||
sitcc
|
||||
. sep
|
||||
commaDel
|
||||
(located' (sitcc . p_stmt))
|
||||
stmts = init xs
|
||||
yield = last xs
|
||||
lists = gatherStmts stmts
|
||||
located yield p_stmt
|
||||
breakpoint
|
||||
txt "|"
|
||||
space
|
||||
p_parBody lists
|
||||
p_stmts S isApp exprPlacement (p_hsExpr' NotApplicand) es
|
||||
case doFlavor of
|
||||
DoExpr moduleName -> doBody moduleName "do"
|
||||
MDoExpr moduleName -> doBody moduleName "mdo"
|
||||
ListComp -> compBody
|
||||
MonadComp -> compBody
|
||||
ListComp -> p_listComp s es
|
||||
MonadComp -> p_listComp s es
|
||||
GhciStmtCtxt -> notImplemented "GhciStmtCtxt"
|
||||
ExplicitList _ xs ->
|
||||
brackets s $
|
||||
@ -867,6 +851,44 @@ p_hsExpr' isApp s = \case
|
||||
space
|
||||
located hswc_body p_hsType
|
||||
|
||||
-- | Print a list comprehension.
|
||||
--
|
||||
-- BracketStyle should be N except in a do-block, which must be S or else it's a parse error.
|
||||
p_listComp :: BracketStyle -> GenLocated SrcSpanAnnL [ExprLStmt GhcPs] -> R ()
|
||||
p_listComp s es = sitcc (vlayout singleLine multiLine)
|
||||
where
|
||||
singleLine = do
|
||||
txt "["
|
||||
body
|
||||
txt "]"
|
||||
multiLine = do
|
||||
txt "[" >> space
|
||||
(if s == S then sitcc else id) $ do
|
||||
body
|
||||
newline
|
||||
txt "]"
|
||||
|
||||
body = located es p_body
|
||||
p_body xs = do
|
||||
let (stmts, yield) =
|
||||
-- TODO: use unsnoc when require GHC 9.8+
|
||||
case xs of
|
||||
[] -> error $ "list comprehension unexpectedly had no expressions"
|
||||
_ -> (init xs, last xs)
|
||||
sitcc $ located yield p_stmt
|
||||
breakpoint
|
||||
txt "|"
|
||||
space
|
||||
p_bodyParallels (gatherStmts stmts)
|
||||
|
||||
-- print the list of list comprehension sections, e.g.
|
||||
-- [ "| x <- xs, y <- ys, let z = x <> y", "| a <- f z" ]
|
||||
p_bodyParallels = sep (breakpoint >> txt "|" >> space) (sitcc . p_bodyParallelStmts)
|
||||
|
||||
-- print a list comprehension section within a pipe, e.g.
|
||||
-- [ "x <- xs", "y <- ys", "let z = x <> y" ]
|
||||
p_bodyParallelStmts = sep commaDel (located' (sitcc . p_stmt))
|
||||
|
||||
-- | Gather the set of statements in a list comprehension.
|
||||
--
|
||||
-- For example, this code:
|
||||
|
Loading…
Reference in New Issue
Block a user