8466d6e · ormolu · git.iko.soy

git.iko.soy/ormolu

Change the style of type signatures

The commit changes how type signatures are printed. The new style looks like this: foo :: Int -> Char -> String This works better with foralls and other features of the type system that will be added in the near future, like linear arrows. In order to print Haddocks nicely (this seems to be the only acceptable placement): foo :: -- | First argument Int -> -- | Second argument Char -> -- | Result String It is often necessary to re-arrange them completely and use the “pipe style” instead of “caret style”. It proved to be a very hard task with our older comment-handling system, if not impossible. Here we start parsing Haddocks so that they are treated as components of AST and we now render them as part of rendering of those components. The existing framework for handling comments only prints non-Haddock comments now. The change caused a fair number of new problems and failures which I added new tests for.

commit8466d6e74376f298e05a19b427790fa37e8c39af authormrkkrp <mark.karpov@tweag.io> dateTue 17 Sep 2019, 13:16 (7 years ago) parent776d3f5

154 files changed+1052−521

compare with master

unifiedsplit

DESIGN.md+10−10

@@ -282,22 +282,22 @@ map :: (a -> b) -> [a] -> [b]

282282foldr :: (a -> b -> b) ->

283283 b -> [a] -> [b]

284284-- Is reformatted to:

285−foldr

286− :: (a -> b -> b)

287− -> b

288− -> [a]

289− -> [b]

285+foldr ::

286+ (a -> b -> b) ->

287+ b ->

288+ [a] ->

289+ [b]

290290

291291t = let x = foo bar

292292 baz

293293 in foo bar baz

294294-- Is reformatted to:

295295t =

296− let x =

297− foo

298− bar

299− baz

300− in foo far baz

296+ let x =

297+ foo

298+ bar

299+ baz

300+ in foo far baz

301301```

302302

303303Crucially, no effort is made to fit within reasonable line lengths. That's

README.md+2

@@ -95,6 +95,8 @@ $ ormolu --mode inplace Module.hs

9595## Current limitations

9696

9797* Does not handle CPP (wontfix, see [the design document][design]).

98+* Input modules should be parsable by Haddock, which is a bit stricter

99+ criterion than just being a valid Haskell modules.

98100* Various minor idempotence issues, most of them are related to comments †.

99101

100102† To be resolved in 0.0.2.0.

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

@@ -2,8 +2,8 @@

33{-# ANN

44 module

5− ( 5

6− :: Int

5+ ( 5 ::

6+ Int

77 )

88 #-}

data/examples/declaration/class/associated-data2-out.hs+2

@@ -1,5 +1,7 @@

11{-# LANGUAGE TypeFamilies #-}

3+module Main where

35-- | Something more.

46class Baz a where

data/examples/declaration/class/associated-data2.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13{-# LANGUAGE TypeFamilies #-}

35-- | Something more.

data/examples/declaration/class/associated-types2-out.hs+2

@@ -1,5 +1,7 @@

11{-# LANGUAGE TypeFamilies #-}

3+module Main where

35-- | Something more.

46class Baz a where

data/examples/declaration/class/associated-types2.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13{-# LANGUAGE TypeFamilies #-}

35-- | Something more.

data/examples/declaration/class/default-implementations-comments-out.hs+7−5

@@ -1,3 +1,5 @@

1+module Main where

13-- | Baz

24class Baz a where

@@ -6,13 +8,13 @@ class Baz a where

68 barbaz (bazbar a)

810 -- | Bar baz

9− barbaz

10− :: a -> a

11+ barbaz ::

12+ a -> a

1113

1214 -- | Baz bar

13− bazbar

14− :: a

15− -> a

15+ bazbar ::

16+ a ->

17+ a

1618

1719 -- First comment

1820 barbaz a =

data/examples/declaration/class/default-implementations-comments.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Baz

24class Baz a where

35 foobar :: a -> a

data/examples/declaration/class/default-implementations-out.hs+5−3

@@ -1,3 +1,5 @@

1+module Main where

13-- | Foo

24class Foo a where

35 foo :: a -> a

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

68-- | Bar

79class Bar a where

8− bar

9− :: a

10− -> Int

10+ bar ::

11+ a ->

12+ Int

1113 bar = const 0

data/examples/declaration/class/default-implementations.hs+2−1

@@ -1,3 +1,5 @@

1+module Main where

13-- | Foo

24class Foo a where

35 foo :: a -> a

@@ -9,4 +11,3 @@ class Bar a where

911 a

1012 -> Int

1113 bar = const 0

12−

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

@@ -1,22 +1,24 @@

11{-# LANGUAGE DefaultSignatures #-}

3+module Main where

35-- | Something else.

46class Bar a where

68 -- | Bar

7− bar

8− :: String

9− -> String

10− -> a

9+ bar ::

10+ String ->

11+ String ->

12+ a

1113

1214 -- Pointless comment

13− default bar

14− :: ( Read a,

15− Semigroup a

16− )

17− => a

18− -> a

19− -> a

15+ default bar ::

16+ ( Read a,

17+ Semigroup a

18+ ) =>

19+ a ->

20+ a ->

21+ a

2022 -- Even more pointless comment

2123 bar

2224 a

data/examples/declaration/class/default-signatures-simple-out.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

24class Foo a where

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

@@ -1,7 +1,8 @@

1+module Main where

13-- | Something.

24class Foo a where

35 -- | Foo

46 foo :: a -> String

57 default foo :: Show a => a -> String

68 foo = show

7−

data/examples/declaration/class/default-signatures.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13{-# LANGUAGE DefaultSignatures #-}

35-- | Something else.

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

@@ -1,5 +1,7 @@

11{-# LANGUAGE FunctionalDependencies #-}

3+module Main where

35-- | Something.

46class (MonadReader r s, MonadWriter w m) => MonadState s m | m -> s where

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

1113class

1214 ( Stream s, -- Token streams

1315 MonadPlus m -- Potential for failure

14− )

15− => MonadParsec e s m

16+ ) =>

17+ MonadParsec e s m

1618 | m -> e s where

1719

1820 -- | 'getState' returns state

19− getState

20− :: m s

21+ getState ::

22+ m s

2123

2224 -- | 'putState' sets state

23− putState

24− :: s

25− -> m ()

25+ putState ::

26+ s ->

27+ m ()

data/examples/declaration/class/dependency-super-classes.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13{-# LANGUAGE FunctionalDependencies #-}

35-- | Something.

data/examples/declaration/class/empty-classes-out.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Foo!

24class Foo a

data/examples/declaration/class/empty-classes.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Foo!

24class Foo a where

35-- | Bar!

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

@@ -1,5 +1,7 @@

11{-# LANGUAGE FunctionalDependencies #-}

3+module Main where

35-- | Something.

46class Foo a b | a -> b

data/examples/declaration/class/functional-dependencies.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13{-# LANGUAGE FunctionalDependencies #-}

35-- | Something.

data/examples/declaration/class/multi-parameters1-out.hs+5−5

@@ -4,11 +4,11 @@ class Foo a b where foo :: a -> b

55-- | Something.

66class Bar a b c d where

7− bar

8− :: a

9− -> b

10− -> c

11− -> d

7+ bar ::

8+ a ->

9+ b ->

10+ c ->

11+ d

1212

1313class -- Before name

1414 Baz where

data/examples/declaration/class/multi-parameters2-out.hs+7−5

@@ -1,5 +1,7 @@

11{-# LANGUAGE MultiParamTypeClasses #-}

3+module Main where

35-- | Something else.

46class

57 BarBaz

@@ -10,9 +12,9 @@ class

1012 e -- Rest

1113 f where

1214

13− barbaz

14− :: a -> f

15+ barbaz ::

16+ a -> f

1517

16− bazbar

17− :: e

18− -> f

18+ bazbar ::

19+ e ->

20+ f

data/examples/declaration/class/multi-parameters2.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13{-# LANGUAGE MultiParamTypeClasses #-}

35-- | Something else.

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

@@ -4,6 +4,6 @@ class Foo (a :: k)

55class

66 Bar

7− ( a -- Variable

8− :: * -- Star

7+ ( a :: -- Variable

8+ * -- Star

99 )

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

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

24class Foo a where foo :: a

@@ -8,16 +10,19 @@ class Bar a where

810

911class Baz a where

1012 -- | Baz

11− baz

12− :: ( a,

13− a -- ^ First argument

14− )

15− -> a -- ^ Second argument

16− -> a -- ^ Return value

13+ baz ::

14+ -- | First argument

15+ ( a,

16+ a

17+ ) ->

18+ -- | Second argument

19+ a ->

20+ -- | Return value

21+ a

1722

1823class BarBaz a where

1924

20− barbaz

21− :: a -> b

25+ barbaz ::

26+ a -> b

2227

2328 bazbar :: b -> a

data/examples/declaration/class/single-parameters.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

24class Foo a where foo :: a

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

@@ -3,12 +3,12 @@ class Foo a

33class Foo a => Bar a

55class

6− (Foo a, Bar a)

7− => Baz a

6+ (Foo a, Bar a) =>

7+ Baz a

99class

1010 ( Foo a, -- Foo?

1111 Bar a, -- Bar?

1212 Baz a -- Baz

13− )

14− => BarBar a

13+ ) =>

14+ BarBar a

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

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

24newtype Foo = Foo Int

35 deriving stock (Eq, Show, Generic)

data/examples/declaration/data/deriving-strategies.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

35newtype Foo = Foo Int

data/examples/declaration/data/fat-multiline-out.hs+6−4

@@ -1,10 +1,12 @@

1+module Main where

13-- | Something.

24data Foo

3− = Foo

5+ = -- | Foo

6+ Foo

47 Int

58 Int

6− -- ^ Foo

7− | Bar

9+ | -- | Bar

10+ Bar

811 Bool

912 Bool

10− -- ^ Bar

data/examples/declaration/data/fat-multiline.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

35data Foo

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

@@ -1,2 +1,3 @@

1−{-# LANUGAGE GADTSyntax #-}

1+{-# LANGUAGE GADTSyntax #-}

23data Foo where MKFoo :: a -> (a -> Bool) -> Foo

data/examples/declaration/data/gadt-syntax.hs+1−1

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

1−{-# LANUGAGE GADTSyntax #-}

1+{-# LANGUAGE GADTSyntax #-}

33data Foo where { MKFoo :: a -> (a->Bool) -> Foo }

data/examples/declaration/data/gadt/multiline-out.hs+16−12

@@ -1,21 +1,25 @@

11{-# LANGUAGE ExplicitForAll #-}

3+module Main where

35-- | Here goes a comment.

46data Foo a where

57 -- | 'Foo' is wonderful.

6− Foo

7− :: forall a b. (Show a, Eq b) -- foo

8+ Foo ::

9+ forall a b.

10+ (Show a, Eq b) => -- foo

811 -- bar

9− => a

10− -> b

11− -> Foo 'Int

12+ a ->

13+ b ->

14+ Foo 'Int

1215 -- | But 'Bar' is also not too bad.

13− Bar

14− :: Int

15− -> Maybe Text

16− -> Foo 'Bool

16+ Bar ::

17+ Int ->

18+ Maybe Text ->

19+ Foo 'Bool

1720 -- | So is 'Baz'.

18− Baz

19− :: forall a. a

20− -> Foo 'String

21+ Baz ::

22+ forall a.

23+ a ->

24+ Foo 'String

2125 (:~>) :: Foo a -> Foo a -> Foo a

data/examples/declaration/data/gadt/multiline.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13{-# LANGUAGE ExplicitForAll #-}

35-- | Here goes a comment.

data/examples/declaration/data/gadt/multiple-declaration-out.hs+6−6

@@ -3,13 +3,13 @@ data GADT0 a where

44data GADT1 a where

55 GADT11,

6− GADT12

7− :: Int

8− -> GADT1 a

6+ GADT12 ::

7+ Int ->

8+ GADT1 a

1010data GADT2 a where

1111 GADT21,

1212 GADT21,

13− GADT22

14− :: Int

15− -> GADT2 a

13+ GADT22 ::

14+ Int ->

15+ GADT2 a

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

@@ -1,12 +1,14 @@

1+module Main where

13-- | Something.

24data Foo where

35 Foo :: {fooX :: Int} -> Foo

4− Bar

5− :: { fooY :: Int,

6− fooBar, fooBaz :: Bool,

7− fooFoo,

8− barBar,

9− bazBaz

10− :: Int

11− }

12− -> Foo

6+ Bar ::

7+ { fooY :: Int,

8+ fooBar, fooBaz :: Bool,

9+ fooFoo,

10+ barBar,

11+ bazBaz ::

12+ Int

13+ } ->

14+ Foo

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

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

35data Foo where

data/examples/declaration/data/gadt/simple-out.hs+12−2

@@ -1,8 +1,18 @@

11{-# LANGUAGE ExplicitForAll #-}

3+module Main where

35-- | Here goes a comment.

46data Foo a where

57 -- | 'Foo' is wonderful.

68 Foo :: forall a b. (Show a, Eq b) => a -> b -> Foo 'Int

7− Bar :: Int -> Text -> Foo 'Bool -- ^ But 'Bar' is also not too bad.

8− Baz :: forall a. a -> Foo 'String -- ^ So is 'Baz'.

9+ Bar ::

10+ Int ->

11+ Text ->

12+ -- | But 'Bar' is also not too bad.

13+ Foo 'Bool

14+ Baz ::

15+ forall a.

16+ a ->

17+ -- | So is 'Baz'.

18+ Foo 'String

data/examples/declaration/data/gadt/simple.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13{-# LANGUAGE ExplicitForAll #-}

35-- | Here goes a comment.

data/examples/declaration/data/multiline-arg-parens-out.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

24data Foo

35 = Foo

data/examples/declaration/data/multiline-arg-parens.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

35data Foo

data/examples/declaration/data/multiline-out.hs+8−3

@@ -1,7 +1,12 @@

1+module Main where

13-- | Here we have 'Foo'.

24data Foo

3− = Foo -- ^ One

4− | Bar Int -- ^ Two

5− | Baz -- ^ Three

5+ = -- | One

6+ Foo

7+ | -- | Two

8+ Bar Int

9+ | -- | Three

10+ Baz

611 deriving

712 (Eq, Show)

data/examples/declaration/data/multiline.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Here we have 'Foo'.

35data Foo

data/examples/declaration/data/newtype-out.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

24newtype Foo = Foo Int

35 deriving (Eq, Show)

data/examples/declaration/data/newtype.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

35newtype Foo = Foo Int

data/examples/declaration/data/record-out.hs+17−11

@@ -1,18 +1,24 @@

1+module Main where

13-- | Something.

24data Foo

35 = Foo

4− { fooX :: Int, -- ^ X

5− fooY :: Int, -- ^ Y

6− fooBar, fooBaz :: NonEmpty (Identity Bool), -- ^ BarBaz

6+ { -- | X

7+ fooX :: Int,

8+ -- | Y

9+ fooY :: Int,

10+ -- | BarBaz

11+ fooBar, fooBaz :: NonEmpty (Identity Bool),

12+ -- | GagGog

713 fooGag,

8− fooGog

9− :: NonEmpty

10− ( Indentity

11− Bool

12− ),

13− -- ^ GagGog

14+ fooGog ::

15+ NonEmpty

16+ ( Indentity

17+ Bool

18+ ),

19+ -- | Huh!

1420 fooFoo,

15− barBar

16− :: Int -- ^ Huh!

21+ barBar ::

22+ Int

1723 }

1824 deriving (Eq, Show)

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

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

24data Foo = Foo {fooX :: Int, fooY :: Int}

35 deriving (Eq, Show)

data/examples/declaration/data/record-singleline.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

35data Foo = Foo { fooX :: Int , fooY :: Int }

data/examples/declaration/data/record.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

35data Foo = Foo

data/examples/declaration/data/simple-broken-out.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Here we go.

24data Foo

35 = Foo {unFoo :: Int}

data/examples/declaration/data/simple-broken.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Here we go.

35data Foo

data/examples/declaration/data/simple-out.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | And here we have 'Foo'.

24data Foo = Foo | Bar Int | Baz

35 deriving (Eq, Show)

data/examples/declaration/data/simple.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | And here we have 'Foo'.

35data Foo = Foo | Bar Int | Baz

data/examples/declaration/data/strictness-out.hs+2

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

1+module Main where

13-- | Something.

24data Foo = Foo !Int {-# UNPACK #-} !Bool {-# NOUNPACK #-} !String

data/examples/declaration/data/strictness.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Something.

35data Foo = Foo !Int {-# UNPACK #-} !Bool {-# NOUNPACK #-} !String

data/examples/declaration/foreign/foreign-import-out.hs+9−9

@@ -10,16 +10,16 @@ foreign import stdcall unsafe "boo"

1010 boo :: Int -> Text -> IO Array

1111

1212foreign import javascript

13− baz

14− :: String

15− -> Int

16− -> IO Foo

13+ baz ::

14+ String ->

15+ Int ->

16+ IO Foo

1717

1818foreign import {- We use capi here -} capi "pi.h value pi" c_pi :: CDouble

1919

2020foreign import stdcall {- This is a bad place for a comment -} "dynamic"

21− dyn_gluBeginSurface

22− :: FunPtr (Ptr GLUnurbs -> IO ())

23− -- ^ This 'FunPtr' is extremely dangerous, beware

24− -> Ptr GLUnurbs

25− -> IO ()

21+ dyn_gluBeginSurface ::

22+ -- | This 'FunPtr' is extremely dangerous, beware

23+ FunPtr (Ptr GLUnurbs -> IO ()) ->

24+ Ptr GLUnurbs ->

25+ IO ()

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

@@ -5,13 +5,13 @@ instance

55 ( c, -- Bar

66 d

77 )

8− )

9− => Read

10− ( a, -- Baz

11− b,

12− ( c, -- Quux

13− d

14− )

15− )

8+ ) =>

9+ Read

10+ ( a, -- Baz

11+ b,

12+ ( c, -- Quux

13+ d

14+ )

15+ )

1616 where

1717 readsPrec = undefined

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

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

33instance

44 ( Ord a,

55 Ord b

6− )

7− => Ord (a, b)

6+ ) =>

7+ Ord (a, b)

88 where

99 compare _ _ = GT

1010

1111instance

12− (Show a, Show b)

13− => Show

14− ( a,

15− b

16− )

12+ (Show a, Show b) =>

13+ Show

14+ ( a,

15+ b

16+ )

1717 where

1818 showsPrec _ _ = showString ""

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

@@ -2,10 +2,10 @@

22{-# LANGUAGE TypeFamilies #-}

44data instance Bar Int a where

5− SameBar

6− :: Bar Int

7− Int

5+ SameBar ::

6+ Bar Int

7+ Int

88 CloseBar :: Bar Int Double

9− OtherBar

10− :: Bar Int

11− a

9+ OtherBar ::

10+ Bar Int

11+ a

data/examples/declaration/instance/instance-sigs-multiple-out.hs+5−5

@@ -2,11 +2,11 @@

33instance Applicative [] where

5− pure

6− :: a

7− -> [a]

5+ pure ::

6+ a ->

7+ [a]

88 pure a = [a]

10− (<*>)

11− :: [a] -> [a] -> [a]

10+ (<*>) ::

11+ [a] -> [a] -> [a]

1212 (<*>) _ _ = []

data/examples/declaration/instance/instance-sigs-out.hs+4−4

@@ -5,10 +5,10 @@ instance Eq Int where

55 (==) _ _ = False

77instance Ord Int where

8− compare

9− :: Int

10− -> Int

11− -> Ordering

8+ compare ::

9+ Int ->

10+ Int ->

11+ Ordering

1212 compare

1313 _

1414 _ =

data/examples/declaration/rewrite-rule/prelude2-out.hs+1

@@ -17,6 +17,7 @@

1717-- So I've disabled it for now. We could have special cases

1818-- for short lists, I suppose.

1919-- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)

20+

2021"foldr/single" forall k z x. foldr k z [x] = k x z

2122"foldr/nil" forall k z. foldr k z [] = z

2223"augment/build" forall

data/examples/declaration/rewrite-rule/prelude2.hs−1

@@ -27,4 +27,3 @@

2727"augment/nil" forall (g::forall b. (a->b->b) -> b -> b) .

2828 augment g [] = build g

2929 #-}

30−

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

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

66"fold/build" forall

77 k

88 z

9− ( g

10− :: forall b.

11− (a -> b -> b)

12− -> b

13− -> b

9+ ( g ::

10+ forall b.

11+ (a -> b -> b) ->

12+ b ->

13+ b

1414 ).

1515 foldr k z (build g) =

1616 g k z

data/examples/declaration/signature/complete/complete-out.hs+2−2

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

55{-# COMPLETE

66 A,

77 B,

8− C

9− :: Foo

8+ C ::

9+ Foo

1010 #-}

data/examples/declaration/signature/pattern/multiline-out.hs+9−9

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

11{-# LANGUAGE PatternSynonyms #-}

3−pattern Arrow

4− :: Type

5− -> Type

6− -> Type

3+pattern Arrow ::

4+ Type ->

5+ Type ->

6+ Type

88pattern

99 Foo,

10− Bar

11− :: Type -> Type -> Type

10+ Bar ::

11+ Type -> Type -> Type

1212

1313pattern

1414 TypeSignature,

1515 FunctionBody,

1616 PatternSignature,

17− WarningPragma

18− :: [RdrName]

19− -> HsDecl GhcPs

17+ WarningPragma ::

18+ [RdrName] ->

19+ HsDecl GhcPs

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

@@ -9,15 +9,15 @@ bar = id

1010baz :: Num a => a -> a

1111baz = id

12−{-# SPECIALIZE [~2] baz

13− :: Int

14− -> Int

12+{-# SPECIALIZE [~2] baz ::

13+ Int ->

14+ Int

1515 #-}

1616

1717{-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-}

18−{-# SPECIALIZE fits13Bits

19− :: Int

20− -> Bool,

18+{-# SPECIALIZE fits13Bits ::

19+ Int ->

20+ Bool,

2121 Integer -> Bool

2222 #-}

2323fits13Bits :: Integral a => a -> Bool

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

@@ -1,16 +1,16 @@

11{-# LANGUAGE RankNTypes #-}

3−functionName

4− :: (C1, C2, C3, C4, C5)

5− => a

6− -> b

7− -> ( forall a.

8− (C6, C7)

9− => LongDataTypeName

10− -> a

11− -> AnotherLongDataTypeName

12− -> b

13− -> c

14− )

15− -> (c -> d)

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

3+functionName ::

4+ (C1, C2, C3, C4, C5) =>

5+ a ->

6+ b ->

7+ ( forall a.

8+ (C6, C7) =>

9+ LongDataTypeName ->

10+ a ->

11+ AnotherLongDataTypeName ->

12+ b ->

13+ c

14+ ) ->

15+ (c -> d) ->

16+ (a, b, c, d)

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

@@ -1,10 +1,10 @@

1−functionName

2− :: ( C1,

3− C2,

4− C3

5− )

6− => a

7− -> b

8− -> c

9− -> d

10− -> (a, b, c, d)

1+functionName ::

2+ ( C1,

3+ C2,

4+ C3

5+ ) =>

6+ a ->

7+ b ->

8+ c ->

9+ d ->

10+ (a, b, c, d)

data/examples/declaration/signature/type/context-single-line-out.hs+7−7

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

1−functionName

2− :: (C1, C2, C3)

3− => a

4− -> b

5− -> c

6− -> d

7− -> (a, b, c, d)

1+functionName ::

2+ (C1, C2, C3) =>

3+ a ->

4+ b ->

5+ c ->

6+ d ->

7+ (a, b, c, d)

data/examples/declaration/signature/type/long-function-name-out.hs+6−6

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

1−longFunctionName

2− :: a

3− -> b

4− -> c

5− -> d

6− -> (a, b, c, d)

1+longFunctionName ::

2+ a ->

3+ b ->

4+ c ->

5+ d ->

6+ (a, b, c, d)

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

@@ -1,15 +1,15 @@

1−functionName

2− :: (C1, C2, C3, C4, C5)

3− => a

4− -> b

5− -> ( LongDataTypeName

6− AnotherLongDataTypeName

7− AnotherLongDataTypeName2

8− AnotherLongDataTypeName3

9− -> a

10− -> AnotherLongDataTypeName4

11− -> b

12− -> c

13− )

14− -> (c -> d)

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

1+functionName ::

2+ (C1, C2, C3, C4, C5) =>

3+ a ->

4+ b ->

5+ ( LongDataTypeName

6+ AnotherLongDataTypeName

7+ AnotherLongDataTypeName2

8+ AnotherLongDataTypeName3 ->

9+ a ->

10+ AnotherLongDataTypeName4 ->

11+ b ->

12+ c

13+ ) ->

14+ (c -> d) ->

15+ (a, b, c, d)

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

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

55foo,

66 bar,

7− baz

8− :: Int

7+ baz ::

8+ Int

99bar = 2

1010baz = 3

data/examples/declaration/type-families/closed-type-family/multi-line-out.hs+6−6

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

11type family

2− Id a

3− = result

2+ Id a =

3+ result

44 | result -> a where

55 Id a =

66 a

@@ -9,15 +9,15 @@ type family

99 G

1010 (a :: k)

1111 b

12− c

13− = foo

12+ c =

13+ foo

1414 | foo -> k b where

1515 G a b c =

1616 (a, b)

1717

1818type family

19− F a

20− :: * -> * where

19+ F a ::

20+ * -> * where

2121 F Int = Double

2222 F Bool =

2323 Char

data/examples/declaration/type-families/closed-type-family/simple-out.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Documentation.

24type family F a :: * -> * where

35 F Int = Double

data/examples/declaration/type-families/closed-type-family/simple.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Documentation.

35type family F a :: * -> * where

data/examples/declaration/type-families/data-family/no-annotation-out.hs+2

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

1+module Main where

13-- | Documentation.

24data family Array e

data/examples/declaration/type-families/data-family/no-annotation.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Documentation.

35data family Array e

data/examples/declaration/type-families/data-family/simple-out.hs+2

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

1+module Main where

13-- | Documentation.

24data family GMap k :: Type -> Type

data/examples/declaration/type-families/data-family/simple.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Documentation.

35data family GMap k :: Type -> Type

data/examples/declaration/type-families/type-family/no-annotation-out.hs+2

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

1+module Main where

13-- | Documentation.

24type family F a b :: Type -> Type

data/examples/declaration/type-families/type-family/no-annotation.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Documentation.

35type family F a b :: Type -> Type

data/examples/declaration/type-families/type-family/simple-out.hs+2

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

1+module Main where

13-- | Documentation.

24type family Elem c :: Type

data/examples/declaration/type-families/type-family/simple.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Documentation.

35type family Elem c :: Type

data/examples/declaration/type-synonyms/multi-line-out.hs+12−12

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

1−type Foo a b c

2− = Bar c a b

1+type Foo a b c =

2+ Bar c a b

44type Foo

55 a

66 b

7− c

8− = Bar c a b

7+ c =

8+ Bar c a b

10−type Foo

11− = Bar

12− Baz

13− Quux

10+type Foo =

11+ Bar

12+ Baz

13+ Quux

1414

15−type API

16− = "route1" :> ApiRoute1

17− :<|> "route2" :> ApiRoute2 -- comment here

18− :<|> OmitDocs :> "i" :> ASomething API

15+type API =

16+ "route1" :> ApiRoute1

17+ :<|> "route2" :> ApiRoute2 -- comment here

18+ :<|> OmitDocs :> "i" :> ASomething API

data/examples/declaration/type-synonyms/multi-line.hs−3

@@ -15,6 +15,3 @@ type API

1515 = "route1" :> ApiRoute1

1616 :<|> "route2" :> ApiRoute2 -- comment here

1717 :<|> OmitDocs :> "i" :> ASomething API

18−

19−

20−

data/examples/declaration/type-synonyms/simple-out.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Documentation.

24type Foo a b c = Bar c a b

data/examples/declaration/type-synonyms/simple.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Documentation.

35type Foo a b c = Bar c a b

data/examples/declaration/type/forall-out.hs+4−4

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

1−type CoerceLocalSig m m'

2− = forall r a.

3− LocalSig m r a

4− -> LocalSig m' r a

1+type CoerceLocalSig m m' =

2+ forall r a.

3+ LocalSig m r a ->

4+ LocalSig m' r a

data/examples/declaration/type/lits-out.hs+4−4

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

11type A = "foo"

3−type B

4− = "foo\

5− \bar"

6− -> ()

3+type B =

4+ "foo\

5+ \bar" ->

6+ ()

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

@@ -6,6 +6,7 @@ foo' xs ys =

66 )

77 | x <- xs,

88 y <- ys,

9− -- First comment

10− then reverse -- Second comment

9+ then

10+ -- First comment

11+ reverse -- Second comment

1112 ]

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

@@ -6,8 +6,9 @@ bar' xs ys =

66 )

77 | x <- xs,

88 y <- ys,

9− -- First comment

10− then sortWith

9+ then

10+ -- First comment

11+ sortWith

1112 by

1213 ( x

1314 + y -- Second comment

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

@@ -6,6 +6,7 @@ baz' xs ys =

66 )

77 | x <- xs,

88 y <- ys,

9− -- First comment

10− then group using permutations -- Second comment

9+ then group using

10+ -- First comment

11+ permutations -- Second comment

1112 ]

data/examples/declaration/value/function/comprehension/transform-multi-line3.hs−1

@@ -10,4 +10,3 @@ baz' xs ys = [

1010 using -- First comment

1111 permutations -- Second comment

1212 ]

13−

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

@@ -6,11 +6,12 @@ quux' xs ys =

66 )

77 | x <- xs,

88 y <- ys,

9− -- First comment

109 then group by

10+ -- First comment

1111 ( x

1212 + y

1313 )

14− -- Second comment

15− using groupWith -- Third comment

14+ using

15+ -- Second comment

16+ groupWith -- Third comment

1617 ]

data/examples/declaration/value/function/do/hanging-out.hsdeleted

No changes to the content.

data/examples/declaration/value/function/do/hanging.hsdeleted

No changes to the content.

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

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

11foo = 5 :: Int

33bar =

4− 5

5− :: Int

4+ 5 ::

5+ Int

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

@@ -1,10 +1,10 @@

1−wrapError

2− :: forall outertag innertag t outer inner m a.

3− ( forall x. Coercible (t m x) (m x),

4− forall m'.

5− HasCatch outertag outer m'

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

7− HasCatch outertag outer m

8− )

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

10− -> m a

1+wrapError ::

2+ forall outertag innertag t outer inner m a.

3+ ( forall x. Coercible (t m x) (m x),

4+ forall m'.

5+ HasCatch outertag outer m' =>

6+ HasCatch innertag inner (t m'),

7+ HasCatch outertag outer m

8+ ) =>

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

10+ m a

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

@@ -1,10 +1,10 @@

1−magnify

2− :: forall outertag innertag t outer inner m a.

3− ( forall x. Coercible (t m x) (m x),

4− forall m'.

5− HasReader outertag outer m'

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

7− HasReader outertag outer m

8− )

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

10− -> m a

1+magnify ::

2+ forall outertag innertag t outer inner m a.

3+ ( forall x. Coercible (t m x) (m x),

4+ forall m'.

5+ HasReader outertag outer m' =>

6+ HasReader innertag inner (t m'),

7+ HasReader outertag outer m

8+ ) =>

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

10+ m a

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

@@ -5,11 +5,11 @@ sortBy :: (a -> a -> Bool) -> [a] -> [a]

55sort :: (?cmp :: a -> a -> Bool) => [a] -> [a]

66sort = sortBy ?cmp

8−sort'

9− :: ( ?cmp

10− :: a -> a -> Bool,

11− ?foo :: Int

12− )

13− => [a]

14− -> [a]

8+sort' ::

9+ ( ?cmp ::

10+ a -> a -> Bool,

11+ ?foo :: Int

12+ ) =>

13+ [a] ->

14+ [a]

1515sort' = sort

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

@@ -2,6 +2,6 @@ f = do

22 x :: a <- g

44f = do

5− (x, y)

6− :: (a, b) <-

5+ (x, y) ::

6+ (a, b) <-

77 g

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

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

11foo x = x :: Int

33bar x =

4− Just x

5− :: Maybe String

4+ Just x ::

5+ Maybe String

data/examples/declaration/value/function/where-nested.hs−1

@@ -10,4 +10,3 @@ foo = bar

1010foo2 = bar

1111 where

1212 { f1 = f1 where { f1 = 3; f1' = 4 }; f2 = f2 where { f2 = 3; f2' = 4 } }

13−

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

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

88pattern Arrow

99 { t1,

1010 t2

11− }

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

11+ } =

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

1313

14−pattern Int

15− = App "Int" []

14+pattern Int =

15+ App "Int" []

1616

17−pattern Maybe {t}

18− = App

19− "Maybe"

20− [t]

17+pattern Maybe {t} =

18+ App

19+ "Maybe"

20+ [t]

2121

22−pattern Maybe t

23− = App

24− "Maybe"

25− [t]

22+pattern Maybe t =

23+ App

24+ "Maybe"

25+ [t]

2626

27−pattern a :< b

28− <- (a, b)

27+pattern a :< b <-

28+ (a, b)

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

@@ -1,21 +1,21 @@

11{-# LANGUAGE PatternSynonyms #-}

3−pattern HeadC x

4− <- x : xs

3+pattern HeadC x <-

4+ x : xs

55 where

66 HeadC x = [x]

8−pattern HeadC' x

9− <- x : xs

8+pattern HeadC' x <-

9+ x : xs

1010 where

1111 HeadC' x = [x]

1212

13−pattern Simple

14− <- "Simple"

13+pattern Simple <-

14+ "Simple"

1515 where

1616 Simple = "Complicated"

1717

18−pattern a :< b

19− <- (a, b)

18+pattern a :< b <-

19+ (a, b)

2020 where

2121 a :< b = (a, b)

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

@@ -2,20 +2,20 @@

33pattern Head x <- x : xs

5−pattern Head' x

6− <- x : xs

5+pattern Head' x <-

6+ x : xs

8−pattern Head'' {x}

9− <- x : xs

8+pattern Head'' {x} <-

9+ x : xs

1010

11−pattern FirstTwo {x, y}

12− <- x : (y : xs)

11+pattern FirstTwo {x, y} <-

12+ x : (y : xs)

1313

1414pattern FirstTwo'

1515 { x,

1616 y

17− }

18− <- x : (y : xs)

17+ } <-

18+ x : (y : xs)

1919

2020pattern Simple <- "Simple"

2121

data/examples/import/comments-inside-imports-out.hs+1

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

11-- x

23import qualified -- x

34 Bar

45import qualified -- x

data/examples/module-header/leading-empty-line-out.hsnew file+11

@@ -0,0 +1,11 @@

1+-- |

2+-- Module : Text.Megaparsec

6+-- License : FreeBSD

7+--

8+-- Maintainer : Mark Karpov <markkarpov92@gmail.com>

9+-- Stability : experimental

10+-- Portability : portable

11+module Main where

data/examples/module-header/leading-empty-line.hsnew file+11

@@ -0,0 +1,11 @@

1+-- |

2+-- Module : Text.Megaparsec

6+-- License : FreeBSD

7+--

8+-- Maintainer : Mark Karpov <markkarpov92@gmail.com>

9+-- Stability : experimental

10+-- Portability : portable

11+module Main where

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

@@ -6,6 +6,7 @@ module My.Module

66 ( -- * Something

77 foo,

88 bar,

910 -- * Another thing

1011 (<?>),

1112 {- some other thing -} foo2, -- yet another

data/examples/module-header/named-section-out.hsnew file+13

@@ -0,0 +1,13 @@

1+module Magic

2+ ( -- * Something

3+ -- $explanation

5+ -- ** Another level

6+ foo,

7+ bar,

8+ )

9+where

10+

11+-- $explanation

12+--

13+-- Here it goes.

data/examples/module-header/named-section.hsnew file+13

@@ -0,0 +1,13 @@

1+module Magic

2+ ( -- * Something

3+ -- $explanation

5+ -- ** Another level

6+ foo

7+ , bar

8+ )

9+where

10+

11+-- $explanation

12+--

13+-- Here it goes.

data/examples/other/argument-comment-out.hs+14−11

@@ -1,14 +1,17 @@

1−foo

2− :: Int -- ^ Documentation

3− -> Bool

1+foo ::

2+ -- | Documentation

3+ Int ->

4+ Bool

45foo _ = True

6−foo

7− :: Foo a

8− => Int -- ^ Foo

9− -> Int

7+foo ::

8+ Foo a =>

9+ -- | Foo

10+ Int ->

11+ Int

1012

11−foo

12− :: Foo a

13− => Int -- ^ Foo

14− -> Int

13+foo ::

14+ Foo a =>

15+ -- | Foo

16+ Int ->

17+ Int

data/examples/other/comment-alignment-out.hs+4−3

@@ -1,9 +1,10 @@

11class Foo a where

33 -- | Foo.

4− foo

5− :: Int

6− -> a -- ^ Something

4+ foo ::

5+ Int ->

6+ -- | Something

7+ a

89 -- | Bar.

910 bar :: a

data/examples/other/comment-multiline-after-out.hs+7−1

@@ -1 +1,7 @@

1−foo :: Int {- ^ start index -} -> Int {- ^ length -} -> t a -> t a

1+foo ::

2+ -- | start index

3+ Int ->

4+ -- | length

5+ Int ->

6+ t a ->

7+ t a

data/examples/other/comment-style-transform-out.hsnew file+17

@@ -0,0 +1,17 @@

1+-- |

2+-- Module: Data.Aeson.TH

5+-- License: BSD3

6+-- Stability: experimental

7+-- Portability: portable

8+module Main where

10+-- |

11+--

12+-- Here is a snippet:

13+--

14+-- @

15+-- x = y + 2

16+-- @

17+x = y + 2

data/examples/other/comment-style-transform.hsnew file+22

@@ -0,0 +1,22 @@

1+{-|

2+Module: Data.Aeson.TH

5+License: BSD3

6+Stability: experimental

7+Portability: portable

8+-}

10+module Main where

11+

12+{- |

13+

14+Here is a snippet:

15+

16+@

17+x = y + 2

18+@

19+

20+-}

21+

22+x = y + 2

data/examples/other/consequetive-pipe-comments-out.hsnew file+7

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

1+module Main where

3+-- | Foo.

5+-- | Bar.

6+bar :: Int

7+bar = 5

data/examples/other/consequetive-pipe-comments.hsnew file+8

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

1+module Main where

3+-- | Foo.

5+-- | Bar.

7+bar :: Int

8+bar = 5

data/examples/other/empty-haddock-out.hsnew file+5

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

1+module Main where

3+-- |

4+foo :: Int

5+foo = 5

data/examples/other/empty-haddock.hsnew file+6

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

1+module Main where

3+-- |

5+foo :: Int

6+foo = 5

data/examples/other/following-comment-last-0-out.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Another datatype...

24data D'

35-- ^ ...with two docstrings.

data/examples/other/following-comment-last-0.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Another datatype...

24data D'

35-- ^ ...with two docstrings.

data/examples/other/following-comment-last-1-out.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Another datatype...

24data D'

35 deriving (Show)

data/examples/other/following-comment-last-1.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Another datatype...

24data D'

35 deriving (Show)

data/examples/other/following-comment-last-2-out.hs+3

@@ -1,7 +1,10 @@

1+module Main where

13-- | Another datatype...

24data D'

35 deriving (Show)

46-- ^ ...with two docstrings.

68-- more

710data B

data/examples/other/following-comment-last-2.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Another datatype...

24data D'

35 deriving (Show)

data/examples/other/following-comment-last-3-out.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Another datatype...

24data D'

35-- ^ ...with two docstrings.

data/examples/other/following-comment-last-3.hs+2

@@ -1,3 +1,5 @@

1+module Main where

13-- | Another datatype...

24data D'

35-- ^ ...with two docstrings.

data/examples/other/overly-indented-out.hsnew file+11

@@ -0,0 +1,11 @@

1+tagCloudField ::

2+ -- | Destination key

3+ String ->

4+ -- | Smallest font size, in percent

5+ Double ->

6+ -- | Biggest font size, in percent

7+ Double ->

8+ -- | Input tags

9+ Tags ->

10+ -- | Context

11+ Context a

data/examples/other/overly-indented.hsnew file+10

@@ -0,0 +1,10 @@

1+tagCloudField :: String

2+ -- ^ Destination key

3+ -> Double

4+ -- ^ Smallest font size, in percent

5+ -> Double

6+ -- ^ Biggest font size, in percent

7+ -> Tags

8+ -- ^ Input tags

9+ -> Context a

10+ -- ^ Context

default.nix+19−2

@@ -20,8 +20,25 @@ let

2020 inherit pkgs;

2121 inherit haskellPackages;

2222 };

23+ # NOTE We have to exclude some directories for some packages because

24+ # Ormolu needs files to be parsable by Haddock which is not always the

25+ # case. For example some tests and examples do not parse.

26+ excludedHackageDirs = {

27+ "aws" = ["Examples"];

28+ "distributed-process" = ["benchmarks"];

29+ "esqueleto" = ["test"];

30+ "fay" = ["examples"];

31+ "postgrest" = ["test"];

32+ };

2333 ormolizedPackages = doCheck:

24− pkgs.lib.mapAttrs (_: v: ormolize { package = v; inherit doCheck; }) haskellPackages;

34+ pkgs.lib.mapAttrs (name: p: ormolize {

35+ package = p;

36+ inherit doCheck;

37+ excludedDirs =

38+ if builtins.hasAttr name excludedHackageDirs

39+ then excludedHackageDirs.${name}

40+ else [];

41+ }) haskellPackages;

2542in {

2643 ormolu = haskellPackages.ormolu;

2744 ormoluShell = haskellPackages.shellFor {

@@ -45,6 +62,7 @@ in {

4562 "distributed-process"

4663 "esqueleto"

4764 "fay"

65+ "hakyll"

4866 "haxl"

4967 "hedgehog"

5068 "hlint"

@@ -62,7 +80,6 @@ in {

6280

6381 # "Agda"

6482 # "brick"

65− # "hakyll"

6683 # "hledger"

6784 # "http-client"

6885 # "idris"

nix/ormolize/default.nix+13−3

@@ -1,5 +1,11 @@

1−{ pkgs, haskellPackages }: { package, doCheck ? false }:

2− pkgs.stdenv.mkDerivation {

1+{ pkgs

2+, haskellPackages

3+}:

4+{ package

5+, doCheck ? false

6+, excludedDirs ? []

7+}:

8+ pkgs.stdenv.mkDerivation rec {

39 name = package.name + "-ormolized";

410 src = package.src;

511 buildInputs = [

@@ -10,8 +16,12 @@

1016 pkgs.glibcLocales

1117 ];

1218 LANG = "en_US.UTF-8";

19+ excludedDirsRendered =

20+ if excludedDirs == []

21+ then ""

22+ else pkgs.lib.concatMapStringsSep " " (x: "-not -path './" + x + "/*'") excludedDirs;

1323 buildPhase = ''

14− find . -name '*.hs' -exec bash ${./ormolize.sh} {} \; 2> log.txt

24+ find . -name '*.hs' ${excludedDirsRendered} -exec bash ${./ormolize.sh} {} \; 2> log.txt

1525 cat log.txt

1626 '';

1727 inherit doCheck;

src/Ormolu/Diff.hs+11

@@ -18,6 +18,7 @@ import Data.Text (Text)

1818import GHC

1919import Ormolu.Imports (sortImports)

2020import Ormolu.Parser.Result

21+import Ormolu.Utils

2122import qualified Data.Text as T

2223import qualified FastString as GHC

2324import qualified SrcLoc as GHC

@@ -69,6 +70,7 @@ matchIgnoringSrcSpans = genericQuery

6970 `extQ` srcSpanEq

7071 `extQ` hsModuleEq

7172 `extQ` sourceTextEq

73+ `extQ` hsDocStringEq

7274 `ext2Q` forLocated)

7375 x y

7476 | otherwise = Different []

@@ -88,6 +90,15 @@ matchIgnoringSrcSpans = genericQuery

8890 sourceTextEq :: SourceText -> GenericQ Diff

8991 sourceTextEq _ _ = Same

9092

93+ hsDocStringEq :: HsDocString -> GenericQ Diff

94+ hsDocStringEq str0 str1' =

95+ case cast str1' :: Maybe HsDocString of

96+ Nothing -> Different []

97+ Just str1 ->

98+ if splitDocString str0 == splitDocString str1

99+ then Same

100+ else Different []

101+

91102 forLocated

92103 :: (Data e0, Data e1)

93104 => GenLocated e0 e1

src/Ormolu/Parser.hs+1−1

@@ -50,7 +50,7 @@ parseModule Config {..} path input' = liftIO $ do

5050 (dynFlags1, _, ws) <- GHC.parseDynamicFilePragma

5151 dynFlags0

5252 (dynOptionToLocatedStr <$> cfgDynOptions)

53− return (ws, dynFlags1)

53+ return (ws, GHC.setGeneralFlag' GHC.Opt_Haddock dynFlags1)

5454 -- NOTE It's better to throw this outside of 'ghcWrapper' because

5555 -- otherwise the exception will be wrapped as a GHC panic, which we don't

5656 -- want.

src/Ormolu/Parser/CommentStream.hs+15−10

@@ -62,8 +62,8 @@ mkCommentStream extraComments pstate =

6262 (comments, pragmas) = partitionEithers (partitionComments <$> rawComments)

6363 rawComments = mapMaybe toRealSpan $

6464 extraComments ++

65− (fmap unAnnotationComment <$> GHC.comment_q pstate) ++

66− concatMap (fmap (fmap unAnnotationComment) . snd)

65+ mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate) ++

66+ concatMap (mapMaybe (liftMaybe . fmap unAnnotationComment) . snd)

6767 (GHC.annotations_comments pstate)

6868

6969-- | Test whether a 'Comment' looks like a Haddock following a definition,

@@ -111,15 +111,20 @@ mkComment (L l s) = L l . Comment . fmap dropTrailing $

111111

112112-- | Get a 'String' from 'GHC.AnnotationComment'.

113113

114−unAnnotationComment :: GHC.AnnotationComment -> String

114+unAnnotationComment :: GHC.AnnotationComment -> Maybe String

115115unAnnotationComment = \case

116− GHC.AnnDocCommentNext s -> s

117− GHC.AnnDocCommentPrev s -> s

118− GHC.AnnDocCommentNamed s -> s

119− GHC.AnnDocSection _ s -> s

120− GHC.AnnDocOptions s -> s

121− GHC.AnnLineComment s -> s

122− GHC.AnnBlockComment s -> s

116+ GHC.AnnDocCommentNext _ -> Nothing -- @-- |@

117+ GHC.AnnDocCommentPrev _ -> Nothing -- @-- ^@

118+ GHC.AnnDocCommentNamed _ -> Nothing -- @-- $@

119+ GHC.AnnDocSection _ _ -> Nothing -- @-- *@

120+ GHC.AnnDocOptions s -> Just s

121+ GHC.AnnLineComment s -> Just s

122+ GHC.AnnBlockComment s -> Just s

123+

124+liftMaybe :: Located (Maybe a) -> Maybe (Located a)

125+liftMaybe = \case

126+ L _ Nothing -> Nothing

127+ L l (Just a) -> Just (L l a)

123128

124129toRealSpan :: Located a -> Maybe (RealLocated a)

125130toRealSpan (L (RealSrcSpan l) a) = Just (L l a)

src/Ormolu/Printer/Combinators.hs+6

@@ -22,7 +22,9 @@ module Ormolu.Printer.Combinators

2222 , located

2323 , located'

2424 , switchLayout

25+ , Layout (..)

2526 , vlayout

27+ , getLayout

2628 , breakpoint

2729 , breakpoint'

2830 -- ** Formatting lists

@@ -44,6 +46,10 @@ module Ormolu.Printer.Combinators

4446 , pragma

4547 -- ** Literals

4648 , comma

49+ -- ** Comments

50+ , HaddockStyle (..)

51+ , setLastCommentSpan

52+ , getLastCommentSpan

4753 )

4854where

4955

src/Ormolu/Printer/Comments.hs+25−10

@@ -30,7 +30,20 @@ spitPrecedingComments

3030 :: Data a

3131 => RealLocated a -- ^ AST element to attach comments to

3232 -> R ()

33−spitPrecedingComments = handleCommentSeries . spitPrecedingComment

33+spitPrecedingComments ref = do

34+ r <- getLastCommentSpan

35+ case r of

36+ Just (Just Pipe, _) ->

37+ -- We should not insert comments between pipe Haddock and the thing

38+ -- it's attached to.

39+ return ()

40+ _ -> do

41+ gotSome <- handleCommentSeries (spitPrecedingComment ref)

42+ when gotSome $ do

43+ -- Insert a blank line between the preceding comments and the thing

44+ -- after them if there was a blank line in the input.

45+ lastSpn <- fmap snd <$> getLastCommentSpan

46+ when (needsNewlineBefore (getLoc ref) lastSpn) newline

3447

3548-- | Output all comments following an element at given location.

3649

@@ -40,12 +53,12 @@ spitFollowingComments

4053 -> R ()

4154spitFollowingComments ref = do

4255 trimSpanStream (getLoc ref)

43− handleCommentSeries (spitFollowingComment ref)

56+ void $ handleCommentSeries (spitFollowingComment ref)

4457

4558-- | Output all remaining comments in the comment stream.

4659

4760spitRemainingComments :: R ()

48−spitRemainingComments = handleCommentSeries spitRemainingComment

61+spitRemainingComments = void $ handleCommentSeries spitRemainingComment

4962

5063----------------------------------------------------------------------------

5164-- Single-comment functions

@@ -119,12 +132,14 @@ handleCommentSeries

119132 :: (Maybe RealSrcSpan -> R Bool)

120133 -- ^ Given location of previous comment, output the next comment

121134 -- returning 'True' if we're done

122− -> R ()

123−handleCommentSeries f = go

135+ -> R Bool -- ^ Whether we printed any comments

136+handleCommentSeries f = go False

124137 where

125− go = do

126− done <- getLastCommentSpan >>= f

127− unless done go

138+ go gotSome = do

139+ done <- getLastCommentSpan >>= f . fmap snd

140+ if done

141+ then return gotSome

142+ else go True

128143

129144-- | Try to pop a comment using given predicate and if there is a comment

130145-- matching the predicate, print it out.

@@ -249,7 +264,7 @@ spitCommentNow spn comment = do

249264 . fmap (txt . T.pack)

250265 . coerce

251266 $ comment

252− setLastCommentSpan spn

267+ setLastCommentSpan Nothing spn

253268

254269-- | Output a 'Comment' at the end of correct line or after it depending on

255270-- 'CommentPosition'. Used for comments that may potentially follow on the

@@ -266,4 +281,4 @@ spitCommentPending position spn comment = do

266281 . fmap (registerPendingCommentLine position . T.pack)

267282 . coerce

268283 $ comment

269− setLastCommentSpan spn

284+ setLastCommentSpan Nothing spn

src/Ormolu/Printer/Internal.hs+26−6

@@ -23,6 +23,7 @@ module Ormolu.Printer.Internal

2323 , Layout (..)

2424 , enterLayout

2525 , vlayout

26+ , getLayout

2627 -- * Helpers for braces

2728 , useBraces

2829 , dontUseBraces

@@ -35,6 +36,7 @@ module Ormolu.Printer.Internal

3536 , popComment

3637 , getEnclosingSpan

3738 , withEnclosingSpan

39+ , HaddockStyle (..)

3840 , setLastCommentSpan

3941 , getLastCommentSpan

4042 -- * Annotations

@@ -104,7 +106,7 @@ data SC = SC

104106 -- atoms that can have comments attached to them

105107 , scRequestedDelimiter :: !RequestedDelimiter

106108 -- ^ Whether to output a space before the next output

107− , scLastCommentSpan :: !(Maybe RealSrcSpan)

109+ , scLastCommentSpan :: !(Maybe (Maybe HaddockStyle, RealSrcSpan))

108110 -- ^ Span of last output comment

109111 }

110112

@@ -355,11 +357,16 @@ vlayout

355357 -> R a -- ^ Multi line

356358 -> R a

357359vlayout sline mline = do

358− l <- R (asks rcLayout)

360+ l <- getLayout

359361 case l of

360362 SingleLine -> sline

361363 MultiLine -> mline

362364

365+-- | Get current 'Layout'.

366+

367+getLayout :: R Layout

368+getLayout = R (asks rcLayout)

369+

363370----------------------------------------------------------------------------

364371-- Special helpers for comment placement

365372

@@ -430,16 +437,29 @@ withEnclosingSpan spn (R m) = R (local modRC m)

430437 { rcEnclosingSpans = spn : rcEnclosingSpans rc

431438 }

432439

440+-- | Haddock string style.

441+

442+data HaddockStyle

443+ = Pipe -- ^ @-- |@

444+ | Caret -- ^ @-- ^@

445+ | Asterisk Int -- ^ @-- *@

446+ | Named String -- ^ @-- $@

447+

433448-- | Set span of last output comment.

434449

435−setLastCommentSpan :: RealSrcSpan -> R ()

436−setLastCommentSpan spn = R . modify $ \sc -> sc

437− { scLastCommentSpan = Just spn

450+setLastCommentSpan

451+ :: Maybe HaddockStyle

452+ -- ^ 'HaddockStyle' or 'Nothing' if it's a non-Haddock comment

453+ -> RealSrcSpan

454+ -- ^ Location of last printed comment

455+ -> R ()

456+setLastCommentSpan mhStyle spn = R . modify $ \sc -> sc

457+ { scLastCommentSpan = Just (mhStyle, spn)

438458 }

439459

440460-- | Get span of last output comment.

441461

442−getLastCommentSpan :: R (Maybe RealSrcSpan)

462+getLastCommentSpan :: R (Maybe (Maybe HaddockStyle, RealSrcSpan))

443463getLastCommentSpan = R (gets scLastCommentSpan)

444464

445465----------------------------------------------------------------------------

src/Ormolu/Printer/Meat/Common.hs+36−9

@@ -11,17 +11,21 @@ module Ormolu.Printer.Meat.Common

1111 , doesNotNeedExtraParens

1212 , p_qualName

1313 , p_infixDefHelper

14− , p_trailingCommaFor

14+ , p_hsDocString

15+ , p_hsDocName

1516 )

1617where

1718

1819import Control.Monad

1920import Data.List (isPrefixOf)

21+import Data.Maybe (isJust)

2022import GHC hiding (GhcPs, IE)

2123import Name (nameStableString)

2224import OccName (OccName (..))

2325import Ormolu.Printer.Combinators

26+import Ormolu.Utils

2427import RdrName (RdrName (..))

28+import qualified Data.Text as T

2529

2630-- | Data and type family style.

2731

@@ -141,13 +145,36 @@ p_infixDefHelper isInfix inci' name args =

141145 breakpoint

142146 inci' $ sitcc (sep breakpoint sitcc args)

143147

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

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

148+-- | Print a Haddock.

146149

147−p_trailingCommaFor

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

150+p_hsDocString

151+ :: HaddockStyle -- ^ Haddock style

152+ -> Bool -- ^ Finish the doc string with a newline

153+ -> LHsDocString -- ^ The doc string to render

149154 -> R ()

150−p_trailingCommaFor xs =

151− vlayout

152− (return ())

153− (unless (null xs) comma)

155+p_hsDocString hstyle needsNewline (L l str) = do

156+ goesAfterComment <- isJust <$> getLastCommentSpan

157+ -- Make sure the Haddock is separated by a newline from other comments.

158+ when goesAfterComment newline

159+ forM_ (zip (splitDocString str) (True : repeat False)) $ \(x, isFirst) -> do

160+ if isFirst

161+ then case hstyle of

162+ Pipe -> txt "-- |" >> space

163+ Caret -> txt "-- ^" >> space

164+ Asterisk n -> txt ("-- " <> T.replicate n "*") >> space

165+ Named name -> p_hsDocName name

166+ else newline >> txt "--" >> space

167+ unless (T.null x) (txt x)

168+ when needsNewline newline

169+ case l of

170+ UnhelpfulSpan _ ->

171+ -- It's often the case that the comment itself doesn't have a span

172+ -- attached to it and instead its location can be obtained from

173+ -- nearest enclosing span.

174+ getEnclosingSpan (const True) >>= mapM_ (setLastCommentSpan (Just hstyle))

175+ RealSrcSpan spn -> setLastCommentSpan (Just hstyle) spn

176+

177+-- | Print anchor of named doc section.

178+

179+p_hsDocName :: String -> R ()

180+p_hsDocName name = txt ("-- $" <> T.pack name)

src/Ormolu/Printer/Meat/Declaration.hs+21−3

@@ -12,6 +12,8 @@ module Ormolu.Printer.Meat.Declaration

1212 )

1313where

1414

15+import Data.List (sort)

16+import Data.List.NonEmpty (NonEmpty (..), (<|))

1517import GHC

1618import OccName (occNameFS)

1719import Ormolu.Printer.Combinators

@@ -28,13 +30,11 @@ import Ormolu.Printer.Meat.Declaration.Signature

2830import Ormolu.Printer.Meat.Declaration.Splice

2931import Ormolu.Printer.Meat.Declaration.Type

3032import Ormolu.Printer.Meat.Declaration.TypeFamily

31−import Data.List

3233import Ormolu.Printer.Meat.Declaration.Value

3334import Ormolu.Printer.Meat.Declaration.Warning

3435import Ormolu.Printer.Meat.Type

3536import Ormolu.Utils

3637import RdrName (rdrNameOcc)

37−import Data.List.NonEmpty (NonEmpty((:|)))

3838import qualified Data.List.NonEmpty as NE

3939

4040p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

@@ -57,6 +57,12 @@ p_hsDecls style decls = sepSemi id $

5757

5858groupDecls :: [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)]

5959groupDecls [] = []

60+groupDecls (l@(L _ DocNext) : xs) =

61+ -- If the first element is a doc string for next element, just include it

62+ -- in the next block:

63+ case groupDecls xs of

64+ [] -> [l :| []]

65+ (x:xs') -> (l <| x) : xs'

6066groupDecls (lhdr:xs) =

6167 let -- Pick the first decl as the group header

6268 hdr = unLoc lhdr

@@ -83,7 +89,12 @@ p_hsDecl style = \case

8389 AnnD NoExt x -> p_annDecl x

8490 RuleD NoExt x -> p_ruleDecls x

8591 SpliceD NoExt x -> p_spliceDecl x

86− DocD _ _ -> notImplemented "DocD"

92+ DocD NoExt docDecl ->

93+ case docDecl of

94+ DocCommentNext str -> p_hsDocString Pipe False (noLoc str)

95+ DocCommentPrev str -> p_hsDocString Caret False (noLoc str)

96+ DocCommentNamed name str -> p_hsDocString (Named name) False (noLoc str)

97+ DocGroup n str -> p_hsDocString (Asterisk n) False (noLoc str)

8798 RoleAnnotD NoExt x -> p_roleAnnot x

8899 XHsDecl _ -> notImplemented "XHsDecl"

89100

@@ -109,6 +120,7 @@ p_tyClDecl style = \case

109120 tcdMeths

110121 tcdATs

111122 tcdATDefs

123+ tcdDocs

112124 XTyClDecl {} -> notImplemented "XTyClDecl"

113125

114126p_instDecl :: FamilyStyle -> InstDecl GhcPs -> R ()

@@ -139,6 +151,8 @@ groupedDecls x y | Just ns <- isPragma x, Just ns' <- isPragma y = ns `intersect

139151groupedDecls x (TypeSignature ns) | Just ns' <- isPragma x = ns `intersects` ns'

140152groupedDecls (TypeSignature ns) x | Just ns' <- isPragma x = ns `intersects` ns'

141153groupedDecls (PatternSignature ns) (Pattern n) = n `elem` ns

154+groupedDecls DocNext _ = True

155+groupedDecls _ DocPrev = True

142156groupedDecls _ _ = False

143157

144158intersects :: Ord a => [a] -> [a] -> Bool

@@ -200,6 +214,10 @@ pattern FunctionBody n <- (funRdrNames -> Just n)

200214pattern PatternSignature n <- (patSigRdrNames -> Just n)

201215pattern WarningPragma n <- (warnSigRdrNames -> Just n)

202216

217+pattern DocNext, DocPrev :: HsDecl GhcPs

218+pattern DocNext <- (DocD NoExt (DocCommentNext _))

219+pattern DocPrev <- (DocD NoExt (DocCommentPrev _))

220+

203221sigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

204222sigRdrNames (SigD NoExt (TypeSig NoExt ns _)) = Just $ map unLoc ns

205223sigRdrNames (SigD NoExt (ClassOpSig NoExt _ ns _)) = Just $ map unLoc ns

src/Ormolu/Printer/Meat/Declaration/Class.hs+6−4

@@ -33,8 +33,9 @@ p_classDecl

3333 -> LHsBinds GhcPs

3434 -> [LFamilyDecl GhcPs]

3535 -> [LTyFamDefltEqn GhcPs]

36+ -> [LDocDecl]

3637 -> R ()

37−p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do

38+p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs cdocs = do

3839 let HsQTvs {..} = tvars

3940 variableSpans = getLoc <$> hsq_explicit

4041 signatureSpans = getLoc name : variableSpans

@@ -59,11 +60,12 @@ p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do

5960 let sigs = (getLoc &&& fmap (SigD NoExt)) <$> csigs

6061 vals = (getLoc &&& fmap (ValD NoExt)) <$> toList cdefs

6162 tyFams = (getLoc &&& fmap (TyClD NoExt . FamDecl NoExt)) <$> cats

63+ docs = (getLoc &&& fmap (DocD NoExt)) <$> cdocs

6264 tyFamDefs =

6365 ( getLoc &&& fmap (InstD NoExt . TyFamInstD NoExt . defltEqnToInstDecl)

6466 ) <$> catdefs

6567 allDecls =

66− snd <$> sortBy (comparing fst) (sigs <> vals <> tyFams <> tyFamDefs)

68+ snd <$> sortBy (comparing fst) (sigs <> vals <> tyFams <> tyFamDefs <> docs)

6769 unless (null allDecls) $ do

6870 space

6971 txt "where"

@@ -76,9 +78,9 @@ p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do

7678p_classContext :: LHsContext GhcPs -> R ()

7779p_classContext ctx = unless (null (unLoc ctx)) $ do

7880 located ctx p_hsContext

79− breakpoint

80− txt "=>"

8181 space

82+ txt "=>"

83+ breakpoint

8284

8385p_classFundeps :: [Located (FunDep (Located RdrName))] -> R ()

8486p_classFundeps fdeps = unless (null fdeps) $ do

src/Ormolu/Printer/Meat/Declaration/Data.hs+19−11

@@ -60,9 +60,10 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do

6060 breakpoint

6161 txt "="

6262 space

63− let s = vlayout (txt " | ") (newline >> txt "| ")

63+ let s = vlayout

64+ (space >> txt "|" >> space)

65+ (newline >> txt "|" >> space)

6466 sep s (sitcc . located' p_conDecl) dd_cons

65−

6667 unless (null $ unLoc dd_derivs) breakpoint

6768 inci . located dd_derivs $ \xs -> do

6869 sep newline (located' p_hsDerivingClause) xs

@@ -71,6 +72,7 @@ p_dataDecl _ _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"

7172p_conDecl :: ConDecl GhcPs -> R ()

7273p_conDecl = \case

7374 ConDeclGADT {..} -> do

75+ mapM_ (p_hsDocString Pipe True) con_doc

7476 case con_names of

7577 [] -> return ()

7678 (c:cs) -> do

@@ -79,29 +81,36 @@ p_conDecl = \case

7981 comma

8082 breakpoint

8183 sitcc $ sep (comma >> breakpoint) p_rdrName cs

82− breakpoint

84+ space

8385 inci $ do

8486 txt "::"

85− space

87+ let interArgBreak =

88+ if hasDocStrings (unLoc con_res_ty)

89+ then newline

90+ else breakpoint

91+ interArgBreak

8692 p_forallBndrs (hsq_explicit con_qvars)

93+ unless (null $ hsq_explicit con_qvars) interArgBreak

8794 forM_ con_mb_cxt p_lhsContext

8895 case con_args of

8996 PrefixCon xs -> do

9097 sep breakpoint (located' p_hsType) xs

9198 unless (null xs) $ do

92− breakpoint

93− txt "->"

9499 space

100+ txt "->"

101+ breakpoint

95102 RecCon l -> do

96103 located l p_conDeclFields

97104 unless (null $ unLoc l) $ do

98− breakpoint

99− txt "->"

100105 space

106+ txt "->"

107+ breakpoint

101108 InfixCon _ _ -> notImplemented "InfixCon"

102109 p_hsType (unLoc con_res_ty)

103110 ConDeclH98 {..} -> do

111+ mapM_ (p_hsDocString Pipe True) con_doc

104112 p_forallBndrs con_ex_tvs

113+ unless (null con_ex_tvs) breakpoint

105114 forM_ con_mb_cxt p_lhsContext

106115 case con_args of

107116 PrefixCon xs -> do

@@ -131,7 +140,6 @@ p_forallBndrs = \case

131140 space

132141 sep space (located' p_hsTyVarBndr) bndrs

133142 txt "."

134− space

135143

136144p_lhsContext

137145 :: LHsContext GhcPs

@@ -140,9 +148,9 @@ p_lhsContext = \case

140148 L _ [] -> pure ()

141149 ctx -> do

142150 located ctx p_hsContext

143− breakpoint

144− txt "=>"

145151 space

152+ txt "=>"

153+ breakpoint

146154

147155isGadt :: ConDecl GhcPs -> Bool

148156isGadt = \case

src/Ormolu/Printer/Meat/Declaration/Signature.hs+12−10

@@ -55,11 +55,14 @@ p_typeAscription

5555 :: LHsSigWcType GhcPs

5656 -> R ()

5757p_typeAscription HsWC {..} = do

58− breakpoint

58+ space

5959 inci $ do

6060 txt "::"

61− space

62− located (hsib_body hswc_body) p_hsType

61+ let t = hsib_body hswc_body

62+ if hasDocStrings (unLoc t)

63+ then newline

64+ else breakpoint

65+ located t p_hsType

6366p_typeAscription (XHsWildCardBndrs NoExt) = notImplemented "XHsWildCardBndrs"

6467

6568p_patSynSig

@@ -125,10 +128,10 @@ p_specSig name ts InlinePragma {..} = pragmaBraces $ do

125128 p_activation inl_act

126129 space

127130 p_rdrName name

131+ space

132+ txt "::"

128133 breakpoint

129− inci $ do

130− txt ":: "

131− sep (comma >> breakpoint) (located' p_hsType . hsib_body) ts

134+ inci $ sep (comma >> breakpoint) (located' p_hsType . hsib_body) ts

132135

133136p_inlineSpec :: InlineSpec -> R ()

134137p_inlineSpec = \case

@@ -185,11 +188,10 @@ p_completeSig cs' mty =

185188 pragma "COMPLETE" . inci $ do

186189 sitcc $ sep (comma >> breakpoint) p_rdrName cs

187190 forM_ mty $ \ty -> do

191+ space

192+ txt "::"

188193 breakpoint

189− inci $ do

190− txt "::"

191− space

192− p_rdrName ty

194+ inci (p_rdrName ty)

193195

194196p_sccSig :: Located (IdP GhcPs) -> Maybe (Located StringLiteral) -> R ()

195197p_sccSig loc literal = pragma "SCC" . inci $ do

src/Ormolu/Printer/Meat/Declaration/Type.hs+3−4

@@ -31,8 +31,7 @@ p_synDecl name fixity tvars t = do

3131 inci

3232 (p_rdrName name)

3333 (map (located' p_hsTyVarBndr) hsq_explicit)

34+ space

35+ txt "="

3436 breakpoint

35− inci $ do

36− txt "="

37− space

38− located t p_hsType

37+ inci (located t p_hsType)

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+3−3

@@ -40,7 +40,7 @@ p_famDecl style FamilyDecl {..} = do

4040 (located' p_hsTyVarBndr <$> hsq_explicit)

4141 let rsig = p_familyResultSigL (isJust fdInjectivityAnn) fdResultSig

4242 unless (isNothing rsig && isNothing fdInjectivityAnn) $

43− breakpoint

43+ space

4444 inci $ do

4545 sequence_ rsig

4646 when (isJust rsig && isJust fdInjectivityAnn) breakpoint

@@ -69,11 +69,11 @@ p_familyResultSigL injAnn l =

6969 NoSig NoExt -> Nothing

7070 KindSig NoExt k -> Just $ do

7171 if injAnn then txt "=" else txt "::"

72− space

72+ breakpoint

7373 located k p_hsType

7474 TyVarSig NoExt bndr -> Just $ do

7575 if injAnn then txt "=" else txt "::"

76− space

76+ breakpoint

7777 located bndr p_hsTyVarBndr

7878 XFamilyResultSig NoExt ->

7979 notImplemented "XFamilyResultSig"

src/Ormolu/Printer/Meat/Declaration/Value.hs+54−51

@@ -386,34 +386,30 @@ p_stmt' pretty = \case

386386 -- since pretty printing of relevant statements (e.g., in 'trS_stmts')

387387 -- is handled through 'gatherStmt'.

388388 case (trS_form, trS_by) of

389− (ThenForm, Nothing) -> located trS_using $ \x -> do

389+ (ThenForm, Nothing) -> do

390390 txt "then"

391391 breakpoint

392− inci (p_hsExpr x)

392+ inci $ located trS_using p_hsExpr

393393 (ThenForm, Just e) -> do

394− located trS_using $ \x -> do

395− txt "then"

396− breakpoint

397− inci (p_hsExpr x)

394+ txt "then"

398395 breakpoint

399− located e $ \x -> do

400− txt "by"

401− breakpoint

402− inci (p_hsExpr x)

403− (GroupForm, Nothing) -> located trS_using $ \x -> do

396+ inci $ located trS_using p_hsExpr

397+ breakpoint

398+ txt "by"

399+ breakpoint

400+ inci $ located e p_hsExpr

401+ (GroupForm, Nothing) -> do

404402 txt "then group using"

405403 breakpoint

406− inci (p_hsExpr x)

404+ inci $ located trS_using p_hsExpr

407405 (GroupForm, Just e) -> do

408− located e $ \x -> do

409− txt "then group by"

410− breakpoint

411− inci (p_hsExpr x)

406+ txt "then group by"

412407 breakpoint

413− located trS_using $ \x -> do

414− txt "using"

415− breakpoint

416− inci (p_hsExpr x)

408+ inci $ located e p_hsExpr

409+ breakpoint

410+ txt "using"

411+ breakpoint

412+ inci $ located trS_using p_hsExpr

417413 RecStmt {..} -> do

418414 txt "rec"

419415 space

@@ -450,7 +446,7 @@ p_hsLocalBinds = \case

450446 -- NOTE When in a single-line layout, there is a chance that the inner

451447 -- elements will also contain semicolons and they will confuse the

452448 -- parser. so we request braces around every element except the last.

453− br <- vlayout (return useBraces) (return id)

449+ br <- layoutToBraces <$> getLayout

454450 sitcc $ sepSemi

455451 (\(m, i) -> (if m then br else id) $ p_item i)

456452 (markInit $ sortOn ssStart items)

@@ -623,7 +619,7 @@ p_hsExpr' s = \case

623619 let doBody header = do

624620 txt header

625621 breakpoint

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

622+ ub <- layoutToBraces <$> getLayout

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

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

629625 let p_parBody = sep

@@ -685,10 +681,10 @@ p_hsExpr' s = \case

685681 rupd_flds

686682 ExprWithTySig affix x -> sitcc $ do

687683 located x p_hsExpr

684+ space

685+ txt "::"

688686 breakpoint

689687 inci $ do

690− txt "::"

691− space

692688 let HsWC {..} = affix

693689 HsIB {..} = hswc_body

694690 located hsib_body p_hsType

@@ -771,23 +767,25 @@ p_hsExpr' s = \case

771767

772768p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()

773769p_patSynBind PSB {..} = do

774− let rhs = case psb_dir of

775− Unidirectional -> do

776− txt "<-"

777− space

778− located psb_def p_pat

779− ImplicitBidirectional -> do

780− txt "="

781− space

782− located psb_def p_pat

783− ExplicitBidirectional mgroup -> do

784− txt "<-"

785− space

786− located psb_def p_pat

787− newline

788− txt "where"

789− newline

790− inci (p_matchGroup (Function psb_id) mgroup)

770+ let rhs = do

771+ space

772+ case psb_dir of

773+ Unidirectional -> do

774+ txt "<-"

775+ breakpoint

776+ located psb_def p_pat

777+ ImplicitBidirectional -> do

778+ txt "="

779+ breakpoint

780+ located psb_def p_pat

781+ ExplicitBidirectional mgroup -> do

782+ txt "<-"

783+ breakpoint

784+ located psb_def p_pat

785+ newline

786+ txt "where"

787+ newline

788+ inci (p_matchGroup (Function psb_id) mgroup)

791789 txt "pattern"

792790 case psb_args of

793791 PrefixCon xs -> do

@@ -797,7 +795,6 @@ p_patSynBind PSB {..} = do

797795 switchLayout (getLoc <$> xs) $ do

798796 unless (null xs) breakpoint

799797 sitcc (sep breakpoint p_rdrName xs)

800− breakpoint

801798 rhs

802799 RecCon xs -> do

803800 space

@@ -807,7 +804,6 @@ p_patSynBind PSB {..} = do

807804 unless (null xs) breakpoint

808805 braces N . sitcc $

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

810− breakpoint

811807 rhs

812808 InfixCon l r -> do

813809 switchLayout [getLoc l, getLoc r] $ do

@@ -818,9 +814,7 @@ p_patSynBind PSB {..} = do

818814 p_rdrName psb_id

819815 space

820816 p_rdrName r

821− inci $ do

822− breakpoint

823− rhs

817+ inci rhs

824818p_patSynBind (XPatSynBind NoExt) = notImplemented "XPatSynBind"

825819

826820p_pat :: Pat GhcPs -> R ()

@@ -1051,6 +1045,14 @@ p_stringLit src =

10511045----------------------------------------------------------------------------

10521046-- Helpers

10531047

1048+-- | Return the wrapping function controlling the use of braces according to

1049+-- the current layout.

1050+

1051+layoutToBraces :: Layout -> R () -> R ()

1052+layoutToBraces = \case

1053+ SingleLine -> useBraces

1054+ MultiLine -> id

1055+

10541056-- | Append each element in both lists with semigroups. If one list is shorter

10551057-- than the other, return the rest of the longer list unchanged.

10561058

@@ -1159,11 +1161,12 @@ p_exprOpTree s (OpBranch x op y) = do

11591161 opWrapper = case unLoc op of

11601162 EWildPat NoExt -> backticks

11611163 _ -> id

1162− ub <- vlayout

1163− (return useBraces)

1164− (return $ case placement of

1165− Hanging -> useBraces

1166− Normal -> dontUseBraces)

1164+ layout <- getLayout

1165+ let ub = case layout of

1166+ SingleLine -> useBraces

1167+ MultiLine -> case placement of

1168+ Hanging -> useBraces

1169+ Normal -> dontUseBraces

11671170 switchLayout [opTreeLoc x] $

11681171 ub $ p_exprOpTree s x

11691172 placeHanging placement $ do

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

@@ -24,8 +24,8 @@ p_hsmodExports [] = do

2424 txt ")"

2525p_hsmodExports xs =

2626 parens N . sitcc $ do

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

28− p_trailingCommaFor xs

27+ layout <- getLayout

28+ sep breakpoint (sitcc . located' (uncurry (p_lie layout))) (attachPositions xs)

2929

3030p_hsmodImport :: ImportDecl GhcPs -> R ()

3131p_hsmodImport ImportDecl {..} = do

@@ -60,21 +60,25 @@ p_hsmodImport ImportDecl {..} = do

6060 Just (_, (L _ xs)) -> do

6161 breakpoint

6262 parens N . sitcc $ do

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

64− p_trailingCommaFor xs

63+ layout <- getLayout

64+ sep breakpoint (sitcc . located' (uncurry (p_lie layout))) (attachPositions xs)

6565 newline

6666p_hsmodImport (XImportDecl NoExt) = notImplemented "XImportDecl"

6767

68−p_lie :: IE GhcPs -> R ()

69−p_lie = \case

70− IEVar NoExt l1 -> located l1 p_ieWrappedName

71− IEThingAbs NoExt l1 -> located l1 p_ieWrappedName

68+p_lie :: Layout -> (Int, Int) -> IE GhcPs -> R ()

69+p_lie encLayout (i, totalItems) = \case

70+ IEVar NoExt l1 -> do

71+ located l1 p_ieWrappedName

72+ p_comma

73+ IEThingAbs NoExt l1 -> do

74+ located l1 p_ieWrappedName

75+ p_comma

7276 IEThingAll NoExt l1 -> do

7377 located l1 p_ieWrappedName

7478 space

7579 txt "(..)"

80+ p_comma

7681 IEThingWith NoExt l1 w xs _ -> sitcc $ do

77− -- XXX I have no idea what field labels are in this context.

7882 located l1 p_ieWrappedName

7983 breakpoint

8084 inci $ do

@@ -87,9 +91,29 @@ p_lie = \case

8791 IEWildcard n ->

8892 let (before, after) = splitAt n names

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

90− IEModuleContents NoExt l1 -> located l1 p_hsmodName

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

92− IEGroup NoExt _ _ -> return ()

93− IEDoc NoExt _ -> return ()

94− IEDocNamed NoExt _ -> return ()

94+ p_comma

95+ IEModuleContents NoExt l1 -> do

96+ located l1 p_hsmodName

97+ p_comma

98+ IEGroup NoExt n str -> do

99+ unless (i == 0) newline

100+ p_hsDocString (Asterisk n) False (noLoc str)

101+ IEDoc NoExt str ->

102+ p_hsDocString Pipe False (noLoc str)

103+ IEDocNamed NoExt str -> p_hsDocName str

95104 XIE NoExt -> notImplemented "XIE"

105+ where

106+ p_comma =

107+ case encLayout of

108+ SingleLine -> unless (i + 1 == totalItems) comma

109+ MultiLine -> comma

110+

111+-- | Attach positions to 'Located' things in a list.

112+

113+attachPositions

114+ :: [Located a]

115+ -> [Located ((Int, Int), a)]

116+attachPositions xs =

117+ let f i (L l x) = L l ((i, n), x)

118+ n = length xs

119+ in zipWith f [0..] xs

src/Ormolu/Printer/Meat/Module.hs+1

@@ -32,6 +32,7 @@ p_hsModule pragmas (L moduleSpan HsModule {..}) = do

3232 switchLayout spans' $ do

3333 p_pragmas pragmas

3434 newline

35+ forM_ hsmodHaddockModHeader (p_hsDocString Pipe True)

3536 case hsmodName of

3637 Nothing -> return ()

3738 Just hsmodName' -> do

src/Ormolu/Printer/Meat/Type.hs+49−32

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

77module Ormolu.Printer.Meat.Type

88 ( p_hsType

9+ , hasDocStrings

910 , p_hsContext

1011 , p_hsTyVarBndr

1112 , p_conDeclFields

@@ -13,8 +14,8 @@ module Ormolu.Printer.Meat.Type

1314 )

1415where

1516

16−import GHC

1717import BasicTypes

18+import GHC

1819import Ormolu.Printer.Combinators

1920import Ormolu.Printer.Meat.Common

2021import Ormolu.Printer.Operators

@@ -22,23 +23,25 @@ import Ormolu.Utils

2223import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice, p_stringLit)

2324

2425p_hsType :: HsType GhcPs -> R ()

25−p_hsType = \case

26+p_hsType t = p_hsType' (hasDocStrings t) t

27+

28+p_hsType' :: Bool -> HsType GhcPs -> R ()

29+p_hsType' multilineArgs = \case

2630 HsForAllTy NoExt bndrs t -> do

2731 txt "forall "

2832 sep space (located' p_hsTyVarBndr) bndrs

2933 txt "."

30− breakpoint

31− vlayout (return ()) (txt " ")

32− p_hsType (unLoc t)

34+ interArgBreak

35+ p_hsType' multilineArgs (unLoc t)

3336 HsQualTy NoExt qs t -> do

3437 located qs p_hsContext

35− breakpoint

36− txt "=>"

3738 space

39+ txt "=>"

40+ interArgBreak

3841 case unLoc t of

39− HsQualTy {} -> p_hsType (unLoc t)

40− HsFunTy {} -> p_hsType (unLoc t)

41− _ -> located t p_hsType

42+ HsQualTy {} -> p_hsTypeR (unLoc t)

43+ HsFunTy {} -> p_hsTypeR (unLoc t)

44+ _ -> located t p_hsTypeR

4245 HsTyVar NoExt p n -> do

4346 case p of

4447 Promoted -> do

@@ -54,13 +57,14 @@ p_hsType = \case

5457 inci (located x p_hsType)

5558 HsFunTy NoExt x y@(L _ y') -> do

5659 located x p_hsType

57− breakpoint

58− txt "->"

5960 space

61+ txt "->"

62+ interArgBreak

6063 case y' of

61− HsFunTy{} -> p_hsType y'

62− _ -> located y p_hsType

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

64+ HsFunTy{} -> p_hsTypeR y'

65+ _ -> located y p_hsTypeR

66+ HsListTy NoExt t ->

67+ located t (brackets N . p_hsType)

6468 HsTupleTy NoExt tsort xs ->

6569 let parens' =

6670 case tsort of

@@ -86,23 +90,23 @@ p_hsType = \case

8690 parens N (located t p_hsType)

8791 HsIParamTy NoExt n t -> sitcc $ do

8892 located n atom

93+ space

94+ txt "::"

8995 breakpoint

90− inci $ do

91− txt "::"

92− space

93− located t p_hsType

96+ inci (located t p_hsType)

9497 HsStarTy NoExt _ -> txt "*"

9598 HsKindSig NoExt t k ->

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

97100 parens N . sitcc $ do

98101 located t p_hsType

99102 space -- FIXME

100− inci $ do

101− txt "::"

102− space

103− located k p_hsType

103+ txt "::"

104+ space

105+ inci (located k p_hsType)

104106 HsSpliceTy NoExt splice -> p_hsSplice splice

105− HsDocTy NoExt _ _ -> error "HsDocTy"

107+ HsDocTy NoExt t str -> do

108+ p_hsDocString Pipe True str

109+ located t p_hsType

106110 HsBangTy NoExt (HsSrcBang _ u s) t -> do

107111 case u of

108112 SrcUnpack -> txt "{-# UNPACK #-}" >> space

@@ -145,6 +149,20 @@ p_hsType = \case

145149 HsExplicitListTy _ _ _ -> True

146150 HsExplicitTupleTy _ _ -> True

147151 _ -> False

152+ interArgBreak =

153+ if multilineArgs

154+ then newline

155+ else breakpoint

156+ p_hsTypeR = p_hsType' multilineArgs

157+

158+-- | Return 'True' if at least one argument in 'HsType' has a doc string

159+-- attached to it.

160+

161+hasDocStrings :: HsType GhcPs -> Bool

162+hasDocStrings = \case

163+ HsDocTy _ _ _ -> True

164+ HsFunTy _ (L _ x) (L _ y) -> hasDocStrings x || hasDocStrings y

165+ _ -> False

148166

149167p_hsContext :: HsContext GhcPs -> R ()

150168p_hsContext = \case

@@ -159,11 +177,10 @@ p_hsTyVarBndr = \case

159177 p_rdrName x

160178 KindedTyVar NoExt l k -> parens N $ do

161179 located l atom

180+ space

181+ txt "::"

162182 breakpoint

163− inci $ do

164− txt "::"

165− space

166− located k p_hsType

183+ inci (located k p_hsType)

167184 XTyVarBndr NoExt -> notImplemented "XTyVarBndr"

168185

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

@@ -172,14 +189,14 @@ p_conDeclFields xs = braces N . sitcc $

172189

173190p_conDeclField :: ConDeclField GhcPs -> R ()

174191p_conDeclField ConDeclField {..} = do

192+ mapM_ (p_hsDocString Pipe True) cd_fld_doc

175193 sitcc $ sep (comma >> breakpoint)

176194 (located' (p_rdrName . rdrNameFieldOcc))

177195 cd_fld_names

196+ space

197+ txt "::"

178198 breakpoint

179− sitcc . inci $ do

180− txt "::"

181− space

182− p_hsType (unLoc cd_fld_type)

199+ sitcc . inci $ p_hsType (unLoc cd_fld_type)

183200p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"

184201

185202tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)

src/Ormolu/Utils.hs+44−1

@@ -1,18 +1,24 @@

11-- | Random utilities used by the code.

3−{-# LANGUAGE LambdaCase #-}

3+{-# LANGUAGE LambdaCase #-}

4+{-# LANGUAGE OverloadedStrings #-}

56module Ormolu.Utils

67 ( combineSrcSpans'

78 , isModule

89 , notImplemented

910 , showOutputable

11+ , splitDocString

1012 )

1113where

1214

1315import Data.Data (Data, showConstr, toConstr)

16+import Data.List (dropWhileEnd)

1417import Data.List.NonEmpty (NonEmpty (..))

18+import Data.Text (Text)

19+import HsDoc (HsDocString, unpackHDS)

1520import SrcLoc

21+import qualified Data.Text as T

1622import qualified Outputable as GHC

1723

1824-- | Combine all source spans from the given list.

@@ -34,3 +40,40 @@ notImplemented msg = error $ "not implemented yet: " ++ msg

3440

3541showOutputable :: GHC.Outputable o => o -> String

3642showOutputable = GHC.showSDocUnsafe . GHC.ppr

43+

44+-- | Split and normalize a doc string. The result is a list of lines that

45+-- make up the comment.

46+

47+splitDocString :: HsDocString -> [Text]

48+splitDocString docStr =

49+ case r of

50+ [] -> [""]

51+ _ -> r

52+ where

53+ r = fmap escapeLeadingDollar

54+ . dropPaddingSpace

55+ . dropWhileEnd T.null

56+ . fmap (T.stripEnd . T.pack)

57+ . lines

58+ $ unpackHDS docStr

59+ -- We cannot have the first character to be a dollar because in that

60+ -- case it'll be a parse error (apparently collides with named docs

61+ -- syntax @-- $name@ somehow).

62+ escapeLeadingDollar txt =

63+ case T.uncons txt of

64+ Just ('$', _) -> T.cons '\\' txt

65+ _ -> txt

66+ dropPaddingSpace xs =

67+ case dropWhile T.null xs of

68+ [] -> []

69+ (x:_) ->

70+ let leadingSpace txt = case T.uncons txt of

71+ Just (' ', _) -> True

72+ _ -> False

73+ dropSpace txt =

74+ if leadingSpace txt

75+ then T.drop 1 txt

76+ else txt

77+ in if leadingSpace x

78+ then dropSpace <$> xs

79+ else xs