git.iko.soy/ormolu
on 2fa7078 help sign in
dec158c
swap
0 ahead, 74 behind
216 files changed+1284−2807
since splitsnapshots
unifiedsplit
.buildkite/pipeline.yml+2−2 .github/workflows/binaries.yml−39 .github/workflows/build.sh−7 CHANGELOG.md−110 CONTRIBUTING.md+1−1 DESIGN.md+11−11 README.md+13−54 app/Main.hs+26−40 data/examples/declaration/annotation/annotation-out.hs−1 data/examples/declaration/data/gadt/multiline-out.hs+1−1 data/examples/declaration/data/multiline-arg-parens-out.hs+1−1 data/examples/declaration/data/partly-documented-out.hs−5 data/examples/declaration/data/partly-documented.hs−2 data/examples/declaration/data/unnamed-field-comment-0-out.hs−7 data/examples/declaration/data/unnamed-field-comment-0.hs−5 data/examples/declaration/data/unnamed-field-comment-1-out.hs−5 data/examples/declaration/data/unnamed-field-comment-1.hs−4 data/examples/declaration/data/with-comment-out.hs−4 data/examples/declaration/data/with-comment.hs−5 data/examples/declaration/data/with-weird-haddock-out.hs−4 data/examples/declaration/data/with-weird-haddock.hs−2 data/examples/declaration/signature/type/infix-promoted-type-constructor-out.hs+1 data/examples/declaration/signature/type/multi-value-out.hs−5 data/examples/declaration/signature/type/multi-value.hs−5 data/examples/declaration/signature/type/unrelated-out.hs−4 data/examples/declaration/signature/type/unrelated.hs−4 data/examples/declaration/type-synonyms/with-weird-haddock-out.hs−3 data/examples/declaration/type-synonyms/with-weird-haddock.hs−1 data/examples/declaration/value/function/arg-breakpoints-out.hs−3 data/examples/declaration/value/function/arg-breakpoints.hs−3 data/examples/declaration/value/function/arrow/proc-do-complex-out.hs+1−1 data/examples/declaration/value/function/awkward-comment-0-out.hs−6 data/examples/declaration/value/function/awkward-comment-0.hs−5 data/examples/declaration/value/function/awkward-comment-1-out.hs−9 data/examples/declaration/value/function/awkward-comment-1.hs−7 data/examples/declaration/value/function/blank-lines-let-out.hs−6 data/examples/declaration/value/function/blank-lines-let.hs−9 data/examples/declaration/value/function/blank-lines-where-out.hs−6 data/examples/declaration/value/function/blank-lines-where.hs−7 data/examples/declaration/value/function/if-with-comment-out.hs−8 data/examples/declaration/value/function/if-with-comment.hs−8 data/examples/declaration/value/function/implicit-params-out.hs−1 data/examples/declaration/value/function/implicit-params.hs−2 data/examples/declaration/value/function/infix/dollar-chains-out.hs+3−3 data/examples/declaration/value/function/infix/hanging-out.hs+3−4 data/examples/declaration/value/function/infix/lenses-out.hs+7−8 data/examples/declaration/value/function/list-notation-0-out.hs−5 data/examples/declaration/value/function/list-notation-0.hs−5 data/examples/declaration/value/function/list-notation-1-out.hs−8 data/examples/declaration/value/function/list-notation-1.hs−7 data/examples/declaration/value/function/list-notation-2-out.hs−6 data/examples/declaration/value/function/list-notation-2.hs−5 data/examples/declaration/value/function/list-notation-3-out.hs−12 data/examples/declaration/value/function/list-notation-3.hs−10 data/examples/declaration/value/function/multi-way-if-out.hs+2−4 data/examples/declaration/value/function/operator-comments-2-out.hs−5 data/examples/declaration/value/function/operator-comments-2.hs−4 data/examples/declaration/value/function/operators-1-out.hs−4 data/examples/declaration/value/function/operators-1.hs−3 data/examples/declaration/value/function/operators-2-out.hs−4 data/examples/declaration/value/function/operators-2.hs−4 data/examples/declaration/value/function/operators-3-out.hs−3 data/examples/declaration/value/function/operators-3.hs−3 data/examples/declaration/value/function/operators-4-out.hs−3 data/examples/declaration/value/function/operators-4.hs−3 data/examples/declaration/value/function/operators-5-out.hs−5 data/examples/declaration/value/function/operators-5.hs−4 data/examples/declaration/value/function/operators-6-out.hs−9 data/examples/declaration/value/function/operators-6.hs−7 data/examples/declaration/value/function/operators-0-out.hs → data/examples/declaration/value/function/operators-out.hs data/examples/declaration/value/function/operators-0.hs → data/examples/declaration/value/function/operators.hs data/examples/declaration/value/function/record/constructors-out.hs → data/examples/declaration/value/function/record-constructors-out.hs data/examples/declaration/value/function/record/constructors.hs → data/examples/declaration/value/function/record-constructors.hs data/examples/declaration/value/function/record/dot-out.hs → data/examples/declaration/value/function/record-dot-out.hs data/examples/declaration/value/function/record/dot.hs → data/examples/declaration/value/function/record-dot.hs data/examples/declaration/value/function/record/inter-comments-out.hs → data/examples/declaration/value/function/record-inter-comments-out.hs data/examples/declaration/value/function/record/inter-comments.hs → data/examples/declaration/value/function/record-inter-comments.hs data/examples/declaration/value/function/record/updaters-out.hs → data/examples/declaration/value/function/record-updaters-out.hs data/examples/declaration/value/function/record/updaters.hs → data/examples/declaration/value/function/record-updaters.hs data/examples/declaration/value/function/record/wildcards-out.hs → data/examples/declaration/value/function/record-wildcards-out.hs data/examples/declaration/value/function/record/wildcards.hs → data/examples/declaration/value/function/record-wildcards.hs data/examples/declaration/value/function/record/hanging-after-equal-con-out.hs−8 data/examples/declaration/value/function/record/hanging-after-equal-con.hs−7 data/examples/declaration/value/function/record/hanging-after-equal-update-out.hs−8 data/examples/declaration/value/function/record/hanging-after-equal-update.hs−7 data/examples/declaration/value/function/type-applications-and-splice-out.hs−4 data/examples/declaration/value/function/type-applications-and-splice.hs−4 data/examples/import/deduplication-bug-out.hs−6 data/examples/import/deduplication-bug.hs−6 data/examples/import/explicit-imports-out.hs+4−4 data/examples/import/explicit-imports-with-comments-out.hs+2−3 data/examples/import/merging-0-out.hs−3 data/examples/import/merging-0.hs−4 data/examples/import/merging-1-out.hs−2 data/examples/import/merging-1.hs−3 data/examples/import/merging-2-out.hs−2 data/examples/import/merging-2.hs−4 data/examples/import/misc-out.hs+6 data/examples/import/nested-explicit-imports-out.hs+6−6 data/examples/import/qualified-post-out.hs+1−1 data/examples/import/qualified-prelude-out.hs+1−1 data/examples/import/simple-out.hs+3−2 data/examples/import/simple.hs−2 data/examples/import/sorted-export-list-out.hs−1 data/examples/import/sorted-export-list.hs−1 data/examples/module-header/double-dot-with-names-out.hs+6−1 data/examples/module-header/multiline2.hs+2−2 data/examples/module-header/preceding-comment-with-haddock-out.hs+4−1 data/examples/module-header/singleline-empty-out.hs+4−1 data/examples/module-header/stack-header-0-out.hs−1 data/examples/module-header/stack-header-1-out.hs−1 data/examples/module-header/warning-pragma-multiline-out.hs+4−1 data/examples/module-header/warning-pragma-out.hs+1−3 data/examples/other/argument-comment-out.hs+1 data/examples/other/comment-glued-together-out.hs−7 data/examples/other/comment-glued-together.hs−6 data/examples/other/comment-trailing-space-out.hs−9 data/examples/other/comment-trailing-space.hs−9 data/examples/other/comment-two-blocks-out.hs+2−2 data/examples/other/cpp/continuation-out.hs−8 data/examples/other/cpp/continuation.hs−8 data/examples/other/cpp/lonely-hash-out.hs−14 data/examples/other/cpp/lonely-hash.hs−14 data/examples/other/cpp/separation-0a-out.hs−7 data/examples/other/cpp/separation-0a.hs−6 data/examples/other/cpp/separation-0b-out.hs−10 data/examples/other/cpp/separation-0b.hs−9 data/examples/other/cpp/separation-1a-out.hs−12 data/examples/other/cpp/separation-1a.hs−11 data/examples/other/cpp/separation-1b-out.hs−15 data/examples/other/cpp/separation-1b.hs−14 data/examples/other/cpp/separation-2a-out.hs−9 data/examples/other/cpp/separation-2a.hs−8 data/examples/other/cpp/separation-2b-out.hs−11 data/examples/other/cpp/separation-2b.hs−11 data/examples/other/cpp/shifted-out.hs−21 data/examples/other/cpp/shifted.hs−17 data/examples/other/cpp/simple-import-out.hs−14 data/examples/other/cpp/simple-import.hs−14 data/examples/other/disabling/indented-fragment-out.hs−7 data/examples/other/disabling/indented-fragment.hs−7 data/examples/other/disabling/single-definition-out.hs−10 data/examples/other/disabling/single-definition.hs−10 data/examples/other/disabling/whole-file-out.hs−10 data/examples/other/disabling/whole-file.hs−10 data/examples/other/inline-comment-0-out.hs−3 data/examples/other/inline-comment-0.hs−3 data/examples/other/inline-comment-1-out.hs−12 data/examples/other/inline-comment-1.hs−9 data/examples/other/multiple-blank-line-comment-out.hs−9 data/examples/other/multiple-blank-line-comment.hs−10 data/examples/other/pragma-comments-after-out.hs−4 data/examples/other/pragma-comments-after.hs−3 data/examples/other/pragma-comments-out.hs+4−1 data/examples/other/pragma-out.hs+4−1 default.nix+25−69 expected-failures/Agda.txt+29−6 expected-failures/brick.txt+5 expected-failures/esqueleto.txt+1−1 expected-failures/hlint.txt−11 expected-failures/idris.txt+94 expected-failures/intero.txt+3−3 expected-failures/leksah.txt+7−1 expected-failures/pandoc.txt+7−1 expected-failures/postgrest.txt−5 expected-failures/purescript.txt+2−2 expected-failures/stack.txt+5 expected-failures/tensorflow.txt−7 format.sh+4−6 nix/nixpkgs/default.nix+3−7 nix/ormolize/default.nix+5−3 ormolu.cabal+156−174 region-tests/expected-result-17-18.hs−17 region-tests/expected-result-6-7.hs−17 region-tests/expected-result-6-8.hs−16 region-tests/expected-result-9-12.hs−17 region-tests/expected-result-all.hs−21 region-tests/src.hs−17 shell.nix+2−4 src/GHC.hs+3 src/Ormolu.hs+7−10 src/Ormolu/Config.hs+11−52 src/Ormolu/Diff.hs+12−15 src/Ormolu/Exception.hs+10−3 src/Ormolu/Imports.hs+44−161 src/Ormolu/Parser.hs+99−48 src/Ormolu/Parser/CommentStream.hs+60−126 src/Ormolu/Parser/Result.hs+2−9 src/Ormolu/Printer.hs+12−17 src/Ormolu/Printer/Combinators.hs+26−34 src/Ormolu/Printer/Comments.hs+52−46 src/Ormolu/Printer/Internal.hs+52−85 src/Ormolu/Printer/Meat/Common.hs+10−11 src/Ormolu/Printer/Meat/Declaration.hs+14−26 src/Ormolu/Printer/Meat/Declaration.hs-boot+1 src/Ormolu/Printer/Meat/Declaration/Class.hs+2−2 src/Ormolu/Printer/Meat/Declaration/Data.hs+31−34 src/Ormolu/Printer/Meat/Declaration/Default.hs+2−2 src/Ormolu/Printer/Meat/Declaration/Instance.hs+9−5 src/Ormolu/Printer/Meat/Declaration/Rule.hs+2−2 src/Ormolu/Printer/Meat/Declaration/Signature.hs+27−29 src/Ormolu/Printer/Meat/Declaration/Type.hs+3−5 src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+5−5 src/Ormolu/Printer/Meat/Declaration/Value.hs+166−181 src/Ormolu/Printer/Meat/Declaration/Value.hs-boot+4 src/Ormolu/Printer/Meat/Declaration/Warning.hs+8−5 src/Ormolu/Printer/Meat/ImportExport.hs+20−26 src/Ormolu/Printer/Meat/Module.hs+15−12 src/Ormolu/Printer/Meat/Type.hs+24−35 src/Ormolu/Printer/Operators.hs+59−46 src/Ormolu/Processing/Common.hs−27 src/Ormolu/Processing/Cpp.hs−70 src/Ormolu/Processing/Postprocess.hs−31 src/Ormolu/Processing/Preprocess.hs−149 src/Ormolu/Utils.hs+10−63 tests/Ormolu/PrinterSpec.hs+7−4
.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−110
@@ -1,102 +1,5 @@
11## Unreleased
22
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−
98−## Ormolu 0.0.5.0
99−
1003* Grouping of statements in `do`-blocks is now preserved. [Issue
1014 74](https://github.com/tweag/ormolu/issues/74).
1025
@@ -106,19 +9,6 @@
1069* Comments on pragmas are now preserved. [Issue
10710 216](https://github.com/tweag/ormolu/issues/216).
10811
109−* Ormolu can now be enabled and disabled via special comments. [Issue
110− 435](https://github.com/tweag/ormolu/issues/435).
111−
112−* Added experimental support for simple CPP. [Issue
113− 415](https://github.com/tweag/ormolu/issues/415).
114−
115−* Added two new options `--start-line` and `--end-line` that allow us to
116− select a region to format. [Issue
117− 516](https://github.com/tweag/ormolu/issues/516).
118−
119−* Fixed rendering of module headers in the presence of preceding comments or
120− Haddocks. [Issue 561](https://github.com/tweag/ormolu/issues/561).
121−
12212## Ormolu 0.0.4.0
12313
12414* When given several files to format, Ormolu does not stop on the first
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+13−54
@@ -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,44 +91,21 @@ 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−
101−## Magic comments
102−
103−Ormolu understands two magic comments:
104−
105−```haskell
106−{- ORMOLU_DISABLE -}
107−```
108−
109−and
110−
111−```haskell
112−{- ORMOLU_ENABLE -}
113−```
114−
115−This allows us to disable formatting selectively for code between these
116−markers or disable it for the entire file. To achieve the latter, just put
117−`{- ORMOLU_DISABLE -}` at the very top. Note that the source code should
118−still be parseable even without the “excluded” part. Because of that the
119−magic comments cannot be placed arbitrary, but should rather enclose
120−independent top-level definitions.
121−
12294## Current limitations
12395
124−* CPP support is experimental. CPP is virtually impossible to handle
125− 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.
96+* Does not handle CPP (wontfix, see [the design document][design]).
12997* Input modules should be parsable by Haddock, which is a bit stricter
13098 criterion than just being valid Haskell modules.
13199* Various minor idempotence issues, most of them are related to comments.
132100
101+## Editor integration
102+
103+We know of the following editor integrations:
104+
105+* [Emacs][emacs-package]
106+* [VS Code][vs-code-plugin]
107+* vim: [neoformat][neoformat], [vim-ormolu][vim-ormolu]
108+
133109## Running on Hackage
134110
135111It's possible to try Ormolu on arbitrary packages from Hackage. For that
@@ -144,22 +120,6 @@ also contain formatted `.hs` files for inspection and original inputs with
144120`.hs-original` extension (those are with CPP dropped, exactly what is fed
145121into Ormolu).
146122
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−
163123## Contributing
164124
165125See [CONTRIBUTING.md][contributing].
@@ -170,7 +130,7 @@ See [LICENSE.md][license].
170130
171131Copyright © 2018–present Tweag I/O
172132
173−[design-cpp]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp
133+[design]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp
174134[contributing]: https://github.com/tweag/ormolu/blob/master/CONTRIBUTING.md
175135[license]: https://github.com/tweag/ormolu/blob/master/LICENSE.md
176136[haskell-src-exts]: https://hackage.haskell.org/package/haskell-src-exts
@@ -178,4 +138,3 @@ Copyright © 2018–present Tweag I/O
178138[vs-code-plugin]: https://marketplace.visualstudio.com/items?itemName=sjurmillidahl.ormolu-vscode
179139[vim-ormolu]: https://github.com/sdiehl/vim-ormolu
180140[neoformat]: https://github.com/sbdchd/neoformat
181−[aur]: https://aur.archlinux.org/packages/ormolu
app/Main.hs+26−40
@@ -4,11 +4,13 @@
44{-# LANGUAGE TemplateHaskell #-}
55{-# LANGUAGE TypeApplications #-}
66
7−module Main (main) where
7+module Main
8+ ( main,
9+ )
10+where
811
912import Control.Exception (SomeException, displayException, try)
1013import Control.Monad
11−import Data.Bool (bool)
1214import Data.Either (lefts)
1315import Data.List (intercalate, sort)
1416import qualified Data.Text.IO as TIO
@@ -45,7 +47,7 @@ formatOne ::
4547 -- | Mode of operation
4648 Mode ->
4749 -- | Configuration
48− Config RegionIndices ->
50+ Config ->
4951 -- | File to format or stdin as 'Nothing'
5052 Maybe FilePath ->
5153 IO ()
@@ -61,19 +63,15 @@ formatOne mode config = \case
6163 -- 101 is different from all the other exit codes we already use.
6264 exitWith (ExitFailure 101)
6365 Just inputFile -> do
64− originalInput <- TIO.readFile inputFile
65− formattedInput <- ormoluFile config inputFile
66+ r <- ormoluFile config inputFile
6667 case mode of
6768 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
69+ TIO.putStr r
70+ InPlace ->
71+ TIO.writeFile inputFile r
7572 Check -> do
76− when (formattedInput /= originalInput) $
73+ r' <- TIO.readFile inputFile
74+ when (r /= r') $
7775 -- 100 is different to all the other exit code that are emitted
7876 -- either from an 'OrmoluException' or from 'error' and
7977 -- 'notImplemented'.
@@ -86,7 +84,7 @@ data Opts = Opts
8684 { -- | Mode of operation
8785 optMode :: !Mode,
8886 -- | Ormolu 'Config'
89− optConfig :: !(Config RegionIndices),
87+ optConfig :: !Config,
9088 -- | Haskell source files to format or stdin (when the list is empty)
9189 optInputFiles :: ![FilePath]
9290 }
@@ -139,25 +137,20 @@ optsParserInfo =
139137optsParser :: Parser Opts
140138optsParser =
141139 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− )
140+ <$> (option parseMode . mconcat)
141+ [ long "mode",
142+ short 'm',
143+ metavar "MODE",
144+ value Stdout,
145+ help "Mode of operation: 'stdout' (default), 'inplace', or 'check'"
146+ ]
154147 <*> configParser
155148 <*> (many . strArgument . mconcat)
156149 [ metavar "FILE",
157150 help "Haskell source files to format or stdin (default)"
158151 ]
159152
160−configParser :: Parser (Config RegionIndices)
153+configParser :: Parser Config
161154configParser =
162155 Config
163156 <$> (fmap (fmap DynOption) . many . strOption . mconcat)
@@ -177,22 +170,15 @@ configParser =
177170 help "Output information useful for debugging"
178171 ]
179172 <*> (switch . mconcat)
180− [ long "check-idempotence",
173+ [ long "tolerate-cpp",
174+ short 'p',
175+ help "Do not fail if CPP pragma is present"
176+ ]
177+ <*> (switch . mconcat)
178+ [ long "check-idempotency",
181179 short 'c',
182180 help "Fail if formatting is not idempotent"
183181 ]
184− <*> ( RegionIndices
185− <$> (optional . option auto . mconcat)
186− [ long "start-line",
187− metavar "START",
188− help "Start line of the region to format (starts from 1)"
189− ]
190− <*> (optional . option auto . mconcat)
191− [ long "end-line",
192− metavar "END",
193− help "End line of the region to format (inclusive)"
194− ]
195− )
196182
197183----------------------------------------------------------------------------
198184-- Helpers
data/examples/declaration/annotation/annotation-out.hs−1
@@ -18,5 +18,4 @@ foo = 5
1818
1919data Foo = Foo Int
2020{-# ANN type Foo ("HLint: ignore") #-}
21−
2221{- Comment -}
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)
2+
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
44
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
44
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 #-}
22
33sortBy :: (a -> a -> Bool) -> [a] -> [a]
4−sortBy = undefined
54
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]
33
4−sortBy = undefined
5−
64sort :: (?cmp :: a -> a -> Bool) => [a] -> [a]
75sort = sortBy ?cmp
86
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
44
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 #-}
22
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
22
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/module-header/double-dot-with-names-out.hs+6−1
@@ -1,6 +1,11 @@
11{-# LANGUAGE PatternSynonyms #-}
22
3−module ExportSyntax (A (.., NoA), Q (F, ..), G (T, .., U)) where
3+module ExportSyntax
4+ ( A (.., NoA),
5+ Q (F, ..),
6+ G (T, .., U),
7+ )
8+where
49
510data A = A | B
611
data/examples/module-header/multiline2.hs+2−2
@@ -1,2 +1,2 @@
1−module Foo (
2− foo, bar, baz) where
1+module Foo
2+ (foo, bar, baz) where
data/examples/module-header/preceding-comment-with-haddock-out.hs+4−1
@@ -3,6 +3,9 @@
33-}
44
55-- | This is the module's Haddock.
6−module Main (main) where
6+module Main
7+ ( main,
8+ )
9+where
710
811main = return ()
data/examples/module-header/singleline-empty-out.hs+4−1
@@ -1,2 +1,5 @@
11-- | This demonstrates a BUG.
2−module Foo () where
2+module Foo
3+ (
4+ )
5+where
data/examples/module-header/stack-header-0-out.hs−1
@@ -3,5 +3,4 @@
33{-# LANGUAGE OverloadedStrings #-}
44
55main = return ()
6−
76-- stack runhaskell
data/examples/module-header/stack-header-1-out.hs−1
@@ -4,5 +4,4 @@
44{-# LANGUAGE OverloadedStrings #-}
55
66main = return ()
7−
87-- stack runhaskell
data/examples/module-header/warning-pragma-multiline-out.hs+4−1
@@ -1,6 +1,9 @@
11module Test
22 {-# DEPRECATED "This module is unstable" #-}
3− (foo, bar, baz)
3+ ( foo,
4+ bar,
5+ baz,
6+ )
47where
58
69import Blah
data/examples/module-header/warning-pragma-out.hs+1−3
@@ -1,5 +1,3 @@
11module Test
2− {-# WARNING
3− "This module is very internal"
4− #-}
2+ {-# WARNING "This module is very internal" #-}
53where
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
66
7− -- Bar
7+ -- Bar
88 ]
data/examples/other/cpp/continuation-out.hsdeleted−8
@@ -1,8 +0,0 @@
1−foo :: Int
2−foo = 5
3−
4−#define message_for(a, b) \
5− printf(#a " and " #b ": We love you!\n")
6−
7−bar :: Int
8−bar = 6
data/examples/other/cpp/continuation.hsdeleted−8
@@ -1,8 +0,0 @@
1−foo :: Int
2−foo = 5
3−
4−#define message_for(a, b) \
5− printf(#a " and " #b ": We love you!\n")
6−
7−bar :: Int
8−bar = 6
data/examples/other/cpp/lonely-hash-out.hsdeleted−14
@@ -1,14 +0,0 @@
1−module Main (main) where
2−
3−import Data.Void
4−import Test.Hspec
5−import Test.Hspec.Megaparsec
6−import Text.Megaparsec
7−import Text.Megaparsec.Char
8−
9−# if !MIN_VERSION_base(4,13,0)
10−import Data.Semigroup ((<>))
11−# endif
12−
13−main :: IO ()
14−main = return ()
data/examples/other/cpp/lonely-hash.hsdeleted−14
@@ -1,14 +0,0 @@
1−module Main (main) where
2−
3−import Data.Void
4−import Test.Hspec
5−import Test.Hspec.Megaparsec
6−import Text.Megaparsec
7−import Text.Megaparsec.Char
8−
9−# if !MIN_VERSION_base(4,13,0)
10−import Data.Semigroup ((<>))
11−# endif
12−
13−main :: IO ()
14−main = return ()
data/examples/other/cpp/separation-0a-out.hsdeleted−7
@@ -1,7 +0,0 @@
1−instance Stream s => Monad (ParsecT e s m) where
2− return = pure
3− (>>=) = pBind
4−
5−#if !(MIN_VERSION_base(4,13,0))
6− fail = Fail.fail
7−#endif
data/examples/other/cpp/separation-0a.hsdeleted−6
@@ -1,6 +0,0 @@
1−instance Stream s => Monad (ParsecT e s m) where
2− return = pure
3− (>>=) = pBind
4−#if !(MIN_VERSION_base(4,13,0))
5− fail = Fail.fail
6−#endif
data/examples/other/cpp/separation-0b-out.hsdeleted−10
@@ -1,10 +0,0 @@
1−instance Stream s => Monad (ParsecT e s m) where
2− return = pure
3− (>>=) = pBind
4−
5−#if !(MIN_VERSION_base(4,13,0))
6− fail = Fail.fail
7−#endif
8−
9−foo :: Int
10−foo = undefined
data/examples/other/cpp/separation-0b.hsdeleted−9
@@ -1,9 +0,0 @@
1−instance Stream s => Monad (ParsecT e s m) where
2− return = pure
3− (>>=) = pBind
4−#if !(MIN_VERSION_base(4,13,0))
5− fail = Fail.fail
6−#endif
7−
8−foo :: Int
9−foo = undefined
data/examples/other/cpp/separation-1a-out.hsdeleted−12
@@ -1,12 +0,0 @@
1−decompressingPipe ::
2− (PrimMonad m, MonadThrow m, MonadResource m) =>
3− CompressionMethod ->
4− ConduitT ByteString ByteString m ()
5−decompressingPipe Store = C.awaitForever C.yield
6−decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15)
7−
8−#ifdef ENABLE_BZIP2
9−decompressingPipe BZip2 = BZ.bunzip2
10−#else
11−decompressingPipe BZip2 = throwM BZip2Unsupported
12−#endif
data/examples/other/cpp/separation-1a.hsdeleted−11
@@ -1,11 +0,0 @@
1−decompressingPipe
2− :: (PrimMonad m, MonadThrow m, MonadResource m)
3− => CompressionMethod
4− -> ConduitT ByteString ByteString m ()
5−decompressingPipe Store = C.awaitForever C.yield
6−decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15)
7−#ifdef ENABLE_BZIP2
8−decompressingPipe BZip2 = BZ.bunzip2
9−#else
10−decompressingPipe BZip2 = throwM BZip2Unsupported
11−#endif
data/examples/other/cpp/separation-1b-out.hsdeleted−15
@@ -1,15 +0,0 @@
1−decompressingPipe ::
2− (PrimMonad m, MonadThrow m, MonadResource m) =>
3− CompressionMethod ->
4− ConduitT ByteString ByteString m ()
5−decompressingPipe Store = C.awaitForever C.yield
6−decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15)
7−
8−#ifdef ENABLE_BZIP2
9−decompressingPipe BZip2 = BZ.bunzip2
10−#else
11−decompressingPipe BZip2 = throwM BZip2Unsupported
12−#endif
13−
14−foo :: Int
15−foo = undefined
data/examples/other/cpp/separation-1b.hsdeleted−14
@@ -1,14 +0,0 @@
1−decompressingPipe
2− :: (PrimMonad m, MonadThrow m, MonadResource m)
3− => CompressionMethod
4− -> ConduitT ByteString ByteString m ()
5−decompressingPipe Store = C.awaitForever C.yield
6−decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15)
7−#ifdef ENABLE_BZIP2
8−decompressingPipe BZip2 = BZ.bunzip2
9−#else
10−decompressingPipe BZip2 = throwM BZip2Unsupported
11−#endif
12−
13−foo :: Int
14−foo = undefined
data/examples/other/cpp/separation-2a-out.hsdeleted−9
@@ -1,9 +0,0 @@
1−ffff, ffffffff :: Natural
2−
3−#ifdef HASKELL_ZIP_DEV_MODE
4−ffff = 200
5−ffffffff = 5000
6−#else
7−ffff = 0xffff
8−ffffffff = 0xffffffff
9−#endif
data/examples/other/cpp/separation-2a.hsdeleted−8
@@ -1,8 +0,0 @@
1−ffff, ffffffff :: Natural
2−#ifdef HASKELL_ZIP_DEV_MODE
3−ffff = 200
4−ffffffff = 5000
5−#else
6−ffff = 0xffff
7−ffffffff = 0xffffffff
8−#endif
data/examples/other/cpp/separation-2b-out.hsdeleted−11
@@ -1,11 +0,0 @@
1−ffff, ffffffff :: Natural
2−#ifdef HASKELL_ZIP_DEV_MODE
3−ffff = 200
4−ffffffff = 5000
5−#else
6−ffff = 0xffff
7−ffffffff = 0xffffffff
8−#endif
9−
10−foo :: Int
11−foo = undefined
data/examples/other/cpp/separation-2b.hsdeleted−11
@@ -1,11 +0,0 @@
1−ffff, ffffffff :: Natural
2−#ifdef HASKELL_ZIP_DEV_MODE
3−ffff = 200
4−ffffffff = 5000
5−#else
6−ffff = 0xffff
7−ffffffff = 0xffffffff
8−#endif
9−
10−foo :: Int
11−foo = undefined
data/examples/other/cpp/shifted-out.hsdeleted−21
@@ -1,21 +0,0 @@
1−sinkData h compression = do
2− (uncompressedSize, crc32, compressedSize) <-
3− case compression of
4− Store ->
5− withCompression
6− dataSink
7− Deflate ->
8− withCompression $
9− Z.compress 9 (Z.WindowBits (-15)) .| dataSink
10−#ifdef ENABLE_BZIP2
11− BZip2 -> withCompression $
12− BZ.bzip2 .| dataSink
13−#else
14− BZip2 -> throwM BZip2Unsupported
15−#endif
16− return
17− DataDescriptor
18− { ddCRC32 = fromIntegral crc32,
19− ddCompressedSize = compressedSize,
20− ddUncompressedSize = uncompressedSize
21− }
data/examples/other/cpp/shifted.hsdeleted−17
@@ -1,17 +0,0 @@
1−sinkData h compression = do
2− (uncompressedSize, crc32, compressedSize) <-
3− case compression of
4− Store -> withCompression
5− dataSink
6− Deflate -> withCompression $
7− Z.compress 9 (Z.WindowBits (-15)) .| dataSink
8−#ifdef ENABLE_BZIP2
9− BZip2 -> withCompression $
10− BZ.bzip2 .| dataSink
11−#else
12− BZip2 -> throwM BZip2Unsupported
13−#endif
14− return DataDescriptor
15− { ddCRC32 = fromIntegral crc32
16− , ddCompressedSize = compressedSize
17− , ddUncompressedSize = uncompressedSize }
data/examples/other/cpp/simple-import-out.hsdeleted−14
@@ -1,14 +0,0 @@
1−module Main (main) where
2−
3−import Data.Void
4−import Test.Hspec
5−import Test.Hspec.Megaparsec
6−import Text.Megaparsec
7−import Text.Megaparsec.Char
8−
9−#if !MIN_VERSION_base(4,13,0)
10−import Data.Semigroup ((<>))
11−#endif
12−
13−main :: IO ()
14−main = return ()
data/examples/other/cpp/simple-import.hsdeleted−14
@@ -1,14 +0,0 @@
1−module Main (main) where
2−
3−import Data.Void
4−import Test.Hspec
5−import Test.Hspec.Megaparsec
6−import Text.Megaparsec
7−import Text.Megaparsec.Char
8−
9−#if !MIN_VERSION_base(4,13,0)
10−import Data.Semigroup ((<>))
11−#endif
12−
13−main :: IO ()
14−main = return ()
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/disabling/single-definition-out.hsdeleted−10
@@ -1,10 +0,0 @@
1−module Foo (foo, bar) where
2−
3−{- ORMOLU_DISABLE -}
4−foo :: Int -> Int
5−foo = (+5)
6−{- ORMOLU_ENABLE -}
7−
8−bar :: Bool -> Bool
9−bar True = True
10−bar False = True
data/examples/other/disabling/single-definition.hsdeleted−10
@@ -1,10 +0,0 @@
1−module Foo (foo,bar) where
2−
3−{- ORMOLU_DISABLE -}
4−foo :: Int -> Int
5−foo = (+5)
6−{- ORMOLU_ENABLE -}
7−
8−bar :: Bool -> Bool
9−bar True = True
10−bar False = True
data/examples/other/disabling/whole-file-out.hsdeleted−10
@@ -1,10 +0,0 @@
1−{- ORMOLU_DISABLE -}
2−
3−module Foo (foo,bar) where
4−
5−foo :: Int -> Int
6−foo = (+5)
7−
8−bar :: Bool -> Bool
9−bar True = True
10−bar False = True
data/examples/other/disabling/whole-file.hsdeleted−10
@@ -1,10 +0,0 @@
1−{- ORMOLU_DISABLE -}
2−
3−module Foo (foo,bar) where
4−
5−foo :: Int -> Int
6−foo = (+5)
7−
8−bar :: Bool -> Bool
9−bar True = True
10−bar False = True
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 #-}
data/examples/other/pragma-comments-out.hs+4−1
@@ -5,4 +5,7 @@
55{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
66
77-- | Header comment.
8−module Foo () where
8+module Foo
9+ (
10+ )
11+where
data/examples/other/pragma-out.hs+4−1
@@ -9,4 +9,7 @@
99{-# OPTIONS_HADDOCK prune, show-extensions #-}
1010
1111-- | Header comment.
12−module Foo () where
12+module Foo
13+ (
14+ )
15+where
default.nix+25−69
@@ -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}:
54
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"
@@ -117,53 +122,4 @@ in {
117122 ];
118123 in listToAttrs (map (p: nameValuePair p (ormolizedPackages true).${p}) ps)
119124 );
120− regionTests = pkgs.stdenv.mkDerivation {
121− name = "ormolu-region-tests";
122− src = ./region-tests;
123− buildInputs = [
124− haskellPackages.ormolu
125− pkgs.diffutils
126− ];
127− doCheck = true;
128− buildPhase = ''
129− cp src.hs result-all-implicit.hs
130− ormolu --check-idempotence --mode inplace result-all-implicit.hs
131− cp src.hs result-all-explicit.hs
132− ormolu --check-idempotence --mode inplace --start-line 1 --end-line 18 result-all-explicit.hs
133− cp src.hs result-only-start.hs
134− ormolu --check-idempotence --mode inplace --start-line 1 result-only-start.hs
135− cp src.hs result-only-end.hs
136− ormolu --check-idempotence --mode inplace --end-line 18 result-only-end.hs
137− cp src.hs result-6-7.hs
138− ormolu --check-idempotence --mode inplace --start-line 6 --end-line 7 result-6-7.hs
139− 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− '';
146− checkPhase = ''
147− echo result-all-implicit.hs
148− diff --color=always expected-result-all.hs result-all-implicit.hs
149− echo result-all-explicit.hs
150− diff --color=always expected-result-all.hs result-all-explicit.hs
151− echo result-only-start.hs
152− diff --color=always expected-result-all.hs result-only-start.hs
153− echo result-only-end.hs
154− diff --color=always expected-result-all.hs result-only-end.hs
155− echo result-6-7.hs
156− diff --color=always expected-result-6-7.hs result-6-7.hs
157− echo result-6-8.hs
158− 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
163− '';
164− installPhase = ''
165− mkdir "$out"
166− find . -name '*.hs' -exec cp --parents {} $out \;
167− '';
168− };
169125}
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.
66
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>:152: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'
44
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.
6+
7+Formatting is not idempotent:
8+ src/Idris/Core/ProofState.hs<rendered>:163:20
9+ before: "++ showEnv env (\n "
10+ after: "++ showEnv\n "
11+Please, consider reporting the bug.
12+
13+Formatting is not idempotent:
14+ src/Idris/Core/ProofTerm.hs<rendered>:351:19
15+ before: "f c e pt = -- @(PT p"
16+ after: "f c e pt =\n -- @(PT"
17+Please, consider reporting the bug.
18+
19+Formatting is not idempotent:
20+ src/Idris/Core/TT.hs<rendered>:1963:13
21+ before: " text op <> pretty"
22+ after: " text op\n <"
23+Please, consider reporting the bug.
24+
25+Formatting is not idempotent:
26+ src/Idris/Core/WHNF.hs<rendered>:110: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>:40: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>:244: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.
6+
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'
44
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>:997: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?
55
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+4−6
@@ -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.
55
@@ -7,8 +7,6 @@ set -e
77
88export LANG="C.UTF-8"
99
10−cabal format
11−
12−ormolu -m inplace $(find app -type f -name "*.hs")
13−ormolu -m inplace $(find src -type f \( -name "*.hs" -o -name "*.hs-boot" \))
14−ormolu -m inplace $(find tests -type f -name "*.hs")
10+ormolu -p -m inplace $(find app -type f -name "*.hs")
11+ormolu -p -m inplace $(find src -type f \( -name "*.hs" -o -name "*.hs-boot" \))
12+ormolu -p -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+5−3
@@ -10,9 +10,11 @@
1010 src = package.src;
1111 buildInputs = [
1212 haskellPackages.cpphs
13− haskellPackages.ormolu
14− pkgs.diffutils
13+ (if doCheck
14+ then haskellPackages.ormolu
15+ else pkgs.haskell.lib.dontCheck haskellPackages.ormolu)
1516 pkgs.glibcLocales
17+ pkgs.diffutils
1618 ];
1719 LANG = "en_US.UTF-8";
1820 buildPhase = ''
@@ -32,7 +34,7 @@
3234 cp "$hs_file" "''${hs_file}-original"
3335 done
3436
35− (ormolu --check-idempotence --mode inplace $hs_files || true) 2> log.txt
37+ (ormolu --tolerate-cpp --check-idempotency --mode inplace $hs_files || true) 2> log.txt
3638 '';
3739 inherit doCheck;
3840 checkPhase =
ormolu.cabal+156−174
@@ -1,184 +1,166 @@
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.4.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.Utils
113+ other-modules: GHC
114+ , GHC.DynFlags
115+ if flag(dev)
116+ ghc-options: -Wall -Werror -Wcompat
117+ -Wincomplete-record-updates
118+ -Wincomplete-uni-patterns
119+ -Wnoncanonical-monad-instances
120+ -- https://github.com/haskell/haddock/issues/1116
121+ -Wno-missing-home-modules
122+ else
123+ ghc-options: -O2 -Wall
124+ default-language: Haskell2010
159125
160126test-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
127+ main-is: Spec.hs
128+ hs-source-dirs: tests
129+ type: exitcode-stdio-1.0
130+ build-depends: base >= 4.12 && < 5.0
131+ , containers >= 0.5 && < 0.7
132+ , filepath >= 1.2 && < 1.5
133+ , hspec >= 2.0 && < 3.0
134+ , ormolu
135+ , path >= 0.6 && < 0.8
136+ , path-io >= 1.4.2 && < 2.0
137+ , text >= 0.2 && < 1.3
138+ build-tools: hspec-discover >= 2.0 && < 3.0
139+ other-modules:
140+ Ormolu.Parser.PragmaSpec
141+ , Ormolu.PrinterSpec
168142
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
143+ if flag(dev)
144+ ghc-options: -Wall -Werror
145+ else
146+ ghc-options: -O2 -Wall
147+ default-language: Haskell2010
179148
180− if flag(dev)
181− ghc-options: -Wall -Werror
182−
183− else
184− ghc-options: -O2 -Wall
149+executable ormolu
150+ main-is: Main.hs
151+ hs-source-dirs: app
152+ build-depends: base >= 4.12 && < 5.0
153+ , ghc-lib-parser >= 8.10 && < 8.11
154+ , gitrev >= 1.3 && < 1.4
155+ , optparse-applicative >= 0.14 && < 0.16
156+ , ormolu
157+ , text >= 0.2 && < 1.3
158+ other-modules: Paths_ormolu
159+ if flag(dev)
160+ ghc-options: -Wall -Werror -Wcompat
161+ -Wincomplete-record-updates
162+ -Wincomplete-uni-patterns
163+ -Wnoncanonical-monad-instances
164+ else
165+ ghc-options: -O2 -Wall -rtsopts
166+ 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.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-8.hsdeleted−16
@@ -1,16 +0,0 @@
1−{-# LANGUAGE LambdaCase #-}
2−
3−module Foo (
4− foo, bar, baz) where
5−
6−foo :: Int
7−foo = 5
8−bar :: Int -> Int
9−bar = \case
10− 0 -> foo
11− x -> x - foo
12−
13−baz :: Int -> Int
14−baz = gege
15− where
16− gege = 1 + 2
region-tests/expected-result-9-12.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-all.hsdeleted−21
@@ -1,21 +0,0 @@
1−{-# LANGUAGE LambdaCase #-}
2−
3−module Foo
4− ( foo,
5− bar,
6− baz,
7− )
8−where
9−
10−foo :: Int
11−foo = 5
12−
13−bar :: Int -> Int
14−bar = \case
15− 0 -> foo
16− x -> x - foo
17−
18−baz :: Int -> Int
19−baz = gege
20− where
21− gege = 1 + 2
region-tests/src.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
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) }:
42
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
56
@@ -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+7−10
@@ -6,7 +6,6 @@ module Ormolu
66 ormoluFile,
77 ormoluStdin,
88 Config (..),
9− RegionIndices (..),
109 defaultConfig,
1110 DynOption (..),
1211 OrmoluException (..),
@@ -43,15 +42,13 @@ import qualified SrcLoc as GHC
4342ormolu ::
4443 MonadIO m =>
4544 -- | Ormolu configuration
46− Config RegionIndices ->
45+ Config ->
4746 -- | Location of source file
4847 FilePath ->
4948 -- | Input to format
5049 String ->
5150 m Text
52−ormolu cfgWithIndices path str = do
53− let totalLines = length (lines str)
54− cfg = regionIndicesToDeltas totalLines <$> cfgWithIndices
51+ormolu cfg path str = do
5552 (warnings, result0) <-
5653 parseModule' cfg OrmoluParsingFailed path str
5754 when (cfgDebug cfg) $ do
@@ -63,7 +60,7 @@ ormolu cfgWithIndices path str = do
6360 -- to parse the rendered code back, inside of GHC monad wrapper which will
6461 -- lead to error messages presenting the exceptions as GHC bugs.
6562 let !txt = printModule result0
66− when (not (cfgUnsafe cfg) || cfgCheckIdempotence cfg) $ do
63+ when (not (cfgUnsafe cfg) || cfgCheckIdempotency cfg) $ do
6764 let pathRendered = path ++ "<rendered>"
6865 -- Parse the result of pretty-printing again and make sure that AST
6966 -- is the same as AST of original snippet module span positions.
@@ -79,7 +76,7 @@ ormolu cfgWithIndices path str = do
7976 Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss)
8077 -- Try re-formatting the formatted result to check if we get exactly
8178 -- the same output.
82− when (cfgCheckIdempotence cfg) $
79+ when (cfgCheckIdempotency cfg) $
8380 let txt2 = printModule result1
8481 in case diffText txt txt2 pathRendered of
8582 Nothing -> return ()
@@ -96,7 +93,7 @@ ormolu cfgWithIndices path str = do
9693ormoluFile ::
9794 MonadIO m =>
9895 -- | Ormolu configuration
99− Config RegionIndices ->
96+ Config ->
10097 -- | Location of source file
10198 FilePath ->
10299 -- | Resulting rendition
@@ -111,7 +108,7 @@ ormoluFile cfg path =
111108ormoluStdin ::
112109 MonadIO m =>
113110 -- | Ormolu configuration
114− Config RegionIndices ->
111+ Config ->
115112 -- | Resulting rendition
116113 m Text
117114ormoluStdin cfg =
@@ -124,7 +121,7 @@ ormoluStdin cfg =
124121parseModule' ::
125122 MonadIO m =>
126123 -- | Ormolu configuration
127− Config RegionDeltas ->
124+ Config ->
128125 -- | How to obtain 'OrmoluException' to throw when parsing fails
129126 (GHC.SrcSpan -> String -> OrmoluException) ->
130127 -- | File name to use in errors
src/Ormolu/Config.hs+11−52
@@ -1,13 +1,7 @@
1−{-# LANGUAGE DeriveFunctor #-}
2−{-# LANGUAGE RecordWildCards #-}
3−
41-- | Configuration options used by the tool.
52module Ormolu.Config
63 ( Config (..),
7− RegionIndices (..),
8− RegionDeltas (..),
94 defaultConfig,
10− regionIndicesToDeltas,
115 DynOption (..),
126 dynOptionToLocatedStr,
137 )
@@ -16,66 +10,31 @@ where
1610import qualified SrcLoc as GHC
1711
1812-- | Ormolu configuration.
19−data Config region = Config
13+data Config = Config
2014 { -- | Dynamic options to pass to GHC parser
2115 cfgDynOptions :: ![DynOption],
2216 -- | Do formatting faster but without automatic detection of defects
2317 cfgUnsafe :: !Bool,
2418 -- | Output information useful for debugging
2519 cfgDebug :: !Bool,
26− -- | Checks if re-formatting the result is idempotent
27− cfgCheckIdempotence :: !Bool,
28− -- | Region selection
29− cfgRegion :: !region
30− }
31− deriving (Eq, Show, Functor)
32−
33−-- | Region selection as the combination of start and end line numbers.
34−data RegionIndices = RegionIndices
35− { -- | Start line of the region to format
36− regionStartLine :: !(Maybe Int),
37− -- | End line of the region to format
38− regionEndLine :: !(Maybe Int)
39− }
40− deriving (Eq, Show)
41−
42−-- | Region selection as the length of the literal prefix and the literal
43−-- suffix.
44−data RegionDeltas = RegionDeltas
45− { -- | Prefix length in number of lines
46− regionPrefixLength :: !Int,
47− -- | Suffix length in number of lines
48− regionSuffixLength :: !Int
20+ -- | Do not fail if CPP pragma is present (still doesn't handle CPP but
21+ -- useful for formatting of files that enable the extension without
22+ -- actually containing CPP macros)
23+ cfgTolerateCpp :: !Bool,
24+ -- | Checks if re-formatting the result is idempotent.
25+ cfgCheckIdempotency :: !Bool
4926 }
5027 deriving (Eq, Show)
5128
52−-- | Default @'Config' 'RegionIndices'@.
53−defaultConfig :: Config RegionIndices
29+-- | Default 'Config'.
30+defaultConfig :: Config
5431defaultConfig =
5532 Config
5633 { cfgDynOptions = [],
5734 cfgUnsafe = False,
5835 cfgDebug = False,
59− cfgCheckIdempotence = False,
60− cfgRegion =
61− RegionIndices
62− { regionStartLine = Nothing,
63− regionEndLine = Nothing
64− }
65− }
66−
67−-- | Convert 'RegionIndices' into 'RegionDeltas'.
68−regionIndicesToDeltas ::
69− -- | Total number of lines in the input
70− Int ->
71− -- | Region indices
72− RegionIndices ->
73− -- | Region deltas
74− RegionDeltas
75−regionIndicesToDeltas total RegionIndices {..} =
76− RegionDeltas
77− { regionPrefixLength = maybe 0 (subtract 1) regionStartLine,
78− regionSuffixLength = maybe 0 (total -) regionEndLine
36+ cfgTolerateCpp = False,
37+ cfgCheckIdempotency = False
7938 }
8039
8140-- | A wrapper for dynamic options.
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/Exception.hs+10−3
@@ -19,7 +19,9 @@ import System.IO
1919
2020-- | Ormolu exception representing all cases when Ormolu can fail.
2121data OrmoluException
22− = -- | Parsing of original source code failed
22+ = -- | Ormolu does not work with source files that use CPP
23+ OrmoluCppEnabled FilePath
24+ | -- | Parsing of original source code failed
2325 OrmoluParsingFailed GHC.SrcSpan String
2426 | -- | Parsing of formatted source code failed
2527 OrmoluOutputParsingFailed GHC.SrcSpan String
@@ -33,6 +35,11 @@ data OrmoluException
3335
3436instance Exception OrmoluException where
3537 displayException = \case
38+ OrmoluCppEnabled path ->
39+ unlines
40+ [ "CPP is not supported:",
41+ withIndent path
42+ ]
3643 OrmoluParsingFailed s e ->
3744 showParsingErr "The GHC parser (in Haddock mode) failed:" s [e]
3845 OrmoluOutputParsingFailed s e ->
@@ -74,8 +81,8 @@ withPrettyOrmoluExceptions m = m `catch` h
7481 hPutStrLn stderr (displayException e)
7582 exitWith . ExitFailure $
7683 case e of
77− -- Error code 1 is for 'error' or 'notImplemented'
78− -- 2 used to be for erroring out on CPP
84+ -- Error code 1 is for `error` or `notImplemented`
85+ OrmoluCppEnabled {} -> 2
7986 OrmoluParsingFailed {} -> 3
8087 OrmoluOutputParsingFailed {} -> 4
8188 OrmoluASTDiffers {} -> 5
src/Ormolu/Imports.hs+44−161
@@ -4,199 +4,82 @@
44
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+99−48
@@ -12,11 +12,12 @@ where
1212import Bag (bagToList)
1313import qualified CmdLineParser as GHC
1414import Control.Exception
15+import Control.Monad
1516import Control.Monad.IO.Class
16−import qualified Data.List as L
17+import Data.List ((\\), foldl', isPrefixOf, sortOn)
1718import qualified Data.List.NonEmpty as NE
19+import Data.Maybe (catMaybes)
1820import Data.Ord (Down (Down))
19−import qualified Data.Text as T
2021import DynFlags as GHC
2122import ErrUtils (Severity (..), errMsgSeverity, errMsgSpan)
2223import qualified FastString as GHC
@@ -31,8 +32,7 @@ import Ormolu.Exception
3132import Ormolu.Parser.Anns
3233import Ormolu.Parser.CommentStream
3334import Ormolu.Parser.Result
34−import Ormolu.Processing.Preprocess (preprocess)
35−import Ormolu.Utils (incSpanLine, removeIndentation)
35+import Ormolu.Parser.Shebang
3636import qualified Panic as GHC
3737import qualified Parser as GHC
3838import qualified StringBuffer as GHC
@@ -41,7 +41,7 @@ import qualified StringBuffer as GHC
4141parseModule ::
4242 MonadIO m =>
4343 -- | Ormolu configuration
44− Config RegionDeltas ->
44+ Config ->
4545 -- | File name (only for source location annotations)
4646 FilePath ->
4747 -- | Input for parser
@@ -50,10 +50,8 @@ parseModule ::
5050 ( [GHC.Warn],
5151 Either (SrcSpan, String) ParseResult
5252 )
53−parseModule Config {..} path rawInput = liftIO $ do
54− let (literalPrefix, indentedInput, literalSuffix, extraComments) =
55− preprocess path rawInput cfgRegion
56− (input, indent) = removeIndentation indentedInput
53+parseModule Config {..} path input' = liftIO $ do
54+ let (input, extraComments) = extractCommentsFromLines path input'
5755 -- It's important that 'setDefaultExts' is done before
5856 -- 'parsePragmasIntoDynFlags', because otherwise we might enable an
5957 -- extension that was explicitly disabled in the file.
@@ -63,7 +61,7 @@ parseModule Config {..} path rawInput = liftIO $ do
6361 (setDefaultExts baseDynFlags)
6462 extraOpts = dynOptionToLocatedStr <$> cfgDynOptions
6563 (warnings, dynFlags) <-
66− parsePragmasIntoDynFlags baseFlags extraOpts path rawInput >>= \case
64+ parsePragmasIntoDynFlags baseFlags extraOpts path input' >>= \case
6765 Right res -> pure res
6866 Left err ->
6967 let loc =
@@ -71,6 +69,8 @@ parseModule Config {..} path rawInput = liftIO $ do
7169 (mkSrcLoc (GHC.mkFastString path) 1 1)
7270 (mkSrcLoc (GHC.mkFastString path) 1 1)
7371 in throwIO (OrmoluParsingFailed loc err)
72+ when (GHC.xopt Cpp dynFlags && not cfgTolerateCpp) $
73+ throwIO (OrmoluCppEnabled path)
7474 let useRecordDot =
7575 "record-dot-preprocessor" == pgm_F dynFlags
7676 || any
@@ -78,18 +78,15 @@ parseModule Config {..} path rawInput = liftIO $ do
7878 (pluginModNames dynFlags)
7979 pStateErrors = \pstate ->
8080 let errs = bagToList $ GHC.getErrorMessages pstate dynFlags
81− fixupErrSpan = incSpanLine (regionPrefixLength cfgRegion)
82− in case L.sortOn (Down . SeverityOrd . errMsgSeverity) errs of
81+ in case sortOn (Down . SeverityOrd . errMsgSeverity) errs of
8382 [] -> Nothing
84− err : _ ->
85− -- Show instance returns a short error message
86− Just (fixupErrSpan (errMsgSpan err), show err)
83+ err : _ -> Just (errMsgSpan err, show err) -- Show instance returns a short error message
8784 r = case runParser GHC.parseModule dynFlags path input of
8885 GHC.PFailed pstate ->
8986 case pStateErrors pstate of
9087 Just err -> Left err
91− Nothing -> error "PFailed does not have an error"
92− GHC.POk pstate (L _ hsModule) ->
88+ Nothing -> error "invariant violation: PFailed does not have an error"
89+ GHC.POk pstate pmod ->
9390 case pStateErrors pstate of
9491 -- Some parse errors (pattern/arrow syntax in expr context)
9592 -- do not cause a parse error, but they are replaced with "_"
@@ -98,10 +95,10 @@ parseModule Config {..} path rawInput = liftIO $ do
9895 Just err -> Left err
9996 Nothing ->
10097 let (stackHeader, shebangs, pragmas, comments) =
101− mkCommentStream input extraComments pstate
98+ mkCommentStream extraComments pstate
10299 in Right
103100 ParseResult
104− { prParsedSource = hsModule,
101+ { prParsedSource = pmod,
105102 prAnns = mkAnns pstate,
106103 prStackHeader = stackHeader,
107104 prShebangs = shebangs,
@@ -109,21 +106,10 @@ parseModule Config {..} path rawInput = liftIO $ do
109106 prCommentStream = comments,
110107 prUseRecordDot = useRecordDot,
111108 prImportQualifiedPost =
112− GHC.xopt ImportQualifiedPost dynFlags,
113− prLiteralPrefix = T.pack literalPrefix,
114− prLiteralSuffix = T.pack literalSuffix,
115− prIndent = indent
109+ GHC.xopt ImportQualifiedPost dynFlags
116110 }
117111 return (warnings, r)
118112
119−-- | Enable all language extensions that we think should be enabled by
120−-- default for ease of use.
121−setDefaultExts :: DynFlags -> DynFlags
122−setDefaultExts flags = L.foldl' xopt_set flags autoExts
123− where
124− autoExts = allExts L.\\ manualExts
125− allExts = [minBound .. maxBound]
126−
127113-- | Extensions that are not enabled automatically and should be activated
128114-- by user.
129115manualExts :: [Extension]
@@ -150,6 +136,9 @@ manualExts =
150136 -- decision of enabling this style is left to the user
151137 ]
152138
139+----------------------------------------------------------------------------
140+-- Helpers (taken from ghc-exactprint)
141+
153142-- | Run a 'GHC.P' computation.
154143runParser ::
155144 -- | Computation to run
@@ -168,27 +157,67 @@ runParser parser flags filename input = GHC.unP parser parseState
168157 buffer = GHC.stringToStringBuffer input
169158 parseState = GHC.mkPState flags buffer location
170159
171−-- | Wrap GHC's 'Severity' to add 'Ord' instance.
172−newtype SeverityOrd = SeverityOrd Severity
160+-- | Transform given input possibly returning comments extracted from it.
161+-- This handles LINE pragmas and shebangs.
162+extractCommentsFromLines ::
163+ -- | File name, just to use in the spans
164+ FilePath ->
165+ -- | Contents of that file
166+ String ->
167+ -- | Adjusted input with comments extracted from it
168+ (String, [Located String])
169+extractCommentsFromLines path =
170+ unlines' . unzip . zipWith (extractCommentFromLine path) [1 ..] . lines
171+ where
172+ unlines' (a, b) = (unlines a, catMaybes b)
173173
174−instance Eq SeverityOrd where
175− s1 == s2 = compare s1 s2 == EQ
174+-- | Transform a given line possibly returning a comment extracted from it.
175+extractCommentFromLine ::
176+ -- | File name, just to use in the spans
177+ FilePath ->
178+ -- | Line number of this line
179+ Int ->
180+ -- | The actual line
181+ String ->
182+ -- | Adjusted line and possibly a comment extracted from it
183+ (String, Maybe (Located String))
184+extractCommentFromLine path line s
185+ | "{-# LINE" `isPrefixOf` s =
186+ let (pragma, res) = getPragma s
187+ size = length pragma
188+ ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1))
189+ in (res, Just $ L ss pragma)
190+ | isShebang s =
191+ let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length s))
192+ in ("", Just $ L ss s)
193+ | otherwise = (s, Nothing)
194+ where
195+ mkSrcLoc' = mkSrcLoc (GHC.mkFastString path) line
176196
177−instance Ord SeverityOrd where
178− compare (SeverityOrd s1) (SeverityOrd s2) =
179− compare (f s1) (f s2)
180− where
181− f :: Severity -> Int
182− f SevOutput = 1
183− f SevFatal = 2
184− f SevInteractive = 3
185− f SevDump = 4
186− f SevInfo = 5
187− f SevWarning = 6
188− f SevError = 7
197+-- | Take a line pragma and output its replacement (where line pragma is
198+-- replaced with spaces) and the contents of the pragma itself.
199+getPragma ::
200+ -- | Pragma line to analyze
201+ String ->
202+ -- | Contents of the pragma and its replacement line
203+ (String, String)
204+getPragma [] = error "Ormolu.Parser.getPragma: input must not be empty"
205+getPragma s@(x : xs)
206+ | "#-}" `isPrefixOf` s = ("#-}", " " ++ drop 3 s)
207+ | otherwise =
208+ let (prag, remline) = getPragma xs
209+ in (x : prag, ' ' : remline)
210+
211+-- | Enable all language extensions that we think should be enabled by
212+-- default for ease of use.
213+setDefaultExts :: DynFlags -> DynFlags
214+setDefaultExts flags = foldl' GHC.xopt_set flags autoExts
215+ where
216+ autoExts = allExts \\ manualExts
217+ allExts = [minBound .. maxBound]
189218
190219----------------------------------------------------------------------------
191−-- Helpers taken from HLint
220+-- More helpers (taken from HLint)
192221
193222parsePragmasIntoDynFlags ::
194223 -- | Pre-set 'DynFlags'
@@ -217,3 +246,25 @@ parsePragmasIntoDynFlags flags extraOpts filepath str =
217246 reportErr
218247 (GHC.handleSourceError reportErr act)
219248 reportErr e = return $ Left (show e)
249+
250+----------------------------------------------------------------------------
251+-- Even more helpers
252+
253+-- Wrap GHC's ErrUtils.Severity to add Ord instance
254+newtype SeverityOrd = SeverityOrd Severity
255+
256+instance Eq SeverityOrd where
257+ s1 == s2 = compare s1 s2 == EQ
258+
259+instance Ord SeverityOrd where
260+ compare (SeverityOrd s1) (SeverityOrd s2) =
261+ compare (f s1) (f s2)
262+ where
263+ f :: Severity -> Int
264+ f SevOutput = 1
265+ f SevFatal = 2
266+ f SevInteractive = 3
267+ f SevDump = 4
268+ f SevInfo = 5
269+ f SevWarning = 6
270+ f SevError = 7
src/Ormolu/Parser/CommentStream.hs+60−126
@@ -4,16 +4,12 @@
44
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−9
@@ -7,7 +7,6 @@ module Ormolu.Parser.Result
77 )
88where
99
10−import Data.Text (Text)
1110import GHC
1211import Ormolu.Parser.Anns
1312import Ormolu.Parser.CommentStream
@@ -17,7 +16,7 @@ import Ormolu.Parser.Shebang (Shebang)
1716-- | A collection of data that represents a parsed module in Ormolu.
1817data ParseResult = ParseResult
1918 { -- | 'ParsedSource' from GHC
20− prParsedSource :: HsModule GhcPs,
19+ prParsedSource :: ParsedSource,
2120 -- | Ormolu-specfic representation of annotations
2221 prAnns :: Anns,
2322 -- | Stack header
@@ -31,13 +30,7 @@ data ParseResult = ParseResult
3130 -- | Whether or not record dot syntax is enabled
3231 prUseRecordDot :: Bool,
3332 -- | Whether or not ImportQualifiedPost is enabled
34− prImportQualifiedPost :: Bool,
35− -- | Literal prefix
36− prLiteralPrefix :: Text,
37− -- | Literal suffix
38− prLiteralSuffix :: Text,
39− -- | Indentation level, can be non-zero in case of region formatting
40− prIndent :: Int
33+ prImportQualifiedPost :: Bool
4134 }
4235
4336-- | Pretty-print a 'ParseResult'.
src/Ormolu/Printer.hs+12−17
@@ -11,7 +11,6 @@ import Ormolu.Parser.Result
1111import Ormolu.Printer.Combinators
1212import Ormolu.Printer.Meat.Module
1313import Ormolu.Printer.SpanStream
14−import Ormolu.Processing.Postprocess (postprocess)
1514
1615-- | Render a module.
1716printModule ::
@@ -20,19 +19,15 @@ printModule ::
2019 -- | Resulting rendition
2120 Text
2221printModule ParseResult {..} =
23− prLiteralPrefix <> region <> prLiteralSuffix
24− where
25− region =
26− postprocess prIndent $
27− runR
28− ( p_hsModule
29− prStackHeader
30− prShebangs
31− prPragmas
32− prImportQualifiedPost
33− prParsedSource
34− )
35− (mkSpanStream prParsedSource)
36− prCommentStream
37− prAnns
38− prUseRecordDot
22+ runR
23+ ( p_hsModule
24+ prStackHeader
25+ prShebangs
26+ prPragmas
27+ prImportQualifiedPost
28+ prParsedSource
29+ )
30+ (mkSpanStream prParsedSource)
31+ prCommentStream
32+ prAnns
33+ prUseRecordDot
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+52−46
@@ -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,65 +37,70 @@ 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.
4953spitRemainingComments :: R ()
50−spitRemainingComments = do
51− -- Make sure we have a blank a line between the last definition and the
52− -- trailing comments.
53− newline
54− void $ handleCommentSeries spitRemainingComment
54+spitRemainingComments = void $ handleCommentSeries spitRemainingComment
5555
5656----------------------------------------------------------------------------
5757-- Single-comment functions
5858
5959-- | Output a single preceding comment for an element at given location.
6060spitPrecedingComment ::
61− -- | Span of the element to attach comments to
62− RealSrcSpan ->
61+ Data a =>
62+ -- | AST element to attach comments to
63+ RealLocated a ->
64+ -- | Location of last comment in the series
65+ Maybe SpanMark ->
6366 -- | Are we done?
6467 R Bool
65−spitPrecedingComment ref = do
66− mlastMark <- getSpanMark
68+spitPrecedingComment (L ref a) mlastMark = do
6769 let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref
6870 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
71+ dirtyLine <-
72+ case mlastMark of
73+ -- When the current line is dirty it means that something that can
74+ -- have comments attached to it is already on the line. To avoid
75+ -- problems with idempotence we cannot output the first comment
76+ -- immediately because it'll be attached to the previous element (on
77+ -- the same line) on the next run, so we play safe here and output
78+ -- an extra 'newline' in this case.
79+ Nothing -> isLineDirty -- only for very first preceding comment
80+ Just _ -> return False
81+ when (dirtyLine || needsNewlineBefore l mlastMark) newline
7682 spitCommentNow l comment
77− if theSameLinePre l ref
83+ if theSameLinePre l ref && not (isModule a)
7884 then space
7985 else newline
8086
8187-- | Output a comment that follows element at given location immediately on
8288-- the same line, if there is any.
8389spitFollowingComment ::
90+ Data a =>
8491 -- | AST element to attach comments to
85− RealSrcSpan ->
92+ RealLocated a ->
93+ -- | Location of last comment in the series
94+ Maybe SpanMark ->
8695 -- | Are we done?
8796 R Bool
88−spitFollowingComment ref = do
89− mlastMark <- getSpanMark
97+spitFollowingComment (L ref a) mlastMark = do
9098 mnSpn <- nextEltSpan
9199 -- Get first enclosing span that is not equal to reference span, i.e. it's
92100 -- truly something enclosing the AST element.
93101 meSpn <- getEnclosingSpan (/= ref)
94102 withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment ->
95− if theSameLinePost l ref
103+ if theSameLinePost l ref && not (isModule a)
96104 then
97105 if isMultilineComment comment
98106 then space >> spitCommentNow l comment
@@ -104,10 +112,11 @@ spitFollowingComment ref = do
104112
105113-- | Output a single remaining comment from the comment stream.
106114spitRemainingComment ::
115+ -- | Location of last comment in the series
116+ Maybe SpanMark ->
107117 -- | Are we done?
108118 R Bool
109−spitRemainingComment = do
110− mlastMark <- getSpanMark
119+spitRemainingComment mlastMark =
111120 withPoppedComment (const True) $ \l comment -> do
112121 when (needsNewlineBefore l mlastMark) newline
113122 spitCommentNow l comment
@@ -120,13 +129,13 @@ spitRemainingComment = do
120129handleCommentSeries ::
121130 -- | Given location of previous comment, output the next comment
122131 -- returning 'True' if we're done
123− R Bool ->
132+ (Maybe SpanMark -> R Bool) ->
124133 -- | Whether we printed any comments
125134 R Bool
126135handleCommentSeries f = go False
127136 where
128137 go gotSome = do
129− done <- f
138+ done <- getSpanMark >>= f
130139 if done
131140 then return gotSome
132141 else go True
@@ -154,7 +163,6 @@ needsNewlineBefore ::
154163 -- | Last printed comment span
155164 Maybe SpanMark ->
156165 Bool
157−needsNewlineBefore _ (Just (HaddockSpan _ _)) = True
158166needsNewlineBefore l mlastMark =
159167 case spanMarkSpan <$> mlastMark of
160168 Nothing -> False
@@ -207,8 +215,9 @@ commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =
207215 -- 2) The comment logically belongs to the element, four cases:
208216 logicallyFollows =
209217 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
218+ || isPrevHaddock comment -- b) it's a Haddock string starting with -- ^
219+ || continuation -- c) it's a continuation of a comment block
220+ || lastInEnclosing -- d) it's the last element in the enclosing construct
212221
213222 -- 3) There is no other AST element between this element and the comment:
214223 noEltBetween =
@@ -235,15 +244,12 @@ commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =
235244 >= abs (startColumn ref - startColumn l)
236245 )
237246 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− )
247+ case mlastMark of
248+ Just (HaddockSpan _ spn) ->
249+ srcSpanEndLine spn + 1 == srcSpanStartLine l
250+ Just (CommentSpan spn) ->
251+ srcSpanEndLine spn + 1 == srcSpanStartLine l
252+ _ -> False
247253 lastInEnclosing =
248254 case meSpn of
249255 -- When there is no enclosing element, return false
@@ -265,7 +271,7 @@ spitCommentNow spn comment = do
265271 . sequence_
266272 . NE.intersperse newline
267273 . fmap (txt . T.pack)
268− . unComment
274+ . coerce
269275 $ comment
270276 setSpanMark (CommentSpan spn)
271277
@@ -281,6 +287,6 @@ spitCommentPending position spn comment = do
281287 . sequence_
282288 . NE.toList
283289 . fmap (registerPendingCommentLine position . T.pack)
284− . unComment
290+ . coerce
285291 $ comment
286292 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+166−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,34 @@ 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
476+ -- Assigns 'False' to the last element, 'True' to the rest.
477+ markInit :: [a] -> [(Bool, a)]
478+ markInit [] = []
479+ markInit [x] = [(False, x)]
480+ markInit (x : xs) = (True, x) : markInit xs
474481 -- When in a single-line layout, there is a chance that the inner
475482 -- elements will also contain semicolons and they will confuse the
476483 -- parser. so we request braces around every element except the last.
477484 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)
485+ sitcc $
486+ sepSemi
487+ (\(m, i) -> (if m then br else id) $ p_item i)
488+ (markInit $ sortOn ssStart items)
492489 HsValBinds NoExtField _ -> notImplemented "HsValBinds"
493490 HsIPBinds NoExtField (IPBinds NoExtField xs) ->
494491 -- Second argument of IPBind is always Left before type-checking.
495492 let p_ipBind (IPBind NoExtField (Left name) expr) = do
496493 atom name
497494 space
498− equals
495+ txt "="
499496 breakpoint
500497 useBraces $ inci $ located expr p_hsExpr
501498 p_ipBind (IPBind NoExtField (Right _) _) =
@@ -514,12 +511,15 @@ p_hsRecField HsRecField {..} = do
514511 p_rdrName hsRecFieldLbl
515512 unless hsRecPun $ do
516513 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)
514+ txt "="
515+ let placement = exprPlacement (unLoc hsRecFieldArg)
516+ placeHanging placement $ located hsRecFieldArg p_hsExpr
517+
518+p_hsTupArg :: HsTupArg GhcPs -> R ()
519+p_hsTupArg = \case
520+ Present NoExtField x -> located x p_hsExpr
521+ Missing NoExtField -> pure ()
522+ XTupArg x -> noExtCon x
523523
524524p_hsExpr :: HsExpr GhcPs -> R ()
525525p_hsExpr = p_hsExpr' N
@@ -584,21 +584,23 @@ p_hsExpr' s = \case
584584 -- do-block or case expression it is not a good idea. It seems
585585 -- to be safe to always bump indentation when the function
586586 -- expression is parenthesised.
587− doIndent =
587+ indent =
588588 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
589+ L _ (HsPar NoExtField _) -> inci
590+ L _ (HsAppType NoExtField _ _) -> inci
591+ L _ (HsMultiIf NoExtField _) -> inci
592+ L spn _ ->
593+ if isOneLineSpan spn
594+ then inci
595+ else id
596+ ub <- getLayout <&> \case
597+ SingleLine -> useBraces
598+ MultiLine -> id
597599 ub $ do
598600 located func (p_hsExpr' s)
599601 breakpoint
600− inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp
601− inciIf doIndent $ do
602+ indent $ sep breakpoint (located' p_hsExpr) initp
603+ indent $ do
602604 unless (null initp) breakpoint
603605 located lastp p_hsExpr
604606 Hanging -> do
@@ -613,15 +615,10 @@ p_hsExpr' s = \case
613615 breakpoint
614616 inci $ do
615617 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 ()
621618 located (hswc_body a) p_hsType
622619 OpApp NoExtField x op y -> do
623620 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)
624− p_exprOpTree s (reassociateOpTree getOpName opTree)
621+ p_exprOpTree True s (reassociateOpTree getOpName opTree)
625622 NegApp NoExtField e _ -> do
626623 txt "-"
627624 space
@@ -638,27 +635,22 @@ p_hsExpr' s = \case
638635 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)
639636 unless (useRecordDot' && isRecordDot') breakpoint
640637 inci (located x p_hsExpr)
641− ExplicitTuple NoExtField args boxity ->
638+ ExplicitTuple NoExtField args boxity -> do
642639 let isSection = any (isMissing . unLoc) args
643640 isMissing = \case
644641 Missing NoExtField -> True
645642 _ -> 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' =
643+ let parens' =
652644 case boxity of
653645 Boxed -> parens
654646 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
647+ if isSection
648+ then
649+ switchLayout [] . parens' s $
650+ sep comma (located' p_hsTupArg) args
651+ else
652+ switchLayout (getLoc <$> args) . parens' s . sitcc $
653+ sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
662654 ExplicitSum NoExtField tag arity e ->
663655 p_unboxedSum N tag arity (located e p_hsExpr)
664656 HsCase NoExtField e mgroup ->
@@ -666,9 +658,8 @@ p_hsExpr' s = \case
666658 HsIf NoExtField _ if' then' else' ->
667659 p_if exprPlacement p_hsExpr if' then' else'
668660 HsMultiIf NoExtField guards -> do
669− txt "if"
670− breakpoint
671− inci . inci $ sep newline (located' (p_grhs RightArrow)) guards
661+ txt "if "
662+ inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards
672663 HsLet NoExtField localBinds e ->
673664 p_let p_hsExpr localBinds e
674665 HsDo NoExtField ctx es -> do
@@ -680,15 +671,15 @@ p_hsExpr' s = \case
680671 sepSemi
681672 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))
682673 (unLoc es)
683− compBody = brackets N . located es $ \xs -> do
674+ compBody = brackets N $ located es $ \xs -> do
684675 let p_parBody =
685676 sep
686− (breakpoint >> txt "|" >> space)
677+ (breakpoint >> txt "| ")
687678 p_seqBody
688679 p_seqBody =
689680 sitcc
690681 . sep
691− commaDel
682+ (comma >> breakpoint)
692683 (located' (sitcc . p_stmt))
693684 stmts = init xs
694685 yield = last xs
@@ -709,8 +700,8 @@ p_hsExpr' s = \case
709700 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
710701 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
711702 ExplicitList _ _ xs ->
712− brackets s $
713− sep commaDel (sitcc . located' p_hsExpr) xs
703+ brackets s . sitcc $
704+ sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs
714705 RecordCon {..} -> do
715706 located rcon_con_name atom
716707 breakpoint
@@ -726,8 +717,8 @@ p_hsExpr' s = \case
726717 case rec_dotdot of
727718 Just {} -> [txt ".."]
728719 Nothing -> []
729− inci . braces N $
730− sep commaDel sitcc (fields <> dotdot)
720+ inci . braces N . sitcc $
721+ sep (comma >> breakpoint) sitcc (fields <> dotdot)
731722 RecordUpd {..} -> do
732723 located rupd_expr p_hsExpr
733724 useRecordDot' <- useRecordDot
@@ -745,9 +736,9 @@ p_hsExpr' s = \case
745736 Unambiguous _ n -> n
746737 XAmbiguousFieldOcc x -> noExtCon x
747738 }
748− inci . braces N $
739+ inci . braces N . sitcc $
749740 sep
750− commaDel
741+ (comma >> breakpoint)
751742 (sitcc . located' (p_hsRecField . updName))
752743 rupd_flds
753744 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do
@@ -760,22 +751,22 @@ p_hsExpr' s = \case
760751 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x
761752 ArithSeq NoExtField _ x ->
762753 case x of
763− From from -> brackets s $ do
754+ From from -> brackets s . sitcc $ do
764755 located from p_hsExpr
765756 breakpoint
766757 txt ".."
767− FromThen from next -> brackets s $ do
768− sep commaDel (located' p_hsExpr) [from, next]
758+ FromThen from next -> brackets s . sitcc $ do
759+ sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
769760 breakpoint
770761 txt ".."
771− FromTo from to -> brackets s $ do
762+ FromTo from to -> brackets s . sitcc $ do
772763 located from p_hsExpr
773764 breakpoint
774765 txt ".."
775766 space
776767 located to p_hsExpr
777− FromThenTo from next to -> brackets s $ do
778− sep commaDel (located' p_hsExpr) [from, next]
768+ FromThenTo from next to -> brackets s . sitcc $ do
769+ sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
779770 breakpoint
780771 txt ".."
781772 space
@@ -825,7 +816,7 @@ p_patSynBind PSB {..} = do
825816 breakpoint
826817 located psb_def p_pat
827818 ImplicitBidirectional -> do
828− equals
819+ txt "="
829820 breakpoint
830821 located psb_def p_pat
831822 ExplicitBidirectional mgroup -> do
@@ -852,8 +843,8 @@ p_patSynBind PSB {..} = do
852843 inci $ do
853844 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do
854845 unless (null xs) breakpoint
855− braces N $
856− sep commaDel (p_rdrName . recordPatSynPatVar) xs
846+ braces N . sitcc $
847+ sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs
857848 rhs
858849 InfixCon l r -> do
859850 switchLayout [getLoc l, getLoc r] $ do
@@ -907,12 +898,10 @@ p_if placer render if' then' else' = do
907898 breakpoint
908899 inci $ do
909900 txt "then"
910− space
911901 located then' $ \x ->
912902 placeHanging (placer x) (render x)
913903 breakpoint
914904 txt "else"
915− space
916905 located else' $ \x ->
917906 placeHanging (placer x) (render x)
918907
@@ -949,13 +938,13 @@ p_pat = \case
949938 txt "!"
950939 located pat p_pat
951940 ListPat NoExtField pats ->
952− brackets S $ sep commaDel (located' p_pat) pats
941+ brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats
953942 TuplePat NoExtField pats boxing -> do
954− let parens' =
943+ let f =
955944 case boxing of
956945 Boxed -> parens S
957946 Unboxed -> parensHash S
958− parens' $ sep commaDel (sitcc . located' p_pat) pats
947+ f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
959948 SumPat NoExtField pat tag arity ->
960949 p_unboxedSum S tag arity (located pat p_pat)
961950 ConPatIn pat details ->
@@ -971,7 +960,7 @@ p_pat = \case
971960 let f = \case
972961 Nothing -> txt ".."
973962 Just x -> located x p_pat_hsRecField
974− inci . braces N . sep commaDel f $
963+ inci . braces N . sitcc . sep (comma >> breakpoint) f $
975964 case dotdot of
976965 Nothing -> Just <$> fields
977966 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]
@@ -1012,7 +1001,7 @@ p_pat_hsRecField HsRecField {..} = do
10121001 p_rdrName (rdrNameFieldOcc x)
10131002 unless hsRecPun $ do
10141003 space
1015− equals
1004+ txt "="
10161005 breakpoint
10171006 inci (located hsRecFieldArg p_pat)
10181007
@@ -1021,15 +1010,17 @@ p_unboxedSum s tag arity m = do
10211010 let before = tag - 1
10221011 after = arity - before - 1
10231012 args = replicate before Nothing <> [Just m] <> replicate after Nothing
1024− f x =
1013+ f (x, i) = do
1014+ let isFirst = i == 0
1015+ isLast = i == arity - 1
10251016 case x :: Maybe (R ()) of
10261017 Nothing ->
1027− space
1018+ unless (isFirst || isLast) space
10281019 Just m' -> do
1029− space
1020+ unless isFirst space
10301021 m'
1031− space
1032− parensHash s $ sep (txt "|") f args
1022+ unless isLast space
1023+ parensHash s $ sep (txt "|") f (zip args [0 ..])
10331024
10341025p_hsSplice :: HsSplice GhcPs -> R ()
10351026p_hsSplice = \case
@@ -1231,10 +1222,11 @@ exprPlacement = \case
12311222 HsCase NoExtField _ _ -> Hanging
12321223 HsDo NoExtField DoExpr _ -> Hanging
12331224 HsDo NoExtField MDoExpr _ -> Hanging
1234− OpApp NoExtField _ op y ->
1235− case (fmap getOpNameStr . getOpName . unLoc) op of
1236− Just "$" -> exprPlacement (unLoc y)
1237− _ -> Normal
1225+ -- If the rightmost expression in an operator chain is hanging, make the
1226+ -- whole block hanging; so that we can use the common @f = foo $ do@
1227+ -- style.
1228+ OpApp NoExtField _ _ y -> exprPlacement (unLoc y)
1229+ -- Same thing for function applications (usually with -XBlockArguments)
12381230 HsApp NoExtField _ y -> exprPlacement (unLoc y)
12391231 HsProc NoExtField p _ ->
12401232 -- Indentation breaks if pattern is longer than one line and left
@@ -1260,16 +1252,15 @@ getOpName = \case
12601252 HsVar NoExtField (L _ a) -> Just a
12611253 _ -> Nothing
12621254
1263−getOpNameStr :: RdrName -> String
1264−getOpNameStr = occNameString . rdrNameOcc
1265−
12661255p_exprOpTree ::
1256+ -- | Can use special handling of dollar?
1257+ Bool ->
12671258 -- | Bracket style to use
12681259 BracketStyle ->
12691260 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
12701261 R ()
1271−p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)
1272−p_exprOpTree s (OpBranch x op y) = do
1262+p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)
1263+p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
12731264 -- If the beginning of the first argument and the second argument are on
12741265 -- the same line, and the second argument has a hanging form, use hanging
12751266 -- placement.
@@ -1291,54 +1282,44 @@ p_exprOpTree s (OpBranch x op y) = do
12911282 MultiLine -> case placement of
12921283 Hanging -> useBraces
12931284 Normal -> dontUseBraces
1294− opNameStr = (fmap getOpNameStr . getOpName . unLoc) op
1295− gotDollar = opNameStr == Just "$"
1296− gotColon = opNameStr == Just ":"
1297− gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)
1285+ gotDollar = case getOpName (unLoc op) of
1286+ Just rname -> mkVarOcc "$" == rdrNameOcc rname
1287+ _ -> False
12981288 lhs =
12991289 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)
1290+ p_exprOpTree (not gotDollar) s x
1291+ let p_op = located op (opWrapper . p_hsExpr)
1292+ p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)
13031293 isSection = case (opTreeLoc x, getLoc op) of
13041294 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->
13051295 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan
13061296 _ -> False
1307− isDoBlock = \case
1308− OpNode (L _ HsDo {}) -> True
1309− _ -> False
13101297 useRecordDot' <- useRecordDot
1311− if
1312− | gotColon -> do
1313− lhs
1314− space
1315− p_op
1316− case placement of
1317− Hanging -> do
1298+ let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)
1299+ if useRecordDot' && isRecordDot'
1300+ then do
1301+ lhs
1302+ when isSection space
1303+ p_op
1304+ p_y
1305+ else
1306+ if isDollarSpecial
1307+ && gotDollar
1308+ && placement
1309+ == Normal
1310+ && isOneLineSpan (opTreeLoc x)
1311+ then do
1312+ useBraces lhs
1313+ space
1314+ p_op
1315+ breakpoint
1316+ inci p_y
1317+ else do
1318+ ub lhs
1319+ placeHanging placement $ do
1320+ p_op
13181321 space
13191322 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
13421323
13431324-- | Return 'True' if given expression is a record-dot operator expression.
13441325isRecordDot ::
@@ -1349,10 +1330,14 @@ isRecordDot ::
13491330 Bool
13501331isRecordDot op (RealSrcSpan ySpan) = case op of
13511332 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->
1352− (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
1333+ isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
13531334 _ -> False
13541335isRecordDot _ _ = False
13551336
1337+-- | Check whether a given 'RdrName' is the dot operator.
1338+isDot :: RdrName -> Bool
1339+isDot name = rdrNameOcc name == mkVarOcc "."
1340+
13561341-- | Get annotations for the enclosing element.
13571342getEnclosingAnns :: R [AnnKeywordId]
13581343getEnclosingAnns = 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+8−5
@@ -27,14 +27,17 @@ p_warnDecl (XWarnDecl x) = noExtCon x
2727p_moduleWarning :: WarningTxt -> R ()
2828p_moduleWarning wtxt = do
2929 let (pragmaText, lits) = warningText wtxt
30− inci $ pragma pragmaText $ inci $ p_lits lits
30+ switchLayout (getLoc <$> lits)
31+ $ inci
32+ $ pragma pragmaText (inci $ p_lits lits)
3133
3234p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()
3335p_topLevelWarning fnames wtxt = do
3436 let (pragmaText, lits) = warningText wtxt
35− switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $
36− pragma pragmaText . inci $ do
37− sep commaDel p_rdrName fnames
37+ switchLayout (fmap getLoc fnames ++ fmap getLoc lits)
38+ $ pragma pragmaText . inci
39+ $ do
40+ sitcc $ sep (comma >> breakpoint) p_rdrName fnames
3841 breakpoint
3942 p_lits lits
4043
@@ -46,4 +49,4 @@ warningText = \case
4649p_lits :: [Located StringLiteral] -> R ()
4750p_lits = \case
4851 [l] -> atom l
49− ls -> brackets N $ sep commaDel atom ls
52+ ls -> brackets N . sitcc $ sep (comma >> breakpoint) atom ls
src/Ormolu/Printer/Meat/ImportExport.hs+20−26
@@ -13,7 +13,6 @@ import Control.Monad
1313import GHC
1414import Ormolu.Printer.Combinators
1515import Ormolu.Printer.Meat.Common
16−import Ormolu.Utils (RelativePos (..), attachRelativePos)
1716
1817p_hsmodExports :: [LIE GhcPs] -> R ()
1918p_hsmodExports [] = do
@@ -21,12 +20,9 @@ p_hsmodExports [] = do
2120 breakpoint'
2221 txt ")"
2322p_hsmodExports xs =
24− parens N $ do
23+ parens N . sitcc $ do
2524 layout <- getLayout
26− sep
27− breakpoint
28− (\(p, l) -> sitcc (located l (p_lie layout p)))
29− (attachRelativePos xs)
25+ sep breakpoint (sitcc . located' (uncurry (p_lie layout))) (attachPositions xs)
3026
3127p_hsmodImport :: Bool -> ImportDecl GhcPs -> R ()
3228p_hsmodImport useQualifiedPost ImportDecl {..} = do
@@ -65,17 +61,14 @@ p_hsmodImport useQualifiedPost ImportDecl {..} = do
6561 Nothing -> return ()
6662 Just (_, L _ xs) -> do
6763 breakpoint
68− parens N $ do
64+ parens N . sitcc $ do
6965 layout <- getLayout
70− sep
71− breakpoint
72− (\(p, l) -> sitcc (located l (p_lie layout p)))
73− (attachRelativePos xs)
66+ sep breakpoint (sitcc . located' (uncurry (p_lie layout))) (attachPositions xs)
7467 newline
7568p_hsmodImport _ (XImportDecl x) = noExtCon x
7669
77−p_lie :: Layout -> RelativePos -> IE GhcPs -> R ()
78−p_lie encLayout relativePos = \case
70+p_lie :: Layout -> (Int, Int) -> IE GhcPs -> R ()
71+p_lie encLayout (i, totalItems) = \case
7972 IEVar NoExtField l1 -> do
8073 located l1 p_ieWrappedName
8174 p_comma
@@ -93,8 +86,9 @@ p_lie encLayout relativePos = \case
9386 inci $ do
9487 let names :: [R ()]
9588 names = located' p_ieWrappedName <$> xs
96− parens N . sep commaDel sitcc $
97− case w of
89+ parens N . sitcc
90+ $ sep (comma >> breakpoint) sitcc
91+ $ case w of
9892 NoIEWildcard -> names
9993 IEWildcard n ->
10094 let (before, after) = splitAt n names
@@ -104,11 +98,7 @@ p_lie encLayout relativePos = \case
10498 located l1 p_hsmodName
10599 p_comma
106100 IEGroup NoExtField n str -> do
107− case relativePos of
108− SinglePos -> return ()
109− FirstPos -> return ()
110− MiddlePos -> newline
111− LastPos -> newline
101+ unless (i == 0) newline
112102 p_hsDocString (Asterisk n) False (noLoc str)
113103 IEDoc NoExtField str ->
114104 p_hsDocString Pipe False (noLoc str)
@@ -117,10 +107,14 @@ p_lie encLayout relativePos = \case
117107 where
118108 p_comma =
119109 case encLayout of
120− SingleLine ->
121− case relativePos of
122− SinglePos -> return ()
123− FirstPos -> comma
124− MiddlePos -> comma
125− LastPos -> return ()
110+ SingleLine -> unless (i + 1 == totalItems) comma
126111 MultiLine -> comma
112+
113+-- | Attach positions to 'Located' things in a list.
114+attachPositions ::
115+ [Located a] ->
116+ [Located ((Int, Int), a)]
117+attachPositions xs =
118+ let f i (L l x) = L l ((i, n), x)
119+ n = length xs
120+ in zipWith f [0 ..] xs
src/Ormolu/Printer/Meat/Module.hs+15−12
@@ -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,12 +34,16 @@ 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
40− let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage
41− exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports
42− switchLayout (deprecSpan <> exportSpans) $ do
39+p_hsModule mstackHeader shebangs pragmas qualifiedPost (L moduleSpan HsModule {..}) = do
40+ -- If span of exports in multiline, the whole thing is multiline. This is
41+ -- especially important because span of module itself always seems to have
42+ -- length zero, so it's not reliable for layout selection.
43+ let exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports
44+ deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage
45+ spans' = exportSpans ++ deprecSpan ++ [moduleSpan]
46+ switchLayout spans' $ do
4347 forM_ shebangs $ \(Shebang x) ->
4448 located x $ \shebang -> do
4549 txt (T.pack shebang)
@@ -56,20 +60,19 @@ p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do
5660 located hsmodName' $ \name -> do
5761 forM_ hsmodHaddockModHeader (p_hsDocString Pipe True)
5862 p_hsmodName name
59− breakpoint
6063 forM_ hsmodDeprecMessage $ \w -> do
61− located' p_moduleWarning w
6264 breakpoint
65+ located' p_moduleWarning w
6366 case hsmodExports of
6467 Nothing -> return ()
65− Just l -> do
66− located l $ \exports -> do
67− inci (p_hsmodExports exports)
68+ Just hsmodExports' -> do
6869 breakpoint
70+ inci (p_hsmodExports (unLoc hsmodExports'))
71+ breakpoint
6972 txt "where"
7073 newline
7174 newline
72− forM_ (normalizeImports hsmodImports) (located' (p_hsmodImport qualifiedPost))
75+ forM_ (sortImports hsmodImports) (located' (p_hsmodImport qualifiedPost))
7376 newline
7477 switchLayout (getLoc <$> hsmodDecls) $ do
7578 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.hsdeleted−27
@@ -1,27 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−-- | Common definitions for pre- and post- processing.
4−module Ormolu.Processing.Common
5− ( OrmoluState (..),
6− startDisabling,
7− endDisabling,
8− )
9−where
10−
11−import Data.String (IsString (..))
12−
13−-- | Ormolu state.
14−data OrmoluState
15− = -- | Enabled
16− OrmoluEnabled
17− | -- | Disabled
18− OrmoluDisabled
19− deriving (Eq, Show)
20−
21−-- | Marker for the beginning of the region where Ormolu should be disabled.
22−startDisabling :: IsString s => s
23−startDisabling = "{- ORMOLU_DISABLE_START"
24−
25−-- | Marker for the end of the region where Ormolu should be disabled.
26−endDisabling :: IsString s => s
27−endDisabling = "ORMOLU_DISABLE_END -}"
src/Ormolu/Processing/Cpp.hsdeleted−70
@@ -1,70 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−-- | Support for CPP.
4−module Ormolu.Processing.Cpp
5− ( State (..),
6− processLine,
7− unmaskLine,
8− )
9−where
10−
11−import Control.Monad
12−import Data.Char (isSpace)
13−import qualified Data.List as L
14−import Data.Maybe (isJust)
15−import Data.String
16−import Data.Text (Text)
17−import qualified Data.Text as T
18−
19−-- | State of the CPP processor.
20−data State
21− = -- | Outside of CPP directives
22− Outside
23− | -- | In a conditional expression
24− InConditional
25− | -- | In a continuation (after @\\@)
26− InContinuation
27− deriving (Eq, Show)
28−
29−-- | Automatically mask the line when needed and update the 'State'.
30−processLine :: String -> State -> (String, State)
31−processLine line state
32− | for "define " = (masked, state')
33− | for "include " = (masked, state')
34− | for "undef " = (masked, state')
35− | for "ifdef " = (masked, InConditional)
36− | for "ifndef " = (masked, InConditional)
37− | for "if " = (masked, InConditional)
38− | for "else" = (masked, InConditional)
39− | for "elif" = (masked, InConditional)
40− | for "endif" = (masked, state')
41− | otherwise =
42− case state of
43− Outside -> (line, Outside)
44− InConditional -> (masked, InConditional)
45− InContinuation -> (masked, state')
46− where
47− for directive = isJust $ do
48− s <- dropWhile isSpace <$> L.stripPrefix "#" line
49− void (L.stripPrefix directive s)
50− masked = maskLine line
51− state' =
52− if "\\" `L.isSuffixOf` line
53− then InContinuation
54− else Outside
55−
56−-- | Mask the given line.
57−maskLine :: String -> String
58−maskLine x = maskPrefix ++ x
59−
60−-- | If the given line is masked, unmask it. Otherwise return the line
61−-- unchanged.
62−unmaskLine :: Text -> Text
63−unmaskLine x =
64− case T.stripPrefix maskPrefix (T.stripStart x) of
65− Nothing -> x
66− Just x' -> x'
67−
68−-- | Mask prefix for CPP.
69−maskPrefix :: IsString s => s
70−maskPrefix = "-- ORMOLU_CPP_MASK"
src/Ormolu/Processing/Postprocess.hsdeleted−31
@@ -1,31 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE ViewPatterns #-}
3−
4−-- | Postprocessing for the results of printing.
5−module Ormolu.Processing.Postprocess
6− ( postprocess,
7− )
8−where
9−
10−import Data.Text (Text)
11−import qualified Data.Text as T
12−import Ormolu.Processing.Common
13−import qualified Ormolu.Processing.Cpp as Cpp
14−
15−-- | Postprocess output of the formatter.
16−postprocess ::
17− -- | Desired indentation level
18− Int ->
19− -- | Input to process
20− Text ->
21− Text
22−postprocess indent =
23− T.unlines
24− . fmap indentLine
25− . fmap Cpp.unmaskLine
26− . filter (not . magicComment)
27− . T.lines
28− where
29− magicComment (T.stripStart -> x) =
30− x == startDisabling || x == endDisabling
31− indentLine x = T.replicate indent " " <> x
src/Ormolu/Processing/Preprocess.hsdeleted−149
@@ -1,149 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE LambdaCase #-}
3−{-# LANGUAGE RecordWildCards #-}
4−
5−-- | Preprocessing for input source code.
6−module Ormolu.Processing.Preprocess
7− ( preprocess,
8− )
9−where
10−
11−import Control.Monad
12−import Data.Char (isSpace)
13−import qualified Data.List as L
14−import Data.Maybe (isJust, maybeToList)
15−import FastString
16−import Ormolu.Config (RegionDeltas (..))
17−import Ormolu.Parser.Shebang (isShebang)
18−import Ormolu.Processing.Common
19−import qualified Ormolu.Processing.Cpp as Cpp
20−import SrcLoc
21−
22−-- | Transform given input possibly returning comments extracted from it.
23−-- This handles LINE pragmas, CPP, shebangs, and the magic comments for
24−-- enabling\/disabling of Ormolu.
25−preprocess ::
26− -- | File name, just to use in the spans
27− FilePath ->
28− -- | Input to process
29− String ->
30− -- | Region deltas
31− RegionDeltas ->
32− -- | Literal prefix, pre-processed input, literal suffix, extra comments
33− (String, String, String, [Located String])
34−preprocess path input RegionDeltas {..} =
35− go 1 OrmoluEnabled Cpp.Outside id id regionLines
36− where
37− (prefixLines, otherLines) = splitAt regionPrefixLength (lines input)
38− (regionLines, suffixLines) =
39− let regionLength = length otherLines - regionSuffixLength
40− in splitAt regionLength otherLines
41− go !n ormoluState cppState inputSoFar csSoFar = \case
42− [] ->
43− let input' = unlines (inputSoFar [])
44− in ( unlines prefixLines,
45− case ormoluState of
46− OrmoluEnabled -> input'
47− OrmoluDisabled -> input' ++ endDisabling,
48− unlines suffixLines,
49− csSoFar []
50− )
51− (x : xs) ->
52− let (x', ormoluState', cppState', cs) =
53− processLine path n ormoluState cppState x
54− in go
55− (n + 1)
56− ormoluState'
57− cppState'
58− (inputSoFar . (x' :))
59− (csSoFar . (maybeToList cs ++))
60− xs
61−
62−-- | Transform a given line possibly returning a comment extracted from it.
63−processLine ::
64− -- | File name, just to use in the spans
65− FilePath ->
66− -- | Line number of this line
67− Int ->
68− -- | Whether Ormolu is currently enabled
69− OrmoluState ->
70− -- | CPP state
71− Cpp.State ->
72− -- | The actual line
73− String ->
74− -- | Adjusted line and possibly a comment extracted from it
75− (String, OrmoluState, Cpp.State, Maybe (Located String))
76−processLine path n ormoluState Cpp.Outside line
77− | "{-# LINE" `L.isPrefixOf` line =
78− let (pragma, res) = getPragma line
79− size = length pragma
80− ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1))
81− in (res, ormoluState, Cpp.Outside, Just (L ss pragma))
82− | isOrmoluEnable line =
83− case ormoluState of
84− OrmoluEnabled ->
85− (enableMarker, OrmoluEnabled, Cpp.Outside, Nothing)
86− OrmoluDisabled ->
87− (endDisabling ++ enableMarker, OrmoluEnabled, Cpp.Outside, Nothing)
88− | isOrmoluDisable line =
89− case ormoluState of
90− OrmoluEnabled ->
91− (disableMarker ++ startDisabling, OrmoluDisabled, Cpp.Outside, Nothing)
92− OrmoluDisabled ->
93− (disableMarker, OrmoluDisabled, Cpp.Outside, Nothing)
94− | isShebang line =
95− let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length line))
96− in ("", ormoluState, Cpp.Outside, Just (L ss line))
97− | otherwise =
98− let (line', cppState') = Cpp.processLine line Cpp.Outside
99− in (line', ormoluState, cppState', Nothing)
100− where
101− mkSrcLoc' = mkSrcLoc (mkFastString path) n
102−processLine _ _ ormoluState cppState line =
103− let (line', cppState') = Cpp.processLine line cppState
104− in (line', ormoluState, cppState', Nothing)
105−
106−-- | Take a line pragma and output its replacement (where line pragma is
107−-- replaced with spaces) and the contents of the pragma itself.
108−getPragma ::
109− -- | Pragma line to analyze
110− String ->
111− -- | Contents of the pragma and its replacement line
112− (String, String)
113−getPragma [] = error "Ormolu.Preprocess.getPragma: input must not be empty"
114−getPragma s@(x : xs)
115− | "#-}" `L.isPrefixOf` s = ("#-}", " " ++ drop 3 s)
116− | otherwise =
117− let (prag, remline) = getPragma xs
118− in (x : prag, ' ' : remline)
119−
120−-- | Canonical enable marker.
121−enableMarker :: String
122−enableMarker = "{- ORMOLU_ENABLE -}"
123−
124−-- | Canonical disable marker.
125−disableMarker :: String
126−disableMarker = "{- ORMOLU_DISABLE -}"
127−
128−-- | Return 'True' if the given string is an enabling marker.
129−isOrmoluEnable :: String -> Bool
130−isOrmoluEnable = magicComment "ORMOLU_ENABLE"
131−
132−-- | Return 'True' if the given string is a disabling marker.
133−isOrmoluDisable :: String -> Bool
134−isOrmoluDisable = magicComment "ORMOLU_DISABLE"
135−
136−-- | Construct a function for whitespace-insensitive matching of string.
137−magicComment ::
138− -- | What to expect
139− String ->
140− -- | String to test
141− String ->
142− -- | Whether or not the two strings watch
143− Bool
144−magicComment expected s0 = isJust $ do
145− let trim = dropWhile isSpace
146− s1 <- trim <$> L.stripPrefix "{-" (trim s0)
147− s2 <- trim <$> L.stripPrefix expected s1
148− s3 <- L.stripPrefix "-}" s2
149− guard (all isSpace s3)
src/Ormolu/Utils.hs+10−63
@@ -1,29 +1,24 @@
11{-# LANGUAGE LambdaCase #-}
22{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ViewPatterns #-}
43
54-- | Random utilities used by the code.
65module Ormolu.Utils
7− ( RelativePos (..),
8− attachRelativePos,
9− combineSrcSpans',
6+ ( combineSrcSpans',
7+ isModule,
108 notImplemented,
119 showOutputable,
1210 splitDocString,
1311 typeArgToType,
1412 unSrcSpan,
15− incSpanLine,
1613 separatedByBlank,
1714 separatedByBlankNE,
18− onTheSameLine,
19− removeIndentation,
2015 )
2116where
2217
23−import Data.Char (isSpace)
18+import Data.Data (Data, showConstr, toConstr)
2419import Data.List (dropWhileEnd)
25−import Data.List.NonEmpty (NonEmpty (..))
2620import qualified Data.List.NonEmpty as NE
21+import Data.List.NonEmpty (NonEmpty (..))
2722import Data.Maybe (fromMaybe)
2823import Data.Text (Text)
2924import qualified Data.Text as T
@@ -31,29 +26,14 @@ import GHC
3126import GHC.DynFlags (baseDynFlags)
3227import qualified Outputable as GHC
3328
34−-- | Relative positions in a list.
35−data RelativePos
36− = SinglePos
37− | FirstPos
38− | MiddlePos
39− | LastPos
40− deriving (Eq, Show)
41−
42−-- | Attach 'RelativePos'es to elements of a given list.
43−attachRelativePos :: [a] -> [(RelativePos, a)]
44−attachRelativePos = \case
45− [] -> []
46− [x] -> [(SinglePos, x)]
47− (x : xs) -> (FirstPos, x) : markLast xs
48− where
49− markLast [] = []
50− markLast [x] = [(LastPos, x)]
51− markLast (x : xs) = (MiddlePos, x) : markLast xs
52−
5329-- | Combine all source spans from the given list.
5430combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan
5531combineSrcSpans' (x :| xs) = foldr combineSrcSpans x xs
5632
33+-- | Return 'True' if given element of AST is module.
34+isModule :: Data a => a -> Bool
35+isModule x = showConstr (toConstr x) == "HsModule"
36+
5737-- | Placeholder for things that are not yet implemented.
5838notImplemented :: String -> a
5939notImplemented msg = error $ "not implemented yet: " ++ msg
@@ -99,32 +79,15 @@ splitDocString docStr =
9979 then dropSpace <$> xs
10080 else xs
10181
102−-- | Get 'LHsType' out of 'LHsTypeArg'.
10382typeArgToType :: LHsTypeArg p -> LHsType p
10483typeArgToType = \case
10584 HsValArg tm -> tm
10685 HsTypeArg _ ty -> ty
10786 HsArgPar _ -> notImplemented "HsArgPar"
10887
109−-- | Get 'RealSrcSpan' out of 'SrcSpan' if the span is “helpful”.
11088unSrcSpan :: SrcSpan -> Maybe RealSrcSpan
111−unSrcSpan = \case
112− RealSrcSpan r -> Just r
113− UnhelpfulSpan _ -> Nothing
114−
115−-- | Increment line number in a 'SrcSpan'.
116−incSpanLine :: Int -> SrcSpan -> SrcSpan
117−incSpanLine i = \case
118− RealSrcSpan s ->
119− let start = realSrcSpanStart s
120− end = realSrcSpanEnd s
121− incLine x =
122− let file = srcLocFile x
123− line = srcLocLine x
124− col = srcLocCol x
125− in mkRealSrcLoc file (line + i) col
126− in RealSrcSpan (mkRealSrcSpan (incLine start) (incLine end))
127− UnhelpfulSpan x -> UnhelpfulSpan x
89+unSrcSpan (RealSrcSpan r) = Just r
90+unSrcSpan (UnhelpfulSpan _) = Nothing
12891
12992-- | Do two declarations have a blank between them?
13093separatedByBlank :: (a -> SrcSpan) -> a -> a -> Bool
@@ -137,19 +100,3 @@ separatedByBlank loc a b =
137100-- | Do two declaration groups have a blank between them?
138101separatedByBlankNE :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool
139102separatedByBlankNE 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+7−4
@@ -1,6 +1,9 @@
11{-# LANGUAGE TemplateHaskell #-}
22
3−module Ormolu.PrinterSpec (spec) where
3+module Ormolu.PrinterSpec
4+ ( spec,
5+ )
6+where
47
58import Control.Exception
69import Control.Monad
@@ -62,7 +65,7 @@ deriveOutput path =
6265-- | A version of 'shouldBe' that is specialized to comparing 'Text' values.
6366-- It also prints multi-line snippets in a more readable form.
6467shouldMatch :: Bool -> Text -> Text -> Expectation
65−shouldMatch idempotenceTest actual expected =
68+shouldMatch idempotencyTest actual expected =
6669 when (actual /= expected) . expectationFailure $
6770 unlines
6871 [ ">>>>>>>>>>>>>>>>>>>>>> expected (" ++ pass ++ "):",
@@ -72,8 +75,8 @@ shouldMatch idempotenceTest actual expected =
7275 ]
7376 where
7477 pass =
75− if idempotenceTest
76− then "idempotence pass"
78+ if idempotencyTest
79+ then "idempotency pass"
7780 else "first pass"
7881
7982examplesDir :: Path Rel Dir