Remove unnecessary indentation from list comprehensions

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:

data/examples/declaration/value/function/list-comprehensions-out.hs

@@ -24,6 +24,11 @@ barbaz x y z w =
   ]
 
 a = do
+  d <-
+    [ x + 1
+    | x <- b
+    ]
+
   [ c
     | c <- d
     ]

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 ]
 

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
+p_stmt' s placer render = \case
-  LastStmt _ body _ _ -> located body render
+  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
+          p_stmts S isApp exprPlacement (p_hsExpr' NotApplicand) 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
     case doFlavor of
       DoExpr moduleName -> doBody moduleName "do"
       MDoExpr moduleName -> doBody moduleName "mdo"
-      ListComp -> compBody
+      ListComp -> p_listComp s es
-      MonadComp -> compBody
+      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: