Change the way operators are formatted

data/examples/declaration/value/function/arrow/proc-do-complex-out.hs

@@ -31,8 +31,8 @@ foo
               w
               ) -> \u -> -- Procs can have lambdas
               let v =
-                    u ^ -- Actually never used
+                    u -- Actually never used
-                      2
+                      ^ 2
               in ( returnA -<
                      -- Just do the calculation
                      (x + y * z)
@@ -55,7 +55,7 @@ foo
           then ma -< ()
           else returnA -< ()
           returnA -<
-            ( i +
+            ( i
-                x *
+                + x
-                y -- Just do the calculation
+                * y -- Just do the calculation
               )

data/examples/declaration/value/function/arrow/proc-forms-out.hs

@@ -9,15 +9,15 @@ foo1 f g h x =
 foo2 f g h x =
   proc (y, z) ->
     (| test
-         ( h f .
+         ( h f
-             h g -<
+             . h g -<
-             y x .
+             y x
-               y z
+               . y z
            )
-         ( h g .
+         ( h g
-             h f -<
+             . h f -<
-             y z .
+             y z
-               y x
+               . y x
            )
       |)
 
@@ -30,6 +30,6 @@ bar1 f g h x =
 bar2 f g h x =
   proc (y, z) ->
     (h f . h g) -<
-      (y x) . y z |||
+      (y x) . y z
-        (h g . h f) -<
+        ||| (h g . h f) -<
         y z . (y x)

data/examples/declaration/value/function/arrow/proc-ifs-out.hs

@@ -5,8 +5,8 @@ foo f = proc a -> if a then f -< 0 else f -< 1
 bar f g = proc a ->
   if f a
   then
-    f .
+    f
-      g -<
+      . g -<
       a
   else
     g -<

data/examples/declaration/value/function/arrow/proc-lets-out.hs

@@ -4,9 +4,9 @@ foo f = proc a -> let b = a in f -< b
 
 bar f g = proc a ->
   let h =
-        f .
+        f
-          g a
+          . g a
       j =
-        g .
+        g
-          h
+          . h
   in id -< (h, j)

data/examples/declaration/value/function/case-multi-line-out.hs

@@ -26,8 +26,8 @@ withGuards x =
   case x of
     x
       | x > 10 ->
-        foo +
+        foo
-          bar
+          + bar
     x | x > 5 -> 10
     _ -> 20
 

data/examples/declaration/value/function/do-out.hs

@@ -23,17 +23,16 @@ baz = do
   let d = c + 2
   return d
 
-quux =
+quux = something $ do
-  something $ do
+  foo
-    foo
+  case x of
-    case x of
+    1 -> 10
-      1 -> 10
+    2 -> 20
-      2 -> 20
+  bar
-    bar
+  if something
-    if something
+  then x
-    then x
+  else y
-    else y
+  baz
-    baz
 
 foo = do
   rec a <- b + 5
@@ -53,6 +52,29 @@ trickyLet = do
   let x = 5
    in bar x
 
+f = unFoo . foo bar baz 3 $ do
+  act
+  ret
+
+g = unFoo
+  . foo
+      bar
+      baz
+      3 $ do
+  act
+  ret
+
+main =
+  do
+    stuff
+    `finally` do
+      recover
+
+foo =
+  do
+    1
+    + 2
+
 -- single line let-where
 samples n f = do
   gen <- newQCGen

data/examples/declaration/value/function/do.hs

@@ -52,6 +52,26 @@ trickyLet = do
   let x = 5
    in bar x
 
+f = unFoo . foo bar baz 3 $  do
+  act
+  ret
+
+g = unFoo . foo
+      bar
+      baz 3 $  do
+  act
+  ret
+
+main =
+  do stuff
+   `finally` do
+     recover
+
+foo = do
+    1
+    +
+    2
+
 -- single line let-where
 samples n f = do
     gen <- newQCGen

data/examples/declaration/value/function/guards-out.hs

@@ -6,11 +6,11 @@ foo x
 bar :: Int -> Int
 bar x
   | x == 5 =
-    foo x +
+    foo x
-      foo 10
+      + foo 10
   | x == 6 =
-    foo x +
+    foo x
-      foo 20
+      + foo 20
   | otherwise = foo 100
 
 baz :: Int -> Int

data/examples/declaration/value/function/if-multi-line-out.hs

@@ -8,8 +8,8 @@ bar :: Int -> Int
 bar x =
   if x > 5
   then
-    foo x +
+    foo x
-      100
+      + 100
   else
     case x of
       1 -> 10

data/examples/declaration/value/function/lambda-multi-line-out.hs

@@ -13,10 +13,10 @@ tricky0 =
     canUnify poly_given_ok wt gt || go False wt gt
 
 tricky1 =
-  flip all (zip ws gs) $
+  flip all (zip ws gs)
-    \(wt, gt) -> canUnify poly_given_ok wt gt || go False wt gt
+    $ \(wt, gt) -> canUnify poly_given_ok wt gt || go False wt gt
 
 tricky2 =
-  flip all (zip ws gs) $
+  flip all (zip ws gs)
-    \(wt, gt) ->
+    $ \(wt, gt) ->
       canUnify poly_given_ok wt gt || go False wt gt

data/examples/declaration/value/function/let-multi-line-out.hs

@@ -8,8 +8,8 @@ bar :: Int -> Int
 bar x =
   let z = y
       y = x
-   in z +
+   in z
-        100
+        + 100
 
 inlineComment :: Int -> Int
 inlineComment =

data/examples/declaration/value/function/list-comprehensions-out.hs

@@ -9,12 +9,12 @@ barbaz x y z w =
       b <- y, -- Baz
       any even [a, b],
       c <-
-        z *
+        z
-          z ^
+          * z
-          2, -- Bar baz
+          ^ 2, -- Bar baz
       d <-
-        w +
+        w
-          w, -- Baz bar
+          + w, -- Baz bar
       all
         even
         [ a,

data/examples/declaration/value/function/operators-out.hs

@@ -0,0 +1,41 @@
+foo = bar
+  ++ {- some comment -}
+  case foo of
+    a -> a
+
+main =
+  bar
+    $ baz -- bar
+    -- baz
+
+f =
+  Foo <$> bar
+    <*> baz
+
+update =
+  do
+    foobar
+    `catch` \case
+      a -> a
+
+foo =
+  do
+    1
+    + 2
+
+main =
+  do
+    stuff
+    `finally` do
+      recover
+
+lenses =
+  Just $ M.fromList
+    $ "type"
+    .= ("user.connection" :: Text)
+    # "connection"
+    .= uc
+    # "user" .= case name of
+    Just n -> Just $ object ["name" .= n]
+    Nothing -> Nothing
+    # []

data/examples/declaration/value/function/operators.hs

@@ -0,0 +1,36 @@
+foo = bar ++
+    {- some comment -}
+    case foo of
+      a -> a
+
+main =
+  bar $ -- bar
+    baz -- baz
+
+f =
+  Foo <$> bar
+      <*> baz
+
+update =
+    do
+      foobar
+    `catch` \case
+      a -> a
+
+foo = do
+    1
+    +
+    2
+
+main =
+  do stuff
+   `finally` do
+     recover
+
+lenses = Just $ M.fromList
+  $ "type"       .= ("user.connection" :: Text)
+  # "connection" .= uc
+  # "user"       .= case name of
+      Just  n -> Just $ object ["name" .= n]
+      Nothing -> Nothing
+  # []

data/examples/declaration/value/function/parallel-comprehensions-out.hs

@@ -18,20 +18,22 @@ baz x y z w =
         x, -- Foo 2
       b <- -- Bar 1
         y, -- Bar 2
-      a `mod`
+      a
-        b == -- Value
+        `mod` b -- Value
-        0
+        == 0
       | c <- -- Baz 1
-          z * -- Baz 2
+          z
-            z -- Baz 3
+            * z -- Baz 2
+            -- Baz 3
       | d <- w -- Other
       | e <- x * x -- Foo bar
       | f <- -- Foo baz 1
           y + y -- Foo baz 2
       | h <- z + z * w ^ 2 -- Bar foo
       | i <- -- Bar bar 1
-          a + -- Bar bar 2
+          a
-            b, -- Bar bar 3
+            + b, -- Bar bar 2
+            -- Bar bar 3
         j <- -- Bar baz 1
           a + b -- Bar baz 2
     ]

data/examples/declaration/value/function/pattern/splice-pattern-out.hs

@@ -5,8 +5,8 @@ singleLine = case () of
   $(y "something") -> ()
 
 multiline = case () of
-  $( x +
+  $( x
-       y
+       + y
      ) -> ()
   $( y
        "something"

data/examples/declaration/value/function/transform-comprehensions-out.hs

@@ -23,8 +23,8 @@ bar' xs ys =
       -- First comment
       then sortWith
       by
-        ( x +
+        ( x
-            y -- Second comment
+            + y -- Second comment
           )
     ]
 
@@ -50,8 +50,8 @@ quux' xs ys =
       y <- ys,
       -- First comment
       then group by
-        ( x +
+        ( x
-            y
+            + y
           )
       -- Second comment
       using groupWith -- Third comment

data/examples/declaration/value/other/comments-get-before-op-out.hs

@@ -4,7 +4,7 @@ main = do
     [ migration1,
       migration1,
       migration3
-      ] -- When adding migrations here, don't forget to update
+      ]
+    -- When adding migrations here, don't forget to update
     -- 'schemaVersion' in Galley.Data
-    `finally`
+    `finally` Log.close
-    Log.close

default.nix

@@ -23,7 +23,7 @@ in {
   ormolu = haskellPackages.ormolu;
   ormolu-shell = haskellPackages.shellFor {
     packages = ps: [ ps.ormolu ];
-    buildInputs = [ pkgs.cabal-install ];
+    buildInputs = [ haskellPackages.cabal-install haskellPackages.ghcid ];
   };
   hackage = pkgs.lib.mapAttrs ormolize haskellPackages;
 }

src/Ormolu/Printer/Comments.hs

@@ -78,13 +78,22 @@ spitFollowingComment
 spitFollowingComment (L ref a) mlastSpn = do
   mnSpn <- nextEltSpan
   meSpn <- getEnclosingSpan ref
+  newlineModified <- isNewlineModified
   i <- getIndent
   withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastSpn) $ \l comment ->
     if theSameLine l ref && not (isModule a)
       then modNewline $ \m -> setIndent i $ do
-        spit " "
+        if newlineModified
-        spitComment comment
+          then do
-        m
+            -- This happens when we have several lines each with its own
+            -- comment and they get merged by the formatter.
+            m
+            spitComment comment
+            newline
+          else do
+            spit " "
+            spitComment comment
+            m
       else modNewline $ \m -> setIndent i $ do
         m
         when (needsNewlineBefore l mlastSpn) newline

src/Ormolu/Printer/Internal.hs

@@ -16,6 +16,7 @@ module Ormolu.Printer.Internal
   , spit
   , newline
   , modNewline
+  , isNewlineModified
   , ensureIndent
   , inci
   , sitcc
@@ -39,7 +40,7 @@ where
 import Control.Monad.Reader
 import Control.Monad.State.Strict
 import Data.Coerce
-import Data.Maybe (listToMaybe)
+import Data.Maybe (fromMaybe, isJust, listToMaybe)
 import Data.Text (Text)
 import Data.Text.Lazy.Builder
 import Debug.Trace
@@ -89,8 +90,8 @@ data SC = SC
     -- ^ Span stream
   , scCommentStream :: CommentStream
     -- ^ Comment stream
-  , scNewline :: R ()
+  , scNewline :: Maybe (R ())
-    -- ^ What to render as newline
+    -- ^ What to render as newline, or 'Nothing' ('newlineRaw' will be used)
   }
 
 -- | 'Layout' options.
@@ -125,7 +126,7 @@ runR debug (R m) sstream cstream anns =
       , scBuilder = mempty
       , scSpanStream = sstream
       , scCommentStream = cstream
-      , scNewline = newlineRaw
+      , scNewline = Nothing
       }
 
 ----------------------------------------------------------------------------
@@ -149,9 +150,9 @@ newline :: R ()
 newline = do
   n <- R (gets scNewline)
   R . modify $ \sc -> sc
-    { scNewline = newlineRaw
+    { scNewline = Nothing
     }
-  n
+  fromMaybe newlineRaw n
 
 -- | Low-level newline primitive. This one always just inserts a newline, no
 -- hooks can be attached.
@@ -179,9 +180,14 @@ modNewline :: (R () -> R ()) -> R ()
 modNewline f = R $ do
   old <- gets scNewline
   modify $ \sc -> sc
-    { scNewline = f old
+    { scNewline = Just $ f (fromMaybe newlineRaw old)
     }
 
+-- | Check if newline is in modified state.
+
+isNewlineModified :: R Bool
+isNewlineModified = isJust <$> R (gets scNewline)
+
 -- | Ensure that indentation level is satisfied. Insert correct number of
 -- spaces if it isn't.
 

src/Ormolu/Printer/Meat/Declaration/Value.hs

@@ -472,21 +472,20 @@ p_hsExpr = \case
       located (hswc_body a) p_hsType
   OpApp NoExt x op y -> do
     located x p_hsExpr
-    space
+    -- NOTE If the end of the first argument and the beginning of the second
-    let opWrapper = case unLoc op of
+    -- argument are on the same line, and the second argument has a hanging
-          EWildPat NoExt -> backticks
+    -- form, use hanging placement.
-          _ -> id
-    -- NOTE Sometimes operator may be displaced from the line by comments,
-    -- it still should be more indented to remain valid code.
-    inci $ located op (opWrapper . p_hsExpr)
     let placement =
-          -- NOTE If end of operator and start of second argument are on
-          -- different lines, always use normal placement.
           if isOneLineSpan
-               (mkSrcSpan (srcSpanEnd (getLoc op)) (srcSpanStart (getLoc y)))
+               (mkSrcSpan (srcSpanEnd (getLoc x)) (srcSpanStart (getLoc y)))
             then exprPlacement (unLoc y)
             else Normal
-    placeHanging placement $
+        opWrapper = case unLoc op of
+          EWildPat NoExt -> backticks
+          _ -> id
+    placeHanging placement $ do
+      located op (opWrapper . p_hsExpr)
+      space
       located y p_hsExpr
   NegApp NoExt e _ -> do
     txt "- "
@@ -931,9 +930,13 @@ exprPlacement = \case
   HsDo NoExt DoExpr _ -> Hanging
   HsDo NoExt MDoExpr _ -> Hanging
   RecordCon NoExt _ _ -> Hanging
+  -- If the rightmost expression in an operator chain is hanging, make the
+  -- whole block hanging; so that we can use the common @f = foo $ do@
+  -- style.
+  OpApp NoExt _ _ y -> exprPlacement (unLoc y)
   HsProc NoExt (L s _) _ ->
-    -- Indentation breaks if pattern is longer than one line and left hanging.
+    -- Indentation breaks if pattern is longer than one line and left
-    -- Consequently, only apply hanging when it is safe.
+    -- hanging. Consequently, only apply hanging when it is safe.
     if isOneLineSpan s
     then Hanging
     else Normal