Fix rendering of arrow notation with multiline expressions

2024-11-09 15:42:12 +03:00 · 2020-04-10 12:33:22 +02:00 · 2020-04-10 12:33:22 +02:00 · 9b7b6eb239
commit 9b7b6eb239
parent ea2d80ed65
13 changed files with 99 additions and 61 deletions
--- 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
--- a/data/examples/declaration/value/function/arrow/multiline-case-out.hs
+++ 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
--- a/data/examples/declaration/value/function/arrow/multiline-case.hs
+++ 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
--- 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
--- 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
+              )
--- 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
--- 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)
--- 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
        )
    |)
--- 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)
      )
--- 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
--- 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
+                  )
                )
              )
            )
          )
        )
-      )
  )
--- 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
--- 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