Change parens style and how separated lists of items are printed

Goals:

* Make the set of combinators clearer and smaller.
* Solve a number of issues, such as those about parse failures related to
  patterns.
* Solve the bug from #244.

The idea is very simple, we stop doing this

  ( foo
  , bar
  )

and start doing this

( foo,
  bar
  )

* We switch to trailing commas which solves the indentation issues for
  patterns automatically.
* The new general ‘sep’ combinator finally is clear enough, and all the old
  zoo of ‘velt’ and ‘velt'’ and ‘sepWith’, etc. which was confusing and
  overlapping goes away.

data/examples/declaration/class/default-signatures-out.hs

@@ -20,8 +20,8 @@ class Bar a where
 
   -- Pointless comment
   default bar
-    :: ( Read a
+    :: ( Read a,
-       , Semigroup a
+         Semigroup a
          )
     => a
     -> a

data/examples/declaration/class/dependency-super-classes-out.hs

@@ -9,8 +9,8 @@ class (MonadReader r s, MonadWriter w m) => MonadState s m | m -> s where
 
 -- | 'MonadParsec'
 class
-  ( Stream s -- Token streams
+  ( Stream s, -- Token streams
-  , MonadPlus m -- Potential for failure
+    MonadPlus m -- Potential for failure
     )
   => MonadParsec e s m
     | m -> e s where

data/examples/declaration/class/functional-dependencies-out.hs

@@ -10,10 +10,10 @@ class Bar a b | a -> b, b -> a where
 -- | Something else.
 class
   Baz a b c d
-    | a b -> c d -- Foo
+    | a b -> c d, -- Foo
-    , b c -> a d -- Bar
+      b c -> a d, -- Bar
-    , a c -> b d -- Baz
+      a c -> b d, -- Baz
-    , a c d -> b
+      a c d -> b,
-    , a b d -> a b c d where
+      a b d -> a b c d where
 
   baz :: a -> b

data/examples/declaration/class/single-parameters-out.hs

@@ -13,8 +13,8 @@ class Baz a where
 
   -- | Baz
   baz
-    :: ( a
+    :: ( a,
-       , a -- ^ First argument
+         a -- ^ First argument
          )
     -> a -- ^ Second argument
     -> a -- ^ Return value

data/examples/declaration/class/super-classes-out.hs

@@ -7,8 +7,8 @@ class
   => Baz a
 
 class
-  ( Foo a -- Foo?
+  ( Foo a, -- Foo?
-  , Bar a -- Bar?
+    Bar a, -- Bar?
-  , Baz a -- Baz
+    Baz a -- Baz
     )
   => BarBar a

data/examples/declaration/data/deriving-strategies-out.hs

@@ -2,8 +2,8 @@
 newtype Foo = Foo Int
   deriving stock (Eq, Show, Generic)
   deriving anyclass
-    ( ToJSON
+    ( ToJSON,
-    , FromJSON
+      FromJSON
       )
   deriving newtype (Num)
   deriving (Monoid) via (Sum Int)

data/examples/declaration/data/gadt/multiple-declaration-out.hs

@@ -2,14 +2,14 @@ data GADT0 a where
   GADT01, GADT02 :: Int -> GADT0 a
 
 data GADT1 a where
-  GADT11
+  GADT11,
-    , GADT12
+    GADT12
     :: Int
     -> GADT1 a
 
 data GADT2 a where
-  GADT21
+  GADT21,
-    , GADT21
+    GADT21,
-    , GADT22
+    GADT22
     :: Int
     -> GADT2 a

data/examples/declaration/data/gadt/record-out.hs

@@ -2,10 +2,11 @@
 data Foo where
   Foo :: {fooX :: Int} -> Foo
   Bar
-    :: { fooY :: Int
+    :: { fooY :: Int,
-       , fooBar, fooBaz :: Bool
+         fooBar, fooBaz :: Bool,
-       , fooFoo
+         fooFoo,
-         , barBar
+         barBar,
+         bazBaz
            :: Int
          }
     -> Foo

data/examples/declaration/data/gadt/record.hs

@@ -5,5 +5,6 @@ data Foo where
   Bar :: { fooY :: Int
          , fooBar, fooBaz :: Bool
          , fooFoo
-             , barBar :: Int
+             , barBar
+             , bazBaz :: Int
          } -> Foo

data/examples/declaration/data/record-out.hs

@@ -1,18 +1,18 @@
 -- | Something.
 data Foo
   = Foo
-      { fooX :: Int -- ^ X
+      { fooX :: Int, -- ^ X
-      , fooY :: Int -- ^ Y
+        fooY :: Int, -- ^ Y
-      , fooBar, fooBaz :: NonEmpty (Identity Bool) -- ^ BarBaz
+        fooBar, fooBaz :: NonEmpty (Identity Bool), -- ^ BarBaz
-      , fooGag
+        fooGag,
-        , fooGog
+        fooGog
           :: NonEmpty
                ( Indentity
                    Bool
-               )
+                 ),
         -- ^ GagGog
-      , fooFoo
+        fooFoo,
-        , barBar
+        barBar
           :: Int -- ^ Huh!
         }
   deriving (Eq, Show)

data/examples/declaration/default/default-out.hs

@@ -1,7 +1,7 @@
 default (Int, Foo, Bar)
 
 default
-  ( Int
+  ( Int,
-  , Foo
+    Foo,
-  , Bar
+    Bar
     )

data/examples/declaration/instance/contexts-out.hs

@@ -3,38 +3,41 @@ instance Eq a => Eq [a] where
   (==) _ _ = False
 
 instance
-  ( Ord a
+  ( Ord a,
-  , Ord b
+    Ord b
     )
-  => Ord (a, b) where
+  => Ord (a, b)
+  where
 
   compare _ _ = GT
 
 instance
   (Show a, Show b)
   => Show
-       ( a
+       ( a,
-       , b
+         b
-       ) where
+         )
+  where
 
   showsPrec _ _ = showString ""
 
 instance
-  ( Read a -- Foo
+  ( Read a, -- Foo
-  , Read b
+    Read b,
-  , Read
+    Read
-      ( c
+      ( c,
-      , -- Bar
+        -- Bar
         d
         )
     )
   => Read
-       ( a
+       ( a,
-       , -- Baz
+         -- Baz
-       b
+         b,
-       , ( c -- Quux
+         ( c, -- Quux
-         , d
+           d
            )
-       ) where
+         )
+  where
 
   readsPrec = undefined

data/examples/declaration/instance/data-family-instances-out.hs

@@ -7,11 +7,11 @@ data instance
   Foo
     [Int]
   = IntListFoo
-      ( Int
+      ( Int,
-      , Int
+        Int
         )
-      ( Double
+      ( Double,
-      , Double
+        Double
         )
 
 newtype instance Foo [Double]

data/examples/declaration/instance/overlappable-instances-out.hs

@@ -13,6 +13,7 @@ instance {-# OVERLAPS #-} Eq Double where
 instance
   {-# INCOHERENT #-}
   Ord
-    Double where
+    Double
+  where
 
   compare _ _ = GT

data/examples/declaration/instance/type-family-instances-out.hs

@@ -5,8 +5,8 @@ type instance Foo Int = Int
 type instance
   Foo
     [Int] =
-    ( Int
+    ( Int,
-    , Int
+      Int
       )
 
 type instance Bar Int [Int] Double = (Int, Double)
@@ -16,6 +16,6 @@ type instance
     [Int]
     [Int]
     Double =
-    ( Int
+    ( Int,
-    , Double
+      Double
       )

data/examples/declaration/signature/complete/complete-out.hs

@@ -3,8 +3,8 @@
 {-# COMPLETE A, B #-}
 
 {-# COMPLETE
-  A
+  A,
-  , B
+  B,
-  , C
+  C
     :: Foo
   #-}

data/examples/declaration/signature/minimal/minimal-out.hs

@@ -5,8 +5,8 @@ class Foo a where
   {-# MINIMAL
     a
     | ( b, c, d
-      | e
+        | e,
-      , f
+          f
         )
       | g
     #-}

data/examples/declaration/signature/specialize/specialize-out.hs

@@ -17,8 +17,8 @@ baz = id
 {-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-}
 {-# SPECIALIZE fits13Bits
   :: Int
-     -> Bool
+  -> Bool,
-  , Integer -> Bool
+  Integer -> Bool
   #-}
 fits13Bits :: Integral a => a -> Bool
 fits13Bits x = x >= -4096 && x < 4096

data/examples/declaration/signature/type/context-multi-line-out.hs

@@ -1,7 +1,7 @@
 functionName
-  :: ( C1
+  :: ( C1,
-     , C2
+       C2,
-     , C3
+       C3
        )
   => a
   -> b

data/examples/declaration/signature/type/multi-value-out.hs

@@ -1,6 +1,6 @@
 foo, bar :: Int
 
-foo
+foo,
-  , bar
+  bar,
-  , baz
+  baz
     :: Int

data/examples/declaration/value/function/arithmetic-sequences-out.hs

@@ -8,8 +8,8 @@ bar x =
     ]
 
 baz x =
-  [ 1
+  [ 1,
-  , 3
+    3
     .. x
     ]
 

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

@@ -4,15 +4,15 @@ foo x = proc a -> a -< x
 
 bar f x =
   proc
-    ( y
+    ( y,
-    , z
+      z,
-    , w
+      w
       )
   ->
     f -< -- The value
-      ( x -- Foo
+      ( x, -- Foo
-      , w -- Bar
+        w, -- Bar
-      , z -- Baz
+        z -- Baz
         )
 
 baz x = proc a -> a -<< x

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

@@ -5,8 +5,8 @@ foo f = proc a -> case a of Left b -> f -< b
 bar f g h j =
   proc a -> case a of
     Left
-      ( (a, b)
+      ( (a, b),
-      , (c, d)
+        (c, d)
         ) -> f (a <> c) -< b <> d
     Right
       (Left a) ->

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

@@ -6,29 +6,29 @@ foo
   h
   ma =
     proc
-      ( (a, b)
+      ( (a, b),
-      , (c, d)
+        (c, d),
-      , (e, f)
+        (e, f)
         )
     -> do
       -- Begin do
       (x, y) <- -- GHC parser fails if layed out over multiple lines
         f -- Call into f
-          ( a
+          ( a,
-          , c -- Tuple together arguments
+            c -- Tuple together arguments
             )
-          ( b
+          ( b,
-          , d
+            d
             ) -<
-          ( b + 1 -- Funnel into arrow
+          ( b + 1, -- Funnel into arrow
-          , d * b
+            d * b
             )
       if x `mod` y == 0 -- Basic condition
       then
         case e of -- Only left case is relevant
           Left
-            ( z
+            ( z,
-            , w
+              w
               ) -> \u -> -- Procs can have lambdas
               let v =
                     u ^ -- Actually never used

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

@@ -28,9 +28,9 @@ bazbaz f g h = proc (a, b, c) -> do
     h
       x
       y -<
-      ( a
+      ( a,
-      , b
+        b,
-      , c
+        c
         )
   returnA -<
     (x, y, z)

data/examples/declaration/value/function/arrow/recursive-procs-out.hs

@@ -6,8 +6,8 @@ foo f g = proc (x, y) -> do
         g x -<
           y
   bar -<
-    ( a
+    ( a,
-    , b
+      b
       )
   rec p <-
         f

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

@@ -0,0 +1,4 @@
+foo = do
+  ( bar
+      baz
+    )

data/examples/declaration/value/function/do-single-multi.hs

@@ -0,0 +1,2 @@
+foo = do (bar
+          baz)

data/examples/declaration/value/function/implicit-params-out.hs

@@ -7,8 +7,8 @@ sort = sortBy ?cmp
 
 sort'
   :: ( ?cmp
-         :: a -> a -> Bool
+         :: a -> a -> Bool,
-     , ?foo :: Int
+       ?foo :: Int
        )
   => [a]
   -> [a]

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

@@ -5,21 +5,21 @@ bar x y = [(a, b) | a <- x, even a, b <- y, a != b]
 barbaz x y z w =
   [ (a, b, c, d) -- Foo
   | a <-
-      x -- Bar
+      x, -- Bar
-  , b <- y -- Baz
+    b <- y, -- Baz
-  , any even [a, b]
+    any even [a, b],
-  , c <-
+    c <-
       z *
         z ^
-        2 -- Bar baz
+        2, -- Bar baz
-  , d <-
+    d <-
       w +
-        w -- Baz bar
+        w, -- Baz bar
-  , all
+    all
       even
-      [ a
+      [ a,
-      , b
+        b,
-      , c
+        c,
-      , d
+        d
         ]
     ]

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

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

data/examples/declaration/value/function/pattern/famous-cardano-pattern-out.hs

@@ -0,0 +1,8 @@
+( getNodeSettingsR :<|>
+  getNodeInfoR :<|>
+  getNextUpdateR :<|>
+  restartNodeR
+  ) :<|>
+  ( getUtxoR :<|>
+    getConfirmedProposalsR
+    ) = client nodeV1Api

data/examples/declaration/value/function/pattern/famous-cardano-pattern.hs

@@ -0,0 +1,7 @@
+(       getNodeSettingsR
+ :<|>   getNodeInfoR
+ :<|>   getNextUpdateR
+ :<|>   restartNodeR
+ ):<|>( getUtxoR
+ :<|>   getConfirmedProposalsR
+ ) = client nodeV1Api

data/examples/declaration/value/function/pattern/multiline-case-pattern-out.hs

@@ -0,0 +1,15 @@
+readerBench doc name =
+  runPure $ case (getReader name, getWriter name) of
+    ( Right (TextReader r, rexts),
+      Right (TextWriter w, wexts)
+      ) -> undefined
+
+f xs = case xs of
+  [ a,
+    b
+    ] -> a + b
+
+g xs = case xs of
+  ( a :
+    bs
+    ) -> a + b

data/examples/declaration/value/function/pattern/multiline-case-pattern.hs

@@ -0,0 +1,12 @@
+readerBench doc name =
+  runPure $ case (getReader name, getWriter name) of
+    (Right (TextReader r, rexts),
+     Right (TextWriter w, wexts)) -> undefined
+
+f xs = case xs of
+  [    a,
+   b       ] -> a + b
+
+g xs = case xs of
+  (a:
+    bs) -> a + b

data/examples/declaration/value/function/pattern/record-patterns-out.hs

@@ -13,7 +13,7 @@ baz Boom {boom = b, ..} = b
 quux :: Boom -> Int
 quux
   Boom
-    { boom = a
+    { boom = a,
-    , foom = b
+      foom = b,
-    , ..
+      ..
       } = a + b

data/examples/declaration/value/function/record-constructors-out.hs

@@ -1,8 +1,8 @@
 foo = Foo {a = 3}
 
 bar = Bar
-  { abc = foo
+  { abc = foo,
-  , def = Foo {a = 10}
+    def = Foo {a = 10}
     }
 
 baz = Baz {}

data/examples/declaration/value/function/record-updaters-out.hs

@@ -2,8 +2,8 @@ foo x = x {a = 3}
 
 bar x =
   x
-    { abc = foo
+    { abc = foo,
-    , def = Foo {a = 10}
+      def = Foo {a = 10}
       }
 
 baz x = x {}

data/examples/declaration/value/function/record-wildcards-out.hs

@@ -4,10 +4,10 @@
 foo x y = Foo {x, y}
 
 bar x y z = Bar
-  { x
+  { x,
-  , y
+    y,
-  , z
+    z,
-  , ..
+    ..
     }
 
 baz = Baz {..}

data/examples/declaration/value/function/static-pointers-out.hs

@@ -6,9 +6,9 @@ foo = static 5
 bar :: StaticPtr [Int]
 bar =
   static
-    [ 1
+    [ 1,
-    , 2
+      2,
-    , 3
+      3
       ]
 
 baz :: StaticPtr Bool

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

@@ -3,24 +3,24 @@
 foo xs ys = [(x, y) | x <- xs, y <- ys, then reverse]
 
 foo' xs ys =
-  [ ( x
+  [ ( x,
-    , y
+      y
       )
-  | x <- xs
+  | x <- xs,
-  , y <- ys
+    y <- ys,
-  , -- First comment
+    -- First comment
     then reverse -- Second comment
     ]
 
 bar xs ys = [(x, y) | x <- xs, y <- ys, then sortWith by (x + y)]
 
 bar' xs ys =
-  [ ( x
+  [ ( x,
-    , y
+      y
       )
-  | x <- xs
+  | x <- xs,
-  , y <- ys
+    y <- ys,
-  , -- First comment
+    -- First comment
     then sortWith
     by
       ( x +
@@ -31,24 +31,24 @@ bar' xs ys =
 baz xs ys = [(x, y) | x <- xs, y <- ys, then group using permutations]
 
 baz' xs ys =
-  [ ( x
+  [ ( x,
-    , y
+      y
       )
-  | x <- xs
+  | x <- xs,
-  , y <- ys
+    y <- ys,
-  , -- First comment
+    -- First comment
     then group using permutations -- Second comment
     ]
 
 quux xs ys = [(x, y) | x <- xs, y <- ys, then group by (x + y) using groupWith]
 
 quux' xs ys =
-  [ ( x
+  [ ( x,
-    , y
+      y
       )
-  | x <- xs
+  | x <- xs,
-  , y <- ys
+    y <- ys,
-  , -- First comment
+    -- First comment
     then group by
       ( x +
         y

data/examples/declaration/value/function/tuple-sections-out.hs

@@ -5,5 +5,4 @@ foo = (,2)
 bar = (,5,)
 
 baz =
-  ( ,,5,6,7,,,
+  (,,5,6,7,,,)
-  )

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

@@ -1,7 +1,7 @@
 foo = (1, 2, 3)
 
 bar =
-  ( 1
+  ( 1,
-  , 2
+    2,
-  , 3
+    3
     )

data/examples/declaration/value/function/unboxed-tuples-out.hs

@@ -3,7 +3,7 @@
 foo = (# 1, 2, 3 #)
 
 bar =
-  (# 1
+  (# 1,
-  , 2
+     2,
-  , 3
+     3
     #)

data/examples/declaration/value/other/line-multi-line-out.hs

@@ -1,6 +1,6 @@
 x :: [Int]
 x =
-  [ 1
+  [ 1,
-  , 2
+    2,
-  , somethingSomething 3
+    somethingSomething 3
     ]

data/examples/declaration/warning/warning-multiline-out.hs

@@ -1,8 +1,8 @@
 {-# WARNING
-  test
+  test,
-  , foo
+  foo
-  [ "These are bad functions"
+  [ "These are bad functions",
-  , "Really bad!"
+    "Really bad!"
     ]
   #-}
 test :: IO ()

data/examples/import/explicit-imports-out.hs

@@ -1,12 +1,12 @@
 import qualified MegaModule as M
-  ( (<<<)
+  ( (<<<),
-  , (>>>)
+    (>>>),
-  , Either
+    Either,
-  , Maybe (Just, Nothing)
+    Maybe (Just, Nothing),
-  , MaybeT (..)
+    MaybeT (..),
-  , Monad ((>>), (>>=), return)
+    Monad ((>>), (>>=), return),
-  , MonadBaseControl
+    MonadBaseControl,
-  , join
+    join,
-  , liftIO
+    liftIO,
-  , void
+    void
     )

data/examples/import/explicit-imports-with-comments-out.hs

@@ -1,6 +1,6 @@
 import qualified MegaModule as M
   ( -- (1)
-    (<<<) -- (2)
+    (<<<), -- (2)
-  , (>>>)
+    (>>>),
-  , Either -- (3)
+    Either -- (3)
     )

data/examples/import/misc-out.hs

@@ -1,11 +1,11 @@
 import A hiding
-  ( foobarbazqux
+  ( foobarbazqux,
-  , foobarbazqux
+    foobarbazqux,
-  , foobarbazqux
+    foobarbazqux,
-  , foobarbazqux
+    foobarbazqux,
-  , foobarbazqux
+    foobarbazqux,
-  , foobarbazqux
+    foobarbazqux,
-  , foobarbazqux
+    foobarbazqux
     )
 import {-# SOURCE #-} safe qualified Module as M hiding (a, b, c, d, e, f)
 import Name hiding ()

data/examples/import/nested-explicit-imports-out.hs

@@ -1,10 +1,10 @@
 import qualified MegaModule as M
-  ( (<<<)
+  ( (<<<),
-  , (>>>)
+    (>>>),
-  , Either
+    Either,
-  , Monad
+    Monad
-      ( (>>)
+      ( (>>),
-      , (>>=)
+        (>>=),
-      , return
+        return
         )
     )

data/examples/module-header/double-dot-with-names-out.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE PatternSynonyms #-}
 
 module ExportSyntax
-  ( A (.., NoA)
+  ( A (.., NoA),
-  , Q (F, ..)
+    Q (F, ..),
-  , G (T, .., U)
+    G (T, .., U)
     )
 where
 

data/examples/module-header/multiline-out.hs

@@ -1,6 +1,6 @@
 module Foo
-  ( foo
+  ( foo,
-  , bar
+    bar,
-  , baz
+    baz
     )
 where

data/examples/module-header/multiline-with-comments-out.hs

@@ -4,17 +4,17 @@
 -- | Header.
 module My.Module
   ( -- * Something
-    foo
+    foo,
-  , bar
+    bar,
-  , -- * Another thing
+    -- * Another thing
-    (<?>)
+    (<?>),
-  , {- some other thing -} foo2 -- yet another
+    {- some other thing -} foo2, -- yet another
-  , foo3 -- third one
+    foo3, -- third one
-  , baz
+    baz,
-  , bar2 -- a multiline comment
+    bar2, -- a multiline comment
     -- the second line
-  , bar3
+    bar3,
-  , module Foo.Bar.Baz
+    module Foo.Bar.Baz
     )
 where
 

data/examples/module-header/multiline2-out.hs

@@ -1,6 +1,6 @@
 module Foo
-  ( foo
+  ( foo,
-  , bar
+    bar,
-  , baz
+    baz
     )
 where

data/examples/module-header/warning-pragma-list-multiline-out.hs

@@ -1,11 +1,11 @@
 module Test
   {-# DEPRECATED
-    [ "This module is deprecated."
+    [ "This module is deprecated.",
-    , "Please use OtherModule instead."
+      "Please use OtherModule instead."
       ]
     #-}
-  ( foo
+  ( foo,
-  , bar
+    bar,
-  , baz
+    baz
     )
 where

data/examples/module-header/warning-pragma-multiline-out.hs

@@ -1,7 +1,7 @@
 module Test {-# DEPRECATED "This module is unstable" #-}
-  ( foo
+  ( foo,
-  , bar
+    bar,
-  , baz
+    baz
     )
 where
 

data/printer/list0-multi.hs

@@ -1,4 +1,4 @@
-[ foo
+[ foo,
-, bar
+  bar,
-, baz
+  baz
-]
+  ]

data/printer/list1-multi.hs

@@ -1,8 +1,8 @@
-[ foo
+[ foo,
-, bar
+  bar,
-, foo
+  foo
     :: ( Int
          -> Int
          )
     -> Bool
-]
+  ]

data/printer/mhdr-multi.hs

@@ -1,7 +1,7 @@
 module MyModule
-  ( R
+  ( R,
-  , runR
+    runR,
-  , txt
+    txt,
-  , blah
+    blah
     )
 where

src/Ormolu/Printer/Combinators.hs

@@ -17,18 +17,13 @@ module Ormolu.Printer.Combinators
   , newline
   , inci
   , located
-  , locatedVia
   , located'
   , switchLayout
   , vlayout
   , breakpoint
   , breakpoint'
     -- ** Formatting lists
-  , velt
+  , sep
-  , velt'
-  , withSep
-  , spaceSep
-  , newlineSep
     -- ** Wrapping
   , sitcc
   , line
@@ -85,18 +80,7 @@ located
   => Located a                  -- ^ Thing to enter
   -> (a -> R ())                -- ^ How to render inner value
   -> R ()
-located loc@(L l _) = locatedVia (Just l) loc
+located loc f = do
-
--- | A special version of 'located' that allows to control layout using an
--- externally provided span. 'Nothing' means that layout won't be changed.
-
-locatedVia
-  :: Data a
-  => Maybe SrcSpan              -- ^ Span that controls layout selection
-  -> Located a                  -- ^ Thing to enter
-  -> (a -> R ())                -- ^ How to render inner value
-  -> R ()
-locatedVia ml loc f = do
   let withRealLocated (L l a) g =
         case l of
           UnhelpfulSpan _ -> return ()
@@ -109,9 +93,7 @@ locatedVia ml loc f = do
             if isModule (unLoc loc)
               then id
               else withEnclosingSpan orf
-  setEnclosingSpan $ case ml of
+  setEnclosingSpan $ switchLayout [getLoc loc] (f (unLoc loc))
-     Nothing -> f (unLoc loc)
-     Just l' -> switchLayout l' (f (unLoc loc))
   withRealLocated loc spitFollowingComments
 
 -- | A version of 'located' with arguments flipped.
@@ -123,19 +105,28 @@ located'
   -> R ()
 located' = flip located
 
--- | Set layout according to given 'SrcSpan' for a given computation. Use
+-- | Set layout according to combination of given 'SrcSpan's for a given.
--- this only when you need to set layout based on e.g. combined span of
+-- Use this only when you need to set layout based on e.g. combined span of
 -- several elements when there is no corresponding 'Located' wrapper
 -- provided by GHC AST. It is relatively rare that this one is needed.
+--
+-- Given empty list this function will set layout to single line.
 
 switchLayout
-  :: SrcSpan                    -- ^ Span that controls layout
+  :: [SrcSpan]                  -- ^ Span that controls layout
   -> R ()                       -- ^ Computation to run with changed layout
   -> R ()
-switchLayout spn = enterLayout
+switchLayout spans' = enterLayout (spansLayout spans')
-  (if isOneLineSpan spn
+
+-- | Which layout combined spans result in?
+
+spansLayout :: [SrcSpan] -> Layout
+spansLayout = \case
+  [] -> SingleLine
+  (x:xs) ->
+    if isOneLineSpan (foldr combineSrcSpans x xs)
       then SingleLine
-    else MultiLine)
+      else MultiLine
 
 -- | Insert a space if enclosing layout is single-line, or newline if it's
 -- multiline.
@@ -156,56 +147,14 @@ breakpoint' = vlayout (return ()) newline
 ----------------------------------------------------------------------------
 -- Formatting lists
 
--- | Element of variable layout. This means that the sub-components may be
+-- | Render a collection of elements inserting a separator between them.
--- rendered either on single line or each on its own line depending on
--- current layout.
---
--- This version does not make subsequent element (second and later) align
--- with the first automatically and does not insert spaces between elements
--- when layout is single line.
 
-velt :: [R ()] -> R ()
+sep
-velt xs = sequence_ (intersperse breakpoint' (sitcc <$> xs))
-
--- | Like 'velt', but all sub-elements start at the same indentation level
--- as first element, additionally spaces are inserted when layout is single
--- line.
-
-velt' :: [R ()] -> R ()
-velt' xs = sitcc $ sequence_ (intersperse breakpoint (sitcc <$> xs))
-
--- | Put separator between renderings of items of a list.
-
-withSep
   :: R ()                       -- ^ Separator
-  -> (a -> R ())                -- ^ How to render list items
+  -> (a -> R ())                -- ^ How to render an element
-  -> [a]                        -- ^ List to render
+  -> [a]                        -- ^ Elements to render
-  -> [R ()]                     -- ^ List of printing actions
-withSep sep f = \case
-  [] -> []
-  (x:xs) ->
-    let g a = sep >> f a
-    in f x : fmap g xs
-
--- | Render space-separated elements.
---
--- > spaceSep f = sequence_ . withSep space f
-
-spaceSep
-  :: (a -> R ())                -- ^ How to render list items
-  -> [a]                        -- ^ List to render
   -> R ()
-spaceSep f = sequence_ . withSep space f
+sep s f xs = sequence_ (intersperse s (f <$> xs))
-
--- | Render newline-separated elements.
---
--- > newlineSep f = sequence_ . withSep newline f
-
-newlineSep
-  :: (a -> R ())                -- ^ How to render list items
-  -> [a]                        -- ^ List to render
-  -> R ()
-newlineSep f = sequence_ . withSep newline f
 
 ----------------------------------------------------------------------------
 -- Wrapping
@@ -259,6 +208,7 @@ bracketsPar :: R () -> R ()
 bracketsPar m = sitcc $ do
   txt "[: "
   m
+  vlayout (return ()) space
   txt " :]"
 
 -- | Surround given entity by parentheses @(@ and @)@.
@@ -275,7 +225,7 @@ parensHash :: R () -> R ()
 parensHash m = sitcc $ do
   txt "(# "
   m
-  breakpoint
+  vlayout space (newline >> txt "  ")
   txt "#)"
 
 -- | Braces as used for pragmas: @{-#@ and @#-}@.
@@ -302,15 +252,19 @@ pragma pragmaText body = pragmaBraces $ do
 -- current layout is multiline.
 
 ospaces :: R () -> R ()
-ospaces m = vlayout m (txt " " >> m >> newline)
+ospaces m = vlayout m $ do
+  space
+  m
+  newline
+  txt "  "
 
 ----------------------------------------------------------------------------
 -- Literals
 
--- | Print @,@ followed by a space.
+-- | Print @,@.
 
 comma :: R ()
-comma = txt ", "
+comma = txt ","
 
 -- | Print single space.
 

src/Ormolu/Printer/Meat/Common.hs

@@ -130,9 +130,9 @@ p_infixDefHelper isInfix inci' name args =
         inci' p1
       unless (null ps) . inci' $ do
         breakpoint
-        velt' ps
+        sitcc (sep breakpoint sitcc ps)
     (_, ps) -> do
       name
       unless (null ps) $ do
         breakpoint
-        inci' (velt' args)
+        inci' $ sitcc (sep breakpoint sitcc args)

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

@@ -21,7 +21,6 @@ import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Type
 import Ormolu.Utils
 import RdrName (RdrName (..))
-import SrcLoc (Located, combineSrcSpans)
 import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
 
 p_classDecl
@@ -37,13 +36,10 @@ p_classDecl
   -> R ()
 p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do
   let HsQTvs {..} = tvars
-      variableSpans = foldr (combineSrcSpans . getLoc) noSrcSpan hsq_explicit
+      variableSpans = getLoc <$> hsq_explicit
-      signatureSpans = getLoc name `combineSrcSpans` variableSpans
+      signatureSpans = getLoc name : variableSpans
-      dependencySpans = foldr (combineSrcSpans . getLoc) noSrcSpan fdeps
+      dependencySpans = getLoc <$> fdeps
-      combinedSpans =
+      combinedSpans = getLoc ctx : (signatureSpans ++ dependencySpans)
-        getLoc ctx `combineSrcSpans`
-        signatureSpans `combineSrcSpans`
-        dependencySpans
   txt "class"
   switchLayout combinedSpans $ do
     breakpoint
@@ -86,13 +82,13 @@ p_classFundeps :: [Located (FunDep (Located RdrName))] -> R ()
 p_classFundeps fdeps = unless (null fdeps) $ do
   breakpoint
   txt "| "
-  velt $ withSep comma (located' p_funDep) fdeps
+  sitcc $ sep (comma >> breakpoint) (sitcc . located' p_funDep) fdeps
 
 p_funDep :: FunDep (Located RdrName) -> R ()
 p_funDep (before, after) = do
-  spaceSep p_rdrName before
+  sep space p_rdrName before
   txt " -> "
-  spaceSep p_rdrName after
+  sep space p_rdrName after
 
 ----------------------------------------------------------------------------
 -- Helpers

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

@@ -10,7 +10,6 @@ module Ormolu.Printer.Meat.Declaration.Data
 where
 
 import Control.Monad
-import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (isJust)
 import GHC
 import Ormolu.Printer.Combinators
@@ -28,14 +27,13 @@ p_dataDecl
   -> HsDataDefn GhcPs           -- ^ Data definition
   -> R ()
 p_dataDecl style name tpats fixity HsDataDefn {..} = do
-  let combinedSpans = combineSrcSpans' (getLoc name :| (getLoc <$> tpats))
   txt $ case dd_ND of
     NewType -> "newtype"
     DataType -> "data"
   txt $ case style of
     Associated -> mempty
     Free -> " instance"
-  switchLayout combinedSpans $ do
+  switchLayout (getLoc name : fmap getLoc tpats) $ do
     breakpoint
     inci $ p_infixDefHelper
       (isInfix fixity)
@@ -54,13 +52,13 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do
       then do
         txt " where"
         newline
-        inci $ newlineSep (sitcc . located' p_conDecl) dd_cons
+        inci . sitcc $ sep newline (sitcc . located' p_conDecl) dd_cons
-      else switchLayout (combineSrcSpans' (getLoc name :| (getLoc <$> dd_cons))) $
+      else switchLayout (getLoc name : (getLoc <$> dd_cons)) $
         inci $ do
           breakpoint
           txt "= "
-          let sep = vlayout (txt " | ") (txt "| ")
+          let s = vlayout (txt " | ") (newline >> txt "| ")
-          velt $ withSep sep (sitcc . located' p_conDecl) dd_cons
+          sep s (sitcc . located' p_conDecl) dd_cons
   newline
   inci . located dd_derivs $ \xs ->
     forM_ xs (line . located' p_hsDerivingClause)
@@ -73,11 +71,10 @@ p_conDecl = \case
       [] -> return ()
       (c:cs) -> do
         p_rdrName c
-        unless (null cs) $ do
+        unless (null cs) . inci $ do
-          breakpoint'
-          inci $ do
           comma
-            velt $ withSep comma p_rdrName cs
+          breakpoint
+          sitcc $ sep (comma >> breakpoint) p_rdrName cs
     breakpoint
     inci $ do
       txt ":: "
@@ -85,7 +82,7 @@ p_conDecl = \case
       forM_ con_mb_cxt p_lhsContext
       case con_args of
         PrefixCon xs -> do
-          velt' (located' p_hsType <$> xs)
+          sep breakpoint (located' p_hsType) xs
           unless (null xs) $ do
             breakpoint
             txt "-> "
@@ -95,7 +92,7 @@ p_conDecl = \case
             breakpoint
             txt "-> "
         InfixCon _ _ -> notImplemented "InfixCon"
-      locatedVia Nothing con_res_ty p_hsType
+      p_hsType (unLoc con_res_ty)
   ConDeclH98 {..} -> do
     p_forallBndrs con_ex_tvs
     forM_ con_mb_cxt p_lhsContext
@@ -103,7 +100,7 @@ p_conDecl = \case
       PrefixCon xs -> do
         p_rdrName con_name
         unless (null xs) breakpoint
-        inci $ velt' (located' p_hsType <$> xs)
+        inci . sitcc $ sep breakpoint (sitcc . located' p_hsType) xs
       RecCon l -> do
         p_rdrName con_name
         breakpoint
@@ -124,7 +121,7 @@ p_forallBndrs = \case
   [] -> return ()
   bndrs -> do
     txt "forall "
-    spaceSep (located' p_hsTyVarBndr) bndrs
+    sep space  (located' p_hsTyVarBndr) bndrs
     txt ". "
 
 p_lhsContext
@@ -150,12 +147,15 @@ p_hsDerivingClause HsDerivingClause {..} = do
   txt "deriving"
   let derivingWhat = located deriv_clause_tys $ \case
         [] -> txt "()"
-        xs -> parens . velt $ withSep comma (located' p_hsType . hsib_body) xs
+        xs -> parens . sitcc $ sep
+          (comma >> breakpoint)
+          (sitcc . located' p_hsType . hsib_body)
+          xs
   case deriv_clause_strategy of
     Nothing -> do
       breakpoint
       inci derivingWhat
-    Just l -> locatedVia Nothing l $ \case
+    Just (L _ a) -> case a of
       StockStrategy -> do
         txt " stock"
         breakpoint

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

@@ -16,6 +16,6 @@ p_defaultDecl = \case
   DefaultDecl NoExt ts -> line $ do
     txt "default"
     breakpoint
-    inci . parens . velt $
+    inci . parens . sitcc $
-      withSep comma (located' p_hsType) ts
+      sep (comma >> breakpoint) (sitcc . located' p_hsType) ts
   XDefaultDecl {} -> notImplemented "XDefaultDecl"

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

@@ -35,7 +35,7 @@ p_foreignTypeSig fd = do
   breakpoint
   -- Switch into the layout of the signature, to allow us to pull name and
   -- signature onto a single line.
-  inci . switchLayout (getLoc . hsib_body $ fd_sig_ty fd) $ do
+  inci . switchLayout [getLoc . hsib_body $ fd_sig_ty fd] $ do
     p_rdrName (fd_name fd)
     p_typeAscription (HsWC NoExt (fd_sig_ty fd))
 

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

@@ -41,7 +41,7 @@ p_standaloneDerivDecl DerivDecl {..} = do
     Nothing -> do
       space
       instTypes False
-    Just l -> locatedVia Nothing l $ \case
+    Just (L _ a) -> case a of
       StockStrategy -> do
         txt " stock "
         instTypes False
@@ -72,7 +72,6 @@ p_clsInstDecl = \case
         inci $ do
           match_overlap_mode cid_overlap_mode breakpoint
           p_hsType x
-      XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"
         -- GHC's AST does not necessarily store each kind of element in source
         -- location order. This happens because different declarations are stored in
         -- different lists. Consequently, to get all the declarations in proper
@@ -88,13 +87,16 @@ p_clsInstDecl = \case
             allDecls =
               snd <$>
                 sortBy (comparing fst) (sigs <> vals <> tyFamInsts <> dataFamInsts)
-    if not (null allDecls)
+        if null allDecls
-    then do
+          then newline
-      txt " where"
+          else do
+            switchLayout [getLoc hsib_body] breakpoint
+            inci $ do
+              txt "where"
               newline -- Ensure line is added after where clause.
               newline -- Add newline before first declaration.
-      inci (p_hsDecls Associated allDecls)
+              p_hsDecls Associated allDecls
-    else newline
+      XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"
   XClsInstDecl NoExt -> notImplemented "XClsInstDecl"
 
 p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()

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

@@ -32,7 +32,7 @@ p_roleAnnot' l_name anns = line $ do
     breakpoint
     let
       p_role' = maybe (txt "_") p_role
-    inci $ velt' $ (located' p_role') <$> anns
+    inci . sitcc $ sep breakpoint (sitcc . located' p_role') anns
 
 p_role :: Role -> R ()
 p_role = \case

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

@@ -16,13 +16,12 @@ import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Declaration.Signature
 import Ormolu.Printer.Meat.Declaration.Value
 import Ormolu.Utils
-import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as T
 
 p_ruleDecls :: RuleDecls GhcPs -> R ()
 p_ruleDecls = \case
-  HsRules NoExt _ xs -> line $ pragma "RULES" $
+  HsRules NoExt _ xs -> line . pragma "RULES" . sitcc $
-    velt' $ (located' p_ruleDecl) <$> xs
+    sep breakpoint (sitcc . located' p_ruleDecl) xs
   XRuleDecls NoExt -> notImplemented "XRuleDecls"
 
 p_ruleDecl :: RuleDecl GhcPs -> R ()
@@ -50,13 +49,13 @@ p_ruleName (_, name) = do
   txt "\""
 
 p_ruleBndrs :: [LRuleBndr GhcPs] -> R ()
+p_ruleBndrs [] = return ()
 p_ruleBndrs bndrs =
-  forM_ (NE.nonEmpty bndrs) $ \bndrs_ne ->
+  switchLayout (getLoc <$> bndrs) $ do
-    switchLayout (combineSrcSpans' (getLoc <$> bndrs_ne)) $ do
     txt "forall"
     breakpoint
     inci $ do
-        velt' (located' p_ruleBndr <$> bndrs)
+      sitcc $ sep breakpoint (sitcc . located' p_ruleBndr) bndrs
       txt "."
 
 p_ruleBndr :: RuleBndr GhcPs -> R ()

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

@@ -49,9 +49,9 @@ p_typeSig (n:ns) hswc = do
   if null ns
     then p_typeAscription hswc
     else inci $ do
-      vlayout (return ()) newline
       comma
-      velt (withSep comma p_rdrName ns)
+      breakpoint
+      sep (comma >> breakpoint) p_rdrName ns
       p_typeAscription hswc
 
 p_typeAscription
@@ -93,7 +93,7 @@ p_fixSig = \case
     space
     atom n
     space
-    sequence_ (withSep comma p_rdrName names)
+    sitcc $ sep (comma >> breakpoint) p_rdrName names
   XFixitySig NoExt -> notImplemented "XFixitySig"
 
 p_inlineSig
@@ -125,7 +125,7 @@ p_specSig name ts InlinePragma {..} = pragmaBraces $ do
   breakpoint
   inci $ do
     txt ":: "
-    velt (withSep comma (located' p_hsType) (hsib_body <$> ts))
+    sep (comma >> breakpoint) (located' p_hsType . hsib_body) ts
 
 p_activation :: Activation -> R ()
 p_activation = \case
@@ -162,10 +162,12 @@ p_booleanFormula
   -> R ()
 p_booleanFormula = \case
   Var name -> p_rdrName name
-  And xs -> velt $
+  And xs -> sitcc $ sep
-    withSep comma (located' p_booleanFormula) xs
+    (comma >> breakpoint)
-  Or xs -> velt $
+    (located' p_booleanFormula)
-    withSep (vlayout space (return ()) >> txt "| ")
+    xs
+  Or xs -> sitcc $ sep
+    (breakpoint >> txt "| ")
     (located' p_booleanFormula)
     xs
   Parens l -> located l (parens . p_booleanFormula)
@@ -177,7 +179,7 @@ p_completeSig
 p_completeSig cs' mty =
   located cs' $ \cs ->
     pragma "COMPLETE" . inci $ do
-      velt (withSep comma p_rdrName cs)
+      sitcc $ sep (comma >> breakpoint) p_rdrName cs
       forM_ mty $ \ty -> do
         breakpoint
         inci $ do

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

@@ -26,6 +26,6 @@ p_synDecl name tvars t = line $ do
   p_rdrName name
   let HsQTvs {..} = tvars
   unless (null hsq_explicit) space
-  spaceSep (located' p_hsTyVarBndr) hsq_explicit
+  sep space (located' p_hsTyVarBndr) hsq_explicit
   breakpoint
   inci (txt "= " >> located t p_hsType)

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

@@ -12,7 +12,6 @@ where
 
 import BasicTypes (LexicalFixity (..))
 import Control.Monad
-import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (isNothing, isJust)
 import GHC
 import Ormolu.Printer.Combinators
@@ -31,11 +30,9 @@ p_famDecl style FamilyDecl {..} = do
     Associated -> mempty
     Free -> " family"
   let HsQTvs {..} = fdTyVars
-      combinedSpans = combineSrcSpans' $
-        getLoc fdLName :| fmap getLoc hsq_explicit
   breakpoint
   inci $ do
-    switchLayout combinedSpans $ do
+    switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $ do
       p_infixDefHelper
         (isInfix fdFixity)
         inci
@@ -82,14 +79,12 @@ p_injectivityAnn (InjectivityAnn a bs) = do
   p_rdrName a
   space
   txt "-> "
-  spaceSep p_rdrName bs
+  sep space p_rdrName bs
 
 p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()
 p_tyFamInstEqn HsIB {..} = do
   let FamEqn {..} = hsib_body
-      combinedSpans = combineSrcSpans' $
+  switchLayout (getLoc feqn_tycon : (getLoc <$> feqn_pats)) $ p_infixDefHelper
-        getLoc feqn_tycon :| fmap getLoc feqn_pats
-  switchLayout combinedSpans $ p_infixDefHelper
     (isInfix feqn_fixity)
     inci
     (p_rdrName feqn_tycon)

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

@@ -85,9 +85,9 @@ p_matchGroup'
   -> MatchGroup GhcPs (Located body)
   -> R ()
 p_matchGroup' placer pretty style MG {..} =
-  locatedVia Nothing mg_alts $
+  sep newline (located' (\m@Match {..} ->
-    newlineSep (located' (\m@Match {..} ->
     p_match' placer pretty style (isInfixMatch m) (matchStrictness m) m_pats m_grhss))
+    (unLoc mg_alts)
 p_matchGroup' _ _ _ (XMatchGroup NoExt) = notImplemented "XMatchGroup"
 
 matchStrictness :: Match id body -> SrcStrictness
@@ -137,8 +137,8 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do
           inci' = if isOneLineSpan combinedSpans
             then id
             else inci
-      switchLayout combinedSpans $ do
+      switchLayout [combinedSpans] $ do
-        let stdCase = velt' (located' p_pat <$> m_pats)
+        let stdCase = sep breakpoint (located' p_pat) m_pats
         case style of
           Function name ->
             p_infixDefHelper
@@ -201,12 +201,12 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do
                 if isCase style && hasGuards
                 then RightArrow
                 else EqualSign
-          newlineSep (located' (p_grhs' pretty groupStyle)) grhssGRHSs
+          sep newline (located' (p_grhs' pretty groupStyle)) grhssGRHSs
           let whereLocation = combineSrcSpans patGrhssSpan $ getLoc grhssLocalBinds
               whereIsEmpty = GHC.isEmptyLocalBindsPR (unLoc grhssLocalBinds)
           unless (GHC.eqEmptyLocalBinds (unLoc grhssLocalBinds))
             . inciLocalBinds
-            . switchLayout whereLocation $ do
+            . switchLayout [whereLocation] $ do
                 if whereIsEmpty then newline else breakpoint
                 txt "where"
                 unless whereIsEmpty $ do
@@ -214,8 +214,8 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do
                   inci (located grhssLocalBinds p_hsLocalBinds)
     case style of
       Lambda -> placeHanging placement $
-        switchLayout patGrhssSpan p_body
+        switchLayout [patGrhssSpan] p_body
-      _ -> switchLayout patGrhssSpan $
+      _ -> switchLayout [patGrhssSpan] $
         placeHanging placement p_body
 
 p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
@@ -232,7 +232,7 @@ p_grhs' pretty style (GRHS NoExt guards body) =
     [] -> p_body
     xs -> do
       txt "| "
-      velt $ withSep comma (located' p_stmt) xs
+      sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)
       space
       txt $ case style of
         EqualSign -> "="
@@ -298,7 +298,7 @@ p_hsCmd = \case
   HsCmdDo NoExt es -> do
     txt "do"
     newline
-    inci (located es (newlineSep (located' (sitcc . p_stmt' p_hsCmd))))
+    inci (located es (sitcc . sep newline (located' (sitcc . p_stmt' p_hsCmd))))
   HsCmdWrap {} -> notImplemented "HsCmdWrap"
   XCmd {} -> notImplemented "XCmd"
 
@@ -368,7 +368,7 @@ p_stmt' pretty = \case
           inci (p_hsExpr x)
   RecStmt {..} -> do
     txt "rec "
-    sitcc $ newlineSep (located' (p_stmt' pretty)) recS_stmts
+    sitcc $ sep newline (located' (p_stmt' pretty)) recS_stmts
   XStmtLR {} -> notImplemented "XStmtLR"
 
 gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
@@ -393,7 +393,7 @@ p_hsLocalBinds = \case
           (Left <$> bagToList bag) ++ (Right <$> lsigs)
         p_item (Left x) = located x p_valDecl'
         p_item (Right x) = located x p_sigDecl'
-    newlineSep (sitcc . p_item) (sortOn ssStart items)
+    sitcc $ sep newline (sitcc . p_item) (sortOn ssStart items)
   HsValBinds NoExt _ -> notImplemented "HsValBinds"
   HsIPBinds NoExt _ -> notImplemented "HsIPBinds"
   EmptyLocalBinds NoExt -> return ()
@@ -439,7 +439,7 @@ p_hsExpr = \case
     txt "\\case"
     newline
     inci (p_matchGroup LambdaCase mgroup)
-  HsApp NoExt f x -> do
+  HsApp NoExt f x -> sitcc $ do
     located f p_hsExpr
     breakpoint
     inci (located x p_hsExpr)
@@ -479,9 +479,11 @@ p_hsExpr = \case
           case boxity of
             Boxed -> parens
             Unboxed -> parensHash
-    parens' $ if isSection
+    if isSection
-      then sequence_ (withSep (txt ",") (located' p_hsTupArg) args)
+      then switchLayout [] . parens' $
-      else velt (withSep comma (located' p_hsTupArg) args)
+             sep comma (located' p_hsTupArg) args
+      else switchLayout (getLoc <$> args) . parens' . sitcc $
+             sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
   ExplicitSum NoExt tag arity e -> do
     let before = tag - 1
         after = arity - before - 1
@@ -496,7 +498,7 @@ p_hsExpr = \case
               unless isFirst space
               located l p_hsExpr
               unless isLast space
-    parensHash $ sequence_ (withSep (txt "|") f (zip args [0..]))
+    parensHash $ sep (txt "|") f (zip args [0..])
   HsCase NoExt e mgroup -> do
     txt "case "
     located e p_hsExpr
@@ -518,7 +520,7 @@ p_hsExpr = \case
       inci (p_hsExpr x)
   HsMultiIf NoExt guards -> do
     txt "if "
-    sitcc $ newlineSep (located' (p_grhs RightArrow)) guards
+    sitcc $ sep newline (located' (p_grhs RightArrow)) guards
   HsLet NoExt localBinds e -> do
     txt "let "
     sitcc (located localBinds p_hsLocalBinds)
@@ -529,16 +531,14 @@ p_hsExpr = \case
     let doBody header = do
           txt header
           newline
-          inci $ located es (newlineSep (located' (sitcc . p_stmt)))
+          inci $ located es (sep newline (located' (sitcc . p_stmt)))
-        compBody = brackets $ located es $ \xs -> do
+        compBody = brackets $ located es $ \xs -> do
-          let p_parBody =
+          let p_parBody = sitcc . sep
-                sequence_ .
+                (breakpoint >> txt "| ")
-                intersperse breakpoint .
+                p_seqBody
-                withSep (txt "| ") p_seqBody
+              p_seqBody = sitcc . sep
-              p_seqBody =
+                (comma >> breakpoint)
-                sequence_ .
+                (located' (sitcc . p_stmt))
-                intersperse (vlayout (pure ()) newline) .
-                withSep comma (located' (sitcc . p_stmt))
               stmts = init xs
               yield = last xs
               lists = foldr (liftAppend . gatherStmt) [] stmts
@@ -557,7 +557,7 @@ p_hsExpr = \case
       ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
       TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
   ExplicitList _ _ xs ->
-    brackets $ velt (withSep comma (located' p_hsExpr) xs)
+    brackets . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs
   RecordCon {..} -> do
     located rcon_con_name atom
     breakpoint
@@ -567,11 +567,12 @@ p_hsExpr = \case
           case rec_dotdot of
             Just {} -> [txt ".."]
             Nothing -> []
-    inci $ braces $ velt (withSep comma id (fields <> dotdot))
+    inci . braces . sitcc $ sep (comma >> breakpoint) sitcc (fields <> dotdot)
   RecordUpd {..} -> do
     located rupd_expr p_hsExpr
     breakpoint
-    inci $ braces $ velt (withSep comma (located' p_hsRecField) rupd_flds)
+    inci . braces . sitcc $
+      sep (comma >> breakpoint) (sitcc . located' p_hsRecField) rupd_flds
   ExprWithTySig affix x -> sitcc $ do
     located x p_hsExpr
     breakpoint
@@ -582,21 +583,21 @@ p_hsExpr = \case
       located hsib_body p_hsType
   ArithSeq NoExt _ x -> do
     case x of
-      From from -> brackets $ do
+      From from -> brackets . sitcc $ do
         located from p_hsExpr
         breakpoint
         txt ".."
-      FromThen from next -> brackets $ do
+      FromThen from next -> brackets . sitcc $ do
-        velt (withSep comma (located' p_hsExpr) [from, next])
+        sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
         breakpoint
         txt ".."
-      FromTo from to -> brackets $ do
+      FromTo from to -> brackets . sitcc $ do
         located from p_hsExpr
         breakpoint
         txt ".. "
         located to p_hsExpr
-      FromThenTo from next to -> brackets $ do
+      FromThenTo from next to -> brackets . sitcc $ do
-        velt (withSep comma (located' p_hsExpr) [from, next])
+        sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
         breakpoint
         txt ".. "
         located to p_hsExpr
@@ -680,9 +681,9 @@ p_patSynBind (XPatSynBind NoExt) = notImplemented "XPatSynBind"
 p_patSynDetails :: HsPatSynDetails (Located RdrName) -> R ()
 p_patSynDetails = \case
   PrefixCon xs ->
-    velt' (p_rdrName <$> xs)
+    sitcc $ sep breakpoint p_rdrName xs
   RecCon xs ->
-    velt' (p_rdrName . recordPatSynPatVar <$> xs)
+    sitcc $ sep breakpoint (p_rdrName . recordPatSynPatVar) xs
   InfixCon _ _ -> notImplemented "InfixCon"
 
 p_pat :: Pat GhcPs -> R ()
@@ -702,13 +703,13 @@ p_pat = \case
     txt "!"
     located pat p_pat
   ListPat NoExt pats -> do
-    brackets $ velt (withSep comma (located' p_pat) pats)
+    brackets . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats
   TuplePat NoExt pats boxing -> do
     let f =
           case boxing of
             Boxed -> parens
             Unboxed -> parensHash
-    f $ velt (withSep comma (located' p_pat) pats)
+    f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
   SumPat NoExt pat _ _ -> do
     -- XXX I'm not sure about this one.
     located pat p_pat
@@ -718,14 +719,14 @@ p_pat = \case
         p_rdrName pat
         unless (null xs) $ do
           breakpoint
-          inci $ velt' (located' p_pat <$> xs)
+          inci . sitcc $ sep breakpoint (sitcc . located' p_pat) xs
       RecCon (HsRecFields fields dotdot) -> do
         p_rdrName pat
         breakpoint
         let f = \case
               Nothing -> txt ".."
               Just x -> located x p_pat_hsRecField
-        inci . braces . velt . withSep comma f $ case dotdot of
+        inci . braces . sitcc . sep (comma >> breakpoint) f $ case dotdot of
           Nothing -> Just <$> fields
           Just n -> (Just <$> take n fields) ++ [Nothing]
       InfixCon x y -> do
@@ -899,7 +900,7 @@ exprPlacement = \case
   RecordCon NoExt _ _ -> Hanging
   HsProc NoExt (L s _) _ ->
     -- Indentation breaks if pattern is longer than one line and left hanging.
-    -- Consequentally, once apply hanging when it is safe.
+    -- Consequently, only apply hanging when it is safe.
     if isOneLineSpan s
     then Hanging
     else Normal

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

@@ -9,13 +9,11 @@ where
 
 import BasicTypes
 import Data.Foldable
-import qualified Data.List.NonEmpty as NE
 import Data.Text (Text)
 import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import Ormolu.Utils
-import SrcLoc (combineSrcSpans)
 
 p_warnDecls :: WarnDecls GhcPs -> R ()
 p_warnDecls (Warnings NoExt _ warnings) =
@@ -30,16 +28,16 @@ p_warnDecl XWarnDecl {} = notImplemented "XWarnDecl"
 p_moduleWarning :: WarningTxt -> R ()
 p_moduleWarning wtxt = do
   let (pragmaText, lits) = warningText wtxt
-  switchLayout (listSpan lits) $ do
+  switchLayout (getLoc <$> lits) $ do
     breakpoint
     inci $ pragma pragmaText (inci $ p_lits lits)
 
 p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()
 p_topLevelWarning fnames wtxt = do
   let (pragmaText, lits) = warningText wtxt
-  switchLayout (combineSrcSpans (listSpan fnames) (listSpan lits)) $ do
+  switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $ do
     pragma pragmaText . inci $ do
-      velt (withSep comma p_rdrName fnames)
+      sitcc $ sep (comma >> breakpoint) p_rdrName fnames
       breakpoint
       p_lits lits
 
@@ -48,10 +46,7 @@ warningText = \case
   WarningTxt _ lits -> ("WARNING", lits)
   DeprecatedTxt _ lits -> ("DEPRECATED", lits)
 
-listSpan :: [Located a] -> SrcSpan
-listSpan xs = combineSrcSpans' (getLoc <$> NE.fromList xs)
-
 p_lits :: [Located StringLiteral] -> R ()
 p_lits = \case
   [l] -> atom l
-  ls -> brackets . velt $ withSep comma atom ls
+  ls -> brackets . sitcc $ sep (comma >> breakpoint) atom ls

src/Ormolu/Printer/Meat/ImportExport.hs

@@ -23,7 +23,7 @@ p_hsmodExports [] = do
   breakpoint'
   txt ")"
 p_hsmodExports xs =
-  parens . velt $ withSep comma (sitcc . located' p_lie) xs
+  parens . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_lie) xs
 
 p_hsmodImport :: ImportDecl GhcPs -> R ()
 p_hsmodImport ImportDecl {..} = line $ do
@@ -52,10 +52,10 @@ p_hsmodImport ImportDecl {..} = line $ do
         txt " hiding"
   case ideclHiding of
     Nothing -> return ()
-    Just (_, l) -> do
+    Just (_, (L _ a)) -> do
       breakpoint
-      inci . locatedVia Nothing l $
+      inci . parens . sitcc $
-        parens . velt . withSep comma (located' p_lie)
+        sep (comma >> breakpoint) (sitcc . located' p_lie) a
 p_hsmodImport (XImportDecl NoExt) = notImplemented "XImportDecl"
 
 p_lie :: IE GhcPs -> R ()
@@ -72,7 +72,7 @@ p_lie = \case
     inci $ do
       let names :: [R ()]
           names = located' p_ieWrappedName <$> xs
-      parens . velt . withSep comma id $
+      parens . sitcc . sep (comma >> breakpoint) sitcc $
         case w of
           NoIEWildcard -> names
           IEWildcard n ->

src/Ormolu/Printer/Meat/Module.hs

@@ -20,18 +20,16 @@ import Ormolu.Printer.Meat.Declaration
 import Ormolu.Printer.Meat.Declaration.Warning
 import Ormolu.Printer.Meat.ImportExport
 import Ormolu.Printer.Meat.LanguagePragma
-import SrcLoc (combineSrcSpans)
 
 p_hsModule :: Set String -> ParsedSource -> R ()
-p_hsModule exts loc@(L moduleSpan hsModule) = do
+p_hsModule exts (L moduleSpan HsModule {..}) = do
   -- NOTE If span of exports in multiline, the whole thing is multiline.
   -- This is especially important because span of module itself always seems
   -- to have length zero, so it's not reliable for layout selection.
-  let spn =
+  let spans' = case hsmodExports of
-        case hsmodExports hsModule of
+        Nothing -> [moduleSpan]
-          Nothing -> moduleSpan
+        Just (L exportsSpan _) -> moduleSpan : [exportsSpan]
-          Just (L exportsSpan _) -> combineSrcSpans moduleSpan exportsSpan
+  switchLayout spans' $ do
-  locatedVia (Just spn) loc $ \HsModule {..} -> do
     let hasLangPragmas = not (null exts)
         hasModuleHeader = isJust hsmodName
         hasImports = not (null hsmodImports)
@@ -49,7 +47,7 @@ p_hsModule exts loc@(L moduleSpan hsModule) = do
           Nothing -> return ()
           Just hsmodExports' -> do
             breakpoint
-            inci (locatedVia Nothing hsmodExports' p_hsmodExports)
+            inci (p_hsmodExports (unLoc hsmodExports'))
         breakpoint
         txt "where"
         when (hasImports || hasDecls) newline

src/Ormolu/Printer/Meat/Type.hs

@@ -22,16 +22,16 @@ p_hsType :: HsType GhcPs -> R ()
 p_hsType = \case
   HsForAllTy NoExt bndrs t -> do
     txt "forall "
-    spaceSep (located' p_hsTyVarBndr) bndrs
+    sep space (located' p_hsTyVarBndr) bndrs
     txt ". "
-    locatedVia Nothing t p_hsType
+    p_hsType (unLoc t)
   HsQualTy NoExt qs t -> do
     located qs p_hsContext
     breakpoint
     txt "=> "
     case unLoc t of
-      HsQualTy {} -> locatedVia Nothing t p_hsType
+      HsQualTy {} -> p_hsType (unLoc t)
-      HsFunTy {} -> locatedVia Nothing t p_hsType
+      HsFunTy {} -> p_hsType (unLoc t)
       _ -> located t p_hsType
   HsTyVar NoExt p n -> do
     case p of
@@ -60,9 +60,11 @@ p_hsType = \case
             HsBoxedTuple -> parens
             HsConstraintTuple -> parens
             HsBoxedOrConstraintTuple -> parens
-    in parens' . velt $ withSep comma (located' p_hsType) xs
+    in parens' . sitcc $
+         sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
   HsSumTy NoExt xs ->
-    parensHash . velt $ withSep (txt "| ") (located' p_hsType) xs
+    parensHash . sitcc $
+      sep (txt "| " >> breakpoint') (sitcc . located' p_hsType) xs
   HsOpTy NoExt x op y -> do
     located x p_hsType
     breakpoint
@@ -115,10 +117,10 @@ p_hsType = \case
       case xs of
         ((L _ (HsTyVar _ Promoted _)):_) -> space
         _ -> return ()
-      velt $ withSep comma (located' p_hsType) xs
+      sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
   HsExplicitTupleTy NoExt xs -> do
     txt "'"
-    parens . velt $ withSep comma (located' p_hsType) xs
+    parens $ sep (comma >> breakpoint) (located' p_hsType) xs
   HsTyLit NoExt t -> atom t
   HsWildCardTy NoExt -> txt "_"
   XHsType (NHsCoreTy t) -> atom t
@@ -127,7 +129,8 @@ p_hsContext :: HsContext GhcPs -> R ()
 p_hsContext = \case
   [] -> txt "()"
   [x] -> located x p_hsType
-  xs -> parens . velt $ withSep comma (located' p_hsType) xs
+  xs -> parens . sitcc $
+    sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
 
 p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()
 p_hsTyVarBndr = \case
@@ -142,23 +145,22 @@ p_hsTyVarBndr = \case
   XTyVarBndr NoExt -> notImplemented "XTyVarBndr"
 
 p_conDeclFields :: [LConDeclField GhcPs] -> R ()
-p_conDeclFields =
+p_conDeclFields xs = braces . sitcc $
-  braces . velt . withSep comma (sitcc . located' p_conDeclField)
+  sep (comma >> breakpoint) (sitcc . located' p_conDeclField) xs
 
 p_conDeclField :: ConDeclField GhcPs -> R ()
 p_conDeclField ConDeclField {..} = do
-  sitcc . velt $ withSep
+  sitcc $ sep (comma >> breakpoint)
-    comma
     (located' (p_rdrName . rdrNameFieldOcc))
     cd_fld_names
   breakpoint
   sitcc . inci $ do
     txt ":: "
-    locatedVia Nothing cd_fld_type p_hsType
+    p_hsType (unLoc cd_fld_type)
 p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"
 
 ----------------------------------------------------------------------------
--- Convertion functions
+-- Conversion functions
 
 tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]
 tyVarsToTypes = \case

src/Ormolu/Utils.hs

@@ -1,5 +1,7 @@
 -- | Random utilities used by the code.
 
+{-# LANGUAGE LambdaCase #-}
+
 module Ormolu.Utils
   ( combineSrcSpans'
   , isModule

tests/Ormolu/Printer/CombinatorsSpec.hs

@@ -47,27 +47,27 @@ rSimpleSig :: R ()
 rSimpleSig = line rFn
 
 rList0 :: R ()
-rList0 = line . brackets $
+rList0 = line . brackets . sitcc $
-  velt
+  sep (comma >> breakpoint) id
     [ txt "foo"
-    , comma >> txt "bar"
+    , txt "bar"
-    , comma >> txt "baz"
+    , txt "baz"
     ]
 
 rList1 :: R ()
-rList1 = line . brackets $
+rList1 = line . brackets . sitcc $
-  velt
+  sep (comma >> breakpoint) id
     [ txt "foo"
-    , comma >> txt "bar"
+    , txt "bar"
-    , comma >> rFn
+    , rFn
     ]
 
 rFn :: R ()
-rFn = velt'
+rFn = sitcc $ sep breakpoint sitcc
   [ txt "foo"
-  , inci $ velt'
+  , inci . sitcc $ sep breakpoint sitcc
     [ do txt ":: "
-         parens $ velt'
+         parens . sitcc $ sep breakpoint sitcc
            [ txt "Int"
            , txt "-> " >> txt "Int"
            ]
@@ -80,11 +80,11 @@ rModuleHeader = do
   line $ do
     txt "module "
     txt "MyModule"
-  line . inci . parens . velt $
+  line . inci . parens . sitcc . sep (comma >> breakpoint) sitcc $
     [ txt "R"
-    , comma >> txt "runR"
+    , txt "runR"
-    , comma >> txt "txt"
+    , txt "txt"
-    , comma >> txt "blah"
+    , txt "blah"
     ]
   line (txt "where")
 
@@ -96,8 +96,10 @@ rModuleHeader = do
 
 shouldRender :: R () -> FilePath -> Expectation
 shouldRender m path = do
+  let rendered = runR False m mempty mempty emptyAnns
+  -- T.writeFile path rendered
   expected <- T.readFile path
-  runR False m mempty mempty emptyAnns `shouldBe` expected
+  rendered `shouldBe` expected
 
 -- | Render using single-line layout.
 

tests/Ormolu/PrinterSpec.hs

@@ -32,6 +32,7 @@ checkExample srcPath' = it (fromRelFile srcPath' ++ " works") $ do
   formatted0 <- ormoluFile defaultConfig (fromRelFile srcPath)
   -- 3. Check the output against expected output. Thus all tests should
   -- include two files: input and expected output.
+  -- T.writeFile (fromRelFile expectedOutputPath) formatted0
   expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath
   shouldMatch False formatted0 expected
   -- 4. Check that running the formatter on the output produces the same