From 159e5e7761dd0289a8f1eda173deb4c50435f4ad Mon Sep 17 00:00:00 2001
From: Utku Demir <me@utdemir.com>
Date: Fri, 16 Aug 2019 11:59:41 +1200
Subject: [PATCH] Use new operator style in types & declarations

```
a
  + b
```

instead of

```
a +
  b
---
 .../declaration/class/type-operators-out.hs   | 24 ++++++++++------
 .../declaration/class/type-operators.hs       |  7 +++++
 .../declaration/data/multiline-names-out.hs   |  8 +++---
 .../declaration/value/function/infix-out.hs   |  4 +--
 src/Ormolu/Printer/Meat/Common.hs             |  7 +++--
 src/Ormolu/Printer/Meat/Type.hs               | 28 ++++++++++++++-----
 6 files changed, 54 insertions(+), 24 deletions(-)

diff --git a/data/examples/declaration/class/type-operators-out.hs b/data/examples/declaration/class/type-operators-out.hs
index 3bbc9a3..56d43d7 100644
--- a/data/examples/declaration/class/type-operators-out.hs
+++ b/data/examples/declaration/class/type-operators-out.hs
@@ -11,25 +11,33 @@ class
 class a :* b
 
 class
-  a :+ -- Before operator
-    b -- After operator
+  a -- Before operator
+    :+ b -- After operator
 
 class
-  ( f :.
-      g
+  ( f
+      :. g
     )
     a
 
 class a `Pair` b
 
 class
-  a `Sum`
-    b
+  a
+    `Sum` b
 
 class (f `Product` g) a
 
 class
-  ( f `Sum`
-      g
+  ( f
+      `Sum` g
     )
     a
+
+type API
+  = "route1" :> ApiRoute1
+      :<|> "route2"
+      :> ApiRoute2 -- comment here
+      :<|> OmitDocs
+      :> "i"
+      :> ASomething API
diff --git a/data/examples/declaration/class/type-operators.hs b/data/examples/declaration/class/type-operators.hs
index 86e83f3..3cc002b 100644
--- a/data/examples/declaration/class/type-operators.hs
+++ b/data/examples/declaration/class/type-operators.hs
@@ -30,3 +30,10 @@ class (f`Product`g)a
 class (
     f `Sum` g
   ) a
+
+type API
+  = "route1" :> ApiRoute1
+      :<|> "route2" :> ApiRoute2 -- comment here
+      :<|> OmitDocs :> "i" :> ASomething API
+
+
diff --git a/data/examples/declaration/data/multiline-names-out.hs b/data/examples/declaration/data/multiline-names-out.hs
index 0e9022c..9164287 100644
--- a/data/examples/declaration/data/multiline-names-out.hs
+++ b/data/examples/declaration/data/multiline-names-out.hs
@@ -9,8 +9,8 @@ data a :-> b = Arrow (a -> b)
 data (f :* g) a = f a :* g a
 
 data
-  ( f :+
-      g
+  ( f
+      :+ g
     )
     a
   = L (f a)
@@ -21,8 +21,8 @@ data a `Arrow` b = Arrow' (a -> b)
 data (f `Product` g) a = f a `Product` g a
 
 data
-  ( f `Sum`
-      g
+  ( f
+      `Sum` g
     )
     a
   = L' (f a)
diff --git a/data/examples/declaration/value/function/infix-out.hs b/data/examples/declaration/value/function/infix-out.hs
index 6fb01d9..0459297 100644
--- a/data/examples/declaration/value/function/infix-out.hs
+++ b/data/examples/declaration/value/function/infix-out.hs
@@ -8,5 +8,5 @@ bar :: Int -> Int -> Int -> Int
 (x `bar` y) z = z
 
 multiline :: Int -> Int -> Int
-x `multiline`
-  y = z
+x
+  `multiline` y = z
diff --git a/src/Ormolu/Printer/Meat/Common.hs b/src/Ormolu/Printer/Meat/Common.hs
index 99b2f8a..50b8d6b 100644
--- a/src/Ormolu/Printer/Meat/Common.hs
+++ b/src/Ormolu/Printer/Meat/Common.hs
@@ -124,10 +124,11 @@ p_infixDefHelper isInfix inci' name args =
               else parens
       parens' $ do
         p0
-        space
-        name
         breakpoint
-        inci' p1
+        inci $ sitcc $ do
+          name
+          space
+          p1
       unless (null ps) . inci' $ do
         breakpoint
         sitcc (sep breakpoint sitcc ps)
diff --git a/src/Ormolu/Printer/Meat/Type.hs b/src/Ormolu/Printer/Meat/Type.hs
index 5c82f19..816b51d 100644
--- a/src/Ormolu/Printer/Meat/Type.hs
+++ b/src/Ormolu/Printer/Meat/Type.hs
@@ -17,6 +17,7 @@ import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import Ormolu.Utils
+import SrcLoc (combineSrcSpans)
 import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice)
 
 p_hsType :: HsType GhcPs -> R ()
@@ -66,13 +67,26 @@ p_hsType = \case
   HsSumTy NoExt xs ->
     parensHash . sitcc $
       sep (txt "| " >> breakpoint') (sitcc . located' p_hsType) xs
-  HsOpTy NoExt x op y -> do
-    located x p_hsType
-    breakpoint
-    inci $ do
-      p_rdrName op
-      space
-      located y p_hsType
+  HsOpTy NoExt x op y -> sitcc $ do
+    -- In the AST, type operators are right-associative instead of left-associative
+    -- like value level operators. This makes similar constructs look inconsistent.
+    -- Here, we shake the AST to convert right-associative tree to a left-associative
+    -- one.
+    case unLoc y of
+      HsOpTy NoExt x' op' y' ->
+        p_hsType $
+          HsOpTy
+            NoExt
+            (L (combineSrcSpans (getLoc x) (getLoc x')) (HsOpTy NoExt x op x'))
+            op'
+            y'
+      _ -> do
+        located x p_hsType
+        breakpoint
+        inci $ do
+          p_rdrName op
+          space
+          located y p_hsType
   HsParTy NoExt (L _ t@HsKindSig {}) ->
     -- NOTE Kind signatures already put parentheses around in all cases, so
     -- skip this layer of parentheses. The reason for this behavior is that