git.iko.soy/ormolu
on master help sign in
Fix rendering of case alternatives with guards
be0ce29mrkkrp
data/examples/declaration/value/function/case-multi-line-out.hs+9
compare with master
unifiedsplit
@@ -19,3 +19,12 @@ baz x = case x of
19quux :: Int -> Int
19quux :: Int -> Int
20quux x = case x of
20quux x = case x of
21 x -> x
21 x -> x
22+
23+withGuards :: Int -> Int
24+withGuards x = case x of
25+ x
26+ | x > 10 ->
27+ foo +
28+ bar
29+ x | x > 5 -> 10
30+ _ -> 20
data/examples/declaration/value/function/case-multi-line.hs+9
@@ -17,3 +17,12 @@ baz x = case x of 5 -> 10
17quux :: Int -> Int
17quux :: Int -> Int
18quux x = case x of
18quux x = case x of
19 x -> x
19 x -> x
20+
21+withGuards :: Int -> Int
22+withGuards x =
23+ case x of
24+ x | x > 10 ->
25+ foo +
26+ bar
27+ x | x > 5 -> 10
28+ _ -> 20
data/examples/declaration/value/function/if-multi-line-out.hs+4−3
@@ -10,6 +10,7 @@ bar x =
10 then
10 then
11 foo x +
11 foo x +
12 100
12 100
13+ else
13− else case x of
14+ case x of
14− 1 -> 10
15+ 1 -> 10
15− _ -> 20
16+ _ -> 20
src/Ormolu/Printer/Meat/Declaration/Value.hs+32−15
@@ -31,8 +31,8 @@ data MatchGroupStyle
31 | LambdaCase
31 | LambdaCase
32
32
33data GroupStyle
33data GroupStyle
34− = Guard
34+ = EqualSign
35− | MultiIf
35+ | RightArrow
36
36
37-- | Expression placement. This marks the places where expressions that
37-- | Expression placement. This marks the places where expressions that
38-- implement handing forms may use them.
38-- implement handing forms may use them.
@@ -111,16 +111,24 @@ p_match style m_pats m_grhss = do
111 return inci'
111 return inci'
112 inci' $ do
112 inci' $ do
113 let GRHSs {..} = m_grhss
113 let GRHSs {..} = m_grhss
114+ hasGuards = withGuards grhssGRHSs
114 unless (length grhssGRHSs > 1) $ do
115 unless (length grhssGRHSs > 1) $ do
115− space
116− txt $ case style of
116+ case style of
117− Function _ -> "="
117+ Function _ -> txt " ="
118− PatternBind -> "="
118+ PatternBind -> txt " ="
119+ Case -> unless hasGuards (txt " ->")
119− _ -> "->"
120+ _ -> txt " ->"
120 let combinedSpans = combineSrcSpans' $
121 let combinedSpans = combineSrcSpans' $
121 getGRHSSpan . unL <$> NE.fromList grhssGRHSs
122 getGRHSSpan . unL <$> NE.fromList grhssGRHSs
122 p_body = do
123 p_body = do
124+ let groupStyle =
125+ case style of
126+ Case ->
127+ if hasGuards
128+ then RightArrow
129+ else EqualSign
130+ _ -> EqualSign
123− newlineSep (located' (p_grhs Guard)) grhssGRHSs
131+ newlineSep (located' (p_grhs groupStyle)) grhssGRHSs
124 unless (GHC.isEmptyLocalBindsPR (unL grhssLocalBinds)) $ do
132 unless (GHC.isEmptyLocalBindsPR (unL grhssLocalBinds)) $ do
125 newline
133 newline
126 line (txt "where")
134 line (txt "where")
@@ -141,8 +149,8 @@ p_grhs style (GRHS NoExt guards body) =
141 velt $ withSep comma (located' p_stmt) xs
149 velt $ withSep comma (located' p_stmt) xs
142 space
150 space
143 txt $ case style of
151 txt $ case style of
144− Guard -> "="
152+ EqualSign -> "="
145− MultiIf -> "->"
153+ RightArrow -> "->"
146 breakpoint
154 breakpoint
147 inci p_body
155 inci p_body
148 where
156 where
@@ -289,15 +297,17 @@ p_hsExpr = \case
289 located if' p_hsExpr
297 located if' p_hsExpr
290 breakpoint
298 breakpoint
291 txt "then"
299 txt "then"
292− located then' $ \x ->
300+ located then' $ \x -> do
293− placeHanging (exprPlacement x) (p_hsExpr x)
301+ breakpoint
302+ inci (p_hsExpr x)
294 breakpoint
303 breakpoint
295 txt "else"
304 txt "else"
296− located else' $ \x ->
305+ located else' $ \x -> do
297− placeHanging (exprPlacement x) (p_hsExpr x)
306+ breakpoint
307+ inci (p_hsExpr x)
298 HsMultiIf NoExt guards -> do
308 HsMultiIf NoExt guards -> do
299 txt "if "
309 txt "if "
300− sitcc $ newlineSep (located' (p_grhs MultiIf)) guards
310+ sitcc $ newlineSep (located' (p_grhs RightArrow)) guards
301 HsLet NoExt localBinds e -> do
311 HsLet NoExt localBinds e -> do
302 txt "let "
312 txt "let "
303 sitcc (located localBinds p_hsLocalBinds)
313 sitcc (located localBinds p_hsLocalBinds)
@@ -539,3 +549,10 @@ exprPlacement = \case
539 HsDo NoExt _ _ -> Hanging
549 HsDo NoExt _ _ -> Hanging
540 HsLamCase NoExt _ -> Hanging
550 HsLamCase NoExt _ -> Hanging
541 _ -> Normal
551 _ -> Normal
552+
553+withGuards :: [LGRHS GhcPs (LHsExpr GhcPs)] -> Bool
554+withGuards = any (checkOne . unL)
555+ where
556+ checkOne :: GRHS GhcPs (LHsExpr GhcPs) -> Bool
557+ checkOne (GRHS NoExt [] _) = False
558+ checkOne _ = True