on master help sign in
Hang guarded equations

Previously guarded expressions were always printed in non-hanging fashion even if they had a hanging form. This change fixes this behavior.

commit75ac291f135606154b7f073296ce95caea3dc859 authormrkkrp <mark.karpov@tweag.io> dateSat 14 Sep 2019, 13:48 (7 years ago) parent1b818c0
3 files changed+25−9
data/examples/declaration/value/function/case-multi-line-guards-out.hs+4−2 data/examples/declaration/value/function/case-multi-line-guards.hs+3 src/Ormolu/Printer/Meat/Declaration/Value.hs+18−7
data/examples/declaration/value/function/case-multi-line-guards-out.hs+4−2
@@ -9,6 +9,8 @@ withGuards x =
99 _ -> 20
1010
1111case x of
12− '-' | not isUrl ->
12+ '-' | not isUrl -> case xs of
13+ _ -> emitc '-'
14+ '*' | not isUrl ->
1315 case xs of
14− _ -> emitc '-'
16+ _ -> emitc '*'
data/examples/declaration/value/function/case-multi-line-guards.hs+3
@@ -10,3 +10,6 @@ withGuards x =
1010case x of
1111 '-' | not isUrl -> case xs of
1212 _ -> emitc '-'
13+ '*' | not isUrl ->
14+ case xs of
15+ _ -> emitc '*'
src/Ormolu/Printer/Meat/Declaration/Value.hs+18−7
@@ -233,7 +233,7 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do
233233 if isCase style && hasGuards
234234 then RightArrow
235235 else EqualSign
236− sep newline (located' (p_grhs' pretty groupStyle)) grhssGRHSs
236+ sep newline (located' (p_grhs' placer pretty groupStyle)) grhssGRHSs
237237 p_where = do
238238 let whereIsEmpty = GHC.isEmptyLocalBindsPR (unLoc grhssLocalBinds)
239239 unless (GHC.eqEmptyLocalBinds (unLoc grhssLocalBinds)) $ do
@@ -247,15 +247,16 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do
247247 inci p_where
248248
249249p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
250−p_grhs = p_grhs' p_hsExpr
250+p_grhs = p_grhs' exprPlacement p_hsExpr
251251
252252p_grhs'
253253 :: Data body
254− => (body -> R ())
254+ => (body -> Placement) -- ^ How to get body placement
255+ -> (body -> R ()) -- ^ How to print body
255256 -> GroupStyle
256257 -> GRHS GhcPs (Located body)
257258 -> R ()
258−p_grhs' pretty style (GRHS NoExt guards body) =
259+p_grhs' placer pretty style (GRHS NoExt guards body) =
259260 case guards of
260261 [] -> p_body
261262 xs -> do
@@ -266,11 +267,21 @@ p_grhs' pretty style (GRHS NoExt guards body) =
266267 txt $ case style of
267268 EqualSign -> "="
268269 RightArrow -> "->"
269− breakpoint
270− inci p_body
270+ placeHanging placement p_body
271271 where
272+ placement =
273+ case endOfGuards of
274+ Nothing -> placer (unLoc body)
275+ Just spn ->
276+ if isOneLineSpan (mkSrcSpan spn (srcSpanStart (getLoc body)))
277+ then placer (unLoc body)
278+ else Normal
279+ endOfGuards =
280+ case NE.nonEmpty guards of
281+ Nothing -> Nothing
282+ Just gs -> (Just . srcSpanEnd . getLoc . NE.last) gs
272283 p_body = located body pretty
273−p_grhs' _ _ (XGRHS NoExt) = notImplemented "XGRHS"
284+p_grhs' _ _ _ (XGRHS NoExt) = notImplemented "XGRHS"
274285
275286p_hsCmd :: HsCmd GhcPs -> R ()
276287p_hsCmd = \case