git.iko.soy/ormolu
on 1fb65a2 help sign in
dec158c
swap
0 ahead, 46 behind
124 files changed+540−1112
since splitsnapshots
unifiedsplit
.buildkite/pipeline.yml+2−2 .github/workflows/binaries.yml−39 .github/workflows/build.sh−7 CHANGELOG.md+2−59 README.md+11−21 app/Main.hs+13−23 data/examples/declaration/signature/type/infix-promoted-type-constructor-out.hs+1 data/examples/declaration/signature/type/unrelated-out.hs−4 data/examples/declaration/signature/type/unrelated.hs−4 data/examples/declaration/value/function/arg-breakpoints-out.hs−3 data/examples/declaration/value/function/arg-breakpoints.hs−3 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/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/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/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/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/cpp/separation-2b-out.hs+1 data/examples/other/disabling/indented-fragment-out.hs−7 data/examples/other/disabling/indented-fragment.hs−7 data/examples/other/pragma-comments-after-out.hs−4 data/examples/other/pragma-comments-after.hs−3 default.nix+17−17 expected-failures/Agda.txt+2−2 expected-failures/esqueleto.txt+1−1 expected-failures/hlint.txt−11 expected-failures/idris.txt+22 expected-failures/intero.txt+1−1 expected-failures/leksah.txt+1−1 expected-failures/pandoc.txt+1−1 expected-failures/postgrest.txt−5 expected-failures/purescript.txt+2−2 expected-failures/stack.txt+5 expected-failures/tensorflow.txt−7 nix/nixpkgs/default.nix+3−7 ormolu.cabal+4−5 region-tests/expected-result-17-18.hs−17 region-tests/expected-result-6-7.hs+1−6 region-tests/expected-result-6-8.hs+1−6 region-tests/expected-result-9-12.hs → region-tests/expected-result-9-13.hs+1−6 region-tests/expected-result-all.hs−6 region-tests/src.hs+1−6 shell.nix+1−3 src/Ormolu/Diff.hs+3−3 src/Ormolu/Imports.hs+44−161 src/Ormolu/Parser.hs+3−5 src/Ormolu/Parser/CommentStream.hs+5−22 src/Ormolu/Parser/Result.hs+1−3 src/Ormolu/Printer.hs+1−1 src/Ormolu/Printer/Combinators.hs+7−23 src/Ormolu/Printer/Comments.hs+2−2 src/Ormolu/Printer/Internal.hs+1−3 src/Ormolu/Printer/Meat/Common.hs+6−6 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+34−27 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+1−1 src/Ormolu/Printer/Meat/Declaration/Signature.hs+28−25 src/Ormolu/Printer/Meat/Declaration/Type.hs+1−1 src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+3−3 src/Ormolu/Printer/Meat/Declaration/Value.hs+142−149 src/Ormolu/Printer/Meat/Declaration/Value.hs-boot+4 src/Ormolu/Printer/Meat/Declaration/Warning.hs+5−4 src/Ormolu/Printer/Meat/ImportExport.hs+5−4 src/Ormolu/Printer/Meat/Module.hs+2−2 src/Ormolu/Printer/Meat/Type.hs+15−11 src/Ormolu/Printer/Operators.hs+59−46 src/Ormolu/Processing/Common.hs+1−1 src/Ormolu/Processing/Postprocess.hs+3−13 src/Ormolu/Processing/Preprocess.hs+4−4 src/Ormolu/Utils.hs+1−15
.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+2−59
@@ -1,66 +1,12 @@
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−
573* Fixed rendering of type signatures concerning several identifiers. [Issue
584 566](https://github.com/tweag/ormolu/issues/566).
595
606* Fixed an idempotence issue with inline comments in tuples and parentheses.
617 [Issue 450](https://github.com/tweag/ormolu/issues/450).
628
63−* Fixed an idempotence issue when certain comments were picked up as
9+* Fixed an idempotence issue when certain comments where picked up as
6410 “continuation” of a series of comments [Issue
6511 449](https://github.com/tweag/ormolu/issues/449).
6612
@@ -79,7 +25,7 @@
7925 multiple blank lines in a row. [Issue
8026 518](https://github.com/tweag/ormolu/issues/518).
8127
82−* Fixed rendering of comments around if expressions. [Issue
28+* Fixed rendering of comment around if expressions. [Issue
8329 458](https://github.com/tweag/ormolu/issues/458).
8430
8531* Unnamed fields of data constructors are now documented using the `-- ^`
@@ -89,9 +35,6 @@
8935* Fixed non-idempotent transformation of partly documented data definition.
9036 [Issue 590](https://github.com/tweag/ormolu/issues/590).
9137
92−* Fixed an idempotence issue related to operators. [Issue
93− 522](https://github.com/tweag/ormolu/issues/522).
94−
9538* Renamed the `--check-idempotency` flag to `--check-idempotence`.
9639 Apparently only the latter is correct.
9740
README.md+11−21
@@ -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:
@@ -130,6 +129,14 @@ independent top-level definitions.
130129 criterion than just being valid Haskell modules.
131130* Various minor idempotence issues, most of them are related to comments.
132131
132+## Editor integration
133+
134+We know of the following editor integrations:
135+
136+* [Emacs][emacs-package]
137+* [VS Code][vs-code-plugin]
138+* vim: [neoformat][neoformat], [vim-ormolu][vim-ormolu]
139+
133140## Running on Hackage
134141
135142It's possible to try Ormolu on arbitrary packages from Hackage. For that
@@ -144,22 +151,6 @@ also contain formatted `.hs` files for inspection and original inputs with
144151`.hs-original` extension (those are with CPP dropped, exactly what is fed
145152into Ormolu).
146153
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−
163154## Contributing
164155
165156See [CONTRIBUTING.md][contributing].
@@ -178,4 +169,3 @@ Copyright © 2018–present Tweag I/O
178169[vs-code-plugin]: https://marketplace.visualstudio.com/items?itemName=sjurmillidahl.ormolu-vscode
179170[vim-ormolu]: https://github.com/sdiehl/vim-ormolu
180171[neoformat]: https://github.com/sbdchd/neoformat
181−[aur]: https://aur.archlinux.org/packages/ormolu
app/Main.hs+13−23
@@ -8,7 +8,6 @@ module Main (main) where
88
99import Control.Exception (SomeException, displayException, try)
1010import Control.Monad
11−import Data.Bool (bool)
1211import Data.Either (lefts)
1312import Data.List (intercalate, sort)
1413import qualified Data.Text.IO as TIO
@@ -61,19 +60,15 @@ formatOne mode config = \case
6160 -- 101 is different from all the other exit codes we already use.
6261 exitWith (ExitFailure 101)
6362 Just inputFile -> do
64− originalInput <- TIO.readFile inputFile
65− formattedInput <- ormoluFile config inputFile
63+ r <- ormoluFile config inputFile
6664 case mode of
6765 Stdout ->
68− TIO.putStr formattedInput
69− InPlace -> do
70− -- Only write when the contents have changed, in order to avoid
71− -- updating the modified timestamp if the file was already correctly
72− -- formatted.
73− when (formattedInput /= originalInput) $
74− TIO.writeFile inputFile formattedInput
66+ TIO.putStr r
67+ InPlace ->
68+ TIO.writeFile inputFile r
7569 Check -> do
76− when (formattedInput /= originalInput) $
70+ r' <- TIO.readFile inputFile
71+ when (r /= r') $
7772 -- 100 is different to all the other exit code that are emitted
7873 -- either from an 'OrmoluException' or from 'error' and
7974 -- 'notImplemented'.
@@ -139,18 +134,13 @@ optsParserInfo =
139134optsParser :: Parser Opts
140135optsParser =
141136 Opts
142− <$> ( (fmap (bool Stdout InPlace) . switch . mconcat)
143− [ short 'i',
144− help "A shortcut for --mode inplace"
145− ]
146− <|> (option parseMode . mconcat)
147− [ long "mode",
148− short 'm',
149− metavar "MODE",
150− value Stdout,
151− help "Mode of operation: 'stdout' (default), 'inplace', or 'check'"
152− ]
153− )
137+ <$> (option parseMode . mconcat)
138+ [ long "mode",
139+ short 'm',
140+ metavar "MODE",
141+ value Stdout,
142+ help "Mode of operation: 'stdout' (default), 'inplace', or 'check'"
143+ ]
154144 <*> configParser
155145 <*> (many . strArgument . mconcat)
156146 [ metavar "FILE",
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/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/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/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/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/operators-1-out.hsdeleted−4
@@ -1,4 +0,0 @@
1−foo =
2− f
3− . g
4− =<< h . i
data/examples/declaration/value/function/operators-1.hsdeleted−3
@@ -1,3 +0,0 @@
1−foo = f
2− . g
3− =<< h . i
data/examples/declaration/value/function/operators-2-out.hsdeleted−4
@@ -1,4 +0,0 @@
1−foo n
2− | x || y && z || n ** x
3− || x && n =
4− 42
data/examples/declaration/value/function/operators-2.hsdeleted−4
@@ -1,4 +0,0 @@
1−foo n
2− | x || y && z || n ** x
3− || x && n =
4− 42
data/examples/declaration/value/function/operators-3-out.hsdeleted−3
@@ -1,3 +0,0 @@
1−foo =
2− op <> n <+> colon <+> prettySe <+> text "="
3− <+> prettySe <> text sc
data/examples/declaration/value/function/operators-3.hsdeleted−3
@@ -1,3 +0,0 @@
1−foo =
2− op <> n <+> colon <+> prettySe <+> text "=" <+>
3− prettySe <> text sc
data/examples/declaration/value/function/operators-4-out.hsdeleted−3
@@ -1,3 +0,0 @@
1−foo =
2− line <> bindingOf <+> text "=" <+> tPretty <+> colon
3− <+> align <> prettyPs
data/examples/declaration/value/function/operators-4.hsdeleted−3
@@ -1,3 +0,0 @@
1−foo =
2− line <> bindingOf <+> text "=" <+> tPretty <+> colon <+>
3− align <> prettyPs
data/examples/declaration/value/function/operators-5-out.hsdeleted−5
@@ -1,5 +0,0 @@
1−foo =
2− map bar $
3− [ baz
4− ]
5− ++ quux
data/examples/declaration/value/function/operators-5.hsdeleted−4
@@ -1,4 +0,0 @@
1−foo =
2− map bar $
3− [ baz
4− ] ++ quux
data/examples/declaration/value/function/operators-6-out.hsdeleted−9
@@ -1,9 +0,0 @@
1−type PermuteRef =
2− "a"
3− :> ( "b" :> "c" :> End
4− :<|> "c" :> "b" :> End
5− )
6− :<|> "b"
7− :> ( "a" :> "c" :> End
8− :<|> "c" :> "a" :> End
9− )
data/examples/declaration/value/function/operators-6.hsdeleted−7
@@ -1,7 +0,0 @@
1−type PermuteRef =
2− "a" :> ( "b" :> "c" :> End
3− :<|> "c" :> "b" :> End
4− )
5− :<|> "b" :> ( "a" :> "c" :> End
6− :<|> "c" :> "a" :> End
7− )
data/examples/declaration/value/function/operators-0-out.hs → data/examples/declaration/value/function/operators-out.hsrenamed

The content is the same.

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

The content is the same.

data/examples/declaration/value/function/type-applications-and-splice-out.hsdeleted−4
@@ -1,4 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−{-# LANGUAGE TypeApplications #-}
3−
4−staticKey name = [|sing @ $(symFQN name)|]
data/examples/declaration/value/function/type-applications-and-splice.hsdeleted−4
@@ -1,4 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−{-# LANGUAGE TypeApplications #-}
3−
4−staticKey name = [| sing @ $(symFQN name) |]
data/examples/import/deduplication-bug-out.hsdeleted−6
@@ -1,6 +0,0 @@
1−import Foo1 (Bar1 (..), Baz1)
2−import Foo2 (Bar2 (..), Baz2)
3−import Foo3 (Bar3 (x1, x2, x3))
4−import Foo4 (Bar4 (x1, x2))
5−import Foo5 (Bar5 (x1))
6−import Foo6 (Bar6 (..))
data/examples/import/deduplication-bug.hsdeleted−6
@@ -1,6 +0,0 @@
1−import Foo1 (Bar1, Baz1, Bar1(..))
2−import Foo2 (Bar2(..), Baz2, Bar2)
3−import Foo3 (Bar3(x1,x3), Bar3(x1, x2))
4−import Foo4 (Bar4(x1), Bar4(x2))
5−import Foo5 (Bar5, Bar5(x1))
6−import Foo6 (Bar6(x1), Bar6(..))
data/examples/import/explicit-imports-out.hs+4−4
@@ -1,12 +1,12 @@
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/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/cpp/separation-2b-out.hs+1
@@ -1,4 +1,5 @@
11ffff, ffffffff :: Natural
2+
23#ifdef HASKELL_ZIP_DEV_MODE
34ffff = 200
45ffffffff = 5000
data/examples/other/disabling/indented-fragment-out.hsdeleted−7
@@ -1,7 +0,0 @@
1−foo =
2− {- ORMOLU_DISABLE -}
3− testCase "Foo" testFoo :
4− testCase "Bar" testBar :
5− testCase "Baz" testBaz :
6− {- ORMOLU_ENABLE -}
7− []
data/examples/other/disabling/indented-fragment.hsdeleted−7
@@ -1,7 +0,0 @@
1−foo =
2− {- ORMOLU_DISABLE -}
3− testCase "Foo" testFoo :
4− testCase "Bar" testBar :
5− testCase "Baz" testBaz :
6− {- ORMOLU_ENABLE -}
7− []
data/examples/other/pragma-comments-after-out.hsdeleted−4
@@ -1,4 +0,0 @@
1−{-# LANGUAGE AllowAmbiguousTypes #-}
2−{-# LANGUAGE ConstraintKinds #-}
3−-- TODO: Fix and delete this pragma
4−{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
data/examples/other/pragma-comments-after.hsdeleted−3
@@ -1,3 +0,0 @@
1−{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- TODO: Fix and delete this pragma
2−{-# LANGUAGE AllowAmbiguousTypes #-}
3−{-# LANGUAGE ConstraintKinds #-}
default.nix+17−17
@@ -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;
@@ -28,16 +33,15 @@ let
2833 "distributed-process"
2934 "esqueleto"
3035 "fay"
31− "hlint"
3236 "idris"
3337 "intero"
3438 "leksah"
39+ "lens"
3540 "pandoc"
3641 "pipes"
37− "postgrest"
3842 "purescript"
39− "tensorflow"
40− ] ++ (if ormoluCompiler == "ghc8101" then [] else ["lens"]);
43+ "stack"
44+ ];
4145 ormolizedPackages = doCheck:
4246 pkgs.lib.mapAttrs (name: p: ormolize {
4347 package = p;
@@ -129,19 +133,17 @@ in {
129133 cp src.hs result-all-implicit.hs
130134 ormolu --check-idempotence --mode inplace result-all-implicit.hs
131135 cp src.hs result-all-explicit.hs
132− ormolu --check-idempotence --mode inplace --start-line 1 --end-line 18 result-all-explicit.hs
136+ ormolu --check-idempotence --mode inplace --start-line 1 --end-line 13 result-all-explicit.hs
133137 cp src.hs result-only-start.hs
134138 ormolu --check-idempotence --mode inplace --start-line 1 result-only-start.hs
135139 cp src.hs result-only-end.hs
136− ormolu --check-idempotence --mode inplace --end-line 18 result-only-end.hs
140+ ormolu --check-idempotence --mode inplace --end-line 13 result-only-end.hs
137141 cp src.hs result-6-7.hs
138142 ormolu --check-idempotence --mode inplace --start-line 6 --end-line 7 result-6-7.hs
139143 cp src.hs result-6-8.hs
140144 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+ cp src.hs result-9-13.hs
146+ ormolu --check-idempotence --mode inplace --start-line 9 --end-line 13 result-9-13.hs
145147 '';
146148 checkPhase = ''
147149 echo result-all-implicit.hs
@@ -156,10 +158,8 @@ in {
156158 diff --color=always expected-result-6-7.hs result-6-7.hs
157159 echo result-6-8.hs
158160 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
161+ echo result-9-13.hs
162+ diff --color=always expected-result-9-13.hs result-9-13.hs
163163 '';
164164 installPhase = ''
165165 mkdir "$out"
expected-failures/Agda.txt+2−2
@@ -1,11 +1,11 @@
11Formatting is not idempotent:
2− dist/build/Agda/Syntax/Parser/Lexer.hs<rendered>:1602:17
2+ dist/build/Agda/Syntax/Parser/Lexer.hs<rendered>:1597:17
33 before: " = (check_ac"
44 after: " =\n "
55Please, consider reporting the bug.
66
77Formatting is not idempotent:
8− src/full/Agda/Syntax/Translation/InternalToAbstract.hs<rendered>:769:4
8+ src/full/Agda/Syntax/Translation/InternalToAbstract.hs<rendered>:745:4
99 before: " nes\n\n "
1010 after: " nes\n\n -- Andreas"
1111Please, 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+22
@@ -1,7 +1,29 @@
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/TT.hs<rendered>:1963:13
9+ before: " text op <> pretty"
10+ after: " text op\n <"
11+Please, consider reporting the bug.
12+
113The GHC parser (in Haddock mode) failed:
214 src/Idris/Parser.hs:1052:1
315 parse error on input `@'
416
17+AST of input and AST of formatted code differ.
18+ at src/Idris/Parser/Data.hs:281:1-29
19+Please, consider reporting the bug.
20+
521The GHC parser (in Haddock mode) failed:
622 src/Idris/Parser/Expr.hs:75:1
723 parse error on input `@'
24+
25+Formatting is not idempotent:
26+ src/Idris/Prover.hs<rendered>:239:10
27+ before: " line <> bindin"
28+ after: " line\n <"
29+Please, consider reporting the bug.
expected-failures/intero.txt+1−1
@@ -1,5 +1,5 @@
11Formatting is not idempotent:
2− src/InteractiveUI.hs<rendered>:3748:33
2+ src/InteractiveUI.hs<rendered>:3688:33
33 before: "text \"Try\" <+> doWha"
44 after: "text \"Try\"\n "
55Please, consider reporting the bug.
expected-failures/leksah.txt+1−1
@@ -1,5 +1,5 @@
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.
expected-failures/pandoc.txt+1−1
@@ -3,7 +3,7 @@ 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.
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'
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
ormolu.cabal+4−5
@@ -1,10 +1,10 @@
11cabal-version: 1.18
22name: ormolu
3−version: 0.1.2.0
3+version: 0.0.5.0
44license: BSD3
55license-file: LICENSE.md
66maintainer: Mark Karpov <mark.karpov@tweag.io>
7−tested-with: ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.1
7+tested-with: ghc ==8.6.5 ghc ==8.8.3 ghc ==8.10.1
88homepage: https://github.com/tweag/ormolu
99bug-reports: https://github.com/tweag/ormolu/issues
1010synopsis: A formatter for Haskell source code
@@ -119,7 +119,7 @@ library
119119 base >=4.12 && <5.0,
120120 bytestring >=0.2 && <0.11,
121121 containers >=0.5 && <0.7,
122− dlist >=0.8 && <2.0,
122+ dlist >=0.8 && <0.9,
123123 exceptions >=0.6 && <0.11,
124124 ghc-lib-parser >=8.10 && <8.11,
125125 mtl >=2.0 && <3.0,
@@ -144,7 +144,7 @@ executable ormolu
144144 base >=4.12 && <5.0,
145145 ghc-lib-parser >=8.10 && <8.11,
146146 gitrev >=1.3 && <1.4,
147− optparse-applicative >=0.14 && <0.17,
147+ optparse-applicative >=0.14 && <0.16,
148148 ormolu -any,
149149 text >=0.2 && <1.3
150150
@@ -152,7 +152,6 @@ executable ormolu
152152 ghc-options:
153153 -Wall -Werror -Wcompat -Wincomplete-record-updates
154154 -Wincomplete-uni-patterns -Wnoncanonical-monad-instances
155− -optP-Wno-nonportable-include-path
156155
157156 else
158157 ghc-options: -O2 -Wall -rtsopts
region-tests/expected-result-17-18.hsdeleted−17
@@ -1,17 +0,0 @@
1−{-# LANGUAGE LambdaCase #-}
2−
3−module Foo (
4− foo, bar, baz) where
5−
6−foo :: Int
7−foo = 5
8−
9−bar :: Int -> Int
10−bar = \case
11− 0 -> foo
12− x -> x - foo
13−
14−baz :: Int -> Int
15−baz = gege
16− where
17− gege = 1 + 2
region-tests/expected-result-6-7.hs+1−6
@@ -1,7 +1,7 @@
11{-# LANGUAGE LambdaCase #-}
22
33module Foo (
4− foo, bar, baz) where
4+ foo, bar) where
55
66foo :: Int
77foo = 5
@@ -10,8 +10,3 @@ bar :: Int -> Int
1010bar = \case
1111 0 -> foo
1212 x -> x - foo
13−
14−baz :: Int -> Int
15−baz = gege
16− where
17− gege = 1 + 2
region-tests/expected-result-6-8.hs+1−6
@@ -1,7 +1,7 @@
11{-# LANGUAGE LambdaCase #-}
22
33module Foo (
4− foo, bar, baz) where
4+ foo, bar) where
55
66foo :: Int
77foo = 5
@@ -9,8 +9,3 @@ bar :: Int -> Int
99bar = \case
1010 0 -> foo
1111 x -> x - foo
12−
13−baz :: Int -> Int
14−baz = gege
15− where
16− gege = 1 + 2
region-tests/expected-result-9-12.hs → region-tests/expected-result-9-13.hsrenamed+1−6
@@ -1,7 +1,7 @@
11{-# LANGUAGE LambdaCase #-}
22
33module Foo (
4− foo, bar, baz) where
4+ foo, bar) where
55
66foo :: Int
77foo = 5
@@ -10,8 +10,3 @@ bar :: Int -> Int
1010bar = \case
1111 0 -> foo
1212 x -> x - foo
13−
14−baz :: Int -> Int
15−baz = gege
16− where
17− gege = 1 + 2
region-tests/expected-result-all.hs−6
@@ -3,7 +3,6 @@
33module Foo
44 ( foo,
55 bar,
6− baz,
76 )
87where
98
@@ -14,8 +13,3 @@ bar :: Int -> Int
1413bar = \case
1514 0 -> foo
1615 x -> x - foo
17−
18−baz :: Int -> Int
19−baz = gege
20− where
21− gege = 1 + 2
region-tests/src.hs+1−6
@@ -1,7 +1,7 @@
11{-# LANGUAGE LambdaCase #-}
22
33module Foo (
4− foo, bar, baz) where
4+ foo, bar) where
55
66foo :: Int
77foo = 5
@@ -10,8 +10,3 @@ bar :: Int -> Int
1010bar = \case
1111 0 -> foo
1212 x -> x - foo
13−
14−baz :: Int -> Int
15−baz = gege
16− where
17− gege = 1 + 2
shell.nix+1−3
@@ -1,5 +1,3 @@
1−{ pkgs ? (import ./nix/nixpkgs { inherit system; })
2−, system ? builtins.currentSystem
3−}:
1+{ pkgs ? (import ./nix/nixpkgs) }:
42
53(import ./default.nix { inherit pkgs; }).dev.ormoluShell
src/Ormolu/Diff.hs+3−3
@@ -14,7 +14,7 @@ import Data.Text (Text)
1414import qualified Data.Text as T
1515import qualified FastString as GHC
1616import GHC
17−import Ormolu.Imports (normalizeImports)
17+import Ormolu.Imports (sortImports)
1818import Ormolu.Parser.CommentStream
1919import Ormolu.Parser.Result
2020import Ormolu.Utils
@@ -47,8 +47,8 @@ diffParseResult
4747 } =
4848 matchIgnoringSrcSpans cstream0 cstream1
4949 <> matchIgnoringSrcSpans
50− hs0 {hsmodImports = normalizeImports (hsmodImports hs0)}
51− hs1 {hsmodImports = normalizeImports (hsmodImports hs1)}
50+ hs0 {hsmodImports = sortImports (hsmodImports hs0)}
51+ hs1 {hsmodImports = sortImports (hsmodImports hs1)}
5252
5353-- | Compare two values for equality disregarding differences in 'SrcSpan's
5454-- and the ordering of import lists.
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+3−5
@@ -32,7 +32,7 @@ import Ormolu.Parser.Anns
3232import Ormolu.Parser.CommentStream
3333import Ormolu.Parser.Result
3434import Ormolu.Processing.Preprocess (preprocess)
35−import Ormolu.Utils (incSpanLine, removeIndentation)
35+import Ormolu.Utils (incSpanLine)
3636import qualified Panic as GHC
3737import qualified Parser as GHC
3838import qualified StringBuffer as GHC
@@ -51,9 +51,8 @@ parseModule ::
5151 Either (SrcSpan, String) ParseResult
5252 )
5353parseModule Config {..} path rawInput = liftIO $ do
54− let (literalPrefix, indentedInput, literalSuffix, extraComments) =
54+ let (literalPrefix, input, literalSuffix, extraComments) =
5555 preprocess path rawInput cfgRegion
56− (input, indent) = removeIndentation indentedInput
5756 -- It's important that 'setDefaultExts' is done before
5857 -- 'parsePragmasIntoDynFlags', because otherwise we might enable an
5958 -- extension that was explicitly disabled in the file.
@@ -111,8 +110,7 @@ parseModule Config {..} path rawInput = liftIO $ do
111110 prImportQualifiedPost =
112111 GHC.xopt ImportQualifiedPost dynFlags,
113112 prLiteralPrefix = T.pack literalPrefix,
114− prLiteralSuffix = T.pack literalSuffix,
115− prIndent = indent
113+ prLiteralSuffix = T.pack literalSuffix
116114 }
117115 return (warnings, r)
118116
src/Ormolu/Parser/CommentStream.hs+5−22
@@ -27,8 +27,7 @@ import qualified GHC
2727import qualified Lexer as GHC
2828import Ormolu.Parser.Pragma
2929import Ormolu.Parser.Shebang
30−import Ormolu.Processing.Common
31−import Ormolu.Utils (onTheSameLine, showOutputable)
30+import Ormolu.Utils (showOutputable)
3231import SrcLoc
3332
3433----------------------------------------------------------------------------
@@ -110,15 +109,11 @@ mkComment ls (L l s) = (ls', comment)
110109 Nothing -> s :| []
111110 Just (x :| xs) ->
112111 let getIndent y =
113− if all isSpace y || y == endDisabling
112+ if all isSpace y
114113 then startIndent
115114 else length (takeWhile isSpace y)
116115 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)
116+ in x :| (drop n <$> xs)
122117 else s :| []
123118 (atomsBefore, ls') =
124119 case dropWhile ((< commentLine) . fst) ls of
@@ -150,7 +145,6 @@ isMultilineComment (Comment _ (x :| _)) = "{-" `L.isPrefixOf` x
150145
151146-- | Detect and extract stack header if it is present.
152147extractStackHeader ::
153− -- | Comment stream to analyze
154148 [RealLocated String] ->
155149 ([RealLocated String], Maybe (RealLocated Comment))
156150extractStackHeader = \case
@@ -166,9 +160,7 @@ extractStackHeader = \case
166160
167161-- | Extract pragmas and their associated comments.
168162extractPragmas ::
169− -- | Input
170163 String ->
171− -- | Comment stream to analyze
172164 [RealLocated String] ->
173165 ([RealLocated Comment], [([RealLocated Comment], Pragma)])
174166extractPragmas input = go initialLs id id
@@ -182,17 +174,8 @@ extractPragmas input = go initialLs id id
182174 let (ls', x') = mkComment ls x
183175 in go ls' (csSoFar . (x' :)) pragmasSoFar xs
184176 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
177+ let combined = (csSoFar [], pragma)
178+ in go ls id (pragmasSoFar . (combined :)) xs
196179
197180-- | Get a 'String' from 'GHC.AnnotationComment'.
198181unAnnotationComment :: GHC.AnnotationComment -> Maybe String
src/Ormolu/Parser/Result.hs+1−3
@@ -35,9 +35,7 @@ data ParseResult = ParseResult
3535 -- | Literal prefix
3636 prLiteralPrefix :: Text,
3737 -- | Literal suffix
38− prLiteralSuffix :: Text,
39− -- | Indentation level, can be non-zero in case of region formatting
40− prIndent :: Int
38+ prLiteralSuffix :: Text
4139 }
4240
4341-- | Pretty-print a 'ParseResult'.
src/Ormolu/Printer.hs+1−1
@@ -23,7 +23,7 @@ printModule ParseResult {..} =
2323 prLiteralPrefix <> region <> prLiteralSuffix
2424 where
2525 region =
26− postprocess prIndent $
26+ postprocess $
2727 runR
2828 ( p_hsModule
2929 prStackHeader
src/Ormolu/Printer/Combinators.hs+7−23
@@ -21,7 +21,6 @@ module Ormolu.Printer.Combinators
2121 space,
2222 newline,
2323 inci,
24− inciIf,
2524 located,
2625 located',
2726 switchLayout,
@@ -52,7 +51,6 @@ module Ormolu.Printer.Combinators
5251
5352 -- ** Literals
5453 comma,
55− commaDel,
5654 equals,
5755
5856 -- ** Stateful markers
@@ -74,15 +72,6 @@ import SrcLoc
7472----------------------------------------------------------------------------
7573-- Basic
7674
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−
8675-- | Enter a 'Located' entity. This combinator handles outputting comments
8776-- and sets layout (single-line vs multi-line) for the inner computation.
8877-- Roughly, the rule for using 'located' is that every time there is a
@@ -185,12 +174,10 @@ sepSemi f xs = vlayout singleLine multiLine
185174 xs' ->
186175 if ub
187176 then do
188− txt "{"
189− space
190− sep (txt ";" >> space) (dontUseBraces . f) xs'
191− space
192− txt "}"
193− else sep (txt ";" >> space) f xs'
177+ txt "{ "
178+ sep (txt "; ") (dontUseBraces . f) xs'
179+ txt " }"
180+ else sep (txt "; ") f xs'
194181 multiLine =
195182 sep newline (dontUseBraces . f) xs
196183
@@ -203,7 +190,6 @@ data BracketStyle
203190 N
204191 | -- | Shifted one level
205192 S
206− deriving (Eq, Show)
207193
208194-- | Surround given entity by backticks.
209195backticks :: R () -> R ()
@@ -280,7 +266,9 @@ brackets_ needBreaks open close style m = sitcc (vlayout singleLine multiLine)
280266 then newline >> inci m
281267 else space >> sitcc m
282268 newline
283− inciIf (style == S) (txt close)
269+ case style of
270+ N -> txt close
271+ S -> inci (txt close)
284272
285273----------------------------------------------------------------------------
286274-- Literals
@@ -289,10 +277,6 @@ brackets_ needBreaks open close style m = sitcc (vlayout singleLine multiLine)
289277comma :: R ()
290278comma = txt ","
291279
292−-- | Delimiting combination with 'comma'. To be used with 'sep'.
293−commaDel :: R ()
294−commaDel = comma >> breakpoint
295−
296280-- | Print @=@. Do not use @'txt' "="@.
297281equals :: R ()
298282equals = interferingTxt "="
src/Ormolu/Printer/Comments.hs+2−2
@@ -154,7 +154,6 @@ needsNewlineBefore ::
154154 -- | Last printed comment span
155155 Maybe SpanMark ->
156156 Bool
157−needsNewlineBefore _ (Just (HaddockSpan _ _)) = True
158157needsNewlineBefore l mlastMark =
159158 case spanMarkSpan <$> mlastMark of
160159 Nothing -> False
@@ -239,7 +238,8 @@ commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =
239238 -- lexemes in front of it and goes right after the previous comment.
240239 not (hasAtomsBefore comment)
241240 && ( case mlastMark of
242− Just (HaddockSpan _ _) -> False
241+ Just (HaddockSpan _ spn) ->
242+ srcSpanEndLine spn + 1 == srcSpanStartLine l
243243 Just (CommentSpan spn) ->
244244 srcSpanEndLine spn + 1 == srcSpanStartLine l
245245 _ -> False
src/Ormolu/Printer/Internal.hs+1−3
@@ -220,8 +220,7 @@ txt ::
220220 R ()
221221txt = spit SimpleText
222222
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.
223+-- |
225224interferingTxt ::
226225 -- | 'Text' to output
227226 Text ->
@@ -244,7 +243,6 @@ spit ::
244243 -- | 'Text' to output
245244 Text ->
246245 R ()
247−spit _ "" = return ()
248246spit stype text = do
249247 requestedDel <- R (gets scRequestedDelimiter)
250248 pendingComments <- R (gets scPendingComments)
src/Ormolu/Printer/Meat/Common.hs+6−6
@@ -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 ::
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+34−27
@@ -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,28 @@ 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
70+ if hasHaddocks dd_cons
71+ then newline
72+ else breakpoint
73+ equals
74+ space
75+ layout <- getLayout
76+ let s =
77+ if layout == MultiLine || hasHaddocks dd_cons
78+ then newline >> txt "|" >> space
79+ else space >> txt "|" >> space
80+ sitcc' =
81+ if singleConstRec
82+ then id
83+ else sitcc
84+ sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons
8385 unless (null $ unLoc dd_derivs) breakpoint
8486 inci . located dd_derivs $ \xs ->
8587 sep newline (located' p_hsDerivingClause) xs
@@ -104,10 +106,11 @@ p_conDecl singleConstRec = \case
104106 (c : cs) -> do
105107 p_rdrName c
106108 unless (null cs) . inci $ do
107− commaDel
108− sep commaDel p_rdrName cs
109+ comma
110+ breakpoint
111+ sitcc $ sep (comma >> breakpoint) p_rdrName cs
112+ space
109113 inci $ do
110− space
111114 txt "::"
112115 let interArgBreak =
113116 if hasDocStrings (unLoc con_res_ty)
@@ -155,7 +158,11 @@ p_conDecl singleConstRec = \case
155158 RecCon l -> do
156159 p_rdrName con_name
157160 breakpoint
158− inciIf (not singleConstRec) (located l p_conDeclFields)
161+ let inci' =
162+ if singleConstRec
163+ then id
164+ else inci
165+ inci' (located l p_conDeclFields)
159166 InfixCon x y -> do
160167 located x p_hsType
161168 breakpoint
@@ -204,9 +211,9 @@ p_hsDerivingClause HsDerivingClause {..} = do
204211 let derivingWhat = located deriv_clause_tys $ \case
205212 [] -> txt "()"
206213 xs ->
207− parens N $
214+ parens N . sitcc $
208215 sep
209− commaDel
216+ (comma >> breakpoint)
210217 (sitcc . located' p_hsType . hsib_body)
211218 xs
212219 space
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+1−1
@@ -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
src/Ormolu/Printer/Meat/Declaration/Signature.hs+28−25
@@ -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,25 @@ 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
53− p_typeAscription hswc
51+ else do
52+ comma
53+ breakpoint
54+ bool id inci indentTail $ do
55+ sep (comma >> breakpoint) p_rdrName ns
56+ p_typeAscription hswc
5457
5558p_typeAscription ::
5659 LHsSigWcType GhcPs ->
5760 R ()
58−p_typeAscription HsWC {..} = inci $ do
61+p_typeAscription HsWC {..} = do
5962 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
63+ inci $ do
64+ txt "::"
65+ let t = hsib_body hswc_body
66+ if hasDocStrings (unLoc t)
67+ then newline
68+ else breakpoint
69+ located t p_hsType
6670p_typeAscription (XHsWildCardBndrs x) = noExtCon x
6771
6872p_patSynSig ::
@@ -104,7 +108,7 @@ p_fixSig = \case
104108 space
105109 atom n
106110 space
107− sitcc $ sep commaDel p_rdrName names
111+ sitcc $ sep (comma >> breakpoint) p_rdrName names
108112 XFixitySig x -> noExtCon x
109113
110114p_inlineSig ::
@@ -143,7 +147,7 @@ p_specSig name ts InlinePragma {..} = pragmaBraces $ do
143147 space
144148 txt "::"
145149 breakpoint
146− inci $ sep commaDel (located' p_hsType . hsib_body) ts
150+ inci $ sep (comma >> breakpoint) (located' p_hsType . hsib_body) ts
147151
148152p_inlineSpec :: InlineSpec -> R ()
149153p_inlineSpec = \case
@@ -187,13 +191,13 @@ p_booleanFormula = \case
187191 And xs ->
188192 sitcc $
189193 sep
190− commaDel
194+ (comma >> breakpoint)
191195 (located' p_booleanFormula)
192196 xs
193197 Or xs ->
194198 sitcc $
195199 sep
196− (breakpoint >> txt "|" >> space)
200+ (breakpoint >> txt "| ")
197201 (located' p_booleanFormula)
198202 xs
199203 Parens l -> located l (parens N . p_booleanFormula)
@@ -207,7 +211,7 @@ p_completeSig ::
207211p_completeSig cs' mty =
208212 located cs' $ \cs ->
209213 pragma "COMPLETE" . inci $ do
210− sep commaDel p_rdrName cs
214+ sitcc $ sep (comma >> breakpoint) p_rdrName cs
211215 forM_ mty $ \ty -> do
212216 space
213217 txt "::"
@@ -224,13 +228,12 @@ p_sccSig loc literal = pragma "SCC" . inci $ do
224228p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()
225229p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do
226230 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
231+ space
232+ p_rdrName name
233+ space
234+ txt "::"
235+ breakpoint
236+ inci $ case bndrs of
237+ HsIB NoExtField sig -> located sig p_hsType
238+ XHsImplicitBndrs x -> noExtCon x
236239p_standaloneKindSig (XStandaloneKindSig c) = noExtCon c
src/Ormolu/Printer/Meat/Declaration/Type.hs+1−1
@@ -28,7 +28,7 @@ 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
src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+3−3
@@ -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
@@ -92,12 +92,12 @@ 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
src/Ormolu/Printer/Meat/Declaration/Value.hs+142−149
@@ -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,7 +212,7 @@ 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
@@ -224,7 +224,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
224224 Case -> True
225225 LambdaCase -> True
226226 _ -> False
227− hasGuards = withGuards grhssGRHSs
227+ let hasGuards = withGuards grhssGRHSs
228228 grhssSpan =
229229 combineSrcSpans' $
230230 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs
@@ -253,7 +253,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do
253253 txt "where"
254254 unless whereIsEmpty breakpoint
255255 inci $ located grhssLocalBinds p_hsLocalBinds
256− inciIf indentBody $ do
256+ inci' $ do
257257 unless (length grhssGRHSs > 1) $
258258 case style of
259259 Function _ | hasGuards -> return ()
@@ -284,7 +284,7 @@ p_grhs' placer render style (GRHS NoExtField guards body) =
284284 xs -> do
285285 txt "|"
286286 space
287− sitcc (sep commaDel (sitcc . located' p_stmt) xs)
287+ sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)
288288 space
289289 inci $ case style of
290290 EqualSign -> equals
@@ -316,7 +316,7 @@ p_hsCmd = \case
316316 HsHigherOrderApp -> txt "-<<"
317317 placeHanging (exprPlacement (unLoc input)) $
318318 located input p_hsExpr
319− HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ do
319+ HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do
320320 located form p_hsExpr
321321 unless (null cmds) $ do
322322 breakpoint
@@ -353,14 +353,7 @@ p_hsCmdTop = \case
353353 HsCmdTop NoExtField cmd -> located cmd p_hsCmd
354354 XCmdTop x -> noExtCon x
355355
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 ()
356+withSpacing :: Data a => (a -> R ()) -> Located a -> R ()
364357withSpacing f l = located l $ \x -> do
365358 case getLoc l of
366359 UnhelpfulSpan _ -> f x
@@ -471,24 +464,30 @@ gatherStmtBlock (XParStmtBlock x) = noExtCon x
471464p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
472465p_hsLocalBinds = \case
473466 HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do
467+ let ssStart =
468+ either
469+ (srcSpanStart . getLoc)
470+ (srcSpanStart . getLoc)
471+ items =
472+ (Left <$> bagToList bag) ++ (Right <$> lsigs)
473+ p_item (Left x) = located x p_valDecl
474+ p_item (Right x) = located x p_sigDecl
474475 -- When in a single-line layout, there is a chance that the inner
475476 -- elements will also contain semicolons and they will confuse the
476477 -- parser. so we request braces around every element except the last.
477478 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)
479+ sitcc $
480+ sepSemi
481+ ( \(p, i) ->
482+ ( case p of
483+ SinglePos -> id
484+ FirstPos -> br
485+ MiddlePos -> br
486+ LastPos -> id
487+ )
488+ (p_item i)
489+ )
490+ (attachRelativePos $ sortOn ssStart items)
492491 HsValBinds NoExtField _ -> notImplemented "HsValBinds"
493492 HsIPBinds NoExtField (IPBinds NoExtField xs) ->
494493 -- Second argument of IPBind is always Left before type-checking.
@@ -521,6 +520,12 @@ p_hsRecField HsRecField {..} = do
521520 else Normal
522521 placeHanging placement (located hsRecFieldArg p_hsExpr)
523522
523+p_hsTupArg :: HsTupArg GhcPs -> R ()
524+p_hsTupArg = \case
525+ Present NoExtField x -> located x p_hsExpr
526+ Missing NoExtField -> pure ()
527+ XTupArg x -> noExtCon x
528+
524529p_hsExpr :: HsExpr GhcPs -> R ()
525530p_hsExpr = p_hsExpr' N
526531
@@ -584,21 +589,23 @@ p_hsExpr' s = \case
584589 -- do-block or case expression it is not a good idea. It seems
585590 -- to be safe to always bump indentation when the function
586591 -- expression is parenthesised.
587− doIndent =
592+ indent =
588593 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
594+ L _ (HsPar NoExtField _) -> inci
595+ L _ (HsAppType NoExtField _ _) -> inci
596+ L _ (HsMultiIf NoExtField _) -> inci
597+ L spn _ ->
598+ if isOneLineSpan spn
599+ then inci
600+ else id
601+ ub <- getLayout <&> \case
602+ SingleLine -> useBraces
603+ MultiLine -> id
597604 ub $ do
598605 located func (p_hsExpr' s)
599606 breakpoint
600− inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp
601− inciIf doIndent $ do
607+ indent $ sep breakpoint (located' p_hsExpr) initp
608+ indent $ do
602609 unless (null initp) breakpoint
603610 located lastp p_hsExpr
604611 Hanging -> do
@@ -613,15 +620,10 @@ p_hsExpr' s = \case
613620 breakpoint
614621 inci $ do
615622 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 ()
621623 located (hswc_body a) p_hsType
622624 OpApp NoExtField x op y -> do
623625 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)
624− p_exprOpTree s (reassociateOpTree getOpName opTree)
626+ p_exprOpTree True s (reassociateOpTree getOpName opTree)
625627 NegApp NoExtField e _ -> do
626628 txt "-"
627629 space
@@ -638,27 +640,22 @@ p_hsExpr' s = \case
638640 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)
639641 unless (useRecordDot' && isRecordDot') breakpoint
640642 inci (located x p_hsExpr)
641− ExplicitTuple NoExtField args boxity ->
643+ ExplicitTuple NoExtField args boxity -> do
642644 let isSection = any (isMissing . unLoc) args
643645 isMissing = \case
644646 Missing NoExtField -> True
645647 _ -> False
646− p_arg = \case
647− Present NoExtField x -> located x p_hsExpr
648− Missing NoExtField -> pure ()
649− XTupArg x -> noExtCon x
650− p_larg = sitcc . located' p_arg
651− parens' =
648+ let parens' =
652649 case boxity of
653650 Boxed -> parens
654651 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
652+ if isSection
653+ then
654+ switchLayout [] . parens' s $
655+ sep comma (located' p_hsTupArg) args
656+ else
657+ switchLayout (getLoc <$> args) . parens' s . sitcc $
658+ sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
662659 ExplicitSum NoExtField tag arity e ->
663660 p_unboxedSum N tag arity (located e p_hsExpr)
664661 HsCase NoExtField e mgroup ->
@@ -668,7 +665,7 @@ p_hsExpr' s = \case
668665 HsMultiIf NoExtField guards -> do
669666 txt "if"
670667 breakpoint
671− inci . inci $ sep newline (located' (p_grhs RightArrow)) guards
668+ inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards
672669 HsLet NoExtField localBinds e ->
673670 p_let p_hsExpr localBinds e
674671 HsDo NoExtField ctx es -> do
@@ -680,15 +677,15 @@ p_hsExpr' s = \case
680677 sepSemi
681678 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))
682679 (unLoc es)
683− compBody = brackets N . located es $ \xs -> do
680+ compBody = brackets N $ located es $ \xs -> do
684681 let p_parBody =
685682 sep
686− (breakpoint >> txt "|" >> space)
683+ (breakpoint >> txt "| ")
687684 p_seqBody
688685 p_seqBody =
689686 sitcc
690687 . sep
691− commaDel
688+ (comma >> breakpoint)
692689 (located' (sitcc . p_stmt))
693690 stmts = init xs
694691 yield = last xs
@@ -709,8 +706,8 @@ p_hsExpr' s = \case
709706 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
710707 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
711708 ExplicitList _ _ xs ->
712− brackets s $
713− sep commaDel (sitcc . located' p_hsExpr) xs
709+ brackets s . sitcc $
710+ sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs
714711 RecordCon {..} -> do
715712 located rcon_con_name atom
716713 breakpoint
@@ -726,8 +723,8 @@ p_hsExpr' s = \case
726723 case rec_dotdot of
727724 Just {} -> [txt ".."]
728725 Nothing -> []
729− inci . braces N $
730− sep commaDel sitcc (fields <> dotdot)
726+ inci . braces N . sitcc $
727+ sep (comma >> breakpoint) sitcc (fields <> dotdot)
731728 RecordUpd {..} -> do
732729 located rupd_expr p_hsExpr
733730 useRecordDot' <- useRecordDot
@@ -745,9 +742,9 @@ p_hsExpr' s = \case
745742 Unambiguous _ n -> n
746743 XAmbiguousFieldOcc x -> noExtCon x
747744 }
748− inci . braces N $
745+ inci . braces N . sitcc $
749746 sep
750− commaDel
747+ (comma >> breakpoint)
751748 (sitcc . located' (p_hsRecField . updName))
752749 rupd_flds
753750 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do
@@ -760,22 +757,22 @@ p_hsExpr' s = \case
760757 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x
761758 ArithSeq NoExtField _ x ->
762759 case x of
763− From from -> brackets s $ do
760+ From from -> brackets s . sitcc $ do
764761 located from p_hsExpr
765762 breakpoint
766763 txt ".."
767− FromThen from next -> brackets s $ do
768− sep commaDel (located' p_hsExpr) [from, next]
764+ FromThen from next -> brackets s . sitcc $ do
765+ sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
769766 breakpoint
770767 txt ".."
771− FromTo from to -> brackets s $ do
768+ FromTo from to -> brackets s . sitcc $ do
772769 located from p_hsExpr
773770 breakpoint
774771 txt ".."
775772 space
776773 located to p_hsExpr
777− FromThenTo from next to -> brackets s $ do
778− sep commaDel (located' p_hsExpr) [from, next]
774+ FromThenTo from next to -> brackets s . sitcc $ do
775+ sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
779776 breakpoint
780777 txt ".."
781778 space
@@ -852,8 +849,8 @@ p_patSynBind PSB {..} = do
852849 inci $ do
853850 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do
854851 unless (null xs) breakpoint
855− braces N $
856− sep commaDel (p_rdrName . recordPatSynPatVar) xs
852+ braces N . sitcc $
853+ sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs
857854 rhs
858855 InfixCon l r -> do
859856 switchLayout [getLoc l, getLoc r] $ do
@@ -949,13 +946,13 @@ p_pat = \case
949946 txt "!"
950947 located pat p_pat
951948 ListPat NoExtField pats ->
952− brackets S $ sep commaDel (located' p_pat) pats
949+ brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats
953950 TuplePat NoExtField pats boxing -> do
954− let parens' =
951+ let f =
955952 case boxing of
956953 Boxed -> parens S
957954 Unboxed -> parensHash S
958− parens' $ sep commaDel (sitcc . located' p_pat) pats
955+ f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
959956 SumPat NoExtField pat tag arity ->
960957 p_unboxedSum S tag arity (located pat p_pat)
961958 ConPatIn pat details ->
@@ -971,7 +968,7 @@ p_pat = \case
971968 let f = \case
972969 Nothing -> txt ".."
973970 Just x -> located x p_pat_hsRecField
974− inci . braces N . sep commaDel f $
971+ inci . braces N . sitcc . sep (comma >> breakpoint) f $
975972 case dotdot of
976973 Nothing -> Just <$> fields
977974 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]
@@ -1021,15 +1018,17 @@ p_unboxedSum s tag arity m = do
10211018 let before = tag - 1
10221019 after = arity - before - 1
10231020 args = replicate before Nothing <> [Just m] <> replicate after Nothing
1024− f x =
1021+ f (x, i) = do
1022+ let isFirst = i == 0
1023+ isLast = i == arity - 1
10251024 case x :: Maybe (R ()) of
10261025 Nothing ->
1027− space
1026+ unless (isFirst || isLast) space
10281027 Just m' -> do
1029− space
1028+ unless isFirst space
10301029 m'
1031− space
1032− parensHash s $ sep (txt "|") f args
1030+ unless isLast space
1031+ parensHash s $ sep (txt "|") f (zip args [0 ..])
10331032
10341033p_hsSplice :: HsSplice GhcPs -> R ()
10351034p_hsSplice = \case
@@ -1231,10 +1230,11 @@ exprPlacement = \case
12311230 HsCase NoExtField _ _ -> Hanging
12321231 HsDo NoExtField DoExpr _ -> Hanging
12331232 HsDo NoExtField MDoExpr _ -> Hanging
1234− OpApp NoExtField _ op y ->
1235− case (fmap getOpNameStr . getOpName . unLoc) op of
1236− Just "$" -> exprPlacement (unLoc y)
1237− _ -> Normal
1233+ -- If the rightmost expression in an operator chain is hanging, make the
1234+ -- whole block hanging; so that we can use the common @f = foo $ do@
1235+ -- style.
1236+ OpApp NoExtField _ _ y -> exprPlacement (unLoc y)
1237+ -- Same thing for function applications (usually with -XBlockArguments)
12381238 HsApp NoExtField _ y -> exprPlacement (unLoc y)
12391239 HsProc NoExtField p _ ->
12401240 -- Indentation breaks if pattern is longer than one line and left
@@ -1260,16 +1260,15 @@ getOpName = \case
12601260 HsVar NoExtField (L _ a) -> Just a
12611261 _ -> Nothing
12621262
1263−getOpNameStr :: RdrName -> String
1264−getOpNameStr = occNameString . rdrNameOcc
1265−
12661263p_exprOpTree ::
1264+ -- | Can use special handling of dollar?
1265+ Bool ->
12671266 -- | Bracket style to use
12681267 BracketStyle ->
12691268 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->
12701269 R ()
1271−p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)
1272−p_exprOpTree s (OpBranch x op y) = do
1270+p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)
1271+p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
12731272 -- If the beginning of the first argument and the second argument are on
12741273 -- the same line, and the second argument has a hanging form, use hanging
12751274 -- placement.
@@ -1291,54 +1290,44 @@ p_exprOpTree s (OpBranch x op y) = do
12911290 MultiLine -> case placement of
12921291 Hanging -> useBraces
12931292 Normal -> dontUseBraces
1294− opNameStr = (fmap getOpNameStr . getOpName . unLoc) op
1295− gotDollar = opNameStr == Just "$"
1296− gotColon = opNameStr == Just ":"
1297− gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)
1293+ gotDollar = case getOpName (unLoc op) of
1294+ Just rname -> mkVarOcc "$" == rdrNameOcc rname
1295+ _ -> False
12981296 lhs =
12991297 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)
1298+ p_exprOpTree (not gotDollar) s x
1299+ let p_op = located op (opWrapper . p_hsExpr)
1300+ p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)
13031301 isSection = case (opTreeLoc x, getLoc op) of
13041302 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->
13051303 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan
13061304 _ -> False
1307− isDoBlock = \case
1308− OpNode (L _ HsDo {}) -> True
1309− _ -> False
13101305 useRecordDot' <- useRecordDot
1311− if
1312− | gotColon -> do
1313− lhs
1314− space
1315− p_op
1316− case placement of
1317− Hanging -> do
1306+ let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)
1307+ if useRecordDot' && isRecordDot'
1308+ then do
1309+ lhs
1310+ when isSection space
1311+ p_op
1312+ p_y
1313+ else
1314+ if isDollarSpecial
1315+ && gotDollar
1316+ && placement
1317+ == Normal
1318+ && isOneLineSpan (opTreeLoc x)
1319+ then do
1320+ useBraces lhs
1321+ space
1322+ p_op
1323+ breakpoint
1324+ inci p_y
1325+ else do
1326+ ub lhs
1327+ placeHanging placement $ do
1328+ p_op
13181329 space
13191330 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
13421331
13431332-- | Return 'True' if given expression is a record-dot operator expression.
13441333isRecordDot ::
@@ -1349,10 +1338,14 @@ isRecordDot ::
13491338 Bool
13501339isRecordDot op (RealSrcSpan ySpan) = case op of
13511340 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->
1352− (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
1341+ isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)
13531342 _ -> False
13541343isRecordDot _ _ = False
13551344
1345+-- | Check whether a given 'RdrName' is the dot operator.
1346+isDot :: RdrName -> Bool
1347+isDot name = rdrNameOcc name == mkVarOcc "."
1348+
13561349-- | Get annotations for the enclosing element.
13571350getEnclosingAnns :: R [AnnKeywordId]
13581351getEnclosingAnns = do
src/Ormolu/Printer/Meat/Declaration/Value.hs-boot+4
@@ -11,7 +11,11 @@ import GHC
1111import Ormolu.Printer.Combinators
1212
1313p_valDecl :: HsBindLR GhcPs GhcPs -> R ()
14+
1415p_pat :: Pat GhcPs -> R ()
16+
1517p_hsExpr :: HsExpr GhcPs -> R ()
18+
1619p_hsSplice :: HsSplice GhcPs -> R ()
20+
1721p_stringLit :: String -> R ()
src/Ormolu/Printer/Meat/Declaration/Warning.hs+5−4
@@ -32,9 +32,10 @@ p_moduleWarning wtxt = do
3232p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()
3333p_topLevelWarning fnames wtxt = do
3434 let (pragmaText, lits) = warningText wtxt
35− switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $
36− pragma pragmaText . inci $ do
37− sep commaDel p_rdrName fnames
35+ switchLayout (fmap getLoc fnames ++ fmap getLoc lits)
36+ $ pragma pragmaText . inci
37+ $ do
38+ sitcc $ sep (comma >> breakpoint) p_rdrName fnames
3839 breakpoint
3940 p_lits lits
4041
@@ -46,4 +47,4 @@ warningText = \case
4647p_lits :: [Located StringLiteral] -> R ()
4748p_lits = \case
4849 [l] -> atom l
49− ls -> brackets N $ sep commaDel atom ls
50+ ls -> brackets N . sitcc $ sep (comma >> breakpoint) atom ls
src/Ormolu/Printer/Meat/ImportExport.hs+5−4
@@ -21,7 +21,7 @@ p_hsmodExports [] = do
2121 breakpoint'
2222 txt ")"
2323p_hsmodExports xs =
24− parens N $ do
24+ parens N . sitcc $ do
2525 layout <- getLayout
2626 sep
2727 breakpoint
@@ -65,7 +65,7 @@ p_hsmodImport useQualifiedPost ImportDecl {..} = do
6565 Nothing -> return ()
6666 Just (_, L _ xs) -> do
6767 breakpoint
68− parens N $ do
68+ parens N . sitcc $ do
6969 layout <- getLayout
7070 sep
7171 breakpoint
@@ -93,8 +93,9 @@ p_lie encLayout relativePos = \case
9393 inci $ do
9494 let names :: [R ()]
9595 names = located' p_ieWrappedName <$> xs
96− parens N . sep commaDel sitcc $
97− case w of
96+ parens N . sitcc
97+ $ sep (comma >> breakpoint) sitcc
98+ $ case w of
9899 NoIEWildcard -> names
99100 IEWildcard n ->
100101 let (before, after) = splitAt n names
src/Ormolu/Printer/Meat/Module.hs+2−2
@@ -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
@@ -69,7 +69,7 @@ p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do
6969 txt "where"
7070 newline
7171 newline
72− forM_ (normalizeImports hsmodImports) (located' (p_hsmodImport qualifiedPost))
72+ forM_ (sortImports hsmodImports) (located' (p_hsmodImport qualifiedPost))
7373 newline
7474 switchLayout (getLoc <$> hsmodDecls) $ do
7575 p_hsDecls Free hsmodDecls
src/Ormolu/Printer/Meat/Type.hs+15−11
@@ -67,7 +67,7 @@ p_hsType' multilineArgs docStyle = \case
6767 L _ (HsAppTy _ l r) -> gatherArgs l (r : knownArgs)
6868 _ -> (f', knownArgs)
6969 (func, args) = gatherArgs f [x]
70− switchLayout (getLoc f : fmap getLoc args) . sitcc $ do
70+ switchLayout (getLoc f : fmap getLoc args) $ sitcc $ do
7171 located func p_hsType
7272 breakpoint
7373 inci $
@@ -98,9 +98,10 @@ p_hsType' multilineArgs docStyle = \case
9898 HsBoxedTuple -> parens N
9999 HsConstraintTuple -> parens N
100100 HsBoxedOrConstraintTuple -> parens N
101− in parens' $ sep commaDel (sitcc . located' p_hsType) xs
101+ in parens' . sitcc $
102+ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
102103 HsSumTy NoExtField xs ->
103− parensHash N $
104+ parensHash N . sitcc $
104105 sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs
105106 HsOpTy NoExtField x op y ->
106107 sitcc $
@@ -117,9 +118,9 @@ p_hsType' multilineArgs docStyle = \case
117118 HsStarTy NoExtField _ -> txt "*"
118119 HsKindSig NoExtField t k -> sitcc $ do
119120 located t p_hsType
120− space
121+ space -- FIXME
121122 txt "::"
122− breakpoint
123+ space
123124 inci (located k p_hsType)
124125 HsSpliceTy NoExtField splice -> p_hsSplice splice
125126 HsDocTy NoExtField t str ->
@@ -153,14 +154,14 @@ p_hsType' multilineArgs docStyle = \case
153154 case (p, xs) of
154155 (IsPromoted, L _ t : _) | isPromoted t -> space
155156 _ -> return ()
156− sep commaDel (sitcc . located' p_hsType) xs
157+ sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
157158 HsExplicitTupleTy NoExtField xs -> do
158159 txt "'"
159160 parens N $ do
160161 case xs of
161162 L _ t : _ | isPromoted t -> space
162163 _ -> return ()
163− sep commaDel (located' p_hsType) xs
164+ sep (comma >> breakpoint) (located' p_hsType) xs
164165 HsTyLit NoExtField t ->
165166 case t of
166167 HsStrTy (SourceText s) _ -> p_stringLit s
@@ -191,7 +192,9 @@ p_hsContext :: HsContext GhcPs -> R ()
191192p_hsContext = \case
192193 [] -> txt "()"
193194 [x] -> located x p_hsType
194− xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs
195+ xs ->
196+ parens N . sitcc $
197+ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
195198
196199p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()
197200p_hsTyVarBndr = \case
@@ -221,14 +224,15 @@ p_forallBndrs vis p tyvars =
221224
222225p_conDeclFields :: [LConDeclField GhcPs] -> R ()
223226p_conDeclFields xs =
224− braces N $ sep commaDel (sitcc . located' p_conDeclField) xs
227+ braces N . sitcc $
228+ sep (comma >> breakpoint) (sitcc . located' p_conDeclField) xs
225229
226230p_conDeclField :: ConDeclField GhcPs -> R ()
227231p_conDeclField ConDeclField {..} = do
228232 mapM_ (p_hsDocString Pipe True) cd_fld_doc
229233 sitcc $
230234 sep
231− commaDel
235+ (comma >> breakpoint)
232236 (located' (p_rdrName . rdrNameFieldOcc))
233237 cd_fld_names
234238 space
@@ -270,6 +274,6 @@ tyVarToType = \case
270274 -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as
271275 -- long as 'tyVarToType' does not get applied to right-hand sides of
272276 -- declarations.
273− HsParTy NoExtField . noLoc $
277+ HsParTy NoExtField $ noLoc $
274278 HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind
275279 XTyVarBndr x -> noExtCon x
src/Ormolu/Printer/Operators.hs+59−46
@@ -12,11 +12,10 @@ where
1212
1313import Data.Function (on)
1414import qualified Data.List as L
15−import Data.Map.Strict (Map)
16−import qualified Data.Map.Strict as M
1715import Data.Maybe (fromMaybe, mapMaybe)
16+import Data.Ord (Down (Down), comparing)
1817import GHC
19−import OccName (occNameString)
18+import OccName (mkVarOcc)
2019import Ormolu.Utils (unSrcSpan)
2120
2221-- | Intermediate representation of operator trees. It has two type
@@ -57,7 +56,7 @@ reassociateOpTree getOpName opTree =
5756reassociateOpTreeWith ::
5857 forall ty op.
5958 -- | Fixity map for operators
60− Map String Fixity ->
59+ [(RdrName, Fixity)] ->
6160 -- | How to get the name of an operator
6261 (op -> Maybe RdrName) ->
6362 -- | Original 'OpTree'
@@ -68,13 +67,13 @@ reassociateOpTreeWith fixityMap getOpName = go
6867 where
6968 fixityOf :: op -> Fixity
7069 fixityOf op = fromMaybe defaultFixity $ do
71− s <- occNameString . rdrNameOcc <$> getOpName op
72− M.lookup s fixityMap
70+ opName <- getOpName op
71+ lookup opName fixityMap
7372 -- Here, left branch is already associated and the root alongside with
7473 -- the right branch is right-associated. This function picks up one item
7574 -- from the right and inserts it correctly to the left.
7675 --
77− -- Also, we are using the 'compareFixity' function which tells if the
76+ -- Also, we are using the 'compareFixity' function which returns if the
7877 -- expression should associate to right.
7978 go :: OpTree ty op -> OpTree ty op
8079 -- base cases
@@ -94,16 +93,6 @@ reassociateOpTreeWith fixityMap getOpName = go
9493 then go $ OpBranch (OpBranch l op (go $ OpBranch r op' l')) op'' r'
9594 else go $ OpBranch (OpBranch (OpBranch l op r) op' l') op'' r'
9695
97−-- | A score assigned to an operator.
98−data Score
99− = -- | The operator was placed at the beginning of a line
100− AtBeginning Int
101− | -- | The operator was placed at the end of a line
102− AtEnd
103− | -- | The operator was placed in between arguments on a single line
104− InBetween
105− deriving (Eq, Ord)
106−
10796-- | Build a map of inferred 'Fixity's from an 'OpTree'.
10897buildFixityMap ::
10998 forall ty op.
@@ -112,26 +101,23 @@ buildFixityMap ::
112101 -- | Operator tree
113102 OpTree (Located ty) (Located op) ->
114103 -- | Fixity map
115− Map String Fixity
104+ [(RdrName, Fixity)]
116105buildFixityMap getOpName opTree =
117− addOverrides
118− . M.fromList
119− . concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)
120− . zip [2 ..]
121− . L.groupBy ((==) `on` snd)
122− . selectScores
106+ concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)
107+ . zip [0 ..]
108+ . L.groupBy (doubleWithinEps 0.00001 `on` snd)
109+ . (overrides ++)
110+ . modeScores
123111 $ score opTree
124112 where
125− addOverrides :: Map String Fixity -> Map String Fixity
126− addOverrides m =
127− M.fromList
128− [ ("$", fixity 0 InfixR),
129− (":", fixity 1 InfixR),
130− (".", fixity 100 InfixL)
131− ]
132− `M.union` m
133− fixity = Fixity NoSourceText
134− score :: OpTree (Located ty) (Located op) -> [(String, Score)]
113+ -- Add a special case for ($), since it is pretty unlikely for someone
114+ -- to override it.
115+ overrides :: [(RdrName, Double)]
116+ overrides =
117+ [ (mkRdrUnqual $ mkVarOcc "$", -1)
118+ ]
119+ -- Assign scores to operators based on their location in the source.
120+ score :: OpTree (Located ty) (Located op) -> [(RdrName, Double)]
135121 score (OpNode _) = []
136122 score (OpBranch l o r) = fromMaybe (score r) $ do
137123 -- If we fail to get any of these, 'defaultFixity' will be used by
@@ -141,27 +127,48 @@ buildFixityMap getOpName opTree =
141127 oe <- srcSpanEndLine <$> unSrcSpan (getLoc o) -- operator end
142128 rb <- srcSpanStartLine <$> unSrcSpan (opTreeLoc r) -- right begin
143129 oc <- srcSpanStartCol <$> unSrcSpan (getLoc o) -- operator column
144− opName <- occNameString . rdrNameOcc <$> getOpName (unLoc o)
130+ opName <- getOpName (unLoc o)
145131 let s
146− | le < ob = AtBeginning oc
147− | oe < rb = AtEnd
148− | otherwise = InBetween
132+ | le < ob =
133+ -- if the operator is in the beginning of a line, assign
134+ -- a score relative to its column within range [0, 1).
135+ fromIntegral oc / fromIntegral (maxCol + 1)
136+ | oe < rb =
137+ -- if the operator is in the end of the line, assign the
138+ -- score 1.
139+ 1
140+ | otherwise =
141+ 2 -- otherwise, assign a high score.
149142 return $ (opName, s) : score r
150− selectScores :: [(String, Score)] -> [(String, Score)]
151− selectScores =
143+ -- Pick the most common score per 'RdrName'.
144+ modeScores :: [(RdrName, Double)] -> [(RdrName, Double)]
145+ modeScores =
152146 L.sortOn snd
153147 . mapMaybe
154148 ( \case
155149 [] -> Nothing
156− xs@((n, _) : _) -> Just (n, selectScore $ map snd xs)
150+ xs@((n, _) : _) -> Just (n, mode $ map snd xs)
157151 )
158152 . L.groupBy ((==) `on` fst)
159153 . L.sort
160− selectScore :: [Score] -> Score
161− selectScore xs =
162− case filter (/= InBetween) xs of
163− [] -> InBetween
164− xs' -> maximum xs'
154+ -- Return the most common number, leaning to the smaller
155+ -- one in case of a tie.
156+ mode :: [Double] -> Double
157+ mode =
158+ head
159+ . L.minimumBy (comparing (Down . length))
160+ . L.groupBy (doubleWithinEps 0.0001)
161+ . L.sort
162+ -- The start column of the rightmost operator.
163+ maxCol = go opTree
164+ where
165+ go (OpNode (L _ _)) = 0
166+ go (OpBranch l (L o _) r) =
167+ maximum
168+ [ go l,
169+ maybe 0 srcSpanStartCol (unSrcSpan o),
170+ go r
171+ ]
165172
166173----------------------------------------------------------------------------
167174-- Helpers
@@ -175,3 +182,9 @@ normalizeOpTree (OpBranch (OpNode l) lop r) =
175182 OpBranch (OpNode l) lop (normalizeOpTree r)
176183normalizeOpTree (OpBranch (OpBranch l' lop' r') lop r) =
177184 normalizeOpTree (OpBranch l' lop' (OpBranch r' lop r))
185+
186+fixity :: Int -> FixityDirection -> Fixity
187+fixity = Fixity NoSourceText
188+
189+doubleWithinEps :: Double -> Double -> Double -> Bool
190+doubleWithinEps eps a b = abs (a - b) < eps
src/Ormolu/Processing/Common.hs+1−1
@@ -20,7 +20,7 @@ data OrmoluState
2020
2121-- | Marker for the beginning of the region where Ormolu should be disabled.
2222startDisabling :: IsString s => s
23−startDisabling = "{- ORMOLU_DISABLE_START"
23+startDisabling = "{- ORMOLU_DISABLING_START"
2424
2525-- | Marker for the end of the region where Ormolu should be disabled.
2626endDisabling :: IsString s => s
src/Ormolu/Processing/Postprocess.hs+3−13
@@ -1,6 +1,3 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE ViewPatterns #-}
3−
41-- | Postprocessing for the results of printing.
52module Ormolu.Processing.Postprocess
63 ( postprocess,
@@ -13,19 +10,12 @@ import Ormolu.Processing.Common
1310import qualified Ormolu.Processing.Cpp as Cpp
1411
1512-- | Postprocess output of the formatter.
16−postprocess ::
17− -- | Desired indentation level
18− Int ->
19− -- | Input to process
20− Text ->
21− Text
22−postprocess indent =
13+postprocess :: Text -> Text
14+postprocess =
2315 T.unlines
24− . fmap indentLine
2516 . fmap Cpp.unmaskLine
2617 . filter (not . magicComment)
2718 . T.lines
2819 where
29− magicComment (T.stripStart -> x) =
20+ magicComment x =
3021 x == startDisabling || x == endDisabling
31− indentLine x = T.replicate indent " " <> x
src/Ormolu/Processing/Preprocess.hs+4−4
@@ -11,7 +11,8 @@ where
1111import Control.Monad
1212import Data.Char (isSpace)
1313import qualified Data.List as L
14−import Data.Maybe (isJust, maybeToList)
14+import Data.Maybe (isJust)
15+import Data.Maybe (maybeToList)
1516import FastString
1617import Ormolu.Config (RegionDeltas (..))
1718import Ormolu.Parser.Shebang (isShebang)
@@ -142,8 +143,7 @@ magicComment ::
142143 -- | Whether or not the two strings watch
143144 Bool
144145magicComment expected s0 = isJust $ do
145− let trim = dropWhile isSpace
146− s1 <- trim <$> L.stripPrefix "{-" (trim s0)
147− s2 <- trim <$> L.stripPrefix expected s1
146+ s1 <- dropWhile isSpace <$> L.stripPrefix "{-" s0
147+ s2 <- dropWhile isSpace <$> L.stripPrefix expected s1
148148 s3 <- L.stripPrefix "-}" s2
149149 guard (all isSpace s3)
src/Ormolu/Utils.hs+1−15
@@ -1,6 +1,5 @@
11{-# LANGUAGE LambdaCase #-}
22{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ViewPatterns #-}
43
54-- | Random utilities used by the code.
65module Ormolu.Utils
@@ -16,14 +15,12 @@ module Ormolu.Utils
1615 separatedByBlank,
1716 separatedByBlankNE,
1817 onTheSameLine,
19− removeIndentation,
2018 )
2119where
2220
23−import Data.Char (isSpace)
2421import Data.List (dropWhileEnd)
25−import Data.List.NonEmpty (NonEmpty (..))
2622import qualified Data.List.NonEmpty as NE
23+import Data.List.NonEmpty (NonEmpty (..))
2724import Data.Maybe (fromMaybe)
2825import Data.Text (Text)
2926import qualified Data.Text as T
@@ -142,14 +139,3 @@ separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b)
142139onTheSameLine :: SrcSpan -> SrcSpan -> Bool
143140onTheSameLine a b =
144141 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)