diff --git a/CHANGELOG.md b/CHANGELOG.md index a89a23d..4bf8f37 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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: diff --git a/data/examples/declaration/value/function/comprehension/transform-monad-out.hs b/data/examples/declaration/value/function/comprehension/transform-monad-out.hs index eeffad7..acf986e 100644 --- a/data/examples/declaration/value/function/comprehension/transform-monad-out.hs +++ b/data/examples/declaration/value/function/comprehension/transform-monad-out.hs @@ -5,14 +5,14 @@ quux' xs ys = [ ( x, y ) - | x <- xs, - y <- ys, - then group by - -- First comment - ( x - + y - ) - using - -- Second comment - groupWith -- Third comment + | x <- xs, + y <- ys, + then group by + -- First comment + ( x + + y + ) + using + -- Second comment + groupWith -- Third comment ] diff --git a/data/examples/declaration/value/function/comprehension/transform-multi-line1-out.hs b/data/examples/declaration/value/function/comprehension/transform-multi-line1-out.hs index d38ce0d..417643a 100644 --- a/data/examples/declaration/value/function/comprehension/transform-multi-line1-out.hs +++ b/data/examples/declaration/value/function/comprehension/transform-multi-line1-out.hs @@ -4,9 +4,9 @@ foo' xs ys = [ ( x, y ) - | x <- xs, - y <- ys, - then - -- First comment - reverse -- Second comment + | x <- xs, + y <- ys, + then + -- First comment + reverse -- Second comment ] diff --git a/data/examples/declaration/value/function/comprehension/transform-multi-line2-out.hs b/data/examples/declaration/value/function/comprehension/transform-multi-line2-out.hs index 0c0dff8..26d07d0 100644 --- a/data/examples/declaration/value/function/comprehension/transform-multi-line2-out.hs +++ b/data/examples/declaration/value/function/comprehension/transform-multi-line2-out.hs @@ -4,13 +4,13 @@ bar' xs ys = [ ( x, y ) - | x <- xs, - y <- ys, - then - -- First comment - sortWith - by - ( x - + y -- Second comment - ) + | x <- xs, + y <- ys, + then + -- First comment + sortWith + by + ( x + + y -- Second comment + ) ] diff --git a/data/examples/declaration/value/function/comprehension/transform-multi-line3-out.hs b/data/examples/declaration/value/function/comprehension/transform-multi-line3-out.hs index ac51b17..ebd17f9 100644 --- a/data/examples/declaration/value/function/comprehension/transform-multi-line3-out.hs +++ b/data/examples/declaration/value/function/comprehension/transform-multi-line3-out.hs @@ -4,9 +4,9 @@ baz' xs ys = [ ( x, y ) - | x <- xs, - y <- ys, - then group using - -- First comment - permutations -- Second comment + | x <- xs, + y <- ys, + then group using + -- First comment + permutations -- Second comment ] diff --git a/data/examples/declaration/value/function/comprehension/transform-multi-line4-out.hs b/data/examples/declaration/value/function/comprehension/transform-multi-line4-out.hs index a79bace..e09251d 100644 --- a/data/examples/declaration/value/function/comprehension/transform-multi-line4-out.hs +++ b/data/examples/declaration/value/function/comprehension/transform-multi-line4-out.hs @@ -4,14 +4,14 @@ quux' xs ys = [ ( x, y ) - | x <- xs, - y <- ys, - then group by - -- First comment - ( x - + y - ) - using - -- Second comment - groupWith -- Third comment + | x <- xs, + y <- ys, + then group by + -- First comment + ( x + + y + ) + using + -- Second comment + groupWith -- Third comment ] diff --git a/data/examples/declaration/value/function/list-comprehensions-out.hs b/data/examples/declaration/value/function/list-comprehensions-out.hs index 86c4149..80f292f 100644 --- a/data/examples/declaration/value/function/list-comprehensions-out.hs +++ b/data/examples/declaration/value/function/list-comprehensions-out.hs @@ -4,35 +4,40 @@ bar x y = [(a, b) | a <- x, even a, b <- y, a != b] barbaz x y z w = [ (a, b, c, d) -- Foo - | a <- - x, -- Bar - b <- y, -- Baz - any even [a, b], - c <- - z - * z ^ 2, -- Bar baz - d <- - w - + w, -- Baz bar - all - even - [ a, - b, - c, - d - ] + | a <- + x, -- Bar + b <- y, -- Baz + any even [a, b], + c <- + z + * z ^ 2, -- Bar baz + d <- + w + + w, -- Baz bar + all + even + [ a, + b, + c, + d + ] ] a = do + d <- + [ x + 1 + | x <- b + ] + [ c | c <- d ] trans = [ x - | x <- xs, - then - reverse, - then - reverse + | x <- xs, + then + reverse, + then + reverse ] diff --git a/data/examples/declaration/value/function/list-comprehensions.hs b/data/examples/declaration/value/function/list-comprehensions.hs index 68cd805..0f12a55 100644 --- a/data/examples/declaration/value/function/list-comprehensions.hs +++ b/data/examples/declaration/value/function/list-comprehensions.hs @@ -22,6 +22,11 @@ barbaz x y z w = [ ] a = do + d <- + [ x + 1 + | x <- b + ] + [ c | c <- d ] diff --git a/data/examples/declaration/value/function/parallel-comprehensions-complex-out.hs b/data/examples/declaration/value/function/parallel-comprehensions-complex-out.hs index 1f03620..5715bd8 100644 --- a/data/examples/declaration/value/function/parallel-comprehensions-complex-out.hs +++ b/data/examples/declaration/value/function/parallel-comprehensions-complex-out.hs @@ -10,26 +10,26 @@ baz x y z w = i, j ) - | a <- -- Foo 1 - x, -- Foo 2 - b <- -- Bar 1 - y, -- Bar 2 + | a <- -- Foo 1 + x, -- Foo 2 + b <- -- Bar 1 + y, -- Bar 2 + a + `mod` b -- Value + == 0 + | c <- -- Baz 1 + z + * z -- Baz 2 + -- Baz 3 + | d <- w -- Other + | e <- x * x -- Foo bar + | f <- -- Foo baz 1 + y + y -- Foo baz 2 + | h <- z + z * w ^ 2 -- Bar foo + | i <- -- Bar bar 1 a - `mod` b -- Value - == 0 - | c <- -- Baz 1 - z - * z -- Baz 2 - -- Baz 3 - | d <- w -- Other - | e <- x * x -- Foo bar - | f <- -- Foo baz 1 - y + y -- Foo baz 2 - | h <- z + z * w ^ 2 -- Bar foo - | i <- -- Bar bar 1 - a - + b, -- Bar bar 2 - -- Bar bar 3 - j <- -- Bar baz 1 - a + b -- Bar baz 2 + + b, -- Bar bar 2 + -- Bar bar 3 + j <- -- Bar baz 1 + a + b -- Bar baz 2 ] diff --git a/expected-failures/hlint.txt b/expected-failures/hlint.txt index 49c3136..dcc5d46 100644 --- a/expected-failures/hlint.txt +++ b/expected-failures/hlint.txt @@ -14,8 +14,8 @@ src/Extension.hs Please, consider reporting the bug. src/Hint/Bracket.hs @@ -265,8 +265,11 @@ - let y = noLocA $ HsApp EpAnnNotUsed a1 (nlHsPar a2), - let r = Replace Expr (toSSA e) [("a", toSSA a1), ("b", toSSA a2)] "a (b)" + let y = noLocA $ HsApp EpAnnNotUsed a1 (nlHsPar a2), + let r = Replace Expr (toSSA e) [("a", toSSA a1), ("b", toSSA a2)] "a (b)" ] - ++ [ (suggest "Redundant bracket" (reLoc x) (reLoc y) [r]) {ideaSpan -- Special case of (v1 . v2) <$> v3 - = locA locPar} @@ -24,9 +24,9 @@ src/Hint/Bracket.hs + = + locA locPar + } - | L _ (OpApp _ (L locPar (HsPar _ _ o1@(L locNoPar (OpApp _ _ (isDot -> True) _)) _)) o2 v3) <- [x], - varToStr o2 == "<$>", - let y = noLocA (OpApp EpAnnNotUsed o1 o2 v3) :: LHsExpr GhcPs, + | L _ (OpApp _ (L locPar (HsPar _ _ o1@(L locNoPar (OpApp _ _ (isDot -> True) _)) _)) o2 v3) <- [x], + varToStr o2 == "<$>", + let y = noLocA (OpApp EpAnnNotUsed o1 o2 v3) :: LHsExpr GhcPs, Formatting is not idempotent. Please, consider reporting the bug. diff --git a/src/Ormolu/Printer/Meat/Declaration/Data.hs b/src/Ormolu/Printer/Meat/Declaration/Data.hs index e19b675..31e56b8 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Data.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Data.hs @@ -239,8 +239,8 @@ p_conDecl singleRecCon ConDeclH98 {..} = conNameWithContextSpn = [ RealSrcSpan real Strict.Nothing - | EpaSpan (RealSrcSpan real _) <- - mapMaybe (matchAddEpAnn AnnForall) con_ext + | EpaSpan (RealSrcSpan real _) <- + mapMaybe (matchAddEpAnn AnnForall) con_ext ] <> fmap getLocA con_ex_tvs <> maybeToList (fmap getLocA con_mb_cxt) diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs b/src/Ormolu/Printer/Meat/Declaration/Value.hs index 38dfe55..10dfa77 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Value.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs @@ -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: @@ -927,7 +949,7 @@ gatherStmts = \case -- will be ParStmt. [L _ (ParStmt _ blocks _ _)] -> [ concatMap collectNonParStmts stmts - | ParStmtBlock _ stmts _ _ <- blocks + | ParStmtBlock _ stmts _ _ <- blocks ] -- Otherwise, list will not contain any ParStmt stmts ->