diff --git a/data/examples/declaration/value/function/block-arguments-out.hs b/data/examples/declaration/value/function/block-arguments-out.hs index 1a29c1e..499173c 100644 --- a/data/examples/declaration/value/function/block-arguments-out.hs +++ b/data/examples/declaration/value/function/block-arguments-out.hs @@ -1,13 +1,11 @@ f1 = foo do bar -f2 = - foo do - bar +f2 = foo do + bar -f3 = - foo case True of - True -> bar - False -> baz +f3 = foo case True of + True -> bar + False -> baz f4 = foo let a = 3 in b @@ -25,6 +23,5 @@ f6 = f7 = foo \x -> y -f8 = - foo \x -> - y +f8 = foo \x -> + y diff --git a/data/examples/declaration/value/function/record-constructors-out.hs b/data/examples/declaration/value/function/record-constructors-out.hs index b91984a..baa780e 100644 --- a/data/examples/declaration/value/function/record-constructors-out.hs +++ b/data/examples/declaration/value/function/record-constructors-out.hs @@ -15,13 +15,12 @@ aLongVariableName = aLongRecordFieldName = YetAnotherLongRecordName { yetAnotherLongRecordFieldName = "a long string" }, - aLongRecordFieldName2 = - Just YetAnotherLongRecordName - { yetAnotherLongRecordFieldName = "a long string", - yetAnotherLongRecordFieldName = - Just - "a long string" - }, + aLongRecordFieldName2 = Just YetAnotherLongRecordName + { yetAnotherLongRecordFieldName = "a long string", + yetAnotherLongRecordFieldName = + Just + "a long string" + }, aLongRecordFieldName3 = do foo bar diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs b/src/Ormolu/Printer/Meat/Declaration/Value.hs index 6fb9ca4..63c35d2 100644 --- a/src/Ormolu/Printer/Meat/Declaration/Value.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs @@ -59,6 +59,7 @@ data Placement | Hanging -- ^ Expressions that have hanging form -- should use it and avoid bumping one level -- of indentation + deriving (Eq) p_valDecl :: HsBindLR GhcPs GhcPs -> R () p_valDecl = \case @@ -512,11 +513,34 @@ p_hsExpr = \case txt "\\case" breakpoint inci (p_matchGroup LambdaCase mgroup) - HsApp NoExt f x -> sitcc $ do - located f p_hsExpr - -- Second argument can be a `do` or `case` block with `-XBlockArguments`. - placeHanging (exprPlacement (unLoc x)) $ - located x p_hsExpr + HsApp NoExt f x -> do + -- We hang only the last function argument. In order to do + -- this, we only call 'placeHanging' on the topmost 'HsApp', + -- and then use 'p_withoutHanging' for the descendants. + let p_withoutHanging (HsApp NoExt f' x') = do + case f' of + (L _ (HsApp _ _ _)) -> located f' p_withoutHanging + _ -> located f' p_hsExpr + breakpoint + inci $ located x' p_hsExpr + p_withoutHanging e = p_hsExpr e + -- Only use the hanging placement if the function spans + -- a single line. + placement = + if isOneLineSpan (getLoc f) + then exprPlacement (unLoc x) + else Normal + -- We only sit when the last expression is not hanging. + -- This is to allow: + -- f = foo bar do + -- baz + sit' = if placement == Normal + then sitcc + else id + sit' $ do + useBraces $ located f p_withoutHanging + placeHanging placement $ + located x p_hsExpr HsAppType a e -> do located e p_hsExpr breakpoint @@ -1091,6 +1115,8 @@ exprPlacement = \case -- whole block hanging; so that we can use the common @f = foo $ do@ -- style. OpApp NoExt _ _ y -> exprPlacement (unLoc y) + -- Same thing for function applications (usually with -XBlockArguments) + HsApp NoExt _ y -> exprPlacement (unLoc y) HsProc NoExt (L s _) _ -> -- Indentation breaks if pattern is longer than one line and left -- hanging. Consequently, only apply hanging when it is safe.