76c4f52..master · 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.3

6+ - label: Build and test with GHC 8.8.4

7 command: |

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

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

9 timeout: 100

10 - label: Build and test with GHC 8.10.1

11 command: |

.github/workflows/binaries.ymlnew file+39

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

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.shnew file+7

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

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+62−2

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

1## Unreleased

2

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

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

5+

6+## Ormolu 0.1.2.0

7+

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

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

10+

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

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

13+

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

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

16+

17+## Ormolu 0.1.1.0

18+

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

20+ combined/eliminated intelligently.

21+

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

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

24+

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

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

27+ disabled part is still syntactically correct. [Issue

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

29+

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

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

32+

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

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

35+

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

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

38+

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

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

41+

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

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

44+

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

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

47+

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

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

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

51+

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

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

54+

55+## Ormolu 0.1.0.0

56+

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

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

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

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

5

59

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

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

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

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

8

62

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

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

10 “continuation” of a series of comments [Issue

64 “continuation” of a series of comments [Issue

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

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

12

66

@@ -25,13 +79,19 @@

25 multiple blank lines in a row. [Issue

79 multiple blank lines in a row. [Issue

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

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

27

81

28−* Fixed rendering of comment around if expressions. [Issue

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

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

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

30

84

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

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

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

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

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

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

34

88

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

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

91+

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

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

94+

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

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

36 Apparently only the latter is correct.

96 Apparently only the latter is correct.

37

97

README.md+21−11

@@ -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 accomodate them.

25+ extensions enter broad use, we may change the style to accommodate 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,11 +45,12 @@ Alternatively, `stack` could be used with a `stack.yaml` file as follows.

45

46```console

47$ cat stack.yaml

48−resolver: lts-14.3

48+resolver: lts-16.0

49packages:

50- '.'

51

52−$ stack build

52+$ stack build # to build

53+$ stack install # to install

53```

54```

54

55

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

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

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

129 criterion than just being valid Haskell modules.

130 criterion than just being valid Haskell modules.

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

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

131

132

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−

140## Running on Hackage

133## Running on Hackage

141

134

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

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

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

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

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

152into Ormolu).

145into Ormolu).

153

146

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+

154## Contributing

163## Contributing

155

164

156See [CONTRIBUTING.md][contributing].

165See [CONTRIBUTING.md][contributing].

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

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

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

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

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

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

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

app/Main.hs+23−13

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

8

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

10import Control.Monad

11+import Data.Bool (bool)

11import Data.Either (lefts)

12import Data.Either (lefts)

12import Data.List (intercalate, sort)

13import Data.List (intercalate, sort)

13import qualified Data.Text.IO as TIO

14import qualified Data.Text.IO as TIO

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

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

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

61 exitWith (ExitFailure 101)

62 exitWith (ExitFailure 101)

62 Just inputFile -> do

63 Just inputFile -> do

64+ originalInput <- TIO.readFile inputFile

63− r <- ormoluFile config inputFile

65+ formattedInput <- ormoluFile config inputFile

64 case mode of

66 case mode of

65 Stdout ->

67 Stdout ->

66− TIO.putStr r

68+ TIO.putStr formattedInput

67− InPlace ->

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) $

68− TIO.writeFile inputFile r

74+ TIO.writeFile inputFile formattedInput

69 Check -> do

75 Check -> do

70− r' <- TIO.readFile inputFile

76+ when (formattedInput /= originalInput) $

71− when (r /= r') $

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

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

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

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

74 -- 'notImplemented'.

79 -- 'notImplemented'.

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

134optsParser :: Parser Opts

139optsParser :: Parser Opts

135optsParser =

140optsParser =

136 Opts

141 Opts

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

143+ [ short 'i',

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

145+ ]

137− <$> (option parseMode . mconcat)

146+ <|> (option parseMode . mconcat)

138− [ long "mode",

147+ [ long "mode",

139− short 'm',

148+ short 'm',

140− metavar "MODE",

149+ metavar "MODE",

141− value Stdout,

150+ value Stdout,

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

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

143− ]

152+ ]

153+ )

144 <*> configParser

154 <*> configParser

145 <*> (many . strArgument . mconcat)

155 <*> (many . strArgument . mconcat)

146 [ metavar "FILE",

156 [ metavar "FILE",

data/examples/declaration/data/partly-documented-out.hsnew file+5

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

1+data Optimisation

2+ = PETransform

3+ | -- | partial eval and associated transforms

4+ GeneralisedNatHack

5+ deriving (Show, Eq, Generic)

data/examples/declaration/data/partly-documented.hsnew file+2

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

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

2+ deriving (Show, Eq, Generic)

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

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

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

2−

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

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

data/examples/declaration/signature/type/unrelated-out.hsnew file+4

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

1+clientFunc1 :: SomeType1

2+clientFunc2 :: SomeType2

3+clientFunc3 :: SomeType3

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

data/examples/declaration/signature/type/unrelated.hsnew file+4

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

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.hsnew file+3

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

1+foo

2+ bar =

3+ body

data/examples/declaration/value/function/arg-breakpoints.hsnew file+3

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

1+foo

2+ bar =

3+ body

data/examples/declaration/value/function/blank-lines-let-out.hsnew file+6

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

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.hsnew file+9

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

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.hsnew file+6

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

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.hsnew file+7

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

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,6 +1,7 @@

1{-# LANGUAGE ImplicitParams #-}

2

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

4+sortBy = undefined

4

5

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

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

6sort = sortBy ?cmp

7sort = sortBy ?cmp

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

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

1{-# LANGUAGE ImplicitParams #-}

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

3

4+sortBy = undefined

5+

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

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

5sort = sortBy ?cmp

7sort = sortBy ?cmp

6

8

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+4−3

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

17 `catch` \case

18 a -> a

19

20−foo = bar

20+foo =

21+ bar

21− ++ case foo of

22+ ++ case foo of

22− a -> a

23+ a -> a

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

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

1lenses =

2+ Just $

2− Just $ M.fromList $

3+ M.fromList $

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

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

4− # "connection" .= uc

5+ # "connection" .= uc

5− # "user" .= case name of

6+ # "user" .= case name of

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

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

7− Nothing -> Nothing

8+ Nothing -> Nothing

8− # []

9+ # []

9

10

10foo =

11foo =

11 a

12 a

data/examples/declaration/value/function/list-notation-0-out.hsnew file+5

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

1+foo =

2+ testCase "Foo" testFoo :

3+ testCase "Bar" testBar :

4+ testCase "Baz" testBaz :

5+ []

data/examples/declaration/value/function/list-notation-0.hsnew file+5

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

1+foo =

2+ testCase "Foo" testFoo :

3+ testCase "Bar" testBar :

4+ testCase "Baz" testBaz :

5+ []

data/examples/declaration/value/function/list-notation-1-out.hsnew file+8

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

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.hsnew file+7

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

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.hsnew file+6

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

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.hsnew file+5

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

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.hsnew file+12

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

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.hsnew file+10

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

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-out.hs → data/examples/declaration/value/function/operators-0-out.hsrenamed

The content is the same.

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

The content is the same.

data/examples/declaration/value/function/operators-1-out.hsnew file+4

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

1+foo =

2+ f

3+ . g

4+ =<< h . i

data/examples/declaration/value/function/operators-1.hsnew file+3

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

1+foo = f

2+ . g

3+ =<< h . i

data/examples/declaration/value/function/operators-2-out.hsnew file+4

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

1+foo n

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

3+ || x && n =

4+ 42

data/examples/declaration/value/function/operators-2.hsnew file+4

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

1+foo n

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

3+ || x && n =

4+ 42

data/examples/declaration/value/function/operators-3-out.hsnew file+3

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

1+foo =

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

3+ <+> prettySe <> text sc

data/examples/declaration/value/function/operators-3.hsnew file+3

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

1+foo =

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

3+ prettySe <> text sc

data/examples/declaration/value/function/operators-4-out.hsnew file+3

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

1+foo =

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

3+ <+> align <> prettyPs

data/examples/declaration/value/function/operators-4.hsnew file+3

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

1+foo =

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

3+ align <> prettyPs

data/examples/declaration/value/function/operators-5-out.hsnew file+5

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

1+foo =

2+ map bar $

3+ [ baz

4+ ]

5+ ++ quux

data/examples/declaration/value/function/operators-5.hsnew file+4

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

1+foo =

2+ map bar $

3+ [ baz

4+ ] ++ quux

data/examples/declaration/value/function/operators-6-out.hsnew file+9

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

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.hsnew file+7

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

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/type-applications-and-splice-out.hsnew file+4

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

1+{-# LANGUAGE TemplateHaskell #-}

2+{-# LANGUAGE TypeApplications #-}

3+

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

data/examples/declaration/value/function/type-applications-and-splice.hsnew file+4

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

1+{-# LANGUAGE TemplateHaskell #-}

2+{-# LANGUAGE TypeApplications #-}

3+

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

data/examples/import/deduplication-bug-out.hsnew file+6

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

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.hsnew file+6

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

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

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

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

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

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

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

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

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

1import qualified MegaModule as M

2− ( (<<<),

3− (>>>),

4− Either,

2+ ( Either,

5 Maybe (Just, Nothing),

3 Maybe (Just, Nothing),

6 MaybeT (..),

4 MaybeT (..),

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

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

8 MonadBaseControl,

6 MonadBaseControl,

9 join,

7 join,

10 liftIO,

8 liftIO,

11 void,

9 void,

10+ (<<<),

11+ (>>>),

12 )

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

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

1import qualified MegaModule as M

2 ( -- (1)

3− (<<<), -- (2)

3+ -- (2)

4− (>>>),

5 Either, -- (3)

4 Either, -- (3)

5+ (<<<),

6+ (>>>),

6 )

7 )

data/examples/import/merging-0-out.hsnew file+3

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

1+import Foo

2+import Foo (bar, foo)

3+import Foo as F

data/examples/import/merging-0.hsnew file+4

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

1+import Foo

2+import Foo (foo)

3+import Foo (bar)

4+import Foo as F

data/examples/import/merging-1-out.hsnew file+2

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

1+import "bar" Foo (bar)

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

data/examples/import/merging-1.hsnew file+3

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

1+import "foo" Foo (foo)

2+import "bar" Foo (bar)

3+import "foo" Foo (baz)

data/examples/import/merging-2-out.hsnew file+2

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

1+import Foo hiding (bar4, foo2)

2+import qualified Foo (bar3, foo1)

data/examples/import/merging-2.hsnew file+4

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

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,11 +1,5 @@

1import A hiding

2 ( foobarbazqux,

3− foobarbazqux,

4− foobarbazqux,

5− foobarbazqux,

6− foobarbazqux,

7− foobarbazqux,

8− foobarbazqux,

9 )

3 )

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

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

11import Name hiding ()

5import Name hiding ()

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

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

1import qualified MegaModule as M

2− ( (<<<),

3− (>>>),

4− Either,

2+ ( Either,

5 Monad

3 Monad

4+ ( return,

6− ( (>>),

5+ (>>),

7− (>>=),

6+ (>>=)

8− return

9 ),

7 ),

8+ (<<<),

9+ (>>>),

10 )

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

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

1{-# LANGUAGE ImportQualifiedPost #-}

2

3−import Data.Text qualified as T

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

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

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

4import 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, (.))

3import qualified Prelude

4import qualified Prelude

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

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

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

1import Data.Text

2−import Data.Text

3−import qualified Data.Text as T

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

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

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

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

3import 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,3 +4,5 @@ import qualified Data.Text as T

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

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

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

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

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

data/examples/import/sorted-export-list-out.hsnew file+1

@@ -0,0 +1 @@

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

data/examples/import/sorted-export-list.hsnew file+1

@@ -0,0 +1 @@

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

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

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

9 -- | Foo

10 Int ->

11 Int

12−

13foo ::

12foo ::

14 Foo a =>

13 Foo a =>

15 -- | Foo

14 -- | Foo

data/examples/other/comment-glued-together-out.hsnew file+7

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

1+module Main (main) where

2+

3+-- | Foo.

4+

5+-- Bar

6+main :: IO ()

7+main = return ()

data/examples/other/comment-glued-together.hsnew file+6

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

1+module Main (main) where

2+

3+{- | Foo. -}

4+-- Bar

5+main :: IO ()

6+main = return ()

data/examples/other/comment-trailing-space-out.hsnew file+9

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

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.hsnew file+9

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

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,5 +1,4 @@

1ffff, ffffffff :: Natural

2−

3#ifdef HASKELL_ZIP_DEV_MODE

2#ifdef HASKELL_ZIP_DEV_MODE

4ffff = 200

3ffff = 200

5ffffffff = 5000

4ffffffff = 5000

data/examples/other/disabling/indented-fragment-out.hsnew file+7

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

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.hsnew file+7

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

1+foo =

2+ {- ORMOLU_DISABLE -}

3+ testCase "Foo" testFoo :

4+ testCase "Bar" testBar :

5+ testCase "Baz" testBaz :

6+ {- ORMOLU_ENABLE -}

7+ []

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

The content is the same.

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

The content is the same.

data/examples/other/inline-comment-1-out.hsnew file+12

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

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

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

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

4+ ++ " = "

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

6+ ++ "\n"

7+ ++ showPs env bs

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

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

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

11+ ++ "\n"

12+ ++ showPs env bs

data/examples/other/inline-comment-1.hsnew file+9

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

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

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

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

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

5+ "\n" ++ showPs env bs

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

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

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

9+ "\n" ++ showPs env bs

data/examples/other/pragma-comments-after-out.hsnew file+4

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

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.hsnew file+3

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

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

2+{-# LANGUAGE AllowAmbiguousTypes #-}

3+{-# LANGUAGE ConstraintKinds #-}

default.nix+17−17

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

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

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

2+, system ? builtins.currentSystem

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

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

3}:

4}:

4

5

5let

6let

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

16 };

17 };

17 ormoluOverlay = self: super: {

18 ormoluOverlay = self: super: {

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

19 "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− } {});

25 };

20 };

26 ormolize = import ./nix/ormolize {

21 ormolize = import ./nix/ormolize {

27 inherit pkgs;

22 inherit pkgs;

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

33 "distributed-process"

28 "distributed-process"

34 "esqueleto"

29 "esqueleto"

35 "fay"

30 "fay"

31+ "hlint"

36 "idris"

32 "idris"

37 "intero"

33 "intero"

38 "leksah"

34 "leksah"

39− "lens"

40 "pandoc"

35 "pandoc"

41 "pipes"

36 "pipes"

37+ "postgrest"

42 "purescript"

38 "purescript"

43− "stack"

39+ "tensorflow"

44− ];

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

45 ormolizedPackages = doCheck:

41 ormolizedPackages = doCheck:

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

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

47 package = p;

43 package = p;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

140− ormolu --check-idempotence --mode inplace --end-line 13 result-only-end.hs

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

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

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

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

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

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

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

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

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

145− cp src.hs result-9-13.hs

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

146− ormolu --check-idempotence --mode inplace --start-line 9 --end-line 13 result-9-13.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

147 '';

145 '';

148 checkPhase = ''

146 checkPhase = ''

149 echo result-all-implicit.hs

147 echo result-all-implicit.hs

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

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

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

159 echo result-6-8.hs

157 echo result-6-8.hs

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

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

161− echo result-9-13.hs

159+ echo result-9-12.hs

162− diff --color=always expected-result-9-13.hs result-9-13.hs

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

161+ echo result-17-18.hs

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

163 '';

164 installPhase = ''

165 mkdir "$out"

expected-failures/Agda.txt+2−2

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

1Formatting is not idempotent:

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

2+ dist/build/Agda/Syntax/Parser/Lexer.hs<rendered>:1602: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>:745:4

8+ src/full/Agda/Syntax/Translation/InternalToAbstract.hs<rendered>:769: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:510:9-41

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

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

expected-failures/hlint.txtnew file+11

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

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

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

1−Formatting is not idempotent:

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

3− before: "t_impl ppo && uname "

4− after: "t_impl ppo\n "

5−Please, consider reporting the bug.

6−

7−Formatting is not idempotent:

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

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

10− after: "++ showEnv\n "

11−Please, consider reporting the bug.

12−

13−Formatting is not idempotent:

14− src/Idris/Core/TT.hs<rendered>:1963:13

15− before: " text op <> pretty"

16− after: " text op\n <"

17−Please, consider reporting the bug.

18−

19−Formatting is not idempotent:

20− src/Idris/Options.hs<rendered>:178:15

21− before: "ETransform | -- | pa"

22− after: "ETransform\n | -- | "

23−Please, consider reporting the bug.

24−

25The GHC parser (in Haddock mode) failed:

1The GHC parser (in Haddock mode) failed:

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

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

27 parse error on input `@'

3 parse error on input `@'

28

4

29−AST of input and AST of formatted code differ.

30− at src/Idris/Parser/Data.hs:281:1-29

31−Please, consider reporting the bug.

32−

33The GHC parser (in Haddock mode) failed:

5The GHC parser (in Haddock mode) failed:

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

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

35 parse error on input `@'

7 parse error on input `@'

36−

37−Formatting is not idempotent:

38− src/Idris/Prover.hs<rendered>:239:10

39− before: " line <> bindin"

40− after: " line\n <"

41−Please, consider reporting the bug.

expected-failures/intero.txt+1−1

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

1Formatting is not idempotent:

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

2+ src/InteractiveUI.hs<rendered>:3748: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>:1188:7

2+ src/IDE/Pane/Modules.hs<rendered>:1184: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>:615:19

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

7 before: ".softbreak <$ endlin"

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

9Please, consider reporting the bug.

expected-failures/postgrest.txtnew file+5

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

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:478:1-17

2+ src/Language/PureScript/AST/Declarations.hs:479: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:101:1-22

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

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

9Perhaps you meant to use PatternSynonyms?

10

expected-failures/stack.txtdeleted−5

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

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.txtnew file+7

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

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+7−3

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

1+{ system ? builtins.currentSystem }:

1let

2let

2− rev = "807ca93fadd5197c2260490de0c76e500562dc05";

3+ rev = "32b46dd897ab2143a609988a04d87452f0bbef59";

3− sha256 = "10yq8bnls77fh3pk5chkkb1sv5lbdgyk1rr2v9xn71rr1k2x563p";

4+ sha256 = "1gzfrpjnr1bz9zljsyg3a4zrhk8r927sz761mrgcg56dwinkhpjk";

4 nixpkgs = builtins.fetchTarball {

5 nixpkgs = builtins.fetchTarball {

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

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

6 inherit sha256;

7 inherit sha256;

7 };

8 };

9+ pkgs = import nixpkgs {

10+ inherit system;

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

11+ config.allowUnfree = true;

12+ };

9in pkgs

13in pkgs

ormolu.cabal+5−4

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

1cabal-version: 1.18

2name: ormolu

3−version: 0.0.5.0

3+version: 0.1.2.0

4license: BSD3

5license-file: LICENSE.md

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

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

7+tested-with: ghc ==8.6.5 ghc ==8.8.4 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 && <0.9,

122+ dlist >=0.8 && <2.0,

123 exceptions >=0.6 && <0.11,

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

125 mtl >=2.0 && <3.0,

@@ -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.16,

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

148 ormolu -any,

149 text >=0.2 && <1.3

150

@@ -152,6 +152,7 @@ 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

155

156

156 else

157 else

157 ghc-options: -O2 -Wall -rtsopts

158 ghc-options: -O2 -Wall -rtsopts

region-tests/expected-result-17-18.hsnew file+17

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

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+6−1

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar) where

4+ foo, bar, baz) where

5

6foo :: Int

7foo = 5

@@ -10,3 +10,8 @@ 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+6−1

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar) where

4+ foo, bar, baz) where

5

6foo :: Int

7foo = 5

@@ -9,3 +9,8 @@ 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-13.hs → region-tests/expected-result-9-12.hsrenamed+6−1

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar) where

4+ foo, bar, baz) where

5

6foo :: Int

7foo = 5

@@ -10,3 +10,8 @@ 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,6 +3,7 @@

3module Foo

4 ( foo,

5 bar,

6+ baz,

6 )

7 )

7where

8where

8

9

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

13bar = \case

14bar = \case

14 0 -> foo

15 0 -> foo

15 x -> x - foo

16 x -> x - foo

17+

18+baz :: Int -> Int

19+baz = gege

20+ where

21+ gege = 1 + 2

region-tests/src.hs+6−1

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar) where

4+ foo, bar, baz) where

5

6foo :: Int

7foo = 5

@@ -10,3 +10,8 @@ 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+3−1

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

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

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

2+, system ? builtins.currentSystem

3+}:

2

4

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

5(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 (sortImports)

17+import Ormolu.Imports (normalizeImports)

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 = sortImports (hsmodImports hs0)}

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

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

51+ hs1 {hsmodImports = normalizeImports (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+161−44

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

4

5-- | Manipulations on import lists.

6module Ormolu.Imports

7− ( sortImports,

7+ ( normalizeImports,

8 )

9where

10

11import Data.Bifunctor

12+import Data.Char (isAlphaNum)

12import Data.Function (on)

13import Data.Function (on)

13−import Data.Generics (gcompare)

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

14−import Data.List (sortBy)

15+import Data.Map.Strict (Map)

16+import qualified Data.Map.Strict as M

17+import FastString (FastString)

15import GHC hiding (GhcPs, IE)

18import GHC hiding (GhcPs, IE)

16import GHC.Hs.Extension

19import GHC.Hs.Extension

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

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

18−import Ormolu.Utils (notImplemented)

21+import Ormolu.Utils (notImplemented, showOutputable)

19

22

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

23+-- | Sort and normalize imports.

21−-- each declaration.

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

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

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

25+normalizeImports =

26+ fmap snd

27+ . M.toAscList

28+ . M.fromListWith combineImports

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

24 where

30 where

25− sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs

26− sortImportLists = \case

27− ImportDecl {..} ->

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

32+ L

33+ l

28 ImportDecl

34 ImportDecl

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

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

30 ..

36 ..

31 }

37 }

32− XImportDecl x -> noExtCon x

38+ g _ = notImplemented "XImportDecl"

33

39

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

41+-- are equal.

42+combineImports ::

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

43+ LImportDecl GhcPs ->

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

44+ LImportDecl GhcPs ->

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

45+ LImportDecl GhcPs

37− case (isPrelude n0, isPrelude n1) of

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

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

47+ L

39− (True, False) -> GT

48+ lx

40− (False, True) -> LT

49+ ImportDecl

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

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

42 where

91 where

43− n0 = unLoc (ideclName m0)

44− n1 = unLoc (ideclName m1)

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

92+ isPrelude = moduleNameString moduleName == "Prelude"

93+ moduleName = unLoc ideclName

94+importId _ = notImplemented "XImportDecl"

46

95

47−-- | Sort located import or export.

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

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

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

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

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

50

151

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

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

52−sortThings :: IE GhcPs -> IE GhcPs

153+-- 'Ord' instance for it.

53−sortThings = \case

154+newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)

54− IEThingWith NoExtField x w xs fl ->

155+ deriving (Eq)

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

56− other -> other

57

156

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

157+instance Ord IEWrappedNameOrd where

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

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

60−compareIE = compareIewn `on` getIewn

61

159

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

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

63−getIewn :: IE GhcPs -> IEWrappedName RdrName

161+getIewn :: IE GhcPs -> IEWrappedNameOrd

64getIewn = \case

162getIewn = \case

65− IEVar NoExtField x -> unLoc x

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

66− IEThingAbs NoExtField x -> unLoc x

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

67− IEThingAll NoExtField x -> unLoc x

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

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

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

69 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

167 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

70 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

168 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

71 IEDoc NoExtField _ -> notImplemented "IEDoc"

169 IEDoc NoExtField _ -> notImplemented "IEDoc"

72 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

170 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

73 XIE x -> noExtCon x

171 XIE x -> noExtCon x

74

172

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

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

175+compareLIewn = compareIewn `on` unLoc

176+

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

src/Ormolu/Parser.hs+5−3

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

35+import Ormolu.Utils (incSpanLine, removeIndentation)

36import qualified Panic as GHC

37import qualified Parser as GHC

38import qualified StringBuffer as GHC

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

51 Either (SrcSpan, String) ParseResult

52 )

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

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

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

55 preprocess path rawInput cfgRegion

56+ (input, indent) = removeIndentation indentedInput

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

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

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

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

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

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

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

110 prImportQualifiedPost =

111 prImportQualifiedPost =

111 GHC.xopt ImportQualifiedPost dynFlags,

112 GHC.xopt ImportQualifiedPost dynFlags,

112 prLiteralPrefix = T.pack literalPrefix,

113 prLiteralPrefix = T.pack literalPrefix,

113− prLiteralSuffix = T.pack literalSuffix

114+ prLiteralSuffix = T.pack literalSuffix,

115+ prIndent = indent

114 }

116 }

115 return (warnings, r)

117 return (warnings, r)

116

118

src/Ormolu/Parser/CommentStream.hs+22−5

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

27import qualified Lexer as GHC

28import Ormolu.Parser.Pragma

29import Ormolu.Parser.Shebang

30+import Ormolu.Processing.Common

30−import Ormolu.Utils (showOutputable)

31+import Ormolu.Utils (onTheSameLine, showOutputable)

31import SrcLoc

32import SrcLoc

32

33

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

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

@@ -109,11 +110,15 @@ mkComment ls (L l s) = (ls', comment)

109 Nothing -> s :| []

110 Nothing -> s :| []

110 Just (x :| xs) ->

111 Just (x :| xs) ->

111 let getIndent y =

112 let getIndent y =

112− if all isSpace y

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

113 then startIndent

114 then startIndent

114 else length (takeWhile isSpace y)

115 else length (takeWhile isSpace y)

115 n = minimum (startIndent : fmap getIndent xs)

116 n = minimum (startIndent : fmap getIndent xs)

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

117+ removeIndent y =

118+ if y == endDisabling

119+ then y

120+ else drop n y

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

117 else s :| []

122 else s :| []

118 (atomsBefore, ls') =

123 (atomsBefore, ls') =

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

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

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

145

150

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

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

147extractStackHeader ::

152extractStackHeader ::

153+ -- | Comment stream to analyze

148 [RealLocated String] ->

154 [RealLocated String] ->

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

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

150extractStackHeader = \case

156extractStackHeader = \case

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

160

166

161-- | Extract pragmas and their associated comments.

167-- | Extract pragmas and their associated comments.

162extractPragmas ::

168extractPragmas ::

169+ -- | Input

163 String ->

170 String ->

171+ -- | Comment stream to analyze

164 [RealLocated String] ->

172 [RealLocated String] ->

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

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

166extractPragmas input = go initialLs id id

174extractPragmas input = go initialLs id id

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

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

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

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

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

176 Just pragma ->

184 Just pragma ->

177− let combined = (csSoFar [], pragma)

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

178− in go ls id (pragmasSoFar . (combined :)) xs

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

179

196

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

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

181unAnnotationComment :: GHC.AnnotationComment -> Maybe String

198unAnnotationComment :: GHC.AnnotationComment -> Maybe String

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

@@ -35,7 +35,9 @@ 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

39 }

41 }

40

42

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

43-- | 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 $

26+ postprocess prIndent $

27 runR

28 ( p_hsModule

29 prStackHeader

src/Ormolu/Printer/Combinators.hs+23−7

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

21 space,

22 newline,

23 inci,

24+ inciIf,

24 located,

25 located,

25 located',

26 located',

26 switchLayout,

27 switchLayout,

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

51

52

52 -- ** Literals

53 -- ** Literals

53 comma,

54 comma,

55+ commaDel,

54 equals,

56 equals,

55

57

56 -- ** Stateful markers

58 -- ** Stateful markers

@@ -72,6 +74,15 @@ import SrcLoc

72----------------------------------------------------------------------------

74----------------------------------------------------------------------------

73-- Basic

75-- Basic

74

76

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+

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

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

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

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

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

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

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

174 xs' ->

185 xs' ->

175 if ub

186 if ub

176 then do

187 then do

177− txt "{ "

188+ txt "{"

189+ space

178− sep (txt "; ") (dontUseBraces . f) xs'

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

191+ space

179− txt " }"

192+ txt "}"

180− else sep (txt "; ") f xs'

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

181 multiLine =

194 multiLine =

182 sep newline (dontUseBraces . f) xs

195 sep newline (dontUseBraces . f) xs

183

196

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

190 N

203 N

191 | -- | Shifted one level

204 | -- | Shifted one level

192 S

205 S

206+ deriving (Eq, Show)

193

207

194-- | Surround given entity by backticks.

208-- | Surround given entity by backticks.

195backticks :: R () -> R ()

209backticks :: R () -> R ()

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

266 then newline >> inci m

280 then newline >> inci m

267 else space >> sitcc m

281 else space >> sitcc m

268 newline

282 newline

269− case style of

270− N -> txt close

271− S -> inci (txt close)

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

272

284

273----------------------------------------------------------------------------

285----------------------------------------------------------------------------

274-- Literals

286-- Literals

@@ -277,6 +289,10 @@ brackets_ needBreaks open close style m = sitcc (vlayout singleLine multiLine)

277comma :: R ()

289comma :: R ()

278comma = txt ","

290comma = txt ","

279

291

292+-- | Delimiting combination with 'comma'. To be used with 'sep'.

293+commaDel :: R ()

294+commaDel = comma >> breakpoint

295+

280-- | Print @=@. Do not use @'txt' "="@.

296-- | Print @=@. Do not use @'txt' "="@.

281equals :: R ()

297equals :: R ()

282equals = interferingTxt "="

298equals = interferingTxt "="

src/Ormolu/Printer/Comments.hs+8−5

@@ -14,6 +14,7 @@ where

14

15import Control.Monad

16import qualified Data.List.NonEmpty as NE

17+import Data.Maybe (listToMaybe)

17import qualified Data.Text as T

18import qualified Data.Text as T

18import Ormolu.Parser.CommentStream

19import Ormolu.Parser.CommentStream

19import Ormolu.Printer.Internal

20import Ormolu.Printer.Internal

@@ -66,9 +67,11 @@ spitPrecedingComment ref = do

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

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

67 withPoppedComment p $ \l comment -> do

68 withPoppedComment p $ \l comment -> do

68 lineSpans <- thisLineSpans

69 lineSpans <- thisLineSpans

69− let ls = srcLocLine . realSrcSpanEnd <$> lineSpans

70− thisCommentLine = srcLocLine (realSrcSpanStart l)

70+ let thisCommentLine = srcLocLine (realSrcSpanStart l)

71− needsNewline = any (/= thisCommentLine) ls

71+ needsNewline =

72+ case listToMaybe lineSpans of

73+ Nothing -> False

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

72 when (needsNewline || needsNewlineBefore l mlastMark) newline

75 when (needsNewline || needsNewlineBefore l mlastMark) newline

73 spitCommentNow l comment

76 spitCommentNow l comment

74 if theSameLinePre l ref

77 if theSameLinePre l ref

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

151 -- | Last printed comment span

154 -- | Last printed comment span

152 Maybe SpanMark ->

155 Maybe SpanMark ->

153 Bool

156 Bool

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

154needsNewlineBefore l mlastMark =

158needsNewlineBefore l mlastMark =

155 case spanMarkSpan <$> mlastMark of

159 case spanMarkSpan <$> mlastMark of

156 Nothing -> False

160 Nothing -> False

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

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

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

236 not (hasAtomsBefore comment)

240 not (hasAtomsBefore comment)

237 && ( case mlastMark of

241 && ( case mlastMark of

238− Just (HaddockSpan _ spn) ->

242+ Just (HaddockSpan _ _) -> False

239− srcSpanEndLine spn + 1 == srcSpanStartLine l

240 Just (CommentSpan spn) ->

243 Just (CommentSpan spn) ->

241 srcSpanEndLine spn + 1 == srcSpanStartLine l

244 srcSpanEndLine spn + 1 == srcSpanStartLine l

242 _ -> False

245 _ -> False

src/Ormolu/Printer/Internal.hs+3−1

@@ -220,7 +220,8 @@ txt ::

220 R ()

221txt = spit SimpleText

222

223−-- |

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.

224interferingTxt ::

225interferingTxt ::

225 -- | 'Text' to output

226 -- | 'Text' to output

226 Text ->

227 Text ->

@@ -243,6 +244,7 @@ spit ::

243 -- | 'Text' to output

244 -- | 'Text' to output

244 Text ->

245 Text ->

245 R ()

246 R ()

247+spit _ "" = return ()

246spit stype text = do

248spit stype text = do

247 requestedDel <- R (gets scRequestedDelimiter)

249 requestedDel <- R (gets scRequestedDelimiter)

248 pendingComments <- R (gets scPendingComments)

250 pendingComments <- R (gets scPendingComments)

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

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

114p_infixDefHelper ::

115 -- | Whether to format in infix style

116 Bool ->

117− -- | Indentation-bumping wrapper

117+ -- | Whether to bump indentation for arguments

118− (R () -> R ()) ->

118+ Bool ->

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

120 R () ->

121 -- | How to print the arguments

122 [R ()] ->

123 R ()

124−p_infixDefHelper isInfix inci' name args =

124+p_infixDefHelper isInfix indentArgs name args =

125 case (isInfix, args) of

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

127 let parens' =

@@ -131,18 +131,18 @@ p_infixDefHelper isInfix inci' name args =

131 parens' $ do

132 p0

133 breakpoint

134− inci $ sitcc $ do

134+ inci . sitcc $ do

135 name

136 space

137 p1

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

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

139 breakpoint

140 sitcc (sep breakpoint sitcc ps)

141 (_, ps) -> do

142 name

143 unless (null ps) $ do

144 breakpoint

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

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

146

147-- | Print a Haddock.

148p_hsDocString ::

src/Ormolu/Printer/Meat/Declaration.hs+26−14

@@ -12,7 +12,7 @@ module Ormolu.Printer.Meat.Declaration

12where

13

14import Data.List (sort)

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

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

16import qualified Data.List.NonEmpty as NE

17import GHC hiding (InlinePragma)

18import OccName (occNameFS)

@@ -54,12 +54,13 @@ 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 = sepSemi id $

57+p_hsDecls' grouping style decls =

58+ sepSemi id $

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

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

59− -- groups.

60+ -- groups.

60− case groupDecls decls of

61+ case groupDecls decls of

61− [] -> []

62+ [] -> []

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

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

63 where

64 where

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

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

65 renderGroupWithPrev prev curr =

66 renderGroupWithPrev prev curr =

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

84 isHaddock _ = False

85 isHaddock _ = False

85

86

86-- | Group relevant declarations together.

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

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

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

91groupDecls [] = []

89groupDecls [] = []

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

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

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

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

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

100 let relevantToHdr = groupedDecls header current

98 let relevantToHdr = groupedDecls header current

101 relevantToPrev = groupedDecls previous current

99 relevantToPrev = groupedDecls previous current

100+ isDeclSeries = declSeries previous current

102− in relevantToHdr || relevantToPrev

101+ in isDeclSeries || relevantToHdr || relevantToPrev

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

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

104

103

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

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

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

196 (_, DocPrev) -> True

195 (_, DocPrev) -> True

197 _ -> False

196 _ -> False

198

197

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+

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

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

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

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

201 where

212 where

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

288patSigRdrNames _ = Nothing

299patSigRdrNames _ = Nothing

289

300

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

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

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

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

303+ flip concatMap ws $ \case

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

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

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

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

294warnSigRdrNames _ = Nothing

306warnSigRdrNames _ = Nothing

295

307

296patBindNames :: Pat GhcPs -> [RdrName]

308patBindNames :: Pat GhcPs -> [RdrName]

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

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

9import Ormolu.Printer.Meat.Common

10

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

12−

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

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

src/Ormolu/Printer/Meat/Declaration/Class.hs+2−2

@@ -58,7 +58,7 @@ p_classDecl ctx name HsQTvs {..} fixity fdeps csigs cdefs cats catdefs cdocs = d

58 switchLayout signatureSpans $

59 p_infixDefHelper

60 (isInfix fixity)

61− inci

61+ True

62 (p_rdrName name)

63 (located' p_hsTyVarBndr <$> hsq_explicit)

64 inci (p_classFundeps fdeps)

@@ -82,7 +82,7 @@ p_classFundeps fdeps = unless (null fdeps) $ do

82 breakpoint

83 txt "|"

84 space

85− sitcc $ sep (comma >> breakpoint) (sitcc . located' p_funDep) fdeps

85+ inci $ sep commaDel (sitcc . located' p_funDep) fdeps

86

87p_funDep :: FunDep (Located RdrName) -> R ()

88p_funDep (before, after) = do

src/Ormolu/Printer/Meat/Declaration/Data.hs+27−33

@@ -41,7 +41,7 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do

41 inci $

42 p_infixDefHelper

43 (isInfix fixity)

44− inci

44+ True

45 (p_rdrName name)

46 (located' p_hsType <$> tpats)

47 case dd_kindSig of

@@ -60,27 +60,26 @@ 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))

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

64− $ inci

65− $ do

66− let singleConstRec = isSingleConstRec dd_cons

64+ let singleConstRec = isSingleConstRec dd_cons

67− if singleConstRec

65+ if singleConstRec

68− then space

66+ then space

69− else

67+ else

70− if hasHaddocks dd_cons

68+ if hasHaddocks dd_cons

71− then newline

69+ then newline

72− else breakpoint

70+ else breakpoint

73− equals

71+ equals

74− space

72+ space

73+ layout <- getLayout

75− let s =

74+ let s =

76− vlayout

75+ if layout == MultiLine || hasHaddocks dd_cons

77− (space >> txt "|" >> space)

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

78− (newline >> txt "|" >> space)

77+ else space >> txt "|" >> space

79− sitcc' =

78+ sitcc' =

80− if singleConstRec

79+ if singleConstRec

81− then id

80+ then id

82− else sitcc

81+ else sitcc

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

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

84 unless (null $ unLoc dd_derivs) breakpoint

83 unless (null $ unLoc dd_derivs) breakpoint

85 inci . located dd_derivs $ \xs ->

84 inci . located dd_derivs $ \xs ->

86 sep newline (located' p_hsDerivingClause) xs

85 sep newline (located' p_hsDerivingClause) xs

@@ -105,11 +104,10 @@ p_conDecl singleConstRec = \case

105 (c : cs) -> do

104 (c : cs) -> do

106 p_rdrName c

105 p_rdrName c

107 unless (null cs) . inci $ do

106 unless (null cs) . inci $ do

108− comma

107+ commaDel

109− breakpoint

110− sitcc $ sep (comma >> breakpoint) p_rdrName cs

108+ sep commaDel p_rdrName cs

111− space

112 inci $ do

109 inci $ do

110+ space

113 txt "::"

111 txt "::"

114 let interArgBreak =

112 let interArgBreak =

115 if hasDocStrings (unLoc con_res_ty)

113 if hasDocStrings (unLoc con_res_ty)

@@ -157,11 +155,7 @@ p_conDecl singleConstRec = \case

157 RecCon l -> do

155 RecCon l -> do

158 p_rdrName con_name

156 p_rdrName con_name

159 breakpoint

157 breakpoint

160− let inci' =

161− if singleConstRec

162− then id

163− else inci

164− inci' (located l p_conDeclFields)

158+ inciIf (not singleConstRec) (located l p_conDeclFields)

165 InfixCon x y -> do

159 InfixCon x y -> do

166 located x p_hsType

160 located x p_hsType

167 breakpoint

161 breakpoint

@@ -210,9 +204,9 @@ p_hsDerivingClause HsDerivingClause {..} = do

210 let derivingWhat = located deriv_clause_tys $ \case

204 let derivingWhat = located deriv_clause_tys $ \case

211 [] -> txt "()"

205 [] -> txt "()"

212 xs ->

206 xs ->

213− parens N . sitcc $

207+ parens N $

214 sep

208 sep

215− (comma >> breakpoint)

209+ commaDel

216 (sitcc . located' p_hsType . hsib_body)

210 (sitcc . located' p_hsType . hsib_body)

217 xs

211 xs

218 space

212 space

src/Ormolu/Printer/Meat/Declaration/Default.hs+2−2

@@ -15,6 +15,6 @@ p_defaultDecl = \case

15 DefaultDecl NoExtField ts -> do

16 txt "default"

17 breakpoint

18− inci . parens N . sitcc $

18+ inci . parens N $

19− sep (comma >> breakpoint) (sitcc . located' p_hsType) ts

19+ sep commaDel (sitcc . located' p_hsType) ts

20 XDefaultDecl x -> noExtCon x

src/Ormolu/Printer/Meat/Declaration/Instance.hs+5−9

@@ -32,9 +32,7 @@ p_standaloneDerivDecl DerivDecl {..} = do

32 txt "instance"

33 breakpoint

34 match_overlap_mode deriv_overlap_mode breakpoint

35− if toIndent

36− then inci typesAfterInstance

37− else typesAfterInstance

35+ inciIf toIndent typesAfterInstance

38 txt "deriving"

36 txt "deriving"

39 space

37 space

40 case deriv_strategy of

38 case deriv_strategy of

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

90 unless (null allDecls) $ do

88 unless (null allDecls) $ do

91 breakpoint

89 breakpoint

92 txt "where"

90 txt "where"

93− unless (null allDecls)

91+ unless (null allDecls) . inci $ do

94− $ inci

95− $ do

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

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

97− breakpoint

93+ breakpoint

98− dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

94+ dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

99 XHsImplicitBndrs x -> noExtCon x

95 XHsImplicitBndrs x -> noExtCon x

100 XClsInstDecl x -> noExtCon x

96 XClsInstDecl x -> noExtCon x

101

97

src/Ormolu/Printer/Meat/Declaration/Rule.hs+1−1

@@ -18,7 +18,7 @@ import Ormolu.Printer.Meat.Type

18p_ruleDecls :: RuleDecls GhcPs -> R ()

19p_ruleDecls = \case

20 HsRules NoExtField _ xs ->

21− pragma "RULES" . sitcc $

21+ pragma "RULES" $

22 sep breakpoint (sitcc . located' p_ruleDecl) xs

23 XRuleDecls x -> noExtCon x

24

src/Ormolu/Printer/Meat/Declaration/Signature.hs+25−28

@@ -14,7 +14,6 @@ where

14import BasicTypes

15import BooleanFormula

16import Control.Monad

17−import Data.Bool (bool)

18import GHC

17import GHC

19import Ormolu.Printer.Combinators

18import Ormolu.Printer.Combinators

20import Ormolu.Printer.Meat.Common

19import Ormolu.Printer.Meat.Common

@@ -48,25 +47,22 @@ p_typeSig indentTail (n : ns) hswc = do

48 p_rdrName n

47 p_rdrName n

49 if null ns

48 if null ns

50 then p_typeAscription hswc

49 then p_typeAscription hswc

51− else do

52− comma

53− breakpoint

54− bool id inci indentTail $ do

50+ else inciIf indentTail $ do

51+ commaDel

55− sep (comma >> breakpoint) p_rdrName ns

52+ sep commaDel p_rdrName ns

56− p_typeAscription hswc

53+ p_typeAscription hswc

57

54

58p_typeAscription ::

55p_typeAscription ::

59 LHsSigWcType GhcPs ->

56 LHsSigWcType GhcPs ->

60 R ()

57 R ()

61−p_typeAscription HsWC {..} = do

58+p_typeAscription HsWC {..} = inci $ do

62 space

59 space

63− inci $ do

64− txt "::"

60+ txt "::"

65− let t = hsib_body hswc_body

61+ let t = hsib_body hswc_body

66− if hasDocStrings (unLoc t)

62+ if hasDocStrings (unLoc t)

67− then newline

63+ then newline

68− else breakpoint

64+ else breakpoint

69− located t p_hsType

65+ located t p_hsType

70p_typeAscription (XHsWildCardBndrs x) = noExtCon x

66p_typeAscription (XHsWildCardBndrs x) = noExtCon x

71

67

72p_patSynSig ::

68p_patSynSig ::

@@ -108,7 +104,7 @@ p_fixSig = \case

108 space

104 space

109 atom n

105 atom n

110 space

106 space

111− sitcc $ sep (comma >> breakpoint) p_rdrName names

107+ sitcc $ sep commaDel p_rdrName names

112 XFixitySig x -> noExtCon x

108 XFixitySig x -> noExtCon x

113

109

114p_inlineSig ::

110p_inlineSig ::

@@ -147,7 +143,7 @@ p_specSig name ts InlinePragma {..} = pragmaBraces $ do

147 space

143 space

148 txt "::"

144 txt "::"

149 breakpoint

145 breakpoint

150− inci $ sep (comma >> breakpoint) (located' p_hsType . hsib_body) ts

146+ inci $ sep commaDel (located' p_hsType . hsib_body) ts

151

147

152p_inlineSpec :: InlineSpec -> R ()

148p_inlineSpec :: InlineSpec -> R ()

153p_inlineSpec = \case

149p_inlineSpec = \case

@@ -191,13 +187,13 @@ p_booleanFormula = \case

191 And xs ->

187 And xs ->

192 sitcc $

188 sitcc $

193 sep

189 sep

194− (comma >> breakpoint)

190+ commaDel

195 (located' p_booleanFormula)

191 (located' p_booleanFormula)

196 xs

192 xs

197 Or xs ->

193 Or xs ->

198 sitcc $

194 sitcc $

199 sep

195 sep

200− (breakpoint >> txt "| ")

196+ (breakpoint >> txt "|" >> space)

201 (located' p_booleanFormula)

197 (located' p_booleanFormula)

202 xs

198 xs

203 Parens l -> located l (parens N . p_booleanFormula)

199 Parens l -> located l (parens N . p_booleanFormula)

@@ -211,7 +207,7 @@ p_completeSig ::

211p_completeSig cs' mty =

207p_completeSig cs' mty =

212 located cs' $ \cs ->

208 located cs' $ \cs ->

213 pragma "COMPLETE" . inci $ do

209 pragma "COMPLETE" . inci $ do

214− sitcc $ sep (comma >> breakpoint) p_rdrName cs

210+ sep commaDel p_rdrName cs

215 forM_ mty $ \ty -> do

211 forM_ mty $ \ty -> do

216 space

212 space

217 txt "::"

213 txt "::"

@@ -228,12 +224,13 @@ p_sccSig loc literal = pragma "SCC" . inci $ do

228p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()

224p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()

229p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do

225p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do

230 txt "type"

226 txt "type"

227+ inci $ do

231− space

228+ space

232− p_rdrName name

229+ p_rdrName name

233− space

230+ space

234− txt "::"

231+ txt "::"

235− breakpoint

232+ breakpoint

236− inci $ case bndrs of

233+ case bndrs of

237− HsIB NoExtField sig -> located sig p_hsType

234+ HsIB NoExtField sig -> located sig p_hsType

238− XHsImplicitBndrs x -> noExtCon x

235+ XHsImplicitBndrs x -> noExtCon x

239p_standaloneKindSig (XStandaloneKindSig c) = noExtCon c

236p_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

28 switchLayout (getLoc name : map getLoc hsq_explicit) $

29 p_infixDefHelper

30 (case fixity of Infix -> True; _ -> False)

31− inci

31+ True

32 (p_rdrName name)

33 (map (located' p_hsTyVarBndr) hsq_explicit)

34 space

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+3−3

@@ -31,7 +31,7 @@ p_famDecl style FamilyDecl {fdTyVars = HsQTvs {..}, ..} = do

31 switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $

32 p_infixDefHelper

33 (isInfix fdFixity)

34− inci

34+ True

35 (p_rdrName fdLName)

36 (located' p_hsTyVarBndr <$> hsq_explicit)

37 let resultSig = p_familyResultSigL fdResultSig

@@ -92,12 +92,12 @@ p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do

92 Just bndrs -> do

93 p_forallBndrs ForallInvis p_hsTyVarBndr bndrs

94 breakpoint

95− (if null feqn_bndrs then id else inci) $ do

95+ inciIf (not $ null feqn_bndrs) $ do

96 let famLhsSpn = getLoc feqn_tycon : fmap (getLoc . typeArgToType) feqn_pats

97 switchLayout famLhsSpn $

98 p_infixDefHelper

99 (isInfix feqn_fixity)

100− inci

100+ True

101 (p_rdrName feqn_tycon)

102 (located' p_hsType . typeArgToType <$> feqn_pats)

103 space

src/Ormolu/Printer/Meat/Declaration/Value.hs+149−142

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

1{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE MultiWayIf #-}

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE RecordWildCards #-}

4{-# LANGUAGE RecordWildCards #-}

4{-# LANGUAGE TypeApplications #-}

5{-# LANGUAGE TypeApplications #-}

@@ -21,12 +22,12 @@ import Data.Char (isPunctuation, isSymbol)

21import Data.Data hiding (Infix, Prefix)

22import Data.Data hiding (Infix, Prefix)

22import Data.Functor ((<&>))

23import Data.Functor ((<&>))

23import Data.List (intersperse, sortOn)

24import Data.List (intersperse, sortOn)

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

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

25import qualified Data.List.NonEmpty as NE

26import qualified Data.List.NonEmpty as NE

26import Data.Text (Text)

27import Data.Text (Text)

27import qualified Data.Text as Text

28import qualified Data.Text as Text

28import GHC

29import GHC

29−import OccName (mkVarOcc)

30+import OccName (occNameString)

30import Ormolu.Printer.Combinators

31import Ormolu.Printer.Combinators

31import Ormolu.Printer.Internal

32import Ormolu.Printer.Internal

32import Ormolu.Printer.Meat.Common

33import Ormolu.Printer.Meat.Common

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

60 -- should use it and avoid bumping one level

61 -- should use it and avoid bumping one level

61 -- of indentation

62 -- of indentation

62 Hanging

63 Hanging

63− deriving (Eq)

64+ deriving (Eq, Show)

64

65

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

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

66p_valDecl = \case

67p_valDecl = \case

@@ -179,25 +180,24 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

179 NoSrcStrict -> return ()

180 NoSrcStrict -> return ()

180 SrcStrict -> txt "!"

181 SrcStrict -> txt "!"

181 SrcLazy -> txt "~"

182 SrcLazy -> txt "~"

182− inci' <- case NE.nonEmpty m_pats of

183+ indentBody <- case NE.nonEmpty m_pats of

184+ Nothing ->

183− Nothing -> id <$ case style of

185+ False <$ case style of

184− Function name -> p_rdrName name

186+ Function name -> p_rdrName name

185− _ -> return ()

187+ _ -> return ()

186 Just ne_pats -> do

188 Just ne_pats -> do

187− let combinedSpans =

189+ let combinedSpans = case style of

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

191+ _ -> patSpans

188− combineSrcSpans' $

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

189− getLoc <$> ne_pats

190− inci' =

191− if isOneLineSpan combinedSpans

193+ indentBody = not (isOneLineSpan combinedSpans)

192− then id

193− else inci

194 switchLayout [combinedSpans] $ do

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

196 case style of

197 Function name ->

198 p_infixDefHelper

199 isInfix

200− inci'

200+ indentBody

201 (p_rdrName name)

202 (located' p_pat <$> m_pats)

203 PatternBind -> stdCase

@@ -212,7 +212,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

212 when needsSpace space

213 sitcc stdCase

214 LambdaCase -> stdCase

215− return inci'

215+ return indentBody

216 let -- Calculate position of end of patterns. This is useful when we decide

217 -- about putting certain constructions in hanging positions.

218 endOfPats = case NE.nonEmpty m_pats of

@@ -224,7 +224,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

224 Case -> True

225 LambdaCase -> True

226 _ -> False

227− let hasGuards = withGuards grhssGRHSs

227+ hasGuards = withGuards grhssGRHSs

228 grhssSpan =

229 combineSrcSpans' $

230 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

@@ -253,7 +253,7 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

253 txt "where"

254 unless whereIsEmpty breakpoint

255 inci $ located grhssLocalBinds p_hsLocalBinds

256− inci' $ do

256+ inciIf indentBody $ do

257 unless (length grhssGRHSs > 1) $

258 case style of

259 Function _ | hasGuards -> return ()

@@ -284,7 +284,7 @@ p_grhs' placer render style (GRHS NoExtField guards body) =

284 xs -> do

285 txt "|"

286 space

287− sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)

287+ sitcc (sep commaDel (sitcc . located' p_stmt) xs)

288 space

289 inci $ case style of

290 EqualSign -> equals

@@ -316,7 +316,7 @@ p_hsCmd = \case

316 HsHigherOrderApp -> txt "-<<"

317 placeHanging (exprPlacement (unLoc input)) $

318 located input p_hsExpr

319− HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do

319+ HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ do

320 located form p_hsExpr

321 unless (null cmds) $ do

322 breakpoint

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

353 HsCmdTop NoExtField cmd -> located cmd p_hsCmd

354 XCmdTop x -> noExtCon x

355

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

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

356−withSpacing :: Data a => (a -> R ()) -> Located a -> R ()

358+withSpacing ::

359+ -- | Rendering function

360+ (a -> R ()) ->

361+ -- | Entity to render

362+ Located a ->

363+ R ()

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

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

358 case getLoc l of

365 case getLoc l of

359 UnhelpfulSpan _ -> f x

366 UnhelpfulSpan _ -> f x

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

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

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

465p_hsLocalBinds = \case

472p_hsLocalBinds = \case

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

473 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

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

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

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

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

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

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

478 br <- layoutToBraces <$> getLayout

477 br <- layoutToBraces <$> getLayout

479− sitcc $

478+ let items =

480− sepSemi

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

481− ( \(p, i) ->

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

482− ( case p of

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

482+ positionToBracing = \case

483− SinglePos -> id

483+ SinglePos -> id

484− FirstPos -> br

484+ FirstPos -> br

485− MiddlePos -> br

485+ MiddlePos -> br

486− LastPos -> id

486+ LastPos -> id

487− )

487+ p_item' (p, item) =

488− (p_item i)

488+ positionToBracing p $

489− )

489+ withSpacing (either p_valDecl p_sigDecl) item

490+ binds = sortOn (srcSpanStart . getLoc) items

490− (attachRelativePos $ sortOn ssStart items)

491+ sitcc $ sepSemi p_item' (attachRelativePos binds)

491 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

492 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

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

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

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

520 else Normal

521 else Normal

521 placeHanging placement (located hsRecFieldArg p_hsExpr)

522 placeHanging placement (located hsRecFieldArg p_hsExpr)

522

523

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−

529p_hsExpr :: HsExpr GhcPs -> R ()

524p_hsExpr :: HsExpr GhcPs -> R ()

530p_hsExpr = p_hsExpr' N

525p_hsExpr = p_hsExpr' N

531

526

@@ -589,23 +584,21 @@ p_hsExpr' s = \case

589 -- do-block or case expression it is not a good idea. It seems

584 -- do-block or case expression it is not a good idea. It seems

590 -- to be safe to always bump indentation when the function

585 -- to be safe to always bump indentation when the function

591 -- expression is parenthesised.

586 -- expression is parenthesised.

592− indent =

587+ doIndent =

593 case func of

588 case func of

594− L _ (HsPar NoExtField _) -> inci

589+ L _ (HsPar NoExtField _) -> True

595− L _ (HsAppType NoExtField _ _) -> inci

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

596− L _ (HsMultiIf NoExtField _) -> inci

591+ L _ (HsMultiIf NoExtField _) -> True

597− L spn _ ->

598− if isOneLineSpan spn

592+ L spn _ -> isOneLineSpan spn

599− then inci

593+ ub <-

600− else id

601− ub <- getLayout <&> \case

594+ getLayout <&> \case

602− SingleLine -> useBraces

595+ SingleLine -> useBraces

603− MultiLine -> id

596+ MultiLine -> id

604 ub $ do

597 ub $ do

605 located func (p_hsExpr' s)

598 located func (p_hsExpr' s)

606 breakpoint

599 breakpoint

607− indent $ sep breakpoint (located' p_hsExpr) initp

600+ inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp

608− indent $ do

601+ inciIf doIndent $ do

609 unless (null initp) breakpoint

602 unless (null initp) breakpoint

610 located lastp p_hsExpr

603 located lastp p_hsExpr

611 Hanging -> do

604 Hanging -> do

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

620 breakpoint

613 breakpoint

621 inci $ do

614 inci $ do

622 txt "@"

615 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 ()

623 located (hswc_body a) p_hsType

621 located (hswc_body a) p_hsType

624 OpApp NoExtField x op y -> do

622 OpApp NoExtField x op y -> do

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

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

626− p_exprOpTree True s (reassociateOpTree getOpName opTree)

624+ p_exprOpTree s (reassociateOpTree getOpName opTree)

627 NegApp NoExtField e _ -> do

625 NegApp NoExtField e _ -> do

628 txt "-"

626 txt "-"

629 space

627 space

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

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

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

641 unless (useRecordDot' && isRecordDot') breakpoint

639 unless (useRecordDot' && isRecordDot') breakpoint

642 inci (located x p_hsExpr)

640 inci (located x p_hsExpr)

643− ExplicitTuple NoExtField args boxity -> do

641+ ExplicitTuple NoExtField args boxity ->

644 let isSection = any (isMissing . unLoc) args

642 let isSection = any (isMissing . unLoc) args

645 isMissing = \case

643 isMissing = \case

646 Missing NoExtField -> True

644 Missing NoExtField -> True

647 _ -> False

645 _ -> 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

648− let parens' =

651+ parens' =

649 case boxity of

652 case boxity of

650 Boxed -> parens

653 Boxed -> parens

651 Unboxed -> parensHash

654 Unboxed -> parensHash

652− if isSection

655+ in if isSection

653− then

656+ then

654− switchLayout [] . parens' s $

657+ switchLayout [] . parens' s $

655− sep comma (located' p_hsTupArg) args

658+ sep comma p_larg args

656− else

659+ else

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

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

658− sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args

661+ sep commaDel p_larg args

659 ExplicitSum NoExtField tag arity e ->

662 ExplicitSum NoExtField tag arity e ->

660 p_unboxedSum N tag arity (located e p_hsExpr)

663 p_unboxedSum N tag arity (located e p_hsExpr)

661 HsCase NoExtField e mgroup ->

664 HsCase NoExtField e mgroup ->

@@ -665,7 +668,7 @@ p_hsExpr' s = \case

665 HsMultiIf NoExtField guards -> do

668 HsMultiIf NoExtField guards -> do

666 txt "if"

669 txt "if"

667 breakpoint

670 breakpoint

668− inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards

671+ inci . inci $ sep newline (located' (p_grhs RightArrow)) guards

669 HsLet NoExtField localBinds e ->

672 HsLet NoExtField localBinds e ->

670 p_let p_hsExpr localBinds e

673 p_let p_hsExpr localBinds e

671 HsDo NoExtField ctx es -> do

674 HsDo NoExtField ctx es -> do

@@ -677,15 +680,15 @@ p_hsExpr' s = \case

677 sepSemi

680 sepSemi

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

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

679 (unLoc es)

682 (unLoc es)

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

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

681 let p_parBody =

684 let p_parBody =

682 sep

685 sep

683− (breakpoint >> txt "| ")

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

684 p_seqBody

687 p_seqBody

685 p_seqBody =

688 p_seqBody =

686 sitcc

689 sitcc

687 . sep

690 . sep

688− (comma >> breakpoint)

691+ commaDel

689 (located' (sitcc . p_stmt))

692 (located' (sitcc . p_stmt))

690 stmts = init xs

693 stmts = init xs

691 yield = last xs

694 yield = last xs

@@ -706,8 +709,8 @@ p_hsExpr' s = \case

706 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"

709 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"

707 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

710 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

708 ExplicitList _ _ xs ->

711 ExplicitList _ _ xs ->

709− brackets s . sitcc $

712+ brackets s $

710− sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs

713+ sep commaDel (sitcc . located' p_hsExpr) xs

711 RecordCon {..} -> do

714 RecordCon {..} -> do

712 located rcon_con_name atom

715 located rcon_con_name atom

713 breakpoint

716 breakpoint

@@ -723,8 +726,8 @@ p_hsExpr' s = \case

723 case rec_dotdot of

726 case rec_dotdot of

724 Just {} -> [txt ".."]

727 Just {} -> [txt ".."]

725 Nothing -> []

728 Nothing -> []

726− inci . braces N . sitcc $

729+ inci . braces N $

727− sep (comma >> breakpoint) sitcc (fields <> dotdot)

730+ sep commaDel sitcc (fields <> dotdot)

728 RecordUpd {..} -> do

731 RecordUpd {..} -> do

729 located rupd_expr p_hsExpr

732 located rupd_expr p_hsExpr

730 useRecordDot' <- useRecordDot

733 useRecordDot' <- useRecordDot

@@ -742,9 +745,9 @@ p_hsExpr' s = \case

742 Unambiguous _ n -> n

745 Unambiguous _ n -> n

743 XAmbiguousFieldOcc x -> noExtCon x

746 XAmbiguousFieldOcc x -> noExtCon x

744 }

747 }

745− inci . braces N . sitcc $

748+ inci . braces N $

746 sep

749 sep

747− (comma >> breakpoint)

750+ commaDel

748 (sitcc . located' (p_hsRecField . updName))

751 (sitcc . located' (p_hsRecField . updName))

749 rupd_flds

752 rupd_flds

750 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do

753 ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do

@@ -757,22 +760,22 @@ p_hsExpr' s = \case

757 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x

760 ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x

758 ArithSeq NoExtField _ x ->

761 ArithSeq NoExtField _ x ->

759 case x of

762 case x of

760− From from -> brackets s . sitcc $ do

763+ From from -> brackets s $ do

761 located from p_hsExpr

764 located from p_hsExpr

762 breakpoint

765 breakpoint

763 txt ".."

766 txt ".."

764− FromThen from next -> brackets s . sitcc $ do

767+ FromThen from next -> brackets s $ do

765− sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]

768+ sep commaDel (located' p_hsExpr) [from, next]

766 breakpoint

769 breakpoint

767 txt ".."

770 txt ".."

768− FromTo from to -> brackets s . sitcc $ do

771+ FromTo from to -> brackets s $ do

769 located from p_hsExpr

772 located from p_hsExpr

770 breakpoint

773 breakpoint

771 txt ".."

774 txt ".."

772 space

775 space

773 located to p_hsExpr

776 located to p_hsExpr

774− FromThenTo from next to -> brackets s . sitcc $ do

777+ FromThenTo from next to -> brackets s $ do

775− sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]

778+ sep commaDel (located' p_hsExpr) [from, next]

776 breakpoint

779 breakpoint

777 txt ".."

780 txt ".."

778 space

781 space

@@ -849,8 +852,8 @@ p_patSynBind PSB {..} = do

849 inci $ do

852 inci $ do

850 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do

853 switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do

851 unless (null xs) breakpoint

854 unless (null xs) breakpoint

852− braces N . sitcc $

855+ braces N $

853− sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs

856+ sep commaDel (p_rdrName . recordPatSynPatVar) xs

854 rhs

857 rhs

855 InfixCon l r -> do

858 InfixCon l r -> do

856 switchLayout [getLoc l, getLoc r] $ do

859 switchLayout [getLoc l, getLoc r] $ do

@@ -946,13 +949,13 @@ p_pat = \case

946 txt "!"

949 txt "!"

947 located pat p_pat

950 located pat p_pat

948 ListPat NoExtField pats ->

951 ListPat NoExtField pats ->

949− brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats

952+ brackets S $ sep commaDel (located' p_pat) pats

950 TuplePat NoExtField pats boxing -> do

953 TuplePat NoExtField pats boxing -> do

951− let f =

954+ let parens' =

952 case boxing of

955 case boxing of

953 Boxed -> parens S

956 Boxed -> parens S

954 Unboxed -> parensHash S

957 Unboxed -> parensHash S

955− f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats

958+ parens' $ sep commaDel (sitcc . located' p_pat) pats

956 SumPat NoExtField pat tag arity ->

959 SumPat NoExtField pat tag arity ->

957 p_unboxedSum S tag arity (located pat p_pat)

960 p_unboxedSum S tag arity (located pat p_pat)

958 ConPatIn pat details ->

961 ConPatIn pat details ->

@@ -968,7 +971,7 @@ p_pat = \case

968 let f = \case

971 let f = \case

969 Nothing -> txt ".."

972 Nothing -> txt ".."

970 Just x -> located x p_pat_hsRecField

973 Just x -> located x p_pat_hsRecField

971− inci . braces N . sitcc . sep (comma >> breakpoint) f $

974+ inci . braces N . sep commaDel f $

972 case dotdot of

975 case dotdot of

973 Nothing -> Just <$> fields

976 Nothing -> Just <$> fields

974 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]

977 Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]

@@ -1018,17 +1021,15 @@ p_unboxedSum s tag arity m = do

1018 let before = tag - 1

1021 let before = tag - 1

1019 after = arity - before - 1

1022 after = arity - before - 1

1020 args = replicate before Nothing <> [Just m] <> replicate after Nothing

1023 args = replicate before Nothing <> [Just m] <> replicate after Nothing

1021− f (x, i) = do

1024+ f x =

1022− let isFirst = i == 0

1023− isLast = i == arity - 1

1024 case x :: Maybe (R ()) of

1025 case x :: Maybe (R ()) of

1025 Nothing ->

1026 Nothing ->

1026− unless (isFirst || isLast) space

1027+ space

1027 Just m' -> do

1028 Just m' -> do

1028− unless isFirst space

1029+ space

1029 m'

1030 m'

1030− unless isLast space

1031+ space

1031− parensHash s $ sep (txt "|") f (zip args [0 ..])

1032+ parensHash s $ sep (txt "|") f args

1032

1033

1033p_hsSplice :: HsSplice GhcPs -> R ()

1034p_hsSplice :: HsSplice GhcPs -> R ()

1034p_hsSplice = \case

1035p_hsSplice = \case

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

1230 HsCase NoExtField _ _ -> Hanging

1231 HsCase NoExtField _ _ -> Hanging

1231 HsDo NoExtField DoExpr _ -> Hanging

1232 HsDo NoExtField DoExpr _ -> Hanging

1232 HsDo NoExtField MDoExpr _ -> Hanging

1233 HsDo NoExtField MDoExpr _ -> Hanging

1233− -- If the rightmost expression in an operator chain is hanging, make the

1234+ OpApp NoExtField _ op y ->

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

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

1235− -- style.

1236− OpApp NoExtField _ _ y -> exprPlacement (unLoc y)

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

1237− -- Same thing for function applications (usually with -XBlockArguments)

1237+ _ -> Normal

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

1239 HsProc NoExtField p _ ->

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

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

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

1261 _ -> Nothing

1262

1263+getOpNameStr :: RdrName -> String

1264+getOpNameStr = occNameString . rdrNameOcc

1265+

1263p_exprOpTree ::

1266p_exprOpTree ::

1264− -- | Can use special handling of dollar?

1265− Bool ->

1266 -- | Bracket style to use

1267 -- | Bracket style to use

1267 BracketStyle ->

1268 BracketStyle ->

1268 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->

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

1269 R ()

1270 R ()

1270−p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)

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

1271−p_exprOpTree isDollarSpecial s (OpBranch x op y) = do

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

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

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

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

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

1274 -- placement.

1275 -- placement.

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

1290 MultiLine -> case placement of

1291 MultiLine -> case placement of

1291 Hanging -> useBraces

1292 Hanging -> useBraces

1292 Normal -> dontUseBraces

1293 Normal -> dontUseBraces

1293− gotDollar = case getOpName (unLoc op) of

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

1294− Just rname -> mkVarOcc "$" == rdrNameOcc rname

1295+ gotDollar = opNameStr == Just "$"

1295− _ -> False

1296+ gotColon = opNameStr == Just ":"

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

1296 lhs =

1298 lhs =

1297 switchLayout [opTreeLoc x] $

1299 switchLayout [opTreeLoc x] $

1298− p_exprOpTree (not gotDollar) s x

1300+ p_exprOpTree s x

1299− let p_op = located op (opWrapper . p_hsExpr)

1301+ p_op = located op (opWrapper . p_hsExpr)

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

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

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

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

1302 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1304 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1303 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1305 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1304 _ -> False

1306 _ -> False

1307+ isDoBlock = \case

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

1309+ _ -> False

1305 useRecordDot' <- useRecordDot

1310 useRecordDot' <- useRecordDot

1306− let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)

1311+ if

1307− if useRecordDot' && isRecordDot'

1312+ | gotColon -> do

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

1313+ lhs

1321− space

1314+ space

1322− p_op

1315+ p_op

1323− breakpoint

1316+ case placement of

1324− inci p_y

1317+ Hanging -> do

1325− else do

1326− ub lhs

1327− placeHanging placement $ do

1328− p_op

1329 space

1318 space

1330 p_y

1319 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

1331

1342

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

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

1333isRecordDot ::

1344isRecordDot ::

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

1338 Bool

1349 Bool

1339isRecordDot op (RealSrcSpan ySpan) = case op of

1350isRecordDot op (RealSrcSpan ySpan) = case op of

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

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

1341− isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)

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

1342 _ -> False

1353 _ -> False

1343isRecordDot _ _ = False

1354isRecordDot _ _ = False

1344

1355

1345−-- | Check whether a given 'RdrName' is the dot operator.

1346−isDot :: RdrName -> Bool

1347−isDot name = rdrNameOcc name == mkVarOcc "."

1348−

1349-- | Get annotations for the enclosing element.

1356-- | Get annotations for the enclosing element.

1350getEnclosingAnns :: R [AnnKeywordId]

1357getEnclosingAnns :: R [AnnKeywordId]

1351getEnclosingAnns = do

1358getEnclosingAnns = do

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

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

11import Ormolu.Printer.Combinators

12

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

14−

15p_pat :: Pat GhcPs -> R ()

14p_pat :: Pat GhcPs -> R ()

16−

17p_hsExpr :: HsExpr GhcPs -> R ()

15p_hsExpr :: HsExpr GhcPs -> R ()

18−

19p_hsSplice :: HsSplice GhcPs -> R ()

16p_hsSplice :: HsSplice GhcPs -> R ()

20−

21p_stringLit :: String -> R ()

17p_stringLit :: String -> R ()

src/Ormolu/Printer/Meat/Declaration/Warning.hs+4−5

@@ -32,10 +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

36+ pragma pragmaText . inci $ do

37− $ do

38− sitcc $ sep (comma >> breakpoint) p_rdrName fnames

37+ sep commaDel p_rdrName fnames

39 breakpoint

38 breakpoint

40 p_lits lits

39 p_lits lits

41

40

@@ -47,4 +46,4 @@ warningText = \case

47p_lits :: [Located StringLiteral] -> R ()

46p_lits :: [Located StringLiteral] -> R ()

48p_lits = \case

47p_lits = \case

49 [l] -> atom l

48 [l] -> atom l

50− ls -> brackets N . sitcc $ sep (comma >> breakpoint) atom ls

49+ ls -> brackets N $ sep commaDel atom ls

src/Ormolu/Printer/Meat/ImportExport.hs+4−5

@@ -21,7 +21,7 @@ p_hsmodExports [] = do

21 breakpoint'

22 txt ")"

23p_hsmodExports xs =

24− parens N . sitcc $ do

24+ parens N $ do

25 layout <- getLayout

26 sep

27 breakpoint

@@ -65,7 +65,7 @@ p_hsmodImport useQualifiedPost ImportDecl {..} = do

65 Nothing -> return ()

66 Just (_, L _ xs) -> do

67 breakpoint

68− parens N . sitcc $ do

68+ parens N $ do

69 layout <- getLayout

70 sep

71 breakpoint

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

93 inci $ do

94 let names :: [R ()]

95 names = located' p_ieWrappedName <$> xs

96− parens N . sitcc

96+ parens N . sep commaDel sitcc $

97− $ sep (comma >> breakpoint) sitcc

98− $ case w of

97+ case w of

99 NoIEWildcard -> names

98 NoIEWildcard -> names

100 IEWildcard n ->

99 IEWildcard n ->

101 let (before, after) = splitAt n names

100 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

14+import Ormolu.Imports (normalizeImports)

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_ (sortImports hsmodImports) (located' (p_hsmodImport qualifiedPost))

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

73 newline

74 switchLayout (getLoc <$> hsmodDecls) $ do

75 p_hsDecls Free hsmodDecls

src/Ormolu/Printer/Meat/Type.hs+11−15

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

@@ -98,10 +98,9 @@ p_hsType' multilineArgs docStyle = \case

98 HsBoxedTuple -> parens N

99 HsConstraintTuple -> parens N

100 HsBoxedOrConstraintTuple -> parens N

101− in parens' . sitcc $

102− sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

101+ in parens' $ sep commaDel (sitcc . located' p_hsType) xs

103 HsSumTy NoExtField xs ->

102 HsSumTy NoExtField xs ->

104− parensHash N . sitcc $

103+ parensHash N $

105 sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs

104 sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs

106 HsOpTy NoExtField x op y ->

105 HsOpTy NoExtField x op y ->

107 sitcc $

106 sitcc $

@@ -118,9 +117,9 @@ p_hsType' multilineArgs docStyle = \case

118 HsStarTy NoExtField _ -> txt "*"

117 HsStarTy NoExtField _ -> txt "*"

119 HsKindSig NoExtField t k -> sitcc $ do

118 HsKindSig NoExtField t k -> sitcc $ do

120 located t p_hsType

119 located t p_hsType

121− space -- FIXME

122− txt "::"

123 space

120 space

121+ txt "::"

122+ breakpoint

124 inci (located k p_hsType)

123 inci (located k p_hsType)

125 HsSpliceTy NoExtField splice -> p_hsSplice splice

124 HsSpliceTy NoExtField splice -> p_hsSplice splice

126 HsDocTy NoExtField t str ->

125 HsDocTy NoExtField t str ->

@@ -154,14 +153,14 @@ p_hsType' multilineArgs docStyle = \case

154 case (p, xs) of

153 case (p, xs) of

155 (IsPromoted, L _ t : _) | isPromoted t -> space

154 (IsPromoted, L _ t : _) | isPromoted t -> space

156 _ -> return ()

155 _ -> return ()

157− sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

156+ sep commaDel (sitcc . located' p_hsType) xs

158 HsExplicitTupleTy NoExtField xs -> do

157 HsExplicitTupleTy NoExtField xs -> do

159 txt "'"

158 txt "'"

160 parens N $ do

159 parens N $ do

161 case xs of

160 case xs of

162 L _ t : _ | isPromoted t -> space

161 L _ t : _ | isPromoted t -> space

163 _ -> return ()

162 _ -> return ()

164− sep (comma >> breakpoint) (located' p_hsType) xs

163+ sep commaDel (located' p_hsType) xs

165 HsTyLit NoExtField t ->

164 HsTyLit NoExtField t ->

166 case t of

165 case t of

167 HsStrTy (SourceText s) _ -> p_stringLit s

166 HsStrTy (SourceText s) _ -> p_stringLit s

@@ -192,9 +191,7 @@ p_hsContext :: HsContext GhcPs -> R ()

192p_hsContext = \case

191p_hsContext = \case

193 [] -> txt "()"

192 [] -> txt "()"

194 [x] -> located x p_hsType

193 [x] -> located x p_hsType

195− xs ->

196− parens N . sitcc $

197− sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

194+ xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs

198

195

199p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

196p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

200p_hsTyVarBndr = \case

197p_hsTyVarBndr = \case

@@ -224,15 +221,14 @@ p_forallBndrs vis p tyvars =

224

221

225p_conDeclFields :: [LConDeclField GhcPs] -> R ()

222p_conDeclFields :: [LConDeclField GhcPs] -> R ()

226p_conDeclFields xs =

223p_conDeclFields xs =

227− braces N . sitcc $

228− sep (comma >> breakpoint) (sitcc . located' p_conDeclField) xs

224+ braces N $ sep commaDel (sitcc . located' p_conDeclField) xs

229

225

230p_conDeclField :: ConDeclField GhcPs -> R ()

226p_conDeclField :: ConDeclField GhcPs -> R ()

231p_conDeclField ConDeclField {..} = do

227p_conDeclField ConDeclField {..} = do

232 mapM_ (p_hsDocString Pipe True) cd_fld_doc

228 mapM_ (p_hsDocString Pipe True) cd_fld_doc

233 sitcc $

229 sitcc $

234 sep

230 sep

235− (comma >> breakpoint)

231+ commaDel

236 (located' (p_rdrName . rdrNameFieldOcc))

232 (located' (p_rdrName . rdrNameFieldOcc))

237 cd_fld_names

233 cd_fld_names

238 space

234 space

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

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

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

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

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

276 -- declarations.

272 -- declarations.

277− HsParTy NoExtField $ noLoc $

273+ HsParTy NoExtField . noLoc $

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

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

279 XTyVarBndr x -> noExtCon x

275 XTyVarBndr x -> noExtCon x

src/Ormolu/Printer/Operators.hs+46−59

@@ -12,10 +12,11 @@ where

12

13import Data.Function (on)

14import qualified Data.List as L

15+import Data.Map.Strict (Map)

16+import qualified Data.Map.Strict as M

15import Data.Maybe (fromMaybe, mapMaybe)

17import Data.Maybe (fromMaybe, mapMaybe)

16−import Data.Ord (Down (Down), comparing)

17import GHC

18import GHC

18−import OccName (mkVarOcc)

19+import OccName (occNameString)

19import Ormolu.Utils (unSrcSpan)

20import Ormolu.Utils (unSrcSpan)

20

21

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

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

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

56reassociateOpTreeWith ::

57reassociateOpTreeWith ::

57 forall ty op.

58 forall ty op.

58 -- | Fixity map for operators

59 -- | Fixity map for operators

59− [(RdrName, Fixity)] ->

60+ Map String Fixity ->

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

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

61 (op -> Maybe RdrName) ->

62 (op -> Maybe RdrName) ->

62 -- | Original 'OpTree'

63 -- | Original 'OpTree'

@@ -67,13 +68,13 @@ reassociateOpTreeWith fixityMap getOpName = go

67 where

68 where

68 fixityOf :: op -> Fixity

69 fixityOf :: op -> Fixity

69 fixityOf op = fromMaybe defaultFixity $ do

70 fixityOf op = fromMaybe defaultFixity $ do

70− opName <- getOpName op

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

71− lookup opName fixityMap

72+ M.lookup s fixityMap

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

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

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

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

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

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

75 --

76 --

76− -- Also, we are using the 'compareFixity' function which returns if the

77+ -- Also, we are using the 'compareFixity' function which tells if the

77 -- expression should associate to right.

78 -- expression should associate to right.

78 go :: OpTree ty op -> OpTree ty op

79 go :: OpTree ty op -> OpTree ty op

79 -- base cases

80 -- base cases

@@ -93,6 +94,16 @@ reassociateOpTreeWith fixityMap getOpName = go

93 then go $ OpBranch (OpBranch l op (go $ OpBranch r op' l')) op'' r'

94 then go $ OpBranch (OpBranch l op (go $ OpBranch r op' l')) op'' r'

94 else go $ OpBranch (OpBranch (OpBranch l op r) op' l') op'' r'

95 else go $ OpBranch (OpBranch (OpBranch l op r) op' l') op'' r'

95

96

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+

96-- | Build a map of inferred 'Fixity's from an 'OpTree'.

107-- | Build a map of inferred 'Fixity's from an 'OpTree'.

97buildFixityMap ::

108buildFixityMap ::

98 forall ty op.

109 forall ty op.

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

101 -- | Operator tree

112 -- | Operator tree

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

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

103 -- | Fixity map

114 -- | Fixity map

104− [(RdrName, Fixity)]

115+ Map String Fixity

105buildFixityMap getOpName opTree =

116buildFixityMap getOpName opTree =

117+ addOverrides

118+ . M.fromList

106− concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)

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

107− . zip [0 ..]

120+ . zip [2 ..]

108− . L.groupBy (doubleWithinEps 0.00001 `on` snd)

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

109− . (overrides ++)

122+ . selectScores

110− . modeScores

111 $ score opTree

123 $ score opTree

112 where

124 where

113− -- Add a special case for ($), since it is pretty unlikely for someone

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

114− -- to override it.

126+ addOverrides m =

115− overrides :: [(RdrName, Double)]

127+ M.fromList

116− overrides =

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

117− [ (mkRdrUnqual $ mkVarOcc "$", -1)

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

118− ]

130+ (".", fixity 100 InfixL)

119− -- Assign scores to operators based on their location in the source.

131+ ]

132+ `M.union` m

133+ fixity = Fixity NoSourceText

120− score :: OpTree (Located ty) (Located op) -> [(RdrName, Double)]

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

121 score (OpNode _) = []

135 score (OpNode _) = []

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

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

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

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

@@ -127,48 +141,27 @@ buildFixityMap getOpName opTree =

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

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

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

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

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

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

130− opName <- getOpName (unLoc o)

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

131 let s

145 let s

132− | le < ob =

146+ | le < ob = AtBeginning oc

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 =

147+ | oe < rb = AtEnd

137− -- if the operator is in the end of the line, assign the

138− -- score 1.

139− 1

140− | otherwise =

148+ | otherwise = InBetween

141− 2 -- otherwise, assign a high score.

142 return $ (opName, s) : score r

149 return $ (opName, s) : score r

143− -- Pick the most common score per 'RdrName'.

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

144− modeScores :: [(RdrName, Double)] -> [(RdrName, Double)]

151+ selectScores =

145− modeScores =

146 L.sortOn snd

152 L.sortOn snd

147 . mapMaybe

153 . mapMaybe

148 ( \case

154 ( \case

149 [] -> Nothing

155 [] -> Nothing

150− xs@((n, _) : _) -> Just (n, mode $ map snd xs)

156+ xs@((n, _) : _) -> Just (n, selectScore $ map snd xs)

151 )

157 )

152 . L.groupBy ((==) `on` fst)

158 . L.groupBy ((==) `on` fst)

153 . L.sort

159 . L.sort

154− -- Return the most common number, leaning to the smaller

160+ selectScore :: [Score] -> Score

155− -- one in case of a tie.

161+ selectScore xs =

156− mode :: [Double] -> Double

162+ case filter (/= InBetween) xs of

157− mode =

163+ [] -> InBetween

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

164+ xs' -> maximum xs'

168− [ go l,

169− maybe 0 srcSpanStartCol (unSrcSpan o),

170− go r

171− ]

172

165

173----------------------------------------------------------------------------

166----------------------------------------------------------------------------

174-- Helpers

167-- Helpers

@@ -182,9 +175,3 @@ normalizeOpTree (OpBranch (OpNode l) lop r) =

182 OpBranch (OpNode l) lop (normalizeOpTree r)

175 OpBranch (OpNode l) lop (normalizeOpTree r)

183normalizeOpTree (OpBranch (OpBranch l' lop' r') lop r) =

176normalizeOpTree (OpBranch (OpBranch l' lop' r') lop r) =

184 normalizeOpTree (OpBranch l' lop' (OpBranch r' lop r))

177 normalizeOpTree (OpBranch l' lop' (OpBranch r' lop r))

185−

186−fixity :: Int -> FixityDirection -> Fixity

187−fixity = Fixity NoSourceText

188−

189−doubleWithinEps :: Double -> Double -> Double -> Bool

190−doubleWithinEps eps a b = abs (a - b) < eps

src/Ormolu/Processing/Common.hs+1−1

@@ -20,7 +20,7 @@ data OrmoluState

20

21-- | Marker for the beginning of the region where Ormolu should be disabled.

22startDisabling :: IsString s => s

23−startDisabling = "{- ORMOLU_DISABLING_START"

23+startDisabling = "{- ORMOLU_DISABLE_START"

24

25-- | Marker for the end of the region where Ormolu should be disabled.

26endDisabling :: IsString s => s

src/Ormolu/Processing/Postprocess.hs+13−3

@@ -1,3 +1,6 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE ViewPatterns #-}

3+

1-- | Postprocessing for the results of printing.

4-- | Postprocessing for the results of printing.

2module Ormolu.Processing.Postprocess

5module Ormolu.Processing.Postprocess

3 ( postprocess,

6 ( postprocess,

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

10import qualified Ormolu.Processing.Cpp as Cpp

13import qualified Ormolu.Processing.Cpp as Cpp

11

14

12-- | Postprocess output of the formatter.

15-- | Postprocess output of the formatter.

13−postprocess :: Text -> Text

16+postprocess ::

17+ -- | Desired indentation level

18+ Int ->

19+ -- | Input to process

20+ Text ->

21+ Text

14−postprocess =

22+postprocess indent =

15 T.unlines

23 T.unlines

24+ . fmap indentLine

16 . fmap Cpp.unmaskLine

25 . fmap Cpp.unmaskLine

17 . filter (not . magicComment)

26 . filter (not . magicComment)

18 . T.lines

27 . T.lines

19 where

28 where

20− magicComment x =

29+ magicComment (T.stripStart -> x) =

21 x == startDisabling || x == endDisabling

30 x == startDisabling || x == endDisabling

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

src/Ormolu/Processing/Preprocess.hs+4−4

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

11import Control.Monad

12import Data.Char (isSpace)

13import qualified Data.List as L

14−import Data.Maybe (isJust)

14+import Data.Maybe (isJust, maybeToList)

15−import Data.Maybe (maybeToList)

16import FastString

15import FastString

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

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

18import Ormolu.Parser.Shebang (isShebang)

17import Ormolu.Parser.Shebang (isShebang)

@@ -143,7 +142,8 @@ magicComment ::

143 -- | Whether or not the two strings watch

142 -- | Whether or not the two strings watch

144 Bool

143 Bool

145magicComment expected s0 = isJust $ do

144magicComment expected s0 = isJust $ do

146− s1 <- dropWhile isSpace <$> L.stripPrefix "{-" s0

145+ let trim = dropWhile isSpace

146+ s1 <- trim <$> L.stripPrefix "{-" (trim s0)

147− s2 <- dropWhile isSpace <$> L.stripPrefix expected s1

147+ s2 <- trim <$> L.stripPrefix expected s1

148 s3 <- L.stripPrefix "-}" s2

149 guard (all isSpace s3)

src/Ormolu/Utils.hs+15−1

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

1{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE ViewPatterns #-}

3

4

4-- | Random utilities used by the code.

5-- | Random utilities used by the code.

5module Ormolu.Utils

6module Ormolu.Utils

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

15 separatedByBlank,

16 separatedByBlank,

16 separatedByBlankNE,

17 separatedByBlankNE,

17 onTheSameLine,

18 onTheSameLine,

19+ removeIndentation,

18 )

20 )

19where

21where

20

22

23+import Data.Char (isSpace)

21import Data.List (dropWhileEnd)

24import Data.List (dropWhileEnd)

22−import qualified Data.List.NonEmpty as NE

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

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

26+import qualified Data.List.NonEmpty as NE

24import Data.Maybe (fromMaybe)

27import Data.Maybe (fromMaybe)

25import Data.Text (Text)

28import Data.Text (Text)

26import qualified Data.Text as T

29import qualified Data.Text as T

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

139onTheSameLine :: SrcSpan -> SrcSpan -> Bool

142onTheSameLine :: SrcSpan -> SrcSpan -> Bool

140onTheSameLine a b =

143onTheSameLine a b =

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

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

145+

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

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

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

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

150+ where

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

152+ getIndent y =

153+ if all isSpace y

154+ then 0

155+ else length (takeWhile isSpace y)