master..fc64ead · ormolu

git.iko.soy/ormolu

180 files changed+1103−1913

unifiedsplit

.buildkite/pipeline.yml+2−2

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

33 command: |

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

55 timeout: 100

6− - label: Build and test with GHC 8.8.4

6+ - label: Build and test with GHC 8.8.3

77 command: |

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

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

99 timeout: 100

1010 - label: Build and test with GHC 8.10.1

1111 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−97

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

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

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

59−

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

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

62−

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

64− “continuation” of a series of comments [Issue

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

66−

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`.

96− Apparently only the latter is correct.

97−

981## Ormolu 0.0.5.0

992

1003* Grouping of statements in `do`-blocks is now preserved. [Issue

CONTRIBUTING.md+1−1

@@ -30,7 +30,7 @@ Testing is performed as following:

3030* The result of printing is parsed back again and the AST is compared to the

3131 AST obtained from the original file. They should match.

3232* The output of printer is checked against the expected output.

33−* Idempotence property is verified: formatting already formatted code

33+* Idempotency property is verified: formatting already formatted code

3434 results in exactly the same output.

3535

3636Examples can be organized in sub-directories, see the existing ones for

DESIGN.md+11−11

@@ -24,7 +24,7 @@ It also includes recommendations for future implementers.

2424

2525We set for the following goals (mostly taken from

2626[brittany](https://github.com/lspitzner/brittany)):

27−* Preserve the meaning of the formatted functions when no CPP is used;

27+* Preserve the meaning of the formatted functions;

2828* Make reasonable use of screen space;

2929* Use linear space and computation time on the size of the input;

3030* Preserve comments;

@@ -140,10 +140,8 @@ impossible to guess what they'll be called on.

140140

141141### CPP

142142

143−We allow CPP directives in the input, but we forgo the goal to preserve the

144−meaning of the formatted functions in that case.

145−Instead of supporting CPP better, we hope for a solution to replace CPP to

146−do conditional compilation.

143+Formatting a module which uses CPP directives won't be supported. Instead,

144+we hope for a solution to replace CPP to do conditional compilation.

147145

148146There are the following challenges when formatting a module with CPP:

149147

@@ -182,15 +180,14 @@ True

182180```

183181

184182At the time of this writing, formatting this program with Hindent

185−or Ormolu produces the same output we would get if the CPP directives

186−were considered comments:

183+produces the same output we would get if the CPP directives were

184+considered comments:

187185

188186```

189−$ ormolu --version

190−ormolu 0.0.5.0 HEAD fc64eada5c4da7a5b07d2872e253671b48aec115

191−using ghc-lib-parser 8.10.1.20200412

187+$ hindent --version

188+hindent 5.2.7

192189

193−$ ormolu --mode inplace test.hs

190+$ hindent test.hs

194191

195192$ cat test.hs

196193{-# LANGUAGE CPP #-}

@@ -230,6 +227,9 @@ to parse Haskell modules. If CPP is replaced with some language

230227extension or mechanism to do conditional compilation, all tools

231228will benefit from it.

232229

230+Therefore, CPP won't be supported. If the CPP extension

231+is enabled, we should signal an error right away.

232+

233233### Printing

234234

235235Just pretty-printing code (following the approach of Hindent) seems sane. It

README.md+14−31

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

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

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

2424* 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.

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

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

2828 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.

4545

4646```console

4747$ cat stack.yaml

48−resolver: lts-16.0

48+resolver: lts-14.3

4949packages:

5050- '.'

5151

52−$ stack build # to build

53−$ stack install # to install

52+$ stack build

5453```

5554

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

@@ -92,12 +91,6 @@ formatted output.

9291$ ormolu --mode inplace Module.hs

9392```

9493

95−Use `find` to format a tree recursively:

96−

97−```console

98−$ ormolu --mode inplace $(find . -name '*.hs')

99−```

100−

10194## Magic comments

10295

10396Ormolu understands two magic comments:

@@ -123,13 +116,20 @@ independent top-level definitions.

123116

124117* CPP support is experimental. CPP is virtually impossible to handle

125118 correctly, so we process them as a sort of unchangeable snippets. This

126− works only in simple cases when CPP conditionals surround top-level

127− declarations. See the [CPP][design-cpp] section in the design notes for

128− a discussion of the dangers.

119+ works only in simple cases when CPP conditionals are self-contained. Use

120+ Ormolu with CPP at your own risk.

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

130122 criterion than just being valid Haskell modules.

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

132124

125+## Editor integration

126+

127+We know of the following editor integrations:

128+

129+* [Emacs][emacs-package]

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

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

132+

133133## Running on Hackage

134134

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

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

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

145145into Ormolu).

146146

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−

163147## Contributing

164148

165149See [CONTRIBUTING.md][contributing].

@@ -170,7 +154,7 @@ See [LICENSE.md][license].

170154

172156

173−[design-cpp]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp

157+[design]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp

174158[contributing]: https://github.com/tweag/ormolu/blob/master/CONTRIBUTING.md

175159[license]: https://github.com/tweag/ormolu/blob/master/LICENSE.md

176160[haskell-src-exts]: https://hackage.haskell.org/package/haskell-src-exts

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

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

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

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

app/Main.hs+15−27

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

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

1010import Control.Monad

11−import Data.Bool (bool)

1211import Data.Either (lefts)

1312import Data.List (intercalate, sort)

1413import qualified Data.Text.IO as TIO

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

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

6261 exitWith (ExitFailure 101)

6362 Just inputFile -> do

64− originalInput <- TIO.readFile inputFile

65− formattedInput <- ormoluFile config inputFile

63+ r <- ormoluFile config inputFile

6664 case mode of

6765 Stdout ->

68− TIO.putStr formattedInput

69− InPlace -> do

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

66+ TIO.putStr r

67+ InPlace ->

68+ TIO.writeFile inputFile r

7569 Check -> do

76− when (formattedInput /= originalInput) $

70+ r' <- TIO.readFile inputFile

71+ when (r /= r') $

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

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

7974 -- 'notImplemented'.

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

139134optsParser :: Parser Opts

140135optsParser =

141136 Opts

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

143− [ short 'i',

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

145− ]

146− <|> (option parseMode . mconcat)

147− [ long "mode",

148− short 'm',

149− metavar "MODE",

150− value Stdout,

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

152− ]

153− )

137+ <$> (option parseMode . mconcat)

138+ [ long "mode",

139+ short 'm',

140+ metavar "MODE",

141+ value Stdout,

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

143+ ]

154144 <*> configParser

155145 <*> (many . strArgument . mconcat)

156146 [ metavar "FILE",

@@ -177,19 +167,17 @@ configParser =

177167 help "Output information useful for debugging"

178168 ]

179169 <*> (switch . mconcat)

180− [ long "check-idempotence",

170+ [ long "check-idempotency",

181171 short 'c',

182172 help "Fail if formatting is not idempotent"

183173 ]

184174 <*> ( RegionIndices

185175 <$> (optional . option auto . mconcat)

186176 [ long "start-line",

187− metavar "START",

188− help "Start line of the region to format (starts from 1)"

177+ help "Start line of the region to format (lines start from 1)"

189178 ]

190179 <*> (optional . option auto . mconcat)

191180 [ long "end-line",

192− metavar "END",

193181 help "End line of the region to format (inclusive)"

194182 ]

195183 )

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

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

88 Foo ::

99 forall a b.

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

11− -- bar

11+ -- bar

1212 a ->

1313 b ->

1414 Foo 'Int

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

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

55 = Foo

66 Bar

77 (Set Baz) -- and here we go

8− -- and that's it

8+ -- and that's it

99 Text

1010 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-comment-out.hsdeleted−4

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

1−data A

2− = B -- C

3− | -- D

4− E

data/examples/declaration/data/with-comment.hsdeleted−5

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

1−data A =

2− B -- C

3−

4− -- D

5− | E

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 @@

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

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

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

@@ -2,11 +2,6 @@ foo, bar :: Int

22foo = 1

33bar = 2

5−a, b, c :: Int

6−a = 1

7−b = 2

8−c = 3

9−

105foo,

116 bar,

127 baz ::

data/examples/declaration/signature/type/multi-value.hs−5

@@ -2,11 +2,6 @@ foo, bar :: Int

22foo = 1

33bar = 2

5−a, b, c :: Int

6−a = 1

7−b = 2

8−c = 3

9−

105foo,

116 bar,

127 baz :: Int

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

4040 )

4141 else do

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

43− -- Could pattern match directly on x

43+ -- Could pattern match directly on x

4444 i <- case u of

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

4646 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 @@

11{-# LANGUAGE ImplicitParams #-}

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

4−sortBy = undefined

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

76sort = sortBy ?cmp

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

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

11{-# LANGUAGE ImplicitParams #-}

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

4−sortBy = undefined

5−

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

75sort = sortBy ?cmp

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

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

1313 throwIO (OrmoluCppEnabled path)

1414

1515foo =

16− bar $

17− baz $

18− quux

16+ bar

17+ $ baz

18+ $ quux

1919

2020x =

2121 case l of { A -> B } $

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

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

1717 `catch` \case

1818 a -> a

1919

20−foo =

21− bar

22− ++ case foo of

23− a -> a

20+foo = bar

21+ ++ case foo of

22+ a -> a

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

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

11lenses =

2− Just $

3− M.fromList $

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

5− # "connection" .= uc

6− # "user" .= case name of

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

8− Nothing -> Nothing

9− # []

2+ Just $ M.fromList $

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

4+ # "connection" .= uc

5+ # "user" .= case name of

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

7+ Nothing -> Nothing

8+ # []

109

1110foo =

1211 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 @@

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

55bar x y =

6− if

7− | x > y -> x

6+ if | x > y -> x

87 | x < y ->

98 y

109 | otherwise -> x

1110

1211baz =

13− if

14− | p -> f

12+ if | p -> f

1513 | otherwise -> g

1614 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/record/constructors-out.hs → data/examples/declaration/value/function/record-constructors-out.hsrenamed

The content is the same.

data/examples/declaration/value/function/record/constructors.hs → data/examples/declaration/value/function/record-constructors.hsrenamed

The content is the same.

data/examples/declaration/value/function/record/dot-out.hs → data/examples/declaration/value/function/record-dot-out.hsrenamed

The content is the same.

data/examples/declaration/value/function/record/dot.hs → data/examples/declaration/value/function/record-dot.hsrenamed

The content is the same.

data/examples/declaration/value/function/record/inter-comments-out.hs → data/examples/declaration/value/function/record-inter-comments-out.hsrenamed

The content is the same.

data/examples/declaration/value/function/record/inter-comments.hs → data/examples/declaration/value/function/record-inter-comments.hsrenamed

The content is the same.

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

The content is the same.

data/examples/declaration/value/function/record/updaters.hs → data/examples/declaration/value/function/record-updaters.hsrenamed

The content is the same.

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

The content is the same.

data/examples/declaration/value/function/record/wildcards.hs → data/examples/declaration/value/function/record-wildcards.hsrenamed

The content is the same.

data/examples/declaration/value/function/record/hanging-after-equal-con-out.hsdeleted−8

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

1−foo =

2− Foo

3− { foo =

4− -- Blah blah

5− case x of

6− Blah -> 1

7− Blim -> 2

8− }

data/examples/declaration/value/function/record/hanging-after-equal-con.hsdeleted−7

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

1−foo = Foo

2− { foo =

3− -- Blah blah

4− case x of

5− Blah -> 1

6− Blim -> 2

7− }

data/examples/declaration/value/function/record/hanging-after-equal-update-out.hsdeleted−8

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

1−foo =

2− foo

3− { foo =

4− -- Blah blah

5− case x of

6− Blah -> 1

7− Blim -> 2

8− }

data/examples/declaration/value/function/record/hanging-after-equal-update.hsdeleted−7

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

1−foo = foo

2− { foo =

3− -- Blah blah

4− case x of

5− Blah -> 1

6− Blim -> 2

7− }

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 @@

11import qualified MegaModule as M

2− ( Either,

2+ ( (<<<),

3+ (>>>),

4+ Either,

35 Maybe (Just, Nothing),

46 MaybeT (..),

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

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

68 MonadBaseControl,

79 join,

810 liftIO,

911 void,

10− (<<<),

11− (>>>),

1212 )

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

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

11import qualified MegaModule as M

22 ( -- (1)

3− -- (2)

4− Either, -- (3)

5− (<<<),

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

64 (>>>),

5+ Either, -- (3)

76 )

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 @@

11import A hiding

22 ( foobarbazqux,

3+ foobarbazqux,

4+ foobarbazqux,

5+ foobarbazqux,

6+ foobarbazqux,

7+ foobarbazqux,

8+ foobarbazqux,

39 )

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

511import Name hiding ()

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

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

11import qualified MegaModule as M

2− ( Either,

2+ ( (<<<),

3+ (>>>),

4+ Either,

35 Monad

4− ( return,

5− (>>),

6− (>>=)

6+ ( (>>),

7+ (>>=),

8+ return

79 ),

8− (<<<),

9− (>>>),

1010 )

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

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

11{-# LANGUAGE ImportQualifiedPost #-}

3+import Data.Text qualified as T

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

45import 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 @@

11module P where

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

43import qualified Prelude

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

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

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

11import Data.Text

2+import Data.Text

3+import qualified Data.Text as T

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

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

36import 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

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

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

66import 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 ::

99 -- | Foo

1010 Int ->

1111 Int

12+

1213foo ::

1314 Foo a =>

1415 -- | 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)]

22newNames =

33 let (*) = flip (,)

44 in [ "Control" * "Monad"

5− -- Foo

5+ -- Foo

7− -- Bar

7+ -- Bar

88 ]

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

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

11ffff, ffffffff :: Natural

23#ifdef HASKELL_ZIP_DEV_MODE

34ffff = 200

45ffffffff = 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-0-out.hsdeleted−3

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

1−x = ({-a-} b, c)

2−

3−y = ({-a-} b)

data/examples/other/inline-comment-0.hsdeleted−3

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

1−x = ({-a-}b, c)

2−

3−y = ({-a-}b)

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/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+35−34

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

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

2−, system ? builtins.currentSystem

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

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

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

43}:

65let

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

1716 };

1817 ormoluOverlay = self: super: {

1918 "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+ } {});

2025 };

2126 ormolize = import ./nix/ormolize {

2227 inherit pkgs;

@@ -25,19 +30,19 @@ let

2530 expectedFailures = [

2631 "Agda"

2732 "aws"

33+ "brick"

2834 "distributed-process"

2935 "esqueleto"

3036 "fay"

31− "hlint"

3237 "idris"

3338 "intero"

3439 "leksah"

40+ "lens"

3541 "pandoc"

3642 "pipes"

37− "postgrest"

3843 "purescript"

39− "tensorflow"

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

44+ "stack"

45+ ];

4146 ormolizedPackages = doCheck:

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

4348 package = p;

@@ -49,11 +54,14 @@ let

4954 }) haskellPackages;

5055in {

5156 ormolu = haskellPackages.ormolu;

52− # We put the derivations in another attribute set to avoid building them

53− # when nix-build is run.

54− dev = {

55− ormoluShell =

56− haskellPackages.shellFor {

57+ ormoluShell =

58+ if ormoluCompiler == "ghc8101"

59+ # HACK The shell doesn't compile with GHC 8.10.1

60+ then haskellPackages.shellFor {

61+ packages = ps: [];

62+ buildInputs = [];

63+ }

64+ else haskellPackages.shellFor {

5765 packages = ps: [

5866 ps.ormolu

5967 ];

@@ -62,13 +70,11 @@ in {

6270 haskellPackages.ghcid

6371 ];

6472 };

65− withOrmolu = haskellPackages.shellFor {

66− packages = ps: [];

67− buildInputs = [

68− haskellPackages.cabal-install

69− haskellPackages.ormolu

70− ];

71− };

73+ withOrmolu = haskellPackages.shellFor {

74+ packages = ps: [];

75+ buildInputs = [

76+ haskellPackages.ormolu

77+ ];

7278 };

7379 inherit ormoluOverlay ormoluCompiler;

7480 hackage = ormolizedPackages false;

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

103109 "optics"

104110 "ormolu"

105111 "pandoc"

106− "parsec3"

107112 "pipes"

108113 "postgrest"

109114 "purescript"

@@ -127,21 +132,19 @@ in {

127132 doCheck = true;

128133 buildPhase = ''

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

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

135+ ormolu --check-idempotency --mode inplace result-all-implicit.hs

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

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

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

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

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

139+ ormolu --check-idempotency --mode inplace --start-line 1 result-only-start.hs

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

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

141+ ormolu --check-idempotency --mode inplace --end-line 13 result-only-end.hs

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

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

143+ ormolu --check-idempotency --mode inplace --start-line 6 --end-line 7 result-6-7.hs

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

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

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

142− ormolu --check-idempotence --mode inplace --start-line 9 --end-line 12 result-9-12.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+ ormolu --check-idempotency --mode inplace --start-line 6 --end-line 8 result-6-8.hs

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

147+ ormolu --check-idempotency --mode inplace --start-line 9 --end-line 13 result-9-13.hs

145148 '';

146149 checkPhase = ''

147150 echo result-all-implicit.hs

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

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

157160 echo result-6-8.hs

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

159− echo result-9-12.hs

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

161− echo result-17-18.hs

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

162+ echo result-9-13.hs

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

163164 '';

164165 installPhase = ''

165166 mkdir "$out"

expected-failures/Agda.txt+29−6

@@ -1,11 +1,34 @@

11Formatting is not idempotent:

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

3− before: " = (check_ac"

4− after: " =\n "

2+ src/full/Agda/Auto/CaseSplit.hs<rendered>:176:54

3+ before: ", pats') = applyperm"

4+ after: ", pats') =\n "

55Please, consider reporting the bug.

77Formatting is not idempotent:

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

9− before: " nes\n\n "

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

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

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

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

11+Please, consider reporting the bug.

12+

13+Parsing of formatted code failed:

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

15+ parse error on input `C.QName'

16+Please, consider reporting the bug.

17+

18+Formatting is not idempotent:

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

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

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

22+Please, consider reporting the bug.

23+

24+Formatting is not idempotent:

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

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

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

28+Please, consider reporting the bug.

29+

30+Formatting is not idempotent:

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

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

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

1134Please, consider reporting the bug.

expected-failures/brick.txtnew file+5

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

1+Formatting is not idempotent:

2+ src/Brick/Widgets/List.hs<rendered>:573:3

3+ before: "t at i\n in -- If t"

4+ after: "t at i\n -"

5+Please, consider reporting the bug.

expected-failures/esqueleto.txt+1−1

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

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

55The GHC parser (in Haddock mode) failed:

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

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

77 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.

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+

155The GHC parser (in Haddock mode) failed:

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

357 parse error on input `@'

458

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+

563The GHC parser (in Haddock mode) failed:

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

765 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 @@

11Formatting is not idempotent:

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

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

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

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

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

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

55Please, consider reporting the bug.

expected-failures/leksah.txt+7−1

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

11Formatting is not idempotent:

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

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

33 before: "cr\n -- show"

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

55Please, consider reporting the bug.

7+Formatting is not idempotent:

8+ src/IDE/SymbolNavigation.hs<rendered>:233:8

9+ before: "\n\n return [\n {-i"

10+ after: "\n\n return\n [ {-i"

11+Please, consider reporting the bug.

expected-failures/pandoc.txt+7−1

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

33 parse error on input `import'

55Formatting is not idempotent:

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

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

77 before: ".softbreak <$ endlin"

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

99Please, consider reporting the bug.

10+

11+Formatting is not idempotent:

12+ src/Text/Pandoc/Writers/Docx.hs<rendered>:994:25

13+ before: " -- w:p\n "

14+ after: " -- w:p\n "

15+Please, 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 @@

11The 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

33 Invalid type signature: pattern ValueDecl :: ...

44Perhaps you meant to use PatternSynonyms?

66The 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

88 Invalid type signature: pattern NullSourceSpan :: ...

99Perhaps you meant to use PatternSynonyms?

1010

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'

format.sh+1−3

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

11#!/usr/bin/env nix-shell

2−#!nix-shell default.nix -A dev.withOrmolu -i bash --pure

2+#!nix-shell default.nix -A withOrmolu -i bash --pure

33#

44# Format Ormolu using current version of Ormolu.

@@ -7,8 +7,6 @@ set -e

88export LANG="C.UTF-8"

10−cabal format

11−

1210ormolu -m inplace $(find app -type f -name "*.hs")

1311ormolu -m inplace $(find src -type f $ -name "*.hs" -o -name "*.hs-boot" $)

1412ormolu -m inplace $(find tests -type f -name "*.hs")

nix/nixpkgs/default.nix+3−7

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

1−{ system ? builtins.currentSystem }:

21let

3− rev = "32b46dd897ab2143a609988a04d87452f0bbef59";

4− sha256 = "1gzfrpjnr1bz9zljsyg3a4zrhk8r927sz761mrgcg56dwinkhpjk";

2+ rev = "807ca93fadd5197c2260490de0c76e500562dc05";

3+ sha256 = "10yq8bnls77fh3pk5chkkb1sv5lbdgyk1rr2v9xn71rr1k2x563p";

54 nixpkgs = builtins.fetchTarball {

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

76 inherit sha256;

87 };

9− pkgs = import nixpkgs {

10− inherit system;

11− config.allowUnfree = true;

12− };

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

139in pkgs

nix/ormolize/default.nix+1−1

@@ -32,7 +32,7 @@

3232 cp "$hs_file" "''${hs_file}-original"

3333 done

3434

35− (ormolu --check-idempotence --mode inplace $hs_files || true) 2> log.txt

35+ (ormolu --check-idempotency --mode inplace $hs_files || true) 2> log.txt

3636 '';

3737 inherit doCheck;

3838 checkPhase =

ormolu.cabal+160−174

@@ -1,184 +1,170 @@

1−cabal-version: 1.18

2−name: ormolu

3−version: 0.1.2.0

4−license: BSD3

5−license-file: LICENSE.md

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

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

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

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

10−synopsis: A formatter for Haskell source code

11−description: A formatter for Haskell source code.

12−category: Development, Formatting

13−build-type: Simple

14−data-files:

15− data/examples/declaration/annotation/*.hs

16− data/examples/declaration/class/*.hs

17− data/examples/declaration/data/*.hs

18− data/examples/declaration/data/gadt/*.hs

19− data/examples/declaration/default/*.hs

20− data/examples/declaration/deriving/*.hs

21− data/examples/declaration/foreign/*.hs

22− data/examples/declaration/instance/*.hs

23− data/examples/declaration/rewrite-rule/*.hs

24− data/examples/declaration/role-annotation/*.hs

25− data/examples/declaration/signature/complete/*.hs

26− data/examples/declaration/signature/fixity/*.hs

27− data/examples/declaration/signature/inline/*.hs

28− data/examples/declaration/signature/minimal/*.hs

29− data/examples/declaration/signature/pattern/*.hs

30− data/examples/declaration/signature/set-cost-centre/*.hs

31− data/examples/declaration/signature/specialize/*.hs

32− data/examples/declaration/signature/type/*.hs

33− data/examples/declaration/splice/*.hs

34− data/examples/declaration/type-families/closed-type-family/*.hs

35− data/examples/declaration/type-families/data-family/*.hs

36− data/examples/declaration/type-families/type-family/*.hs

37− data/examples/declaration/type-synonyms/*.hs

38− data/examples/declaration/type/*.hs

39− data/examples/declaration/value/function/*.hs

40− data/examples/declaration/value/function/arrow/*.hs

41− data/examples/declaration/value/function/comprehension/*.hs

42− data/examples/declaration/value/function/do/*.hs

43− data/examples/declaration/value/function/infix/*.hs

44− data/examples/declaration/value/function/pattern/*.hs

45− data/examples/declaration/value/other/*.hs

46− data/examples/declaration/value/pattern-synonyms/*.hs

47− data/examples/declaration/warning/*.hs

48− data/examples/import/*.hs

49− data/examples/module-header/*.hs

50− data/examples/other/*.hs

51−

52−extra-doc-files:

53− CONTRIBUTING.md

54− CHANGELOG.md

55− DESIGN.md

56− README.md

1+name: ormolu

2+version: 0.0.5.0

3+cabal-version: 1.18

4+tested-with: GHC==8.6.5, GHC==8.8.3, GHC==8.10.1

5+license: BSD3

6+license-file: LICENSE.md

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

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

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

10+category: Development, Formatting

11+synopsis: A formatter for Haskell source code

12+build-type: Simple

13+description: A formatter for Haskell source code.

14+extra-doc-files: CONTRIBUTING.md

15+ , CHANGELOG.md

16+ , DESIGN.md

17+ , README.md

18+data-files: data/examples/declaration/annotation/*.hs

19+ , data/examples/declaration/class/*.hs

20+ , data/examples/declaration/data/*.hs

21+ , data/examples/declaration/data/gadt/*.hs

22+ , data/examples/declaration/default/*.hs

23+ , data/examples/declaration/deriving/*.hs

24+ , data/examples/declaration/foreign/*.hs

25+ , data/examples/declaration/instance/*.hs

26+ , data/examples/declaration/rewrite-rule/*.hs

27+ , data/examples/declaration/role-annotation/*.hs

28+ , data/examples/declaration/signature/complete/*.hs

29+ , data/examples/declaration/signature/fixity/*.hs

30+ , data/examples/declaration/signature/inline/*.hs

31+ , data/examples/declaration/signature/minimal/*.hs

32+ , data/examples/declaration/signature/pattern/*.hs

33+ , data/examples/declaration/signature/set-cost-centre/*.hs

34+ , data/examples/declaration/signature/specialize/*.hs

35+ , data/examples/declaration/signature/type/*.hs

36+ , data/examples/declaration/splice/*.hs

37+ , data/examples/declaration/type-families/closed-type-family/*.hs

38+ , data/examples/declaration/type-families/data-family/*.hs

39+ , data/examples/declaration/type-families/type-family/*.hs

40+ , data/examples/declaration/type-synonyms/*.hs

41+ , data/examples/declaration/type/*.hs

42+ , data/examples/declaration/value/function/*.hs

43+ , data/examples/declaration/value/function/arrow/*.hs

44+ , data/examples/declaration/value/function/comprehension/*.hs

45+ , data/examples/declaration/value/function/do/*.hs

46+ , data/examples/declaration/value/function/infix/*.hs

47+ , data/examples/declaration/value/function/pattern/*.hs

48+ , data/examples/declaration/value/other/*.hs

49+ , data/examples/declaration/value/pattern-synonyms/*.hs

50+ , data/examples/declaration/warning/*.hs

51+ , data/examples/import/*.hs

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

53+ , data/examples/other/*.hs

5754

5855source-repository head

59− type: git

60− location: https://github.com/tweag/ormolu.git

56+ type: git

57+ location: https://github.com/tweag/ormolu.git

6158

6259flag dev

63− description: Turn on development settings.

64− default: False

65− manual: True

60+ description: Turn on development settings.

61+ manual: True

62+ default: False

6663

6764library

68− exposed-modules:

69− Ormolu

70− Ormolu.Config

71− Ormolu.Diff

72− Ormolu.Exception

73− Ormolu.Imports

74− Ormolu.Parser

75− Ormolu.Parser.Anns

76− Ormolu.Parser.CommentStream

77− Ormolu.Parser.Pragma

78− Ormolu.Parser.Result

79− Ormolu.Parser.Shebang

80− Ormolu.Printer

81− Ormolu.Printer.Combinators

82− Ormolu.Printer.Comments

83− Ormolu.Printer.Internal

84− Ormolu.Printer.Meat.Common

85− Ormolu.Printer.Meat.Declaration

86− Ormolu.Printer.Meat.Declaration.Annotation

87− Ormolu.Printer.Meat.Declaration.Class

88− Ormolu.Printer.Meat.Declaration.Data

89− Ormolu.Printer.Meat.Declaration.Default

90− Ormolu.Printer.Meat.Declaration.Foreign

91− Ormolu.Printer.Meat.Declaration.Instance

92− Ormolu.Printer.Meat.Declaration.RoleAnnotation

93− Ormolu.Printer.Meat.Declaration.Rule

94− Ormolu.Printer.Meat.Declaration.Signature

95− Ormolu.Printer.Meat.Declaration.Splice

96− Ormolu.Printer.Meat.Declaration.Type

97− Ormolu.Printer.Meat.Declaration.TypeFamily

98− Ormolu.Printer.Meat.Declaration.Value

99− Ormolu.Printer.Meat.Declaration.Warning

100− Ormolu.Printer.Meat.ImportExport

101− Ormolu.Printer.Meat.Module

102− Ormolu.Printer.Meat.Pragma

103− Ormolu.Printer.Meat.Type

104− Ormolu.Printer.Operators

105− Ormolu.Printer.SpanStream

106− Ormolu.Processing.Common

107− Ormolu.Processing.Cpp

108− Ormolu.Processing.Postprocess

109− Ormolu.Processing.Preprocess

110− Ormolu.Utils

111−

112− hs-source-dirs: src

113− other-modules:

114− GHC

115− GHC.DynFlags

116−

117− default-language: Haskell2010

118− build-depends:

119− base >=4.12 && <5.0,

120− bytestring >=0.2 && <0.11,

121− containers >=0.5 && <0.7,

122− dlist >=0.8 && <2.0,

123− exceptions >=0.6 && <0.11,

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

125− mtl >=2.0 && <3.0,

126− syb >=0.7 && <0.8,

127− text >=0.2 && <1.3

128−

129− if flag(dev)

130− ghc-options:

131− -Wall -Werror -Wcompat -Wincomplete-record-updates

132− -Wincomplete-uni-patterns -Wnoncanonical-monad-instances

133− -Wno-missing-home-modules

134−

135− else

136− ghc-options: -O2 -Wall

137−

138−executable ormolu

139− main-is: Main.hs

140− hs-source-dirs: app

141− other-modules: Paths_ormolu

142− default-language: Haskell2010

143− build-depends:

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,

148− ormolu -any,

149− text >=0.2 && <1.3

150−

151− if flag(dev)

152− ghc-options:

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

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

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

156−

157− else

158− ghc-options: -O2 -Wall -rtsopts

65+ hs-source-dirs: src

66+ build-depends: base >= 4.12 && < 5.0

67+ , bytestring >= 0.2 && < 0.11

68+ , containers >= 0.5 && < 0.7

69+ , dlist >= 0.8 && < 0.9

70+ , exceptions >= 0.6 && < 0.11

71+ , ghc-lib-parser >= 8.10 && < 8.11

72+ , mtl >= 2.0 && < 3.0

73+ , syb >= 0.7 && < 0.8

74+ , text >= 0.2 && < 1.3

75+ exposed-modules: Ormolu

76+ , Ormolu.Config

77+ , Ormolu.Diff

78+ , Ormolu.Exception

79+ , Ormolu.Imports

80+ , Ormolu.Parser

81+ , Ormolu.Parser.Anns

82+ , Ormolu.Parser.CommentStream

83+ , Ormolu.Parser.Pragma

84+ , Ormolu.Parser.Result

85+ , Ormolu.Parser.Shebang

86+ , Ormolu.Printer

87+ , Ormolu.Printer.Combinators

88+ , Ormolu.Printer.Comments

89+ , Ormolu.Printer.Internal

90+ , Ormolu.Printer.Meat.Common

91+ , Ormolu.Printer.Meat.Declaration

92+ , Ormolu.Printer.Meat.Declaration.Annotation

93+ , Ormolu.Printer.Meat.Declaration.Class

94+ , Ormolu.Printer.Meat.Declaration.Data

95+ , Ormolu.Printer.Meat.Declaration.Default

96+ , Ormolu.Printer.Meat.Declaration.Foreign

97+ , Ormolu.Printer.Meat.Declaration.Instance

98+ , Ormolu.Printer.Meat.Declaration.RoleAnnotation

99+ , Ormolu.Printer.Meat.Declaration.Rule

100+ , Ormolu.Printer.Meat.Declaration.Signature

101+ , Ormolu.Printer.Meat.Declaration.Splice

102+ , Ormolu.Printer.Meat.Declaration.Type

103+ , Ormolu.Printer.Meat.Declaration.TypeFamily

104+ , Ormolu.Printer.Meat.Declaration.Value

105+ , Ormolu.Printer.Meat.Declaration.Warning

106+ , Ormolu.Printer.Meat.ImportExport

107+ , Ormolu.Printer.Meat.Module

108+ , Ormolu.Printer.Meat.Pragma

109+ , Ormolu.Printer.Meat.Type

110+ , Ormolu.Printer.Operators

111+ , Ormolu.Printer.SpanStream

112+ , Ormolu.Processing.Common

113+ , Ormolu.Processing.Cpp

114+ , Ormolu.Processing.Postprocess

115+ , Ormolu.Processing.Preprocess

116+ , Ormolu.Utils

117+ other-modules: GHC

118+ , GHC.DynFlags

119+ if flag(dev)

120+ ghc-options: -Wall -Werror -Wcompat

121+ -Wincomplete-record-updates

122+ -Wincomplete-uni-patterns

123+ -Wnoncanonical-monad-instances

124+ -- https://github.com/haskell/haddock/issues/1116

125+ -Wno-missing-home-modules

126+ else

127+ ghc-options: -O2 -Wall

128+ default-language: Haskell2010

159129

160130test-suite tests

161− type: exitcode-stdio-1.0

162− main-is: Spec.hs

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

164− hs-source-dirs: tests

165− other-modules:

166− Ormolu.Parser.PragmaSpec

167− Ormolu.PrinterSpec

131+ main-is: Spec.hs

132+ hs-source-dirs: tests

133+ type: exitcode-stdio-1.0

134+ build-depends: base >= 4.12 && < 5.0

135+ , containers >= 0.5 && < 0.7

136+ , filepath >= 1.2 && < 1.5

137+ , hspec >= 2.0 && < 3.0

138+ , ormolu

139+ , path >= 0.6 && < 0.8

140+ , path-io >= 1.4.2 && < 2.0

141+ , text >= 0.2 && < 1.3

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

143+ other-modules:

144+ Ormolu.Parser.PragmaSpec

145+ , Ormolu.PrinterSpec

168146

169− default-language: Haskell2010

170− build-depends:

171− base >=4.12 && <5.0,

172− containers >=0.5 && <0.7,

173− filepath >=1.2 && <1.5,

174− hspec >=2.0 && <3.0,

175− ormolu -any,

176− path >=0.6 && <0.8,

177− path-io >=1.4.2 && <2.0,

178− text >=0.2 && <1.3

147+ if flag(dev)

148+ ghc-options: -Wall -Werror

149+ else

150+ ghc-options: -O2 -Wall

151+ default-language: Haskell2010

179152

180− if flag(dev)

181− ghc-options: -Wall -Werror

182−

183− else

184− ghc-options: -O2 -Wall

153+executable ormolu

154+ main-is: Main.hs

155+ hs-source-dirs: app

156+ build-depends: base >= 4.12 && < 5.0

157+ , ghc-lib-parser >= 8.10 && < 8.11

158+ , gitrev >= 1.3 && < 1.4

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

160+ , ormolu

161+ , text >= 0.2 && < 1.3

162+ other-modules: Paths_ormolu

163+ if flag(dev)

164+ ghc-options: -Wall -Werror -Wcompat

165+ -Wincomplete-record-updates

166+ -Wincomplete-uni-patterns

167+ -Wnoncanonical-monad-instances

168+ else

169+ ghc-options: -O2 -Wall -rtsopts

170+ default-language: Haskell2010

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 @@

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

66foo :: Int

77foo = 5

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

1010bar = \case

1111 0 -> foo

1212 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 @@

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

66foo :: Int

77foo = 5

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

99bar = \case

1010 0 -> foo

1111 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 @@

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

66foo :: Int

77foo = 5

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

1010bar = \case

1111 0 -> foo

1212 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 @@

33module Foo

44 ( foo,

55 bar,

6− baz,

76 )

87where

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

1413bar = \case

1514 0 -> foo

1615 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 @@

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

66foo :: Int

77foo = 5

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

1010bar = \case

1111 0 -> foo

1212 x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

shell.nix+2−4

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

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

2−, system ? builtins.currentSystem

3−}:

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

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

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

src/GHC.hs+3

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

11module GHC

22 ( module X,

3+ ParsedSource,

34 )

45where

@@ -10,3 +11,5 @@ import GHC.Hs.Instances as X ()

1011import Module as X

1112import RdrName as X

1213import SrcLoc as X

14+

15+type ParsedSource = Located (HsModule GhcPs)

src/Ormolu.hs+2−2

@@ -63,7 +63,7 @@ ormolu cfgWithIndices path str = do

6363 -- to parse the rendered code back, inside of GHC monad wrapper which will

6464 -- lead to error messages presenting the exceptions as GHC bugs.

6565 let !txt = printModule result0

66− when (not (cfgUnsafe cfg) || cfgCheckIdempotence cfg) $ do

66+ when (not (cfgUnsafe cfg) || cfgCheckIdempotency cfg) $ do

6767 let pathRendered = path ++ "<rendered>"

6868 -- Parse the result of pretty-printing again and make sure that AST

6969 -- is the same as AST of original snippet module span positions.

@@ -79,7 +79,7 @@ ormolu cfgWithIndices path str = do

7979 Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss)

8080 -- Try re-formatting the formatted result to check if we get exactly

8181 -- the same output.

82− when (cfgCheckIdempotence cfg) $

82+ when (cfgCheckIdempotency cfg) $

8383 let txt2 = printModule result1

8484 in case diffText txt txt2 pathRendered of

8585 Nothing -> return ()

src/Ormolu/Config.hs+2−2

@@ -24,7 +24,7 @@ data Config region = Config

2424 -- | Output information useful for debugging

2525 cfgDebug :: !Bool,

2626 -- | Checks if re-formatting the result is idempotent

27− cfgCheckIdempotence :: !Bool,

27+ cfgCheckIdempotency :: !Bool,

2828 -- | Region selection

2929 cfgRegion :: !region

3030 }

@@ -56,7 +56,7 @@ defaultConfig =

5656 { cfgDynOptions = [],

5757 cfgUnsafe = False,

5858 cfgDebug = False,

59− cfgCheckIdempotence = False,

59+ cfgCheckIdempotency = False,

6060 cfgRegion =

6161 RegionIndices

6262 { regionStartLine = Nothing,

src/Ormolu/Diff.hs+12−15

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

1414import qualified Data.Text as T

1515import qualified FastString as GHC

1616import GHC

17−import Ormolu.Imports (normalizeImports)

18−import Ormolu.Parser.CommentStream

17+import Ormolu.Imports (sortImports)

1918import Ormolu.Parser.Result

2019import Ormolu.Utils

2120

@@ -39,16 +38,14 @@ diffParseResult :: ParseResult -> ParseResult -> Diff

3938diffParseResult

4039 ParseResult

4140 { prCommentStream = cstream0,

42− prParsedSource = hs0

41+ prParsedSource = ps0

4342 }

4443 ParseResult

4544 { prCommentStream = cstream1,

46− prParsedSource = hs1

45+ prParsedSource = ps1

4746 } =

4847 matchIgnoringSrcSpans cstream0 cstream1

49− <> matchIgnoringSrcSpans

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

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

48+ <> matchIgnoringSrcSpans ps0 ps1

5249

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

5451-- and the ordering of import lists.

@@ -70,7 +67,7 @@ matchIgnoringSrcSpans = genericQuery

7067 gzipWithQ

7168 ( genericQuery

7269 `extQ` srcSpanEq

73− `extQ` commentEq

70+ `extQ` hsModuleEq

7471 `extQ` sourceTextEq

7572 `extQ` hsDocStringEq

7673 `extQ` importDeclQualifiedStyleEq

@@ -81,14 +78,14 @@ matchIgnoringSrcSpans = genericQuery

8178 | otherwise = Different []

8279 srcSpanEq :: SrcSpan -> GenericQ Diff

8380 srcSpanEq _ _ = Same

84− commentEq :: Comment -> GenericQ Diff

85− commentEq (Comment _ x) d =

86− case cast d :: Maybe Comment of

81+ hsModuleEq :: HsModule GhcPs -> GenericQ Diff

82+ hsModuleEq hs0 hs1' =

83+ case cast hs1' :: Maybe (HsModule GhcPs) of

8784 Nothing -> Different []

88− Just (Comment _ y) ->

89− if x == y

90− then Same

91− else Different []

85+ Just hs1 ->

86+ matchIgnoringSrcSpans

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

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

9289 sourceTextEq :: SourceText -> GenericQ Diff

9390 sourceTextEq _ _ = Same

9491 importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ Diff

src/Ormolu/Imports.hs+44−161

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

55-- | Manipulations on import lists.

66module Ormolu.Imports

7− ( normalizeImports,

7+ ( sortImports,

88 )

99where

1010

1111import Data.Bifunctor

12−import Data.Char (isAlphaNum)

1312import Data.Function (on)

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

15−import Data.Map.Strict (Map)

16−import qualified Data.Map.Strict as M

17−import FastString (FastString)

13+import Data.Generics (gcompare)

14+import Data.List (sortBy)

1815import GHC hiding (GhcPs, IE)

1916import GHC.Hs.Extension

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

21−import Ormolu.Utils (notImplemented, showOutputable)

18+import Ormolu.Utils (notImplemented)

2219

23−-- | Sort and normalize imports.

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

25−normalizeImports =

26− fmap snd

27− . M.toAscList

28− . M.fromListWith combineImports

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

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

21+-- each declaration.

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

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

3024 where

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

32− L

33− l

25+ sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs

26+ sortImportLists = \case

27+ ImportDecl {..} ->

3428 ImportDecl

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

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

3630 ..

3731 }

38− g _ = notImplemented "XImportDecl"

32+ XImportDecl x -> noExtCon x

3933

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

41−-- are equal.

42−combineImports ::

43− LImportDecl GhcPs ->

44− LImportDecl GhcPs ->

45− LImportDecl GhcPs

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

47− L

48− lx

49− ImportDecl

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

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

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− }

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

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

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

37+ case (isPrelude n0, isPrelude n1) of

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

39+ (True, False) -> GT

40+ (False, True) -> LT

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

9142 where

92− isPrelude = moduleNameString moduleName == "Prelude"

93− moduleName = unLoc ideclName

94−importId _ = notImplemented "XImportDecl"

43+ n0 = unLoc (ideclName m0)

44+ n1 = unLoc (ideclName m1)

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

9546

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

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

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

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

47+-- | Sort located import or export.

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

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

15150

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

153−-- 'Ord' instance for it.

154−newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)

155− deriving (Eq)

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

52+sortThings :: IE GhcPs -> IE GhcPs

53+sortThings = \case

54+ IEThingWith NoExtField x w xs fl ->

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

56+ other -> other

15657

157−instance Ord IEWrappedNameOrd where

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

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

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

60+compareIE = compareIewn `on` getIewn

15961

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

161−getIewn :: IE GhcPs -> IEWrappedNameOrd

63+getIewn :: IE GhcPs -> IEWrappedName RdrName

16264getIewn = \case

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

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

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

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

65+ IEVar NoExtField x -> unLoc x

66+ IEThingAbs NoExtField x -> unLoc x

67+ IEThingAll NoExtField x -> unLoc x

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

16769 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

16870 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

16971 IEDoc NoExtField _ -> notImplemented "IEDoc"

17072 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

17173 XIE x -> noExtCon x

17274

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

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

175−compareLIewn = compareIewn `on` unLoc

176−

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

17876compareIewn :: 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

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

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

18280compareIewn (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

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

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

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

187−compareIewn (IEType x) (IEType y) = unLoc x `compareRdrName` 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

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

src/Ormolu/Parser.hs+6−8

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

3232import Ormolu.Parser.CommentStream

3333import Ormolu.Parser.Result

3434import Ormolu.Processing.Preprocess (preprocess)

35−import Ormolu.Utils (incSpanLine, removeIndentation)

35+import Ormolu.Utils (incSpanLine)

3636import qualified Panic as GHC

3737import qualified Parser as GHC

3838import qualified StringBuffer as GHC

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

5151 Either (SrcSpan, String) ParseResult

5252 )

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

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

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

5555 preprocess path rawInput cfgRegion

56− (input, indent) = removeIndentation indentedInput

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

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

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

@@ -89,7 +88,7 @@ parseModule Config {..} path rawInput = liftIO $ do

8988 case pStateErrors pstate of

9089 Just err -> Left err

9190 Nothing -> error "PFailed does not have an error"

92− GHC.POk pstate (L _ hsModule) ->

91+ GHC.POk pstate pmod ->

9392 case pStateErrors pstate of

9493 -- Some parse errors (pattern/arrow syntax in expr context)

9594 -- do not cause a parse error, but they are replaced with "_"

@@ -98,10 +97,10 @@ parseModule Config {..} path rawInput = liftIO $ do

9897 Just err -> Left err

9998 Nothing ->

10099 let (stackHeader, shebangs, pragmas, comments) =

101− mkCommentStream input extraComments pstate

100+ mkCommentStream extraComments pstate

102101 in Right

103102 ParseResult

104− { prParsedSource = hsModule,

103+ { prParsedSource = pmod,

105104 prAnns = mkAnns pstate,

106105 prStackHeader = stackHeader,

107106 prShebangs = shebangs,

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

111110 prImportQualifiedPost =

112111 GHC.xopt ImportQualifiedPost dynFlags,

113112 prLiteralPrefix = T.pack literalPrefix,

114− prLiteralSuffix = T.pack literalSuffix,

115− prIndent = indent

113+ prLiteralSuffix = T.pack literalSuffix

116114 }

117115 return (warnings, r)

118116

src/Ormolu/Parser/CommentStream.hs+60−126

@@ -4,16 +4,12 @@

55-- | Functions for working with comment stream.

66module Ormolu.Parser.CommentStream

7− ( -- * Comment stream

8− CommentStream (..),

9− mkCommentStream,

10− showCommentStream,

11−

12− -- * Comment

7+ ( CommentStream (..),

138 Comment (..),

14− unComment,

15− hasAtomsBefore,

9+ mkCommentStream,

10+ isPrevHaddock,

1611 isMultilineComment,

12+ showCommentStream,

1713 )

1814where

1915

@@ -27,24 +23,23 @@ import qualified GHC

2723import qualified Lexer as GHC

2824import Ormolu.Parser.Pragma

2925import Ormolu.Parser.Shebang

30−import Ormolu.Processing.Common

31−import Ormolu.Utils (onTheSameLine, showOutputable)

26+import Ormolu.Utils (showOutputable)

3227import SrcLoc

3328

34−----------------------------------------------------------------------------

35−-- Comment stream

36−

3729-- | A stream of 'RealLocated' 'Comment's in ascending order with respect to

3830-- beginning of corresponding spans.

3931newtype CommentStream = CommentStream [RealLocated Comment]

4032 deriving (Eq, Data, Semigroup, Monoid)

4133

34+-- | A wrapper for a single comment. The 'NonEmpty' list inside contains

35+-- lines of multiline comment @{- … -}@ or just single item\/line otherwise.

36+newtype Comment = Comment (NonEmpty String)

37+ deriving (Eq, Show, Data)

38+

4239-- | Create 'CommentStream' from 'GHC.PState'. The pragmas and shebangs are

4340-- removed from the 'CommentStream'. Shebangs are only extracted from the

4441-- comments that come from the first argument.

4542mkCommentStream ::

46− -- | Original input

47− String ->

4843 -- | Extra comments to include

4944 [Located String] ->

5045 -- | Parser state to use for comment extraction

@@ -55,14 +50,14 @@ mkCommentStream ::

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

5651 CommentStream

5752 )

58−mkCommentStream input extraComments pstate =

53+mkCommentStream extraComments pstate =

5954 ( mstackHeader,

6055 shebangs,

6156 pragmas,

6257 CommentStream comments

6358 )

6459 where

65− (comments, pragmas) = extractPragmas input rawComments1

60+ (comments, pragmas) = extractPragmas rawComments1

6661 (rawComments1, mstackHeader) = extractStackHeader rawComments0

6762 rawComments0 =

6863 L.sortOn (realSrcSpanStart . getRealSrcSpan) . mapMaybe toRealSpan $

@@ -73,6 +68,15 @@ mkCommentStream input extraComments pstate =

7368 (GHC.annotations_comments pstate)

7469 (shebangs, otherExtraComments) = extractShebangs extraComments

7570

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

72+-- i.e. something starting with @-- ^@.

73+isPrevHaddock :: Comment -> Bool

74+isPrevHaddock (Comment (x :| _)) = "-- ^" `L.isPrefixOf` x

75+

76+-- | Is this comment multiline-style?

77+isMultilineComment :: Comment -> Bool

78+isMultilineComment (Comment (x :| _)) = "{-" `L.isPrefixOf` x

79+

7680-- | Pretty-print a 'CommentStream'.

7781showCommentStream :: CommentStream -> String

7882showCommentStream (CommentStream xs) =

@@ -82,145 +86,75 @@ showCommentStream (CommentStream xs) =

8286 showComment (GHC.L l str) = showOutputable l ++ " " ++ show str

8387

8488----------------------------------------------------------------------------

85−-- Comment

86−

87−-- | A wrapper for a single comment. The 'Bool' indicates whether there were

88−-- atoms before beginning of the comment in the original input. The

89−-- 'NonEmpty' list inside contains lines of multiline comment @{- … -}@ or

90−-- just single item\/line otherwise.

91−data Comment = Comment Bool (NonEmpty String)

92− deriving (Eq, Show, Data)

89+-- Helpers

9390

9491-- | Normalize comment string. Sometimes one multi-line comment is turned

9592-- into several lines for subsequent outputting with correct indentation for

9693-- each line.

97−mkComment ::

98− -- | Lines of original input with their indices

99− [(Int, String)] ->

100− -- | Raw comment string

101− RealLocated String ->

102− -- | Remaining lines of original input and the constructed 'Comment'

103− ([(Int, String)], RealLocated Comment)

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

94+mkComment :: RealLocated String -> RealLocated Comment

95+mkComment (L l s) =

96+ L l . Comment . fmap dropTrailing $

97+ if "{-" `L.isPrefixOf` s

98+ then case NE.nonEmpty (lines s) of

99+ Nothing -> s :| []

100+ Just (x :| xs) ->

101+ let getIndent y =

102+ if all isSpace y

103+ then startIndent

104+ else length (takeWhile isSpace y)

105+ n = minimum (startIndent : fmap getIndent xs)

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

107+ else s :| []

105108 where

106− comment =

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

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

109− then case NE.nonEmpty (lines s) of

110− Nothing -> s :| []

111− Just (x :| xs) ->

112− let getIndent y =

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

114− then startIndent

115− else length (takeWhile isSpace y)

116− n = minimum (startIndent : fmap getIndent xs)

117− removeIndent y =

118− if y == endDisabling

119− then y

120− else drop n y

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

122− else s :| []

123− (atomsBefore, ls') =

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

125− [] -> (False, [])

126− ((_, i) : ls'') ->

127− case take 2 (dropWhile isSpace i) of

128− "--" -> (False, ls'')

129− "{-" -> (False, ls'')

130− _ -> (True, ls'')

131109 dropTrailing = L.dropWhileEnd isSpace

132110 startIndent = srcSpanStartCol l - 1

133− commentLine = srcSpanStartLine l

134−

135−-- | Get a collection of lines from a 'Comment'.

136−unComment :: Comment -> NonEmpty String

137−unComment (Comment _ xs) = xs

138111

139−-- | Check whether the 'Comment' had some non-whitespace atoms in front of

140−-- it in the original input.

141−hasAtomsBefore :: Comment -> Bool

142−hasAtomsBefore (Comment atomsBefore _) = atomsBefore

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

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

114+unAnnotationComment = \case

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

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

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

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

119+ GHC.AnnDocOptions s -> Just s

120+ GHC.AnnLineComment s -> Just s

121+ GHC.AnnBlockComment s -> Just s

143122

144−-- | Is this comment multiline-style?

145−isMultilineComment :: Comment -> Bool

146−isMultilineComment (Comment _ (x :| _)) = "{-" `L.isPrefixOf` x

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

124+liftMaybe = \case

125+ L _ Nothing -> Nothing

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

147127

148−----------------------------------------------------------------------------

149−-- Helpers

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

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

130+toRealSpan _ = Nothing

150131

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

152133extractStackHeader ::

153− -- | Comment stream to analyze

154134 [RealLocated String] ->

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

156136extractStackHeader = \case

157137 [] -> ([], Nothing)

158138 (x : xs) ->

159− let comment = snd (mkComment [] x)

139+ let comment = mkComment x

160140 in if isStackHeader (unRealSrcSpan comment)

161141 then (xs, Just comment)

162142 else (x : xs, Nothing)

163143 where

164− isStackHeader (Comment _ (x :| _)) =

144+ isStackHeader (Comment (x :| _)) =

165145 "stack" `L.isPrefixOf` dropWhile isSpace (drop 2 x)

166146

167147-- | Extract pragmas and their associated comments.

168148extractPragmas ::

169− -- | Input

170− String ->

171− -- | Comment stream to analyze

172149 [RealLocated String] ->

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

174−extractPragmas input = go initialLs id id

151+extractPragmas = go id id

175152 where

176− initialLs = zip [1 ..] (lines input)

177− go ls csSoFar pragmasSoFar = \case

153+ go csSoFar pragmasSoFar = \case

178154 [] -> (csSoFar [], pragmasSoFar [])

179155 (x : xs) ->

180156 case parsePragma (unRealSrcSpan x) of

181− Nothing ->

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

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

157+ Nothing -> go (csSoFar . (mkComment x :)) pragmasSoFar xs

184158 Just pragma ->

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

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

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

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

160+ in go id (pragmasSoFar . (combined :)) xs

src/Ormolu/Parser/Result.hs+2−4

@@ -17,7 +17,7 @@ import Ormolu.Parser.Shebang (Shebang)

1717-- | A collection of data that represents a parsed module in Ormolu.

1818data ParseResult = ParseResult

1919 { -- | 'ParsedSource' from GHC

20− prParsedSource :: HsModule GhcPs,

20+ prParsedSource :: ParsedSource,

2121 -- | Ormolu-specfic representation of annotations

2222 prAnns :: Anns,

2323 -- | Stack header

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

3535 -- | Literal prefix

3636 prLiteralPrefix :: Text,

3737 -- | Literal suffix

38− prLiteralSuffix :: Text,

39− -- | Indentation level, can be non-zero in case of region formatting

40− prIndent :: Int

38+ prLiteralSuffix :: Text

4139 }

4240

4341-- | Pretty-print a 'ParseResult'.

src/Ormolu/Printer.hs+1−1

@@ -23,7 +23,7 @@ printModule ParseResult {..} =

2323 prLiteralPrefix <> region <> prLiteralSuffix

2424 where

2525 region =

26− postprocess prIndent $

26+ postprocess $

2727 runR

2828 ( p_hsModule

2929 prStackHeader

src/Ormolu/Printer/Combinators.hs+26−34

@@ -21,7 +21,6 @@ module Ormolu.Printer.Combinators

2121 space,

2222 newline,

2323 inci,

24− inciIf,

2524 located,

2625 located',

2726 switchLayout,

@@ -52,8 +51,6 @@ module Ormolu.Printer.Combinators

5251

5352 -- ** Literals

5453 comma,

55− commaDel,

56− equals,

5754

5855 -- ** Stateful markers

5956 SpanMark (..),

@@ -65,44 +62,48 @@ module Ormolu.Printer.Combinators

6562where

6663

6764import Control.Monad

65+import Data.Data (Data)

6866import Data.List (intersperse)

6967import Data.Text (Text)

7068import Ormolu.Printer.Comments

7169import Ormolu.Printer.Internal

70+import Ormolu.Utils (isModule)

7271import SrcLoc

7372

7473----------------------------------------------------------------------------

7574-- Basic

7675

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−

8676-- | Enter a 'Located' entity. This combinator handles outputting comments

8777-- and sets layout (single-line vs multi-line) for the inner computation.

8878-- Roughly, the rule for using 'located' is that every time there is a

8979-- 'Located' wrapper, it should be “discharged” with a corresponding

9080-- 'located' invocation.

9181located ::

82+ Data a =>

9283 -- | Thing to enter

9384 Located a ->

9485 -- | How to render inner value

9586 (a -> R ()) ->

9687 R ()

97−located (L (UnhelpfulSpan _) a) f = f a

98−located (L (RealSrcSpan l) a) f = do

99− spitPrecedingComments l

100− withEnclosingSpan l $

101− switchLayout [RealSrcSpan l] (f a)

102− spitFollowingComments l

88+located loc f = do

89+ let withRealLocated (L l a) g =

90+ case l of

91+ UnhelpfulSpan _ -> return ()

92+ RealSrcSpan l' -> g (L l' a)

93+ withRealLocated loc spitPrecedingComments

94+ let setEnclosingSpan =

95+ case getLoc loc of

96+ UnhelpfulSpan _ -> id

97+ RealSrcSpan orf ->

98+ if isModule (unLoc loc)

99+ then id

100+ else withEnclosingSpan orf

101+ setEnclosingSpan $ switchLayout [getLoc loc] (f (unLoc loc))

102+ withRealLocated loc spitFollowingComments

103103

104104-- | A version of 'located' with arguments flipped.

105105located' ::

106+ Data a =>

106107 -- | How to render inner value

107108 (a -> R ()) ->

108109 -- | Thing to enter

@@ -185,12 +186,10 @@ sepSemi f xs = vlayout singleLine multiLine

185186 xs' ->

186187 if ub

187188 then do

188− txt "{"

189− space

190− sep (txt ";" >> space) (dontUseBraces . f) xs'

191− space

192− txt "}"

193− else sep (txt ";" >> space) f xs'

189+ txt "{ "

190+ sep (txt "; ") (dontUseBraces . f) xs'

191+ txt " }"

192+ else sep (txt "; ") f xs'

194193 multiLine =

195194 sep newline (dontUseBraces . f) xs

196195

@@ -203,7 +202,6 @@ data BracketStyle

203202 N

204203 | -- | Shifted one level

205204 S

206− deriving (Eq, Show)

207205

208206-- | Surround given entity by backticks.

209207backticks :: R () -> R ()

@@ -280,7 +278,9 @@ brackets_ needBreaks open close style m = sitcc (vlayout singleLine multiLine)

280278 then newline >> inci m

281279 else space >> sitcc m

282280 newline

283− inciIf (style == S) (txt close)

281+ case style of

282+ N -> txt close

283+ S -> inci (txt close)

284284

285285----------------------------------------------------------------------------

286286-- Literals

@@ -288,11 +288,3 @@ brackets_ needBreaks open close style m = sitcc (vlayout singleLine multiLine)

288288-- | Print @,@.

289289comma :: R ()

290290comma = 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+51−41

@@ -13,11 +13,13 @@ module Ormolu.Printer.Comments

1313where

1414

1515import Control.Monad

16+import Data.Coerce (coerce)

17+import Data.Data (Data)

1618import qualified Data.List.NonEmpty as NE

17−import Data.Maybe (listToMaybe)

1819import qualified Data.Text as T

1920import Ormolu.Parser.CommentStream

2021import Ormolu.Printer.Internal

22+import Ormolu.Utils (isModule)

2123import SrcLoc

2224

2325----------------------------------------------------------------------------

@@ -25,8 +27,9 @@ import SrcLoc

2527

2628-- | Output all preceding comments for an element at given location.

2729spitPrecedingComments ::

28− -- | Span of the element to attach comments to

29− RealSrcSpan ->

30+ Data a =>

31+ -- | AST element to attach comments to

32+ RealLocated a ->

3033 R ()

3134spitPrecedingComments ref = do

3235 gotSome <- handleCommentSeries (spitPrecedingComment ref)

@@ -34,15 +37,16 @@ spitPrecedingComments ref = do

3437 lastMark <- getSpanMark

3538 -- Insert a blank line between the preceding comments and the thing

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

37− when (needsNewlineBefore ref lastMark) newline

40+ when (needsNewlineBefore (getRealSrcSpan ref) lastMark) newline

3841

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

4043spitFollowingComments ::

41− -- | Span of the element to attach comments to

42− RealSrcSpan ->

44+ Data a =>

45+ -- | AST element of attach comments to

46+ RealLocated a ->

4347 R ()

4448spitFollowingComments ref = do

45− trimSpanStream ref

49+ trimSpanStream (getRealSrcSpan ref)

4650 void $ handleCommentSeries (spitFollowingComment ref)

4751

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

@@ -58,41 +62,49 @@ spitRemainingComments = do

5862

5963-- | Output a single preceding comment for an element at given location.

6064spitPrecedingComment ::

61− -- | Span of the element to attach comments to

62− RealSrcSpan ->

65+ Data a =>

66+ -- | AST element to attach comments to

67+ RealLocated a ->

68+ -- | Location of last comment in the series

69+ Maybe SpanMark ->

6370 -- | Are we done?

6471 R Bool

65−spitPrecedingComment ref = do

66− mlastMark <- getSpanMark

72+spitPrecedingComment (L ref a) mlastMark = do

6773 let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref

6874 withPoppedComment p $ \l comment -> do

69− lineSpans <- thisLineSpans

70− let thisCommentLine = srcLocLine (realSrcSpanStart l)

71− needsNewline =

72− case listToMaybe lineSpans of

73− Nothing -> False

74− Just spn -> srcLocLine (realSrcSpanEnd spn) /= thisCommentLine

75− when (needsNewline || needsNewlineBefore l mlastMark) newline

75+ dirtyLine <-

76+ case mlastMark of

77+ -- When the current line is dirty it means that something that can

78+ -- have comments attached to it is already on the line. To avoid

79+ -- problems with idempotence we cannot output the first comment

80+ -- immediately because it'll be attached to the previous element (on

81+ -- the same line) on the next run, so we play safe here and output

82+ -- an extra 'newline' in this case.

83+ Nothing -> isLineDirty -- only for very first preceding comment

84+ Just _ -> return False

85+ when (dirtyLine || needsNewlineBefore l mlastMark) newline

7686 spitCommentNow l comment

77− if theSameLinePre l ref

87+ if theSameLinePre l ref && not (isModule a)

7888 then space

7989 else newline

8090

8191-- | Output a comment that follows element at given location immediately on

8292-- the same line, if there is any.

8393spitFollowingComment ::

94+ Data a =>

8495 -- | AST element to attach comments to

85− RealSrcSpan ->

96+ RealLocated a ->

97+ -- | Location of last comment in the series

98+ Maybe SpanMark ->

8699 -- | Are we done?

87100 R Bool

88−spitFollowingComment ref = do

89− mlastMark <- getSpanMark

101+spitFollowingComment (L ref a) mlastMark = do

90102 mnSpn <- nextEltSpan

91103 -- Get first enclosing span that is not equal to reference span, i.e. it's

92104 -- truly something enclosing the AST element.

93105 meSpn <- getEnclosingSpan (/= ref)

94106 withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment ->

95− if theSameLinePost l ref

107+ if theSameLinePost l ref && not (isModule a)

96108 then

97109 if isMultilineComment comment

98110 then space >> spitCommentNow l comment

@@ -104,10 +116,11 @@ spitFollowingComment ref = do

104116

105117-- | Output a single remaining comment from the comment stream.

106118spitRemainingComment ::

119+ -- | Location of last comment in the series

120+ Maybe SpanMark ->

107121 -- | Are we done?

108122 R Bool

109−spitRemainingComment = do

110− mlastMark <- getSpanMark

123+spitRemainingComment mlastMark =

111124 withPoppedComment (const True) $ \l comment -> do

112125 when (needsNewlineBefore l mlastMark) newline

113126 spitCommentNow l comment

@@ -120,13 +133,13 @@ spitRemainingComment = do

120133handleCommentSeries ::

121134 -- | Given location of previous comment, output the next comment

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

123− R Bool ->

136+ (Maybe SpanMark -> R Bool) ->

124137 -- | Whether we printed any comments

125138 R Bool

126139handleCommentSeries f = go False

127140 where

128141 go gotSome = do

129− done <- f

142+ done <- getSpanMark >>= f

130143 if done

131144 then return gotSome

132145 else go True

@@ -154,7 +167,6 @@ needsNewlineBefore ::

154167 -- | Last printed comment span

155168 Maybe SpanMark ->

156169 Bool

157−needsNewlineBefore _ (Just (HaddockSpan _ _)) = True

158170needsNewlineBefore l mlastMark =

159171 case spanMarkSpan <$> mlastMark of

160172 Nothing -> False

@@ -207,8 +219,9 @@ commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =

207219 -- 2) The comment logically belongs to the element, four cases:

208220 logicallyFollows =

209221 theSameLinePost l ref -- a) it's on the same line

210− || continuation -- b) it's a continuation of a comment block

211− || lastInEnclosing -- c) it's the last element in the enclosing construct

222+ || isPrevHaddock comment -- b) it's a Haddock string starting with -- ^

223+ || continuation -- c) it's a continuation of a comment block

224+ || lastInEnclosing -- d) it's the last element in the enclosing construct

212225

213226 -- 3) There is no other AST element between this element and the comment:

214227 noEltBetween =

@@ -235,15 +248,12 @@ commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =

235248 >= abs (startColumn ref - startColumn l)

236249 )

237250 continuation =

238− -- A comment is a continuation when it doesn't have non-whitespace

239− -- lexemes in front of it and goes right after the previous comment.

240− not (hasAtomsBefore comment)

241− && ( case mlastMark of

242− Just (HaddockSpan _ _) -> False

243− Just (CommentSpan spn) ->

244− srcSpanEndLine spn + 1 == srcSpanStartLine l

245− _ -> False

246− )

251+ case mlastMark of

252+ Just (HaddockSpan _ spn) ->

253+ srcSpanEndLine spn + 1 == srcSpanStartLine l

254+ Just (CommentSpan spn) ->

255+ srcSpanEndLine spn + 1 == srcSpanStartLine l

256+ _ -> False

247257 lastInEnclosing =

248258 case meSpn of

249259 -- When there is no enclosing element, return false

@@ -265,7 +275,7 @@ spitCommentNow spn comment = do

265275 . sequence_

266276 . NE.intersperse newline

267277 . fmap (txt . T.pack)

268− . unComment

278+ . coerce

269279 $ comment

270280 setSpanMark (CommentSpan spn)

271281

@@ -281,6 +291,6 @@ spitCommentPending position spn comment = do

281291 . sequence_

282292 . NE.toList

283293 . fmap (registerPendingCommentLine position . T.pack)

284− . unComment

294+ . coerce

285295 $ comment

286296 setSpanMark (CommentSpan spn)

src/Ormolu/Printer/Internal.hs+52−85

@@ -14,10 +14,10 @@ module Ormolu.Printer.Internal

1414

1515 -- * Internal functions

1616 txt,

17− interferingTxt,

1817 atom,

1918 space,

2019 newline,

20+ isLineDirty,

2121 useRecordDot,

2222 inci,

2323 sitcc,

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

3939 popComment,

4040 getEnclosingSpan,

4141 withEnclosingSpan,

42− thisLineSpans,

4342

4443 -- * Stateful markers

4544 SpanMark (..),

@@ -99,19 +98,18 @@ data RC = RC

9998data SC = SC

10099 { -- | Index of the next column to render

101100 scColumn :: !Int,

102− -- | Indentation level that was used for the current line

103− scIndent :: !Int,

104101 -- | Rendered source code so far

105102 scBuilder :: Builder,

106103 -- | Span stream

107104 scSpanStream :: SpanStream,

108− -- | Spans of atoms that have been printed on the current line so far

109− scThisLineSpans :: [RealSrcSpan],

110105 -- | Comment stream

111106 scCommentStream :: CommentStream,

112107 -- | Pending comment lines (in reverse order) to be inserted before next

113108 -- newline, 'Int' is the indentation level

114− scPendingComments :: ![(CommentPosition, Text)],

109+ scPendingComments :: ![(CommentPosition, Int, Text)],

110+ -- | Whether the current line is “dirty”, that is, already contains

111+ -- atoms that can have comments attached to them

112+ scDirtyLine :: !Bool,

115113 -- | Whether to output a space before the next output

116114 scRequestedDelimiter :: !RequestedDelimiter,

117115 -- | An auxiliary marker for keeping track of last output element

@@ -177,12 +175,11 @@ runR (R m) sstream cstream anns recDot =

177175 sc =

178176 SC

179177 { scColumn = 0,

180− scIndent = 0,

181178 scBuilder = mempty,

182179 scSpanStream = sstream,

183− scThisLineSpans = [],

184180 scCommentStream = cstream,

185181 scPendingComments = [],

182+ scDirtyLine = False,

186183 scRequestedDelimiter = VeryBeginning,

187184 scSpanMark = Nothing

188185 }

@@ -190,23 +187,6 @@ runR (R m) sstream cstream anns recDot =

190187----------------------------------------------------------------------------

191188-- Internal functions

192189

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−

210190-- | Output a fixed 'Text' fragment. The argument may not contain any line

211191-- breaks. 'txt' is used to output all sorts of “fixed” bits of syntax like

212192-- keywords and pipes @|@ in functional dependencies.

@@ -218,15 +198,7 @@ txt ::

218198 -- | 'Text' to output

219199 Text ->

220200 R ()

221−txt = spit SimpleText

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

201+txt = spit False False

230202

231203-- | Output 'Outputable' fragment of AST. This can be used to output numeric

232204-- literals and similar. Everything that doesn't have inner structure but

@@ -235,60 +207,47 @@ atom ::

235207 Outputable a =>

236208 a ->

237209 R ()

238−atom = spit Atom . T.pack . showOutputable

210+atom = spit True False . T.pack . showOutputable

239211

240212-- | Low-level non-public helper to define 'txt' and 'atom'.

241213spit ::

242− -- | Type of the thing to spit

243− SpitType ->

214+ -- | Should we mark the line as dirty?

215+ Bool ->

216+ -- | Used during outputting of pending comments?

217+ Bool ->

244218 -- | 'Text' to output

245219 Text ->

246220 R ()

247−spit _ "" = return ()

248−spit stype text = do

221+spit dirty printingComments txt' = do

249222 requestedDel <- R (gets scRequestedDelimiter)

250− pendingComments <- R (gets scPendingComments)

251− when (stype == InterferingText && not (null pendingComments)) newline

252223 case requestedDel of

253224 RequestedNewline -> do

254225 R . modify $ \sc ->

255226 sc

256227 { scRequestedDelimiter = RequestedNothing

257228 }

258− case stype of

259− CommentPart -> newlineRaw

260− _ -> newline

229+ if printingComments

230+ then newlineRaw

231+ else newline

261232 _ -> return ()

262233 R $ do

263234 i <- asks rcIndent

264235 c <- gets scColumn

265− closestEnclosing <- listToMaybe <$> asks rcEnclosingSpans

266− let indentedTxt = spaces <> text

267− spaces = T.replicate spacesN " "

268− spacesN =

269− if c == 0

270− then i

271− else bool 0 1 (requestedDel == RequestedSpace)

236+ let spaces =

237+ if c < i

238+ then T.replicate (i - c) " "

239+ else bool mempty " " (requestedDel == RequestedSpace)

240+ indentedTxt = spaces <> txt'

272241 modify $ \sc ->

273242 sc

274243 { scBuilder = scBuilder sc <> fromText indentedTxt,

275244 scColumn = scColumn sc + T.length indentedTxt,

276− scIndent =

277− if c == 0

278− then i

279− else scIndent sc,

280− scThisLineSpans =

281− let xs = scThisLineSpans sc

282− in case stype of

283− Atom -> case closestEnclosing of

284− Nothing -> xs

285− Just x -> x : xs

286− _ -> xs,

245+ scDirtyLine = scDirtyLine sc || dirty,

287246 scRequestedDelimiter = RequestedNothing,

288247 scSpanMark =

289248 -- If there are pending comments, do not reset last comment

290249 -- location.

291− if (stype == CommentPart) || (not . null . scPendingComments) sc

250+ if printingComments || (not . null . scPendingComments) sc

292251 then scSpanMark sc

293252 else Nothing

294253 }

@@ -320,22 +279,21 @@ space = R . modify $ \sc ->

320279-- hard to output more than one blank newline in a row.

321280newline :: R ()

322281newline = do

323− indent <- R (gets scIndent)

324282 cs <- reverse <$> R (gets scPendingComments)

325283 case cs of

326284 [] -> newlineRaw

327− ((position, _) : _) -> do

285+ ((position, _, _) : _) -> do

328286 case position of

329287 OnTheSameLine -> space

330288 OnNextLine -> newlineRaw

331− R . forM_ cs $ \(_, text) ->

289+ R . forM_ cs $ \(_, indent, txt') ->

332290 let modRC rc =

333291 rc

334292 { rcIndent = indent

335293 }

336294 R m = do

337− unless (T.null text) $

338− spit CommentPart text

295+ unless (T.null txt') $

296+ spit False True txt'

339297 newlineRaw

340298 in local modRC m

341299 R . modify $ \sc ->

@@ -356,8 +314,7 @@ newlineRaw = R . modify $ \sc ->

356314 VeryBeginning -> builderSoFar

357315 _ -> builderSoFar <> "\n",

358316 scColumn = 0,

359− scIndent = 0,

360− scThisLineSpans = [],

317+ scDirtyLine = False,

361318 scRequestedDelimiter = case scRequestedDelimiter sc of

362319 AfterNewline -> RequestedNewline

363320 RequestedNewline -> RequestedNewline

@@ -365,9 +322,14 @@ newlineRaw = R . modify $ \sc ->

365322 _ -> AfterNewline

366323 }

367324

325+-- | Check if the current line is “dirty”, that is, there is something on it

326+-- that can have comments attached to it.

327+isLineDirty :: R Bool

328+isLineDirty = R (gets scDirtyLine)

329+

368330-- | Return 'True' if we should print record dot syntax.

369331useRecordDot :: R Bool

370−useRecordDot = R (asks rcUseRecDot)

332+useRecordDot = R $ asks rcUseRecDot

371333

372334-- | Increase indentation level by one indentation step for the inner

373335-- computation. 'inci' should be used when a part of code must be more

@@ -384,7 +346,8 @@ inci (R m) = R (local modRC m)

384346

385347-- | Set indentation level for the inner computation equal to current

386348-- column. This makes sure that the entire inner block is uniformly

387−-- \"shifted\" to the right.

349+-- \"shifted\" to the right. Only works (and makes sense) when enclosing

350+-- layout is multi-line.

388351sitcc :: R () -> R ()

389352sitcc (R m) = do

390353 requestedDel <- R (gets scRequestedDelimiter)

@@ -392,9 +355,16 @@ sitcc (R m) = do

392355 c <- R (gets scColumn)

393356 let modRC rc =

394357 rc

395− { rcIndent = max i (c + bool 0 1 (requestedDel == RequestedSpace))

358+ { rcIndent = max i c + bool 0 1 (requestedDel == RequestedSpace)

396359 }

397− R (local modRC m)

360+ vlayout (R m) . R $ do

361+ modify $ \sc ->

362+ sc

363+ { scRequestedDelimiter = case requestedDel of

364+ RequestedSpace -> RequestedNothing

365+ other -> other

366+ }

367+ local modRC m

398368

399369-- | Set 'Layout' for internal computation.

400370enterLayout :: Layout -> R () -> R ()

@@ -435,10 +405,11 @@ registerPendingCommentLine ::

435405 -- | 'Text' to output

436406 Text ->

437407 R ()

438−registerPendingCommentLine position text = R $ do

408+registerPendingCommentLine position txt' = R $ do

409+ i <- asks rcIndent

439410 modify $ \sc ->

440411 sc

441− { scPendingComments = (position, text) : scPendingComments sc

412+ { scPendingComments = (position, i, txt') : scPendingComments sc

442413 }

443414

444415-- | Drop elements that begin before or at the same place as given

@@ -497,10 +468,6 @@ withEnclosingSpan spn (R m) = R (local modRC m)

497468 { rcEnclosingSpans = spn : rcEnclosingSpans rc

498469 }

499470

500−-- | Get spans on this line so far.

501−thisLineSpans :: R [RealSrcSpan]

502−thisLineSpans = R (gets scThisLineSpans)

503−

504471----------------------------------------------------------------------------

505472-- Stateful markers

506473

@@ -510,15 +477,15 @@ data SpanMark

510477 HaddockSpan HaddockStyle RealSrcSpan

511478 | -- | Non-haddock comment

512479 CommentSpan RealSrcSpan

513− | -- | A statement in a do-block and such span

514− StatementSpan RealSrcSpan

480+ | -- | Non-comment span

481+ OtherSpan RealSrcSpan

515482

516483-- | Project 'RealSrcSpan' from 'SpanMark'.

517484spanMarkSpan :: SpanMark -> RealSrcSpan

518485spanMarkSpan = \case

519486 HaddockSpan _ s -> s

520487 CommentSpan s -> s

521− StatementSpan s -> s

488+ OtherSpan s -> s

522489

523490-- | Haddock string style.

524491data HaddockStyle

@@ -567,7 +534,7 @@ dontUseBraces (R r) = R (local (\i -> i {rcCanUseBraces = False}) r)

567534

568535-- | Return 'True' if we can use braces in this context.

569536canUseBraces :: R Bool

570−canUseBraces = R (asks rcCanUseBraces)

537+canUseBraces = R $ asks rcCanUseBraces

571538

572539----------------------------------------------------------------------------

573540-- Constants

src/Ormolu/Printer/Meat/Common.hs+10−11

@@ -114,14 +114,14 @@ p_qualName mname occName = do

114114p_infixDefHelper ::

115115 -- | Whether to format in infix style

116116 Bool ->

117− -- | Whether to bump indentation for arguments

118− Bool ->

117+ -- | Indentation-bumping wrapper

118+ (R () -> R ()) ->

119119 -- | How to print the operator\/name

120120 R () ->

121121 -- | How to print the arguments

122122 [R ()] ->

123123 R ()

124−p_infixDefHelper isInfix indentArgs name args =

124+p_infixDefHelper isInfix inci' name args =

125125 case (isInfix, args) of

126126 (True, p0 : p1 : ps) -> do

127127 let parens' =

@@ -131,18 +131,18 @@ p_infixDefHelper isInfix indentArgs name args =

131131 parens' $ do

132132 p0

133133 breakpoint

134− inci . sitcc $ do

134+ inci $ sitcc $ do

135135 name

136136 space

137137 p1

138− unless (null ps) . inciIf indentArgs $ do

138+ unless (null ps) . inci' $ do

139139 breakpoint

140140 sitcc (sep breakpoint sitcc ps)

141141 (_, ps) -> do

142142 name

143143 unless (null ps) $ do

144144 breakpoint

145− inciIf indentArgs $ sitcc (sep breakpoint sitcc args)

145+ inci' $ sitcc (sep breakpoint sitcc args)

146146

147147-- | Print a Haddock.

148148p_hsDocString ::

@@ -154,11 +154,10 @@ p_hsDocString ::

154154 LHsDocString ->

155155 R ()

156156p_hsDocString hstyle needsNewline (L l str) = do

157− let isCommentSpan = \case

158− HaddockSpan _ _ -> True

159− CommentSpan _ -> True

160− _ -> False

161− goesAfterComment <- maybe False isCommentSpan <$> getSpanMark

157+ goesAfterComment <- getSpanMark >>= \case

158+ Just (HaddockSpan _ _) -> return True

159+ Just (CommentSpan _) -> return True

160+ _ -> return False

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

163162 when goesAfterComment newline

164163 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

1212where

1313

1414import Data.List (sort)

15−import Data.List.NonEmpty (NonEmpty (..), (<|))

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

1616import qualified Data.List.NonEmpty as NE

1717import GHC hiding (InlinePragma)

1818import OccName (occNameFS)

@@ -54,13 +54,12 @@ p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

5454p_hsDeclsRespectGrouping = p_hsDecls' Respect

5555

5656p_hsDecls' :: UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R ()

57−p_hsDecls' grouping style decls =

58− sepSemi id $

59− -- Return a list of rendered declarations, adding a newline to separate

60− -- groups.

61− case groupDecls decls of

62− [] -> []

63− (x : xs) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)

57+p_hsDecls' grouping style decls = sepSemi id $

58+ -- Return a list of rendered declarations, adding a newline to separate

59+ -- groups.

60+ case groupDecls decls of

61+ [] -> []

62+ (x : xs) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)

6463 where

6564 renderGroup = NE.toList . fmap (located' $ dontUseBraces . p_hsDecl style)

6665 renderGroupWithPrev prev curr =

@@ -85,6 +84,9 @@ isDocumented = any (isHaddock . unLoc)

8584 isHaddock _ = False

8685

8786-- | 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.

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

8991groupDecls [] = []

9092groupDecls (l@(L _ DocNext) : xs) =

@@ -97,8 +99,7 @@ groupDecls (header : xs) =

9799 let (grp, rest) = flip span (zip (header : xs) xs) $ \(previous, current) ->

98100 let relevantToHdr = groupedDecls header current

99101 relevantToPrev = groupedDecls previous current

100− isDeclSeries = declSeries previous current

101− in isDeclSeries || relevantToHdr || relevantToPrev

102+ in relevantToHdr || relevantToPrev

102103 in (header :| map snd grp) : groupDecls (map snd rest)

103104

104105p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()

@@ -195,18 +196,6 @@ groupedDecls (L l_x x') (L l_y y') =

195196 (_, DocPrev) -> True

196197 _ -> False

197198

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−

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

211200intersects a b = go (sort a) (sort b)

212201 where

@@ -299,10 +288,9 @@ patSigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc

299288patSigRdrNames _ = Nothing

300289

301290warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

302−warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $

303− flip concatMap ws $ \case

304− L _ (Warning NoExtField ns _) -> map unLoc ns

305− L _ (XWarnDecl x) -> noExtCon x

291+warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $ flip concatMap ws $ \case

292+ L _ (Warning NoExtField ns _) -> map unLoc ns

293+ L _ (XWarnDecl x) -> noExtCon x

306294warnSigRdrNames _ = Nothing

307295

308296patBindNames :: Pat GhcPs -> [RdrName]

src/Ormolu/Printer/Meat/Declaration.hs-boot+1

@@ -9,4 +9,5 @@ import Ormolu.Printer.Combinators

99import Ormolu.Printer.Meat.Common

1010

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

12+

1213p_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

5858 switchLayout signatureSpans $

5959 p_infixDefHelper

6060 (isInfix fixity)

61− True

61+ inci

6262 (p_rdrName name)

6363 (located' p_hsTyVarBndr <$> hsq_explicit)

6464 inci (p_classFundeps fdeps)

@@ -82,7 +82,7 @@ p_classFundeps fdeps = unless (null fdeps) $ do

8282 breakpoint

8383 txt "|"

8484 space

85− inci $ sep commaDel (sitcc . located' p_funDep) fdeps

85+ sitcc $ sep (comma >> breakpoint) (sitcc . located' p_funDep) fdeps

8686

8787p_funDep :: FunDep (Located RdrName) -> R ()

8888p_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

4141 inci $

4242 p_infixDefHelper

4343 (isInfix fixity)

44− True

44+ inci

4545 (p_rdrName name)

4646 (located' p_hsType <$> tpats)

4747 case dd_kindSig of

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

6060 txt "where"

6161 breakpoint

6262 sepSemi (located' (p_conDecl False)) dd_cons

63− else switchLayout (getLoc name : (getLoc <$> dd_cons)) . inci $ do

64− let singleConstRec = isSingleConstRec dd_cons

65− if singleConstRec

66− then space

67− else

68− if hasHaddocks dd_cons

69− then newline

70− else breakpoint

71− equals

72− space

73− layout <- getLayout

74− let s =

75− if layout == MultiLine || hasHaddocks dd_cons

76− then newline >> txt "|" >> space

77− else space >> txt "|" >> space

78− sitcc' =

79− if singleConstRec

80− then id

81− else sitcc

82− sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons

63+ else switchLayout (getLoc name : (getLoc <$> dd_cons))

64+ $ inci

65+ $ do

66+ let singleConstRec = isSingleConstRec dd_cons

67+ if singleConstRec

68+ then space

69+ else breakpoint

70+ txt "="

71+ space

72+ let s =

73+ vlayout

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

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

76+ sitcc' =

77+ if singleConstRec

78+ then id

79+ else sitcc

80+ sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons

8381 unless (null $ unLoc dd_derivs) breakpoint

8482 inci . located dd_derivs $ \xs ->

8583 sep newline (located' p_hsDerivingClause) xs

@@ -104,10 +102,11 @@ p_conDecl singleConstRec = \case

104102 (c : cs) -> do

105103 p_rdrName c

106104 unless (null cs) . inci $ do

107− commaDel

108− sep commaDel p_rdrName cs

105+ comma

106+ breakpoint

107+ sitcc $ sep (comma >> breakpoint) p_rdrName cs

108+ space

109109 inci $ do

110− space

111110 txt "::"

112111 let interArgBreak =

113112 if hasDocStrings (unLoc con_res_ty)

@@ -151,11 +150,15 @@ p_conDecl singleConstRec = \case

151150 PrefixCon xs -> do

152151 p_rdrName con_name

153152 unless (null xs) breakpoint

154− inci . sitcc $ sep breakpoint (sitcc . located' p_hsTypePostDoc) xs

153+ inci . sitcc $ sep breakpoint (sitcc . located' p_hsType) xs

155154 RecCon l -> do

156155 p_rdrName con_name

157156 breakpoint

158− inciIf (not singleConstRec) (located l p_conDeclFields)

157+ let inci' =

158+ if singleConstRec

159+ then id

160+ else inci

161+ inci' (located l p_conDeclFields)

159162 InfixCon x y -> do

160163 located x p_hsType

161164 breakpoint

@@ -204,9 +207,9 @@ p_hsDerivingClause HsDerivingClause {..} = do

204207 let derivingWhat = located deriv_clause_tys $ \case

205208 [] -> txt "()"

206209 xs ->

207− parens N $

210+ parens N . sitcc $

208211 sep

209− commaDel

212+ (comma >> breakpoint)

210213 (sitcc . located' p_hsType . hsib_body)

211214 xs

212215 space

@@ -253,9 +256,3 @@ isSingleConstRec [(L _ ConDeclH98 {..})] =

253256 RecCon _ -> True

254257 _ -> False

255258isSingleConstRec _ = 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

1515 DefaultDecl NoExtField ts -> do

1616 txt "default"

1717 breakpoint

18− inci . parens N $

19− sep commaDel (sitcc . located' p_hsType) ts

18+ inci . parens N . sitcc $

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

2020 XDefaultDecl x -> noExtCon x

src/Ormolu/Printer/Meat/Declaration/Instance.hs+9−5

@@ -32,7 +32,9 @@ p_standaloneDerivDecl DerivDecl {..} = do

3232 txt "instance"

3333 breakpoint

3434 match_overlap_mode deriv_overlap_mode breakpoint

35− inciIf toIndent typesAfterInstance

35+ if toIndent

36+ then inci typesAfterInstance

37+ else typesAfterInstance

3638 txt "deriving"

3739 space

3840 case deriv_strategy of

@@ -88,10 +90,12 @@ p_clsInstDecl = \case

8890 unless (null allDecls) $ do

8991 breakpoint

9092 txt "where"

91− unless (null allDecls) . inci $ do

92− -- Ensure whitespace is added after where clause.

93− breakpoint

94− dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

93+ unless (null allDecls)

94+ $ inci

95+ $ do

96+ -- Ensure whitespace is added after where clause.

97+ breakpoint

98+ dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

9599 XHsImplicitBndrs x -> noExtCon x

96100 XClsInstDecl x -> noExtCon x

97101

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

@@ -18,7 +18,7 @@ import Ormolu.Printer.Meat.Type

1818p_ruleDecls :: RuleDecls GhcPs -> R ()

1919p_ruleDecls = \case

2020 HsRules NoExtField _ xs ->

21− pragma "RULES" $

21+ pragma "RULES" . sitcc $

2222 sep breakpoint (sitcc . located' p_ruleDecl) xs

2323 XRuleDecls x -> noExtCon x

2424

@@ -43,7 +43,7 @@ p_ruleDecl = \case

4343 inci $ do

4444 located lhs p_hsExpr

4545 space

46− equals

46+ txt "="

4747 inci $ do

4848 breakpoint

4949 located rhs p_hsExpr

src/Ormolu/Printer/Meat/Declaration/Signature.hs+27−29

@@ -14,6 +14,7 @@ where

1414import BasicTypes

1515import BooleanFormula

1616import Control.Monad

17+import Data.Bool (bool)

1718import GHC

1819import Ormolu.Printer.Combinators

1920import Ormolu.Printer.Meat.Common

@@ -47,22 +48,24 @@ p_typeSig indentTail (n : ns) hswc = do

4748 p_rdrName n

4849 if null ns

4950 then p_typeAscription hswc

50− else inciIf indentTail $ do

51− commaDel

52− sep commaDel p_rdrName ns

51+ else bool id inci indentTail $ do

52+ comma

53+ breakpoint

54+ sep (comma >> breakpoint) p_rdrName ns

5355 p_typeAscription hswc

5456

5557p_typeAscription ::

5658 LHsSigWcType GhcPs ->

5759 R ()

58−p_typeAscription HsWC {..} = inci $ do

60+p_typeAscription HsWC {..} = do

5961 space

60− txt "::"

61− let t = hsib_body hswc_body

62− if hasDocStrings (unLoc t)

63− then newline

64− else breakpoint

65− located t p_hsType

62+ inci $ do

63+ txt "::"

64+ let t = hsib_body hswc_body

65+ if hasDocStrings (unLoc t)

66+ then newline

67+ else breakpoint

68+ located t p_hsType

6669p_typeAscription (XHsWildCardBndrs x) = noExtCon x

6770

6871p_patSynSig ::

@@ -71,11 +74,7 @@ p_patSynSig ::

7174 R ()

7275p_patSynSig names hsib = do

7376 txt "pattern"

74− let body =

75− p_typeSig

76− False

77− names

78− HsWC {hswc_ext = NoExtField, hswc_body = hsib}

77+ let body = p_typeSig False names HsWC {hswc_ext = NoExtField, hswc_body = hsib}

7978 if length names > 1

8079 then breakpoint >> inci body

8180 else space >> body

@@ -104,7 +103,7 @@ p_fixSig = \case

104103 space

105104 atom n

106105 space

107− sitcc $ sep commaDel p_rdrName names

106+ sitcc $ sep (comma >> breakpoint) p_rdrName names

108107 XFixitySig x -> noExtCon x

109108

110109p_inlineSig ::

@@ -143,7 +142,7 @@ p_specSig name ts InlinePragma {..} = pragmaBraces $ do

143142 space

144143 txt "::"

145144 breakpoint

146− inci $ sep commaDel (located' p_hsType . hsib_body) ts

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

147146

148147p_inlineSpec :: InlineSpec -> R ()

149148p_inlineSpec = \case

@@ -187,13 +186,13 @@ p_booleanFormula = \case

187186 And xs ->

188187 sitcc $

189188 sep

190− commaDel

189+ (comma >> breakpoint)

191190 (located' p_booleanFormula)

192191 xs

193192 Or xs ->

194193 sitcc $

195194 sep

196− (breakpoint >> txt "|" >> space)

195+ (breakpoint >> txt "| ")

197196 (located' p_booleanFormula)

198197 xs

199198 Parens l -> located l (parens N . p_booleanFormula)

@@ -207,7 +206,7 @@ p_completeSig ::

207206p_completeSig cs' mty =

208207 located cs' $ \cs ->

209208 pragma "COMPLETE" . inci $ do

210− sep commaDel p_rdrName cs

209+ sitcc $ sep (comma >> breakpoint) p_rdrName cs

211210 forM_ mty $ \ty -> do

212211 space

213212 txt "::"

@@ -224,13 +223,12 @@ p_sccSig loc literal = pragma "SCC" . inci $ do

224223p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()

225224p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do

226225 txt "type"

227− inci $ do

228− space

229− p_rdrName name

230− space

231− txt "::"

232− breakpoint

233− case bndrs of

234− HsIB NoExtField sig -> located sig p_hsType

235− XHsImplicitBndrs x -> noExtCon x

226+ space

227+ p_rdrName name

228+ space

229+ txt "::"

230+ breakpoint

231+ inci $ case bndrs of

232+ HsIB NoExtField sig -> located sig p_hsType

233+ XHsImplicitBndrs x -> noExtCon x

236234p_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

2828 switchLayout (getLoc name : map getLoc hsq_explicit) $

2929 p_infixDefHelper

3030 (case fixity of Infix -> True; _ -> False)

31− True

31+ inci

3232 (p_rdrName name)

3333 (map (located' p_hsTyVarBndr) hsq_explicit)

3434 space

35− equals

36− if hasDocStrings (unLoc t)

37− then newline

38− else breakpoint

35+ txt "="

36+ breakpoint

3937 inci (located t p_hsType)

4038p_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

3131 switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $

3232 p_infixDefHelper

3333 (isInfix fdFixity)

34− True

34+ inci

3535 (p_rdrName fdLName)

3636 (located' p_hsTyVarBndr <$> hsq_explicit)

3737 let resultSig = p_familyResultSigL fdResultSig

@@ -69,7 +69,7 @@ p_familyResultSigL l =

6969 breakpoint

7070 located k p_hsType

7171 TyVarSig NoExtField bndr -> Just $ do

72− equals

72+ txt "="

7373 breakpoint

7474 located bndr p_hsTyVarBndr

7575 XFamilyResultSig x ->

@@ -92,16 +92,16 @@ p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do

9292 Just bndrs -> do

9393 p_forallBndrs ForallInvis p_hsTyVarBndr bndrs

9494 breakpoint

95− inciIf (not $ null feqn_bndrs) $ do

95+ (if null feqn_bndrs then id else inci) $ do

9696 let famLhsSpn = getLoc feqn_tycon : fmap (getLoc . typeArgToType) feqn_pats

9797 switchLayout famLhsSpn $

9898 p_infixDefHelper

9999 (isInfix feqn_fixity)

100− True

100+ inci

101101 (p_rdrName feqn_tycon)

102102 (located' p_hsType . typeArgToType <$> feqn_pats)

103103 space

104− equals

104+ txt "="

105105 breakpoint

106106 inci (located feqn_rhs p_hsType)

107107p_tyFamInstEqn HsIB {hsib_body = XFamEqn x} = noExtCon x

src/Ormolu/Printer/Meat/Declaration/Value.hs+169−181

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

11{-# LANGUAGE LambdaCase #-}

2−{-# LANGUAGE MultiWayIf #-}

32{-# LANGUAGE OverloadedStrings #-}

43{-# LANGUAGE RecordWildCards #-}

54{-# LANGUAGE TypeApplications #-}

@@ -22,12 +21,12 @@ import Data.Char (isPunctuation, isSymbol)

2221import Data.Data hiding (Infix, Prefix)

2322import Data.Functor ((<&>))

2423import Data.List (intersperse, sortOn)

25−import Data.List.NonEmpty (NonEmpty (..), (<|))

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

2625import qualified Data.List.NonEmpty as NE

2726import Data.Text (Text)

2827import qualified Data.Text as Text

2928import GHC

30−import OccName (occNameString)

29+import OccName (mkVarOcc)

3130import Ormolu.Printer.Combinators

3231import Ormolu.Printer.Internal

3332import Ormolu.Printer.Meat.Common

@@ -61,7 +60,7 @@ data Placement

6160 -- should use it and avoid bumping one level

6261 -- of indentation

6362 Hanging

64− deriving (Eq, Show)

63+ deriving (Eq)

6564

6665p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

6766p_valDecl = \case

@@ -180,24 +179,25 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

180179 NoSrcStrict -> return ()

181180 SrcStrict -> txt "!"

182181 SrcLazy -> txt "~"

183− indentBody <- case NE.nonEmpty m_pats of

184− Nothing ->

185− False <$ case style of

186− Function name -> p_rdrName name

187− _ -> return ()

182+ inci' <- case NE.nonEmpty m_pats of

183+ Nothing -> id <$ case style of

184+ Function name -> p_rdrName name

185+ _ -> return ()

188186 Just ne_pats -> do

189− let combinedSpans = case style of

190− Function name -> combineSrcSpans (getLoc name) patSpans

191− _ -> patSpans

192− patSpans = combineSrcSpans' (getLoc <$> ne_pats)

193− indentBody = not (isOneLineSpan combinedSpans)

187+ let combinedSpans =

188+ combineSrcSpans' $

189+ getLoc <$> ne_pats

190+ inci' =

191+ if isOneLineSpan combinedSpans

192+ then id

193+ else inci

194194 switchLayout [combinedSpans] $ do

195195 let stdCase = sep breakpoint (located' p_pat) m_pats

196196 case style of

197197 Function name ->

198198 p_infixDefHelper

199199 isInfix

200− indentBody

200+ inci'

201201 (p_rdrName name)

202202 (located' p_pat <$> m_pats)

203203 PatternBind -> stdCase

@@ -212,32 +212,40 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

212212 when needsSpace space

213213 sitcc stdCase

214214 LambdaCase -> stdCase

215− return indentBody

215+ return inci'

216216 let -- Calculate position of end of patterns. This is useful when we decide

217217 -- about putting certain constructions in hanging positions.

218218 endOfPats = case NE.nonEmpty m_pats of

219219 Nothing -> case style of

220− Function name -> Just (getLoc name)

220+ Function name -> (Just . srcSpanEnd . getLoc) name

221221 _ -> Nothing

222− Just pats -> (Just . getLoc . NE.last) pats

222+ Just pats -> (Just . srcSpanEnd . getLoc . NE.last) pats

223223 isCase = \case

224224 Case -> True

225225 LambdaCase -> True

226226 _ -> False

227− hasGuards = withGuards grhssGRHSs

228− grhssSpan =

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 "->"

235+ let grhssSpan =

229236 combineSrcSpans' $

230237 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

231238 patGrhssSpan =

232239 maybe

233240 grhssSpan

234− (combineSrcSpans grhssSpan . srcLocSpan . srcSpanEnd)

241+ (combineSrcSpans grhssSpan . srcLocSpan)

235242 endOfPats

236243 placement =

237244 case endOfPats of

238245 Nothing -> blockPlacement placer grhssGRHSs

239246 Just spn ->

240− if onTheSameLine spn grhssSpan

247+ if isOneLineSpan

248+ (mkSrcSpan spn (srcSpanStart grhssSpan))

241249 then blockPlacement placer grhssGRHSs

242250 else Normal

243251 p_body = do

@@ -253,14 +261,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

253261 txt "where"

254262 unless whereIsEmpty breakpoint

255263 inci $ located grhssLocalBinds p_hsLocalBinds

256− inciIf indentBody $ 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+ inci' $ do

264265 switchLayout [patGrhssSpan] $

265266 placeHanging placement p_body

266267 inci p_where

@@ -284,24 +285,24 @@ p_grhs' placer render style (GRHS NoExtField guards body) =

284285 xs -> do

285286 txt "|"

286287 space

287− sitcc (sep commaDel (sitcc . located' p_stmt) xs)

288+ sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)

288289 space

289− inci $ case style of

290− EqualSign -> equals

291− RightArrow -> txt "->"

290+ txt $ case style of

291+ EqualSign -> "="

292+ RightArrow -> "->"

292293 placeHanging placement p_body

293294 where

294295 placement =

295296 case endOfGuards of

296297 Nothing -> placer (unLoc body)

297298 Just spn ->

298− if onTheSameLine spn (getLoc body)

299+ if isOneLineSpan (mkSrcSpan spn (srcSpanStart (getLoc body)))

299300 then placer (unLoc body)

300301 else Normal

301302 endOfGuards =

302303 case NE.nonEmpty guards of

303304 Nothing -> Nothing

304− Just gs -> (Just . getLoc . NE.last) gs

305+ Just gs -> (Just . srcSpanEnd . getLoc . NE.last) gs

305306 p_body = located body render

306307p_grhs' _ _ _ (XGRHS x) = noExtCon x

307308

@@ -316,7 +317,7 @@ p_hsCmd = \case

316317 HsHigherOrderApp -> txt "-<<"

317318 placeHanging (exprPlacement (unLoc input)) $

318319 located input p_hsExpr

319− HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ do

320+ HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do

320321 located form p_hsExpr

321322 unless (null cmds) $ do

322323 breakpoint

@@ -353,14 +354,7 @@ p_hsCmdTop = \case

353354 HsCmdTop NoExtField cmd -> located cmd p_hsCmd

354355 XCmdTop x -> noExtCon x

355356

356−-- | Render an expression preserving blank lines between such consecutive

357−-- expressions found in the original source code.

358−withSpacing ::

359− -- | Rendering function

360− (a -> R ()) ->

361− -- | Entity to render

362− Located a ->

363− R ()

357+withSpacing :: Data a => (a -> R ()) -> Located a -> R ()

364358withSpacing f l = located l $ \x -> do

365359 case getLoc l of

366360 UnhelpfulSpan _ -> f x

@@ -369,7 +363,7 @@ withSpacing f l = located l $ \x -> do

369363 -- Spacing before comments will be handled by the code

370364 -- that prints comments, so we just have to deal with

371365 -- blank lines between statements here.

372− Just (StatementSpan lastSpn) ->

366+ Just (OtherSpan lastSpn) ->

373367 if srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1

374368 then newline

375369 else return ()

@@ -380,7 +374,7 @@ withSpacing f l = located l $ \x -> do

380374 getSpanMark >>= \case

381375 Just (HaddockSpan _ _) -> return ()

382376 Just (CommentSpan _) -> return ()

383− _ -> setSpanMark (StatementSpan currentSpn)

377+ _ -> setSpanMark (OtherSpan currentSpn)

384378

385379p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()

386380p_stmt = p_stmt' exprPlacement p_hsExpr

@@ -471,31 +465,37 @@ gatherStmtBlock (XParStmtBlock x) = noExtCon x

471465p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()

472466p_hsLocalBinds = \case

473467 HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do

468+ let ssStart =

469+ either

470+ (srcSpanStart . getLoc)

471+ (srcSpanStart . getLoc)

472+ items =

473+ (Left <$> bagToList bag) ++ (Right <$> lsigs)

474+ p_item (Left x) = located x p_valDecl

475+ p_item (Right x) = located x p_sigDecl

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

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

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

477479 br <- layoutToBraces <$> getLayout

478− let items =

479− let injectLeft (L l x) = L l (Left x)

480− injectRight (L l x) = L l (Right x)

481− in (injectLeft <$> bagToList bag) ++ (injectRight <$> lsigs)

482− positionToBracing = \case

483− SinglePos -> id

484− FirstPos -> br

485− MiddlePos -> br

486− LastPos -> id

487− p_item' (p, item) =

488− positionToBracing p $

489− withSpacing (either p_valDecl p_sigDecl) item

490− binds = sortOn (srcSpanStart . getLoc) items

491− sitcc $ sepSemi p_item' (attachRelativePos binds)

480+ sitcc $

481+ sepSemi

482+ ( \(p, i) ->

483+ ( case p of

484+ SinglePos -> id

485+ FirstPos -> br

486+ MiddlePos -> br

487+ LastPos -> id

488+ )

489+ (p_item i)

490+ )

491+ (attachRelativePos $ sortOn ssStart items)

492492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

493493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

494494 -- Second argument of IPBind is always Left before type-checking.

495495 let p_ipBind (IPBind NoExtField (Left name) expr) = do

496496 atom name

497497 space

498− equals

498+ txt "="

499499 breakpoint

500500 useBraces $ inci $ located expr p_hsExpr

501501 p_ipBind (IPBind NoExtField (Right _) _) =

@@ -514,12 +514,15 @@ p_hsRecField HsRecField {..} = do

514514 p_rdrName hsRecFieldLbl

515515 unless hsRecPun $ do

516516 space

517− equals

518− let placement =

519− if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)

520− then exprPlacement (unLoc hsRecFieldArg)

521− else Normal

522− placeHanging placement (located hsRecFieldArg p_hsExpr)

517+ txt "="

518+ let placement = exprPlacement (unLoc hsRecFieldArg)

519+ placeHanging placement $ located hsRecFieldArg p_hsExpr

520+

521+p_hsTupArg :: HsTupArg GhcPs -> R ()

522+p_hsTupArg = \case

523+ Present NoExtField x -> located x p_hsExpr

524+ Missing NoExtField -> pure ()

525+ XTupArg x -> noExtCon x

523526

524527p_hsExpr :: HsExpr GhcPs -> R ()

525528p_hsExpr = p_hsExpr' N

@@ -584,21 +587,23 @@ p_hsExpr' s = \case

584587 -- do-block or case expression it is not a good idea. It seems

585588 -- to be safe to always bump indentation when the function

586589 -- expression is parenthesised.

587− doIndent =

590+ indent =

588591 case func of

589− L _ (HsPar NoExtField _) -> True

590− L _ (HsAppType NoExtField _ _) -> True

591− L _ (HsMultiIf NoExtField _) -> True

592− L spn _ -> isOneLineSpan spn

593− ub <-

594− getLayout <&> \case

595− SingleLine -> useBraces

596− MultiLine -> id

592+ L _ (HsPar NoExtField _) -> inci

593+ L _ (HsAppType NoExtField _ _) -> inci

594+ L _ (HsMultiIf NoExtField _) -> inci

595+ L spn _ ->

596+ if isOneLineSpan spn

597+ then inci

598+ else id

599+ ub <- getLayout <&> \case

600+ SingleLine -> useBraces

601+ MultiLine -> id

597602 ub $ do

598603 located func (p_hsExpr' s)

599604 breakpoint

600− inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp

601− inciIf doIndent $ do

605+ indent $ sep breakpoint (located' p_hsExpr) initp

606+ indent $ do

602607 unless (null initp) breakpoint

603608 located lastp p_hsExpr

604609 Hanging -> do

@@ -613,15 +618,10 @@ p_hsExpr' s = \case

613618 breakpoint

614619 inci $ do

615620 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 ()

621621 located (hswc_body a) p_hsType

622622 OpApp NoExtField x op y -> do

623623 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)

624− p_exprOpTree s (reassociateOpTree getOpName opTree)

624+ p_exprOpTree True s (reassociateOpTree getOpName opTree)

625625 NegApp NoExtField e _ -> do

626626 txt "-"

627627 space

@@ -638,27 +638,22 @@ p_hsExpr' s = \case

638638 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)

639639 unless (useRecordDot' && isRecordDot') breakpoint

640640 inci (located x p_hsExpr)

641− ExplicitTuple NoExtField args boxity ->

641+ ExplicitTuple NoExtField args boxity -> do

642642 let isSection = any (isMissing . unLoc) args

643643 isMissing = \case

644644 Missing NoExtField -> True

645645 _ -> 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' =

646+ let parens' =

652647 case boxity of

653648 Boxed -> parens

654649 Unboxed -> parensHash

655− in if isSection

656− then

657− switchLayout [] . parens' s $

658− sep comma p_larg args

659− else

660− switchLayout (getLoc <$> args) . parens' s $

661− sep commaDel p_larg args

650+ if isSection

651+ then

652+ switchLayout [] . parens' s $

653+ sep comma (located' p_hsTupArg) args

654+ else

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

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

662657 ExplicitSum NoExtField tag arity e ->

663658 p_unboxedSum N tag arity (located e p_hsExpr)

664659 HsCase NoExtField e mgroup ->

@@ -666,9 +661,8 @@ p_hsExpr' s = \case

666661 HsIf NoExtField _ if' then' else' ->

667662 p_if exprPlacement p_hsExpr if' then' else'

668663 HsMultiIf NoExtField guards -> do

669− txt "if"

670− breakpoint

671− inci . inci $ sep newline (located' (p_grhs RightArrow)) guards

664+ txt "if "

665+ inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards

672666 HsLet NoExtField localBinds e ->

673667 p_let p_hsExpr localBinds e

674668 HsDo NoExtField ctx es -> do

@@ -680,15 +674,15 @@ p_hsExpr' s = \case

680674 sepSemi

681675 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))

682676 (unLoc es)

683− compBody = brackets N . located es $ \xs -> do

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

684678 let p_parBody =

685679 sep

686− (breakpoint >> txt "|" >> space)

680+ (breakpoint >> txt "| ")

687681 p_seqBody

688682 p_seqBody =

689683 sitcc

690684 . sep

691− commaDel

685+ (comma >> breakpoint)

692686 (located' (sitcc . p_stmt))

693687 stmts = init xs

694688 yield = last xs

@@ -709,8 +703,8 @@ p_hsExpr' s = \case

709703 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"

710704 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

711705 ExplicitList _ _ xs ->

712− brackets s $

713− sep commaDel (sitcc . located' p_hsExpr) xs

706+ brackets s . sitcc $

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

714708 RecordCon {..} -> do

715709 located rcon_con_name atom

716710 breakpoint

@@ -726,8 +720,8 @@ p_hsExpr' s = \case

726720 case rec_dotdot of

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

728722 Nothing -> []

729− inci . braces N $

730− sep commaDel sitcc (fields <> dotdot)

723+ inci . braces N . sitcc $

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

731725 RecordUpd {..} -> do

732726 located rupd_expr p_hsExpr

733727 useRecordDot' <- useRecordDot

@@ -745,9 +739,9 @@ p_hsExpr' s = \case

745739 Unambiguous _ n -> n

746740 XAmbiguousFieldOcc x -> noExtCon x

747741 }

748− inci . braces N $

742+ inci . braces N . sitcc $

749743 sep

750− commaDel

744+ (comma >> breakpoint)

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

752746 rupd_flds

753747 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do

@@ -760,22 +754,22 @@ p_hsExpr' s = \case

760754 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x

761755 ArithSeq NoExtField _ x ->

762756 case x of

763− From from -> brackets s $ do

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

764758 located from p_hsExpr

765759 breakpoint

766760 txt ".."

767− FromThen from next -> brackets s $ do

768− sep commaDel (located' p_hsExpr) [from, next]

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

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

769763 breakpoint

770764 txt ".."

771− FromTo from to -> brackets s $ do

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

772766 located from p_hsExpr

773767 breakpoint

774768 txt ".."

775769 space

776770 located to p_hsExpr

777− FromThenTo from next to -> brackets s $ do

778− sep commaDel (located' p_hsExpr) [from, next]

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

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

779773 breakpoint

780774 txt ".."

781775 space

@@ -825,7 +819,7 @@ p_patSynBind PSB {..} = do

825819 breakpoint

826820 located psb_def p_pat

827821 ImplicitBidirectional -> do

828− equals

822+ txt "="

829823 breakpoint

830824 located psb_def p_pat

831825 ExplicitBidirectional mgroup -> do

@@ -852,8 +846,8 @@ p_patSynBind PSB {..} = do

852846 inci $ do

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

854848 unless (null xs) breakpoint

855− braces N $

856− sep commaDel (p_rdrName . recordPatSynPatVar) xs

849+ braces N . sitcc $

850+ sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs

857851 rhs

858852 InfixCon l r -> do

859853 switchLayout [getLoc l, getLoc r] $ do

@@ -907,12 +901,10 @@ p_if placer render if' then' else' = do

907901 breakpoint

908902 inci $ do

909903 txt "then"

910− space

911904 located then' $ \x ->

912905 placeHanging (placer x) (render x)

913906 breakpoint

914907 txt "else"

915− space

916908 located else' $ \x ->

917909 placeHanging (placer x) (render x)

918910

@@ -949,13 +941,13 @@ p_pat = \case

949941 txt "!"

950942 located pat p_pat

951943 ListPat NoExtField pats ->

952− brackets S $ sep commaDel (located' p_pat) pats

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

953945 TuplePat NoExtField pats boxing -> do

954− let parens' =

946+ let f =

955947 case boxing of

956948 Boxed -> parens S

957949 Unboxed -> parensHash S

958− parens' $ sep commaDel (sitcc . located' p_pat) pats

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

959951 SumPat NoExtField pat tag arity ->

960952 p_unboxedSum S tag arity (located pat p_pat)

961953 ConPatIn pat details ->

@@ -971,7 +963,7 @@ p_pat = \case

971963 let f = \case

972964 Nothing -> txt ".."

973965 Just x -> located x p_pat_hsRecField

974− inci . braces N . sep commaDel f $

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

975967 case dotdot of

976968 Nothing -> Just <$> fields

977969 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]

@@ -1012,7 +1004,7 @@ p_pat_hsRecField HsRecField {..} = do

10121004 p_rdrName (rdrNameFieldOcc x)

10131005 unless hsRecPun $ do

10141006 space

1015− equals

1007+ txt "="

10161008 breakpoint

10171009 inci (located hsRecFieldArg p_pat)

10181010

@@ -1021,15 +1013,17 @@ p_unboxedSum s tag arity m = do

10211013 let before = tag - 1

10221014 after = arity - before - 1

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

1024− f x =

1016+ f (x, i) = do

1017+ let isFirst = i == 0

1018+ isLast = i == arity - 1

10251019 case x :: Maybe (R ()) of

10261020 Nothing ->

1027− space

1021+ unless (isFirst || isLast) space

10281022 Just m' -> do

1029− space

1023+ unless isFirst space

10301024 m'

1031− space

1032− parensHash s $ sep (txt "|") f args

1025+ unless isLast space

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

10331027

10341028p_hsSplice :: HsSplice GhcPs -> R ()

10351029p_hsSplice = \case

@@ -1231,10 +1225,11 @@ exprPlacement = \case

12311225 HsCase NoExtField _ _ -> Hanging

12321226 HsDo NoExtField DoExpr _ -> Hanging

12331227 HsDo NoExtField MDoExpr _ -> Hanging

1234− OpApp NoExtField _ op y ->

1235− case (fmap getOpNameStr . getOpName . unLoc) op of

1236− Just "$" -> exprPlacement (unLoc y)

1237− _ -> Normal

1228+ -- If the rightmost expression in an operator chain is hanging, make the

1229+ -- whole block hanging; so that we can use the common @f = foo $ do@

1230+ -- style.

1231+ OpApp NoExtField _ _ y -> exprPlacement (unLoc y)

1232+ -- Same thing for function applications (usually with -XBlockArguments)

12381233 HsApp NoExtField _ y -> exprPlacement (unLoc y)

12391234 HsProc NoExtField p _ ->

12401235 -- Indentation breaks if pattern is longer than one line and left

@@ -1260,16 +1255,15 @@ getOpName = \case

12601255 HsVar NoExtField (L _ a) -> Just a

12611256 _ -> Nothing

12621257

1263−getOpNameStr :: RdrName -> String

1264−getOpNameStr = occNameString . rdrNameOcc

1265−

12661258p_exprOpTree ::

1259+ -- | Can use special handling of dollar?

1260+ Bool ->

12671261 -- | Bracket style to use

12681262 BracketStyle ->

12691263 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->

12701264 R ()

1271−p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)

1272−p_exprOpTree s (OpBranch x op y) = do

1265+p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)

1266+p_exprOpTree isDollarSpecial s (OpBranch x op y) = do

12731267 -- If the beginning of the first argument and the second argument are on

12741268 -- the same line, and the second argument has a hanging form, use hanging

12751269 -- placement.

@@ -1291,54 +1285,44 @@ p_exprOpTree s (OpBranch x op y) = do

12911285 MultiLine -> case placement of

12921286 Hanging -> useBraces

12931287 Normal -> dontUseBraces

1294− opNameStr = (fmap getOpNameStr . getOpName . unLoc) op

1295− gotDollar = opNameStr == Just "$"

1296− gotColon = opNameStr == Just ":"

1297− gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)

1288+ gotDollar = case getOpName (unLoc op) of

1289+ Just rname -> mkVarOcc "$" == rdrNameOcc rname

1290+ _ -> False

12981291 lhs =

12991292 switchLayout [opTreeLoc x] $

1300− p_exprOpTree s x

1301− p_op = located op (opWrapper . p_hsExpr)

1302− p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y)

1293+ p_exprOpTree (not gotDollar) s x

1294+ let p_op = located op (opWrapper . p_hsExpr)

1295+ p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)

13031296 isSection = case (opTreeLoc x, getLoc op) of

13041297 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

13051298 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

13061299 _ -> False

1307− isDoBlock = \case

1308− OpNode (L _ HsDo {}) -> True

1309− _ -> False

13101300 useRecordDot' <- useRecordDot

1311− if

1312− | gotColon -> do

1313− lhs

1314− space

1315− p_op

1316− case placement of

1317− Hanging -> do

1301+ let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)

1302+ if useRecordDot' && isRecordDot'

1303+ then do

1304+ lhs

1305+ when isSection space

1306+ p_op

1307+ p_y

1308+ else

1309+ if isDollarSpecial

1310+ && gotDollar

1311+ && placement

1312+ == Normal

1313+ && isOneLineSpan (opTreeLoc x)

1314+ then do

1315+ useBraces lhs

1316+ space

1317+ p_op

1318+ breakpoint

1319+ inci p_y

1320+ else do

1321+ ub lhs

1322+ placeHanging placement $ do

1323+ p_op

13181324 space

13191325 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

13421326

13431327-- | Return 'True' if given expression is a record-dot operator expression.

13441328isRecordDot ::

@@ -1349,10 +1333,14 @@ isRecordDot ::

13491333 Bool

13501334isRecordDot op (RealSrcSpan ySpan) = case op of

13511335 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->

1352− (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)

1336+ isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)

13531337 _ -> False

13541338isRecordDot _ _ = False

13551339

1340+-- | Check whether a given 'RdrName' is the dot operator.

1341+isDot :: RdrName -> Bool

1342+isDot name = rdrNameOcc name == mkVarOcc "."

1343+

13561344-- | Get annotations for the enclosing element.

13571345getEnclosingAnns :: R [AnnKeywordId]

13581346getEnclosingAnns = do

src/Ormolu/Printer/Meat/Declaration/Value.hs-boot+4

@@ -11,7 +11,11 @@ import GHC

1111import Ormolu.Printer.Combinators

1212

1313p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

14+

1415p_pat :: Pat GhcPs -> R ()

16+

1517p_hsExpr :: HsExpr GhcPs -> R ()

18+

1619p_hsSplice :: HsSplice GhcPs -> R ()

20+

1721p_stringLit :: String -> R ()

src/Ormolu/Printer/Meat/Declaration/Warning.hs+5−4

@@ -32,9 +32,10 @@ p_moduleWarning wtxt = do

3232p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()

3333p_topLevelWarning fnames wtxt = do

3434 let (pragmaText, lits) = warningText wtxt

35− switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $

36− pragma pragmaText . inci $ do

37− sep commaDel p_rdrName fnames

35+ switchLayout (fmap getLoc fnames ++ fmap getLoc lits)

36+ $ pragma pragmaText . inci

37+ $ do

38+ sitcc $ sep (comma >> breakpoint) p_rdrName fnames

3839 breakpoint

3940 p_lits lits

4041

@@ -46,4 +47,4 @@ warningText = \case

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

4748p_lits = \case

4849 [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

2121 breakpoint'

2222 txt ")"

2323p_hsmodExports xs =

24− parens N $ do

24+ parens N . sitcc $ do

2525 layout <- getLayout

2626 sep

2727 breakpoint

@@ -65,7 +65,7 @@ p_hsmodImport useQualifiedPost ImportDecl {..} = do

6565 Nothing -> return ()

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

6767 breakpoint

68− parens N $ do

68+ parens N . sitcc $ do

6969 layout <- getLayout

7070 sep

7171 breakpoint

@@ -93,8 +93,9 @@ p_lie encLayout relativePos = \case

9393 inci $ do

9494 let names :: [R ()]

9595 names = located' p_ieWrappedName <$> xs

96− parens N . sep commaDel sitcc $

97− case w of

96+ parens N . sitcc

97+ $ sep (comma >> breakpoint) sitcc

98+ $ case w of

9899 NoIEWildcard -> names

99100 IEWildcard n ->

100101 let (before, after) = splitAt n names

src/Ormolu/Printer/Meat/Module.hs+4−4

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

1111import Control.Monad

1212import qualified Data.Text as T

1313import GHC

14−import Ormolu.Imports (normalizeImports)

14+import Ormolu.Imports

1515import Ormolu.Parser.CommentStream

1616import Ormolu.Parser.Pragma

1717import Ormolu.Parser.Shebang

@@ -34,9 +34,9 @@ p_hsModule ::

3434 -- | Whether to use postfix qualified imports

3535 Bool ->

3636 -- | AST to print

37− HsModule GhcPs ->

37+ ParsedSource ->

3838 R ()

39−p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do

39+p_hsModule mstackHeader shebangs pragmas qualifiedPost (L _ HsModule {..}) = do

4040 let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage

4141 exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports

4242 switchLayout (deprecSpan <> exportSpans) $ do

@@ -69,7 +69,7 @@ p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do

6969 txt "where"

7070 newline

7171 newline

72− forM_ (normalizeImports hsmodImports) (located' (p_hsmodImport qualifiedPost))

72+ forM_ (sortImports hsmodImports) (located' (p_hsmodImport qualifiedPost))

7373 newline

7474 switchLayout (getLoc <$> hsmodDecls) $ do

7575 p_hsDecls Free hsmodDecls

src/Ormolu/Printer/Meat/Type.hs+24−35

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

55-- | Rendering of types.

66module Ormolu.Printer.Meat.Type

77 ( p_hsType,

8− p_hsTypePostDoc,

98 hasDocStrings,

109 p_hsContext,

1110 p_hsTyVarBndr,

@@ -24,22 +23,14 @@ import Ormolu.Printer.Operators

2423import Ormolu.Utils

2524

2625p_hsType :: HsType GhcPs -> R ()

27−p_hsType t = p_hsType' (hasDocStrings t) PipeStyle t

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

2827

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 ()

38−p_hsType' multilineArgs docStyle = \case

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

29+p_hsType' multilineArgs = \case

3930 HsForAllTy NoExtField visibility bndrs t -> do

4031 p_forallBndrs visibility p_hsTyVarBndr bndrs

4132 interArgBreak

42− p_hsTypeR (unLoc t)

33+ p_hsType' multilineArgs (unLoc t)

4334 HsQualTy NoExtField qs t -> do

4435 located qs p_hsContext

4536 space

@@ -67,7 +58,7 @@ p_hsType' multilineArgs docStyle = \case

6758 L _ (HsAppTy _ l r) -> gatherArgs l (r : knownArgs)

6859 _ -> (f', knownArgs)

6960 (func, args) = gatherArgs f [x]

70− switchLayout (getLoc f : fmap getLoc args) . sitcc $ do

61+ switchLayout (getLoc f : fmap getLoc args) $ sitcc $ do

7162 located func p_hsType

7263 breakpoint

7364 inci $

@@ -98,9 +89,10 @@ p_hsType' multilineArgs docStyle = \case

9889 HsBoxedTuple -> parens N

9990 HsConstraintTuple -> parens N

10091 HsBoxedOrConstraintTuple -> parens N

101− in parens' $ sep commaDel (sitcc . located' p_hsType) xs

92+ in parens' . sitcc $

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

10294 HsSumTy NoExtField xs ->

103− parensHash N $

95+ parensHash N . sitcc $

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

10597 HsOpTy NoExtField x op y ->

10698 sitcc $

@@ -117,20 +109,14 @@ p_hsType' multilineArgs docStyle = \case

117109 HsStarTy NoExtField _ -> txt "*"

118110 HsKindSig NoExtField t k -> sitcc $ do

119111 located t p_hsType

120− space

112+ space -- FIXME

121113 txt "::"

122− breakpoint

114+ space

123115 inci (located k p_hsType)

124116 HsSpliceTy NoExtField splice -> p_hsSplice splice

125− HsDocTy NoExtField t str ->

126− case docStyle of

127− PipeStyle -> do

128− p_hsDocString Pipe True str

129− located t p_hsType

130− CaretStyle -> do

131− located t p_hsType

132− newline

133− p_hsDocString Caret False str

117+ HsDocTy NoExtField t str -> do

118+ p_hsDocString Pipe True str

119+ located t p_hsType

134120 HsBangTy NoExtField (HsSrcBang _ u s) t -> do

135121 case u of

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

@@ -153,14 +139,14 @@ p_hsType' multilineArgs docStyle = \case

153139 case (p, xs) of

154140 (IsPromoted, L _ t : _) | isPromoted t -> space

155141 _ -> return ()

156− sep commaDel (sitcc . located' p_hsType) xs

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

157143 HsExplicitTupleTy NoExtField xs -> do

158144 txt "'"

159145 parens N $ do

160146 case xs of

161147 L _ t : _ | isPromoted t -> space

162148 _ -> return ()

163− sep commaDel (located' p_hsType) xs

149+ sep (comma >> breakpoint) (located' p_hsType) xs

164150 HsTyLit NoExtField t ->

165151 case t of

166152 HsStrTy (SourceText s) _ -> p_stringLit s

@@ -170,14 +156,14 @@ p_hsType' multilineArgs docStyle = \case

170156 where

171157 isPromoted = \case

172158 HsTyVar _ IsPromoted _ -> True

173− HsExplicitTupleTy {} -> True

174159 HsExplicitListTy {} -> True

160+ HsExplicitTupleTy {} -> True

175161 _ -> False

176162 interArgBreak =

177163 if multilineArgs

178164 then newline

179165 else breakpoint

180− p_hsTypeR = p_hsType' multilineArgs docStyle

166+ p_hsTypeR = p_hsType' multilineArgs

181167

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

183169-- attached to it.

@@ -191,7 +177,9 @@ p_hsContext :: HsContext GhcPs -> R ()

191177p_hsContext = \case

192178 [] -> txt "()"

193179 [x] -> located x p_hsType

194− xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs

180+ xs ->

181+ parens N . sitcc $

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

195183

196184p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

197185p_hsTyVarBndr = \case

@@ -221,14 +209,15 @@ p_forallBndrs vis p tyvars =

221209

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

223211p_conDeclFields xs =

224− braces N $ sep commaDel (sitcc . located' p_conDeclField) xs

212+ braces N . sitcc $

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

225214

226215p_conDeclField :: ConDeclField GhcPs -> R ()

227216p_conDeclField ConDeclField {..} = do

228217 mapM_ (p_hsDocString Pipe True) cd_fld_doc

229218 sitcc $

230219 sep

231− commaDel

220+ (comma >> breakpoint)

232221 (located' (p_rdrName . rdrNameFieldOcc))

233222 cd_fld_names

234223 space

@@ -270,6 +259,6 @@ tyVarToType = \case

270259 -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as

271260 -- long as 'tyVarToType' does not get applied to right-hand sides of

272261 -- declarations.

273− HsParTy NoExtField . noLoc $

262+ HsParTy NoExtField $ noLoc $

274263 HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind

275264 XTyVarBndr x -> noExtCon x

src/Ormolu/Printer/Operators.hs+59−46

@@ -12,11 +12,10 @@ where

1212

1313import Data.Function (on)

1414import qualified Data.List as L

15−import Data.Map.Strict (Map)

16−import qualified Data.Map.Strict as M

1715import Data.Maybe (fromMaybe, mapMaybe)

16+import Data.Ord (Down (Down), comparing)

1817import GHC

19−import OccName (occNameString)

18+import OccName (mkVarOcc)

2019import Ormolu.Utils (unSrcSpan)

2120

2221-- | Intermediate representation of operator trees. It has two type

@@ -57,7 +56,7 @@ reassociateOpTree getOpName opTree =

5756reassociateOpTreeWith ::

5857 forall ty op.

5958 -- | Fixity map for operators

60− Map String Fixity ->

59+ [(RdrName, Fixity)] ->

6160 -- | How to get the name of an operator

6261 (op -> Maybe RdrName) ->

6362 -- | Original 'OpTree'

@@ -68,13 +67,13 @@ reassociateOpTreeWith fixityMap getOpName = go

6867 where

6968 fixityOf :: op -> Fixity

7069 fixityOf op = fromMaybe defaultFixity $ do

71− s <- occNameString . rdrNameOcc <$> getOpName op

72− M.lookup s fixityMap

70+ opName <- getOpName op

71+ lookup opName fixityMap

7372 -- Here, left branch is already associated and the root alongside with

7473 -- the right branch is right-associated. This function picks up one item

7574 -- from the right and inserts it correctly to the left.

7675 --

77− -- Also, we are using the 'compareFixity' function which tells if the

76+ -- Also, we are using the 'compareFixity' function which returns if the

7877 -- expression should associate to right.

7978 go :: OpTree ty op -> OpTree ty op

8079 -- base cases

@@ -94,16 +93,6 @@ reassociateOpTreeWith fixityMap getOpName = go

9493 then go $ OpBranch (OpBranch l op (go $ OpBranch r op' l')) op'' r'

9594 else go $ OpBranch (OpBranch (OpBranch l op r) op' l') op'' r'

9695

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−

10796-- | Build a map of inferred 'Fixity's from an 'OpTree'.

10897buildFixityMap ::

10998 forall ty op.

@@ -112,26 +101,23 @@ buildFixityMap ::

112101 -- | Operator tree

113102 OpTree (Located ty) (Located op) ->

114103 -- | Fixity map

115− Map String Fixity

104+ [(RdrName, Fixity)]

116105buildFixityMap getOpName opTree =

117− addOverrides

118− . M.fromList

119− . concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)

120− . zip [2 ..]

121− . L.groupBy ((==) `on` snd)

122− . selectScores

106+ concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)

107+ . zip [0 ..]

108+ . L.groupBy (doubleWithinEps 0.00001 `on` snd)

109+ . (overrides ++)

110+ . modeScores

123111 $ score opTree

124112 where

125− addOverrides :: Map String Fixity -> Map String Fixity

126− addOverrides m =

127− M.fromList

128− [ ("$", fixity 0 InfixR),

129− (":", fixity 1 InfixR),

130− (".", fixity 100 InfixL)

131− ]

132− `M.union` m

133− fixity = Fixity NoSourceText

134− score :: OpTree (Located ty) (Located op) -> [(String, Score)]

113+ -- Add a special case for ($), since it is pretty unlikely for someone

114+ -- to override it.

115+ overrides :: [(RdrName, Double)]

116+ overrides =

117+ [ (mkRdrUnqual $ mkVarOcc "$", -1)

118+ ]

119+ -- Assign scores to operators based on their location in the source.

120+ score :: OpTree (Located ty) (Located op) -> [(RdrName, Double)]

135121 score (OpNode _) = []

136122 score (OpBranch l o r) = fromMaybe (score r) $ do

137123 -- If we fail to get any of these, 'defaultFixity' will be used by

@@ -141,27 +127,48 @@ buildFixityMap getOpName opTree =

141127 oe <- srcSpanEndLine <$> unSrcSpan (getLoc o) -- operator end

142128 rb <- srcSpanStartLine <$> unSrcSpan (opTreeLoc r) -- right begin

143129 oc <- srcSpanStartCol <$> unSrcSpan (getLoc o) -- operator column

144− opName <- occNameString . rdrNameOcc <$> getOpName (unLoc o)

130+ opName <- getOpName (unLoc o)

145131 let s

146− | le < ob = AtBeginning oc

147− | oe < rb = AtEnd

148− | otherwise = InBetween

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)

136+ | oe < rb =

137+ -- if the operator is in the end of the line, assign the

138+ -- score 1.

139+ 1

140+ | otherwise =

141+ 2 -- otherwise, assign a high score.

149142 return $ (opName, s) : score r

150− selectScores :: [(String, Score)] -> [(String, Score)]

151− selectScores =

143+ -- Pick the most common score per 'RdrName'.

144+ modeScores :: [(RdrName, Double)] -> [(RdrName, Double)]

145+ modeScores =

152146 L.sortOn snd

153147 . mapMaybe

154148 ( \case

155149 [] -> Nothing

156− xs@((n, _) : _) -> Just (n, selectScore $ map snd xs)

150+ xs@((n, _) : _) -> Just (n, mode $ map snd xs)

157151 )

158152 . L.groupBy ((==) `on` fst)

159153 . L.sort

160− selectScore :: [Score] -> Score

161− selectScore xs =

162− case filter (/= InBetween) xs of

163− [] -> InBetween

164− xs' -> maximum xs'

154+ -- Return the most common number, leaning to the smaller

155+ -- one in case of a tie.

156+ mode :: [Double] -> Double

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) =

167+ maximum

168+ [ go l,

169+ maybe 0 srcSpanStartCol (unSrcSpan o),

170+ go r

171+ ]

165172

166173----------------------------------------------------------------------------

167174-- Helpers

@@ -175,3 +182,9 @@ normalizeOpTree (OpBranch (OpNode l) lop r) =

175182 OpBranch (OpNode l) lop (normalizeOpTree r)

176183normalizeOpTree (OpBranch (OpBranch l' lop' r') lop r) =

177184 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

2020

2121-- | Marker for the beginning of the region where Ormolu should be disabled.

2222startDisabling :: IsString s => s

23−startDisabling = "{- ORMOLU_DISABLE_START"

23+startDisabling = "{- ORMOLU_DISABLING_START"

2424

2525-- | Marker for the end of the region where Ormolu should be disabled.

2626endDisabling :: IsString s => s

src/Ormolu/Processing/Postprocess.hs+3−13

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

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE ViewPatterns #-}

3−

41-- | Postprocessing for the results of printing.

52module Ormolu.Processing.Postprocess

63 ( postprocess,

@@ -13,19 +10,12 @@ import Ormolu.Processing.Common

1310import qualified Ormolu.Processing.Cpp as Cpp

1411

1512-- | Postprocess output of the formatter.

16−postprocess ::

17− -- | Desired indentation level

18− Int ->

19− -- | Input to process

20− Text ->

21− Text

22−postprocess indent =

13+postprocess :: Text -> Text

14+postprocess =

2315 T.unlines

24− . fmap indentLine

2516 . fmap Cpp.unmaskLine

2617 . filter (not . magicComment)

2718 . T.lines

2819 where

29− magicComment (T.stripStart -> x) =

20+ magicComment x =

3021 x == startDisabling || x == endDisabling

31− indentLine x = T.replicate indent " " <> x

src/Ormolu/Processing/Preprocess.hs+4−4

@@ -11,7 +11,8 @@ where

1111import Control.Monad

1212import Data.Char (isSpace)

1313import qualified Data.List as L

14−import Data.Maybe (isJust, maybeToList)

14+import Data.Maybe (isJust)

15+import Data.Maybe (maybeToList)

1516import FastString

1617import Ormolu.Config (RegionDeltas (..))

1718import Ormolu.Parser.Shebang (isShebang)

@@ -142,8 +143,7 @@ magicComment ::

142143 -- | Whether or not the two strings watch

143144 Bool

144145magicComment expected s0 = isJust $ do

145− let trim = dropWhile isSpace

146− s1 <- trim <$> L.stripPrefix "{-" (trim s0)

147− s2 <- trim <$> L.stripPrefix expected s1

146+ s1 <- dropWhile isSpace <$> L.stripPrefix "{-" s0

147+ s2 <- dropWhile isSpace <$> L.stripPrefix expected s1

148148 s3 <- L.stripPrefix "-}" s2

149149 guard (all isSpace s3)

src/Ormolu/Utils.hs+7−21

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

11{-# LANGUAGE LambdaCase #-}

22{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ViewPatterns #-}

54-- | Random utilities used by the code.

65module Ormolu.Utils

76 ( RelativePos (..),

87 attachRelativePos,

98 combineSrcSpans',

9+ isModule,

1010 notImplemented,

1111 showOutputable,

1212 splitDocString,

@@ -15,15 +15,13 @@ module Ormolu.Utils

1515 incSpanLine,

1616 separatedByBlank,

1717 separatedByBlankNE,

18− onTheSameLine,

19− removeIndentation,

2018 )

2119where

2220

23−import Data.Char (isSpace)

21+import Data.Data (Data, showConstr, toConstr)

2422import Data.List (dropWhileEnd)

25−import Data.List.NonEmpty (NonEmpty (..))

2623import qualified Data.List.NonEmpty as NE

24+import Data.List.NonEmpty (NonEmpty (..))

2725import Data.Maybe (fromMaybe)

2826import Data.Text (Text)

2927import qualified Data.Text as T

@@ -54,6 +52,10 @@ attachRelativePos = \case

5452combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan

5553combineSrcSpans' (x :| xs) = foldr combineSrcSpans x xs

5654

55+-- | Return 'True' if given element of AST is module.

56+isModule :: Data a => a -> Bool

57+isModule x = showConstr (toConstr x) == "HsModule"

58+

5759-- | Placeholder for things that are not yet implemented.

5860notImplemented :: String -> a

5961notImplemented msg = error $ "not implemented yet: " ++ msg

@@ -137,19 +139,3 @@ separatedByBlank loc a b =

137139-- | Do two declaration groups have a blank between them?

138140separatedByBlankNE :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool

139141separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b)

140−

141−-- | Return 'True' if one span ends on the same line the second one starts.

142−onTheSameLine :: SrcSpan -> SrcSpan -> Bool

143−onTheSameLine a b =

144− 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)

tests/Ormolu/PrinterSpec.hs+3−3

@@ -62,7 +62,7 @@ deriveOutput path =

6262-- | A version of 'shouldBe' that is specialized to comparing 'Text' values.

6363-- It also prints multi-line snippets in a more readable form.

6464shouldMatch :: Bool -> Text -> Text -> Expectation

65−shouldMatch idempotenceTest actual expected =

65+shouldMatch idempotencyTest actual expected =

6666 when (actual /= expected) . expectationFailure $

6767 unlines

6868 [ ">>>>>>>>>>>>>>>>>>>>>> expected (" ++ pass ++ "):",

@@ -72,8 +72,8 @@ shouldMatch idempotenceTest actual expected =

7272 ]

7373 where

7474 pass =

75− if idempotenceTest

76− then "idempotence pass"

75+ if idempotencyTest

76+ then "idempotency pass"

7777 else "first pass"

7878

7979examplesDir :: Path Rel Dir