master..6dfd6f0 · ormolu

.buildkite/pipeline.yml+2−2

since splitsnapshots

unifiedsplit

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

3 command: |

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

5 timeout: 100

6− - label: Build and test with GHC 8.8.4

6+ - label: Build and test with GHC 8.8.3

7 command: |

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

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

9 timeout: 100

10 - label: Build and test with GHC 8.10.1

11 command: |

.github/workflows/binaries.ymldeleted−39

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

1−name: Build binaries

2−on:

3− release:

4− types: [published]

5−jobs:

6− build:

7− strategy:

8− fail-fast: false

9− matrix:

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

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

12− steps:

13− - uses: actions/checkout@v2

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

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

16− with:

17− ghc-version: '8.10.1'

18− cabal-version: '3.2'

19− - name: Build Linux binary

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

21− run: |

22− docker run \

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

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

25− bash .github/workflows/build.sh

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

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

28− shell: bash

29− run: |

30− cabal build exe:ormolu

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

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

33− env:

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

35− with:

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

37− asset_path: ormolu

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

39− asset_content_type: application/octet-stream

.github/workflows/build.shdeleted−7

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

1−set -e

2−

3−cabal update

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

5−

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

7−strip -s ormolu

CHANGELOG.md+1−40

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

1## Unreleased

2

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

3+* Duplicate imports in a single import list are now eliminated.

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

4

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

5* 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

6 fragment of code provided that the remaining code after exclusion of the

@@ -33,25 +13,6 @@

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

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

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

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

35

15

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

16## Ormolu 0.1.0.0

56

17

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

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

README.md+11−21

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

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

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

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

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

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

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

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

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

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

45

46```console

47$ cat stack.yaml

48−resolver: lts-16.0

48+resolver: lts-14.3

49packages:

50- '.'

51

52−$ stack build # to build

52+$ stack build

53−$ stack install # to install

54```

53```

55

54

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

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

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

130 criterion than just being valid Haskell modules.

129 criterion than just being valid Haskell modules.

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

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

132

131

132+## Editor integration

133+

134+We know of the following editor integrations:

135+

136+* [Emacs][emacs-package]

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

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

139+

133## Running on Hackage

140## Running on Hackage

134

141

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

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

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

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

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

145into Ormolu).

152into Ormolu).

146

153

147−## Editor integration

148−

149−We know of the following editor integrations:

150−

151−* [Emacs][emacs-package]

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

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

154−

155−## Arch Linux

156−

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

158−

159−```console

160−yay -S ormolu

161−```

162−

163## Contributing

154## Contributing

164

155

165See [CONTRIBUTING.md][contributing].

156See [CONTRIBUTING.md][contributing].

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

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

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

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

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

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

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

app/Main.hs+13−23

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

8

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

10import Control.Monad

11−import Data.Bool (bool)

12import Data.Either (lefts)

11import Data.Either (lefts)

13import Data.List (intercalate, sort)

12import Data.List (intercalate, sort)

14import qualified Data.Text.IO as TIO

13import qualified Data.Text.IO as TIO

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

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

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

62 exitWith (ExitFailure 101)

61 exitWith (ExitFailure 101)

63 Just inputFile -> do

62 Just inputFile -> do

64− originalInput <- TIO.readFile inputFile

65− formattedInput <- ormoluFile config inputFile

63+ r <- ormoluFile config inputFile

66 case mode of

64 case mode of

67 Stdout ->

65 Stdout ->

68− TIO.putStr formattedInput

66+ TIO.putStr r

69− InPlace -> do

67+ InPlace ->

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

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

72− -- formatted.

73− when (formattedInput /= originalInput) $

74− TIO.writeFile inputFile formattedInput

68+ TIO.writeFile inputFile r

75 Check -> do

69 Check -> do

76− when (formattedInput /= originalInput) $

70+ r' <- TIO.readFile inputFile

71+ when (r /= r') $

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

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

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

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

79 -- 'notImplemented'.

74 -- 'notImplemented'.

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

139optsParser :: Parser Opts

134optsParser :: Parser Opts

140optsParser =

135optsParser =

141 Opts

136 Opts

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

143− [ short 'i',

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

145− ]

146− <|> (option parseMode . mconcat)

137+ <$> (option parseMode . mconcat)

147− [ long "mode",

138+ [ long "mode",

148− short 'm',

139+ short 'm',

149− metavar "MODE",

140+ metavar "MODE",

150− value Stdout,

141+ value Stdout,

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

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

152− ]

143+ ]

153− )

154 <*> configParser

144 <*> configParser

155 <*> (many . strArgument . mconcat)

145 <*> (many . strArgument . mconcat)

156 [ metavar "FILE",

146 [ metavar "FILE",

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

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

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

2+

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

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

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

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

1−clientFunc1 :: SomeType1

2−clientFunc2 :: SomeType2

3−clientFunc3 :: SomeType3

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

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

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

1−clientFunc1 :: SomeType1

2−clientFunc2 :: SomeType2

3−clientFunc3 :: SomeType3

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

data/examples/declaration/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 @@

1{-# LANGUAGE ImplicitParams #-}

2

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

4−sortBy = undefined

5

4

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

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

7sort = sortBy ?cmp

6sort = sortBy ?cmp

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

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

1{-# LANGUAGE ImplicitParams #-}

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

3

4−sortBy = undefined

5−

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

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

7sort = sortBy ?cmp

5sort = sortBy ?cmp

8

6

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

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

13 throwIO (OrmoluCppEnabled path)

14

15foo =

16− bar $

16+ bar

17− baz $

17+ $ baz

18− quux

18+ $ quux

19

20x =

21 case l of { A -> B } $

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

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

17 `catch` \case

18 a -> a

19

20−foo =

20+foo = bar

21− bar

22− ++ case foo of

21+ ++ case foo of

23− a -> a

22+ a -> a

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

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

1lenses =

2− Just $

3− M.fromList $

2+ Just $ M.fromList $

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

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

5− # "connection" .= uc

4+ # "connection" .= uc

6− # "user" .= case name of

5+ # "user" .= case name of

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

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

8− Nothing -> Nothing

7+ Nothing -> Nothing

9− # []

8+ # []

10

9

11foo =

10foo =

12 a

11 a

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

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

1−foo =

2− testCase "Foo" testFoo :

3− testCase "Bar" testBar :

4− testCase "Baz" testBaz :

5− []

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

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

1−foo =

2− testCase "Foo" testFoo :

3− testCase "Bar" testBar :

4− testCase "Baz" testBaz :

5− []

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

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

1−instance A.ToJSON UpdateTable where

2− toJSON a =

3− A.object $

4− "TableName" .= updateTableName a :

5− "ProvisionedThroughput" .= updateProvisionedThroughput a :

6− case updateGlobalSecondaryIndexUpdates a of

7− [] -> []

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

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

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

1−instance A.ToJSON UpdateTable where

2− toJSON a = A.object

3− $ "TableName" .= updateTableName a

4− : "ProvisionedThroughput" .= updateProvisionedThroughput a

5− : case updateGlobalSecondaryIndexUpdates a of

6− [] -> []

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

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

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

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

2−getPath tree t =

3− t :

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

5− Nothing -> []

6− Just parent -> getPath tree parent

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

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

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

2−getPath tree t = t :

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

4− Nothing -> []

5− Just parent -> getPath tree parent

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

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

1−foo =

2− reportSDoc "tc.cc" 30 $

3− sep $ do

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

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

6−

7−foo =

8− reportSDoc "tc.cc" 30 $

9− sep $ do

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

11− do

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

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

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

1−foo =

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

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

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

5−

6−foo =

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

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

9− do

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

data/examples/declaration/value/function/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/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/qualified-post-out.hs+1−1

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

1{-# LANGUAGE ImportQualifiedPost #-}

2

3+import Data.Text qualified as T

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

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

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

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

5−import Data.Text qualified as T

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

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

1module P where

2

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

4import qualified Prelude

3import qualified Prelude

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

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

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

1import Data.Text

2+import Data.Text

3+import qualified Data.Text as T

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

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

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

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

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

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

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

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

5−import qualified Data.Text as T

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

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

9 -- | Foo

10 Int ->

11 Int

12+

12foo ::

13foo ::

13 Foo a =>

14 Foo a =>

14 -- | Foo

15 -- | Foo

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

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

1−module Main (main) where

2−

3−-- | Foo.

4−

5−-- Bar

6−main :: IO ()

7−main = return ()

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

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

1−module Main (main) where

2−

3−{- | Foo. -}

4−-- Bar

5−main :: IO ()

6−main = return ()

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

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

1ffff, ffffffff :: Natural

2+

2#ifdef HASKELL_ZIP_DEV_MODE

3#ifdef HASKELL_ZIP_DEV_MODE

3ffff = 200

4ffff = 200

4ffffffff = 5000

5ffffffff = 5000

data/examples/other/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+16−17

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

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

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

2−, system ? builtins.currentSystem

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

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

4}:

3}:

5

4

6let

5let

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

17 };

16 };

18 ormoluOverlay = self: super: {

17 ormoluOverlay = self: super: {

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

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

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

20+ (super.callHackageDirect {

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

22+ ver = "8.10.1.20200412";

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

24+ } {});

20 };

25 };

21 ormolize = import ./nix/ormolize {

26 ormolize = import ./nix/ormolize {

22 inherit pkgs;

27 inherit pkgs;

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

28 "distributed-process"

33 "distributed-process"

29 "esqueleto"

34 "esqueleto"

30 "fay"

35 "fay"

31− "hlint"

32 "idris"

36 "idris"

33 "intero"

37 "intero"

34 "leksah"

38 "leksah"

39+ "lens"

35 "pandoc"

40 "pandoc"

36 "pipes"

41 "pipes"

37− "postgrest"

38 "purescript"

42 "purescript"

39− "tensorflow"

43+ ];

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

41 ormolizedPackages = doCheck:

44 ormolizedPackages = doCheck:

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

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

43 package = p;

46 package = p;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

145 '';

146 '';

146 checkPhase = ''

147 checkPhase = ''

147 echo result-all-implicit.hs

148 echo result-all-implicit.hs

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

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

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

157 echo result-6-8.hs

158 echo result-6-8.hs

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

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

159− echo result-9-12.hs

160+ echo result-9-13.hs

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

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

161− echo result-17-18.hs

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

163 '';

162 '';

164 installPhase = ''

163 installPhase = ''

165 mkdir "$out"

164 mkdir "$out"

expected-failures/Agda.txt+2−2

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

1Formatting 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

3 before: " = (check_ac"

4 after: " =\n "

5Please, consider reporting the bug.

6

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

9 before: " nes\n\n "

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

11Please, consider reporting the bug.

expected-failures/esqueleto.txt+1−1

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

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

4

5The GHC parser (in Haddock mode) failed:

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

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

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

expected-failures/hlint.txtdeleted−11

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

1−Formatting is not idempotent:

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

3− before: "DoRec , -} Recursive"

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

5−Please, consider reporting the bug.

6−

7−Formatting is not idempotent:

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

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

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

11−Please, consider reporting the bug.

expected-failures/idris.txt+4

@@ -2,6 +2,10 @@ The GHC parser (in Haddock mode) failed:

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

3 parse error on input `@'

4

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

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

7+Please, consider reporting the bug.

8+

5The GHC parser (in Haddock mode) failed:

9The GHC parser (in Haddock mode) failed:

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

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

7 parse error on input `@'

11 parse error on input `@'

expected-failures/intero.txt+1−1

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

1Formatting is not idempotent:

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

2+ src/InteractiveUI.hs<rendered>:3688:33

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

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

5Please, consider reporting the bug.

expected-failures/leksah.txt+1−1

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

1Formatting is not idempotent:

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

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

3 before: "cr\n -- show"

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

5Please, consider reporting the bug.

expected-failures/pandoc.txt+1−1

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

3 parse error on input `import'

4

5Formatting is not idempotent:

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

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

7 before: ".softbreak <$ endlin"

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

9Please, consider reporting the bug.

expected-failures/postgrest.txtdeleted−5

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

1−Formatting is not idempotent:

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

3− before: " || -- clients"

4− after: " || ( origin ="

5−Please, consider reporting the bug.

expected-failures/purescript.txt+2−2

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

1The GHC parser (in Haddock mode) failed:

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

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

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

4Perhaps you meant to use PatternSynonyms?

5

6The GHC parser (in Haddock mode) failed:

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

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

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

9Perhaps you meant to use PatternSynonyms?

10

expected-failures/tensorflow.txtdeleted−7

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

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

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

3− parse error on input `->'

4−

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

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

7− parse error on input `import'

nix/nixpkgs/default.nix+3−7

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

1−{ system ? builtins.currentSystem }:

2let

1let

3− rev = "32b46dd897ab2143a609988a04d87452f0bbef59";

2+ rev = "807ca93fadd5197c2260490de0c76e500562dc05";

4− sha256 = "1gzfrpjnr1bz9zljsyg3a4zrhk8r927sz761mrgcg56dwinkhpjk";

3+ sha256 = "10yq8bnls77fh3pk5chkkb1sv5lbdgyk1rr2v9xn71rr1k2x563p";

5 nixpkgs = builtins.fetchTarball {

4 nixpkgs = builtins.fetchTarball {

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

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

7 inherit sha256;

6 inherit sha256;

8 };

7 };

9− pkgs = import nixpkgs {

10− inherit system;

11− config.allowUnfree = true;

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

12− };

13in pkgs

9in pkgs

ormolu.cabal+4−5

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

1cabal-version: 1.18

2name: ormolu

3−version: 0.1.2.0

3+version: 0.1.0.0

4license: BSD3

5license-file: LICENSE.md

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

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

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

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

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

10synopsis: A formatter for Haskell source code

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

119 base >=4.12 && <5.0,

120 bytestring >=0.2 && <0.11,

121 containers >=0.5 && <0.7,

122− dlist >=0.8 && <2.0,

122+ dlist >=0.8 && <0.9,

123 exceptions >=0.6 && <0.11,

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

125 mtl >=2.0 && <3.0,

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

144 base >=4.12 && <5.0,

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

146 gitrev >=1.3 && <1.4,

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

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

148 ormolu -any,

149 text >=0.2 && <1.3

150

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

152 ghc-options:

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

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

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

156

155

157 else

156 else

158 ghc-options: -O2 -Wall -rtsopts

157 ghc-options: -O2 -Wall -rtsopts

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

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

1−{-# LANGUAGE LambdaCase #-}

2−

3−module Foo (

4− foo, bar, baz) where

5−

6−foo :: Int

7−foo = 5

8−

9−bar :: Int -> Int

10−bar = \case

11− 0 -> foo

12− x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

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

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

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

10bar = \case

11 0 -> foo

12 x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

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

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

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

9bar = \case

10 0 -> foo

11 x -> x - foo

12−

13−baz :: Int -> Int

14−baz = gege

15− where

16− gege = 1 + 2

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

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

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

10bar = \case

11 0 -> foo

12 x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

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

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

3module Foo

4 ( foo,

5 bar,

6− baz,

7 )

6 )

8where

7where

9

8

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

14bar = \case

13bar = \case

15 0 -> foo

14 0 -> foo

16 x -> x - foo

15 x -> x - foo

17−

18−baz :: Int -> Int

19−baz = gege

20− where

21− gege = 1 + 2

region-tests/src.hs+1−6

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

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

10bar = \case

11 0 -> foo

12 x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

shell.nix+1−3

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

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

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

2−, system ? builtins.currentSystem

3−}:

4

2

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

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

src/Ormolu/Diff.hs+3−3

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

14import qualified Data.Text as T

15import qualified FastString as GHC

16import GHC

17−import Ormolu.Imports (normalizeImports)

17+import Ormolu.Imports (sortImports)

18import Ormolu.Parser.CommentStream

19import Ormolu.Parser.Result

20import Ormolu.Utils

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

47 } =

48 matchIgnoringSrcSpans cstream0 cstream1

49 <> matchIgnoringSrcSpans

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

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

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

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

52

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

54-- and the ordering of import lists.

src/Ormolu/Imports.hs+43−141

@@ -4,176 +4,78 @@

4

5-- | Manipulations on import lists.

6module Ormolu.Imports

7− ( normalizeImports,

7+ ( sortImports,

8 )

9where

10

11import Data.Bifunctor

12import Data.Char (isAlphaNum)

13import Data.Function (on)

14+import Data.Generics (gcompare)

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

15+import Data.List (nubBy, sortBy)

15−import Data.Map.Strict (Map)

16−import qualified Data.Map.Strict as M

17−import FastString (FastString)

18import GHC hiding (GhcPs, IE)

16import GHC hiding (GhcPs, IE)

19import GHC.Hs.Extension

17import GHC.Hs.Extension

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

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

21import Ormolu.Utils (notImplemented, showOutputable)

19import Ormolu.Utils (notImplemented, showOutputable)

22

20

23−-- | Sort and normalize imports.

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

22+-- each declaration.

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

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

25−normalizeImports =

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

26− fmap snd

27− . M.toAscList

28− . M.fromListWith combineImports

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

30 where

25 where

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

26+ sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs

32− L

27+ sortImportLists = \case

33− l

28+ ImportDecl {..} ->

34 ImportDecl

29 ImportDecl

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

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

36 ..

31 ..

37 }

32 }

38− g _ = notImplemented "XImportDecl"

33+ XImportDecl x -> noExtCon x

39

34

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

41−-- are equal.

42−combineImports ::

43− LImportDecl GhcPs ->

44− LImportDecl GhcPs ->

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

45− LImportDecl GhcPs

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

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

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

47− L

38+ case (isPrelude n0, isPrelude n1) of

48− lx

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

49− ImportDecl

40+ (True, False) -> GT

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

41+ (False, True) -> LT

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

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

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

53− _ -> Nothing,

54− ..

55− }

56−combineImports _ _ = notImplemented "XImportDecl"

57−

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

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

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

61−data ImportId = ImportId

62− { importIsPrelude :: Bool,

63− importIdName :: ModuleName,

64− importPkgQual :: Maybe FastString,

65− importSource :: Bool,

66− importSafe :: Bool,

67− importQualified :: Bool,

68− importImplicit :: Bool,

69− importAs :: Maybe ModuleName,

70− importHiding :: Maybe Bool

71− }

72− deriving (Eq, Ord)

73−

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

75−importId :: LImportDecl GhcPs -> ImportId

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

77− ImportId

78− { importIsPrelude = isPrelude,

79− importIdName = moduleName,

80− importPkgQual = sl_fs <$> ideclPkgQual,

81− importSource = ideclSource,

82− importSafe = ideclSafe,

83− importQualified = case ideclQualified of

84− QualifiedPre -> True

85− QualifiedPost -> True

86− NotQualified -> False,

87− importImplicit = ideclImplicit,

88− importAs = unLoc <$> ideclAs,

89− importHiding = fst <$> ideclHiding

90− }

91 where

43 where

44+ n0 = unLoc (ideclName m0)

45+ n1 = unLoc (ideclName m1)

92− isPrelude = moduleNameString moduleName == "Prelude"

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

93− moduleName = unLoc ideclName

94−importId _ = notImplemented "XImportDecl"

95

47

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

48+-- | Sort located import or export, dropping duplicates.

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

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

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

50+sortLies =

99− where

51+ nubBy (\x y -> compareLIE x y == EQ)

100− combine ::

52+ . sortBy compareLIE

101− Map IEWrappedNameOrd (LIE GhcPs) ->

53+ . fmap (fmap sortThings)

102− LIE GhcPs ->

103− Map IEWrappedNameOrd (LIE GhcPs)

104− combine m (L new_l new) =

105− let wname = getIewn new

106− normalizeWNames =

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

108− alter = \case

109− Nothing -> Just . L new_l $

110− case new of

111− IEThingWith NoExtField n wildcard g flbl ->

112− IEThingWith NoExtField n wildcard (normalizeWNames g) flbl

113− other -> other

114− Just old ->

115− let f = \case

116− IEVar NoExtField n -> IEVar NoExtField n

117− IEThingAbs NoExtField _ -> new

118− IEThingAll NoExtField n -> IEThingAll NoExtField n

119− IEThingWith NoExtField n wildcard g flbl ->

120− case new of

121− IEVar NoExtField _ ->

122− error "Ormolu.Imports broken presupposition"

123− IEThingAbs NoExtField _ ->

124− IEThingWith NoExtField n wildcard g flbl

125− IEThingAll NoExtField n' ->

126− IEThingAll NoExtField n'

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

128− let combinedWildcard =

129− case (wildcard, wildcard') of

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

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

132− _ -> NoIEWildcard

133− in IEThingWith

134− NoExtField

135− n'

136− combinedWildcard

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

138− flbl'

139− IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

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

141− IEDoc NoExtField _ -> notImplemented "IEDoc"

142− IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

143− XIE x -> noExtCon x

144− IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

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

146− IEDoc NoExtField _ -> notImplemented "IEDoc"

147− IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

148− XIE x -> noExtCon x

149− in Just (f <$> old)

150− in M.alter alter wname m

151

54

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

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

153−-- 'Ord' instance for it.

56+sortThings :: IE GhcPs -> IE GhcPs

154−newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)

57+sortThings = \case

155− deriving (Eq)

58+ IEThingWith NoExtField x w xs fl ->

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

60+ other -> other

156

61

157−instance Ord IEWrappedNameOrd where

62+-- | Compare a pair of located imports or exports.

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

63+compareLIE :: LIE GhcPs -> LIE GhcPs -> Ordering

64+compareLIE = compareIewn `on` getIewn . unLoc

159

65

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

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

161−getIewn :: IE GhcPs -> IEWrappedNameOrd

67+getIewn :: IE GhcPs -> IEWrappedName RdrName

162getIewn = \case

68getIewn = \case

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

69+ IEVar NoExtField x -> unLoc x

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

70+ IEThingAbs NoExtField x -> unLoc x

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

71+ IEThingAll NoExtField x -> unLoc x

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

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

167 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

73 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

168 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

74 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

169 IEDoc NoExtField _ -> notImplemented "IEDoc"

75 IEDoc NoExtField _ -> notImplemented "IEDoc"

170 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

76 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

171 XIE x -> noExtCon x

77 XIE x -> noExtCon x

172

78

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

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

175−compareLIewn = compareIewn `on` unLoc

176−

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

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

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

80compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering

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

81compareIewn (IEName x) (IEName y) = unLoc x `compareRdrName` unLoc y

src/Ormolu/Parser.hs+3−5

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

32import Ormolu.Parser.CommentStream

33import Ormolu.Parser.Result

34import Ormolu.Processing.Preprocess (preprocess)

35−import Ormolu.Utils (incSpanLine, removeIndentation)

35+import Ormolu.Utils (incSpanLine)

36import qualified Panic as GHC

37import qualified Parser as GHC

38import qualified StringBuffer as GHC

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

51 Either (SrcSpan, String) ParseResult

52 )

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

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

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

55 preprocess path rawInput cfgRegion

56− (input, indent) = removeIndentation indentedInput

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

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

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

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

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

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

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

111 prImportQualifiedPost =

110 prImportQualifiedPost =

112 GHC.xopt ImportQualifiedPost dynFlags,

111 GHC.xopt ImportQualifiedPost dynFlags,

113 prLiteralPrefix = T.pack literalPrefix,

112 prLiteralPrefix = T.pack literalPrefix,

114− prLiteralSuffix = T.pack literalSuffix,

113+ prLiteralSuffix = T.pack literalSuffix

115− prIndent = indent

116 }

114 }

117 return (warnings, r)

115 return (warnings, r)

118

116

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

@@ -28,7 +28,7 @@ import qualified Lexer as GHC

28import Ormolu.Parser.Pragma

29import Ormolu.Parser.Shebang

30import Ormolu.Processing.Common

31−import Ormolu.Utils (onTheSameLine, showOutputable)

31+import Ormolu.Utils (showOutputable)

32import SrcLoc

33

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

@@ -150,7 +150,6 @@ isMultilineComment (Comment _ (x :| _)) = "{-" `L.isPrefixOf` x

150

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

152extractStackHeader ::

153− -- | Comment stream to analyze

154 [RealLocated String] ->

153 [RealLocated String] ->

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

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

156extractStackHeader = \case

155extractStackHeader = \case

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

166

165

167-- | Extract pragmas and their associated comments.

166-- | Extract pragmas and their associated comments.

168extractPragmas ::

167extractPragmas ::

169− -- | Input

170 String ->

168 String ->

171− -- | Comment stream to analyze

172 [RealLocated String] ->

169 [RealLocated String] ->

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

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

174extractPragmas input = go initialLs id id

171extractPragmas input = go initialLs id id

@@ -182,17 +179,8 @@ extractPragmas input = go initialLs id id

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

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

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

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

184 Just pragma ->

181 Just pragma ->

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

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

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

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

187− in case xs of

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

189− (y : ys) ->

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

191− in if onTheSameLine

192− (RealSrcSpan (getRealSrcSpan x))

193− (RealSrcSpan (getRealSrcSpan y))

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

195− else go' ls [] xs

196

184

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

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

198unAnnotationComment :: GHC.AnnotationComment -> Maybe String

186unAnnotationComment :: GHC.AnnotationComment -> Maybe String

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

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

35 -- | Literal prefix

36 prLiteralPrefix :: Text,

37 -- | Literal suffix

38− prLiteralSuffix :: Text,

38+ prLiteralSuffix :: Text

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

40− prIndent :: Int

41 }

39 }

42

40

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

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

src/Ormolu/Printer.hs+1−1

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

23 prLiteralPrefix <> region <> prLiteralSuffix

24 where

25 region =

26− postprocess prIndent $

26+ postprocess $

27 runR

28 ( p_hsModule

29 prStackHeader

src/Ormolu/Printer/Comments.hs+2−2

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

154 -- | Last printed comment span

155 Maybe SpanMark ->

156 Bool

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

158needsNewlineBefore l mlastMark =

157needsNewlineBefore l mlastMark =

159 case spanMarkSpan <$> mlastMark of

158 case spanMarkSpan <$> mlastMark of

160 Nothing -> False

159 Nothing -> False

@@ -239,7 +238,8 @@ commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =

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

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

240 not (hasAtomsBefore comment)

239 not (hasAtomsBefore comment)

241 && ( case mlastMark of

240 && ( case mlastMark of

242− Just (HaddockSpan _ _) -> False

241+ Just (HaddockSpan _ spn) ->

242+ srcSpanEndLine spn + 1 == srcSpanStartLine l

243 Just (CommentSpan spn) ->

244 srcSpanEndLine spn + 1 == srcSpanStartLine l

245 _ -> False

src/Ormolu/Printer/Meat/Common.hs+1−1

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

131 parens' $ do

132 p0

133 breakpoint

134− inci . sitcc $ do

134+ inci $ sitcc $ do

135 name

136 space

137 p1

src/Ormolu/Printer/Meat/Declaration.hs+13−25

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

54p_hsDeclsRespectGrouping = p_hsDecls' Respect

55

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

57−p_hsDecls' grouping style decls =

57+p_hsDecls' grouping style decls = sepSemi id $

58− sepSemi id $

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

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

60− -- groups.

59+ -- groups.

61− case groupDecls decls of

60+ case groupDecls decls of

62− [] -> []

61+ [] -> []

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

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

64 where

63 where

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

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

66 renderGroupWithPrev prev curr =

65 renderGroupWithPrev prev curr =

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

85 isHaddock _ = False

84 isHaddock _ = False

86

85

87-- | Group relevant declarations together.

86-- | Group relevant declarations together.

87+--

88+-- Add a declaration to a group iff it is relevant to either the first or

89+-- the preceding declaration in the group.

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

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

89groupDecls [] = []

91groupDecls [] = []

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

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

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

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

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

98 let relevantToHdr = groupedDecls header current

100 let relevantToHdr = groupedDecls header current

99 relevantToPrev = groupedDecls previous current

101 relevantToPrev = groupedDecls previous current

100− isDeclSeries = declSeries previous current

101− in isDeclSeries || relevantToHdr || relevantToPrev

102+ in relevantToHdr || relevantToPrev

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

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

103

104

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

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

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

195 (_, DocPrev) -> True

196 (_, DocPrev) -> True

196 _ -> False

197 _ -> False

197

198

198−-- | Detect declaration series that should not have blanks between them.

199−declSeries ::

200− LHsDecl GhcPs ->

201− LHsDecl GhcPs ->

202− Bool

203−declSeries (L _ x) (L _ y) =

204− case (x, y) of

205− ( SigD NoExtField (TypeSig NoExtField _ _),

206− SigD NoExtField (TypeSig NoExtField _ _)

207− ) -> True

208− _ -> False

209−

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

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

211intersects a b = go (sort a) (sort b)

200intersects a b = go (sort a) (sort b)

212 where

201 where

@@ -299,10 +288,9 @@ patSigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc

299patSigRdrNames _ = Nothing

288patSigRdrNames _ = Nothing

300

289

301warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

290warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

302−warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $

291+warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $ flip concatMap ws $ \case

303− flip concatMap ws $ \case

304− L _ (Warning NoExtField ns _) -> map unLoc ns

292+ L _ (Warning NoExtField ns _) -> map unLoc ns

305− L _ (XWarnDecl x) -> noExtCon x

293+ L _ (XWarnDecl x) -> noExtCon x

306warnSigRdrNames _ = Nothing

294warnSigRdrNames _ = Nothing

307

295

308patBindNames :: Pat GhcPs -> [RdrName]

296patBindNames :: Pat GhcPs -> [RdrName]

src/Ormolu/Printer/Meat/Declaration.hs-boot+1

@@ -9,4 +9,5 @@ import Ormolu.Printer.Combinators

9import Ormolu.Printer.Meat.Common

10

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

12+

12p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

13p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

src/Ormolu/Printer/Meat/Declaration/Data.hs+22−20

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

60 txt "where"

61 breakpoint

62 sepSemi (located' (p_conDecl False)) dd_cons

63− else switchLayout (getLoc name : (getLoc <$> dd_cons)) . inci $ do

63+ else switchLayout (getLoc name : (getLoc <$> dd_cons))

64+ $ inci

65+ $ do

64− let singleConstRec = isSingleConstRec dd_cons

66+ let singleConstRec = isSingleConstRec dd_cons

65− if singleConstRec

67+ if singleConstRec

66− then space

68+ then space

67− else

69+ else

68− if hasHaddocks dd_cons

70+ if hasHaddocks dd_cons

69− then newline

71+ then newline

70− else breakpoint

72+ else breakpoint

71− equals

73+ equals

72− space

74+ space

73− layout <- getLayout

75+ layout <- getLayout

74− let s =

76+ let s =

75− if layout == MultiLine || hasHaddocks dd_cons

77+ if layout == MultiLine || hasHaddocks dd_cons

76− then newline >> txt "|" >> space

78+ then newline >> txt "|" >> space

77− else space >> txt "|" >> space

79+ else space >> txt "|" >> space

78− sitcc' =

80+ sitcc' =

79− if singleConstRec

81+ if singleConstRec

80− then id

82+ then id

81− else sitcc

83+ else sitcc

82− sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons

84+ sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons

83 unless (null $ unLoc dd_derivs) breakpoint

85 unless (null $ unLoc dd_derivs) breakpoint

84 inci . located dd_derivs $ \xs ->

86 inci . located dd_derivs $ \xs ->

85 sep newline (located' p_hsDerivingClause) xs

87 sep newline (located' p_hsDerivingClause) xs

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

@@ -88,10 +88,12 @@ p_clsInstDecl = \case

88 unless (null allDecls) $ do

89 breakpoint

90 txt "where"

91− unless (null allDecls) . inci $ do

91+ unless (null allDecls)

92+ $ inci

93+ $ do

92− -- Ensure whitespace is added after where clause.

94+ -- Ensure whitespace is added after where clause.

93− breakpoint

95+ breakpoint

94− dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

96+ dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

95 XHsImplicitBndrs x -> noExtCon x

97 XHsImplicitBndrs x -> noExtCon x

96 XClsInstDecl x -> noExtCon x

98 XClsInstDecl x -> noExtCon x

97

99

src/Ormolu/Printer/Meat/Declaration/Value.hs+92−107

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

1{-# LANGUAGE LambdaCase #-}

2−{-# LANGUAGE MultiWayIf #-}

3{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE RecordWildCards #-}

3{-# LANGUAGE RecordWildCards #-}

5{-# LANGUAGE TypeApplications #-}

4{-# LANGUAGE TypeApplications #-}

@@ -27,7 +26,7 @@ import qualified Data.List.NonEmpty as NE

27import Data.Text (Text)

26import Data.Text (Text)

28import qualified Data.Text as Text

27import qualified Data.Text as Text

29import GHC

28import GHC

30−import OccName (occNameString)

29+import OccName (mkVarOcc)

31import Ormolu.Printer.Combinators

30import Ormolu.Printer.Combinators

32import Ormolu.Printer.Internal

31import Ormolu.Printer.Internal

33import Ormolu.Printer.Meat.Common

32import Ormolu.Printer.Meat.Common

@@ -61,7 +60,7 @@ data Placement

61 -- should use it and avoid bumping one level

60 -- should use it and avoid bumping one level

62 -- of indentation

61 -- of indentation

63 Hanging

62 Hanging

64− deriving (Eq, Show)

63+ deriving (Eq)

65

64

66p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

65p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

67p_valDecl = \case

66p_valDecl = \case

@@ -181,15 +180,13 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

181 SrcStrict -> txt "!"

180 SrcStrict -> txt "!"

182 SrcLazy -> txt "~"

181 SrcLazy -> txt "~"

183 indentBody <- case NE.nonEmpty m_pats of

182 indentBody <- case NE.nonEmpty m_pats of

184− Nothing ->

185− False <$ case style of

183+ Nothing -> False <$ case style of

186− Function name -> p_rdrName name

184+ Function name -> p_rdrName name

187− _ -> return ()

185+ _ -> return ()

188 Just ne_pats -> do

186 Just ne_pats -> do

189− let combinedSpans = case style of

187+ let combinedSpans =

190− Function name -> combineSrcSpans (getLoc name) patSpans

191− _ -> patSpans

192− patSpans = combineSrcSpans' (getLoc <$> ne_pats)

188+ combineSrcSpans' $

189+ getLoc <$> ne_pats

193 indentBody = not (isOneLineSpan combinedSpans)

190 indentBody = not (isOneLineSpan combinedSpans)

194 switchLayout [combinedSpans] $ do

191 switchLayout [combinedSpans] $ do

195 let stdCase = sep breakpoint (located' p_pat) m_pats

192 let stdCase = sep breakpoint (located' p_pat) m_pats

@@ -353,14 +350,7 @@ p_hsCmdTop = \case

353 HsCmdTop NoExtField cmd -> located cmd p_hsCmd

350 HsCmdTop NoExtField cmd -> located cmd p_hsCmd

354 XCmdTop x -> noExtCon x

351 XCmdTop x -> noExtCon x

355

352

356−-- | Render an expression preserving blank lines between such consecutive

357−-- expressions found in the original source code.

358−withSpacing ::

353+withSpacing :: Data a => (a -> R ()) -> Located a -> R ()

359− -- | Rendering function

360− (a -> R ()) ->

361− -- | Entity to render

362− Located a ->

363− R ()

364withSpacing f l = located l $ \x -> do

354withSpacing f l = located l $ \x -> do

365 case getLoc l of

355 case getLoc l of

366 UnhelpfulSpan _ -> f x

356 UnhelpfulSpan _ -> f x

@@ -471,24 +461,30 @@ gatherStmtBlock (XParStmtBlock x) = noExtCon x

471p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()

461p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()

472p_hsLocalBinds = \case

462p_hsLocalBinds = \case

473 HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do

463 HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do

464+ let ssStart =

465+ either

466+ (srcSpanStart . getLoc)

467+ (srcSpanStart . getLoc)

468+ items =

469+ (Left <$> bagToList bag) ++ (Right <$> lsigs)

470+ p_item (Left x) = located x p_valDecl

471+ p_item (Right x) = located x p_sigDecl

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

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

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

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

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

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

477 br <- layoutToBraces <$> getLayout

475 br <- layoutToBraces <$> getLayout

478− let items =

476+ sitcc $

479− let injectLeft (L l x) = L l (Left x)

477+ sepSemi

480− injectRight (L l x) = L l (Right x)

478+ ( \(p, i) ->

481− in (injectLeft <$> bagToList bag) ++ (injectRight <$> lsigs)

479+ ( case p of

482− positionToBracing = \case

483− SinglePos -> id

480+ SinglePos -> id

484− FirstPos -> br

481+ FirstPos -> br

485− MiddlePos -> br

482+ MiddlePos -> br

486− LastPos -> id

483+ LastPos -> id

487− p_item' (p, item) =

484+ )

488− positionToBracing p $

485+ (p_item i)

489− withSpacing (either p_valDecl p_sigDecl) item

486+ )

490− binds = sortOn (srcSpanStart . getLoc) items

487+ (attachRelativePos $ sortOn ssStart items)

491− sitcc $ sepSemi p_item' (attachRelativePos binds)

492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

488 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

489 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

494 -- Second argument of IPBind is always Left before type-checking.

490 -- Second argument of IPBind is always Left before type-checking.

@@ -521,6 +517,12 @@ p_hsRecField HsRecField {..} = do

521 else Normal

517 else Normal

522 placeHanging placement (located hsRecFieldArg p_hsExpr)

518 placeHanging placement (located hsRecFieldArg p_hsExpr)

523

519

520+p_hsTupArg :: HsTupArg GhcPs -> R ()

521+p_hsTupArg = \case

522+ Present NoExtField x -> located x p_hsExpr

523+ Missing NoExtField -> pure ()

524+ XTupArg x -> noExtCon x

525+

524p_hsExpr :: HsExpr GhcPs -> R ()

526p_hsExpr :: HsExpr GhcPs -> R ()

525p_hsExpr = p_hsExpr' N

527p_hsExpr = p_hsExpr' N

526

528

@@ -590,10 +592,9 @@ p_hsExpr' s = \case

590 L _ (HsAppType NoExtField _ _) -> True

592 L _ (HsAppType NoExtField _ _) -> True

591 L _ (HsMultiIf NoExtField _) -> True

593 L _ (HsMultiIf NoExtField _) -> True

592 L spn _ -> isOneLineSpan spn

594 L spn _ -> isOneLineSpan spn

593− ub <-

594− getLayout <&> \case

595+ ub <- getLayout <&> \case

595− SingleLine -> useBraces

596+ SingleLine -> useBraces

596− MultiLine -> id

597+ MultiLine -> id

597 ub $ do

598 ub $ do

598 located func (p_hsExpr' s)

599 located func (p_hsExpr' s)

599 breakpoint

600 breakpoint

@@ -613,15 +614,10 @@ p_hsExpr' s = \case

613 breakpoint

614 breakpoint

614 inci $ do

615 inci $ do

615 txt "@"

616 txt "@"

616− -- Insert a space when the type is represented as a TH splice to avoid

617− -- gluing @ and $ together.

618− case unLoc (hswc_body a) of

619− HsSpliceTy {} -> space

620− _ -> return ()

621 located (hswc_body a) p_hsType

617 located (hswc_body a) p_hsType

622 OpApp NoExtField x op y -> do

618 OpApp NoExtField x op y -> do

623 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)

619 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)

624− p_exprOpTree s (reassociateOpTree getOpName opTree)

620+ p_exprOpTree True s (reassociateOpTree getOpName opTree)

625 NegApp NoExtField e _ -> do

621 NegApp NoExtField e _ -> do

626 txt "-"

622 txt "-"

627 space

623 space

@@ -638,27 +634,22 @@ p_hsExpr' s = \case

638 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)

634 let isRecordDot' = isRecordDot (unLoc op) (getLoc x)

639 unless (useRecordDot' && isRecordDot') breakpoint

635 unless (useRecordDot' && isRecordDot') breakpoint

640 inci (located x p_hsExpr)

636 inci (located x p_hsExpr)

641− ExplicitTuple NoExtField args boxity ->

637+ ExplicitTuple NoExtField args boxity -> do

642 let isSection = any (isMissing . unLoc) args

638 let isSection = any (isMissing . unLoc) args

643 isMissing = \case

639 isMissing = \case

644 Missing NoExtField -> True

640 Missing NoExtField -> True

645 _ -> False

641 _ -> 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' =

642+ let parens' =

652 case boxity of

643 case boxity of

653 Boxed -> parens

644 Boxed -> parens

654 Unboxed -> parensHash

645 Unboxed -> parensHash

655− in if isSection

646+ if isSection

656− then

647+ then

657− switchLayout [] . parens' s $

648+ switchLayout [] . parens' s $

658− sep comma p_larg args

649+ sep comma (located' p_hsTupArg) args

659− else

650+ else

660− switchLayout (getLoc <$> args) . parens' s $

651+ switchLayout (getLoc <$> args) . parens' s $

661− sep commaDel p_larg args

652+ sep commaDel (sitcc . located' p_hsTupArg) args

662 ExplicitSum NoExtField tag arity e ->

653 ExplicitSum NoExtField tag arity e ->

663 p_unboxedSum N tag arity (located e p_hsExpr)

654 p_unboxedSum N tag arity (located e p_hsExpr)

664 HsCase NoExtField e mgroup ->

655 HsCase NoExtField e mgroup ->

@@ -680,7 +671,7 @@ p_hsExpr' s = \case

680 sepSemi

671 sepSemi

681 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))

672 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))

682 (unLoc es)

673 (unLoc es)

683− compBody = brackets N . located es $ \xs -> do

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

684 let p_parBody =

675 let p_parBody =

685 sep

676 sep

686 (breakpoint >> txt "|" >> space)

677 (breakpoint >> txt "|" >> space)

@@ -1231,10 +1222,11 @@ exprPlacement = \case

1231 HsCase NoExtField _ _ -> Hanging

1222 HsCase NoExtField _ _ -> Hanging

1232 HsDo NoExtField DoExpr _ -> Hanging

1223 HsDo NoExtField DoExpr _ -> Hanging

1233 HsDo NoExtField MDoExpr _ -> Hanging

1224 HsDo NoExtField MDoExpr _ -> Hanging

1234− OpApp NoExtField _ op y ->

1225+ -- If the rightmost expression in an operator chain is hanging, make the

1235− case (fmap getOpNameStr . getOpName . unLoc) op of

1226+ -- whole block hanging; so that we can use the common @f = foo $ do@

1227+ -- style.

1236− Just "$" -> exprPlacement (unLoc y)

1228+ OpApp NoExtField _ _ y -> exprPlacement (unLoc y)

1237− _ -> Normal

1229+ -- Same thing for function applications (usually with -XBlockArguments)

1238 HsApp NoExtField _ y -> exprPlacement (unLoc y)

1230 HsApp NoExtField _ y -> exprPlacement (unLoc y)

1239 HsProc NoExtField p _ ->

1231 HsProc NoExtField p _ ->

1240 -- Indentation breaks if pattern is longer than one line and left

1232 -- Indentation breaks if pattern is longer than one line and left

@@ -1260,16 +1252,15 @@ getOpName = \case

1260 HsVar NoExtField (L _ a) -> Just a

1252 HsVar NoExtField (L _ a) -> Just a

1261 _ -> Nothing

1253 _ -> Nothing

1262

1254

1263−getOpNameStr :: RdrName -> String

1264−getOpNameStr = occNameString . rdrNameOcc

1265−

1266p_exprOpTree ::

1255p_exprOpTree ::

1256+ -- | Can use special handling of dollar?

1257+ Bool ->

1267 -- | Bracket style to use

1258 -- | Bracket style to use

1268 BracketStyle ->

1259 BracketStyle ->

1269 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->

1260 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->

1270 R ()

1261 R ()

1271−p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)

1262+p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)

1272−p_exprOpTree s (OpBranch x op y) = do

1263+p_exprOpTree isDollarSpecial s (OpBranch x op y) = do

1273 -- If the beginning of the first argument and the second argument are on

1264 -- If the beginning of the first argument and the second argument are on

1274 -- the same line, and the second argument has a hanging form, use hanging

1265 -- the same line, and the second argument has a hanging form, use hanging

1275 -- placement.

1266 -- placement.

@@ -1291,54 +1282,44 @@ p_exprOpTree s (OpBranch x op y) = do

1291 MultiLine -> case placement of

1282 MultiLine -> case placement of

1292 Hanging -> useBraces

1283 Hanging -> useBraces

1293 Normal -> dontUseBraces

1284 Normal -> dontUseBraces

1294− opNameStr = (fmap getOpNameStr . getOpName . unLoc) op

1285+ gotDollar = case getOpName (unLoc op) of

1295− gotDollar = opNameStr == Just "$"

1286+ Just rname -> mkVarOcc "$" == rdrNameOcc rname

1296− gotColon = opNameStr == Just ":"

1287+ _ -> False

1297− gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)

1298 lhs =

1288 lhs =

1299 switchLayout [opTreeLoc x] $

1289 switchLayout [opTreeLoc x] $

1300− p_exprOpTree s x

1290+ p_exprOpTree (not gotDollar) s x

1301− p_op = located op (opWrapper . p_hsExpr)

1291+ let p_op = located op (opWrapper . p_hsExpr)

1302− p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y)

1292+ p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)

1303 isSection = case (opTreeLoc x, getLoc op) of

1293 isSection = case (opTreeLoc x, getLoc op) of

1304 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1294 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1305 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1295 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1306 _ -> False

1296 _ -> False

1307− isDoBlock = \case

1308− OpNode (L _ HsDo {}) -> True

1309− _ -> False

1310 useRecordDot' <- useRecordDot

1297 useRecordDot' <- useRecordDot

1311− if

1298+ let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)

1312− | gotColon -> do

1299+ if useRecordDot' && isRecordDot'

1313− lhs

1300+ then do

1301+ lhs

1302+ when isSection space

1303+ p_op

1304+ p_y

1305+ else

1306+ if isDollarSpecial

1307+ && gotDollar

1308+ && placement

1309+ == Normal

1310+ && isOneLineSpan (opTreeLoc x)

1311+ then do

1312+ useBraces lhs

1314− space

1313+ space

1315− p_op

1314+ p_op

1316− case placement of

1315+ breakpoint

1317− Hanging -> do

1316+ inci p_y

1317+ else do

1318+ ub lhs

1319+ placeHanging placement $ do

1320+ p_op

1318 space

1321 space

1319 p_y

1322 p_y

1320− Normal -> do

1321− breakpoint

1322− inciIf (isDoBlock y) p_y

1323− | gotDollar

1324− && isOneLineSpan (opTreeLoc x)

1325− && placement == Normal -> do

1326− useBraces lhs

1327− space

1328− p_op

1329− breakpoint

1330− inci p_y

1331− | useRecordDot' && gotRecordDot -> do

1332− lhs

1333− when isSection space

1334− p_op

1335− p_y

1336− | otherwise -> do

1337− ub lhs

1338− placeHanging placement $ do

1339− p_op

1340− space

1341− p_y

1342

1323

1343-- | Return 'True' if given expression is a record-dot operator expression.

1324-- | Return 'True' if given expression is a record-dot operator expression.

1344isRecordDot ::

1325isRecordDot ::

@@ -1349,10 +1330,14 @@ isRecordDot ::

1349 Bool

1330 Bool

1350isRecordDot op (RealSrcSpan ySpan) = case op of

1331isRecordDot op (RealSrcSpan ySpan) = case op of

1351 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->

1332 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->

1352− (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)

1333+ isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)

1353 _ -> False

1334 _ -> False

1354isRecordDot _ _ = False

1335isRecordDot _ _ = False

1355

1336

1337+-- | Check whether a given 'RdrName' is the dot operator.

1338+isDot :: RdrName -> Bool

1339+isDot name = rdrNameOcc name == mkVarOcc "."

1340+

1356-- | Get annotations for the enclosing element.

1341-- | Get annotations for the enclosing element.

1357getEnclosingAnns :: R [AnnKeywordId]

1342getEnclosingAnns :: R [AnnKeywordId]

1358getEnclosingAnns = do

1343getEnclosingAnns = do

src/Ormolu/Printer/Meat/Declaration/Value.hs-boot+4

@@ -11,7 +11,11 @@ import GHC

11import Ormolu.Printer.Combinators

12

13p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

14+

14p_pat :: Pat GhcPs -> R ()

15p_pat :: Pat GhcPs -> R ()

16+

15p_hsExpr :: HsExpr GhcPs -> R ()

17p_hsExpr :: HsExpr GhcPs -> R ()

18+

16p_hsSplice :: HsSplice GhcPs -> R ()

19p_hsSplice :: HsSplice GhcPs -> R ()

20+

17p_stringLit :: String -> R ()

21p_stringLit :: String -> R ()

src/Ormolu/Printer/Meat/Declaration/Warning.hs+3−2

@@ -32,8 +32,9 @@ p_moduleWarning wtxt = do

32p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()

33p_topLevelWarning fnames wtxt = do

34 let (pragmaText, lits) = warningText wtxt

35− switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $

35+ switchLayout (fmap getLoc fnames ++ fmap getLoc lits)

36− pragma pragmaText . inci $ do

36+ $ pragma pragmaText . inci

37+ $ do

37 sep commaDel p_rdrName fnames

38 sep commaDel p_rdrName fnames

38 breakpoint

39 breakpoint

39 p_lits lits

40 p_lits lits

src/Ormolu/Printer/Meat/ImportExport.hs+3−2

@@ -93,8 +93,9 @@ p_lie encLayout relativePos = \case

93 inci $ do

94 let names :: [R ()]

95 names = located' p_ieWrappedName <$> xs

96+ parens N

96− parens N . sep commaDel sitcc $

97+ $ sep commaDel sitcc

97− case w of

98+ $ case w of

98 NoIEWildcard -> names

99 NoIEWildcard -> names

99 IEWildcard n ->

100 IEWildcard n ->

100 let (before, after) = splitAt n names

101 let (before, after) = splitAt n names

src/Ormolu/Printer/Meat/Module.hs+2−2

@@ -11,7 +11,7 @@ where

11import Control.Monad

12import qualified Data.Text as T

13import GHC

14−import Ormolu.Imports (normalizeImports)

14+import Ormolu.Imports

15import Ormolu.Parser.CommentStream

16import Ormolu.Parser.Pragma

17import Ormolu.Parser.Shebang

@@ -69,7 +69,7 @@ p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do

69 txt "where"

70 newline

71 newline

72− forM_ (normalizeImports hsmodImports) (located' (p_hsmodImport qualifiedPost))

72+ forM_ (sortImports hsmodImports) (located' (p_hsmodImport qualifiedPost))

73 newline

74 switchLayout (getLoc <$> hsmodDecls) $ do

75 p_hsDecls Free hsmodDecls

src/Ormolu/Printer/Meat/Type.hs+2−2

@@ -67,7 +67,7 @@ p_hsType' multilineArgs docStyle = \case

67 L _ (HsAppTy _ l r) -> gatherArgs l (r : knownArgs)

68 _ -> (f', knownArgs)

69 (func, args) = gatherArgs f [x]

70− switchLayout (getLoc f : fmap getLoc args) . sitcc $ do

70+ switchLayout (getLoc f : fmap getLoc args) $ sitcc $ do

71 located func p_hsType

72 breakpoint

73 inci $

@@ -270,6 +270,6 @@ tyVarToType = \case

270 -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as

271 -- long as 'tyVarToType' does not get applied to right-hand sides of

272 -- declarations.

273− HsParTy NoExtField . noLoc $

273+ HsParTy NoExtField $ noLoc $

274 HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind

275 XTyVarBndr x -> noExtCon x

src/Ormolu/Printer/Operators.hs+16−16

@@ -16,7 +16,7 @@ import Data.Map.Strict (Map)

16import qualified Data.Map.Strict as M

17import Data.Maybe (fromMaybe, mapMaybe)

18import GHC

19−import OccName (occNameString)

19+import OccName (mkVarOcc)

20import Ormolu.Utils (unSrcSpan)

21

22-- | Intermediate representation of operator trees. It has two type

@@ -57,7 +57,7 @@ reassociateOpTree getOpName opTree =

57reassociateOpTreeWith ::

58 forall ty op.

59 -- | Fixity map for operators

60− Map String Fixity ->

60+ Map RdrName Fixity ->

61 -- | How to get the name of an operator

62 (op -> Maybe RdrName) ->

63 -- | Original 'OpTree'

@@ -68,8 +68,8 @@ reassociateOpTreeWith fixityMap getOpName = go

68 where

69 fixityOf :: op -> Fixity

70 fixityOf op = fromMaybe defaultFixity $ do

71− s <- occNameString . rdrNameOcc <$> getOpName op

71+ opName <- getOpName op

72− M.lookup s fixityMap

72+ M.lookup opName fixityMap

73 -- Here, left branch is already associated and the root alongside with

74 -- the right branch is right-associated. This function picks up one item

75 -- from the right and inserts it correctly to the left.

@@ -112,26 +112,26 @@ buildFixityMap ::

112 -- | Operator tree

113 OpTree (Located ty) (Located op) ->

114 -- | Fixity map

115− Map String Fixity

115+ Map RdrName Fixity

116buildFixityMap getOpName opTree =

117 addOverrides

118 . M.fromList

119 . concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)

120− . zip [2 ..]

120+ . zip [1 ..]

121 . L.groupBy ((==) `on` snd)

122 . selectScores

123 $ score opTree

124 where

125− addOverrides :: Map String Fixity -> Map String Fixity

125+ addOverrides :: Map RdrName Fixity -> Map RdrName Fixity

126 addOverrides m =

127+ let mk k v = (mkRdrUnqual (mkVarOcc k), fixity v InfixL)

127− M.fromList

128+ in M.fromList

128− [ ("$", fixity 0 InfixR),

129+ [ mk "$" 0,

129− (":", fixity 1 InfixR),

130+ mk "." 9

130− (".", fixity 100 InfixL)

131− ]

131+ ]

132− `M.union` m

132+ `M.union` m

133 fixity = Fixity NoSourceText

134− score :: OpTree (Located ty) (Located op) -> [(String, Score)]

134+ score :: OpTree (Located ty) (Located op) -> [(RdrName, Score)]

135 score (OpNode _) = []

136 score (OpBranch l o r) = fromMaybe (score r) $ do

137 -- If we fail to get any of these, 'defaultFixity' will be used by

@@ -141,13 +141,13 @@ buildFixityMap getOpName opTree =

141 oe <- srcSpanEndLine <$> unSrcSpan (getLoc o) -- operator end

142 rb <- srcSpanStartLine <$> unSrcSpan (opTreeLoc r) -- right begin

143 oc <- srcSpanStartCol <$> unSrcSpan (getLoc o) -- operator column

144− opName <- occNameString . rdrNameOcc <$> getOpName (unLoc o)

144+ opName <- getOpName (unLoc o)

145 let s

146 | le < ob = AtBeginning oc

147 | oe < rb = AtEnd

148 | otherwise = InBetween

149 return $ (opName, s) : score r

150− selectScores :: [(String, Score)] -> [(String, Score)]

150+ selectScores :: [(RdrName, Score)] -> [(RdrName, Score)]

151 selectScores =

152 L.sortOn snd

153 . mapMaybe

src/Ormolu/Processing/Postprocess.hs+2−10

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

1−{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE ViewPatterns #-}

1{-# LANGUAGE ViewPatterns #-}

3

2

4-- | Postprocessing for the results of printing.

3-- | Postprocessing for the results of printing.

@@ -13,19 +12,12 @@ import Ormolu.Processing.Common

13import qualified Ormolu.Processing.Cpp as Cpp

12import qualified Ormolu.Processing.Cpp as Cpp

14

13

15-- | Postprocess output of the formatter.

14-- | Postprocess output of the formatter.

16−postprocess ::

15+postprocess :: Text -> Text

17− -- | Desired indentation level

18− Int ->

19− -- | Input to process

20− Text ->

21− Text

22−postprocess indent =

16+postprocess =

23 T.unlines

17 T.unlines

24− . fmap indentLine

25 . fmap Cpp.unmaskLine

18 . fmap Cpp.unmaskLine

26 . filter (not . magicComment)

19 . filter (not . magicComment)

27 . T.lines

20 . T.lines

28 where

21 where

29 magicComment (T.stripStart -> x) =

22 magicComment (T.stripStart -> x) =

30 x == startDisabling || x == endDisabling

23 x == startDisabling || x == endDisabling

31− indentLine x = T.replicate indent " " <> x

src/Ormolu/Processing/Preprocess.hs+2−1

@@ -11,7 +11,8 @@ where

11import Control.Monad

12import Data.Char (isSpace)

13import qualified Data.List as L

14−import Data.Maybe (isJust, maybeToList)

14+import Data.Maybe (isJust)

15+import Data.Maybe (maybeToList)

15import FastString

16import FastString

16import Ormolu.Config (RegionDeltas (..))

17import Ormolu.Config (RegionDeltas (..))

17import Ormolu.Parser.Shebang (isShebang)

18import Ormolu.Parser.Shebang (isShebang)

src/Ormolu/Utils.hs+1−15

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

1{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ViewPatterns #-}

4

3

5-- | Random utilities used by the code.

4-- | Random utilities used by the code.

6module Ormolu.Utils

5module Ormolu.Utils

@@ -16,14 +15,12 @@ module Ormolu.Utils

16 separatedByBlank,

15 separatedByBlank,

17 separatedByBlankNE,

16 separatedByBlankNE,

18 onTheSameLine,

17 onTheSameLine,

19− removeIndentation,

20 )

18 )

21where

19where

22

20

23−import Data.Char (isSpace)

24import Data.List (dropWhileEnd)

21import Data.List (dropWhileEnd)

25−import Data.List.NonEmpty (NonEmpty (..))

26import qualified Data.List.NonEmpty as NE

22import qualified Data.List.NonEmpty as NE

23+import Data.List.NonEmpty (NonEmpty (..))

27import Data.Maybe (fromMaybe)

24import Data.Maybe (fromMaybe)

28import Data.Text (Text)

25import Data.Text (Text)

29import qualified Data.Text as T

26import qualified Data.Text as T

@@ -142,14 +139,3 @@ separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b)

142onTheSameLine :: SrcSpan -> SrcSpan -> Bool

139onTheSameLine :: SrcSpan -> SrcSpan -> Bool

143onTheSameLine a b =

140onTheSameLine a b =

144 isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))

141 isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))

145−

146−-- | Remove indentation from a given 'String'. Return the input with

147−-- indentation removed and the detected indentation level.

148−removeIndentation :: String -> (String, Int)

149−removeIndentation (lines -> xs) = (unlines (drop n <$> xs), n)

150− where

151− n = minimum (getIndent <$> xs)

152− getIndent y =

153− if all isSpace y

154− then 0

155− else length (takeWhile isSpace y)