master..991bf8e · ormolu

.buildkite/pipeline.yml+2−2

since splitsnapshots

unifiedsplit

@@ -3,9 +3,9 @@ steps:

3 command: |

4 nix-build --keep-going --no-out-link --argstr ormoluCompiler ghc865

5 timeout: 100

6− - label: Build and test with GHC 8.8.4

6+ - label: Build and test with GHC 8.8.3

7 command: |

8− nix-build --keep-going --no-out-link --argstr ormoluCompiler ghc884

8+ nix-build --keep-going --no-out-link --argstr ormoluCompiler ghc883

9 timeout: 100

10 - label: Build and test with GHC 8.10.1

11 command: |

.github/workflows/binaries.ymldeleted−39

@@ -1,39 +0,0 @@

1−name: Build binaries

2−on:

3− release:

4− types: [published]

5−jobs:

6− build:

7− strategy:

8− fail-fast: false

9− matrix:

10− os: [ubuntu-latest, macOS-latest, windows-latest]

11− runs-on: ${{ matrix.os }}

12− steps:

13− - uses: actions/checkout@v2

14− - uses: actions/setup-haskell@v1

15− if: runner.os != 'Linux'

16− with:

17− ghc-version: '8.10.1'

18− cabal-version: '3.2'

19− - name: Build Linux binary

20− if: runner.os == 'Linux'

21− run: |

22− docker run \

23− -v $(pwd):/mnt -w /mnt \

24− utdemir/ghc-musl:v14-ghc8101 \

25− bash .github/workflows/build.sh

26− - name: Build ${{ runner.os }} binary

27− if: runner.os != 'Linux'

28− shell: bash

29− run: |

30− cabal build exe:ormolu

31− cp $(find dist-newstyle $ -name ormolu -o -name ormolu.exe $ -type f) ormolu

32− - uses: actions/upload-release-asset@v1

33− env:

34− GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}

35− with:

36− upload_url: ${{ github.event.release.upload_url }}

37− asset_path: ormolu

38− asset_name: ormolu-${{ runner.os }}

39− asset_content_type: application/octet-stream

.github/workflows/build.shdeleted−7

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

1−set -e

2−

3−cabal update

4−cabal build exe:ormolu --enable-executable-static --ghc-options="-split-sections"

5−

6−cp $(find dist-newstyle -name ormolu -type f) .

7−strip -s ormolu

CHANGELOG.md+1−83

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

1## Unreleased

2

3−* Ormolu no longer overwrites already formatted files. [PR

4− 649](https://github.com/tweag/ormolu/pull/649).

5−

6−## Ormolu 0.1.2.0

7−

8−* Fixed the bug when comments in different styles got glued together after

9− formatting. [Issue 589](https://github.com/tweag/ormolu/issues/589).

10−

11−* Added `-i` as a shortcut for `--mode inplace`. [Issue

12− 467](https://github.com/tweag/ormolu/issues/467).

13−

14−* Improved grouping of top-level declarations. [Issue

15− 466](https://github.com/tweag/ormolu/issues/466).

16−

17−## Ormolu 0.1.1.0

18−

19−* Imports in a import lists are now normalized: duplicate imports are

20− combined/eliminated intelligently.

21−

22−* Import declarations that can be merged are now automatically merged.

23− [Issue 414](https://github.com/tweag/ormolu/issues/414).

24−

25−* The magic comments for disabling and enabling Ormolu now can encompass any

26− fragment of code provided that the remaining code after exclusion of the

27− disabled part is still syntactically correct. [Issue

28− 601](https://github.com/tweag/ormolu/issues/601).

29−

30−* Improved sorting of operators in imports. [Issue

31− 602](https://github.com/tweag/ormolu/issues/602).

32−

33−* Fixed a bug related to trailing space in multiline comments in certain

34− cases. [Issue 603](https://github.com/tweag/ormolu/issues/602).

35−

36−* Added support for formatting linked lists with `(:)` as line terminator.

37− [Issue 478](https://github.com/tweag/ormolu/issues/478).

38−

39−* Fixed rendering of function arguments in multiline layout. [Issue

40− 609](https://github.com/tweag/ormolu/issues/609).

41−

42−* Blank lines between definitions in `let` and `while` bindings are now

43− preserved. [Issue 554](https://github.com/tweag/ormolu/issues/554).

44−

45−* Fixed the bug when type applications stuck to the `$` of TH splices that

46− followed them. [Issue 613](https://github.com/tweag/ormolu/issues/613).

47−

48−* Improved region formatting so that indented fragments—such as definitions

49− inside of `where` clauses—can be formatted. [Issue

50− 572](https://github.com/tweag/ormolu/issues/572).

51−

52−* Fixed the bug related to the de-association of pragma comments. [Issue

53− 619](https://github.com/tweag/ormolu/issues/619).

54−

55−## Ormolu 0.1.0.0

56−

57* Fixed rendering of type signatures concerning several identifiers. [Issue

3* Fixed rendering of type signatures concerning several identifiers. [Issue

58 566](https://github.com/tweag/ormolu/issues/566).

4 566](https://github.com/tweag/ormolu/issues/566).

59

5

60* Fixed an idempotence issue with inline comments in tuples and parentheses.

6* Fixed an idempotence issue with inline comments in tuples and parentheses.

61 [Issue 450](https://github.com/tweag/ormolu/issues/450).

7 [Issue 450](https://github.com/tweag/ormolu/issues/450).

62

8

63−* Fixed an idempotence issue when certain comments were picked up as

9+* Fixed an idempotence issue when certain comments where picked up as

64 “continuation” of a series of comments [Issue

10 “continuation” of a series of comments [Issue

65 449](https://github.com/tweag/ormolu/issues/449).

11 449](https://github.com/tweag/ormolu/issues/449).

66

12

67−* Fixed an idempotence issue related to different indentation levels in a

68− comment series. [Issue 512](https://github.com/tweag/ormolu/issues/512).

69−

70−* Fixed an idempotence issue related to comments which may happen to be

71− separated from the elements they are attached to by the equality sign.

72− [Issue 340](https://github.com/tweag/ormolu/issues/340).

73−

74−* Fixed an idempotence issue with type synonym and data declarations where

75− the type has a Haddock. [Issue

76− 578](https://github.com/tweag/ormolu/issues/578).

77−

78−* Fix the false positive about AST differences in presence of comments with

79− multiple blank lines in a row. [Issue

80− 518](https://github.com/tweag/ormolu/issues/518).

81−

82−* Fixed rendering of comments around if expressions. [Issue

83− 458](https://github.com/tweag/ormolu/issues/458).

84−

85−* Unnamed fields of data constructors are now documented using the `-- ^`

86− syntax. [Issue 445](https://github.com/tweag/ormolu/issues/445) and [Issue

87− 428](https://github.com/tweag/ormolu/issues/428).

88−

89−* Fixed non-idempotent transformation of partly documented data definition.

90− [Issue 590](https://github.com/tweag/ormolu/issues/590).

91−

92−* Fixed an idempotence issue related to operators. [Issue

93− 522](https://github.com/tweag/ormolu/issues/522).

94−

95* Renamed the `--check-idempotency` flag to `--check-idempotence`.

13* Renamed the `--check-idempotency` flag to `--check-idempotence`.

96 Apparently only the latter is correct.

14 Apparently only the latter is correct.

97

15

README.md+11−21

@@ -22,7 +22,7 @@ the following goals in mind:

22* That formatting style aims to result in minimal diffs while still

23 remaining very close to “conventional” Haskell formatting people use.

24* Choose a style compatible with modern dialects of Haskell. As new Haskell

25− extensions enter broad use, we may change the style to accommodate them.

25+ extensions enter broad use, we may change the style to accomodate them.

26* Idempotence: formatting already formatted code doesn't change it.

27* Be well-tested and robust to the point that it can be used in large

28 projects without exposing unfortunate, disappointing bugs here and there.

@@ -45,12 +45,11 @@ Alternatively, `stack` could be used with a `stack.yaml` file as follows.

45

46```console

47$ cat stack.yaml

48−resolver: lts-16.0

48+resolver: lts-14.3

49packages:

50- '.'

51

52−$ stack build # to build

52+$ stack build

53−$ stack install # to install

54```

53```

55

54

56To use Ormolu directly from GitHub with Nix, this snippet may come in handy:

55To use Ormolu directly from GitHub with Nix, this snippet may come in handy:

@@ -130,6 +129,14 @@ independent top-level definitions.

130 criterion than just being valid Haskell modules.

129 criterion than just being valid Haskell modules.

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

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

132

131

132+## Editor integration

133+

134+We know of the following editor integrations:

135+

136+* [Emacs][emacs-package]

137+* [VS Code][vs-code-plugin]

138+* vim: [neoformat][neoformat], [vim-ormolu][vim-ormolu]

139+

133## Running on Hackage

140## Running on Hackage

134

141

135It's possible to try Ormolu on arbitrary packages from Hackage. For that

142It's possible to try Ormolu on arbitrary packages from Hackage. For that

@@ -144,22 +151,6 @@ also contain formatted `.hs` files for inspection and original inputs with

144`.hs-original` extension (those are with CPP dropped, exactly what is fed

151`.hs-original` extension (those are with CPP dropped, exactly what is fed

145into Ormolu).

152into Ormolu).

146

153

147−## Editor integration

148−

149−We know of the following editor integrations:

150−

151−* [Emacs][emacs-package]

152−* [VS Code][vs-code-plugin]

153−* vim: [neoformat][neoformat], [vim-ormolu][vim-ormolu]

154−

155−## Arch Linux

156−

157−To install Ormolu on Arch Linux, one can use [the package on AUR][aur]:

158−

159−```console

160−yay -S ormolu

161−```

162−

163## Contributing

154## Contributing

164

155

165See [CONTRIBUTING.md][contributing].

156See [CONTRIBUTING.md][contributing].

178[vs-code-plugin]: https://marketplace.visualstudio.com/items?itemName=sjurmillidahl.ormolu-vscode

169[vs-code-plugin]: https://marketplace.visualstudio.com/items?itemName=sjurmillidahl.ormolu-vscode

179[vim-ormolu]: https://github.com/sdiehl/vim-ormolu

170[vim-ormolu]: https://github.com/sdiehl/vim-ormolu

180[neoformat]: https://github.com/sbdchd/neoformat

171[neoformat]: https://github.com/sbdchd/neoformat

181−[aur]: https://aur.archlinux.org/packages/ormolu

app/Main.hs+13−23

@@ -8,7 +8,6 @@ module Main (main) where

8

9import Control.Exception (SomeException, displayException, try)

10import Control.Monad

11−import Data.Bool (bool)

12import Data.Either (lefts)

11import Data.Either (lefts)

13import Data.List (intercalate, sort)

12import Data.List (intercalate, sort)

14import qualified Data.Text.IO as TIO

13import qualified Data.Text.IO as TIO

@@ -61,19 +60,15 @@ formatOne mode config = \case

61 -- 101 is different from all the other exit codes we already use.

60 -- 101 is different from all the other exit codes we already use.

62 exitWith (ExitFailure 101)

61 exitWith (ExitFailure 101)

63 Just inputFile -> do

62 Just inputFile -> do

64− originalInput <- TIO.readFile inputFile

65− formattedInput <- ormoluFile config inputFile

63+ r <- ormoluFile config inputFile

66 case mode of

64 case mode of

67 Stdout ->

65 Stdout ->

68− TIO.putStr formattedInput

66+ TIO.putStr r

69− InPlace -> do

67+ InPlace ->

70− -- Only write when the contents have changed, in order to avoid

71− -- updating the modified timestamp if the file was already correctly

72− -- formatted.

73− when (formattedInput /= originalInput) $

74− TIO.writeFile inputFile formattedInput

68+ TIO.writeFile inputFile r

75 Check -> do

69 Check -> do

76− when (formattedInput /= originalInput) $

70+ r' <- TIO.readFile inputFile

71+ when (r /= r') $

77 -- 100 is different to all the other exit code that are emitted

72 -- 100 is different to all the other exit code that are emitted

78 -- either from an 'OrmoluException' or from 'error' and

73 -- either from an 'OrmoluException' or from 'error' and

79 -- 'notImplemented'.

74 -- 'notImplemented'.

@@ -139,18 +134,13 @@ optsParserInfo =

139optsParser :: Parser Opts

134optsParser :: Parser Opts

140optsParser =

135optsParser =

141 Opts

136 Opts

142− <$> ( (fmap (bool Stdout InPlace) . switch . mconcat)

143− [ short 'i',

144− help "A shortcut for --mode inplace"

145− ]

146− <|> (option parseMode . mconcat)

137+ <$> (option parseMode . mconcat)

147− [ long "mode",

138+ [ long "mode",

148− short 'm',

139+ short 'm',

149− metavar "MODE",

140+ metavar "MODE",

150− value Stdout,

141+ value Stdout,

151− help "Mode of operation: 'stdout' (default), 'inplace', or 'check'"

142+ help "Mode of operation: 'stdout' (default), 'inplace', or 'check'"

152− ]

143+ ]

153− )

154 <*> configParser

144 <*> configParser

155 <*> (many . strArgument . mconcat)

145 <*> (many . strArgument . mconcat)

156 [ metavar "FILE",

146 [ metavar "FILE",

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

@@ -8,7 +8,7 @@ data Foo a where

8 Foo ::

9 forall a b.

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

11− -- bar

11+ -- bar

12 a ->

13 b ->

14 Foo 'Int

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

@@ -5,6 +5,6 @@ data Foo

5 = Foo

6 Bar

7 (Set Baz) -- and here we go

8− -- and that's it

8+ -- and that's it

9 Text

10 deriving (Eq)

data/examples/declaration/data/partly-documented-out.hsdeleted−5

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

1−data Optimisation

2− = PETransform

3− | -- | partial eval and associated transforms

4− GeneralisedNatHack

5− deriving (Show, Eq, Generic)

data/examples/declaration/data/partly-documented.hsdeleted−2

@@ -1,2 +0,0 @@

1−data Optimisation = PETransform | GeneralisedNatHack -- ^ partial eval and associated transforms

2− deriving (Show, Eq, Generic)

data/examples/declaration/data/unnamed-field-comment-0-out.hsdeleted−7

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

1−data Foo

2− = -- | Bar

3− Bar

4− Field1

5− -- ^ Field 1

6− Field2

7− -- ^ Field 2

data/examples/declaration/data/unnamed-field-comment-0.hsdeleted−5

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

1−data Foo

2− = -- | Bar

3− Bar

4− Field1 -- ^ Field 1

5− Field2 -- ^ Field 2

data/examples/declaration/data/unnamed-field-comment-1-out.hsdeleted−5

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

1−data X

2− = B

3− !Int

4− -- ^ y

5− C

data/examples/declaration/data/unnamed-field-comment-1.hsdeleted−4

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

1−data X

2− = B

3− !Int -- ^ y

4− C

data/examples/declaration/data/with-weird-haddock-out.hsdeleted−4

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

1−data PlusLevel' t

2− = -- | @n + ℓ@.

3− Plus Integer (LevelAtom' t)

4− deriving (Show, Data)

data/examples/declaration/data/with-weird-haddock.hsdeleted−2

@@ -1,2 +0,0 @@

1−data PlusLevel' t = Plus Integer (LevelAtom' t) -- ^ @n + ℓ@.

2− deriving (Show, Data)

data/examples/declaration/signature/type/infix-promoted-type-constructor-out.hs+1

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

1fun1 :: Def ('[Ref s (Stored Uint32), IBool] 'T.:-> IBool)

2+

2fun2 :: Def ('[Ref s (Stored Uint32), IBool] ':-> IBool)

3fun2 :: Def ('[Ref s (Stored Uint32), IBool] ':-> IBool)

data/examples/declaration/signature/type/unrelated-out.hsdeleted−4

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

1−clientFunc1 :: SomeType1

2−clientFunc2 :: SomeType2

3−clientFunc3 :: SomeType3

4−clientFunc1 :<|> clientFunc2 :<|> clientFunc3 = hoistClient foo bar baz

data/examples/declaration/signature/type/unrelated.hsdeleted−4

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

1−clientFunc1 :: SomeType1

2−clientFunc2 :: SomeType2

3−clientFunc3 :: SomeType3

4−clientFunc1 :<|> clientFunc2 :<|> clientFunc3 = hoistClient foo bar baz

data/examples/declaration/type-synonyms/with-weird-haddock-out.hsdeleted−3

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

1−type Elims =

2− -- | eliminations ordered left-to-right.

3− [Elim]

data/examples/declaration/type-synonyms/with-weird-haddock.hsdeleted−1

@@ -1 +0,0 @@

1−type Elims = [Elim] -- ^ eliminations ordered left-to-right.

data/examples/declaration/value/function/arg-breakpoints-out.hsdeleted−3

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

1−foo

2− bar =

3− body

data/examples/declaration/value/function/arg-breakpoints.hsdeleted−3

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

1−foo

2− bar =

3− body

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

@@ -40,7 +40,7 @@ foo

40 )

41 else do

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

43− -- Could pattern match directly on x

43+ -- Could pattern match directly on x

44 i <- case u of

45 0 -> (g . h -< u)

46 n ->

data/examples/declaration/value/function/awkward-comment-0-out.hsdeleted−6

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

1−mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a

2−mergeErrorReply err1 reply -- XXX where to put it?

3− =

4− case reply of

5− Ok x state err2 -> Ok x state (mergeError err1 err2)

6− Error err2 -> Error (mergeError err1 err2)

data/examples/declaration/value/function/awkward-comment-0.hsdeleted−5

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

1−mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a

2−mergeErrorReply err1 reply -- XXX where to put it?

3− = case reply of

4− Ok x state err2 -> Ok x state (mergeError err1 err2)

5− Error err2 -> Error (mergeError err1 err2)

data/examples/declaration/value/function/awkward-comment-1-out.hsdeleted−9

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

1−doForeign :: Vars -> [Name] -> [Term] -> Idris LExp

2−doForeign x = x

3− where

4− splitArg tm | (_, [_, _, l, r]) <- unApply tm -- pair, two implicits

5− =

6− do

7− let l' = toFDesc l

8− r' <- irTerm (sMN 0 "__foreignCall") vs env r

9− return (l', r')

data/examples/declaration/value/function/awkward-comment-1.hsdeleted−7

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

1−doForeign :: Vars -> [Name] -> [Term] -> Idris LExp

2−doForeign x = x

3− where

4− splitArg tm | (_, [_,_,l,r]) <- unApply tm -- pair, two implicits

5− = do let l' = toFDesc l

6− r' <- irTerm (sMN 0 "__foreignCall") vs env r

7− return (l', r')

data/examples/declaration/value/function/blank-lines-let-out.hsdeleted−6

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

1−foo =

2− let x = 10

3−

4− y = 11

5− z = 12

6− in x + y + z

data/examples/declaration/value/function/blank-lines-let.hsdeleted−9

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

1−foo =

2− let

3−

4− x = 10

5−

6− y = 11

7− z = 12

8−

9− in x + y + z

data/examples/declaration/value/function/blank-lines-where-out.hsdeleted−6

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

1−foo = x + y + z

2− where

3− x = 10

4−

5− y = 11

6− z = 12

data/examples/declaration/value/function/blank-lines-where.hsdeleted−7

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

1−foo = x + y + z

2− where

3−

4− x = 10

5−

6− y = 11

7− z = 12

data/examples/declaration/value/function/if-with-comment-out.hsdeleted−8

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

1−foo =

2− if undefined

3− then -- then comment

4− undefined

5− else -- else comment

6−

7− do

8− undefined

data/examples/declaration/value/function/if-with-comment.hsdeleted−8

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

1−foo =

2− if undefined

3− -- then comment

4− then undefined

5− -- else comment

6− else

7− do

8− undefined

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

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

1{-# LANGUAGE ImplicitParams #-}

2

3sortBy :: (a -> a -> Bool) -> [a] -> [a]

4−sortBy = undefined

5

4

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

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

7sort = sortBy ?cmp

6sort = sortBy ?cmp

data/examples/declaration/value/function/implicit-params.hs−2

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

1{-# LANGUAGE ImplicitParams #-}

2sortBy :: (a -> a -> Bool) -> [a] -> [a]

3

4−sortBy = undefined

5−

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

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

7sort = sortBy ?cmp

5sort = sortBy ?cmp

8

6

data/examples/declaration/value/function/infix/dollar-chains-out.hs+3−3

@@ -13,9 +13,9 @@ foo =

13 throwIO (OrmoluCppEnabled path)

14

15foo =

16− bar $

16+ bar

17− baz $

17+ $ baz

18− quux

18+ $ quux

19

20x =

21 case l of { A -> B } $

data/examples/declaration/value/function/infix/hanging-out.hs+3−4

@@ -17,7 +17,6 @@ update =

17 `catch` \case

18 a -> a

19

20−foo =

20+foo = bar

21− bar

22− ++ case foo of

21+ ++ case foo of

23− a -> a

22+ a -> a

data/examples/declaration/value/function/infix/lenses-out.hs+7−8

@@ -1,12 +1,11 @@

1lenses =

2− Just $

3− M.fromList $

2+ Just $ M.fromList $

4− "type" .= ("user.connection" :: Text)

3+ "type" .= ("user.connection" :: Text)

5− # "connection" .= uc

4+ # "connection" .= uc

6− # "user" .= case name of

5+ # "user" .= case name of

7− Just n -> Just $ object ["name" .= n]

6+ Just n -> Just $ object ["name" .= n]

8− Nothing -> Nothing

7+ Nothing -> Nothing

9− # []

8+ # []

10

9

11foo =

10foo =

12 a

11 a

data/examples/declaration/value/function/list-notation-0-out.hsdeleted−5

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

1−foo =

2− testCase "Foo" testFoo :

3− testCase "Bar" testBar :

4− testCase "Baz" testBaz :

5− []

data/examples/declaration/value/function/list-notation-0.hsdeleted−5

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

1−foo =

2− testCase "Foo" testFoo :

3− testCase "Bar" testBar :

4− testCase "Baz" testBaz :

5− []

data/examples/declaration/value/function/list-notation-1-out.hsdeleted−8

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

1−instance A.ToJSON UpdateTable where

2− toJSON a =

3− A.object $

4− "TableName" .= updateTableName a :

5− "ProvisionedThroughput" .= updateProvisionedThroughput a :

6− case updateGlobalSecondaryIndexUpdates a of

7− [] -> []

8− l -> ["GlobalSecondaryIndexUpdates" .= l]

data/examples/declaration/value/function/list-notation-1.hsdeleted−7

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

1−instance A.ToJSON UpdateTable where

2− toJSON a = A.object

3− $ "TableName" .= updateTableName a

4− : "ProvisionedThroughput" .= updateProvisionedThroughput a

5− : case updateGlobalSecondaryIndexUpdates a of

6− [] -> []

7− l -> [ "GlobalSecondaryIndexUpdates" .= l ]

data/examples/declaration/value/function/list-notation-2-out.hsdeleted−6

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

1−-- A list of the element and all its parents up to the root node.

2−getPath tree t =

3− t :

4− case Map.lookup (getId t) tree of

5− Nothing -> []

6− Just parent -> getPath tree parent

data/examples/declaration/value/function/list-notation-2.hsdeleted−5

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

1−-- A list of the element and all its parents up to the root node.

2−getPath tree t = t :

3− case Map.lookup (getId t) tree of

4− Nothing -> []

5− Just parent -> getPath tree parent

data/examples/declaration/value/function/list-notation-3-out.hsdeleted−12

@@ -1,12 +0,0 @@

1−foo =

2− reportSDoc "tc.cc" 30 $

3− sep $ do

4− (prettyTCM q <+> " before compilation") : do

5− map (prettyTCM . map unArg . clPats) cls

6−

7−foo =

8− reportSDoc "tc.cc" 30 $

9− sep $ do

10− (prettyTCM q <+> " before compilation") :

11− do

12− map (prettyTCM . map unArg . clPats) cls

data/examples/declaration/value/function/list-notation-3.hsdeleted−10

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

1−foo =

2− reportSDoc "tc.cc" 30 $ sep $ do

3− (prettyTCM q <+> " before compilation") : do

4− map (prettyTCM . map unArg . clPats) cls

5−

6−foo =

7− reportSDoc "tc.cc" 30 $ sep $ do

8− (prettyTCM q <+> " before compilation") :

9− do

10− map (prettyTCM . map unArg . clPats) cls

data/examples/declaration/value/function/multi-way-if-out.hs+2−4

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

3foo x = if | x == 5 -> 5

4

5bar x y =

6− if

7− | x > y -> x

6+ if | x > y -> x

8 | x < y ->

7 | x < y ->

9 y

8 y

10 | otherwise -> x

9 | otherwise -> x

11

10

12baz =

11baz =

13− if

12+ if | p -> f

14− | p -> f

15 | otherwise -> g

13 | otherwise -> g

16 x

14 x

data/examples/declaration/value/function/operator-comments-2-out.hsdeleted−5

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

1−x =

2− y

3− ++ f g -- commentA

4− -- commentB

5− -- commentC

data/examples/declaration/value/function/operator-comments-2.hsdeleted−4

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

1−x =

2− y ++ -- commentA

3−-- commentB

4− f g -- commentC

data/examples/declaration/value/function/operators-1-out.hsdeleted−4

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

1−foo =

2− f

3− . g

4− =<< h . i

data/examples/declaration/value/function/operators-1.hsdeleted−3

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

1−foo = f

2− . g

3− =<< h . i

data/examples/declaration/value/function/operators-2-out.hsdeleted−4

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

1−foo n

2− | x || y && z || n ** x

3− || x && n =

4− 42

data/examples/declaration/value/function/operators-2.hsdeleted−4

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

1−foo n

2− | x || y && z || n ** x

3− || x && n =

4− 42

data/examples/declaration/value/function/operators-3-out.hsdeleted−3

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

1−foo =

2− op <> n <+> colon <+> prettySe <+> text "="

3− <+> prettySe <> text sc

data/examples/declaration/value/function/operators-3.hsdeleted−3

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

1−foo =

2− op <> n <+> colon <+> prettySe <+> text "=" <+>

3− prettySe <> text sc

data/examples/declaration/value/function/operators-4-out.hsdeleted−3

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

1−foo =

2− line <> bindingOf <+> text "=" <+> tPretty <+> colon

3− <+> align <> prettyPs

data/examples/declaration/value/function/operators-4.hsdeleted−3

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

1−foo =

2− line <> bindingOf <+> text "=" <+> tPretty <+> colon <+>

3− align <> prettyPs

data/examples/declaration/value/function/operators-5-out.hsdeleted−5

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

1−foo =

2− map bar $

3− [ baz

4− ]

5− ++ quux

data/examples/declaration/value/function/operators-5.hsdeleted−4

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

1−foo =

2− map bar $

3− [ baz

4− ] ++ quux

data/examples/declaration/value/function/operators-6-out.hsdeleted−9

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

1−type PermuteRef =

2− "a"

3− :> ( "b" :> "c" :> End

4− :<|> "c" :> "b" :> End

5− )

6− :<|> "b"

7− :> ( "a" :> "c" :> End

8− :<|> "c" :> "a" :> End

9− )

data/examples/declaration/value/function/operators-6.hsdeleted−7

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

1−type PermuteRef =

2− "a" :> ( "b" :> "c" :> End

3− :<|> "c" :> "b" :> End

4− )

5− :<|> "b" :> ( "a" :> "c" :> End

6− :<|> "c" :> "a" :> End

7− )

data/examples/declaration/value/function/operators-0-out.hs → data/examples/declaration/value/function/operators-out.hsrenamed

The content is the same.

data/examples/declaration/value/function/operators-0.hs → data/examples/declaration/value/function/operators.hsrenamed

The content is the same.

data/examples/declaration/value/function/type-applications-and-splice-out.hsdeleted−4

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

1−{-# LANGUAGE TemplateHaskell #-}

2−{-# LANGUAGE TypeApplications #-}

3−

4−staticKey name = [|sing @ $(symFQN name)|]

data/examples/declaration/value/function/type-applications-and-splice.hsdeleted−4

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

1−{-# LANGUAGE TemplateHaskell #-}

2−{-# LANGUAGE TypeApplications #-}

3−

4−staticKey name = [| sing @ $(symFQN name) |]

data/examples/import/deduplication-bug-out.hsdeleted−6

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

1−import Foo1 (Bar1 (..), Baz1)

2−import Foo2 (Bar2 (..), Baz2)

3−import Foo3 (Bar3 (x1, x2, x3))

4−import Foo4 (Bar4 (x1, x2))

5−import Foo5 (Bar5 (x1))

6−import Foo6 (Bar6 (..))

data/examples/import/deduplication-bug.hsdeleted−6

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

1−import Foo1 (Bar1, Baz1, Bar1(..))

2−import Foo2 (Bar2(..), Baz2, Bar2)

3−import Foo3 (Bar3(x1,x3), Bar3(x1, x2))

4−import Foo4 (Bar4(x1), Bar4(x2))

5−import Foo5 (Bar5, Bar5(x1))

6−import Foo6 (Bar6(x1), Bar6(..))

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

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

1import qualified MegaModule as M

2+ ( (<<<),

3+ (>>>),

2− ( Either,

4+ Either,

3 Maybe (Just, Nothing),

5 Maybe (Just, Nothing),

4 MaybeT (..),

6 MaybeT (..),

5− Monad (return, (>>), (>>=)),

7+ Monad ((>>), (>>=), return),

6 MonadBaseControl,

8 MonadBaseControl,

7 join,

9 join,

8 liftIO,

10 liftIO,

9 void,

11 void,

10− (<<<),

11− (>>>),

12 )

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

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

1import qualified MegaModule as M

2 ( -- (1)

3− -- (2)

4− Either, -- (3)

5− (<<<),

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

6 (>>>),

4 (>>>),

5+ Either, -- (3)

7 )

6 )

data/examples/import/merging-0-out.hsdeleted−3

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

1−import Foo

2−import Foo (bar, foo)

3−import Foo as F

data/examples/import/merging-0.hsdeleted−4

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

1−import Foo

2−import Foo (foo)

3−import Foo (bar)

4−import Foo as F

data/examples/import/merging-1-out.hsdeleted−2

@@ -1,2 +0,0 @@

1−import "bar" Foo (bar)

2−import "foo" Foo (baz, foo)

data/examples/import/merging-1.hsdeleted−3

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

1−import "foo" Foo (foo)

2−import "bar" Foo (bar)

3−import "foo" Foo (baz)

data/examples/import/merging-2-out.hsdeleted−2

@@ -1,2 +0,0 @@

1−import Foo hiding (bar4, foo2)

2−import qualified Foo (bar3, foo1)

data/examples/import/merging-2.hsdeleted−4

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

1−import qualified Foo (foo1)

2−import Foo hiding (foo2)

3−import qualified Foo (bar3)

4−import Foo hiding (bar4)

data/examples/import/misc-out.hs+6

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

1import A hiding

2 ( foobarbazqux,

3+ foobarbazqux,

4+ foobarbazqux,

5+ foobarbazqux,

6+ foobarbazqux,

7+ foobarbazqux,

8+ foobarbazqux,

3 )

9 )

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

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

5import Name hiding ()

11import Name hiding ()

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

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

1import qualified MegaModule as M

2+ ( (<<<),

3+ (>>>),

2− ( Either,

4+ Either,

3 Monad

5 Monad

4− ( return,

5− (>>),

6+ ( (>>),

6− (>>=)

7+ (>>=),

8+ return

7 ),

9 ),

8− (<<<),

9− (>>>),

10 )

data/examples/import/qualified-post-out.hs+1−1

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

1{-# LANGUAGE ImportQualifiedPost #-}

2

3+import Data.Text qualified as T

3import Data.Text qualified (a, b, c)

4import Data.Text qualified (a, b, c)

4import Data.Text qualified hiding (a, b, c)

5import Data.Text qualified hiding (a, b, c)

5−import Data.Text qualified as T

data/examples/import/qualified-prelude-out.hs+1−1

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

1module P where

2

3−import Prelude hiding (id, (.))

4import qualified Prelude

3import qualified Prelude

4+import Prelude hiding ((.), id)

data/examples/import/simple-out.hs+3−2

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

1import Data.Text

2+import Data.Text

3+import qualified Data.Text as T

4+import qualified Data.Text (a, b, c)

2import Data.Text (a, b, c)

5import Data.Text (a, b, c)

3import Data.Text hiding (a, b, c)

6import Data.Text hiding (a, b, c)

4−import qualified Data.Text (a, b, c)

5−import qualified Data.Text as T

data/examples/import/simple.hs−2

@@ -4,5 +4,3 @@ import qualified Data.Text as T

4import qualified Data.Text (a, c, b)

5import Data.Text (a, b, c)

6import Data.Text hiding (c, b, a)

7−import Data.Text (a, b, c, b, a)

8−import Data.Text hiding (c, b, a, b, c)

data/examples/import/sorted-export-list-out.hsdeleted−1

@@ -1 +0,0 @@

1−import Linear.Vector (Additive (..), (*^), (^*))

data/examples/import/sorted-export-list.hsdeleted−1

@@ -1 +0,0 @@

1−import Linear.Vector (Additive (..), (*^), (^*))

data/examples/other/argument-comment-out.hs+1

@@ -9,6 +9,7 @@ foo ::

9 -- | Foo

10 Int ->

11 Int

12+

12foo ::

13foo ::

13 Foo a =>

14 Foo a =>

14 -- | Foo

15 -- | Foo

data/examples/other/comment-glued-together-out.hsdeleted−7

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

1−module Main (main) where

2−

3−-- | Foo.

4−

5−-- Bar

6−main :: IO ()

7−main = return ()

data/examples/other/comment-glued-together.hsdeleted−6

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

1−module Main (main) where

2−

3−{- | Foo. -}

4−-- Bar

5−main :: IO ()

6−main = return ()

data/examples/other/comment-trailing-space-out.hsdeleted−9

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

1−data T

2− = {-

3−

4− some multi-line comment

5−

6− with empty lines

7−

8− -}

9− A

data/examples/other/comment-trailing-space.hsdeleted−9

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

1−data T

2− = {-

3−

4− some multi-line comment

5−

6− with empty lines

7−

8− -}

9− A

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

@@ -2,7 +2,7 @@ newNames :: [(String, String)]

2newNames =

3 let (*) = flip (,)

4 in [ "Control" * "Monad"

5− -- Foo

5+ -- Foo

6

7− -- Bar

7+ -- Bar

8 ]

data/examples/other/cpp/separation-2b-out.hs+1

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

1ffff, ffffffff :: Natural

2+

2#ifdef HASKELL_ZIP_DEV_MODE

3#ifdef HASKELL_ZIP_DEV_MODE

3ffff = 200

4ffff = 200

4ffffffff = 5000

5ffffffff = 5000

data/examples/other/disabling/indented-fragment-out.hsdeleted−7

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

1−foo =

2− {- ORMOLU_DISABLE -}

3− testCase "Foo" testFoo :

4− testCase "Bar" testBar :

5− testCase "Baz" testBaz :

6− {- ORMOLU_ENABLE -}

7− []

data/examples/other/disabling/indented-fragment.hsdeleted−7

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

1−foo =

2− {- ORMOLU_DISABLE -}

3− testCase "Foo" testFoo :

4− testCase "Bar" testBar :

5− testCase "Baz" testBaz :

6− {- ORMOLU_ENABLE -}

7− []

data/examples/other/inline-comment-1-out.hsdeleted−12

@@ -1,12 +0,0 @@

1−showPs env ((n, _, Let _ t v) : bs) =

2− " " ++ show n ++ " : "

3− ++ showEnv env ({- normalise ctxt env -} t)

4− ++ " = "

5− ++ showEnv env ({- normalise ctxt env -} v)

6− ++ "\n"

7− ++ showPs env bs

8−showPs env ((n, _, b) : bs) =

9− " " ++ show n ++ " : "

10− ++ showEnv env ({- normalise ctxt env -} (binderTy b))

11− ++ "\n"

12− ++ showPs env bs

data/examples/other/inline-comment-1.hsdeleted−9

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

1−showPs env ((n, _, Let _ t v):bs)

2− = " " ++ show n ++ " : " ++

3− showEnv env ({- normalise ctxt env -} t) ++ " = " ++

4− showEnv env ({- normalise ctxt env -} v) ++

5− "\n" ++ showPs env bs

6−showPs env ((n, _, b):bs)

7− = " " ++ show n ++ " : " ++

8− showEnv env ({- normalise ctxt env -} (binderTy b)) ++

9− "\n" ++ showPs env bs

data/examples/other/inline-comment-0-out.hs → data/examples/other/inline-comment-out.hsrenamed

The content is the same.

data/examples/other/inline-comment-0.hs → data/examples/other/inline-comment.hsrenamed

The content is the same.

data/examples/other/multiple-blank-line-comment-out.hsdeleted−9

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

1−module A where

2−

3−a =

4− b

5− [ f

6− {-,

7−

8− -}

9− ]

data/examples/other/multiple-blank-line-comment.hsdeleted−10

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

1−module A where

2−

3−a =

4− b

5− [ f

6− {-,

7−

8−

9− -}

10− ]

data/examples/other/pragma-comments-after-out.hsdeleted−4

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

1−{-# LANGUAGE AllowAmbiguousTypes #-}

2−{-# LANGUAGE ConstraintKinds #-}

3−-- TODO: Fix and delete this pragma

4−{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

data/examples/other/pragma-comments-after.hsdeleted−3

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

1−{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- TODO: Fix and delete this pragma

2−{-# LANGUAGE AllowAmbiguousTypes #-}

3−{-# LANGUAGE ConstraintKinds #-}

default.nix+17−18

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

1−{ pkgs ? (import ./nix/nixpkgs { inherit system; })

1+{ pkgs ? (import ./nix/nixpkgs)

2−, system ? builtins.currentSystem

3−, ormoluCompiler ? "ghc884" # the shell doesn't work with ghc8101 yet

2+, ormoluCompiler ? "ghc883" # the shell doesn't work with ghc8101 yet

4}:

3}:

5

4

6let

5let

@@ -17,6 +16,12 @@ let

17 };

16 };

18 ormoluOverlay = self: super: {

17 ormoluOverlay = self: super: {

19 "ormolu" = super.callCabal2nixWithOptions "ormolu" source "-fdev" { };

18 "ormolu" = super.callCabal2nixWithOptions "ormolu" source "-fdev" { };

19+ "ghc-lib-parser" = pkgs.haskell.lib.dontHaddock

20+ (super.callHackageDirect {

21+ pkg = "ghc-lib-parser";

22+ ver = "8.10.1.20200412";

23+ sha256 = "sha256-EjMzp8xRT3xVFKDI1fAfopkylGB0hv35Av2+uZeETRU=";

24+ } {});

20 };

25 };

21 ormolize = import ./nix/ormolize {

26 ormolize = import ./nix/ormolize {

22 inherit pkgs;

27 inherit pkgs;

@@ -28,16 +33,15 @@ let

28 "distributed-process"

33 "distributed-process"

29 "esqueleto"

34 "esqueleto"

30 "fay"

35 "fay"

31− "hlint"

32 "idris"

36 "idris"

33 "intero"

37 "intero"

34 "leksah"

38 "leksah"

39+ "lens"

35 "pandoc"

40 "pandoc"

36 "pipes"

41 "pipes"

37− "postgrest"

38 "purescript"

42 "purescript"

39− "tensorflow"

43+ "stack"

40− ] ++ (if ormoluCompiler == "ghc8101" then [] else ["lens"]);

44+ ];

41 ormolizedPackages = doCheck:

45 ormolizedPackages = doCheck:

42 pkgs.lib.mapAttrs (name: p: ormolize {

46 pkgs.lib.mapAttrs (name: p: ormolize {

43 package = p;

47 package = p;

@@ -103,7 +107,6 @@ in {

103 "optics"

107 "optics"

104 "ormolu"

108 "ormolu"

105 "pandoc"

109 "pandoc"

106− "parsec3"

107 "pipes"

110 "pipes"

108 "postgrest"

111 "postgrest"

109 "purescript"

112 "purescript"

@@ -129,19 +132,17 @@ in {

129 cp src.hs result-all-implicit.hs

132 cp src.hs result-all-implicit.hs

130 ormolu --check-idempotence --mode inplace result-all-implicit.hs

133 ormolu --check-idempotence --mode inplace result-all-implicit.hs

131 cp src.hs result-all-explicit.hs

134 cp src.hs result-all-explicit.hs

132− ormolu --check-idempotence --mode inplace --start-line 1 --end-line 18 result-all-explicit.hs

135+ ormolu --check-idempotence --mode inplace --start-line 1 --end-line 13 result-all-explicit.hs

133 cp src.hs result-only-start.hs

136 cp src.hs result-only-start.hs

134 ormolu --check-idempotence --mode inplace --start-line 1 result-only-start.hs

137 ormolu --check-idempotence --mode inplace --start-line 1 result-only-start.hs

135 cp src.hs result-only-end.hs

138 cp src.hs result-only-end.hs

136− ormolu --check-idempotence --mode inplace --end-line 18 result-only-end.hs

139+ ormolu --check-idempotence --mode inplace --end-line 13 result-only-end.hs

137 cp src.hs result-6-7.hs

140 cp src.hs result-6-7.hs

138 ormolu --check-idempotence --mode inplace --start-line 6 --end-line 7 result-6-7.hs

141 ormolu --check-idempotence --mode inplace --start-line 6 --end-line 7 result-6-7.hs

139 cp src.hs result-6-8.hs

142 cp src.hs result-6-8.hs

140 ormolu --check-idempotence --mode inplace --start-line 6 --end-line 8 result-6-8.hs

143 ormolu --check-idempotence --mode inplace --start-line 6 --end-line 8 result-6-8.hs

141− cp src.hs result-9-12.hs

144+ cp src.hs result-9-13.hs

142− ormolu --check-idempotence --mode inplace --start-line 9 --end-line 12 result-9-12.hs

145+ ormolu --check-idempotence --mode inplace --start-line 9 --end-line 13 result-9-13.hs

143− cp src.hs result-17-18.hs

144− ormolu --check-idempotence --mode inplace --start-line 17 --end-line 18 result-17-18.hs

145 '';

146 '';

146 checkPhase = ''

147 checkPhase = ''

147 echo result-all-implicit.hs

148 echo result-all-implicit.hs

@@ -156,10 +157,8 @@ in {

156 diff --color=always expected-result-6-7.hs result-6-7.hs

157 diff --color=always expected-result-6-7.hs result-6-7.hs

157 echo result-6-8.hs

158 echo result-6-8.hs

158 diff --color=always expected-result-6-8.hs result-6-8.hs

159 diff --color=always expected-result-6-8.hs result-6-8.hs

159− echo result-9-12.hs

160+ echo result-9-13.hs

160− diff --color=always expected-result-9-12.hs result-9-12.hs

161+ diff --color=always expected-result-9-13.hs result-9-13.hs

161− echo result-17-18.hs

162− diff --color=always expected-result-17-18.hs result-17-18.hs

163 '';

162 '';

164 installPhase = ''

163 installPhase = ''

165 mkdir "$out"

164 mkdir "$out"

expected-failures/Agda.txt+23−6

@@ -1,11 +1,28 @@

1Formatting is not idempotent:

2− dist/build/Agda/Syntax/Parser/Lexer.hs<rendered>:1602:17

2+ src/full/Agda/Syntax/Internal.hs<rendered>:236:12

3− before: " = (check_ac"

3+ before: "pe Elims = -- | elim"

4+ after: "pe Elims =\n -- | el"

5+Please, consider reporting the bug.

6+

7+Parsing of formatted code failed:

8+ src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs<rendered>:524:7-13

9+ parse error on input `C.QName'

10+Please, consider reporting the bug.

11+

12+Formatting is not idempotent:

13+ src/full/Agda/Termination/CallGraph.hs<rendered>:151:38

14+ before: "2, old2) = -- TODO: "

15+ after: "2, old2) =\n -"

16+Please, consider reporting the bug.

17+

18+Formatting is not idempotent:

19+ src/full/Agda/TypeChecking/MetaVars.hs<rendered>:1448:16

20+ before: "ubstCand = -- | a po"

4− after: " =\n "

21+ after: "ubstCand =\n -- | a "

5Please, consider reporting the bug.

22Please, consider reporting the bug.

6

23

7Formatting is not idempotent:

24Formatting is not idempotent:

8− src/full/Agda/Syntax/Translation/InternalToAbstract.hs<rendered>:769:4

25+ src/full/Agda/Utils/List.hs<rendered>:186:15

9− before: " nes\n\n "

26+ before: "Prefix a = -- | The "

10− after: " nes\n\n -- Andreas"

27+ after: "Prefix a =\n -- | Th"

11Please, consider reporting the bug.

28Please, consider reporting the bug.

expected-failures/esqueleto.txt+1−1

@@ -3,5 +3,5 @@ The GHC parser (in Haddock mode) failed:

3 lexical error in string/character literal at character 's'

4

5The GHC parser (in Haddock mode) failed:

6− test/PostgreSQL/Test.hs:562:9-41

6+ test/PostgreSQL/Test.hs:510:9-41

7 parse error on input `-- | Check the result is not null'

expected-failures/hlint.txtdeleted−11

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

1−Formatting is not idempotent:

2− src/Extension.hs<rendered>:19:22

3− before: "DoRec , -} Recursive"

4− after: "DoRec , -}\n "

5−Please, consider reporting the bug.

6−

7−Formatting is not idempotent:

8− src/Hint/Bracket.hs<rendered>:249:50

9− before: "\" x y [r]) {ideaSpan"

10− after: "\" x y [r])\n "

11−Please, consider reporting the bug.

expected-failures/idris.txt+94

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

1+Formatting is not idempotent:

2+ src/Idris/AbsSyntaxTree.hs<rendered>:2105:48

3+ before: "t_impl ppo && uname "

4+ after: "t_impl ppo\n "

5+Please, consider reporting the bug.

6+

7+Formatting is not idempotent:

8+ src/Idris/Core/ProofState.hs<rendered>:163:20

9+ before: "++ showEnv env (\n "

10+ after: "++ showEnv\n "

11+Please, consider reporting the bug.

12+

13+Formatting is not idempotent:

14+ src/Idris/Core/ProofTerm.hs<rendered>:351:19

15+ before: "f c e pt = -- @(PT p"

16+ after: "f c e pt =\n -- @(PT"

17+Please, consider reporting the bug.

18+

19+Formatting is not idempotent:

20+ src/Idris/Core/TT.hs<rendered>:1963:13

21+ before: " text op <> pretty"

22+ after: " text op\n <"

23+Please, consider reporting the bug.

24+

25+Formatting is not idempotent:

26+ src/Idris/Core/WHNF.hs<rendered>:105:46

27+ before: " n b sc) = -- stk mu"

28+ after: " n b sc) =\n -- "

29+Please, consider reporting the bug.

30+

31+Formatting is not idempotent:

32+ src/Idris/Delaborate.hs<rendered>:627:6

33+ before: "ity\n -- Issue #"

34+ after: "ity\n -- Issue"

35+Please, consider reporting the bug.

36+

37+Formatting is not idempotent:

38+ src/Idris/Elab/Term.hs<rendered>:432:47

39+ before: "K\" _ _)) = -- for ch"

40+ after: "K\" _ _)) =\n -- "

41+Please, consider reporting the bug.

42+

43+Formatting is not idempotent:

44+ src/Idris/ModeCommon.hs<rendered>:34:26

45+ before: "s toline = -- furthe"

46+ after: "s toline =\n -- furt"

47+Please, consider reporting the bug.

48+

49+Formatting is not idempotent:

50+ src/Idris/Options.hs<rendered>:177:17

51+ before: "timisation = PETrans"

52+ after: "timisation\n = PETra"

53+Please, consider reporting the bug.

54+

1The GHC parser (in Haddock mode) failed:

55The GHC parser (in Haddock mode) failed:

2 src/Idris/Parser.hs:1052:1

56 src/Idris/Parser.hs:1052:1

3 parse error on input `@'

57 parse error on input `@'

4

58

59+AST of input and AST of formatted code differ.

60+ at src/Idris/Parser/Data.hs:281:1-29

61+Please, consider reporting the bug.

62+

5The GHC parser (in Haddock mode) failed:

63The GHC parser (in Haddock mode) failed:

6 src/Idris/Parser/Expr.hs:75:1

64 src/Idris/Parser/Expr.hs:75:1

7 parse error on input `@'

65 parse error on input `@'

66+

67+Formatting is not idempotent:

68+ src/Idris/PartialEval.hs<rendered>:281:42

69+ before: ": ns) as = -- Droppe"

70+ after: ": ns) as =\n -- "

71+Please, consider reporting the bug.

72+

73+Formatting is not idempotent:

74+ src/Idris/ProofSearch.hs<rendered>:487:20

75+ before: "OK ty hs = -- if any"

76+ after: "OK ty hs =\n -- "

77+Please, consider reporting the bug.

78+

79+Formatting is not idempotent:

80+ src/Idris/Prover.hs<rendered>:239:10

81+ before: " line <> bindin"

82+ after: " line\n <"

83+Please, consider reporting the bug.

84+

85+Formatting is not idempotent:

86+ src/Idris/REPL.hs<rendered>:1270:33

87+ before: "ht c) _) = -- consta"

88+ after: "ht c) _) =\n -- cons"

89+Please, consider reporting the bug.

90+

91+Formatting is not idempotent:

92+ src/Idris/Reflection.hs<rendered>:934:27

93+ before: "attern _ = -- for al"

94+ after: "attern _ =\n -- for "

95+Please, consider reporting the bug.

96+

97+Formatting is not idempotent:

98+ src/Idris/Transforms.hs<rendered>:26:32

99+ before: "s, rhs)) = -- apply "

100+ after: "s, rhs)) =\n -- "

101+Please, consider reporting the bug.

expected-failures/intero.txt+3−3

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

1Formatting is not idempotent:

2− src/InteractiveUI.hs<rendered>:3748:33

2+ src/InteractiveUI.hs<rendered>:2635:36

3− before: "text \"Try\" <+> doWha"

3+ before: "Decl d2) = -- A bit "

4− after: "text \"Try\"\n "

4+ after: "Decl d2) =\n -- A bi"

5Please, consider reporting the bug.

expected-failures/leksah.txt+1−1

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

1Formatting is not idempotent:

2− src/IDE/Pane/Modules.hs<rendered>:1184:7

2+ src/IDE/Pane/Modules.hs<rendered>:1188:7

3 before: "cr\n -- show"

4 after: "cr\n in -- show"

5Please, consider reporting the bug.

expected-failures/pandoc.txt+1−1

@@ -3,7 +3,7 @@ The GHC parser (in Haddock mode) failed:

3 parse error on input `import'

4

5Formatting is not idempotent:

6− src/Text/Pandoc/Readers/Vimwiki.hs<rendered>:613:19

6+ src/Text/Pandoc/Readers/Vimwiki.hs<rendered>:615:19

7 before: ".softbreak <$ endlin"

8 after: ".softbreak\n <$ en"

9Please, consider reporting the bug.

expected-failures/postgrest.txtdeleted−5

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

1−Formatting is not idempotent:

2− src/PostgREST/DbRequestBuilder.hs<rendered>:149:24

3− before: " || -- clients"

4− after: " || ( origin ="

5−Please, consider reporting the bug.

expected-failures/purescript.txt+2−2

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

1The GHC parser (in Haddock mode) failed:

2− src/Language/PureScript/AST/Declarations.hs:479:1-17

2+ src/Language/PureScript/AST/Declarations.hs:478:1-17

3 Invalid type signature: pattern ValueDecl :: ...

4Perhaps you meant to use PatternSynonyms?

5

6The GHC parser (in Haddock mode) failed:

7− src/Language/PureScript/AST/SourcePos.hs:99:1-22

7+ src/Language/PureScript/AST/SourcePos.hs:101:1-22

8 Invalid type signature: pattern NullSourceSpan :: ...

9Perhaps you meant to use PatternSynonyms?

10

expected-failures/stack.txtnew file+5

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

1+Formatting is not idempotent:

2+ src/Stack/Options/DockerParser.hs<rendered>:36:10

3+ before: " <$> opti"

4+ after: " <$> option"

5+Please, consider reporting the bug.

expected-failures/tensorflow.txtdeleted−7

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

1−The GHC parser (in Haddock mode) failed:

2− tensorflow-mnist/app/Main.hs:50:13-14

3− parse error on input `->'

4−

5−The GHC parser (in Haddock mode) failed:

6− tensorflow-ops/tests/RegressionTest.hs:3:1-6

7− parse error on input `import'

nix/nixpkgs/default.nix+3−7

@@ -1,13 +1,9 @@

1−{ system ? builtins.currentSystem }:

2let

1let

3− rev = "32b46dd897ab2143a609988a04d87452f0bbef59";

2+ rev = "807ca93fadd5197c2260490de0c76e500562dc05";

4− sha256 = "1gzfrpjnr1bz9zljsyg3a4zrhk8r927sz761mrgcg56dwinkhpjk";

3+ sha256 = "10yq8bnls77fh3pk5chkkb1sv5lbdgyk1rr2v9xn71rr1k2x563p";

5 nixpkgs = builtins.fetchTarball {

4 nixpkgs = builtins.fetchTarball {

6 url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";

5 url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";

7 inherit sha256;

6 inherit sha256;

8 };

7 };

9− pkgs = import nixpkgs {

10− inherit system;

11− config.allowUnfree = true;

8+ pkgs = import nixpkgs { config.allowUnfree = true; };

12− };

13in pkgs

9in pkgs

ormolu.cabal+4−5

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

1cabal-version: 1.18

2name: ormolu

3−version: 0.1.2.0

3+version: 0.0.5.0

4license: BSD3

5license-file: LICENSE.md

6maintainer: Mark Karpov <mark.karpov@tweag.io>

7−tested-with: ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.1

7+tested-with: ghc ==8.6.5 ghc ==8.8.3 ghc ==8.10.1

8homepage: https://github.com/tweag/ormolu

9bug-reports: https://github.com/tweag/ormolu/issues

10synopsis: A formatter for Haskell source code

@@ -119,7 +119,7 @@ library

119 base >=4.12 && <5.0,

120 bytestring >=0.2 && <0.11,

121 containers >=0.5 && <0.7,

122− dlist >=0.8 && <2.0,

122+ dlist >=0.8 && <0.9,

123 exceptions >=0.6 && <0.11,

124 ghc-lib-parser >=8.10 && <8.11,

125 mtl >=2.0 && <3.0,

@@ -144,7 +144,7 @@ executable ormolu

144 base >=4.12 && <5.0,

145 ghc-lib-parser >=8.10 && <8.11,

146 gitrev >=1.3 && <1.4,

147− optparse-applicative >=0.14 && <0.17,

147+ optparse-applicative >=0.14 && <0.16,

148 ormolu -any,

149 text >=0.2 && <1.3

150

@@ -152,7 +152,6 @@ executable ormolu

152 ghc-options:

153 -Wall -Werror -Wcompat -Wincomplete-record-updates

154 -Wincomplete-uni-patterns -Wnoncanonical-monad-instances

155− -optP-Wno-nonportable-include-path

156

155

157 else

156 else

158 ghc-options: -O2 -Wall -rtsopts

157 ghc-options: -O2 -Wall -rtsopts

region-tests/expected-result-17-18.hsdeleted−17

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

1−{-# LANGUAGE LambdaCase #-}

2−

3−module Foo (

4− foo, bar, baz) where

5−

6−foo :: Int

7−foo = 5

8−

9−bar :: Int -> Int

10−bar = \case

11− 0 -> foo

12− x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

region-tests/expected-result-6-7.hs+1−6

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

@@ -10,8 +10,3 @@ bar :: Int -> Int

10bar = \case

11 0 -> foo

12 x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

region-tests/expected-result-6-8.hs+1−6

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

@@ -9,8 +9,3 @@ bar :: Int -> Int

9bar = \case

10 0 -> foo

11 x -> x - foo

12−

13−baz :: Int -> Int

14−baz = gege

15− where

16− gege = 1 + 2

region-tests/expected-result-9-12.hs → region-tests/expected-result-9-13.hsrenamed+1−6

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

@@ -10,8 +10,3 @@ bar :: Int -> Int

10bar = \case

11 0 -> foo

12 x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

region-tests/expected-result-all.hs−6

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

3module Foo

4 ( foo,

5 bar,

6− baz,

7 )

6 )

8where

7where

9

8

@@ -14,8 +13,3 @@ bar :: Int -> Int

14bar = \case

13bar = \case

15 0 -> foo

14 0 -> foo

16 x -> x - foo

15 x -> x - foo

17−

18−baz :: Int -> Int

19−baz = gege

20− where

21− gege = 1 + 2

region-tests/src.hs+1−6

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

@@ -10,8 +10,3 @@ bar :: Int -> Int

10bar = \case

11 0 -> foo

12 x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

shell.nix+1−3

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

1−{ pkgs ? (import ./nix/nixpkgs { inherit system; })

1+{ pkgs ? (import ./nix/nixpkgs) }:

2−, system ? builtins.currentSystem

3−}:

4

2

5(import ./default.nix { inherit pkgs; }).dev.ormoluShell

3(import ./default.nix { inherit pkgs; }).dev.ormoluShell

src/Ormolu/Diff.hs+3−3

@@ -14,7 +14,7 @@ import Data.Text (Text)

14import qualified Data.Text as T

15import qualified FastString as GHC

16import GHC

17−import Ormolu.Imports (normalizeImports)

17+import Ormolu.Imports (sortImports)

18import Ormolu.Parser.CommentStream

19import Ormolu.Parser.Result

20import Ormolu.Utils

@@ -47,8 +47,8 @@ diffParseResult

47 } =

48 matchIgnoringSrcSpans cstream0 cstream1

49 <> matchIgnoringSrcSpans

50− hs0 {hsmodImports = normalizeImports (hsmodImports hs0)}

50+ hs0 {hsmodImports = sortImports (hsmodImports hs0)}

51− hs1 {hsmodImports = normalizeImports (hsmodImports hs1)}

51+ hs1 {hsmodImports = sortImports (hsmodImports hs1)}

52

53-- | Compare two values for equality disregarding differences in 'SrcSpan's

54-- and the ordering of import lists.

src/Ormolu/Imports.hs+44−161

@@ -4,199 +4,82 @@

4

5-- | Manipulations on import lists.

6module Ormolu.Imports

7− ( normalizeImports,

7+ ( sortImports,

8 )

9where

10

11import Data.Bifunctor

12−import Data.Char (isAlphaNum)

13import Data.Function (on)

12import Data.Function (on)

14−import Data.List (foldl', nubBy, sortBy, sortOn)

13+import Data.Generics (gcompare)

15−import Data.Map.Strict (Map)

14+import Data.List (sortBy)

16−import qualified Data.Map.Strict as M

17−import FastString (FastString)

18import GHC hiding (GhcPs, IE)

15import GHC hiding (GhcPs, IE)

19import GHC.Hs.Extension

16import GHC.Hs.Extension

20import GHC.Hs.ImpExp (IE (..))

17import GHC.Hs.ImpExp (IE (..))

21−import Ormolu.Utils (notImplemented, showOutputable)

18+import Ormolu.Utils (notImplemented)

22

19

23−-- | Sort and normalize imports.

20+-- | Sort imports by module name. This also sorts explicit import lists for

21+-- each declaration.

24−normalizeImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]

22+sortImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]

25−normalizeImports =

23+sortImports = sortBy compareIdecl . fmap (fmap sortImportLists)

26− fmap snd

27− . M.toAscList

28− . M.fromListWith combineImports

29− . fmap (\x -> (importId x, g x))

30 where

24 where

31− g (L l ImportDecl {..}) =

25+ sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs

32− L

26+ sortImportLists = \case

33− l

27+ ImportDecl {..} ->

34 ImportDecl

28 ImportDecl

35− { ideclHiding = second (fmap normalizeLies) <$> ideclHiding,

29+ { ideclHiding = second (fmap sortLies) <$> ideclHiding,

36 ..

30 ..

37 }

31 }

38− g _ = notImplemented "XImportDecl"

32+ XImportDecl x -> noExtCon x

39

33

40−-- | Combine two import declarations. It should be assumed that 'ImportId's

41−-- are equal.

42−combineImports ::

43− LImportDecl GhcPs ->

44− LImportDecl GhcPs ->

34+-- | Compare two @'LImportDecl' 'GhcPs'@ things.

45− LImportDecl GhcPs

35+compareIdecl :: LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering

46−combineImports (L lx ImportDecl {..}) (L _ y) =

36+compareIdecl (L _ m0) (L _ m1) =

47− L

37+ case (isPrelude n0, isPrelude n1) of

48− lx

38+ (False, False) -> n0 `compare` n1

49− ImportDecl

39+ (True, False) -> GT

50− { ideclHiding = case (ideclHiding, GHC.ideclHiding y) of

40+ (False, True) -> LT

51− (Just (hiding, L l' xs), Just (_, L _ ys)) ->

41+ (True, True) -> m0 `gcompare` m1

52− Just (hiding, (L l' (normalizeLies (xs ++ ys))))

53− _ -> Nothing,

54− ..

55− }

56−combineImports _ _ = notImplemented "XImportDecl"

57−

58−-- | Import id, a collection of all things that justify having a separate

59−-- import entry. This is used for merging of imports. If two imports have

60−-- the same 'ImportId' they can be merged.

61−data ImportId = ImportId

62− { importIsPrelude :: Bool,

63− importIdName :: ModuleName,

64− importPkgQual :: Maybe FastString,

65− importSource :: Bool,

66− importSafe :: Bool,

67− importQualified :: Bool,

68− importImplicit :: Bool,

69− importAs :: Maybe ModuleName,

70− importHiding :: Maybe Bool

71− }

72− deriving (Eq, Ord)

73−

74−-- | Obtain an 'ImportId' for a given import.

75−importId :: LImportDecl GhcPs -> ImportId

76−importId (L _ ImportDecl {..}) =

77− ImportId

78− { importIsPrelude = isPrelude,

79− importIdName = moduleName,

80− importPkgQual = sl_fs <$> ideclPkgQual,

81− importSource = ideclSource,

82− importSafe = ideclSafe,

83− importQualified = case ideclQualified of

84− QualifiedPre -> True

85− QualifiedPost -> True

86− NotQualified -> False,

87− importImplicit = ideclImplicit,

88− importAs = unLoc <$> ideclAs,

89− importHiding = fst <$> ideclHiding

90− }

91 where

42 where

43+ n0 = unLoc (ideclName m0)

44+ n1 = unLoc (ideclName m1)

92− isPrelude = moduleNameString moduleName == "Prelude"

45+ isPrelude = (== "Prelude") . moduleNameString

93− moduleName = unLoc ideclName

94−importId _ = notImplemented "XImportDecl"

95

46

96−-- | Normalize a collection of import\/export items.

47+-- | Sort located import or export.

97−normalizeLies :: [LIE GhcPs] -> [LIE GhcPs]

48+sortLies :: [LIE GhcPs] -> [LIE GhcPs]

98−normalizeLies = sortOn (getIewn . unLoc) . M.elems . foldl' combine M.empty

49+sortLies = sortBy (compareIE `on` unLoc) . fmap (fmap sortThings)

99− where

100− combine ::

101− Map IEWrappedNameOrd (LIE GhcPs) ->

102− LIE GhcPs ->

103− Map IEWrappedNameOrd (LIE GhcPs)

104− combine m (L new_l new) =

105− let wname = getIewn new

106− normalizeWNames =

107− nubBy (\x y -> compareLIewn x y == EQ) . sortBy compareLIewn

108− alter = \case

109− Nothing -> Just . L new_l $

110− case new of

111− IEThingWith NoExtField n wildcard g flbl ->

112− IEThingWith NoExtField n wildcard (normalizeWNames g) flbl

113− other -> other

114− Just old ->

115− let f = \case

116− IEVar NoExtField n -> IEVar NoExtField n

117− IEThingAbs NoExtField _ -> new

118− IEThingAll NoExtField n -> IEThingAll NoExtField n

119− IEThingWith NoExtField n wildcard g flbl ->

120− case new of

121− IEVar NoExtField _ ->

122− error "Ormolu.Imports broken presupposition"

123− IEThingAbs NoExtField _ ->

124− IEThingWith NoExtField n wildcard g flbl

125− IEThingAll NoExtField n' ->

126− IEThingAll NoExtField n'

127− IEThingWith NoExtField n' wildcard' g' flbl' ->

128− let combinedWildcard =

129− case (wildcard, wildcard') of

130− (IEWildcard _, _) -> IEWildcard 0

131− (_, IEWildcard _) -> IEWildcard 0

132− _ -> NoIEWildcard

133− in IEThingWith

134− NoExtField

135− n'

136− combinedWildcard

137− (normalizeWNames (g <> g'))

138− flbl'

139− IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

140− IEGroup NoExtField _ _ -> notImplemented "IEGroup"

141− IEDoc NoExtField _ -> notImplemented "IEDoc"

142− IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

143− XIE x -> noExtCon x

144− IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

145− IEGroup NoExtField _ _ -> notImplemented "IEGroup"

146− IEDoc NoExtField _ -> notImplemented "IEDoc"

147− IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

148− XIE x -> noExtCon x

149− in Just (f <$> old)

150− in M.alter alter wname m

151

50

152−-- | A wrapper for @'IEWrappedName' 'RdrName'@ that allows us to define an

51+-- | Sort imports\/exports inside of 'IEThingWith'.

153−-- 'Ord' instance for it.

52+sortThings :: IE GhcPs -> IE GhcPs

154−newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)

53+sortThings = \case

155− deriving (Eq)

54+ IEThingWith NoExtField x w xs fl ->

55+ IEThingWith NoExtField x w (sortBy (compareIewn `on` unLoc) xs) fl

56+ other -> other

156

57

157−instance Ord IEWrappedNameOrd where

58+-- | Compare two located imports or exports.

158− compare (IEWrappedNameOrd x) (IEWrappedNameOrd y) = compareIewn x y

59+compareIE :: IE GhcPs -> IE GhcPs -> Ordering

60+compareIE = compareIewn `on` getIewn

159

61

160-- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@.

62-- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@.

161−getIewn :: IE GhcPs -> IEWrappedNameOrd

63+getIewn :: IE GhcPs -> IEWrappedName RdrName

162getIewn = \case

64getIewn = \case

163− IEVar NoExtField x -> IEWrappedNameOrd (unLoc x)

65+ IEVar NoExtField x -> unLoc x

164− IEThingAbs NoExtField x -> IEWrappedNameOrd (unLoc x)

66+ IEThingAbs NoExtField x -> unLoc x

165− IEThingAll NoExtField x -> IEWrappedNameOrd (unLoc x)

67+ IEThingAll NoExtField x -> unLoc x

166− IEThingWith NoExtField x _ _ _ -> IEWrappedNameOrd (unLoc x)

68+ IEThingWith NoExtField x _ _ _ -> unLoc x

167 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

69 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

168 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

70 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

169 IEDoc NoExtField _ -> notImplemented "IEDoc"

71 IEDoc NoExtField _ -> notImplemented "IEDoc"

170 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

72 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

171 XIE x -> noExtCon x

73 XIE x -> noExtCon x

172

74

173−-- | Like 'compareIewn' for located wrapped names.

174−compareLIewn :: LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering

175−compareLIewn = compareIewn `on` unLoc

176−

177-- | Compare two @'IEWrapppedName' 'RdrName'@ things.

75-- | Compare two @'IEWrapppedName' 'RdrName'@ things.

178compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering

76compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering

179−compareIewn (IEName x) (IEName y) = unLoc x `compareRdrName` unLoc y

77+compareIewn (IEName x) (IEName y) = unLoc x `compare` unLoc y

180compareIewn (IEName _) (IEPattern _) = LT

78compareIewn (IEName _) (IEPattern _) = LT

181compareIewn (IEName _) (IEType _) = LT

79compareIewn (IEName _) (IEType _) = LT

182compareIewn (IEPattern _) (IEName _) = GT

80compareIewn (IEPattern _) (IEName _) = GT

183−compareIewn (IEPattern x) (IEPattern y) = unLoc x `compareRdrName` unLoc y

81+compareIewn (IEPattern x) (IEPattern y) = unLoc x `compare` unLoc y

184compareIewn (IEPattern _) (IEType _) = LT

82compareIewn (IEPattern _) (IEType _) = LT

185compareIewn (IEType _) (IEName _) = GT

83compareIewn (IEType _) (IEName _) = GT

186compareIewn (IEType _) (IEPattern _) = GT

84compareIewn (IEType _) (IEPattern _) = GT

187−compareIewn (IEType x) (IEType y) = unLoc x `compareRdrName` unLoc y

85+compareIewn (IEType x) (IEType y) = unLoc x `compare` unLoc y

188−

189−compareRdrName :: RdrName -> RdrName -> Ordering

190−compareRdrName x y =

191− case (getNameStr x, getNameStr y) of

192− ([], []) -> EQ

193− ((_ : _), []) -> GT

194− ([], (_ : _)) -> LT

195− ((x' : _), (y' : _)) ->

196− case (isAlphaNum x', isAlphaNum y') of

197− (False, False) -> x `compare` y

198− (True, False) -> LT

199− (False, True) -> GT

200− (True, True) -> x `compare` y

201− where

202− getNameStr = showOutputable . rdrNameOcc

src/Ormolu/Parser.hs+3−5

@@ -32,7 +32,7 @@ import Ormolu.Parser.Anns

32import Ormolu.Parser.CommentStream

33import Ormolu.Parser.Result

34import Ormolu.Processing.Preprocess (preprocess)

35−import Ormolu.Utils (incSpanLine, removeIndentation)

35+import Ormolu.Utils (incSpanLine)

36import qualified Panic as GHC

37import qualified Parser as GHC

38import qualified StringBuffer as GHC

@@ -51,9 +51,8 @@ parseModule ::

51 Either (SrcSpan, String) ParseResult

52 )

53parseModule Config {..} path rawInput = liftIO $ do

54− let (literalPrefix, indentedInput, literalSuffix, extraComments) =

54+ let (literalPrefix, input, literalSuffix, extraComments) =

55 preprocess path rawInput cfgRegion

56− (input, indent) = removeIndentation indentedInput

57 -- It's important that 'setDefaultExts' is done before

56 -- It's important that 'setDefaultExts' is done before

58 -- 'parsePragmasIntoDynFlags', because otherwise we might enable an

57 -- 'parsePragmasIntoDynFlags', because otherwise we might enable an

59 -- extension that was explicitly disabled in the file.

58 -- extension that was explicitly disabled in the file.

@@ -111,8 +110,7 @@ parseModule Config {..} path rawInput = liftIO $ do

111 prImportQualifiedPost =

110 prImportQualifiedPost =

112 GHC.xopt ImportQualifiedPost dynFlags,

111 GHC.xopt ImportQualifiedPost dynFlags,

113 prLiteralPrefix = T.pack literalPrefix,

112 prLiteralPrefix = T.pack literalPrefix,

114− prLiteralSuffix = T.pack literalSuffix,

113+ prLiteralSuffix = T.pack literalSuffix

115− prIndent = indent

116 }

114 }

117 return (warnings, r)

115 return (warnings, r)

118

116

src/Ormolu/Parser/CommentStream.hs+26−54

@@ -27,8 +27,7 @@ import qualified GHC

27import qualified Lexer as GHC

28import Ormolu.Parser.Pragma

29import Ormolu.Parser.Shebang

30−import Ormolu.Processing.Common

31−import Ormolu.Utils (onTheSameLine, showOutputable)

30+import Ormolu.Utils (showOutputable)

32import SrcLoc

31import SrcLoc

33

32

34----------------------------------------------------------------------------

33----------------------------------------------------------------------------

@@ -104,21 +103,17 @@ mkComment ::

104mkComment ls (L l s) = (ls', comment)

103mkComment ls (L l s) = (ls', comment)

105 where

104 where

106 comment =

105 comment =

107− L l . Comment atomsBefore . removeConseqBlanks . fmap dropTrailing $

106+ L l . Comment atomsBefore . fmap dropTrailing $

108 if "{-" `L.isPrefixOf` s

107 if "{-" `L.isPrefixOf` s

109 then case NE.nonEmpty (lines s) of

108 then case NE.nonEmpty (lines s) of

110 Nothing -> s :| []

109 Nothing -> s :| []

111 Just (x :| xs) ->

110 Just (x :| xs) ->

112 let getIndent y =

111 let getIndent y =

113− if all isSpace y || y == endDisabling

112+ if all isSpace y

114 then startIndent

113 then startIndent

115 else length (takeWhile isSpace y)

114 else length (takeWhile isSpace y)

116 n = minimum (startIndent : fmap getIndent xs)

115 n = minimum (startIndent : fmap getIndent xs)

117− removeIndent y =

116+ in x :| (drop n <$> xs)

118− if y == endDisabling

119− then y

120− else drop n y

121− in x :| (removeIndent <$> xs)

122 else s :| []

117 else s :| []

123 (atomsBefore, ls') =

118 (atomsBefore, ls') =

124 case dropWhile ((< commentLine) . fst) ls of

119 case dropWhile ((< commentLine) . fst) ls of

@@ -148,9 +143,28 @@ isMultilineComment (Comment _ (x :| _)) = "{-" `L.isPrefixOf` x

148----------------------------------------------------------------------------

143----------------------------------------------------------------------------

149-- Helpers

144-- Helpers

150

145

146+-- | Get a 'String' from 'GHC.AnnotationComment'.

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

148+unAnnotationComment = \case

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

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

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

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

153+ GHC.AnnDocOptions s -> Just s

154+ GHC.AnnLineComment s -> Just s

155+ GHC.AnnBlockComment s -> Just s

156+

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

158+liftMaybe = \case

159+ L _ Nothing -> Nothing

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

161+

162+toRealSpan :: Located a -> Maybe (RealLocated a)

163+toRealSpan (L (RealSrcSpan l) a) = Just (L l a)

164+toRealSpan _ = Nothing

165+

151-- | Detect and extract stack header if it is present.

166-- | Detect and extract stack header if it is present.

152extractStackHeader ::

167extractStackHeader ::

153− -- | Comment stream to analyze

154 [RealLocated String] ->

168 [RealLocated String] ->

155 ([RealLocated String], Maybe (RealLocated Comment))

169 ([RealLocated String], Maybe (RealLocated Comment))

156extractStackHeader = \case

170extractStackHeader = \case

@@ -166,9 +180,7 @@ extractStackHeader = \case

166

180

167-- | Extract pragmas and their associated comments.

181-- | Extract pragmas and their associated comments.

168extractPragmas ::

182extractPragmas ::

169− -- | Input

170 String ->

183 String ->

171− -- | Comment stream to analyze

172 [RealLocated String] ->

184 [RealLocated String] ->

173 ([RealLocated Comment], [([RealLocated Comment], Pragma)])

185 ([RealLocated Comment], [([RealLocated Comment], Pragma)])

174extractPragmas input = go initialLs id id

186extractPragmas input = go initialLs id id

@@ -182,45 +194,5 @@ extractPragmas input = go initialLs id id

182 let (ls', x') = mkComment ls x

194 let (ls', x') = mkComment ls x

183 in go ls' (csSoFar . (x' :)) pragmasSoFar xs

195 in go ls' (csSoFar . (x' :)) pragmasSoFar xs

184 Just pragma ->

196 Just pragma ->

185− let combined ys = (csSoFar ys, pragma)

197+ let combined = (csSoFar [], pragma)

186− go' ls' ys rest = go ls' id (pragmasSoFar . (combined ys :)) rest

198+ in go ls id (pragmasSoFar . (combined :)) xs

187− in case xs of

188− [] -> go' ls [] xs

189− (y : ys) ->

190− let (ls', y') = mkComment ls y

191− in if onTheSameLine

192− (RealSrcSpan (getRealSrcSpan x))

193− (RealSrcSpan (getRealSrcSpan y))

194− then go' ls' [y'] ys

195− else go' ls [] xs

196−

197−-- | Get a 'String' from 'GHC.AnnotationComment'.

198−unAnnotationComment :: GHC.AnnotationComment -> Maybe String

199−unAnnotationComment = \case

200− GHC.AnnDocCommentNext _ -> Nothing -- @-- |@

201− GHC.AnnDocCommentPrev _ -> Nothing -- @-- ^@

202− GHC.AnnDocCommentNamed _ -> Nothing -- @-- $@

203− GHC.AnnDocSection _ _ -> Nothing -- @-- *@

204− GHC.AnnDocOptions s -> Just s

205− GHC.AnnLineComment s -> Just s

206− GHC.AnnBlockComment s -> Just s

207−

208−liftMaybe :: Located (Maybe a) -> Maybe (Located a)

209−liftMaybe = \case

210− L _ Nothing -> Nothing

211− L l (Just a) -> Just (L l a)

212−

213−toRealSpan :: Located a -> Maybe (RealLocated a)

214−toRealSpan (L (RealSrcSpan l) a) = Just (L l a)

215−toRealSpan _ = Nothing

216−

217−-- | Remove consecutive blank lines.

218−removeConseqBlanks :: NonEmpty String -> NonEmpty String

219−removeConseqBlanks (x :| xs) = x :| go (null x) id xs

220− where

221− go seenBlank acc = \case

222− [] -> acc []

223− (y : ys) ->

224− if seenBlank && null y

225− then go True acc ys

226− else go (null y) (acc . (y :)) ys

src/Ormolu/Parser/Result.hs+1−3

@@ -35,9 +35,7 @@ data ParseResult = ParseResult

35 -- | Literal prefix

36 prLiteralPrefix :: Text,

37 -- | Literal suffix

38− prLiteralSuffix :: Text,

38+ prLiteralSuffix :: Text

39− -- | Indentation level, can be non-zero in case of region formatting

40− prIndent :: Int

41 }

39 }

42

40

43-- | Pretty-print a 'ParseResult'.

41-- | Pretty-print a 'ParseResult'.

src/Ormolu/Printer.hs+1−1

@@ -23,7 +23,7 @@ printModule ParseResult {..} =

23 prLiteralPrefix <> region <> prLiteralSuffix

24 where

25 region =

26− postprocess prIndent $

26+ postprocess $

27 runR

28 ( p_hsModule

29 prStackHeader

src/Ormolu/Printer/Combinators.hs+7−28

@@ -21,7 +21,6 @@ module Ormolu.Printer.Combinators

21 space,

22 newline,

23 inci,

24− inciIf,

25 located,

24 located,

26 located',

25 located',

27 switchLayout,

26 switchLayout,

@@ -52,8 +51,6 @@ module Ormolu.Printer.Combinators

52

51

53 -- ** Literals

52 -- ** Literals

54 comma,

53 comma,

55− commaDel,

56− equals,

57

54

58 -- ** Stateful markers

55 -- ** Stateful markers

59 SpanMark (..),

56 SpanMark (..),

@@ -74,15 +71,6 @@ import SrcLoc

74----------------------------------------------------------------------------

71----------------------------------------------------------------------------

75-- Basic

72-- Basic

76

73

77−-- | Indent the inner expression if the first argument is 'True'.

78−inciIf ::

79− -- | Whether to indent

80− Bool ->

81− -- | The expression to indent

82− R () ->

83− R ()

84−inciIf b m = if b then inci m else m

85−

86-- | Enter a 'Located' entity. This combinator handles outputting comments

74-- | Enter a 'Located' entity. This combinator handles outputting comments

87-- and sets layout (single-line vs multi-line) for the inner computation.

75-- and sets layout (single-line vs multi-line) for the inner computation.

88-- Roughly, the rule for using 'located' is that every time there is a

76-- Roughly, the rule for using 'located' is that every time there is a

@@ -185,12 +173,10 @@ sepSemi f xs = vlayout singleLine multiLine

185 xs' ->

173 xs' ->

186 if ub

174 if ub

187 then do

175 then do

188− txt "{"

176+ txt "{ "

189− space

190− sep (txt ";" >> space) (dontUseBraces . f) xs'

177+ sep (txt "; ") (dontUseBraces . f) xs'

191− space

192− txt "}"

178+ txt " }"

193− else sep (txt ";" >> space) f xs'

179+ else sep (txt "; ") f xs'

194 multiLine =

180 multiLine =

195 sep newline (dontUseBraces . f) xs

181 sep newline (dontUseBraces . f) xs

196

182

@@ -203,7 +189,6 @@ data BracketStyle

203 N

189 N

204 | -- | Shifted one level

190 | -- | Shifted one level

205 S

191 S

206− deriving (Eq, Show)

207

192

208-- | Surround given entity by backticks.

193-- | Surround given entity by backticks.

209backticks :: R () -> R ()

194backticks :: R () -> R ()

@@ -280,7 +265,9 @@ brackets_ needBreaks open close style m = sitcc (vlayout singleLine multiLine)

280 then newline >> inci m

265 then newline >> inci m

281 else space >> sitcc m

266 else space >> sitcc m

282 newline

267 newline

268+ case style of

269+ N -> txt close

283− inciIf (style == S) (txt close)

270+ S -> inci (txt close)

284

271

285----------------------------------------------------------------------------

272----------------------------------------------------------------------------

286-- Literals

273-- Literals

@@ -288,11 +275,3 @@ brackets_ needBreaks open close style m = sitcc (vlayout singleLine multiLine)

288-- | Print @,@.

275-- | Print @,@.

289comma :: R ()

276comma :: R ()

290comma = txt ","

277comma = txt ","

291−

292−-- | Delimiting combination with 'comma'. To be used with 'sep'.

293−commaDel :: R ()

294−commaDel = comma >> breakpoint

295−

296−-- | Print @=@. Do not use @'txt' "="@.

297−equals :: R ()

298−equals = interferingTxt "="

src/Ormolu/Printer/Comments.hs+5−8

@@ -14,7 +14,6 @@ where

14

15import Control.Monad

16import qualified Data.List.NonEmpty as NE

17−import Data.Maybe (listToMaybe)

18import qualified Data.Text as T

17import qualified Data.Text as T

19import Ormolu.Parser.CommentStream

18import Ormolu.Parser.CommentStream

20import Ormolu.Printer.Internal

19import Ormolu.Printer.Internal

@@ -67,11 +66,9 @@ spitPrecedingComment ref = do

67 let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref

66 let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref

68 withPoppedComment p $ \l comment -> do

67 withPoppedComment p $ \l comment -> do

69 lineSpans <- thisLineSpans

68 lineSpans <- thisLineSpans

69+ let ls = srcLocLine . realSrcSpanEnd <$> lineSpans

70− let thisCommentLine = srcLocLine (realSrcSpanStart l)

70+ thisCommentLine = srcLocLine (realSrcSpanStart l)

71− needsNewline =

71+ needsNewline = any (/= thisCommentLine) ls

72− case listToMaybe lineSpans of

73− Nothing -> False

74− Just spn -> srcLocLine (realSrcSpanEnd spn) /= thisCommentLine

75 when (needsNewline || needsNewlineBefore l mlastMark) newline

72 when (needsNewline || needsNewlineBefore l mlastMark) newline

76 spitCommentNow l comment

73 spitCommentNow l comment

77 if theSameLinePre l ref

74 if theSameLinePre l ref

@@ -154,7 +151,6 @@ needsNewlineBefore ::

154 -- | Last printed comment span

151 -- | Last printed comment span

155 Maybe SpanMark ->

152 Maybe SpanMark ->

156 Bool

153 Bool

157−needsNewlineBefore _ (Just (HaddockSpan _ _)) = True

158needsNewlineBefore l mlastMark =

154needsNewlineBefore l mlastMark =

159 case spanMarkSpan <$> mlastMark of

155 case spanMarkSpan <$> mlastMark of

160 Nothing -> False

156 Nothing -> False

@@ -239,7 +235,8 @@ commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =

239 -- lexemes in front of it and goes right after the previous comment.

235 -- lexemes in front of it and goes right after the previous comment.

240 not (hasAtomsBefore comment)

236 not (hasAtomsBefore comment)

241 && ( case mlastMark of

237 && ( case mlastMark of

242− Just (HaddockSpan _ _) -> False

238+ Just (HaddockSpan _ spn) ->

239+ srcSpanEndLine spn + 1 == srcSpanStartLine l

243 Just (CommentSpan spn) ->

240 Just (CommentSpan spn) ->

244 srcSpanEndLine spn + 1 == srcSpanStartLine l

241 srcSpanEndLine spn + 1 == srcSpanStartLine l

245 _ -> False

242 _ -> False

src/Ormolu/Printer/Internal.hs+39−67

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

14

15 -- * Internal functions

16 txt,

17− interferingTxt,

18 atom,

17 atom,

19 space,

18 space,

20 newline,

19 newline,

@@ -99,8 +98,6 @@ data RC = RC

99data SC = SC

98data SC = SC

100 { -- | Index of the next column to render

99 { -- | Index of the next column to render

101 scColumn :: !Int,

100 scColumn :: !Int,

102− -- | Indentation level that was used for the current line

103− scIndent :: !Int,

104 -- | Rendered source code so far

101 -- | Rendered source code so far

105 scBuilder :: Builder,

102 scBuilder :: Builder,

106 -- | Span stream

103 -- | Span stream

@@ -111,7 +108,7 @@ data SC = SC

111 scCommentStream :: CommentStream,

108 scCommentStream :: CommentStream,

112 -- | Pending comment lines (in reverse order) to be inserted before next

109 -- | Pending comment lines (in reverse order) to be inserted before next

113 -- newline, 'Int' is the indentation level

110 -- newline, 'Int' is the indentation level

114− scPendingComments :: ![(CommentPosition, Text)],

111+ scPendingComments :: ![(CommentPosition, Int, Text)],

115 -- | Whether to output a space before the next output

112 -- | Whether to output a space before the next output

116 scRequestedDelimiter :: !RequestedDelimiter,

113 scRequestedDelimiter :: !RequestedDelimiter,

117 -- | An auxiliary marker for keeping track of last output element

114 -- | An auxiliary marker for keeping track of last output element

@@ -177,7 +174,6 @@ runR (R m) sstream cstream anns recDot =

177 sc =

174 sc =

178 SC

175 SC

179 { scColumn = 0,

176 { scColumn = 0,

180− scIndent = 0,

181 scBuilder = mempty,

177 scBuilder = mempty,

182 scSpanStream = sstream,

178 scSpanStream = sstream,

183 scThisLineSpans = [],

179 scThisLineSpans = [],

@@ -190,23 +186,6 @@ runR (R m) sstream cstream anns recDot =

190----------------------------------------------------------------------------

186----------------------------------------------------------------------------

191-- Internal functions

187-- Internal functions

192

188

193−-- | Type of the thing to output. Influences the primary low-level rendering

194−-- function 'spit'.

195−data SpitType

196− = -- | Simple opaque text that breaks comment series.

197− SimpleText

198− | -- | Like 'SimpleText', but assume that when this text is inserted it

199− -- will separate an 'Atom' and its pending comments, so insert an extra

200− -- 'newline' in that case to force the pending comments and continue on

201− -- a fresh line.

202− InterferingText

203− | -- | An atom that typically have span information in the AST and can

204− -- have comments attached to it.

205− Atom

206− | -- | Used for rendering comment lines.

207− CommentPart

208− deriving (Show, Eq)

209−

210-- | Output a fixed 'Text' fragment. The argument may not contain any line

189-- | Output a fixed 'Text' fragment. The argument may not contain any line

211-- breaks. 'txt' is used to output all sorts of “fixed” bits of syntax like

190-- breaks. 'txt' is used to output all sorts of “fixed” bits of syntax like

212-- keywords and pipes @|@ in functional dependencies.

191-- keywords and pipes @|@ in functional dependencies.

@@ -218,15 +197,7 @@ txt ::

218 -- | 'Text' to output

197 -- | 'Text' to output

219 Text ->

198 Text ->

220 R ()

199 R ()

221−txt = spit SimpleText

200+txt = spit False False

222−

223−-- | Similar to 'txt' but the text inserted this way is assumed to break the

224−-- “link” between the preceding atom and its pending comments.

225−interferingTxt ::

226− -- | 'Text' to output

227− Text ->

228− R ()

229−interferingTxt = spit InterferingText

230

201

231-- | Output 'Outputable' fragment of AST. This can be used to output numeric

202-- | Output 'Outputable' fragment of AST. This can be used to output numeric

232-- literals and similar. Everything that doesn't have inner structure but

203-- literals and similar. Everything that doesn't have inner structure but

@@ -235,60 +206,54 @@ atom ::

235 Outputable a =>

206 Outputable a =>

236 a ->

207 a ->

237 R ()

208 R ()

238−atom = spit Atom . T.pack . showOutputable

209+atom = spit True False . T.pack . showOutputable

239

210

240-- | Low-level non-public helper to define 'txt' and 'atom'.

211-- | Low-level non-public helper to define 'txt' and 'atom'.

241spit ::

212spit ::

242− -- | Type of the thing to spit

213+ -- | Whether to register the outermost enclosing span

243− SpitType ->

214+ Bool ->

215+ -- | Used during outputting of pending comments?

216+ Bool ->

244 -- | 'Text' to output

217 -- | 'Text' to output

245 Text ->

218 Text ->

246 R ()

219 R ()

247−spit _ "" = return ()

220+spit registerSpan printingComments text = do

248−spit stype text = do

249 requestedDel <- R (gets scRequestedDelimiter)

221 requestedDel <- R (gets scRequestedDelimiter)

250− pendingComments <- R (gets scPendingComments)

251− when (stype == InterferingText && not (null pendingComments)) newline

252 case requestedDel of

222 case requestedDel of

253 RequestedNewline -> do

223 RequestedNewline -> do

254 R . modify $ \sc ->

224 R . modify $ \sc ->

255 sc

225 sc

256 { scRequestedDelimiter = RequestedNothing

226 { scRequestedDelimiter = RequestedNothing

257 }

227 }

258− case stype of

228+ if printingComments

259− CommentPart -> newlineRaw

229+ then newlineRaw

260− _ -> newline

230+ else newline

261 _ -> return ()

231 _ -> return ()

262 R $ do

232 R $ do

263 i <- asks rcIndent

233 i <- asks rcIndent

264 c <- gets scColumn

234 c <- gets scColumn

265− closestEnclosing <- listToMaybe <$> asks rcEnclosingSpans

235+ outermostEnclosing <- listToMaybe <$> asks rcEnclosingSpans

266− let indentedTxt = spaces <> text

236+ let spaces =

237+ if c < i

267− spaces = T.replicate spacesN " "

238+ then T.replicate (i - c) " "

268− spacesN =

269− if c == 0

270− then i

271− else bool 0 1 (requestedDel == RequestedSpace)

239+ else bool mempty " " (requestedDel == RequestedSpace)

240+ indentedTxt = spaces <> text

272 modify $ \sc ->

241 modify $ \sc ->

273 sc

242 sc

274 { scBuilder = scBuilder sc <> fromText indentedTxt,

243 { scBuilder = scBuilder sc <> fromText indentedTxt,

275 scColumn = scColumn sc + T.length indentedTxt,

244 scColumn = scColumn sc + T.length indentedTxt,

276− scIndent =

277− if c == 0

278− then i

279− else scIndent sc,

280 scThisLineSpans =

245 scThisLineSpans =

281 let xs = scThisLineSpans sc

246 let xs = scThisLineSpans sc

282− in case stype of

247+ in if registerSpan

283− Atom -> case closestEnclosing of

248+ then case outermostEnclosing of

284 Nothing -> xs

249 Nothing -> xs

285 Just x -> x : xs

250 Just x -> x : xs

286− _ -> xs,

251+ else xs,

287 scRequestedDelimiter = RequestedNothing,

252 scRequestedDelimiter = RequestedNothing,

288 scSpanMark =

253 scSpanMark =

289 -- If there are pending comments, do not reset last comment

254 -- If there are pending comments, do not reset last comment

290 -- location.

255 -- location.

291− if (stype == CommentPart) || (not . null . scPendingComments) sc

256+ if printingComments || (not . null . scPendingComments) sc

292 then scSpanMark sc

257 then scSpanMark sc

293 else Nothing

258 else Nothing

294 }

259 }

@@ -320,22 +285,21 @@ space = R . modify $ \sc ->

320-- hard to output more than one blank newline in a row.

285-- hard to output more than one blank newline in a row.

321newline :: R ()

286newline :: R ()

322newline = do

287newline = do

323− indent <- R (gets scIndent)

324 cs <- reverse <$> R (gets scPendingComments)

288 cs <- reverse <$> R (gets scPendingComments)

325 case cs of

289 case cs of

326 [] -> newlineRaw

290 [] -> newlineRaw

327− ((position, _) : _) -> do

291+ ((position, _, _) : _) -> do

328 case position of

292 case position of

329 OnTheSameLine -> space

293 OnTheSameLine -> space

330 OnNextLine -> newlineRaw

294 OnNextLine -> newlineRaw

331− R . forM_ cs $ \(_, text) ->

295+ R . forM_ cs $ \(_, indent, text) ->

332 let modRC rc =

296 let modRC rc =

333 rc

297 rc

334 { rcIndent = indent

298 { rcIndent = indent

335 }

299 }

336 R m = do

300 R m = do

337 unless (T.null text) $

301 unless (T.null text) $

338− spit CommentPart text

302+ spit False True text

339 newlineRaw

303 newlineRaw

340 in local modRC m

304 in local modRC m

341 R . modify $ \sc ->

305 R . modify $ \sc ->

@@ -356,7 +320,6 @@ newlineRaw = R . modify $ \sc ->

356 VeryBeginning -> builderSoFar

320 VeryBeginning -> builderSoFar

357 _ -> builderSoFar <> "\n",

321 _ -> builderSoFar <> "\n",

358 scColumn = 0,

322 scColumn = 0,

359− scIndent = 0,

360 scThisLineSpans = [],

323 scThisLineSpans = [],

361 scRequestedDelimiter = case scRequestedDelimiter sc of

324 scRequestedDelimiter = case scRequestedDelimiter sc of

362 AfterNewline -> RequestedNewline

325 AfterNewline -> RequestedNewline

@@ -367,7 +330,7 @@ newlineRaw = R . modify $ \sc ->

367

330

368-- | Return 'True' if we should print record dot syntax.

331-- | Return 'True' if we should print record dot syntax.

369useRecordDot :: R Bool

332useRecordDot :: R Bool

370−useRecordDot = R (asks rcUseRecDot)

333+useRecordDot = R $ asks rcUseRecDot

371

334

372-- | Increase indentation level by one indentation step for the inner

335-- | Increase indentation level by one indentation step for the inner

373-- computation. 'inci' should be used when a part of code must be more

336-- computation. 'inci' should be used when a part of code must be more

@@ -384,7 +347,8 @@ inci (R m) = R (local modRC m)

384

347

385-- | Set indentation level for the inner computation equal to current

348-- | Set indentation level for the inner computation equal to current

386-- column. This makes sure that the entire inner block is uniformly

349-- column. This makes sure that the entire inner block is uniformly

387−-- \"shifted\" to the right.

350+-- \"shifted\" to the right. Only works (and makes sense) when enclosing

351+-- layout is multi-line.

388sitcc :: R () -> R ()

352sitcc :: R () -> R ()

389sitcc (R m) = do

353sitcc (R m) = do

390 requestedDel <- R (gets scRequestedDelimiter)

354 requestedDel <- R (gets scRequestedDelimiter)

@@ -392,9 +356,16 @@ sitcc (R m) = do

392 c <- R (gets scColumn)

356 c <- R (gets scColumn)

393 let modRC rc =

357 let modRC rc =

394 rc

358 rc

395− { rcIndent = max i (c + bool 0 1 (requestedDel == RequestedSpace))

359+ { rcIndent = max i c + bool 0 1 (requestedDel == RequestedSpace)

396 }

360 }

361+ vlayout (R m) . R $ do

362+ modify $ \sc ->

363+ sc

364+ { scRequestedDelimiter = case requestedDel of

365+ RequestedSpace -> RequestedNothing

366+ other -> other

367+ }

397− R (local modRC m)

368+ local modRC m

398

369

399-- | Set 'Layout' for internal computation.

370-- | Set 'Layout' for internal computation.

400enterLayout :: Layout -> R () -> R ()

371enterLayout :: Layout -> R () -> R ()

@@ -436,9 +407,10 @@ registerPendingCommentLine ::

436 Text ->

407 Text ->

437 R ()

408 R ()

438registerPendingCommentLine position text = R $ do

409registerPendingCommentLine position text = R $ do

410+ i <- asks rcIndent

439 modify $ \sc ->

411 modify $ \sc ->

440 sc

412 sc

441− { scPendingComments = (position, text) : scPendingComments sc

413+ { scPendingComments = (position, i, text) : scPendingComments sc

442 }

414 }

443

415

444-- | Drop elements that begin before or at the same place as given

416-- | Drop elements that begin before or at the same place as given

@@ -567,7 +539,7 @@ dontUseBraces (R r) = R (local (\i -> i {rcCanUseBraces = False}) r)

567

539

568-- | Return 'True' if we can use braces in this context.

540-- | Return 'True' if we can use braces in this context.

569canUseBraces :: R Bool

541canUseBraces :: R Bool

570−canUseBraces = R (asks rcCanUseBraces)

542+canUseBraces = R $ asks rcCanUseBraces

571

543

572----------------------------------------------------------------------------

544----------------------------------------------------------------------------

573-- Constants

545-- Constants

src/Ormolu/Printer/Meat/Common.hs+10−11

@@ -114,14 +114,14 @@ p_qualName mname occName = do

114p_infixDefHelper ::

115 -- | Whether to format in infix style

116 Bool ->

117− -- | Whether to bump indentation for arguments

117+ -- | Indentation-bumping wrapper

118− Bool ->

118+ (R () -> R ()) ->

119 -- | How to print the operator\/name

120 R () ->

121 -- | How to print the arguments

122 [R ()] ->

123 R ()

124−p_infixDefHelper isInfix indentArgs name args =

124+p_infixDefHelper isInfix inci' name args =

125 case (isInfix, args) of

126 (True, p0 : p1 : ps) -> do

127 let parens' =

@@ -131,18 +131,18 @@ p_infixDefHelper isInfix indentArgs name args =

131 parens' $ do

132 p0

133 breakpoint

134− inci . sitcc $ do

134+ inci $ sitcc $ do

135 name

136 space

137 p1

138− unless (null ps) . inciIf indentArgs $ do

138+ unless (null ps) . inci' $ do

139 breakpoint

140 sitcc (sep breakpoint sitcc ps)

141 (_, ps) -> do

142 name

143 unless (null ps) $ do

144 breakpoint

145− inciIf indentArgs $ sitcc (sep breakpoint sitcc args)

145+ inci' $ sitcc (sep breakpoint sitcc args)

146

147-- | Print a Haddock.

148p_hsDocString ::

@@ -154,11 +154,10 @@ p_hsDocString ::

154 LHsDocString ->

155 R ()

156p_hsDocString hstyle needsNewline (L l str) = do

157− let isCommentSpan = \case

157+ goesAfterComment <- getSpanMark >>= \case

158− HaddockSpan _ _ -> True

158+ Just (HaddockSpan _ _) -> return True

159− CommentSpan _ -> True

159+ Just (CommentSpan _) -> return True

160− _ -> False

160+ _ -> return False

161− goesAfterComment <- maybe False isCommentSpan <$> getSpanMark

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

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

163 when goesAfterComment newline

162 when goesAfterComment newline

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

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

src/Ormolu/Printer/Meat/Declaration.hs+14−26

@@ -12,7 +12,7 @@ module Ormolu.Printer.Meat.Declaration

12where

13

14import Data.List (sort)

15−import Data.List.NonEmpty (NonEmpty (..), (<|))

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

16import qualified Data.List.NonEmpty as NE

17import GHC hiding (InlinePragma)

18import OccName (occNameFS)

@@ -54,13 +54,12 @@ p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

54p_hsDeclsRespectGrouping = p_hsDecls' Respect

55

56p_hsDecls' :: UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R ()

57−p_hsDecls' grouping style decls =

57+p_hsDecls' grouping style decls = sepSemi id $

58− sepSemi id $

59− -- Return a list of rendered declarations, adding a newline to separate

58+ -- Return a list of rendered declarations, adding a newline to separate

60− -- groups.

59+ -- groups.

61− case groupDecls decls of

60+ case groupDecls decls of

62− [] -> []

61+ [] -> []

63− (x : xs) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)

62+ (x : xs) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)

64 where

63 where

65 renderGroup = NE.toList . fmap (located' $ dontUseBraces . p_hsDecl style)

64 renderGroup = NE.toList . fmap (located' $ dontUseBraces . p_hsDecl style)

66 renderGroupWithPrev prev curr =

65 renderGroupWithPrev prev curr =

@@ -85,6 +84,9 @@ isDocumented = any (isHaddock . unLoc)

85 isHaddock _ = False

84 isHaddock _ = False

86

85

87-- | Group relevant declarations together.

86-- | Group relevant declarations together.

87+--

88+-- Add a declaration to a group iff it is relevant to either the first or

89+-- the preceding declaration in the group.

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

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

89groupDecls [] = []

91groupDecls [] = []

90groupDecls (l@(L _ DocNext) : xs) =

92groupDecls (l@(L _ DocNext) : xs) =

@@ -97,8 +99,7 @@ groupDecls (header : xs) =

97 let (grp, rest) = flip span (zip (header : xs) xs) $ \(previous, current) ->

99 let (grp, rest) = flip span (zip (header : xs) xs) $ \(previous, current) ->

98 let relevantToHdr = groupedDecls header current

100 let relevantToHdr = groupedDecls header current

99 relevantToPrev = groupedDecls previous current

101 relevantToPrev = groupedDecls previous current

100− isDeclSeries = declSeries previous current

101− in isDeclSeries || relevantToHdr || relevantToPrev

102+ in relevantToHdr || relevantToPrev

102 in (header :| map snd grp) : groupDecls (map snd rest)

103 in (header :| map snd grp) : groupDecls (map snd rest)

103

104

104p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()

105p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()

@@ -195,18 +196,6 @@ groupedDecls (L l_x x') (L l_y y') =

195 (_, DocPrev) -> True

196 (_, DocPrev) -> True

196 _ -> False

197 _ -> False

197

198

198−-- | Detect declaration series that should not have blanks between them.

199−declSeries ::

200− LHsDecl GhcPs ->

201− LHsDecl GhcPs ->

202− Bool

203−declSeries (L _ x) (L _ y) =

204− case (x, y) of

205− ( SigD NoExtField (TypeSig NoExtField _ _),

206− SigD NoExtField (TypeSig NoExtField _ _)

207− ) -> True

208− _ -> False

209−

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

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

211intersects a b = go (sort a) (sort b)

200intersects a b = go (sort a) (sort b)

212 where

201 where

@@ -299,10 +288,9 @@ patSigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc

299patSigRdrNames _ = Nothing

288patSigRdrNames _ = Nothing

300

289

301warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

290warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

302−warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $

291+warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $ flip concatMap ws $ \case

303− flip concatMap ws $ \case

304− L _ (Warning NoExtField ns _) -> map unLoc ns

292+ L _ (Warning NoExtField ns _) -> map unLoc ns

305− L _ (XWarnDecl x) -> noExtCon x

293+ L _ (XWarnDecl x) -> noExtCon x

306warnSigRdrNames _ = Nothing

294warnSigRdrNames _ = Nothing

307

295

308patBindNames :: Pat GhcPs -> [RdrName]

296patBindNames :: Pat GhcPs -> [RdrName]

src/Ormolu/Printer/Meat/Declaration.hs-boot+1

@@ -9,4 +9,5 @@ import Ormolu.Printer.Combinators

9import Ormolu.Printer.Meat.Common

10

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

12+

12p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

13p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

src/Ormolu/Printer/Meat/Declaration/Class.hs+2−2

@@ -58,7 +58,7 @@ p_classDecl ctx name HsQTvs {..} fixity fdeps csigs cdefs cats catdefs cdocs = d

58 switchLayout signatureSpans $

59 p_infixDefHelper

60 (isInfix fixity)

61− True

61+ inci

62 (p_rdrName name)

63 (located' p_hsTyVarBndr <$> hsq_explicit)

64 inci (p_classFundeps fdeps)

@@ -82,7 +82,7 @@ p_classFundeps fdeps = unless (null fdeps) $ do

82 breakpoint

83 txt "|"

84 space

85− inci $ sep commaDel (sitcc . located' p_funDep) fdeps

85+ sitcc $ sep (comma >> breakpoint) (sitcc . located' p_funDep) fdeps

86

87p_funDep :: FunDep (Located RdrName) -> R ()

88p_funDep (before, after) = do

src/Ormolu/Printer/Meat/Declaration/Data.hs+31−34

@@ -41,7 +41,7 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do

41 inci $

42 p_infixDefHelper

43 (isInfix fixity)

44− True

44+ inci

45 (p_rdrName name)

46 (located' p_hsType <$> tpats)

47 case dd_kindSig of

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

60 txt "where"

61 breakpoint

62 sepSemi (located' (p_conDecl False)) dd_cons

63− else switchLayout (getLoc name : (getLoc <$> dd_cons)) . inci $ do

63+ else switchLayout (getLoc name : (getLoc <$> dd_cons))

64+ $ inci

65+ $ do

64− let singleConstRec = isSingleConstRec dd_cons

66+ let singleConstRec = isSingleConstRec dd_cons

65− if singleConstRec

67+ if singleConstRec

66− then space

68+ then space

67− else

68− if hasHaddocks dd_cons

69− then newline

70− else breakpoint

69+ else breakpoint

71− equals

70+ txt "="

72− space

71+ space

73− layout <- getLayout

74− let s =

72+ let s =

75− if layout == MultiLine || hasHaddocks dd_cons

73+ vlayout

76− then newline >> txt "|" >> space

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

77− else space >> txt "|" >> space

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

78− sitcc' =

76+ sitcc' =

79− if singleConstRec

77+ if singleConstRec

80− then id

78+ then id

81− else sitcc

79+ else sitcc

82− sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons

80+ sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons

83 unless (null $ unLoc dd_derivs) breakpoint

81 unless (null $ unLoc dd_derivs) breakpoint

84 inci . located dd_derivs $ \xs ->

82 inci . located dd_derivs $ \xs ->

85 sep newline (located' p_hsDerivingClause) xs

83 sep newline (located' p_hsDerivingClause) xs

@@ -104,10 +102,11 @@ p_conDecl singleConstRec = \case

104 (c : cs) -> do

102 (c : cs) -> do

105 p_rdrName c

103 p_rdrName c

106 unless (null cs) . inci $ do

104 unless (null cs) . inci $ do

107− commaDel

105+ comma

106+ breakpoint

108− sep commaDel p_rdrName cs

107+ sitcc $ sep (comma >> breakpoint) p_rdrName cs

108+ space

109 inci $ do

110− space

111 txt "::"

110 txt "::"

112 let interArgBreak =

111 let interArgBreak =

113 if hasDocStrings (unLoc con_res_ty)

112 if hasDocStrings (unLoc con_res_ty)

@@ -151,11 +150,15 @@ p_conDecl singleConstRec = \case

151 PrefixCon xs -> do

150 PrefixCon xs -> do

152 p_rdrName con_name

151 p_rdrName con_name

153 unless (null xs) breakpoint

152 unless (null xs) breakpoint

154− inci . sitcc $ sep breakpoint (sitcc . located' p_hsTypePostDoc) xs

153+ inci . sitcc $ sep breakpoint (sitcc . located' p_hsType) xs

155 RecCon l -> do

154 RecCon l -> do

156 p_rdrName con_name

155 p_rdrName con_name

157 breakpoint

156 breakpoint

157+ let inci' =

158+ if singleConstRec

159+ then id

160+ else inci

158− inciIf (not singleConstRec) (located l p_conDeclFields)

161+ inci' (located l p_conDeclFields)

159 InfixCon x y -> do

162 InfixCon x y -> do

160 located x p_hsType

163 located x p_hsType

161 breakpoint

164 breakpoint

@@ -204,9 +207,9 @@ p_hsDerivingClause HsDerivingClause {..} = do

204 let derivingWhat = located deriv_clause_tys $ \case

207 let derivingWhat = located deriv_clause_tys $ \case

205 [] -> txt "()"

208 [] -> txt "()"

206 xs ->

209 xs ->

207− parens N $

210+ parens N . sitcc $

208 sep

211 sep

209− commaDel

212+ (comma >> breakpoint)

210 (sitcc . located' p_hsType . hsib_body)

213 (sitcc . located' p_hsType . hsib_body)

211 xs

214 xs

212 space

215 space

@@ -253,9 +256,3 @@ isSingleConstRec [(L _ ConDeclH98 {..})] =

253 RecCon _ -> True

256 RecCon _ -> True

254 _ -> False

257 _ -> False

255isSingleConstRec _ = False

258isSingleConstRec _ = False

256−

257−hasHaddocks :: [LConDecl GhcPs] -> Bool

258−hasHaddocks = any (f . unLoc)

259− where

260− f ConDeclH98 {..} = isJust con_doc

261− f _ = False

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

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

15 DefaultDecl NoExtField ts -> do

16 txt "default"

17 breakpoint

18− inci . parens N $

18+ inci . parens N . sitcc $

19− sep commaDel (sitcc . located' p_hsType) ts

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

20 XDefaultDecl x -> noExtCon x

src/Ormolu/Printer/Meat/Declaration/Instance.hs+9−5

@@ -32,7 +32,9 @@ p_standaloneDerivDecl DerivDecl {..} = do

32 txt "instance"

33 breakpoint

34 match_overlap_mode deriv_overlap_mode breakpoint

35+ if toIndent

36+ then inci typesAfterInstance

35− inciIf toIndent typesAfterInstance

37+ else typesAfterInstance

36 txt "deriving"

38 txt "deriving"

37 space

39 space

38 case deriv_strategy of

40 case deriv_strategy of

@@ -88,10 +90,12 @@ p_clsInstDecl = \case

88 unless (null allDecls) $ do

90 unless (null allDecls) $ do

89 breakpoint

91 breakpoint

90 txt "where"

92 txt "where"

91− unless (null allDecls) . inci $ do

93+ unless (null allDecls)

94+ $ inci

95+ $ do

92− -- Ensure whitespace is added after where clause.

96+ -- Ensure whitespace is added after where clause.

93− breakpoint

97+ breakpoint

94− dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

98+ dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

95 XHsImplicitBndrs x -> noExtCon x

99 XHsImplicitBndrs x -> noExtCon x

96 XClsInstDecl x -> noExtCon x

100 XClsInstDecl x -> noExtCon x

97

101

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

@@ -18,7 +18,7 @@ import Ormolu.Printer.Meat.Type

18p_ruleDecls :: RuleDecls GhcPs -> R ()

19p_ruleDecls = \case

20 HsRules NoExtField _ xs ->

21− pragma "RULES" $

21+ pragma "RULES" . sitcc $

22 sep breakpoint (sitcc . located' p_ruleDecl) xs

23 XRuleDecls x -> noExtCon x

24

@@ -43,7 +43,7 @@ p_ruleDecl = \case

43 inci $ do

44 located lhs p_hsExpr

45 space

46− equals

46+ txt "="

47 inci $ do

48 breakpoint

49 located rhs p_hsExpr

src/Ormolu/Printer/Meat/Declaration/Signature.hs+28−25

@@ -14,6 +14,7 @@ where

14import BasicTypes

15import BooleanFormula

16import Control.Monad

17+import Data.Bool (bool)

17import GHC

18import GHC

18import Ormolu.Printer.Combinators

19import Ormolu.Printer.Combinators

19import Ormolu.Printer.Meat.Common

20import Ormolu.Printer.Meat.Common

@@ -47,22 +48,25 @@ p_typeSig indentTail (n : ns) hswc = do

47 p_rdrName n

48 p_rdrName n

48 if null ns

49 if null ns

49 then p_typeAscription hswc

50 then p_typeAscription hswc

51+ else do

52+ comma

53+ breakpoint

50− else inciIf indentTail $ do

54+ bool id inci indentTail $ do

51− commaDel

52− sep commaDel p_rdrName ns

55+ sep (comma >> breakpoint) p_rdrName ns

53− p_typeAscription hswc

56+ p_typeAscription hswc

54

57

55p_typeAscription ::

58p_typeAscription ::

56 LHsSigWcType GhcPs ->

59 LHsSigWcType GhcPs ->

57 R ()

60 R ()

58−p_typeAscription HsWC {..} = inci $ do

61+p_typeAscription HsWC {..} = do

59 space

62 space

63+ inci $ do

60− txt "::"

64+ txt "::"

61− let t = hsib_body hswc_body

65+ let t = hsib_body hswc_body

62− if hasDocStrings (unLoc t)

66+ if hasDocStrings (unLoc t)

63− then newline

67+ then newline

64− else breakpoint

68+ else breakpoint

65− located t p_hsType

69+ located t p_hsType

66p_typeAscription (XHsWildCardBndrs x) = noExtCon x

70p_typeAscription (XHsWildCardBndrs x) = noExtCon x

67

71

68p_patSynSig ::

72p_patSynSig ::

@@ -104,7 +108,7 @@ p_fixSig = \case

104 space

108 space

105 atom n

109 atom n

106 space

110 space

107− sitcc $ sep commaDel p_rdrName names

111+ sitcc $ sep (comma >> breakpoint) p_rdrName names

108 XFixitySig x -> noExtCon x

112 XFixitySig x -> noExtCon x

109

113

110p_inlineSig ::

114p_inlineSig ::

@@ -143,7 +147,7 @@ p_specSig name ts InlinePragma {..} = pragmaBraces $ do

143 space

147 space

144 txt "::"

148 txt "::"

145 breakpoint

149 breakpoint

146− inci $ sep commaDel (located' p_hsType . hsib_body) ts

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

147

151

148p_inlineSpec :: InlineSpec -> R ()

152p_inlineSpec :: InlineSpec -> R ()

149p_inlineSpec = \case

153p_inlineSpec = \case

@@ -187,13 +191,13 @@ p_booleanFormula = \case

187 And xs ->

191 And xs ->

188 sitcc $

192 sitcc $

189 sep

193 sep

190− commaDel

194+ (comma >> breakpoint)

191 (located' p_booleanFormula)

195 (located' p_booleanFormula)

192 xs

196 xs

193 Or xs ->

197 Or xs ->

194 sitcc $

198 sitcc $

195 sep

199 sep

196− (breakpoint >> txt "|" >> space)

200+ (breakpoint >> txt "| ")

197 (located' p_booleanFormula)

201 (located' p_booleanFormula)

198 xs

202 xs

199 Parens l -> located l (parens N . p_booleanFormula)

203 Parens l -> located l (parens N . p_booleanFormula)

@@ -207,7 +211,7 @@ p_completeSig ::

207p_completeSig cs' mty =

211p_completeSig cs' mty =

208 located cs' $ \cs ->

212 located cs' $ \cs ->

209 pragma "COMPLETE" . inci $ do

213 pragma "COMPLETE" . inci $ do

210− sep commaDel p_rdrName cs

214+ sitcc $ sep (comma >> breakpoint) p_rdrName cs

211 forM_ mty $ \ty -> do

215 forM_ mty $ \ty -> do

212 space

216 space

213 txt "::"

217 txt "::"

@@ -224,13 +228,12 @@ p_sccSig loc literal = pragma "SCC" . inci $ do

224p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()

228p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()

225p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do

229p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do

226 txt "type"

230 txt "type"

227− inci $ do

228− space

231+ space

229− p_rdrName name

232+ p_rdrName name

230− space

233+ space

231− txt "::"

234+ txt "::"

232− breakpoint

235+ breakpoint

233− case bndrs of

236+ inci $ case bndrs of

234− HsIB NoExtField sig -> located sig p_hsType

237+ HsIB NoExtField sig -> located sig p_hsType

235− XHsImplicitBndrs x -> noExtCon x

238+ XHsImplicitBndrs x -> noExtCon x

236p_standaloneKindSig (XStandaloneKindSig c) = noExtCon c

239p_standaloneKindSig (XStandaloneKindSig c) = noExtCon c

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

@@ -28,13 +28,11 @@ p_synDecl name fixity HsQTvs {..} t = do

28 switchLayout (getLoc name : map getLoc hsq_explicit) $

29 p_infixDefHelper

30 (case fixity of Infix -> True; _ -> False)

31− True

31+ inci

32 (p_rdrName name)

33 (map (located' p_hsTyVarBndr) hsq_explicit)

34 space

35− equals

35+ txt "="

36− if hasDocStrings (unLoc t)

37− then newline

38− else breakpoint

36+ breakpoint

39 inci (located t p_hsType)

37 inci (located t p_hsType)

40p_synDecl _ _ (XLHsQTyVars x) _ = noExtCon x

38p_synDecl _ _ (XLHsQTyVars x) _ = noExtCon x

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

@@ -31,7 +31,7 @@ p_famDecl style FamilyDecl {fdTyVars = HsQTvs {..}, ..} = do

31 switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $

32 p_infixDefHelper

33 (isInfix fdFixity)

34− True

34+ inci

35 (p_rdrName fdLName)

36 (located' p_hsTyVarBndr <$> hsq_explicit)

37 let resultSig = p_familyResultSigL fdResultSig

@@ -69,7 +69,7 @@ p_familyResultSigL l =

69 breakpoint

70 located k p_hsType

71 TyVarSig NoExtField bndr -> Just $ do

72− equals

72+ txt "="

73 breakpoint

74 located bndr p_hsTyVarBndr

75 XFamilyResultSig x ->

@@ -92,16 +92,16 @@ p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do

92 Just bndrs -> do

93 p_forallBndrs ForallInvis p_hsTyVarBndr bndrs

94 breakpoint

95− inciIf (not $ null feqn_bndrs) $ do

95+ (if null feqn_bndrs then id else inci) $ do

96 let famLhsSpn = getLoc feqn_tycon : fmap (getLoc . typeArgToType) feqn_pats

97 switchLayout famLhsSpn $

98 p_infixDefHelper

99 (isInfix feqn_fixity)

100− True

100+ inci

101 (p_rdrName feqn_tycon)

102 (located' p_hsType . typeArgToType <$> feqn_pats)

103 space

104− equals

104+ txt "="

105 breakpoint

106 inci (located feqn_rhs p_hsType)

107p_tyFamInstEqn HsIB {hsib_body = XFamEqn x} = noExtCon x

src/Ormolu/Printer/Meat/Declaration/Value.hs+158−168

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

1{-# LANGUAGE LambdaCase #-}

2−{-# LANGUAGE MultiWayIf #-}

3{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE RecordWildCards #-}

3{-# LANGUAGE RecordWildCards #-}

5{-# LANGUAGE TypeApplications #-}

4{-# LANGUAGE TypeApplications #-}

@@ -22,12 +21,12 @@ import Data.Char (isPunctuation, isSymbol)

22import Data.Data hiding (Infix, Prefix)

21import Data.Data hiding (Infix, Prefix)

23import Data.Functor ((<&>))

22import Data.Functor ((<&>))

24import Data.List (intersperse, sortOn)

23import Data.List (intersperse, sortOn)

25−import Data.List.NonEmpty (NonEmpty (..), (<|))

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

26import qualified Data.List.NonEmpty as NE

25import qualified Data.List.NonEmpty as NE

27import Data.Text (Text)

26import Data.Text (Text)

28import qualified Data.Text as Text

27import qualified Data.Text as Text

29import GHC

28import GHC

30−import OccName (occNameString)

29+import OccName (mkVarOcc)

31import Ormolu.Printer.Combinators

30import Ormolu.Printer.Combinators

32import Ormolu.Printer.Internal

31import Ormolu.Printer.Internal

33import Ormolu.Printer.Meat.Common

32import Ormolu.Printer.Meat.Common

@@ -61,7 +60,7 @@ data Placement

61 -- should use it and avoid bumping one level

60 -- should use it and avoid bumping one level

62 -- of indentation

61 -- of indentation

63 Hanging

62 Hanging

64− deriving (Eq, Show)

63+ deriving (Eq)

65

64

66p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

65p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

67p_valDecl = \case

66p_valDecl = \case

@@ -180,24 +179,25 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

180 NoSrcStrict -> return ()

179 NoSrcStrict -> return ()

181 SrcStrict -> txt "!"

180 SrcStrict -> txt "!"

182 SrcLazy -> txt "~"

181 SrcLazy -> txt "~"

183− indentBody <- case NE.nonEmpty m_pats of

182+ inci' <- case NE.nonEmpty m_pats of

184− Nothing ->

185− False <$ case style of

183+ Nothing -> id <$ case style of

186− Function name -> p_rdrName name

184+ Function name -> p_rdrName name

187− _ -> return ()

185+ _ -> return ()

188 Just ne_pats -> do

186 Just ne_pats -> do

189− let combinedSpans = case style of

187+ let combinedSpans =

190− Function name -> combineSrcSpans (getLoc name) patSpans

188+ combineSrcSpans' $

191− _ -> patSpans

192− patSpans = combineSrcSpans' (getLoc <$> ne_pats)

189+ getLoc <$> ne_pats

190+ inci' =

193− indentBody = not (isOneLineSpan combinedSpans)

191+ if isOneLineSpan combinedSpans

192+ then id

193+ else inci

194 switchLayout [combinedSpans] $ do

195 let stdCase = sep breakpoint (located' p_pat) m_pats

196 case style of

197 Function name ->

198 p_infixDefHelper

199 isInfix

200− indentBody

200+ inci'

201 (p_rdrName name)

202 (located' p_pat <$> m_pats)

203 PatternBind -> stdCase

@@ -212,7 +212,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

212 when needsSpace space

213 sitcc stdCase

214 LambdaCase -> stdCase

215− return indentBody

215+ return inci'

216 let -- Calculate position of end of patterns. This is useful when we decide

217 -- about putting certain constructions in hanging positions.

218 endOfPats = case NE.nonEmpty m_pats of

@@ -224,8 +224,15 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

224 Case -> True

225 LambdaCase -> True

226 _ -> False

227− hasGuards = withGuards grhssGRHSs

227+ let hasGuards = withGuards grhssGRHSs

228+ unless (length grhssGRHSs > 1) $

229+ case style of

230+ Function _ | hasGuards -> return ()

231+ Function _ -> space >> txt "="

232+ PatternBind -> space >> txt "="

233+ s | isCase s && hasGuards -> return ()

234+ _ -> space >> txt "->"

228− grhssSpan =

235+ let grhssSpan =

229 combineSrcSpans' $

236 combineSrcSpans' $

230 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

237 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

231 patGrhssSpan =

238 patGrhssSpan =

@@ -253,14 +260,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

253 txt "where"

260 txt "where"

254 unless whereIsEmpty breakpoint

261 unless whereIsEmpty breakpoint

255 inci $ located grhssLocalBinds p_hsLocalBinds

262 inci $ located grhssLocalBinds p_hsLocalBinds

256− inciIf indentBody $ do

263+ inci' $ do

257− unless (length grhssGRHSs > 1) $

258− case style of

259− Function _ | hasGuards -> return ()

260− Function _ -> space >> inci equals

261− PatternBind -> space >> inci equals

262− s | isCase s && hasGuards -> return ()

263− _ -> space >> txt "->"

264 switchLayout [patGrhssSpan] $

265 placeHanging placement p_body

266 inci p_where

@@ -284,11 +284,11 @@ p_grhs' placer render style (GRHS NoExtField guards body) =

284 xs -> do

285 txt "|"

286 space

287− sitcc (sep commaDel (sitcc . located' p_stmt) xs)

287+ sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)

288 space

289− inci $ case style of

289+ txt $ case style of

290− EqualSign -> equals

290+ EqualSign -> "="

291− RightArrow -> txt "->"

291+ RightArrow -> "->"

292 placeHanging placement p_body

293 where

294 placement =

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

316 HsHigherOrderApp -> txt "-<<"

317 placeHanging (exprPlacement (unLoc input)) $

318 located input p_hsExpr

319− HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ do

319+ HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do

320 located form p_hsExpr

321 unless (null cmds) $ do

322 breakpoint

@@ -353,14 +353,7 @@ p_hsCmdTop = \case

353 HsCmdTop NoExtField cmd -> located cmd p_hsCmd

354 XCmdTop x -> noExtCon x

355

356−-- | Render an expression preserving blank lines between such consecutive

357−-- expressions found in the original source code.

358−withSpacing ::

356+withSpacing :: Data a => (a -> R ()) -> Located a -> R ()

359− -- | Rendering function

360− (a -> R ()) ->

361− -- | Entity to render

362− Located a ->

363− R ()

364withSpacing f l = located l $ \x -> do

357withSpacing f l = located l $ \x -> do

365 case getLoc l of

358 case getLoc l of

366 UnhelpfulSpan _ -> f x

359 UnhelpfulSpan _ -> f x

@@ -471,31 +464,37 @@ gatherStmtBlock (XParStmtBlock x) = noExtCon x

471p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()

464p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()

472p_hsLocalBinds = \case

465p_hsLocalBinds = \case

473 HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do

466 HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do

467+ let ssStart =

468+ either

469+ (srcSpanStart . getLoc)

470+ (srcSpanStart . getLoc)

471+ items =

472+ (Left <$> bagToList bag) ++ (Right <$> lsigs)

473+ p_item (Left x) = located x p_valDecl

474+ p_item (Right x) = located x p_sigDecl

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

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

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

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

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

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

477 br <- layoutToBraces <$> getLayout

478 br <- layoutToBraces <$> getLayout

478− let items =

479+ sitcc $

479− let injectLeft (L l x) = L l (Left x)

480+ sepSemi

480− injectRight (L l x) = L l (Right x)

481+ ( \(p, i) ->

481− in (injectLeft <$> bagToList bag) ++ (injectRight <$> lsigs)

482+ ( case p of

482− positionToBracing = \case

483− SinglePos -> id

483+ SinglePos -> id

484− FirstPos -> br

484+ FirstPos -> br

485− MiddlePos -> br

485+ MiddlePos -> br

486− LastPos -> id

486+ LastPos -> id

487− p_item' (p, item) =

487+ )

488− positionToBracing p $

488+ (p_item i)

489− withSpacing (either p_valDecl p_sigDecl) item

489+ )

490− binds = sortOn (srcSpanStart . getLoc) items

490+ (attachRelativePos $ sortOn ssStart items)

491− sitcc $ sepSemi p_item' (attachRelativePos binds)

492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

491 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

492 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

494 -- Second argument of IPBind is always Left before type-checking.

493 -- Second argument of IPBind is always Left before type-checking.

495 let p_ipBind (IPBind NoExtField (Left name) expr) = do

494 let p_ipBind (IPBind NoExtField (Left name) expr) = do

496 atom name

495 atom name

497 space

496 space

498− equals

497+ txt "="

499 breakpoint

498 breakpoint

500 useBraces $ inci $ located expr p_hsExpr

499 useBraces $ inci $ located expr p_hsExpr

501 p_ipBind (IPBind NoExtField (Right _) _) =

500 p_ipBind (IPBind NoExtField (Right _) _) =

@@ -514,13 +513,19 @@ p_hsRecField HsRecField {..} = do

514 p_rdrName hsRecFieldLbl

513 p_rdrName hsRecFieldLbl

515 unless hsRecPun $ do

514 unless hsRecPun $ do

516 space

515 space

517− equals

516+ txt "="

518 let placement =

517 let placement =

519 if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)

518 if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)

520 then exprPlacement (unLoc hsRecFieldArg)

519 then exprPlacement (unLoc hsRecFieldArg)

521 else Normal

520 else Normal

522 placeHanging placement (located hsRecFieldArg p_hsExpr)

521 placeHanging placement (located hsRecFieldArg p_hsExpr)

523

522

523+p_hsTupArg :: HsTupArg GhcPs -> R ()

524+p_hsTupArg = \case

525+ Present NoExtField x -> located x p_hsExpr

526+ Missing NoExtField -> pure ()

527+ XTupArg x -> noExtCon x

528+

524p_hsExpr :: HsExpr GhcPs -> R ()

529p_hsExpr :: HsExpr GhcPs -> R ()

525p_hsExpr = p_hsExpr' N

530p_hsExpr = p_hsExpr' N

526

531

@@ -584,21 +589,23 @@ p_hsExpr' s = \case

584 -- do-block or case expression it is not a good idea. It seems

589 -- do-block or case expression it is not a good idea. It seems

585 -- to be safe to always bump indentation when the function

590 -- to be safe to always bump indentation when the function

586 -- expression is parenthesised.

591 -- expression is parenthesised.

587− doIndent =

592+ indent =

588 case func of

593 case func of

589− L _ (HsPar NoExtField _) -> True

594+ L _ (HsPar NoExtField _) -> inci

590− L _ (HsAppType NoExtField _ _) -> True

595+ L _ (HsAppType NoExtField _ _) -> inci

591− L _ (HsMultiIf NoExtField _) -> True

596+ L _ (HsMultiIf NoExtField _) -> inci

597+ L spn _ ->

592− L spn _ -> isOneLineSpan spn

598+ if isOneLineSpan spn

593− ub <-

599+ then inci

600+ else id

594− getLayout <&> \case

601+ ub <- getLayout <&> \case

595− SingleLine -> useBraces

602+ SingleLine -> useBraces

596− MultiLine -> id

603+ MultiLine -> id

597 ub $ do

604 ub $ do

598 located func (p_hsExpr' s)

605 located func (p_hsExpr' s)

599 breakpoint

606 breakpoint

600− inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp

607+ indent $ sep breakpoint (located' p_hsExpr) initp

601− inciIf doIndent $ do

608+ indent $ do

602 unless (null initp) breakpoint

609 unless (null initp) breakpoint

603 located lastp p_hsExpr

610 located lastp p_hsExpr

604 Hanging -> do

611 Hanging -> do

@@ -613,15 +620,10 @@ p_hsExpr' s = \case

613 breakpoint

620 breakpoint

614 inci $ do

621 inci $ do

615 txt "@"

622 txt "@"

616− -- Insert a space when the type is represented as a TH splice to avoid

617− -- gluing @ and $ together.

618− case unLoc (hswc_body a) of

619− HsSpliceTy {} -> space

620− _ -> return ()

621 located (hswc_body a) p_hsType

623 located (hswc_body a) p_hsType

622 OpApp NoExtField x op y -> do

624 OpApp NoExtField x op y -> do

623 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)

625 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)

624− p_exprOpTree s (reassociateOpTree getOpName opTree)

626+ p_exprOpTree True s (reassociateOpTree getOpName opTree)

625 NegApp NoExtField e _ -> do

627 NegApp NoExtField e _ -> do

626 txt "-"

628 txt "-"

627 space

629 space

@@ -638,27 +640,22 @@ p_hsExpr' s = \case

638 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)

640 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)

639 unless (useRecordDot' && isRecordDot') breakpoint

641 unless (useRecordDot' && isRecordDot') breakpoint

640 inci (located x p_hsExpr)

642 inci (located x p_hsExpr)

641− ExplicitTuple NoExtField args boxity ->

643+ ExplicitTuple NoExtField args boxity -> do

642 let isSection = any (isMissing . unLoc) args

644 let isSection = any (isMissing . unLoc) args

643 isMissing = \case

645 isMissing = \case

644 Missing NoExtField -> True

646 Missing NoExtField -> True

645 _ -> False

647 _ -> False

646− p_arg = \case

647− Present NoExtField x -> located x p_hsExpr

648− Missing NoExtField -> pure ()

649− XTupArg x -> noExtCon x

650− p_larg = sitcc . located' p_arg

651− parens' =

648+ let parens' =

652 case boxity of

649 case boxity of

653 Boxed -> parens

650 Boxed -> parens

654 Unboxed -> parensHash

651 Unboxed -> parensHash

655− in if isSection

652+ if isSection

656− then

653+ then

657− switchLayout [] . parens' s $

654+ switchLayout [] . parens' s $

658− sep comma p_larg args

655+ sep comma (located' p_hsTupArg) args

659− else

656+ else

660− switchLayout (getLoc <$> args) . parens' s $

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

661− sep commaDel p_larg args

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

662 ExplicitSum NoExtField tag arity e ->

659 ExplicitSum NoExtField tag arity e ->

663 p_unboxedSum N tag arity (located e p_hsExpr)

660 p_unboxedSum N tag arity (located e p_hsExpr)

664 HsCase NoExtField e mgroup ->

661 HsCase NoExtField e mgroup ->

@@ -666,9 +663,8 @@ p_hsExpr' s = \case

666 HsIf NoExtField _ if' then' else' ->

663 HsIf NoExtField _ if' then' else' ->

667 p_if exprPlacement p_hsExpr if' then' else'

664 p_if exprPlacement p_hsExpr if' then' else'

668 HsMultiIf NoExtField guards -> do

665 HsMultiIf NoExtField guards -> do

669− txt "if"

666+ txt "if "

670− breakpoint

671− inci . inci $ sep newline (located' (p_grhs RightArrow)) guards

667+ inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards

672 HsLet NoExtField localBinds e ->

668 HsLet NoExtField localBinds e ->

673 p_let p_hsExpr localBinds e

669 p_let p_hsExpr localBinds e

674 HsDo NoExtField ctx es -> do

670 HsDo NoExtField ctx es -> do

@@ -680,15 +676,15 @@ p_hsExpr' s = \case

680 sepSemi

676 sepSemi

681 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))

677 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))

682 (unLoc es)

678 (unLoc es)

683− compBody = brackets N . located es $ \xs -> do

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

684 let p_parBody =

680 let p_parBody =

685 sep

681 sep

686− (breakpoint >> txt "|" >> space)

682+ (breakpoint >> txt "| ")

687 p_seqBody

683 p_seqBody

688 p_seqBody =

684 p_seqBody =

689 sitcc

685 sitcc

690 . sep

686 . sep

691− commaDel

687+ (comma >> breakpoint)

692 (located' (sitcc . p_stmt))

688 (located' (sitcc . p_stmt))

693 stmts = init xs

689 stmts = init xs

694 yield = last xs

690 yield = last xs

@@ -709,8 +705,8 @@ p_hsExpr' s = \case

709 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"

705 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"

710 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

706 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

711 ExplicitList _ _ xs ->

707 ExplicitList _ _ xs ->

712− brackets s $

708+ brackets s . sitcc $

713− sep commaDel (sitcc . located' p_hsExpr) xs

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

714 RecordCon {..} -> do

710 RecordCon {..} -> do

715 located rcon_con_name atom

711 located rcon_con_name atom

716 breakpoint

712 breakpoint

@@ -726,8 +722,8 @@ p_hsExpr' s = \case

726 case rec_dotdot of

722 case rec_dotdot of

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

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

728 Nothing -> []

724 Nothing -> []

729− inci . braces N $

725+ inci . braces N . sitcc $

730− sep commaDel sitcc (fields <> dotdot)

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

731 RecordUpd {..} -> do

727 RecordUpd {..} -> do

732 located rupd_expr p_hsExpr

728 located rupd_expr p_hsExpr

733 useRecordDot' <- useRecordDot

729 useRecordDot' <- useRecordDot

@@ -745,9 +741,9 @@ p_hsExpr' s = \case

745 Unambiguous _ n -> n

741 Unambiguous _ n -> n

746 XAmbiguousFieldOcc x -> noExtCon x

742 XAmbiguousFieldOcc x -> noExtCon x

747 }

743 }

748− inci . braces N $

744+ inci . braces N . sitcc $

749 sep

745 sep

750− commaDel

746+ (comma >> breakpoint)

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

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

752 rupd_flds

748 rupd_flds

753 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do

749 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do

@@ -760,22 +756,22 @@ p_hsExpr' s = \case

760 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x

756 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x

761 ArithSeq NoExtField _ x ->

757 ArithSeq NoExtField _ x ->

762 case x of

758 case x of

763− From from -> brackets s $ do

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

764 located from p_hsExpr

760 located from p_hsExpr

765 breakpoint

761 breakpoint

766 txt ".."

762 txt ".."

767− FromThen from next -> brackets s $ do

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

768− sep commaDel (located' p_hsExpr) [from, next]

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

769 breakpoint

765 breakpoint

770 txt ".."

766 txt ".."

771− FromTo from to -> brackets s $ do

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

772 located from p_hsExpr

768 located from p_hsExpr

773 breakpoint

769 breakpoint

774 txt ".."

770 txt ".."

775 space

771 space

776 located to p_hsExpr

772 located to p_hsExpr

777− FromThenTo from next to -> brackets s $ do

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

778− sep commaDel (located' p_hsExpr) [from, next]

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

779 breakpoint

775 breakpoint

780 txt ".."

776 txt ".."

781 space

777 space

@@ -825,7 +821,7 @@ p_patSynBind PSB {..} = do

825 breakpoint

821 breakpoint

826 located psb_def p_pat

822 located psb_def p_pat

827 ImplicitBidirectional -> do

823 ImplicitBidirectional -> do

828− equals

824+ txt "="

829 breakpoint

825 breakpoint

830 located psb_def p_pat

826 located psb_def p_pat

831 ExplicitBidirectional mgroup -> do

827 ExplicitBidirectional mgroup -> do

@@ -852,8 +848,8 @@ p_patSynBind PSB {..} = do

852 inci $ do

848 inci $ do

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

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

854 unless (null xs) breakpoint

850 unless (null xs) breakpoint

855− braces N $

851+ braces N . sitcc $

856− sep commaDel (p_rdrName . recordPatSynPatVar) xs

852+ sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs

857 rhs

853 rhs

858 InfixCon l r -> do

854 InfixCon l r -> do

859 switchLayout [getLoc l, getLoc r] $ do

855 switchLayout [getLoc l, getLoc r] $ do

@@ -907,12 +903,10 @@ p_if placer render if' then' else' = do

907 breakpoint

903 breakpoint

908 inci $ do

904 inci $ do

909 txt "then"

905 txt "then"

910− space

911 located then' $ \x ->

906 located then' $ \x ->

912 placeHanging (placer x) (render x)

907 placeHanging (placer x) (render x)

913 breakpoint

908 breakpoint

914 txt "else"

909 txt "else"

915− space

916 located else' $ \x ->

910 located else' $ \x ->

917 placeHanging (placer x) (render x)

911 placeHanging (placer x) (render x)

918

912

@@ -949,13 +943,13 @@ p_pat = \case

949 txt "!"

943 txt "!"

950 located pat p_pat

944 located pat p_pat

951 ListPat NoExtField pats ->

945 ListPat NoExtField pats ->

952− brackets S $ sep commaDel (located' p_pat) pats

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

953 TuplePat NoExtField pats boxing -> do

947 TuplePat NoExtField pats boxing -> do

954− let parens' =

948+ let f =

955 case boxing of

949 case boxing of

956 Boxed -> parens S

950 Boxed -> parens S

957 Unboxed -> parensHash S

951 Unboxed -> parensHash S

958− parens' $ sep commaDel (sitcc . located' p_pat) pats

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

959 SumPat NoExtField pat tag arity ->

953 SumPat NoExtField pat tag arity ->

960 p_unboxedSum S tag arity (located pat p_pat)

954 p_unboxedSum S tag arity (located pat p_pat)

961 ConPatIn pat details ->

955 ConPatIn pat details ->

@@ -971,7 +965,7 @@ p_pat = \case

971 let f = \case

965 let f = \case

972 Nothing -> txt ".."

966 Nothing -> txt ".."

973 Just x -> located x p_pat_hsRecField

967 Just x -> located x p_pat_hsRecField

974− inci . braces N . sep commaDel f $

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

975 case dotdot of

969 case dotdot of

976 Nothing -> Just <$> fields

970 Nothing -> Just <$> fields

977 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]

971 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]

@@ -1012,7 +1006,7 @@ p_pat_hsRecField HsRecField {..} = do

1012 p_rdrName (rdrNameFieldOcc x)

1006 p_rdrName (rdrNameFieldOcc x)

1013 unless hsRecPun $ do

1007 unless hsRecPun $ do

1014 space

1008 space

1015− equals

1009+ txt "="

1016 breakpoint

1010 breakpoint

1017 inci (located hsRecFieldArg p_pat)

1011 inci (located hsRecFieldArg p_pat)

1018

1012

@@ -1021,15 +1015,17 @@ p_unboxedSum s tag arity m = do

1021 let before = tag - 1

1015 let before = tag - 1

1022 after = arity - before - 1

1016 after = arity - before - 1

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

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

1024− f x =

1018+ f (x, i) = do

1019+ let isFirst = i == 0

1020+ isLast = i == arity - 1

1025 case x :: Maybe (R ()) of

1021 case x :: Maybe (R ()) of

1026 Nothing ->

1022 Nothing ->

1027− space

1023+ unless (isFirst || isLast) space

1028 Just m' -> do

1024 Just m' -> do

1029− space

1025+ unless isFirst space

1030 m'

1026 m'

1031− space

1027+ unless isLast space

1032− parensHash s $ sep (txt "|") f args

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

1033

1029

1034p_hsSplice :: HsSplice GhcPs -> R ()

1030p_hsSplice :: HsSplice GhcPs -> R ()

1035p_hsSplice = \case

1031p_hsSplice = \case

@@ -1231,10 +1227,11 @@ exprPlacement = \case

1231 HsCase NoExtField _ _ -> Hanging

1227 HsCase NoExtField _ _ -> Hanging

1232 HsDo NoExtField DoExpr _ -> Hanging

1228 HsDo NoExtField DoExpr _ -> Hanging

1233 HsDo NoExtField MDoExpr _ -> Hanging

1229 HsDo NoExtField MDoExpr _ -> Hanging

1234− OpApp NoExtField _ op y ->

1230+ -- If the rightmost expression in an operator chain is hanging, make the

1235− case (fmap getOpNameStr . getOpName . unLoc) op of

1231+ -- whole block hanging; so that we can use the common @f = foo $ do@

1232+ -- style.

1236− Just "$" -> exprPlacement (unLoc y)

1233+ OpApp NoExtField _ _ y -> exprPlacement (unLoc y)

1237− _ -> Normal

1234+ -- Same thing for function applications (usually with -XBlockArguments)

1238 HsApp NoExtField _ y -> exprPlacement (unLoc y)

1235 HsApp NoExtField _ y -> exprPlacement (unLoc y)

1239 HsProc NoExtField p _ ->

1236 HsProc NoExtField p _ ->

1240 -- Indentation breaks if pattern is longer than one line and left

1237 -- Indentation breaks if pattern is longer than one line and left

@@ -1260,16 +1257,15 @@ getOpName = \case

1260 HsVar NoExtField (L _ a) -> Just a

1257 HsVar NoExtField (L _ a) -> Just a

1261 _ -> Nothing

1258 _ -> Nothing

1262

1259

1263−getOpNameStr :: RdrName -> String

1264−getOpNameStr = occNameString . rdrNameOcc

1265−

1266p_exprOpTree ::

1260p_exprOpTree ::

1261+ -- | Can use special handling of dollar?

1262+ Bool ->

1267 -- | Bracket style to use

1263 -- | Bracket style to use

1268 BracketStyle ->

1264 BracketStyle ->

1269 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->

1265 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->

1270 R ()

1266 R ()

1271−p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)

1267+p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)

1272−p_exprOpTree s (OpBranch x op y) = do

1268+p_exprOpTree isDollarSpecial s (OpBranch x op y) = do

1273 -- If the beginning of the first argument and the second argument are on

1269 -- If the beginning of the first argument and the second argument are on

1274 -- the same line, and the second argument has a hanging form, use hanging

1270 -- the same line, and the second argument has a hanging form, use hanging

1275 -- placement.

1271 -- placement.

@@ -1291,54 +1287,44 @@ p_exprOpTree s (OpBranch x op y) = do

1291 MultiLine -> case placement of

1287 MultiLine -> case placement of

1292 Hanging -> useBraces

1288 Hanging -> useBraces

1293 Normal -> dontUseBraces

1289 Normal -> dontUseBraces

1294− opNameStr = (fmap getOpNameStr . getOpName . unLoc) op

1290+ gotDollar = case getOpName (unLoc op) of

1295− gotDollar = opNameStr == Just "$"

1291+ Just rname -> mkVarOcc "$" == rdrNameOcc rname

1296− gotColon = opNameStr == Just ":"

1292+ _ -> False

1297− gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)

1298 lhs =

1293 lhs =

1299 switchLayout [opTreeLoc x] $

1294 switchLayout [opTreeLoc x] $

1300− p_exprOpTree s x

1295+ p_exprOpTree (not gotDollar) s x

1301− p_op = located op (opWrapper . p_hsExpr)

1296+ let p_op = located op (opWrapper . p_hsExpr)

1302− p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y)

1297+ p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)

1303 isSection = case (opTreeLoc x, getLoc op) of

1298 isSection = case (opTreeLoc x, getLoc op) of

1304 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1299 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1305 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1300 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1306 _ -> False

1301 _ -> False

1307− isDoBlock = \case

1308− OpNode (L _ HsDo {}) -> True

1309− _ -> False

1310 useRecordDot' <- useRecordDot

1302 useRecordDot' <- useRecordDot

1311− if

1303+ let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)

1312− | gotColon -> do

1304+ if useRecordDot' && isRecordDot'

1313− lhs

1305+ then do

1306+ lhs

1307+ when isSection space

1308+ p_op

1309+ p_y

1310+ else

1311+ if isDollarSpecial

1312+ && gotDollar

1313+ && placement

1314+ == Normal

1315+ && isOneLineSpan (opTreeLoc x)

1316+ then do

1317+ useBraces lhs

1314− space

1318+ space

1315− p_op

1319+ p_op

1316− case placement of

1320+ breakpoint

1317− Hanging -> do

1321+ inci p_y

1322+ else do

1323+ ub lhs

1324+ placeHanging placement $ do

1325+ p_op

1318 space

1326 space

1319 p_y

1327 p_y

1320− Normal -> do

1321− breakpoint

1322− inciIf (isDoBlock y) p_y

1323− | gotDollar

1324− && isOneLineSpan (opTreeLoc x)

1325− && placement == Normal -> do

1326− useBraces lhs

1327− space

1328− p_op

1329− breakpoint

1330− inci p_y

1331− | useRecordDot' && gotRecordDot -> do

1332− lhs

1333− when isSection space

1334− p_op

1335− p_y

1336− | otherwise -> do

1337− ub lhs

1338− placeHanging placement $ do

1339− p_op

1340− space

1341− p_y

1342

1328

1343-- | Return 'True' if given expression is a record-dot operator expression.

1329-- | Return 'True' if given expression is a record-dot operator expression.

1344isRecordDot ::

1330isRecordDot ::

@@ -1349,10 +1335,14 @@ isRecordDot ::

1349 Bool

1335 Bool

1350isRecordDot op (RealSrcSpan ySpan) = case op of

1336isRecordDot op (RealSrcSpan ySpan) = case op of

1351 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->

1337 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->

1352− (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)

1338+ isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)

1353 _ -> False

1339 _ -> False

1354isRecordDot _ _ = False

1340isRecordDot _ _ = False

1355

1341

1342+-- | Check whether a given 'RdrName' is the dot operator.

1343+isDot :: RdrName -> Bool

1344+isDot name = rdrNameOcc name == mkVarOcc "."

1345+

1356-- | Get annotations for the enclosing element.

1346-- | Get annotations for the enclosing element.

1357getEnclosingAnns :: R [AnnKeywordId]

1347getEnclosingAnns :: R [AnnKeywordId]

1358getEnclosingAnns = do

1348getEnclosingAnns = do

src/Ormolu/Printer/Meat/Declaration/Value.hs-boot+4

@@ -11,7 +11,11 @@ import GHC

11import Ormolu.Printer.Combinators

12

13p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

14+

14p_pat :: Pat GhcPs -> R ()

15p_pat :: Pat GhcPs -> R ()

16+

15p_hsExpr :: HsExpr GhcPs -> R ()

17p_hsExpr :: HsExpr GhcPs -> R ()

18+

16p_hsSplice :: HsSplice GhcPs -> R ()

19p_hsSplice :: HsSplice GhcPs -> R ()

20+

17p_stringLit :: String -> R ()

21p_stringLit :: String -> R ()

src/Ormolu/Printer/Meat/Declaration/Warning.hs+5−4

@@ -32,9 +32,10 @@ p_moduleWarning wtxt = do

32p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()

33p_topLevelWarning fnames wtxt = do

34 let (pragmaText, lits) = warningText wtxt

35− switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $

35+ switchLayout (fmap getLoc fnames ++ fmap getLoc lits)

36− pragma pragmaText . inci $ do

36+ $ pragma pragmaText . inci

37+ $ do

37− sep commaDel p_rdrName fnames

38+ sitcc $ sep (comma >> breakpoint) p_rdrName fnames

38 breakpoint

39 breakpoint

39 p_lits lits

40 p_lits lits

40

41

@@ -46,4 +47,4 @@ warningText = \case

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

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

47p_lits = \case

48p_lits = \case

48 [l] -> atom l

49 [l] -> atom l

49− ls -> brackets N $ sep commaDel atom ls

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

src/Ormolu/Printer/Meat/ImportExport.hs+5−4

@@ -21,7 +21,7 @@ p_hsmodExports [] = do

21 breakpoint'

22 txt ")"

23p_hsmodExports xs =

24− parens N $ do

24+ parens N . sitcc $ do

25 layout <- getLayout

26 sep

27 breakpoint

@@ -65,7 +65,7 @@ p_hsmodImport useQualifiedPost ImportDecl {..} = do

65 Nothing -> return ()

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

67 breakpoint

68− parens N $ do

68+ parens N . sitcc $ do

69 layout <- getLayout

70 sep

71 breakpoint

@@ -93,8 +93,9 @@ p_lie encLayout relativePos = \case

93 inci $ do

94 let names :: [R ()]

95 names = located' p_ieWrappedName <$> xs

96− parens N . sep commaDel sitcc $

96+ parens N . sitcc

97+ $ sep (comma >> breakpoint) sitcc

97− case w of

98+ $ case w of

98 NoIEWildcard -> names

99 NoIEWildcard -> names

99 IEWildcard n ->

100 IEWildcard n ->

100 let (before, after) = splitAt n names

101 let (before, after) = splitAt n names

src/Ormolu/Printer/Meat/Module.hs+2−2

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

11import Control.Monad

12import qualified Data.Text as T

13import GHC

14−import Ormolu.Imports (normalizeImports)

14+import Ormolu.Imports

15import Ormolu.Parser.CommentStream

16import Ormolu.Parser.Pragma

17import Ormolu.Parser.Shebang

@@ -69,7 +69,7 @@ p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do

69 txt "where"

70 newline

71 newline

72− forM_ (normalizeImports hsmodImports) (located' (p_hsmodImport qualifiedPost))

72+ forM_ (sortImports hsmodImports) (located' (p_hsmodImport qualifiedPost))

73 newline

74 switchLayout (getLoc <$> hsmodDecls) $ do

75 p_hsDecls Free hsmodDecls

src/Ormolu/Printer/Meat/Type.hs+24−35

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

5-- | Rendering of types.

6module Ormolu.Printer.Meat.Type

7 ( p_hsType,

8− p_hsTypePostDoc,

9 hasDocStrings,

8 hasDocStrings,

10 p_hsContext,

9 p_hsContext,

11 p_hsTyVarBndr,

10 p_hsTyVarBndr,

@@ -24,22 +23,14 @@ import Ormolu.Printer.Operators

24import Ormolu.Utils

23import Ormolu.Utils

25

24

26p_hsType :: HsType GhcPs -> R ()

25p_hsType :: HsType GhcPs -> R ()

27−p_hsType t = p_hsType' (hasDocStrings t) PipeStyle t

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

28

27

29−p_hsTypePostDoc :: HsType GhcPs -> R ()

30−p_hsTypePostDoc t = p_hsType' (hasDocStrings t) CaretStyle t

31−

32−-- | How to render Haddocks associated with a type.

33−data TypeDocStyle

34− = PipeStyle

35− | CaretStyle

36−

37−p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R ()

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

38−p_hsType' multilineArgs docStyle = \case

29+p_hsType' multilineArgs = \case

39 HsForAllTy NoExtField visibility bndrs t -> do

30 HsForAllTy NoExtField visibility bndrs t -> do

40 p_forallBndrs visibility p_hsTyVarBndr bndrs

31 p_forallBndrs visibility p_hsTyVarBndr bndrs

41 interArgBreak

32 interArgBreak

42− p_hsTypeR (unLoc t)

33+ p_hsType' multilineArgs (unLoc t)

43 HsQualTy NoExtField qs t -> do

34 HsQualTy NoExtField qs t -> do

44 located qs p_hsContext

35 located qs p_hsContext

45 space

36 space

@@ -67,7 +58,7 @@ p_hsType' multilineArgs docStyle = \case

67 L _ (HsAppTy _ l r) -> gatherArgs l (r : knownArgs)

58 L _ (HsAppTy _ l r) -> gatherArgs l (r : knownArgs)

68 _ -> (f', knownArgs)

59 _ -> (f', knownArgs)

69 (func, args) = gatherArgs f [x]

60 (func, args) = gatherArgs f [x]

70− switchLayout (getLoc f : fmap getLoc args) . sitcc $ do

61+ switchLayout (getLoc f : fmap getLoc args) $ sitcc $ do

71 located func p_hsType

62 located func p_hsType

72 breakpoint

63 breakpoint

73 inci $

64 inci $

@@ -98,9 +89,10 @@ p_hsType' multilineArgs docStyle = \case

98 HsBoxedTuple -> parens N

89 HsBoxedTuple -> parens N

99 HsConstraintTuple -> parens N

90 HsConstraintTuple -> parens N

100 HsBoxedOrConstraintTuple -> parens N

91 HsBoxedOrConstraintTuple -> parens N

92+ in parens' . sitcc $

101− in parens' $ sep commaDel (sitcc . located' p_hsType) xs

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

102 HsSumTy NoExtField xs ->

94 HsSumTy NoExtField xs ->

103− parensHash N $

95+ parensHash N . sitcc $

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

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

105 HsOpTy NoExtField x op y ->

97 HsOpTy NoExtField x op y ->

106 sitcc $

98 sitcc $

@@ -117,20 +109,14 @@ p_hsType' multilineArgs docStyle = \case

117 HsStarTy NoExtField _ -> txt "*"

109 HsStarTy NoExtField _ -> txt "*"

118 HsKindSig NoExtField t k -> sitcc $ do

110 HsKindSig NoExtField t k -> sitcc $ do

119 located t p_hsType

111 located t p_hsType

120− space

112+ space -- FIXME

121 txt "::"

113 txt "::"

122− breakpoint

114+ space

123 inci (located k p_hsType)

115 inci (located k p_hsType)

124 HsSpliceTy NoExtField splice -> p_hsSplice splice

116 HsSpliceTy NoExtField splice -> p_hsSplice splice

125− HsDocTy NoExtField t str ->

117+ HsDocTy NoExtField t str -> do

126− case docStyle of

127− PipeStyle -> do

128− p_hsDocString Pipe True str

118+ p_hsDocString Pipe True str

129− located t p_hsType

130− CaretStyle -> do

131− located t p_hsType

119+ located t p_hsType

132− newline

133− p_hsDocString Caret False str

134 HsBangTy NoExtField (HsSrcBang _ u s) t -> do

120 HsBangTy NoExtField (HsSrcBang _ u s) t -> do

135 case u of

121 case u of

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

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

@@ -153,14 +139,14 @@ p_hsType' multilineArgs docStyle = \case

153 case (p, xs) of

139 case (p, xs) of

154 (IsPromoted, L _ t : _) | isPromoted t -> space

140 (IsPromoted, L _ t : _) | isPromoted t -> space

155 _ -> return ()

141 _ -> return ()

156− sep commaDel (sitcc . located' p_hsType) xs

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

157 HsExplicitTupleTy NoExtField xs -> do

143 HsExplicitTupleTy NoExtField xs -> do

158 txt "'"

144 txt "'"

159 parens N $ do

145 parens N $ do

160 case xs of

146 case xs of

161 L _ t : _ | isPromoted t -> space

147 L _ t : _ | isPromoted t -> space

162 _ -> return ()

148 _ -> return ()

163− sep commaDel (located' p_hsType) xs

149+ sep (comma >> breakpoint) (located' p_hsType) xs

164 HsTyLit NoExtField t ->

150 HsTyLit NoExtField t ->

165 case t of

151 case t of

166 HsStrTy (SourceText s) _ -> p_stringLit s

152 HsStrTy (SourceText s) _ -> p_stringLit s

@@ -170,14 +156,14 @@ p_hsType' multilineArgs docStyle = \case

170 where

156 where

171 isPromoted = \case

157 isPromoted = \case

172 HsTyVar _ IsPromoted _ -> True

158 HsTyVar _ IsPromoted _ -> True

173− HsExplicitTupleTy {} -> True

174 HsExplicitListTy {} -> True

159 HsExplicitListTy {} -> True

160+ HsExplicitTupleTy {} -> True

175 _ -> False

161 _ -> False

176 interArgBreak =

162 interArgBreak =

177 if multilineArgs

163 if multilineArgs

178 then newline

164 then newline

179 else breakpoint

165 else breakpoint

180− p_hsTypeR = p_hsType' multilineArgs docStyle

166+ p_hsTypeR = p_hsType' multilineArgs

181

167

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

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

183-- attached to it.

169-- attached to it.

@@ -191,7 +177,9 @@ p_hsContext :: HsContext GhcPs -> R ()

191p_hsContext = \case

177p_hsContext = \case

192 [] -> txt "()"

178 [] -> txt "()"

193 [x] -> located x p_hsType

179 [x] -> located x p_hsType

180+ xs ->

181+ parens N . sitcc $

194− xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs

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

195

183

196p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

184p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

197p_hsTyVarBndr = \case

185p_hsTyVarBndr = \case

@@ -221,14 +209,15 @@ p_forallBndrs vis p tyvars =

221

209

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

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

223p_conDeclFields xs =

211p_conDeclFields xs =

212+ braces N . sitcc $

224− braces N $ sep commaDel (sitcc . located' p_conDeclField) xs

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

225

214

226p_conDeclField :: ConDeclField GhcPs -> R ()

215p_conDeclField :: ConDeclField GhcPs -> R ()

227p_conDeclField ConDeclField {..} = do

216p_conDeclField ConDeclField {..} = do

228 mapM_ (p_hsDocString Pipe True) cd_fld_doc

217 mapM_ (p_hsDocString Pipe True) cd_fld_doc

229 sitcc $

218 sitcc $

230 sep

219 sep

231− commaDel

220+ (comma >> breakpoint)

232 (located' (p_rdrName . rdrNameFieldOcc))

221 (located' (p_rdrName . rdrNameFieldOcc))

233 cd_fld_names

222 cd_fld_names

234 space

223 space

@@ -270,6 +259,6 @@ tyVarToType = \case

270 -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as

259 -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as

271 -- long as 'tyVarToType' does not get applied to right-hand sides of

260 -- long as 'tyVarToType' does not get applied to right-hand sides of

272 -- declarations.

261 -- declarations.

273− HsParTy NoExtField . noLoc $

262+ HsParTy NoExtField $ noLoc $

274 HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind

263 HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind

275 XTyVarBndr x -> noExtCon x

264 XTyVarBndr x -> noExtCon x

src/Ormolu/Printer/Operators.hs+59−46

@@ -12,11 +12,10 @@ where

12

13import Data.Function (on)

14import qualified Data.List as L

15−import Data.Map.Strict (Map)

16−import qualified Data.Map.Strict as M

17import Data.Maybe (fromMaybe, mapMaybe)

15import Data.Maybe (fromMaybe, mapMaybe)

16+import Data.Ord (Down (Down), comparing)

18import GHC

17import GHC

19−import OccName (occNameString)

18+import OccName (mkVarOcc)

20import Ormolu.Utils (unSrcSpan)

19import Ormolu.Utils (unSrcSpan)

21

20

22-- | Intermediate representation of operator trees. It has two type

21-- | Intermediate representation of operator trees. It has two type

@@ -57,7 +56,7 @@ reassociateOpTree getOpName opTree =

57reassociateOpTreeWith ::

56reassociateOpTreeWith ::

58 forall ty op.

57 forall ty op.

59 -- | Fixity map for operators

58 -- | Fixity map for operators

60− Map String Fixity ->

59+ [(RdrName, Fixity)] ->

61 -- | How to get the name of an operator

60 -- | How to get the name of an operator

62 (op -> Maybe RdrName) ->

61 (op -> Maybe RdrName) ->

63 -- | Original 'OpTree'

62 -- | Original 'OpTree'

@@ -68,13 +67,13 @@ reassociateOpTreeWith fixityMap getOpName = go

68 where

67 where

69 fixityOf :: op -> Fixity

68 fixityOf :: op -> Fixity

70 fixityOf op = fromMaybe defaultFixity $ do

69 fixityOf op = fromMaybe defaultFixity $ do

71− s <- occNameString . rdrNameOcc <$> getOpName op

70+ opName <- getOpName op

72− M.lookup s fixityMap

71+ lookup opName fixityMap

73 -- Here, left branch is already associated and the root alongside with

72 -- Here, left branch is already associated and the root alongside with

74 -- the right branch is right-associated. This function picks up one item

73 -- the right branch is right-associated. This function picks up one item

75 -- from the right and inserts it correctly to the left.

74 -- from the right and inserts it correctly to the left.

76 --

75 --

77− -- Also, we are using the 'compareFixity' function which tells if the

76+ -- Also, we are using the 'compareFixity' function which returns if the

78 -- expression should associate to right.

77 -- expression should associate to right.

79 go :: OpTree ty op -> OpTree ty op

78 go :: OpTree ty op -> OpTree ty op

80 -- base cases

79 -- base cases

@@ -94,16 +93,6 @@ reassociateOpTreeWith fixityMap getOpName = go

94 then go $ OpBranch (OpBranch l op (go $ OpBranch r op' l')) op'' r'

93 then go $ OpBranch (OpBranch l op (go $ OpBranch r op' l')) op'' r'

95 else go $ OpBranch (OpBranch (OpBranch l op r) op' l') op'' r'

94 else go $ OpBranch (OpBranch (OpBranch l op r) op' l') op'' r'

96

95

97−-- | A score assigned to an operator.

98−data Score

99− = -- | The operator was placed at the beginning of a line

100− AtBeginning Int

101− | -- | The operator was placed at the end of a line

102− AtEnd

103− | -- | The operator was placed in between arguments on a single line

104− InBetween

105− deriving (Eq, Ord)

106−

107-- | Build a map of inferred 'Fixity's from an 'OpTree'.

96-- | Build a map of inferred 'Fixity's from an 'OpTree'.

108buildFixityMap ::

97buildFixityMap ::

109 forall ty op.

98 forall ty op.

@@ -112,26 +101,23 @@ buildFixityMap ::

112 -- | Operator tree

101 -- | Operator tree

113 OpTree (Located ty) (Located op) ->

102 OpTree (Located ty) (Located op) ->

114 -- | Fixity map

103 -- | Fixity map

115− Map String Fixity

104+ [(RdrName, Fixity)]

116buildFixityMap getOpName opTree =

105buildFixityMap getOpName opTree =

117− addOverrides

118− . M.fromList

119− . concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)

106+ concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)

120− . zip [2 ..]

107+ . zip [0 ..]

121− . L.groupBy ((==) `on` snd)

108+ . L.groupBy (doubleWithinEps 0.00001 `on` snd)

122− . selectScores

109+ . (overrides ++)

110+ . modeScores

123 $ score opTree

111 $ score opTree

124 where

112 where

125− addOverrides :: Map String Fixity -> Map String Fixity

113+ -- Add a special case for ($), since it is pretty unlikely for someone

126− addOverrides m =

114+ -- to override it.

127− M.fromList

115+ overrides :: [(RdrName, Double)]

128− [ ("$", fixity 0 InfixR),

116+ overrides =

129− (":", fixity 1 InfixR),

117+ [ (mkRdrUnqual $ mkVarOcc "$", -1)

130− (".", fixity 100 InfixL)

118+ ]

131− ]

119+ -- Assign scores to operators based on their location in the source.

132− `M.union` m

133− fixity = Fixity NoSourceText

134− score :: OpTree (Located ty) (Located op) -> [(String, Score)]

120+ score :: OpTree (Located ty) (Located op) -> [(RdrName, Double)]

135 score (OpNode _) = []

121 score (OpNode _) = []

136 score (OpBranch l o r) = fromMaybe (score r) $ do

122 score (OpBranch l o r) = fromMaybe (score r) $ do

137 -- If we fail to get any of these, 'defaultFixity' will be used by

123 -- If we fail to get any of these, 'defaultFixity' will be used by

@@ -141,27 +127,48 @@ buildFixityMap getOpName opTree =

141 oe <- srcSpanEndLine <$> unSrcSpan (getLoc o) -- operator end

127 oe <- srcSpanEndLine <$> unSrcSpan (getLoc o) -- operator end

142 rb <- srcSpanStartLine <$> unSrcSpan (opTreeLoc r) -- right begin

128 rb <- srcSpanStartLine <$> unSrcSpan (opTreeLoc r) -- right begin

143 oc <- srcSpanStartCol <$> unSrcSpan (getLoc o) -- operator column

129 oc <- srcSpanStartCol <$> unSrcSpan (getLoc o) -- operator column

144− opName <- occNameString . rdrNameOcc <$> getOpName (unLoc o)

130+ opName <- getOpName (unLoc o)

145 let s

131 let s

146− | le < ob = AtBeginning oc

132+ | le < ob =

133+ -- if the operator is in the beginning of a line, assign

134+ -- a score relative to its column within range [0, 1).

135+ fromIntegral oc / fromIntegral (maxCol + 1)

147− | oe < rb = AtEnd

136+ | oe < rb =

137+ -- if the operator is in the end of the line, assign the

138+ -- score 1.

139+ 1

148− | otherwise = InBetween

140+ | otherwise =

141+ 2 -- otherwise, assign a high score.

149 return $ (opName, s) : score r

142 return $ (opName, s) : score r

150− selectScores :: [(String, Score)] -> [(String, Score)]

143+ -- Pick the most common score per 'RdrName'.

151− selectScores =

144+ modeScores :: [(RdrName, Double)] -> [(RdrName, Double)]

145+ modeScores =

152 L.sortOn snd

146 L.sortOn snd

153 . mapMaybe

147 . mapMaybe

154 ( \case

148 ( \case

155 [] -> Nothing

149 [] -> Nothing

156− xs@((n, _) : _) -> Just (n, selectScore $ map snd xs)

150+ xs@((n, _) : _) -> Just (n, mode $ map snd xs)

157 )

151 )

158 . L.groupBy ((==) `on` fst)

152 . L.groupBy ((==) `on` fst)

159 . L.sort

153 . L.sort

160− selectScore :: [Score] -> Score

154+ -- Return the most common number, leaning to the smaller

161− selectScore xs =

155+ -- one in case of a tie.

162− case filter (/= InBetween) xs of

156+ mode :: [Double] -> Double

163− [] -> InBetween

157+ mode =

158+ head

159+ . L.minimumBy (comparing (Down . length))

160+ . L.groupBy (doubleWithinEps 0.0001)

161+ . L.sort

162+ -- The start column of the rightmost operator.

163+ maxCol = go opTree

164+ where

165+ go (OpNode (L _ _)) = 0

166+ go (OpBranch l (L o _) r) =

164− xs' -> maximum xs'

167+ maximum

168+ [ go l,

169+ maybe 0 srcSpanStartCol (unSrcSpan o),

170+ go r

171+ ]

165

172

166----------------------------------------------------------------------------

173----------------------------------------------------------------------------

167-- Helpers

174-- Helpers

@@ -175,3 +182,9 @@ normalizeOpTree (OpBranch (OpNode l) lop r) =

175 OpBranch (OpNode l) lop (normalizeOpTree r)

182 OpBranch (OpNode l) lop (normalizeOpTree r)

176normalizeOpTree (OpBranch (OpBranch l' lop' r') lop r) =

183normalizeOpTree (OpBranch (OpBranch l' lop' r') lop r) =

177 normalizeOpTree (OpBranch l' lop' (OpBranch r' lop r))

184 normalizeOpTree (OpBranch l' lop' (OpBranch r' lop r))

185+

186+fixity :: Int -> FixityDirection -> Fixity

187+fixity = Fixity NoSourceText

188+

189+doubleWithinEps :: Double -> Double -> Double -> Bool

190+doubleWithinEps eps a b = abs (a - b) < eps

src/Ormolu/Processing/Common.hs+1−1

@@ -20,7 +20,7 @@ data OrmoluState

20

21-- | Marker for the beginning of the region where Ormolu should be disabled.

22startDisabling :: IsString s => s

23−startDisabling = "{- ORMOLU_DISABLE_START"

23+startDisabling = "{- ORMOLU_DISABLING_START"

24

25-- | Marker for the end of the region where Ormolu should be disabled.

26endDisabling :: IsString s => s

src/Ormolu/Processing/Postprocess.hs+3−13

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

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE ViewPatterns #-}

3−

4-- | Postprocessing for the results of printing.

1-- | Postprocessing for the results of printing.

5module Ormolu.Processing.Postprocess

2module Ormolu.Processing.Postprocess

6 ( postprocess,

3 ( postprocess,

@@ -13,19 +10,12 @@ import Ormolu.Processing.Common

13import qualified Ormolu.Processing.Cpp as Cpp

10import qualified Ormolu.Processing.Cpp as Cpp

14

11

15-- | Postprocess output of the formatter.

12-- | Postprocess output of the formatter.

16−postprocess ::

13+postprocess :: Text -> Text

17− -- | Desired indentation level

18− Int ->

19− -- | Input to process

20− Text ->

21− Text

22−postprocess indent =

14+postprocess =

23 T.unlines

15 T.unlines

24− . fmap indentLine

25 . fmap Cpp.unmaskLine

16 . fmap Cpp.unmaskLine

26 . filter (not . magicComment)

17 . filter (not . magicComment)

27 . T.lines

18 . T.lines

28 where

19 where

29− magicComment (T.stripStart -> x) =

20+ magicComment x =

30 x == startDisabling || x == endDisabling

21 x == startDisabling || x == endDisabling

31− indentLine x = T.replicate indent " " <> x

src/Ormolu/Processing/Preprocess.hs+4−4

@@ -11,7 +11,8 @@ where

11import Control.Monad

12import Data.Char (isSpace)

13import qualified Data.List as L

14−import Data.Maybe (isJust, maybeToList)

14+import Data.Maybe (isJust)

15+import Data.Maybe (maybeToList)

15import FastString

16import FastString

16import Ormolu.Config (RegionDeltas (..))

17import Ormolu.Config (RegionDeltas (..))

17import Ormolu.Parser.Shebang (isShebang)

18import Ormolu.Parser.Shebang (isShebang)

@@ -142,8 +143,7 @@ magicComment ::

142 -- | Whether or not the two strings watch

143 -- | Whether or not the two strings watch

143 Bool

144 Bool

144magicComment expected s0 = isJust $ do

145magicComment expected s0 = isJust $ do

145− let trim = dropWhile isSpace

146+ s1 <- dropWhile isSpace <$> L.stripPrefix "{-" s0

146− s1 <- trim <$> L.stripPrefix "{-" (trim s0)

147− s2 <- trim <$> L.stripPrefix expected s1

147+ s2 <- dropWhile isSpace <$> L.stripPrefix expected s1

148 s3 <- L.stripPrefix "-}" s2

149 guard (all isSpace s3)

src/Ormolu/Utils.hs+1−15

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

1{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ViewPatterns #-}

4

3

5-- | Random utilities used by the code.

4-- | Random utilities used by the code.

6module Ormolu.Utils

5module Ormolu.Utils

@@ -16,14 +15,12 @@ module Ormolu.Utils

16 separatedByBlank,

15 separatedByBlank,

17 separatedByBlankNE,

16 separatedByBlankNE,

18 onTheSameLine,

17 onTheSameLine,

19− removeIndentation,

20 )

18 )

21where

19where

22

20

23−import Data.Char (isSpace)

24import Data.List (dropWhileEnd)

21import Data.List (dropWhileEnd)

25−import Data.List.NonEmpty (NonEmpty (..))

26import qualified Data.List.NonEmpty as NE

22import qualified Data.List.NonEmpty as NE

23+import Data.List.NonEmpty (NonEmpty (..))

27import Data.Maybe (fromMaybe)

24import Data.Maybe (fromMaybe)

28import Data.Text (Text)

25import Data.Text (Text)

29import qualified Data.Text as T

26import qualified Data.Text as T

@@ -142,14 +139,3 @@ separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b)

142onTheSameLine :: SrcSpan -> SrcSpan -> Bool

139onTheSameLine :: SrcSpan -> SrcSpan -> Bool

143onTheSameLine a b =

140onTheSameLine a b =

144 isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))

141 isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))

145−

146−-- | Remove indentation from a given 'String'. Return the input with

147−-- indentation removed and the detected indentation level.

148−removeIndentation :: String -> (String, Int)

149−removeIndentation (lines -> xs) = (unlines (drop n <$> xs), n)

150− where

151− n = minimum (getIndent <$> xs)

152− getIndent y =

153− if all isSpace y

154− then 0

155− else length (takeWhile isSpace y)