From 9b7b6eb2391ee9a8a0ea87c46be74d447d9df99a Mon Sep 17 00:00:00 2001
From: Mark Karpov <markkarpov92@gmail.com>
Date: Fri, 10 Apr 2020 12:33:22 +0200
Subject: [PATCH] Fix rendering of arrow notation with multiline expressions

---
 CHANGELOG.md                                  |  3 ++
 .../function/arrow/multiline-case-out.hs      |  8 +++++
 .../value/function/arrow/multiline-case.hs    |  7 +++++
 .../function/arrow/proc-applications-out.hs   | 11 +++----
 .../function/arrow/proc-do-complex-out.hs     | 30 +++++++++++--------
 .../function/arrow/proc-do-simple1-out.hs     |  5 ++--
 .../function/arrow/proc-do-simple2-out.hs     | 16 +++++-----
 .../value/function/arrow/proc-forms1-out.hs   | 14 +++++----
 .../value/function/arrow/proc-forms2-out.hs   | 10 ++++---
 .../value/function/arrow/proc-ifs-out.hs      | 10 ++++---
 .../function/arrow/proc-parentheses-out.hs    |  9 +++---
 .../function/arrow/recursive-procs-out.hs     | 24 ++++++++-------
 src/Ormolu/Printer/Meat/Declaration/Value.hs  | 13 ++++----
 13 files changed, 99 insertions(+), 61 deletions(-)
 create mode 100644 data/examples/declaration/value/function/arrow/multiline-case-out.hs
 create mode 100644 data/examples/declaration/value/function/arrow/multiline-case.hs

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 69c4483..be2f892 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -16,6 +16,9 @@
   now put on its own line. [Issue
   509](https://github.com/tweag/ormolu/issues/509).
 
+* Fixed the bug pertaining to rendering of arrow notation with multiline
+  expressions. [Issue 513](https://github.com/tweag/ormolu/issues/513).
+
 * Implemented support for the new language extension `ImportQualifiedPost`.
 
 * Implemented support for the new language extension
diff --git a/data/examples/declaration/value/function/arrow/multiline-case-out.hs b/data/examples/declaration/value/function/arrow/multiline-case-out.hs
new file mode 100644
index 0000000..3a75149
--- /dev/null
+++ b/data/examples/declaration/value/function/arrow/multiline-case-out.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE Arrows #-}
+
+f = proc x -> do
+  x <-
+    case x of X -> x
+      -<
+        y
+  a -< b
diff --git a/data/examples/declaration/value/function/arrow/multiline-case.hs b/data/examples/declaration/value/function/arrow/multiline-case.hs
new file mode 100644
index 0000000..ac69036
--- /dev/null
+++ b/data/examples/declaration/value/function/arrow/multiline-case.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE Arrows #-}
+
+f = proc x -> do
+  x
+    <- case x of X -> x
+    -< y
+  a -< b
diff --git a/data/examples/declaration/value/function/arrow/proc-applications-out.hs b/data/examples/declaration/value/function/arrow/proc-applications-out.hs
index 28387fa..7745447 100644
--- a/data/examples/declaration/value/function/arrow/proc-applications-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-applications-out.hs
@@ -9,10 +9,11 @@ bar f x =
       w
       )
   ->
-    f -< -- The value
-      ( x, -- Foo
-        w, -- Bar
-        z -- Baz
-      )
+    f -- The value
+      -<
+        ( x, -- Foo
+          w, -- Bar
+          z -- Baz
+        )
 
 baz x = proc a -> a -<< x
diff --git a/data/examples/declaration/value/function/arrow/proc-do-complex-out.hs b/data/examples/declaration/value/function/arrow/proc-do-complex-out.hs
index 5480b78..e1f9089 100644
--- a/data/examples/declaration/value/function/arrow/proc-do-complex-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-do-complex-out.hs
@@ -19,10 +19,11 @@ foo
           )
           ( b,
             d
-          ) -<
-          ( b + 1, -- Funnel into arrow
-            d * b
           )
+          -<
+            ( b + 1, -- Funnel into arrow
+              d * b
+            )
       if x `mod` y == 0 -- Basic condition
         then case e of -- Only left case is relevant
           Left
@@ -32,9 +33,10 @@ foo
               let v =
                     u -- Actually never used
                       ^ 2
-               in ( returnA -<
-                      -- Just do the calculation
-                      (x + y * z)
+               in ( returnA
+                      -<
+                        -- Just do the calculation
+                        (x + y * z)
                   )
         else do
           let u = x -- Let bindings bind expressions, not commands
@@ -42,8 +44,9 @@ foo
           i <- case u of
             0 -> (g . h -< u)
             n ->
-              ( ( h . g -<
-                    y -- First actual use of y
+              ( ( h . g
+                    -<
+                      y -- First actual use of y
                 )
               )
           returnA -< ()
@@ -51,8 +54,9 @@ foo
           if i > 0
             then ma -< ()
             else returnA -< ()
-          returnA -<
-            ( i
-                + x
-                * y -- Just do the calculation
-            )
+          returnA
+            -<
+              ( i
+                  + x
+                  * y -- Just do the calculation
+              )
diff --git a/data/examples/declaration/value/function/arrow/proc-do-simple1-out.hs b/data/examples/declaration/value/function/arrow/proc-do-simple1-out.hs
index fbc89a0..553c5d8 100644
--- a/data/examples/declaration/value/function/arrow/proc-do-simple1-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-do-simple1-out.hs
@@ -13,5 +13,6 @@ barbaz f g = proc (a, b) -> do
 
 bazbar f = proc a -> do
   a <-
-    f -<
-      a
+    f
+      -<
+        a
diff --git a/data/examples/declaration/value/function/arrow/proc-do-simple2-out.hs b/data/examples/declaration/value/function/arrow/proc-do-simple2-out.hs
index b2e0865..e35a613 100644
--- a/data/examples/declaration/value/function/arrow/proc-do-simple2-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-do-simple2-out.hs
@@ -11,10 +11,12 @@ bazbaz f g h = proc (a, b, c) -> do
   z <-
     h
       x
-      y -<
-      ( a,
-        b,
-        c
-      )
-  returnA -<
-    (x, y, z)
+      y
+      -<
+        ( a,
+          b,
+          c
+        )
+  returnA
+    -<
+      (x, y, z)
diff --git a/data/examples/declaration/value/function/arrow/proc-forms1-out.hs b/data/examples/declaration/value/function/arrow/proc-forms1-out.hs
index 402d9f4..bd29b48 100644
--- a/data/examples/declaration/value/function/arrow/proc-forms1-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-forms1-out.hs
@@ -7,13 +7,15 @@ foo1 f g h x =
     (|
       test
         ( h f
-            . h g -<
-            y x
-              . y z
+            . h g
+            -<
+              y x
+                . y z
         )
         ( h g
-            . h f -<
-            y z
-              . y x
+            . h f
+            -<
+              y z
+                . y x
         )
     |)
diff --git a/data/examples/declaration/value/function/arrow/proc-forms2-out.hs b/data/examples/declaration/value/function/arrow/proc-forms2-out.hs
index 894b145..f774850 100644
--- a/data/examples/declaration/value/function/arrow/proc-forms2-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-forms2-out.hs
@@ -12,9 +12,11 @@ bar2 f g h x =
 
 bar3 f g h x =
   proc (y, z) ->
-    ( (h f . h g) -<
-        (y x) . y z
+    ( (h f . h g)
+        -<
+          (y x) . y z
     ) |||
-      ( (h g . h f) -<
-          y z . (y x)
+      ( (h g . h f)
+          -<
+            y z . (y x)
       )
diff --git a/data/examples/declaration/value/function/arrow/proc-ifs-out.hs b/data/examples/declaration/value/function/arrow/proc-ifs-out.hs
index 8bfb614..60b7afb 100644
--- a/data/examples/declaration/value/function/arrow/proc-ifs-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-ifs-out.hs
@@ -6,8 +6,10 @@ bar f g = proc a ->
   if f a
     then
       f
-        . g -<
-        a
+        . g
+        -<
+          a
     else
-      g -<
-        b
+      g
+        -<
+          b
diff --git a/data/examples/declaration/value/function/arrow/proc-parentheses-out.hs b/data/examples/declaration/value/function/arrow/proc-parentheses-out.hs
index 21d2db3..c2fd7c8 100644
--- a/data/examples/declaration/value/function/arrow/proc-parentheses-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-parentheses-out.hs
@@ -6,13 +6,14 @@ bar f g = proc a ->
   ( ( (f)
         ( g
         )
-    ) -<
-      ( ( ( ( ( ( g
-                    a
+    )
+      -<
+        ( ( ( ( ( ( g
+                      a
+                  )
                 )
               )
             )
           )
         )
-      )
   )
diff --git a/data/examples/declaration/value/function/arrow/recursive-procs-out.hs b/data/examples/declaration/value/function/arrow/recursive-procs-out.hs
index bad7c85..5a04daa 100644
--- a/data/examples/declaration/value/function/arrow/recursive-procs-out.hs
+++ b/data/examples/declaration/value/function/arrow/recursive-procs-out.hs
@@ -3,17 +3,21 @@
 foo f g = proc (x, y) -> do
   rec a <- f y -< x
       b <-
-        g x -<
-          y
-  bar -<
-    ( a,
-      b
-    )
+        g x
+          -<
+            y
+  bar
+    -<
+      ( a,
+        b
+      )
   rec p <-
         f
-          p -<
-          a
+          p
+          -<
+            a
   rec q <-
         g
-          q -<
-          b
+          q
+          -<
+            b
diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs b/src/Ormolu/Printer/Meat/Declaration/Value.hs
index dfabee3..608dae1 100644
--- a/src/Ormolu/Printer/Meat/Declaration/Value.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs
@@ -310,12 +310,13 @@ p_hsCmd :: HsCmd GhcPs -> R ()
 p_hsCmd = \case
   HsCmdArrApp NoExtField body input arrType _ -> do
     located body p_hsExpr
-    space
-    case arrType of
-      HsFirstOrderApp -> txt "-<"
-      HsHigherOrderApp -> txt "-<<"
-    placeHanging (exprPlacement (unLoc input)) $
-      located input p_hsExpr
+    breakpoint
+    inci $ do
+      case arrType of
+        HsFirstOrderApp -> txt "-<"
+        HsHigherOrderApp -> txt "-<<"
+      placeHanging (exprPlacement (unLoc input)) $
+        located input p_hsExpr
   HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do
     located form p_hsExpr
     unless (null cmds) $ do