on master help sign in
Fix the “overindentation” issues with function applications
d02483amrkkrp
data/examples/declaration/value/function/infix/hanging-out.hs+3−3
@@ -4,9 +4,9 @@ f = unFoo . foo bar baz 3 $ do
4
4
5g = unFoo
5g = unFoo
6 . foo
6 . foo
7− bar
7+ bar
8− baz
8+ baz
9− 3
9+ 3
10 $ do
10 $ do
11 act
11 act
12 ret
12 ret
data/examples/declaration/value/function/overindentation-out.hsnew file+9
@@ -0,0 +1,9 @@
1+reallyincrediblyLongName = f
2+ a
3+ A
4+ { reallyincrediblyLongName = f
5+ a
6+ A
7+ { reallyincrediblyLongName
8+ }
9+ }
data/examples/declaration/value/function/overindentation.hsnew file+9
@@ -0,0 +1,9 @@
1+reallyincrediblyLongName = f
2+ a
3+ A
4+ { reallyincrediblyLongName = f
5+ a
6+ A
7+ { reallyincrediblyLongName
8+ }
9+ }
src/Ormolu/Parser/CommentStream.hs+1−1
@@ -63,7 +63,7 @@ mkCommentStream extraComments pstate =
63 extraComments
63 extraComments
64 ++ mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate)
64 ++ mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate)
65 ++ concatMap (mapMaybe (liftMaybe . fmap unAnnotationComment) . snd)
65 ++ concatMap (mapMaybe (liftMaybe . fmap unAnnotationComment) . snd)
66− (GHC.annotations_comments pstate)
66+ (GHC.annotations_comments pstate)
67
67
68-- | Test whether a 'Comment' looks like a Haddock following a definition,
68-- | Test whether a 'Comment' looks like a Haddock following a definition,
69-- i.e. something starting with @-- ^@.
69-- i.e. something starting with @-- ^@.
src/Ormolu/Printer/Internal.hs+5−5
@@ -431,11 +431,11 @@ popComment f = R $ do
431 then
431 then
432 Just x
432 Just x
433 <$ modify
433 <$ modify
434− ( \sc ->
434+ ( \sc ->
435− sc
435+ sc
436− { scCommentStream = CommentStream xs
436+ { scCommentStream = CommentStream xs
437− }
437+ }
438− )
438+ )
439 else return Nothing
439 else return Nothing
440
440
441-- | Get the first enclosing 'RealSrcSpan' that satisfies given predicate.
441-- | Get the first enclosing 'RealSrcSpan' that satisfies given predicate.
src/Ormolu/Printer/Meat/Declaration/Value.hs+13−22
@@ -245,7 +245,7 @@ p_match' placer render style isInfix strictness m_pats m_grhss = do
245 Nothing -> blockPlacement placer grhssGRHSs
245 Nothing -> blockPlacement placer grhssGRHSs
246 Just spn ->
246 Just spn ->
247 if isOneLineSpan
247 if isOneLineSpan
248− (mkSrcSpan spn (srcSpanStart grhssSpan))
248+ (mkSrcSpan spn (srcSpanStart grhssSpan))
249 then blockPlacement placer grhssGRHSs
249 then blockPlacement placer grhssGRHSs
250 else Normal
250 else Normal
251 p_body = do
251 p_body = do
@@ -374,7 +374,7 @@ p_stmt' placer render = \case
374 case f of
374 case f of
375 L l' x ->
375 L l' x ->
376 if isOneLineSpan
376 if isOneLineSpan
377− (mkSrcSpan (srcSpanEnd (getLoc l)) (srcSpanStart l'))
377+ (mkSrcSpan (srcSpanEnd (getLoc l)) (srcSpanStart l'))
378 then placer x
378 then placer x
379 else Normal
379 else Normal
380 switchLayout [getLoc l, getLoc f] $
380 switchLayout [getLoc l, getLoc f] $
@@ -525,9 +525,9 @@ p_hsExpr' s = \case
525 breakpoint
525 breakpoint
526 inci (p_matchGroup LambdaCase mgroup)
526 inci (p_matchGroup LambdaCase mgroup)
527 HsApp NoExt f x -> do
527 HsApp NoExt f x -> do
528− -- We hang only the last function argument. In order to do
528+ -- We hang only the last function argument. In order to do this, we only
529− -- this, we only call 'placeHanging' on the topmost 'HsApp',
529+ -- call 'placeHanging' on the topmost 'HsApp', and then use
530− -- and then use 'p_withoutHanging' for the descendants.
530+ -- 'p_withoutHanging' for the descendants.
531 let p_withoutHanging (HsApp NoExt f' x') = do
531 let p_withoutHanging (HsApp NoExt f' x') = do
532 case f' of
532 case f' of
533 L _ (HsApp _ _ _) -> located f' p_withoutHanging
533 L _ (HsApp _ _ _) -> located f' p_withoutHanging
@@ -535,24 +535,15 @@ p_hsExpr' s = \case
535 breakpoint
535 breakpoint
536 inci $ located x' p_hsExpr
536 inci $ located x' p_hsExpr
537 p_withoutHanging e = p_hsExpr e
537 p_withoutHanging e = p_hsExpr e
538− -- Only use the hanging placement if the function spans
538+ -- Only use the hanging placement if the function spans a single
539− -- a single line.
539+ -- line.
540 placement =
540 placement =
541 if isOneLineSpan (getLoc f)
541 if isOneLineSpan (getLoc f)
542 then exprPlacement (unLoc x)
542 then exprPlacement (unLoc x)
543 else Normal
543 else Normal
544− -- We only sit when the last expression is not hanging.
545− -- This is to allow:
546− -- f = foo bar do
547− -- baz
548− sit' =
549− if placement == Normal
550− then sitcc
551− else id
552− sit' $ do
553− useBraces $ located f p_withoutHanging
544+ useBraces (located f p_withoutHanging)
554− placeHanging placement $
545+ placeHanging placement $
555− located x p_hsExpr
546+ located x p_hsExpr
556 HsAppType a e -> do
547 HsAppType a e -> do
557 located e p_hsExpr
548 located e p_hsExpr
558 breakpoint
549 breakpoint
@@ -620,8 +611,8 @@ p_hsExpr' s = \case
620 p_seqBody =
611 p_seqBody =
621 sitcc
612 sitcc
622 . sep
613 . sep
623− (comma >> breakpoint)
614+ (comma >> breakpoint)
624− (located' (sitcc . p_stmt))
615+ (located' (sitcc . p_stmt))
625 stmts = init xs
616 stmts = init xs
626 yield = last xs
617 yield = last xs
627 lists = foldr (liftAppend . gatherStmt) [] stmts
618 lists = foldr (liftAppend . gatherStmt) [] stmts
@@ -1218,7 +1209,7 @@ p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
1218 -- hanging placement.
1209 -- hanging placement.
1219 let placement =
1210 let placement =
1220 if isOneLineSpan
1211 if isOneLineSpan
1221− (mkSrcSpan (srcSpanStart (opTreeLoc x)) (srcSpanStart (opTreeLoc y)))
1212+ (mkSrcSpan (srcSpanStart (opTreeLoc x)) (srcSpanStart (opTreeLoc y)))
1222 then case y of
1213 then case y of
1223 OpNode (L _ n) -> exprPlacement n
1214 OpNode (L _ n) -> exprPlacement n
1224 _ -> Normal
1215 _ -> Normal