@@ -91,7 +91,7 @@ p_matchGroup'
9191 -> MatchGroupStyle -- ^ Style of this group of equations
9292 -> MatchGroup GhcPs (Located body) -- ^ Match group
9393 -> R ()
94−p_matchGroup' placer pretty style MG {..} = do
94+p_matchGroup' placer render style MG {..} = do
9595 let ob = case style of
9696 Case -> id
9797 LambdaCase -> id
@@ -104,7 +104,7 @@ p_matchGroup' placer pretty style MG {..} = do
104104 p_Match m@Match {..} =
105105 p_match'
106106 placer
107− pretty
107+ render
108108 (adjustMatchGroupStyle m style)
109109 (isInfixMatch m)
110110 (matchStrictness m)
@@ -153,7 +153,7 @@ p_match'
153153 -> [LPat GhcPs] -- ^ Argument patterns
154154 -> GRHSs GhcPs (Located body) -- ^ Equations
155155 -> R ()
156−p_match' placer pretty style isInfix strictness m_pats m_grhss = do
156+p_match' placer render style isInfix strictness m_pats m_grhss = do
157157 -- NOTE Normally, since patterns may be placed in a multi-line layout, it
158158 -- is necessary to bump indentation for the pattern group so it's more
159159 -- indented than function name. This in turn means that indentation for
@@ -235,7 +235,7 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do
235235 if isCase style && hasGuards
236236 then RightArrow
237237 else EqualSign
238− sep newline (located' (p_grhs' placer pretty groupStyle)) grhssGRHSs
238+ sep newline (located' (p_grhs' placer render groupStyle)) grhssGRHSs
239239 p_where = do
240240 let whereIsEmpty = GHC.isEmptyLocalBindsPR (unLoc grhssLocalBinds)
241241 unless (GHC.eqEmptyLocalBinds (unLoc grhssLocalBinds)) $ do
@@ -258,7 +258,7 @@ p_grhs'
258258 -> GroupStyle
259259 -> GRHS GhcPs (Located body)
260260 -> R ()
261−p_grhs' placer pretty style (GRHS NoExt guards body) =
261+p_grhs' placer render style (GRHS NoExt guards body) =
262262 case guards of
263263 [] -> p_body
264264 xs -> do
@@ -282,7 +282,7 @@ p_grhs' placer pretty style (GRHS NoExt guards body) =
282282 case NE.nonEmpty guards of
283283 Nothing -> Nothing
284284 Just gs -> (Just . srcSpanEnd . getLoc . NE.last) gs
285− p_body = located body pretty
285+ p_body = located body render
286286p_grhs' _ _ _ (XGRHS NoExt) = notImplemented "XGRHS"
287287
288288p_hsCmd :: HsCmd GhcPs -> R ()
@@ -313,41 +313,17 @@ p_hsCmd = \case
313313 notImplemented "HsCmdApp"
314314 HsCmdLam NoExt mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup
315315 HsCmdPar NoExt c -> parens N (located c p_hsCmd)
316− HsCmdCase NoExt e mgroup -> do
317− txt "case"
318− space
319− located e p_hsExpr
320− space
321− txt "of"
322− breakpoint
323− inci (p_matchGroup' cmdPlacement p_hsCmd Case mgroup)
324− HsCmdIf NoExt _ if' then' else' -> do
325− txt "if"
326− space
327− located if' p_hsExpr
328− breakpoint
329− txt "then"
330− located then' $ \x -> do
331− breakpoint
332− inci (p_hsCmd x)
333− breakpoint
334− txt "else"
335− located else' $ \x -> do
336− breakpoint
337− inci (p_hsCmd x)
338− HsCmdLet NoExt localBinds c -> do
339− txt "let"
340− space
341− sitcc (located localBinds p_hsLocalBinds)
342− breakpoint
343− vlayout space (newline >> txt " ")
344− txt "in"
345− space
346− sitcc (located c p_hsCmd)
316+ HsCmdCase NoExt e mgroup ->
317+ p_case cmdPlacement p_hsCmd e mgroup
318+ HsCmdIf NoExt _ if' then' else' ->
319+ p_if cmdPlacement p_hsCmd if' then' else'
320+ HsCmdLet NoExt localBinds c ->
321+ p_let p_hsCmd localBinds c
347322 HsCmdDo NoExt es -> do
348323 txt "do"
349324 newline
350− inci (located es (sitcc . sep newline (located' (sitcc . p_stmt' p_hsCmd))))
325+ inci . located es $
326+ sitcc . sep newline (located' (sitcc . p_stmt' cmdPlacement p_hsCmd))
351327 HsCmdWrap {} -> notImplemented "HsCmdWrap"
352328 XCmd {} -> notImplemented "XCmd"
353329
@@ -357,23 +333,31 @@ p_hsCmdTop = \case
357333 XCmdTop {} -> notImplemented "XHsCmdTop"
358334
359335p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
360−p_stmt = p_stmt' p_hsExpr
336+p_stmt = p_stmt' exprPlacement p_hsExpr
361337
362338p_stmt'
363339 :: Data body
364− => (body -> R ())
365− -> Stmt GhcPs (Located body)
340+ => (body -> Placement) -- ^ Placer
341+ -> (body -> R ()) -- ^ Render
342+ -> Stmt GhcPs (Located body) -- ^ Statement to render
366343 -> R ()
367−p_stmt' pretty = \case
368− LastStmt NoExt body _ _ -> located body pretty
344+p_stmt' placer render = \case
345+ LastStmt NoExt body _ _ -> located body render
369346 BindStmt NoExt l f _ _ -> do
370347 located l p_pat
371348 space
372349 txt "<-"
373− breakpoint
374− inci (located f pretty)
350+ let placement =
351+ case f of
352+ L l' x ->
353+ if isOneLineSpan
354+ (mkSrcSpan (srcSpanEnd (getLoc l)) (srcSpanStart l'))
355+ then placer x
356+ else Normal
357+ switchLayout [getLoc l, getLoc f] $
358+ placeHanging placement (located f render)
375359 ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer
376− BodyStmt NoExt body _ _ -> located body pretty
360+ BodyStmt NoExt body _ _ -> located body render
377361 LetStmt NoExt binds -> do
378362 txt "let"
379363 space
@@ -384,7 +368,7 @@ p_stmt' pretty = \case
384368 -- here would be redundant.
385369 notImplemented "ParStmt"
386370 TransStmt {..} -> do
387− -- NOTE 'TransStmt' only needs to account for pretty printing itself,
371+ -- NOTE 'TransStmt' only needs to account for render printing itself,
388372 -- since pretty printing of relevant statements (e.g., in 'trS_stmts')
389373 -- is handled through 'gatherStmt'.
390374 case (trS_form, trS_by) of
@@ -415,7 +399,7 @@ p_stmt' pretty = \case
415399 RecStmt {..} -> do
416400 txt "rec"
417401 space
418− sitcc $ sepSemi (located' (p_stmt' pretty)) recS_stmts
402+ sitcc $ sepSemi (located' (p_stmt' placer render)) recS_stmts
419403 XStmtLR {} -> notImplemented "XStmtLR"
420404
421405gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
@@ -581,45 +565,24 @@ p_hsExpr' s = \case
581565 sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
582566 ExplicitSum NoExt tag arity e ->
583567 p_unboxedSum N tag arity (located e p_hsExpr)
584− HsCase NoExt e mgroup -> do
585− txt "case"
586− space
587− located e p_hsExpr
588− space
589− txt "of"
590− breakpoint
591− inci (p_matchGroup Case mgroup)
592− HsIf NoExt _ if' then' else' -> do
593− txt "if"
594− space
595− located if' p_hsExpr
596− breakpoint
597− inci $ do
598− txt "then"
599− located then' $ \x ->
600− placeHanging (exprPlacement x) (p_hsExpr x)
601− breakpoint
602− txt "else"
603− located else' $ \x ->
604− placeHanging (exprPlacement x) (p_hsExpr x)
568+ HsCase NoExt e mgroup ->
569+ p_case exprPlacement p_hsExpr e mgroup
570+ HsIf NoExt _ if' then' else' ->
571+ p_if exprPlacement p_hsExpr if' then' else'
605572 HsMultiIf NoExt guards -> do
606573 txt "if"
607574 breakpoint
608575 inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards
609− HsLet NoExt localBinds e -> sitcc $ do
610− txt "let"
611− space
612− dontUseBraces $ sitcc (located localBinds p_hsLocalBinds)
613− vlayout space (newline >> txt " ")
614− txt "in"
615− space
616− sitcc (located e p_hsExpr)
576+ HsLet NoExt localBinds e ->
577+ p_let p_hsExpr localBinds e
617578 HsDo NoExt ctx es -> do
618579 let doBody header = do
619580 txt header
620581 breakpoint
621582 ub <- layoutToBraces <$> getLayout
622− inci $ sepSemi (located' (ub . p_stmt' (p_hsExpr' S))) (unLoc es)
583+ inci $ sepSemi
584+ (located' (ub . p_stmt' exprPlacement (p_hsExpr' S)))
585+ (unLoc es)
623586 compBody = brackets N $ located es $ \xs -> do
624587 let p_parBody = sep
625588 (breakpoint >> txt "| ")
@@ -816,6 +779,59 @@ p_patSynBind PSB {..} = do
816779 inci rhs
817780p_patSynBind (XPatSynBind NoExt) = notImplemented "XPatSynBind"
818781
782+p_case
783+ :: Data body
784+ => (body -> Placement) -- ^ Placer
785+ -> (body -> R ()) -- ^ Render
786+ -> LHsExpr GhcPs -- ^ Expression
787+ -> (MatchGroup GhcPs (Located body)) -- ^ Match group
788+ -> R ()
789+p_case placer render e mgroup = do
790+ txt "case"
791+ space
792+ located e p_hsExpr
793+ space
794+ txt "of"
795+ breakpoint
796+ inci (p_matchGroup' placer render Case mgroup)
797+
798+p_if
799+ :: Data body
800+ => (body -> Placement) -- ^ Placer
801+ -> (body -> R ()) -- ^ Render
802+ -> LHsExpr GhcPs -- ^ If
803+ -> Located body -- ^ Then
804+ -> Located body -- ^ Else
805+ -> R ()
806+p_if placer render if' then' else' = do
807+ txt "if"
808+ space
809+ located if' p_hsExpr
810+ breakpoint
811+ inci $ do
812+ txt "then"
813+ located then' $ \x ->
814+ placeHanging (placer x) (render x)
815+ breakpoint
816+ txt "else"
817+ located else' $ \x ->
818+ placeHanging (placer x) (render x)
819+
820+p_let
821+ :: Data body
822+ => (body -> R ()) -- ^ Render
823+ -> Located (HsLocalBindsLR GhcPs GhcPs)
824+ -> Located body
825+ -> R ()
826+p_let render localBinds e = sitcc $ do
827+ txt "let"
828+ space
829+ dontUseBraces $ sitcc (located localBinds p_hsLocalBinds)
830+ vlayout space (newline >> txt " ")
831+ txt "in"
832+ space
833+ sitcc (located e render)
834+
819835p_pat :: Pat GhcPs -> R ()
820836p_pat = \case
821837 WildPat NoExt -> txt "_"