git.iko.soy/ormolu
on master help sign in
Fix rendering of hanging constructions
fda9519mrkkrp
data/examples/declaration/value/function/do-out.hs+6
compare with master
unifiedsplit
@@ -24,5 +24,11 @@ baz = do
24quux =
24quux =
25 something $ do
25 something $ do
26 foo
26 foo
27+ case x of
28+ 1 -> 10
29+ 2 -> 20
27 bar
30 bar
31+ if something
32+ then x
33+ else y
28 baz
34 baz
data/examples/declaration/value/function/do.hs+6
@@ -19,5 +19,11 @@ baz = do
19
19
20quux = something $ do
20quux = something $ do
21 foo
21 foo
22+ case x of
23+ 1 -> 10
24+ 2 -> 20
22 bar
25 bar
26+ if something
27+ then x
28+ else y
23 baz
29 baz
data/examples/declaration/value/function/if-multi-line-out.hs+3−3
@@ -10,6 +10,6 @@ bar x =
10 then
10 then
11 foo x +
11 foo x +
12 100
12 100
13− else
13+ else case x of
14− foo x +
14+ 1 -> 10
15− 200
15+ _ -> 20
data/examples/declaration/value/function/if-multi-line.hs+3−2
@@ -7,5 +7,6 @@ bar x =
7 if x > 5
7 if x > 5
8 then foo x
8 then foo x
9 + 100
9 + 100
10− else foo x
10+ else case x of
11− + 200
11+ 1 -> 10
12+ _ -> 20
src/Ormolu/Printer/Meat/Declaration/Value.hs+68−54
@@ -23,6 +23,28 @@ import Outputable (Outputable (..))
23import SrcLoc (isOneLineSpan)
23import SrcLoc (isOneLineSpan)
24import qualified Data.List.NonEmpty as NE
24import qualified Data.List.NonEmpty as NE
25
25
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+
26p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
48p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
27p_valDecl = line . p_valDecl'
49p_valDecl = line . p_valDecl'
28
50
@@ -42,13 +64,6 @@ p_funBind
42p_funBind name mgroup =
64p_funBind name mgroup =
43 p_matchGroup (Function name) mgroup
65 p_matchGroup (Function name) mgroup
44
66
45−data MatchGroupStyle
46− = Function (Located RdrName)
47− | PatternBind
48− | Case
49− | Lambda
50− | LambdaCase
51−
52p_matchGroup
67p_matchGroup
53 :: MatchGroupStyle
68 :: MatchGroupStyle
54 -> MatchGroup GhcPs (LHsExpr GhcPs)
69 -> MatchGroup GhcPs (LHsExpr GhcPs)
@@ -104,27 +119,18 @@ p_match style m_pats m_grhss = do
104 _ -> "->"
119 _ -> "->"
105 let combinedSpans = combineSrcSpans' $
120 let combinedSpans = combineSrcSpans' $
106 getGRHSSpan . unL <$> NE.fromList grhssGRHSs
121 getGRHSSpan . unL <$> NE.fromList grhssGRHSs
107− breakpoint' =
108− if isPrefixBlock grhssGRHSs
109− then space
110− else breakpoint
111 p_body = do
122 p_body = do
112 newlineSep (located' (p_grhs Guard)) grhssGRHSs
123 newlineSep (located' (p_grhs Guard)) grhssGRHSs
113 unless (GHC.isEmptyLocalBindsPR (unL grhssLocalBinds)) $ do
124 unless (GHC.isEmptyLocalBindsPR (unL grhssLocalBinds)) $ do
114 newline
125 newline
115 line (txt "where")
126 line (txt "where")
116 inci (located grhssLocalBinds p_hsLocalBinds)
127 inci (located grhssLocalBinds p_hsLocalBinds)
128+ placement = blockPlacement grhssGRHSs
117 case style of
129 case style of
118− Lambda -> do
130+ Lambda -> placeHanging placement $
119− breakpoint'
120 switchLayout combinedSpans p_body
131 switchLayout combinedSpans p_body
121− _ -> switchLayout combinedSpans . inci $ do
132+ _ -> switchLayout combinedSpans $
122− breakpoint'
133+ placeHanging placement p_body
123− p_body
124−
125−data GroupStyle
126− = Guard
127− | MultiIf
128
134
129p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
135p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
130p_grhs style (GRHS NoExt guards body) =
136p_grhs style (GRHS NoExt guards body) =
@@ -216,7 +222,7 @@ p_hsExpr = \case
216 HsLamCase NoExt mgroup -> do
222 HsLamCase NoExt mgroup -> do
217 txt "\\case"
223 txt "\\case"
218 newline
224 newline
219− p_matchGroup LambdaCase mgroup
225+ inci (p_matchGroup LambdaCase mgroup)
220 HsApp NoExt f x -> do
226 HsApp NoExt f x -> do
221 located f p_hsExpr
227 located f p_hsExpr
222 breakpoint
228 breakpoint
@@ -231,10 +237,8 @@ p_hsExpr = \case
231 located x p_hsExpr
237 located x p_hsExpr
232 space
238 space
233 located op p_hsExpr
239 located op p_hsExpr
234− if isPrefixBlockExpr (unL y)
240+ placeHanging (exprPlacement (unL y)) $
235− then space
236− else breakpoint
237− inci (located y p_hsExpr)
241+ located y p_hsExpr
238 NegApp NoExt e _ -> do
242 NegApp NoExt e _ -> do
239 txt "-"
243 txt "-"
240 located e p_hsExpr
244 located e p_hsExpr
@@ -279,20 +283,18 @@ p_hsExpr = \case
279 located e p_hsExpr
283 located e p_hsExpr
280 txt " of"
284 txt " of"
281 breakpoint
285 breakpoint
282− p_matchGroup Case mgroup
286+ inci (p_matchGroup Case mgroup)
283 HsIf NoExt _ if' then' else' -> do
287 HsIf NoExt _ if' then' else' -> do
284 txt "if "
288 txt "if "
285 located if' p_hsExpr
289 located if' p_hsExpr
286 breakpoint
290 breakpoint
287 txt "then"
291 txt "then"
288− located then' $ \x -> do
292+ located then' $ \x ->
289− breakpoint
293+ placeHanging (exprPlacement x) (p_hsExpr x)
290− inci (p_hsExpr x)
291 breakpoint
294 breakpoint
292 txt "else"
295 txt "else"
293− located else' $ \x -> do
296+ located else' $ \x ->
294− breakpoint
297+ placeHanging (exprPlacement x) (p_hsExpr x)
295− inci (p_hsExpr x)
296 HsMultiIf NoExt guards -> do
298 HsMultiIf NoExt guards -> do
297 txt "if "
299 txt "if "
298 sitcc $ newlineSep (located' (p_grhs MultiIf)) guards
300 sitcc $ newlineSep (located' (p_grhs MultiIf)) guards
@@ -308,8 +310,8 @@ p_hsExpr = \case
308 MDoExpr -> txt "mdo"
310 MDoExpr -> txt "mdo"
309 _ -> notImplemented "certain kinds of do notation"
311 _ -> notImplemented "certain kinds of do notation"
310 newline
312 newline
311− located es (newlineSep (located' p_stmt))
313+ inci $ located es (newlineSep (located' (sitcc . p_stmt)))
312− ExplicitList _ _ xs -> do
314+ ExplicitList _ _ xs ->
313 brackets $ velt (withSep comma (located' p_hsExpr) xs)
315 brackets $ velt (withSep comma (located' p_hsExpr) xs)
314 RecordCon {..} -> do
316 RecordCon {..} -> do
315 located rcon_con_name atom
317 located rcon_con_name atom
@@ -320,15 +322,15 @@ p_hsExpr = \case
320 case rec_dotdot of
322 case rec_dotdot of
321 Just {} -> [txt ".."]
323 Just {} -> [txt ".."]
322 Nothing -> []
324 Nothing -> []
323− inci $ braces $ velt (withSep comma id (fields <> dotdot))
325+ inci $ braces $ velt (withSep comma id (fields <> dotdot))
324 RecordUpd {..} -> do
326 RecordUpd {..} -> do
325 located rupd_expr p_hsExpr
327 located rupd_expr p_hsExpr
326 breakpoint
328 breakpoint
327− inci $ braces $ velt (withSep comma (located' p_hsRecField) rupd_flds)
329+ inci $ braces $ velt (withSep comma (located' p_hsRecField) rupd_flds)
328 ExprWithTySig affix x -> do
330 ExprWithTySig affix x -> do
329 located x p_hsExpr
331 located x p_hsExpr
330 breakpoint
332 breakpoint
331− inci $ do
333+ inci $ do
332 txt ":: "
334 txt ":: "
333 let HsWC {..} = affix
335 let HsWC {..} = affix
334 HsIB {..} = hswc_body
336 HsIB {..} = hswc_body
@@ -340,11 +342,11 @@ p_hsExpr = \case
340 located from p_hsExpr
342 located from p_hsExpr
341 breakpoint'
343 breakpoint'
342 txt ".."
344 txt ".."
343− FromThen from next -> brackets $ do
345+ FromThen from next -> brackets $ do
344 velt (withSep comma (located' p_hsExpr) [from, next])
346 velt (withSep comma (located' p_hsExpr) [from, next])
345 breakpoint'
347 breakpoint'
346 txt ".."
348 txt ".."
347− FromTo from to -> brackets $ do
349+ FromTo from to -> brackets $ do
348 located from p_hsExpr
350 located from p_hsExpr
349 breakpoint'
351 breakpoint'
350 txt ".. "
352 txt ".. "
@@ -433,21 +435,33 @@ getGRHSSpan :: GRHS GhcPs (LHsExpr GhcPs) -> SrcSpan
433getGRHSSpan (GRHS NoExt _ body) = getSpan body
435getGRHSSpan (GRHS NoExt _ body) = getSpan body
434getGRHSSpan (XGRHS NoExt) = notImplemented "XGRHS"
436getGRHSSpan (XGRHS NoExt) = notImplemented "XGRHS"
435
437
436−-- | Check the body is such a thing that prints a short prefix and then the
438+-- | Place a thing that may have a hanging form. This function handles how
437−-- rest goes after a newline. In that case we can leave the prefix on
439+-- to separate it from preceding expressions and whether to bump indentation
438−-- current line. Examples of such things are: lambdas, do-blocks, and lambda
440+-- depending on what sort of expression we have.
439−-- case expressions.
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.
440
454
441−isPrefixBlock :: [LGRHS GhcPs (LHsExpr GhcPs)] -> Bool
455+blockPlacement :: [LGRHS GhcPs (LHsExpr GhcPs)] -> Placement
442−isPrefixBlock [(L _ (GRHS NoExt _ (L _ e)))] = isPrefixBlockExpr e
456+blockPlacement [(L _ (GRHS NoExt _ (L _ e)))] = exprPlacement e
443−isPrefixBlock _ = False
457+blockPlacement _ = Normal
444
458
445−-- | Similar to 'isPrefixBlock', but just for checking 'HsExpr' directly.
459+-- | Check if given expression has hinging a form.
446
460
447−isPrefixBlockExpr :: HsExpr GhcPs -> Bool
461+exprPlacement :: HsExpr GhcPs -> Placement
448−isPrefixBlockExpr = \case
462+exprPlacement = \case
449− HsLam NoExt _ -> True
463+ HsLam NoExt _ -> Hanging
450− HsCase NoExt _ _ -> True
464+ HsCase NoExt _ _ -> Hanging
451− HsDo NoExt _ _ -> True
465+ HsDo NoExt _ _ -> Hanging
452− HsLamCase NoExt _ -> True
466+ HsLamCase NoExt _ -> Hanging
453− _ -> False
467+ _ -> Normal