87406cb · ormolu · git.iko.soy

data/examples/declaration/annotation/annotation-out.hs+1−1

compare with master

unifiedsplit

@@ -4,7 +4,7 @@

4 module

5 ( 5

6 :: Int

7− )

7+ )

8 #-}

9

10{-# ANN foo "hey" #-}

data/examples/declaration/class/default-signatures-out.hs+1−1

@@ -13,7 +13,7 @@ class Bar a where

13 default bar

14 :: ( Read a,

15 Semigroup a

16− )

16+ )

17 => a

18 -> a

19 -> a

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

@@ -11,7 +11,7 @@ class (MonadReader r s, MonadWriter w m) => MonadState s m | m -> s where

11class

12 ( Stream s, -- Token streams

13 MonadPlus m -- Potential for failure

14− )

14+ )

15 => MonadParsec e s m

16 | m -> e s where

17

data/examples/declaration/class/poly-kinded-classes-out.hs+1−1

@@ -6,4 +6,4 @@ class

6 Bar

7 ( a -- Variable

8 :: * -- Star

9− )

9+ )

data/examples/declaration/class/single-parameters-out.hs+1−1

@@ -11,7 +11,7 @@ class Baz a where

11 baz

12 :: ( a,

13 a -- ^ First argument

14− )

14+ )

15 -> a -- ^ Second argument

16 -> a -- ^ Return value

17

data/examples/declaration/class/super-classes-out.hs+1−1

@@ -10,5 +10,5 @@ class

10 ( Foo a, -- Foo?

11 Bar a, -- Bar?

12 Baz a -- Baz

13− )

13+ )

14 => BarBar a

data/examples/declaration/class/type-operators1-out.hs+1−1

@@ -17,5 +17,5 @@ class

17class

18 ( f

19 :. g

20− )

20+ )

21 a

data/examples/declaration/class/type-operators2-out.hs+1−1

@@ -12,5 +12,5 @@ class (f `Product` g) a

12class

13 ( f

14 `Sum` g

15− )

15+ )

16 a

data/examples/declaration/data/deriving-strategies-out.hs+1−1

@@ -4,7 +4,7 @@ newtype Foo = Foo Int

4 deriving anyclass

5 ( ToJSON,

6 FromJSON

7− )

7+ )

8 deriving newtype (Num)

9 deriving (Monoid) via (Sum Int)

10 deriving

data/examples/declaration/data/gadt/record-out.hs+1−1

@@ -8,5 +8,5 @@ data Foo where

8 barBar,

9 bazBaz

10 :: Int

11− }

11+ }

12 -> Foo

data/examples/declaration/data/multiline-names-out.hs+2−2

@@ -11,7 +11,7 @@ data (f :* g) a = f a :* g a

11data

12 ( f

13 :+ g

14− )

14+ )

15 a

16 = L (f a)

17 | R (g a)

@@ -23,7 +23,7 @@ data (f `Product` g) a = f a `Product` g a

23data

24 ( f

25 `Sum` g

26− )

26+ )

27 a

28 = L' (f a)

29 | R' (g a)

data/examples/declaration/data/record-out.hs+2−2

@@ -9,10 +9,10 @@ data Foo

9 :: NonEmpty

10 ( Indentity

11 Bool

12− ),

12+ ),

13 -- ^ GagGog

14 fooFoo,

15 barBar

16 :: Int -- ^ Huh!

17− }

17+ }

18 deriving (Eq, Show)

data/examples/declaration/default/default-out.hs+1−1

@@ -4,4 +4,4 @@ default

4 ( Int,

5 Foo,

6 Bar

7− )

7+ )

data/examples/declaration/instance/contexts-comments-out.hs+3−3

@@ -4,14 +4,14 @@ instance

4 Read

5 ( c, -- Bar

6 d

7− )

7+ )

8− )

8+ )

9 => Read

10 ( a, -- Baz

11 b,

12 ( c, -- Quux

13 d

14− )

15 )

14 )

15+ )

16 where

17 readsPrec = undefined

data/examples/declaration/instance/contexts-out.hs+2−2

@@ -3,7 +3,7 @@ instance Eq a => Eq [a] where (==) _ _ = False

3instance

4 ( Ord a,

5 Ord b

6− )

6+ )

7 => Ord (a, b)

8 where

9 compare _ _ = GT

@@ -13,6 +13,6 @@ instance

13 => Show

14 ( a,

15 b

16− )

16+ )

17 where

18 showsPrec _ _ = showString ""

data/examples/declaration/instance/data-family-instances-newtype-out.hs+1−1

@@ -4,4 +4,4 @@

4newtype instance Foo [Double]

5 = DoubleListFoo

6 { unDoubleListFoo :: Double

7− }

7+ }

data/examples/declaration/instance/data-family-instances-out.hs+2−2

@@ -9,10 +9,10 @@ data instance

9 = IntListFoo

10 ( Int,

11 Int

12− )

12+ )

13 ( Double,

14 Double

15− )

15+ )

16

17data instance Bar Double a

18 = DoubleBar

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

@@ -7,7 +7,7 @@ type instance

7 [Int] =

8 ( Int,

9 Int

10− )

10+ )

11

12type instance Bar Int [Int] Double = (Int, Double)

13

@@ -18,4 +18,4 @@ type instance

18 Double =

19 ( Int,

20 Double

21− )

21+ )

data/examples/declaration/rewrite-rule/type-signature-out.hs+1−1

@@ -11,7 +11,7 @@

11 (a -> b -> b)

12 -> b

13 -> b

14− ).

14+ ).

15 foldr k z (build g) =

16 g k z

17 #-}

data/examples/declaration/signature/minimal/minimal-out.hs+1−1

@@ -7,7 +7,7 @@ class Foo a where

7 | ( b, c, d

8 | e,

9 f

10− )

10+ )

11 | g

12 #-}

13

data/examples/declaration/signature/specialize/specialize-instance-out.hs+1−1

@@ -12,7 +12,7 @@ instance (Num r, V.Vector v r, Factored m r) => Num (VT v m r) where

12

13 {-# SPECIALIZE instance

14 ( Factored m Int => Num (VT U.Vector m Int)

15− )

15+ )

16 #-}

17

18 VT x + VT y = VT $ V.zipWith (+) x y

data/examples/declaration/signature/type/arguments-out.hs+1−1

@@ -11,6 +11,6 @@ functionName

11 -> AnotherLongDataTypeName

12 -> b

13 -> c

14− )

14+ )

15 -> (c -> d)

16 -> (a, b, c, d)

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

@@ -2,7 +2,7 @@ functionName

2 :: ( C1,

3 C2,

4 C3

5− )

5+ )

6 => a

7 -> b

8 -> c

data/examples/declaration/signature/type/long-multiline-applications-out.hs+1−1

@@ -10,6 +10,6 @@ functionName

10 -> AnotherLongDataTypeName4

11 -> b

12 -> c

13− )

13+ )

14 -> (c -> d)

15 -> (a, b, c, d)

data/examples/declaration/splice/bracket-declaration-out.hs+1−1

@@ -23,4 +23,4 @@ $( singletons

23 data T = T

24 deriving (Eq, Ord, Enum, Bounded, Show)

25 |]

26− )

26+ )

data/examples/declaration/splice/typed-splice-out.hs+1−1

@@ -2,6 +2,6 @@

2

3x =

4 $$( foo bar

5− )

5+ )

6

7x = $$foo

data/examples/declaration/splice/untyped-splice-out.hs+1−1

@@ -5,6 +5,6 @@ x = $(foo bar)

5x =

6 $( foo

7 bar

8− )

8+ )

9

10x = $foo

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

@@ -5,13 +5,13 @@ foo' = [0 .. 5]

5bar x =

6 [ 0

7 .. x

8− ]

8+ ]

9

10baz x =

11 [ 1,

12 3

13 .. x

14− ]

14+ ]

15

16barbaz x = [0, 1 ..]

17

data/examples/declaration/value/function/arrow/expression-forms-out.hs+10−9

@@ -1,13 +1,14 @@

1{-# LANGUAGE Arrows #-}

2

3−foo f g x y = (|test (f -< x) (g -< y)|)

3+foo f g x y = (| test (f -< x) (g -< y) |)

4

5bar f g x y =

6+ (|

6− (| test

7+ test

7− ( f -<

8+ ( f -<

8− x

9+ x

9− )

10+ )

10− ( g -<

11+ ( g -<

11− y

12+ y

12− )

13+ )

13− |)

14+ |)

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

@@ -13,6 +13,6 @@ bar f x =

13 ( x, -- Foo

14 w, -- Bar

15 z -- Baz

16− )

16+ )

17

18baz x = proc a -> a -<< x

data/examples/declaration/value/function/arrow/proc-do-complex-out.hs+10−9

@@ -16,13 +16,13 @@ foo

16 f -- Call into f

17 ( a,

18 c -- Tuple together arguments

19− )

19+ )

20 ( b,

21 d

22− ) -<

22+ ) -<

23 ( b + 1, -- Funnel into arrow

24 d * b

25− )

25+ )

26 if x `mod` y == 0 -- Basic condition

27 then

28 case e of -- Only left case is relevant

@@ -33,10 +33,11 @@ foo

33 let v =

34 u -- Actually never used

35 ^ 2

36+

36− in ( returnA -<

37+ in ( returnA -<

37− -- Just do the calculation

38+ -- Just do the calculation

38− (x + y * z)

39+ (x + y * z)

39− )

40+ )

40 else

41 else

41 do

42 do

42 let u = x -- Let bindings bind expressions, not commands

43 let u = x -- Let bindings bind expressions, not commands

@@ -47,8 +48,8 @@ foo

47 n ->

48 n ->

48 ( ( h . g -<

49 ( ( h . g -<

49 y -- First actual use of y

50 y -- First actual use of y

50− )

51 )

52+ )

52 returnA -< ()

53 returnA -< ()

53 -- Sometimes execute effects

54 -- Sometimes execute effects

54 if i > 0

55 if i > 0

@@ -58,4 +59,4 @@ foo

58 ( i

59 ( i

59 + x

60 + x

60 * y -- Just do the calculation

61 * y -- Just do the calculation

61− )

62+ )

data/examples/declaration/value/function/arrow/proc-do-simple2-out.hs+1−1

@@ -15,6 +15,6 @@ bazbaz f g h = proc (a, b, c) -> do

15 ( a,

16 b,

17 c

18− )

18+ )

19 returnA -<

20 (x, y, z)

data/examples/declaration/value/function/arrow/proc-forms1-out.hs+14−13

@@ -1,18 +1,19 @@

1{-# LANGUAGE Arrows #-}

2

3−foo0 f g x y = proc _ -> (|f (g -< (x, y))|)

3+foo0 f g x y = proc _ -> (| f (g -< (x, y)) |)

4

5foo1 f g h x =

6 proc (y, z) ->

7− (| test

7+ (|

8− ( h f

8+ test

9− . h g -<

9+ ( h f

10− y x

10+ . h g -<

11− . y z

11+ y x

12− )

12+ . y z

13− ( h g

13+ )

14− . h f -<

14+ ( h g

15− y z

15+ . h f -<

16− . y x

16+ y z

17− )

17+ . y x

18+ )

18− |)

19+ |)

data/examples/declaration/value/function/arrow/proc-forms2-out.hs+1−1

@@ -2,7 +2,7 @@

2

3bar0 f g h x =

4 proc (y, z) ->

5− (|test (h f . (h g) -< (y x) . y z) ((h g) . h f -< y z . (y x))|)

5+ (| test (h f . (h g) -< (y x) . y z) ((h g) . h f -< y z . (y x)) |)

6

7bar1 f g x y = proc _ -> f -< x &&& g -< y

8

data/examples/declaration/value/function/arrow/proc-lets-out.hs+2−1

@@ -9,4 +9,5 @@ bar f g = proc a ->

9 j =

10 g

11 . h

12+

12− in id -< (h, j)

13+ in id -< (h, j)

data/examples/declaration/value/function/arrow/proc-parentheses-out.hs+4−4

@@ -5,14 +5,14 @@ foo f = proc a -> (f -< a)

5bar f g = proc a ->

6 ( ( (f)

7 ( g

8− )

8+ )

9− ) -<

9+ ) -<

10 ( ( ( ( ( ( g

11 a

12− )

13 )

12 )

14 )

13 )

15 )

14 )

16 )

15 )

17 )

16 )

17+ )

18− )

18+ )

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

@@ -8,7 +8,7 @@ foo f g = proc (x, y) -> do

8 bar -<

9 ( a,

10 b

11− )

11+ )

12 rec p <-

13 f

14 p -<

data/examples/declaration/value/function/complex-list-out.hs+2−2

@@ -4,7 +4,7 @@ handleStuff =

4 something,

5 \ExceptionB ->

6 somethingElse

7− ]

7+ ]

8

9handleStuff =

10 handle

@@ -12,4 +12,4 @@ handleStuff =

12 bar,

13 baz

14 qux

15− ]

15+ ]

data/examples/declaration/value/function/comprehension/transform-multi-line1-out.hs+2−2

@@ -3,9 +3,9 @@

3foo' xs ys =

4 [ ( x,

5 y

6− )

6+ )

7 | x <- xs,

8 y <- ys,

9 -- First comment

10 then reverse -- Second comment

11− ]

11+ ]

data/examples/declaration/value/function/comprehension/transform-multi-line2-out.hs+3−3

@@ -3,7 +3,7 @@

3bar' xs ys =

4 [ ( x,

5 y

6− )

6+ )

7 | x <- xs,

8 y <- ys,

9 -- First comment

@@ -11,5 +11,5 @@ bar' xs ys =

11 by

12 ( x

13 + y -- Second comment

14− )

14+ )

15− ]

15+ ]

data/examples/declaration/value/function/comprehension/transform-multi-line3-out.hs+2−2

@@ -3,9 +3,9 @@

3baz' xs ys =

4 [ ( x,

5 y

6− )

6+ )

7 | x <- xs,

8 y <- ys,

9 -- First comment

10 then group using permutations -- Second comment

11− ]

11+ ]

data/examples/declaration/value/function/comprehension/transform-multi-line4-out.hs+3−3

@@ -3,14 +3,14 @@

3quux' xs ys =

4 [ ( x,

5 y

6− )

6+ )

7 | x <- xs,

8 y <- ys,

9 -- First comment

10 then group by

11 ( x

12 + y

13− )

13+ )

14 -- Second comment

15 using groupWith -- Third comment

16− ]

16+ ]

data/examples/declaration/value/function/do/applications-and-parens-out.hsnew file+9

@@ -0,0 +1,9 @@

1+warningFor var place = do

2+ guard $ isVariableName var

3+ guard . not $ isInArray var place || isGuarded place

4+ ( if includeGlobals || isLocal var

5+ then warningForLocals

6+ else warningForGlobals

7+ )

8+ var

9+ place

data/examples/declaration/value/function/do/applications-and-parens.hsnew file+6

@@ -0,0 +1,6 @@

1+warningFor var place = do

2+ guard $ isVariableName var

3+ guard . not $ isInArray var place || isGuarded place

4+ (if includeGlobals || isLocal var

5+ then warningForLocals

6+ else warningForGlobals) var place

data/examples/declaration/value/function/do/operator-and-parens-out.hsnew file+7

@@ -0,0 +1,7 @@

1+scientifically :: (Scientific -> a) -> Parser a

2+scientifically h = do

3+ something

4+ ( I.satisfy (\w -> w == 'e' || w == 'E')

5+ *> fmap (h . Sci.scientific signedCoeff . (e +)) (signed decimal)

6+ )

7+ <|> return (h $ Sci.scientific signedCoeff e)

data/examples/declaration/value/function/do/operator-and-parens.hsnew file+7

@@ -0,0 +1,7 @@

1+scientifically :: (Scientific -> a) -> Parser a

2+scientifically h = do

3+ something

4+ ( I.satisfy (\w -> w == 'e' || w == 'E')

5+ *> fmap (h . Sci.scientific signedCoeff . (e +)) (signed decimal)

6+ )

7+ <|> return (h $ Sci.scientific signedCoeff e)

data/examples/declaration/value/function/fancy-forall-0-out.hs+1−1

@@ -5,6 +5,6 @@ wrapError

5 HasCatch outertag outer m'

6 => HasCatch innertag inner (t m'),

7 HasCatch outertag outer m

8− )

8+ )

9 => (forall m'. HasCatch innertag inner m' => m' a)

10 -> m a

data/examples/declaration/value/function/fancy-forall-1-out.hs+1−1

@@ -5,6 +5,6 @@ magnify

5 HasReader outertag outer m'

6 => HasReader innertag inner (t m'),

7 HasReader outertag outer m

8− )

8+ )

9 => (forall m'. HasReader innertag inner m' => m' a)

10 -> m a

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

@@ -9,7 +9,7 @@ sort'

9 :: ( ?cmp

10 :: a -> a -> Bool,

11 ?foo :: Int

12− )

12+ )

13 => [a]

14 -> [a]

15sort' = sort

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

@@ -20,5 +20,5 @@ barbaz x y z w =

20 b,

21 c,

22 d

23− ]

23+ ]

24− ]

24+ ]

data/examples/declaration/value/function/operator-sections-out.hs+2−2

@@ -5,9 +5,9 @@ bar = (<> "hello")

5baz =

6 ( 1 * 2

7 +

8− )

8+ )

9 ( *

10 3 ^ 5

11− )

11+ )

12

13quux = (,) <$> foo <$> bar

data/examples/declaration/value/function/parallel-comprehensions-complex-out.hs+2−2

@@ -9,7 +9,7 @@ baz x y z w =

9 h,

10 i,

11 j

12− )

12+ )

13 | a <- -- Foo 1

14 x, -- Foo 2

15 b <- -- Bar 1

@@ -32,4 +32,4 @@ baz x y z w =

32 -- Bar bar 3

33 j <- -- Bar baz 1

34 a + b -- Bar baz 2

35− ]

35+ ]

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

@@ -16,4 +16,4 @@ quux

16 { boom = a,

17 foom = b,

18 ..

19− } = a + b

19+ } = a + b

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

@@ -7,7 +7,7 @@ singleLine = case () of

7multiline = case () of

8 $( x

9 + y

10− ) -> ()

10+ ) -> ()

11 $( y

12 "something"

13− ) -> ()

13+ ) -> ()

data/examples/declaration/value/function/pattern/unboxed-sum-pattern-out.hs+5−3

@@ -18,7 +18,9 @@ z = True

18

19z_multiline = True

20 where

21+ (#

21− (# | | _x

22+ | | _x

22 #) =

23 #) =

24+ (#

23− (# | | True

25+ | | True

24− #)

26+ #)

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

@@ -3,7 +3,7 @@ foo = Foo {a = 3}

3bar = Bar

4 { abc = foo,

5 def = Foo {a = 10}

6− }

6+ }

7

8baz = Baz {}

9

@@ -14,14 +14,14 @@ aLongVariableName =

14 { short = baz,

15 aLongRecordFieldName = YetAnotherLongRecordName

16 { yetAnotherLongRecordFieldName = "a long string"

17− },

17+ },

18 aLongRecordFieldName2 = Just YetAnotherLongRecordName

19 { yetAnotherLongRecordFieldName = "a long string",

20 yetAnotherLongRecordFieldName =

21 Just

22 "a long string"

23− },

23+ },

24 aLongRecordFieldName3 = do

25 foo

26 bar

27− }

27+ }

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

@@ -4,7 +4,7 @@ bar x =

4 x

5 { abc = foo,

6 def = Foo {a = 10}

7− }

7+ }

8

9baz x = x {}

10

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

@@ -8,6 +8,6 @@ bar x y z = Bar

8 y,

9 z,

10 ..

11− }

11+ }

12

13baz = Baz {..}

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

@@ -9,11 +9,11 @@ bar =

9 [ 1,

10 2,

11 3

12− ]

12+ ]

13

14baz :: StaticPtr Bool

15baz =

16 static

17 ( fun 1

18 2

19− )

19+ )

data/examples/declaration/value/function/tricky-parens-out.hs+1−1

@@ -1,4 +1,4 @@

1handleStuff =

2 ( let foo = foo

3 in foo

4− )

4+ )

data/examples/declaration/value/function/tuples-out.hs+2−2

@@ -4,11 +4,11 @@ bar =

4 ( 1,

5 2,

6 3

7− )

7+ )

8

9handleStuff =

10 ( let foo = foo

11 in foo,

12 let bar = bar

13 in bar

14− )

14+ )

data/examples/declaration/value/function/unboxed-sums-out.hs+3−2

@@ -5,5 +5,6 @@ foo = (# 1 | #)

5bar = (# | | 2 | #)

6

7baz =

8+ (#

8− (# | | | 10 | | | | |

9+ | | | 10 | | | | |

9− #)

10+ #)

data/examples/declaration/value/function/unboxed-tuples-out.hs+5−4

@@ -3,7 +3,8 @@

3foo = (# 1, 2, 3 #)

4

5bar =

6+ (#

6− (# 1,

7+ 1,

7− 2,

8+ 2,

8− 3

9+ 3

9− #)

10+ #)

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

@@ -6,5 +6,5 @@ main = do

6 migration3

7 -- When adding migrations here, don't forget to update

8 -- 'schemaVersion' in Galley.Data

9− ]

9+ ]

10 `finally` Log.close

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

@@ -3,4 +3,4 @@ x =

3 [ 1,

4 2,

5 somethingSomething 3

6− ]

6+ ]

data/examples/declaration/value/pattern-synonyms/bidirectional-out.hs+1−1

@@ -8,7 +8,7 @@ pattern Arrow {t1, t2} = App "->" [t1, t2]

8pattern Arrow

9 { t1,

10 t2

11− }

11+ }

12 = App "->" [t1, t2]

13

14pattern Int

data/examples/declaration/value/pattern-synonyms/unidirectional-out.hs+1−1

@@ -14,7 +14,7 @@ pattern FirstTwo {x, y}

14pattern FirstTwo'

15 { x,

16 y

17− }

17+ }

18 <- x : (y : xs)

19

20pattern Simple <- "Simple"

data/examples/declaration/warning/warning-multiline-out.hs+1−1

@@ -3,7 +3,7 @@

3 foo

4 [ "These are bad functions",

5 "Really bad!"

6− ]

6+ ]

7 #-}

8test :: IO ()

9test = pure ()

data/examples/import/explicit-imports-out.hs+2−2

@@ -8,5 +8,5 @@ import qualified MegaModule as M

8 MonadBaseControl,

9 join,

10 liftIO,

11− void

11+ void,

12− )

12+ )

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

@@ -2,5 +2,5 @@ import qualified MegaModule as M

2 ( -- (1)

3 (<<<), -- (2)

4 (>>>),

5− Either -- (3)

5+ Either, -- (3)

6− )

6+ )

data/examples/import/misc-out.hs+2−2

@@ -5,7 +5,7 @@ import A hiding

5 foobarbazqux,

6 foobarbazqux,

7 foobarbazqux,

8− foobarbazqux

8+ foobarbazqux,

9− )

9+ )

10import {-# SOURCE #-} safe qualified Module as M hiding (a, b, c, d, e, f)

11import Name hiding ()

data/examples/import/nested-explicit-imports-out.hs+2−2

@@ -6,5 +6,5 @@ import qualified MegaModule as M

6 ( (>>),

7 (>>=),

8 return

9− )

9+ ),

10− )

10+ )

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

@@ -3,8 +3,8 @@

3module ExportSyntax

4 ( A (.., NoA),

5 Q (F, ..),

6− G (T, .., U)

6+ G (T, .., U),

7− )

7+ )

8where

9

10data A = A | B

data/examples/module-header/multiline-out.hs+2−2

@@ -1,6 +1,6 @@

1module Foo

2 ( foo,

3 bar,

4− baz

4+ baz,

5− )

5+ )

6where

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

@@ -14,8 +14,8 @@ module My.Module

14 bar2, -- a multiline comment

15 -- the second line

16 bar3,

17− module Foo.Bar.Baz

17+ module Foo.Bar.Baz,

18− )

18+ )

19where

20

21-- Wow

data/examples/module-header/multiline2-out.hs+2−2

@@ -1,6 +1,6 @@

1module Foo

2 ( foo,

3 bar,

4− baz

4+ baz,

5− )

5+ )

6where

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

@@ -2,10 +2,10 @@ module Test

2 {-# DEPRECATED

3 [ "This module is deprecated.",

4 "Please use OtherModule instead."

5− ]

5+ ]

6 #-}

7 ( foo,

8 bar,

9− baz

9+ baz,

10− )

10+ )

11where

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

@@ -2,8 +2,8 @@ module Test

2 {-# DEPRECATED "This module is unstable" #-}

3 ( foo,

4 bar,

5− baz

5+ baz,

6− )

6+ )

7where

8

9import Blah

data/examples/other/comment-inside-construct-out.hs+2−2

@@ -3,6 +3,6 @@ xs =

3 [ inner list first item,

4 inner list second item

5 -- inner list last item commented

6− ],

6+ ],

7 outer list item

8− ]

8+ ]

data/examples/other/comment-two-blocks-out.hs+1−1

@@ -5,4 +5,4 @@ newNames =

5 -- Foo

6

7 -- Bar

8− ]

8+ ]

data/examples/other/merging-comments-out.hs+1−1

@@ -5,7 +5,7 @@ foo xs = baz

5 [ lookup langKey gets, -- 1

6 lookup langKey cookies, -- 2

7 lookupText langKey session -- 3

8− ]

8+ ]

9 ++ xs -- 4

10

11 -- Blah

data/printer/list0-multi.hsdeleted−4

@@ -1,4 +0,0 @@

1−[ foo,

2− bar,

3− baz

4− ]

data/printer/list0-single.hsdeleted−1

@@ -1 +0,0 @@

1−[foo, bar, baz]

data/printer/list1-multi.hsdeleted−8

@@ -1,8 +0,0 @@

1−[ foo,

2− bar,

3− foo

4− :: ( Int

5− -> Int

6− )

7− -> Bool

8− ]

data/printer/list1-single.hsdeleted−1

@@ -1 +0,0 @@

1−[foo, bar, foo :: (Int -> Int) -> Bool]

data/printer/mhdr-multi.hsdeleted−7

@@ -1,7 +0,0 @@

1−module MyModule

2− ( R,

3− runR,

4− txt,

5− blah

6− )

7−where

data/printer/mhdr-single.hsdeleted−3

@@ -1,3 +0,0 @@

1−module MyModule

2− (R, runR, txt, blah)

3−where

data/printer/ssig-multi.hsdeleted−5

@@ -1,5 +0,0 @@

1−foo

2− :: ( Int

3− -> Int

4− )

5− -> Bool

data/printer/ssig-single.hsdeleted−1

@@ -1 +0,0 @@

1−foo :: (Int -> Int) -> Bool

ormolu.cabal+1−3

@@ -51,7 +51,6 @@ data-files: data/examples/declaration/annotation/*.hs

51 , data/examples/import/*.hs

52 , data/examples/module-header/*.hs

53 , data/examples/other/*.hs

54− , data/printer/*.hs

55

54

56source-repository head

55source-repository head

57 type: git

56 type: git

@@ -136,8 +135,7 @@ test-suite tests

136 , text >= 0.2 && < 1.3

135 , text >= 0.2 && < 1.3

137 build-tools: hspec-discover >= 2.0 && < 3.0

136 build-tools: hspec-discover >= 2.0 && < 3.0

138 other-modules:

137 other-modules:

139− Ormolu.Printer.CombinatorsSpec

140− , Ormolu.Parser.PragmaSpec

138+ Ormolu.Parser.PragmaSpec

141 , Ormolu.PrinterSpec

139 , Ormolu.PrinterSpec

142

140

143 if flag(dev)

141 if flag(dev)

src/Ormolu/Exception.hs+1−2

@@ -9,10 +9,10 @@ module Ormolu.Exception

9where

10

11import Control.Exception

12+import Data.Text (Text)

12import Ormolu.Utils (showOutputable)

13import Ormolu.Utils (showOutputable)

13import System.Exit (ExitCode (..), exitWith)

14import System.Exit (ExitCode (..), exitWith)

14import System.IO

15import System.IO

15−import Data.Text (Text)

16import qualified GHC

17import qualified Outputable as GHC

18

@@ -54,7 +54,6 @@ instance Exception OrmoluException where

54 [ "before: " ++ show left , "after: " ++ show right ]

55 ++ "Please, consider reporting the bug.\n"

56

57−

58-- | Inside this wrapper 'OrmoluException' will be caught and displayed

57-- | Inside this wrapper 'OrmoluException' will be caught and displayed

59-- nicely using 'displayException'.

58-- nicely using 'displayException'.

60

59

src/Ormolu/Printer/Combinators.hs+45−46

@@ -32,12 +32,12 @@ module Ormolu.Printer.Combinators

32 , useBraces

33 , dontUseBraces

34 -- ** Wrapping

35+ , BracketStyle (..)

35 , sitcc

36 , sitcc

36 , backticks

37 , backticks

37 , banana

38 , banana

38 , braces

39 , braces

39 , brackets

40 , brackets

40− , bracketsPar

41 , parens

42 , parensHash

43 , pragmaBraces

@@ -180,6 +180,12 @@ sepSemi f xs = vlayout singleLine multiLine

180----------------------------------------------------------------------------

181-- Wrapping

182

183+-- | 'BracketStyle' controlling how closing bracket is rendered.

184+

185+data BracketStyle

186+ = N -- ^ Normal

187+ | S -- ^ Shifted one level

188+

183-- | Surround given entity by backticks.

189-- | Surround given entity by backticks.

184

190

185backticks :: R () -> R ()

191backticks :: R () -> R ()

@@ -191,61 +197,37 @@ backticks m = do

191-- | Surround given entity by banana brackets (i.e., from arrow notation.)

197-- | Surround given entity by banana brackets (i.e., from arrow notation.)

192

198

193banana :: R () -> R ()

199banana :: R () -> R ()

194−banana m = sitcc $ do

200+banana = brackets_ True "(|" "|)" N

195− txt "(|"

196− ospaces m

197− txt "|)"

198

201

199-- | Surround given entity by curly braces @{@ and @}@.

202-- | Surround given entity by curly braces @{@ and @}@.

200

203

201−braces :: R () -> R ()

204+braces :: BracketStyle -> R () -> R ()

202−braces m = sitcc $ do

205+braces = brackets_ False "{" "}"

203− txt "{"

204− ospaces m

205− txt "}"

206

207-- | Surround given entity by square brackets @[@ and @]@.

208

209−brackets :: R () -> R ()

209+brackets :: BracketStyle -> R () -> R ()

210−brackets m = sitcc $ do

210+brackets = brackets_ False "[" "]"

211− txt "["

212− ospaces m

213− txt "]"

214−

215−-- | Surround given entity by parallel array brackets @[:@ and @:]@.

216−

217−bracketsPar :: R () -> R ()

218−bracketsPar m = sitcc $ do

219− txt "[: "

220− m

221− vlayout (return ()) space

222− txt " :]"

223

211

224-- | Surround given entity by parentheses @(@ and @)@.

212-- | Surround given entity by parentheses @(@ and @)@.

225

213

226−parens :: R () -> R ()

214+parens :: BracketStyle -> R () -> R ()

227−parens m = sitcc $ do

215+parens = brackets_ False "(" ")"

228− txt "("

229− ospaces m

230− txt ")"

231

216

232-- | Surround given entity by @(# @ and @ #)@.

217-- | Surround given entity by @(# @ and @ #)@.

233

218

234−parensHash :: R () -> R ()

219+parensHash :: BracketStyle -> R () -> R ()

235−parensHash m = sitcc $ do

220+parensHash = brackets_ True "(#" "#)"

236− txt "(# "

237− m

238− vlayout space (newline >> txt " ")

239− txt "#)"

240

221

241-- | Braces as used for pragmas: @{-#@ and @#-}@.

222-- | Braces as used for pragmas: @{-#@ and @#-}@.

242

223

243pragmaBraces :: R () -> R ()

224pragmaBraces :: R () -> R ()

244pragmaBraces m = sitcc $ do

225pragmaBraces m = sitcc $ do

245− txt "{-# "

226+ txt "{-#"

227+ space

246 m

228 m

247− vlayout space (newline >> txt " ")

229+ breakpoint

248− txt "#-}"

230+ inci (txt "#-}")

249

231

250-- | Surround the body with a pragma name and 'pragmaBraces'.

232-- | Surround the body with a pragma name and 'pragmaBraces'.

251

233

@@ -258,15 +240,32 @@ pragma pragmaText body = pragmaBraces $ do

258 breakpoint

240 breakpoint

259 body

241 body

260

242

261−-- | Surround given entity by optional space before and a newline after, iff

243+-- | A helper for defining wrappers like 'parens' and 'braces'.

262−-- current layout is multiline.

263

244

264−ospaces :: R () -> R ()

245+brackets_

265−ospaces m = vlayout m $ do

246+ :: Bool -- ^ Insert breakpoints around brackets

266− space

247+ -> Text -- ^ Opening bracket

248+ -> Text -- ^ Closing bracket

249+ -> BracketStyle -- ^ Bracket style

250+ -> R () -- ^ Inner expression

251+ -> R ()

252+brackets_ needBreaks open close style m = sitcc (vlayout singleLine multiLine)

253+ where

254+ singleLine = do

255+ txt open

256+ when needBreaks space

257+ m

258+ when needBreaks space

259+ txt close

260+ multiLine = do

261+ txt open

262+ if needBreaks

263+ then newline >> inci m

267− sitcc m

264+ else space >> sitcc m

268− newline

265+ newline

269− txt " "

266+ case style of

267+ N -> txt close

268+ S -> inci (txt close)

270

269

271----------------------------------------------------------------------------

270----------------------------------------------------------------------------

272-- Literals

271-- Literals

src/Ormolu/Printer/Meat/Common.hs+14−2

@@ -11,6 +11,7 @@ module Ormolu.Printer.Meat.Common

11 , doesNotNeedExtraParens

12 , p_qualName

13 , p_infixDefHelper

14+ , p_trailingCommaFor

14 )

15 )

15where

16where

16

17

@@ -57,7 +58,7 @@ p_rdrName l@(L spn _) = located l $ \x -> do

57 else id

58 else id

58 parensWrapper =

59 parensWrapper =

59 if AnnOpenP `elem` ids

60 if AnnOpenP `elem` ids

60− then parens

61+ then parens N

61 else id

62 else id

62 singleQuoteWrapper =

63 singleQuoteWrapper =

63 if AnnSimpleQuote `elem` ids

64 if AnnSimpleQuote `elem` ids

@@ -123,7 +124,7 @@ p_infixDefHelper isInfix inci' name args =

123 let parens' =

124 let parens' =

124 if null ps

125 if null ps

125 then id

126 then id

126− else parens

127+ else parens N

127 parens' $ do

128 parens' $ do

128 p0

129 p0

129 breakpoint

130 breakpoint

@@ -139,3 +140,14 @@ p_infixDefHelper isInfix inci' name args =

139 unless (null ps) $ do

140 unless (null ps) $ do

140 breakpoint

141 breakpoint

141 inci' $ sitcc (sep breakpoint sitcc args)

142 inci' $ sitcc (sep breakpoint sitcc args)

143+

144+-- | Insert a trailing comma when the given collection is not empty and

145+-- we're in multi-line layout.

146+

147+p_trailingCommaFor

148+ :: [a] -- ^ Collection to print trailing comma for

149+ -> R ()

150+p_trailingCommaFor xs =

151+ vlayout

152+ (return ())

153+ (unless (null xs) comma)

src/Ormolu/Printer/Meat/Declaration/Data.hs+1−1

@@ -157,7 +157,7 @@ p_hsDerivingClause HsDerivingClause {..} = do

157 txt "deriving"

158 let derivingWhat = located deriv_clause_tys $ \case

159 [] -> txt "()"

160− xs -> parens . sitcc $ sep

160+ xs -> parens N . sitcc $ sep

161 (comma >> breakpoint)

162 (sitcc . located' p_hsType . hsib_body)

163 xs

src/Ormolu/Printer/Meat/Declaration/Default.hs+1−1

@@ -16,6 +16,6 @@ p_defaultDecl = \case

16 DefaultDecl NoExt ts -> do

17 txt "default"

18 breakpoint

19− inci . parens . sitcc $

19+ inci . parens N . sitcc $

20 sep (comma >> breakpoint) (sitcc . located' p_hsType) ts

21 XDefaultDecl {} -> notImplemented "XDefaultDecl"

src/Ormolu/Printer/Meat/Declaration/Rule.hs+1−1

@@ -55,7 +55,7 @@ p_ruleBndrs bndrs =

55p_ruleBndr :: RuleBndr GhcPs -> R ()

56p_ruleBndr = \case

57 RuleBndr NoExt x -> p_rdrName x

58− RuleBndrSig NoExt x hswc -> parens $ do

58+ RuleBndrSig NoExt x hswc -> parens N $ do

59 p_rdrName x

60 p_typeAscription hswc

61 XRuleBndr NoExt -> notImplemented "XRuleBndr"

src/Ormolu/Printer/Meat/Declaration/Signature.hs+1−1

@@ -174,7 +174,7 @@ p_booleanFormula = \case

174 (breakpoint >> txt "| ")

175 (located' p_booleanFormula)

176 xs

177− Parens l -> located l (parens . p_booleanFormula)

177+ Parens l -> located l (parens N . p_booleanFormula)

178

179p_completeSig

180 :: Located [Located RdrName] -- ^ Constructors\/patterns

src/Ormolu/Printer/Meat/Declaration/Value.hs+46−39

@@ -310,7 +310,7 @@ p_hsCmd = \case

310 -- does. Open an issue and ping @yumiova if this ever occurs in output.

311 notImplemented "HsCmdApp"

312 HsCmdLam NoExt mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup

313− HsCmdPar NoExt c -> parens (located c p_hsCmd)

313+ HsCmdPar NoExt c -> parens N (located c p_hsCmd)

314 HsCmdCase NoExt e mgroup -> do

315 txt "case"

316 space

@@ -338,6 +338,7 @@ p_hsCmd = \case

338 space

339 sitcc (located localBinds p_hsLocalBinds)

340 breakpoint

341+ vlayout space (newline >> txt " ")

341 txt "in"

342 txt "in"

342 space

343 space

343 sitcc (located c p_hsCmd)

344 sitcc (located c p_hsCmd)

@@ -486,7 +487,10 @@ p_hsTupArg = \case

486 XTupArg {} -> notImplemented "XTupArg"

487 XTupArg {} -> notImplemented "XTupArg"

487

488

488p_hsExpr :: HsExpr GhcPs -> R ()

489p_hsExpr :: HsExpr GhcPs -> R ()

489−p_hsExpr = \case

490+p_hsExpr = p_hsExpr' N

491+

492+p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()

493+p_hsExpr' s = \case

490 HsVar NoExt name -> p_rdrName name

494 HsVar NoExt name -> p_rdrName name

491 HsUnboundVar NoExt _ -> notImplemented "HsUnboundVar"

495 HsUnboundVar NoExt _ -> notImplemented "HsUnboundVar"

492 HsConLikeOut NoExt _ -> notImplemented "HsConLikeOut"

496 HsConLikeOut NoExt _ -> notImplemented "HsConLikeOut"

@@ -504,8 +508,8 @@ p_hsExpr = \case

504 HsOverLit NoExt v -> atom (ol_val v)

508 HsOverLit NoExt v -> atom (ol_val v)

505 HsLit NoExt lit ->

509 HsLit NoExt lit ->

506 case lit of

510 case lit of

507− HsString (SourceText s) _ -> p_stringLit s

511+ HsString (SourceText stxt) _ -> p_stringLit stxt

508− HsStringPrim (SourceText s) _ -> p_stringLit s

512+ HsStringPrim (SourceText stxt) _ -> p_stringLit stxt

509 r -> atom r

513 r -> atom r

510 HsLam NoExt mgroup ->

514 HsLam NoExt mgroup ->

511 p_matchGroup Lambda mgroup

515 p_matchGroup Lambda mgroup

@@ -519,8 +523,8 @@ p_hsExpr = \case

519 -- and then use 'p_withoutHanging' for the descendants.

523 -- and then use 'p_withoutHanging' for the descendants.

520 let p_withoutHanging (HsApp NoExt f' x') = do

524 let p_withoutHanging (HsApp NoExt f' x') = do

521 case f' of

525 case f' of

522− (L _ (HsApp _ _ _)) -> located f' p_withoutHanging

526+ L _ (HsApp _ _ _) -> located f' p_withoutHanging

523− _ -> located f' p_hsExpr

527+ _ -> located f' (p_hsExpr' s)

524 breakpoint

528 breakpoint

525 inci $ located x' p_hsExpr

529 inci $ located x' p_hsExpr

526 p_withoutHanging e = p_hsExpr e

530 p_withoutHanging e = p_hsExpr e

@@ -552,12 +556,12 @@ p_hsExpr = \case

552 getOpName = \case

556 getOpName = \case

553 HsVar NoExt (L _ a) -> Just a

557 HsVar NoExt (L _ a) -> Just a

554 _ -> Nothing

558 _ -> Nothing

555− p_exprOpTree (reassociateOpTree getOpName opTree)

559+ p_exprOpTree s (reassociateOpTree getOpName opTree)

556 NegApp NoExt e _ -> do

560 NegApp NoExt e _ -> do

557 txt "-"

561 txt "-"

558 space

562 space

559 located e p_hsExpr

563 located e p_hsExpr

560− HsPar NoExt e -> parens (located e p_hsExpr)

564+ HsPar NoExt e -> parens s (located e p_hsExpr)

561 SectionL NoExt x op -> do

565 SectionL NoExt x op -> do

562 located x p_hsExpr

566 located x p_hsExpr

563 breakpoint

567 breakpoint

@@ -576,12 +580,12 @@ p_hsExpr = \case

576 Boxed -> parens

580 Boxed -> parens

577 Unboxed -> parensHash

581 Unboxed -> parensHash

578 if isSection

582 if isSection

579− then switchLayout [] . parens' $

583+ then switchLayout [] . parens' s $

580 sep comma (located' p_hsTupArg) args

584 sep comma (located' p_hsTupArg) args

581− else switchLayout (getLoc <$> args) . parens' . sitcc $

585+ else switchLayout (getLoc <$> args) . parens' s . sitcc $

582 sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args

586 sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args

583 ExplicitSum NoExt tag arity e ->

587 ExplicitSum NoExt tag arity e ->

584− p_unboxedSum tag arity (located e p_hsExpr)

588+ p_unboxedSum N tag arity (located e p_hsExpr)

585 HsCase NoExt e mgroup -> do

589 HsCase NoExt e mgroup -> do

586 txt "case"

590 txt "case"

587 space

591 space

@@ -620,8 +624,8 @@ p_hsExpr = \case

620 txt header

624 txt header

621 breakpoint

625 breakpoint

622 ub <- vlayout (return useBraces) (return id)

626 ub <- vlayout (return useBraces) (return id)

623− inci $ sepSemi (located' (ub . p_stmt)) (unLoc es)

627+ inci $ sepSemi (located' (ub . p_stmt' (p_hsExpr' S))) (unLoc es)

624− compBody = brackets $ located es $ \xs -> do

628+ compBody = brackets N $ located es $ \xs -> do

625 let p_parBody = sep

629 let p_parBody = sep

626 (breakpoint >> txt "| ")

630 (breakpoint >> txt "| ")

627 p_seqBody

631 p_seqBody

@@ -647,7 +651,8 @@ p_hsExpr = \case

647 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"

651 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"

648 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

652 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

649 ExplicitList _ _ xs ->

653 ExplicitList _ _ xs ->

654+ brackets s . sitcc $

650− brackets . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs

655+ sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs

651 RecordCon {..} -> do

656 RecordCon {..} -> do

652 located rcon_con_name atom

657 located rcon_con_name atom

653 breakpoint

658 breakpoint

@@ -662,7 +667,8 @@ p_hsExpr = \case

662 case rec_dotdot of

667 case rec_dotdot of

663 Just {} -> [txt ".."]

668 Just {} -> [txt ".."]

664 Nothing -> []

669 Nothing -> []

670+ inci . braces N . sitcc $

665− inci . braces . sitcc $ sep (comma >> breakpoint) sitcc (fields <> dotdot)

671+ sep (comma >> breakpoint) sitcc (fields <> dotdot)

666 RecordUpd {..} -> do

672 RecordUpd {..} -> do

667 located rupd_expr p_hsExpr

673 located rupd_expr p_hsExpr

668 breakpoint

674 breakpoint

@@ -672,7 +678,7 @@ p_hsExpr = \case

672 Unambiguous _ n -> n

678 Unambiguous _ n -> n

673 XAmbiguousFieldOcc _ -> notImplemented "XAmbiguousFieldOcc"

679 XAmbiguousFieldOcc _ -> notImplemented "XAmbiguousFieldOcc"

674 }

680 }

675− inci . braces . sitcc $

681+ inci . braces N . sitcc $

676 sep

682 sep

677 (comma >> breakpoint)

683 (comma >> breakpoint)

678 (sitcc . located' (p_hsRecField . updName))

684 (sitcc . located' (p_hsRecField . updName))

@@ -688,21 +694,21 @@ p_hsExpr = \case

688 located hsib_body p_hsType

694 located hsib_body p_hsType

689 ArithSeq NoExt _ x -> do

695 ArithSeq NoExt _ x -> do

690 case x of

696 case x of

691− From from -> brackets . sitcc $ do

697+ From from -> brackets s . sitcc $ do

692 located from p_hsExpr

698 located from p_hsExpr

693 breakpoint

699 breakpoint

694 txt ".."

700 txt ".."

695− FromThen from next -> brackets . sitcc $ do

701+ FromThen from next -> brackets s . sitcc $ do

696 sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]

702 sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]

697 breakpoint

703 breakpoint

698 txt ".."

704 txt ".."

699− FromTo from to -> brackets . sitcc $ do

705+ FromTo from to -> brackets s . sitcc $ do

700 located from p_hsExpr

706 located from p_hsExpr

701 breakpoint

707 breakpoint

702 txt ".."

708 txt ".."

703 space

709 space

704 located to p_hsExpr

710 located to p_hsExpr

705− FromThenTo from next to -> brackets . sitcc $ do

711+ FromThenTo from next to -> brackets s . sitcc $ do

706 sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]

712 sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]

707 breakpoint

713 breakpoint

708 txt ".."

714 txt ".."

@@ -799,7 +805,7 @@ p_patSynBind PSB {..} = do

799 inci $ do

805 inci $ do

800 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do

806 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do

801 unless (null xs) breakpoint

807 unless (null xs) breakpoint

802− braces . sitcc $

808+ braces N . sitcc $

803 sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs

809 sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs

804 breakpoint

810 breakpoint

805 rhs

811 rhs

@@ -829,20 +835,20 @@ p_pat = \case

829 txt "@"

835 txt "@"

830 located pat p_pat

836 located pat p_pat

831 ParPat NoExt pat ->

837 ParPat NoExt pat ->

832− located pat (parens . p_pat)

838+ located pat (parens S . p_pat)

833 BangPat NoExt pat -> do

839 BangPat NoExt pat -> do

834 txt "!"

840 txt "!"

835 located pat p_pat

841 located pat p_pat

836 ListPat NoExt pats -> do

842 ListPat NoExt pats -> do

837− brackets . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats

843+ brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats

838 TuplePat NoExt pats boxing -> do

844 TuplePat NoExt pats boxing -> do

839 let f =

845 let f =

840 case boxing of

846 case boxing of

841− Boxed -> parens

847+ Boxed -> parens S

842− Unboxed -> parensHash

848+ Unboxed -> parensHash S

843 f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats

849 f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats

844 SumPat NoExt pat tag arity ->

850 SumPat NoExt pat tag arity ->

845− p_unboxedSum tag arity (located pat p_pat)

851+ p_unboxedSum S tag arity (located pat p_pat)

846 ConPatIn pat details ->

852 ConPatIn pat details ->

847 case details of

853 case details of

848 PrefixCon xs -> sitcc $ do

854 PrefixCon xs -> sitcc $ do

@@ -856,9 +862,10 @@ p_pat = \case

856 let f = \case

862 let f = \case

857 Nothing -> txt ".."

863 Nothing -> txt ".."

858 Just x -> located x p_pat_hsRecField

864 Just x -> located x p_pat_hsRecField

859− inci . braces . sitcc . sep (comma >> breakpoint) f $ case dotdot of

865+ inci . braces N . sitcc . sep (comma >> breakpoint) f $

866+ case dotdot of

860− Nothing -> Just <$> fields

867+ Nothing -> Just <$> fields

861− Just n -> (Just <$> take n fields) ++ [Nothing]

868+ Just n -> (Just <$> take n fields) ++ [Nothing]

862 InfixCon x y -> do

869 InfixCon x y -> do

863 located x p_pat

870 located x p_pat

864 space

871 space

@@ -898,8 +905,8 @@ p_pat_hsRecField HsRecField {..} = do

898 breakpoint

905 breakpoint

899 inci (located hsRecFieldArg p_pat)

906 inci (located hsRecFieldArg p_pat)

900

907

901−p_unboxedSum :: ConTag -> Arity -> R () -> R ()

908+p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()

902−p_unboxedSum tag arity m = do

909+p_unboxedSum s tag arity m = do

903 let before = tag - 1

910 let before = tag - 1

904 after = arity - before - 1

911 after = arity - before - 1

905 args = replicate before Nothing <> [Just m] <> replicate after Nothing

912 args = replicate before Nothing <> [Just m] <> replicate after Nothing

@@ -913,7 +920,7 @@ p_unboxedSum tag arity m = do

913 unless isFirst space

920 unless isFirst space

914 m'

921 m'

915 unless isLast space

922 unless isLast space

916− parensHash $ sep (txt "|") f (zip args [0..])

923+ parensHash s $ sep (txt "|") f (zip args [0..])

917

924

918p_hsSplice :: HsSplice GhcPs -> R ()

925p_hsSplice :: HsSplice GhcPs -> R ()

919p_hsSplice = \case

926p_hsSplice = \case

@@ -938,7 +945,7 @@ p_hsSpliceTH

938p_hsSpliceTH isTyped expr = \case

945p_hsSpliceTH isTyped expr = \case

939 HasParens -> do

946 HasParens -> do

940 txt decoSymbol

947 txt decoSymbol

941− parens (located expr (sitcc . p_hsExpr))

948+ parens N (located expr (sitcc . p_hsExpr))

942 HasDollar -> do

949 HasDollar -> do

943 txt decoSymbol

950 txt decoSymbol

944 located expr (sitcc . p_hsExpr)

951 located expr (sitcc . p_hsExpr)

@@ -971,7 +978,7 @@ p_hsBracket = \case

971 (\i -> isPunctuation i || isSymbol i)

978 (\i -> isPunctuation i || isSymbol i)

972 (showOutputable (rdrNameOcc name))

979 (showOutputable (rdrNameOcc name))

973 && not (doesNotNeedExtraParens name)

980 && not (doesNotNeedExtraParens name)

974− wrapper = if isOperator then parens else id

981+ wrapper = if isOperator then parens N else id

975 wrapper $ p_rdrName (noLoc name)

982 wrapper $ p_rdrName (noLoc name)

976 TExpBr NoExt expr -> do

983 TExpBr NoExt expr -> do

977 txt "[||"

984 txt "[||"

@@ -1136,9 +1143,9 @@ exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)

1136exprOpTree (L _ (OpApp NoExt x op y)) = OpBranch (exprOpTree x) op (exprOpTree y)

1143exprOpTree (L _ (OpApp NoExt x op y)) = OpBranch (exprOpTree x) op (exprOpTree y)

1137exprOpTree n = OpNode n

1144exprOpTree n = OpNode n

1138

1145

1139−p_exprOpTree :: OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()

1146+p_exprOpTree :: BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()

1140−p_exprOpTree (OpNode x) = located x p_hsExpr

1147+p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)

1141−p_exprOpTree (OpBranch x op y) = do

1148+p_exprOpTree s (OpBranch x op y) = do

1142 -- NOTE If the beginning of the first argument and the second argument

1149 -- NOTE If the beginning of the first argument and the second argument

1143 -- are on the same line, and the second argument has a hanging form, use

1150 -- are on the same line, and the second argument has a hanging form, use

1144 -- hanging placement.

1151 -- hanging placement.

@@ -1158,12 +1165,12 @@ p_exprOpTree (OpBranch x op y) = do

1158 Hanging -> useBraces

1165 Hanging -> useBraces

1159 Normal -> dontUseBraces)

1166 Normal -> dontUseBraces)

1160 switchLayout [opTreeLoc x] $

1167 switchLayout [opTreeLoc x] $

1161− ub $ p_exprOpTree x

1168+ ub $ p_exprOpTree s x

1162 placeHanging placement $ do

1169 placeHanging placement $ do

1163 located op (opWrapper . p_hsExpr)

1170 located op (opWrapper . p_hsExpr)

1164 space

1171 space

1165 switchLayout [opTreeLoc y] $

1172 switchLayout [opTreeLoc y] $

1166− p_exprOpTree y

1173+ p_exprOpTree N y

1167

1174

1168-- | Get annotations for the enclosing element.

1175-- | Get annotations for the enclosing element.

1169

1176

src/Ormolu/Printer/Meat/Declaration/Warning.hs+1−1

@@ -48,4 +48,4 @@ warningText = \case

48p_lits :: [Located StringLiteral] -> R ()

49p_lits = \case

50 [l] -> atom l

51− ls -> brackets . sitcc $ sep (comma >> breakpoint) atom ls

51+ ls -> brackets N . sitcc $ sep (comma >> breakpoint) atom ls

src/Ormolu/Printer/Meat/ImportExport.hs+14−10

@@ -23,7 +23,9 @@ p_hsmodExports [] = do

23 breakpoint'

24 txt ")"

25p_hsmodExports xs =

26+ parens N . sitcc $ do

26− parens . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_lie) xs

27+ sep (comma >> breakpoint) (sitcc . located' p_lie) xs

28+ p_trailingCommaFor xs

27

29

28p_hsmodImport :: ImportDecl GhcPs -> R ()

30p_hsmodImport :: ImportDecl GhcPs -> R ()

29p_hsmodImport ImportDecl {..} = do

31p_hsmodImport ImportDecl {..} = do

@@ -55,10 +57,11 @@ p_hsmodImport ImportDecl {..} = do

55 when hiding (txt "hiding")

57 when hiding (txt "hiding")

56 case ideclHiding of

58 case ideclHiding of

57 Nothing -> return ()

59 Nothing -> return ()

58− Just (_, (L _ a)) -> do

60+ Just (_, (L _ xs)) -> do

59 breakpoint

61 breakpoint

60− parens . sitcc $

62+ parens N . sitcc $ do

61− sep (comma >> breakpoint) (sitcc . located' p_lie) a

63+ sep (comma >> breakpoint) (sitcc . located' p_lie) xs

64+ p_trailingCommaFor xs

62 newline

65 newline

63p_hsmodImport (XImportDecl NoExt) = notImplemented "XImportDecl"

66p_hsmodImport (XImportDecl NoExt) = notImplemented "XImportDecl"

64

67

@@ -77,12 +80,13 @@ p_lie = \case

77 inci $ do

80 inci $ do

78 let names :: [R ()]

81 let names :: [R ()]

79 names = located' p_ieWrappedName <$> xs

82 names = located' p_ieWrappedName <$> xs

83+ parens N . sitcc $

80− parens . sitcc . sep (comma >> breakpoint) sitcc $

84+ sep (comma >> breakpoint) sitcc $

81− case w of

85+ case w of

82− NoIEWildcard -> names

86+ NoIEWildcard -> names

83− IEWildcard n ->

87+ IEWildcard n ->

84− let (before, after) = splitAt n names

88+ let (before, after) = splitAt n names

85− in before ++ [txt ".."] ++ after

89+ in before ++ [txt ".."] ++ after

86 IEModuleContents NoExt l1 -> located l1 p_hsmodName

90 IEModuleContents NoExt l1 -> located l1 p_hsmodName

87 -- XXX I have no idea what these things are for.

91 -- XXX I have no idea what these things are for.

88 IEGroup NoExt _ _ -> return ()

92 IEGroup NoExt _ _ -> return ()

src/Ormolu/Printer/Meat/Type.hs+13−13

@@ -60,18 +60,18 @@ p_hsType = \case

60 case y' of

61 HsFunTy{} -> p_hsType y'

62 _ -> located y p_hsType

63− HsListTy NoExt t -> located t (brackets . p_hsType)

63+ HsListTy NoExt t -> located t (brackets N . p_hsType)

64 HsTupleTy NoExt tsort xs ->

65 let parens' =

66 case tsort of

67− HsUnboxedTuple -> parensHash

67+ HsUnboxedTuple -> parensHash N

68− HsBoxedTuple -> parens

68+ HsBoxedTuple -> parens N

69− HsConstraintTuple -> parens

69+ HsConstraintTuple -> parens N

70− HsBoxedOrConstraintTuple -> parens

70+ HsBoxedOrConstraintTuple -> parens N

71 in parens' . sitcc $

72 sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

73 HsSumTy NoExt xs ->

74− parensHash . sitcc $

74+ parensHash N . sitcc $

75 sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs

76 HsOpTy NoExt x op y -> sitcc $ do

77 let opTree = OpBranch (tyOpTree x) op (tyOpTree y)

@@ -83,7 +83,7 @@ p_hsType = \case

83 -- always necessary when we have kind signatures in place.

84 p_hsType t

85 HsParTy NoExt t ->

86− parens (located t p_hsType)

86+ parens N (located t p_hsType)

87 HsIParamTy NoExt n t -> sitcc $ do

88 located n atom

89 breakpoint

@@ -94,7 +94,7 @@ p_hsType = \case

94 HsStarTy NoExt _ -> txt "*"

95 HsKindSig NoExt t k ->

96 -- NOTE Also see the comment for 'HsParTy'.

97− parens . sitcc $ do

97+ parens N . sitcc $ do

98 located t p_hsType

99 space -- FIXME

100 inci $ do

@@ -119,7 +119,7 @@ p_hsType = \case

119 case p of

120 Promoted -> txt "'"

121 NotPromoted -> return ()

122− brackets $ do

122+ brackets N $ do

123 -- If both this list itself and the first element is promoted,

124 -- we need to put a space in between or it fails to parse.

125 case (p, xs) of

@@ -128,7 +128,7 @@ p_hsType = \case

128 sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

129 HsExplicitTupleTy NoExt xs -> do

130 txt "'"

131− parens $ do

131+ parens N $ do

132 case xs of

133 ((L _ t):_) | isPromoted t -> space

134 _ -> return ()

@@ -150,14 +150,14 @@ p_hsContext :: HsContext GhcPs -> R ()

150p_hsContext = \case

151 [] -> txt "()"

152 [x] -> located x p_hsType

153− xs -> parens . sitcc $

153+ xs -> parens N . sitcc $

154 sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

155

156p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

157p_hsTyVarBndr = \case

158 UserTyVar NoExt x ->

159 p_rdrName x

160− KindedTyVar NoExt l k -> parens $ do

160+ KindedTyVar NoExt l k -> parens N $ do

161 located l atom

162 breakpoint

163 inci $ do

@@ -167,7 +167,7 @@ p_hsTyVarBndr = \case

167 XTyVarBndr NoExt -> notImplemented "XTyVarBndr"

168

169p_conDeclFields :: [LConDeclField GhcPs] -> R ()

170−p_conDeclFields xs = braces . sitcc $

170+p_conDeclFields xs = braces N . sitcc $

171 sep (comma >> breakpoint) (sitcc . located' p_conDeclField) xs

172

173p_conDeclField :: ConDeclField GhcPs -> R ()

tests/Ormolu/Printer/CombinatorsSpec.hsdeleted−115

@@ -1,115 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−module Ormolu.Printer.CombinatorsSpec (spec) where

4−

5−import Ormolu.Parser.Anns

6−import Ormolu.Printer.Combinators

7−import Ormolu.Printer.Internal

8−import Test.Hspec

9−import qualified Data.Text.IO as T

10−

11−-- NOTE Testing combinators in separation is easy, but it's not very useful

12−-- either because interesting things happen only when combinators are used

13−-- together. However, there are too many combinations to test, so we test

14−-- just a few things here and expect new tests to be added on demand when

15−-- particularly tricky or problematic use cases are discovered.

16−--

17−-- The printing logic is indirectly tested in the main bulk of reformatting

18−-- tests.

19−

20−spec :: Spec

21−spec = do

22− stdTest "simple signature" rSimpleSig "ssig"

23− stdTest "list" rList0 "list0"

24− stdTest "list with annotated name in it" rList1 "list1"

25− stdTest "module header" rModuleHeader "mhdr"

26−

27−-- | Do a standard test prodedure testing both single-line and multi-line

28−-- layouts.

29−

30−stdTest

31− :: String -- ^ Test name

32− -> R () -- ^ Computation to test

33− -> FilePath -- ^ Base file name where expected result is stored

34− -> Spec

35−stdTest name m path = describe name $ do

36− let spath = "data/printer/" ++ path ++ "-single.hs"

37− mpath = "data/printer/" ++ path ++ "-multi.hs"

38− it "single-line works" $

39− singleLine m `shouldRender` spath

40− it "multi-line works" $

41− multiLine m `shouldRender` mpath

42−

43−----------------------------------------------------------------------------

44−-- Test computations

45−

46−line :: R () -> R ()

47−line m = m >> newline

48−

49−rSimpleSig :: R ()

50−rSimpleSig = line rFn

51−

52−rList0 :: R ()

53−rList0 = line . brackets . sitcc $

54− sep (comma >> breakpoint) id

55− [ txt "foo"

56− , txt "bar"

57− , txt "baz"

58− ]

59−

60−rList1 :: R ()

61−rList1 = line . brackets . sitcc $

62− sep (comma >> breakpoint) id

63− [ txt "foo"

64− , txt "bar"

65− , rFn

66− ]

67−

68−rFn :: R ()

69−rFn = sitcc $ sep breakpoint sitcc

70− [ txt "foo"

71− , inci . sitcc $ sep breakpoint sitcc

72− [ do txt ":: "

73− parens . sitcc $ sep breakpoint sitcc

74− [ txt "Int"

75− , txt "-> " >> txt "Int"

76− ]

77− , txt "-> " >> txt "Bool"

78− ]

79− ]

80−

81−rModuleHeader :: R ()

82−rModuleHeader = do

83− line $ do

84− txt "module "

85− txt "MyModule"

86− line . inci . parens . sitcc . sep (comma >> breakpoint) sitcc $

87− [ txt "R"

88− , txt "runR"

89− , txt "txt"

90− , txt "blah"

91− ]

92− line (txt "where")

93−

94−----------------------------------------------------------------------------

95−-- Helpers

96−

97−-- | Run given computation in @'R' ()@ monad and compare result of rendering

98−-- with contents of a given file.

99−

100−shouldRender :: R () -> FilePath -> Expectation

101−shouldRender m path = do

102− let rendered = runR m mempty mempty emptyAnns

103− -- T.writeFile path rendered

104− expected <- T.readFile path

105− rendered `shouldBe` expected

106−

107−-- | Render using single-line layout.

108−

109−singleLine :: R () -> R ()

110−singleLine = enterLayout SingleLine

111−

112−-- | Render using multi-line layout.

113−

114−multiLine :: R () -> R ()

115−multiLine = enterLayout MultiLine

tests/Ormolu/PrinterSpec.hs+13−1

@@ -2,6 +2,7 @@

2

3module Ormolu.PrinterSpec (spec) where

4

5+import Control.Exception

5import Control.Monad

6import Control.Monad

6import Control.Monad.IO.Class

7import Control.Monad.IO.Class

7import Data.List (isSuffixOf)

8import Data.List (isSuffixOf)

@@ -22,7 +23,7 @@ spec = do

22-- | Check a single given example.

23-- | Check a single given example.

23

24

24checkExample :: Path Rel File -> Spec

25checkExample :: Path Rel File -> Spec

25−checkExample srcPath' = it (fromRelFile srcPath' ++ " works") $ do

26+checkExample srcPath' = it (fromRelFile srcPath' ++ " works") . withNiceExceptions $ do

26 let srcPath = examplesDir </> srcPath'

27 let srcPath = examplesDir </> srcPath'

27 expectedOutputPath <- deriveOutput srcPath

28 expectedOutputPath <- deriveOutput srcPath

28 -- 1. Given input snippet of source code parse it and pretty print it.

29 -- 1. Given input snippet of source code parse it and pretty print it.

@@ -80,3 +81,14 @@ shouldMatch idempotencyTest actual expected =

80

81

81examplesDir :: Path Rel Dir

82examplesDir :: Path Rel Dir

82examplesDir = $(mkRelDir "data/examples")

83examplesDir = $(mkRelDir "data/examples")

84+

85+-- | Inside this wrapper 'OrmoluException' will be caught and displayed

86+-- nicely using 'displayException'.

87+

88+withNiceExceptions

89+ :: Expectation -- ^ Action that may throw the exception

90+ -> Expectation

91+withNiceExceptions m = m `catch` h

92+ where

93+ h :: OrmoluException -> IO ()

94+ h = expectationFailure . displayException