@@ -23,6 +23,28 @@ import Outputable (Outputable (..))
2323import SrcLoc (isOneLineSpan)
2424import qualified Data.List.NonEmpty as NE
2525
26+data MatchGroupStyle
27+ = Function (Located RdrName)
28+ | PatternBind
29+ | Case
30+ | Lambda
31+ | LambdaCase
32+
33+data GroupStyle
34+ = Guard
35+ | MultiIf
36+
37+-- | Expression placement. This marks the places where expressions that
38+-- implement handing forms may use them.
39+
40+data Placement
41+ = Normal -- ^ Multi-line layout should cause
42+ -- insertion of a newline and indentation
43+ -- bump
44+ | Hanging -- ^ Expressions that have hanging form
45+ -- should use it and avoid bumping one level
46+ -- of indentation
47+
2648p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
2749p_valDecl = line . p_valDecl'
2850
@@ -42,13 +64,6 @@ p_funBind
4264p_funBind name mgroup =
4365 p_matchGroup (Function name) mgroup
4466
45−data MatchGroupStyle
46− = Function (Located RdrName)
47− | PatternBind
48− | Case
49− | Lambda
50− | LambdaCase
51−
5267p_matchGroup
5368 :: MatchGroupStyle
5469 -> MatchGroup GhcPs (LHsExpr GhcPs)
@@ -104,27 +119,18 @@ p_match style m_pats m_grhss = do
104119 _ -> "->"
105120 let combinedSpans = combineSrcSpans' $
106121 getGRHSSpan . unL <$> NE.fromList grhssGRHSs
107− breakpoint' =
108− if isPrefixBlock grhssGRHSs
109− then space
110− else breakpoint
111122 p_body = do
112123 newlineSep (located' (p_grhs Guard)) grhssGRHSs
113124 unless (GHC.isEmptyLocalBindsPR (unL grhssLocalBinds)) $ do
114125 newline
115126 line (txt "where")
116127 inci (located grhssLocalBinds p_hsLocalBinds)
128+ placement = blockPlacement grhssGRHSs
117129 case style of
118− Lambda -> do
119− breakpoint'
130+ Lambda -> placeHanging placement $
120131 switchLayout combinedSpans p_body
121− _ -> switchLayout combinedSpans . inci $ do
122− breakpoint'
123− p_body
124−
125−data GroupStyle
126− = Guard
127− | MultiIf
132+ _ -> switchLayout combinedSpans $
133+ placeHanging placement p_body
128134
129135p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
130136p_grhs style (GRHS NoExt guards body) =
@@ -216,7 +222,7 @@ p_hsExpr = \case
216222 HsLamCase NoExt mgroup -> do
217223 txt "\\case"
218224 newline
219− p_matchGroup LambdaCase mgroup
225+ inci (p_matchGroup LambdaCase mgroup)
220226 HsApp NoExt f x -> do
221227 located f p_hsExpr
222228 breakpoint
@@ -231,10 +237,8 @@ p_hsExpr = \case
231237 located x p_hsExpr
232238 space
233239 located op p_hsExpr
234− if isPrefixBlockExpr (unL y)
235− then space
236− else breakpoint
237− inci (located y p_hsExpr)
240+ placeHanging (exprPlacement (unL y)) $
241+ located y p_hsExpr
238242 NegApp NoExt e _ -> do
239243 txt "-"
240244 located e p_hsExpr
@@ -279,20 +283,18 @@ p_hsExpr = \case
279283 located e p_hsExpr
280284 txt " of"
281285 breakpoint
282− p_matchGroup Case mgroup
286+ inci (p_matchGroup Case mgroup)
283287 HsIf NoExt _ if' then' else' -> do
284288 txt "if "
285289 located if' p_hsExpr
286290 breakpoint
287291 txt "then"
288− located then' $ \x -> do
289− breakpoint
290− inci (p_hsExpr x)
292+ located then' $ \x ->
293+ placeHanging (exprPlacement x) (p_hsExpr x)
291294 breakpoint
292295 txt "else"
293− located else' $ \x -> do
294− breakpoint
295− inci (p_hsExpr x)
296+ located else' $ \x ->
297+ placeHanging (exprPlacement x) (p_hsExpr x)
296298 HsMultiIf NoExt guards -> do
297299 txt "if "
298300 sitcc $ newlineSep (located' (p_grhs MultiIf)) guards
@@ -308,8 +310,8 @@ p_hsExpr = \case
308310 MDoExpr -> txt "mdo"
309311 _ -> notImplemented "certain kinds of do notation"
310312 newline
311− located es (newlineSep (located' p_stmt))
312− ExplicitList _ _ xs -> do
313+ inci $ located es (newlineSep (located' (sitcc . p_stmt)))
314+ ExplicitList _ _ xs ->
313315 brackets $ velt (withSep comma (located' p_hsExpr) xs)
314316 RecordCon {..} -> do
315317 located rcon_con_name atom
@@ -320,15 +322,15 @@ p_hsExpr = \case
320322 case rec_dotdot of
321323 Just {} -> [txt ".."]
322324 Nothing -> []
323− inci $ braces $ velt (withSep comma id (fields <> dotdot))
325+ inci $ braces $ velt (withSep comma id (fields <> dotdot))
324326 RecordUpd {..} -> do
325327 located rupd_expr p_hsExpr
326328 breakpoint
327− inci $ braces $ velt (withSep comma (located' p_hsRecField) rupd_flds)
329+ inci $ braces $ velt (withSep comma (located' p_hsRecField) rupd_flds)
328330 ExprWithTySig affix x -> do
329331 located x p_hsExpr
330332 breakpoint
331− inci $ do
333+ inci $ do
332334 txt ":: "
333335 let HsWC {..} = affix
334336 HsIB {..} = hswc_body
@@ -340,11 +342,11 @@ p_hsExpr = \case
340342 located from p_hsExpr
341343 breakpoint'
342344 txt ".."
343− FromThen from next -> brackets $ do
345+ FromThen from next -> brackets $ do
344346 velt (withSep comma (located' p_hsExpr) [from, next])
345347 breakpoint'
346348 txt ".."
347− FromTo from to -> brackets $ do
349+ FromTo from to -> brackets $ do
348350 located from p_hsExpr
349351 breakpoint'
350352 txt ".. "
@@ -433,21 +435,33 @@ getGRHSSpan :: GRHS GhcPs (LHsExpr GhcPs) -> SrcSpan
433435getGRHSSpan (GRHS NoExt _ body) = getSpan body
434436getGRHSSpan (XGRHS NoExt) = notImplemented "XGRHS"
435437
436−-- | Check the body is such a thing that prints a short prefix and then the
437−-- rest goes after a newline. In that case we can leave the prefix on
438−-- current line. Examples of such things are: lambdas, do-blocks, and lambda
439−-- case expressions.
438+-- | Place a thing that may have a hanging form. This function handles how
439+-- to separate it from preceding expressions and whether to bump indentation
440+-- depending on what sort of expression we have.
441+
442+placeHanging :: Placement -> R () -> R ()
443+placeHanging placement m = do
444+ case placement of
445+ Hanging -> do
446+ space
447+ m
448+ Normal -> do
449+ breakpoint
450+ inci m
451+
452+-- | Check if given block contains single expression which has a hanging
453+-- form.
440454
441−isPrefixBlock :: [LGRHS GhcPs (LHsExpr GhcPs)] -> Bool
442−isPrefixBlock [(L _ (GRHS NoExt _ (L _ e)))] = isPrefixBlockExpr e
443−isPrefixBlock _ = False
455+blockPlacement :: [LGRHS GhcPs (LHsExpr GhcPs)] -> Placement
456+blockPlacement [(L _ (GRHS NoExt _ (L _ e)))] = exprPlacement e
457+blockPlacement _ = Normal
444458
445−-- | Similar to 'isPrefixBlock', but just for checking 'HsExpr' directly.
459+-- | Check if given expression has hinging a form.
446460
447−isPrefixBlockExpr :: HsExpr GhcPs -> Bool
448−isPrefixBlockExpr = \case
449− HsLam NoExt _ -> True
450− HsCase NoExt _ _ -> True
451− HsDo NoExt _ _ -> True
452− HsLamCase NoExt _ -> True
453− _ -> False
461+exprPlacement :: HsExpr GhcPs -> Placement
462+exprPlacement = \case
463+ HsLam NoExt _ -> Hanging
464+ HsCase NoExt _ _ -> Hanging
465+ HsDo NoExt _ _ -> Hanging
466+ HsLamCase NoExt _ -> Hanging
467+ _ -> Normal