on master help sign in
Fix rendering of case alternatives with guards

Also rolls back handing things in if branches, because it doesn't look so good?

commitbe0ce29744d0826a6a4024da8bb46670990ee2a2 authormrkkrp <mark.karpov@tweag.io> dateMon 10 Jun 2019, 22:25 (7 years ago) parent656d036
4 files changed+54−18
data/examples/declaration/value/function/case-multi-line-out.hs+9 data/examples/declaration/value/function/case-multi-line.hs+9 data/examples/declaration/value/function/if-multi-line-out.hs+4−3 src/Ormolu/Printer/Meat/Declaration/Value.hs+32−15
data/examples/declaration/value/function/case-multi-line-out.hs+9
@@ -19,3 +19,12 @@ baz x = case x of
1919quux :: Int -> Int
2020quux x = case x of
2121 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
1717quux :: Int -> Int
1818quux x = case x of
1919 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 =
1010 then
1111 foo x +
1212 100
13− else case x of
14− 1 -> 10
15− _ -> 20
13+ else
14+ case x of
15+ 1 -> 10
16+ _ -> 20
src/Ormolu/Printer/Meat/Declaration/Value.hs+32−15
@@ -31,8 +31,8 @@ data MatchGroupStyle
3131 | LambdaCase
3232
3333data GroupStyle
34− = Guard
35− | MultiIf
34+ = EqualSign
35+ | RightArrow
3636
3737-- | Expression placement. This marks the places where expressions that
3838-- implement handing forms may use them.
@@ -111,16 +111,24 @@ p_match style m_pats m_grhss = do
111111 return inci'
112112 inci' $ do
113113 let GRHSs {..} = m_grhss
114+ hasGuards = withGuards grhssGRHSs
114115 unless (length grhssGRHSs > 1) $ do
115− space
116− txt $ case style of
117− Function _ -> "="
118− PatternBind -> "="
119− _ -> "->"
116+ case style of
117+ Function _ -> txt " ="
118+ PatternBind -> txt " ="
119+ Case -> unless hasGuards (txt " ->")
120+ _ -> txt " ->"
120121 let combinedSpans = combineSrcSpans' $
121122 getGRHSSpan . unL <$> NE.fromList grhssGRHSs
122123 p_body = do
123− newlineSep (located' (p_grhs Guard)) grhssGRHSs
124+ let groupStyle =
125+ case style of
126+ Case ->
127+ if hasGuards
128+ then RightArrow
129+ else EqualSign
130+ _ -> EqualSign
131+ newlineSep (located' (p_grhs groupStyle)) grhssGRHSs
124132 unless (GHC.isEmptyLocalBindsPR (unL grhssLocalBinds)) $ do
125133 newline
126134 line (txt "where")
@@ -141,8 +149,8 @@ p_grhs style (GRHS NoExt guards body) =
141149 velt $ withSep comma (located' p_stmt) xs
142150 space
143151 txt $ case style of
144− Guard -> "="
145− MultiIf -> "->"
152+ EqualSign -> "="
153+ RightArrow -> "->"
146154 breakpoint
147155 inci p_body
148156 where
@@ -289,15 +297,17 @@ p_hsExpr = \case
289297 located if' p_hsExpr
290298 breakpoint
291299 txt "then"
292− located then' $ \x ->
293− placeHanging (exprPlacement x) (p_hsExpr x)
300+ located then' $ \x -> do
301+ breakpoint
302+ inci (p_hsExpr x)
294303 breakpoint
295304 txt "else"
296− located else' $ \x ->
297− placeHanging (exprPlacement x) (p_hsExpr x)
305+ located else' $ \x -> do
306+ breakpoint
307+ inci (p_hsExpr x)
298308 HsMultiIf NoExt guards -> do
299309 txt "if "
300− sitcc $ newlineSep (located' (p_grhs MultiIf)) guards
310+ sitcc $ newlineSep (located' (p_grhs RightArrow)) guards
301311 HsLet NoExt localBinds e -> do
302312 txt "let "
303313 sitcc (located localBinds p_hsLocalBinds)
@@ -539,3 +549,10 @@ exprPlacement = \case
539549 HsDo NoExt _ _ -> Hanging
540550 HsLamCase NoExt _ -> Hanging
541551 _ -> 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