991bf8e..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+83−1

@@ -1,15 +1,97 @@

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

67+* Fixed an idempotence issue related to different indentation levels in a

68+ comment series. [Issue 512](https://github.com/tweag/ormolu/issues/512).

69+

70+* Fixed an idempotence issue related to comments which may happen to be

71+ separated from the elements they are attached to by the equality sign.

72+ [Issue 340](https://github.com/tweag/ormolu/issues/340).

73+

74+* Fixed an idempotence issue with type synonym and data declarations where

75+ the type has a Haddock. [Issue

76+ 578](https://github.com/tweag/ormolu/issues/578).

77+

78+* Fix the false positive about AST differences in presence of comments with

79+ multiple blank lines in a row. [Issue

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

81+

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

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

84+

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

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

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

88+

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

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

91+

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

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

94+

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

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

14 Apparently only the latter is correct.

96 Apparently only the latter is correct.

15

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/gadt/multiline-out.hs+1−1

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

8 Foo ::

9 forall a b.

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

11− -- bar

11+ -- bar

12 a ->

13 b ->

14 Foo 'Int

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

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

5 = Foo

6 Bar

7 (Set Baz) -- and here we go

8− -- and that's it

8+ -- and that's it

9 Text

10 deriving (Eq)

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/data/unnamed-field-comment-0-out.hsnew file+7

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

1+data Foo

2+ = -- | Bar

3+ Bar

4+ Field1

5+ -- ^ Field 1

6+ Field2

7+ -- ^ Field 2

data/examples/declaration/data/unnamed-field-comment-0.hsnew file+5

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

1+data Foo

2+ = -- | Bar

3+ Bar

4+ Field1 -- ^ Field 1

5+ Field2 -- ^ Field 2

data/examples/declaration/data/unnamed-field-comment-1-out.hsnew file+5

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

1+data X

2+ = B

3+ !Int

4+ -- ^ y

5+ C

data/examples/declaration/data/unnamed-field-comment-1.hsnew file+4

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

1+data X

2+ = B

3+ !Int -- ^ y

4+ C

data/examples/declaration/data/with-weird-haddock-out.hsnew file+4

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

1+data PlusLevel' t

2+ = -- | @n + ℓ@.

3+ Plus Integer (LevelAtom' t)

4+ deriving (Show, Data)

data/examples/declaration/data/with-weird-haddock.hsnew file+2

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

1+data PlusLevel' t = Plus Integer (LevelAtom' t) -- ^ @n + ℓ@.

2+ deriving (Show, Data)

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

@@ -1,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/type-synonyms/with-weird-haddock-out.hsnew file+3

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

1+type Elims =

2+ -- | eliminations ordered left-to-right.

3+ [Elim]

data/examples/declaration/type-synonyms/with-weird-haddock.hsnew file+1

@@ -0,0 +1 @@

1+type Elims = [Elim] -- ^ eliminations ordered left-to-right.

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/arrow/proc-do-complex-out.hs+1−1

@@ -40,7 +40,7 @@ foo

40 )

41 else do

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

43− -- Could pattern match directly on x

43+ -- Could pattern match directly on x

44 i <- case u of

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

46 n ->

data/examples/declaration/value/function/awkward-comment-0-out.hsnew file+6

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

1+mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a

2+mergeErrorReply err1 reply -- XXX where to put it?

3+ =

4+ case reply of

5+ Ok x state err2 -> Ok x state (mergeError err1 err2)

6+ Error err2 -> Error (mergeError err1 err2)

data/examples/declaration/value/function/awkward-comment-0.hsnew file+5

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

1+mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a

2+mergeErrorReply err1 reply -- XXX where to put it?

3+ = case reply of

4+ Ok x state err2 -> Ok x state (mergeError err1 err2)

5+ Error err2 -> Error (mergeError err1 err2)

data/examples/declaration/value/function/awkward-comment-1-out.hsnew file+9

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

1+doForeign :: Vars -> [Name] -> [Term] -> Idris LExp

2+doForeign x = x

3+ where

4+ splitArg tm | (_, [_, _, l, r]) <- unApply tm -- pair, two implicits

5+ =

6+ do

7+ let l' = toFDesc l

8+ r' <- irTerm (sMN 0 "__foreignCall") vs env r

9+ return (l', r')

data/examples/declaration/value/function/awkward-comment-1.hsnew file+7

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

1+doForeign :: Vars -> [Name] -> [Term] -> Idris LExp

2+doForeign x = x

3+ where

4+ splitArg tm | (_, [_,_,l,r]) <- unApply tm -- pair, two implicits

5+ = do let l' = toFDesc l

6+ r' <- irTerm (sMN 0 "__foreignCall") vs env r

7+ return (l', r')

data/examples/declaration/value/function/blank-lines-let-out.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/if-with-comment-out.hsnew file+8

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

1+foo =

2+ if undefined

3+ then -- then comment

4+ undefined

5+ else -- else comment

6+

7+ do

8+ undefined

data/examples/declaration/value/function/if-with-comment.hsnew file+8

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

1+foo =

2+ if undefined

3+ -- then comment

4+ then undefined

5+ -- else comment

6+ else

7+ do

8+ undefined

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

@@ -1,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/multi-way-if-out.hs+4−2

@@ -3,12 +3,14 @@

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

4

5bar x y =

6+ if

6− if | x > y -> x

7+ | x > y -> x

7 | x < y ->

8 | x < y ->

8 y

9 y

9 | otherwise -> x

10 | otherwise -> x

10

11

11baz =

12baz =

12− if | p -> f

13+ if

14+ | p -> f

13 | otherwise -> g

15 | otherwise -> g

14 x

16 x

data/examples/declaration/value/function/operator-comments-2-out.hsnew file+5

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

1+x =

2+ y

3+ ++ f g -- commentA

4+ -- commentB

5+ -- commentC

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

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

1+x =

2+ y ++ -- commentA

3+-- commentB

4+ f g -- commentC

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/comment-two-blocks-out.hs+2−2

@@ -2,7 +2,7 @@ newNames :: [(String, String)]

2newNames =

3 let (*) = flip (,)

4 in [ "Control" * "Monad"

5− -- Foo

5+ -- Foo

6

7− -- Bar

7+ -- Bar

8 ]

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/multiple-blank-line-comment-out.hsnew file+9

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

1+module A where

2+

3+a =

4+ b

5+ [ f

6+ {-,

7+

8+ -}

9+ ]

data/examples/other/multiple-blank-line-comment.hsnew file+10

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

1+module A where

2+

3+a =

4+ b

5+ [ f

6+ {-,

7+

8+

9+ -}

10+ ]

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+18−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;

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

107 "optics"

103 "optics"

108 "ormolu"

104 "ormolu"

109 "pandoc"

105 "pandoc"

106+ "parsec3"

110 "pipes"

107 "pipes"

111 "postgrest"

108 "postgrest"

112 "purescript"

109 "purescript"

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

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

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

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

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

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

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

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

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

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

137 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

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

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

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

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

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

141 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

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

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

143 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

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

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

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

146 '';

145 '';

147 checkPhase = ''

146 checkPhase = ''

148 echo result-all-implicit.hs

147 echo result-all-implicit.hs

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

157 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

158 echo result-6-8.hs

157 echo result-6-8.hs

159 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

160− echo result-9-13.hs

159+ echo result-9-12.hs

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

162 '';

163 '';

163 installPhase = ''

164 installPhase = ''

164 mkdir "$out"

165 mkdir "$out"

expected-failures/Agda.txt+6−23

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

1Formatting is not idempotent:

2− src/full/Agda/Syntax/Internal.hs<rendered>:236:12

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

3− before: "pe Elims = -- | elim"

4− after: "pe Elims =\n -- | el"

5−Please, consider reporting the bug.

6−

7−Parsing of formatted code failed:

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

9− parse error on input `C.QName'

10−Please, consider reporting the bug.

11−

12−Formatting is not idempotent:

13− src/full/Agda/Termination/CallGraph.hs<rendered>:151:38

14− before: "2, old2) = -- TODO: "

3+ before: " = (check_ac"

15− after: "2, old2) =\n -"

4+ after: " =\n "

16−Please, consider reporting the bug.

17−

18−Formatting is not idempotent:

19− src/full/Agda/TypeChecking/MetaVars.hs<rendered>:1448:16

20− before: "ubstCand = -- | a po"

21− after: "ubstCand =\n -- | a "

22Please, consider reporting the bug.

5Please, consider reporting the bug.

23

6

24Formatting is not idempotent:

7Formatting is not idempotent:

25− src/full/Agda/Utils/List.hs<rendered>:186:15

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

26− before: "Prefix a = -- | The "

9+ before: " nes\n\n "

27− after: "Prefix a =\n -- | Th"

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

28Please, consider reporting the bug.

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

@@ -1,101 +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/ProofTerm.hs<rendered>:351:19

15− before: "f c e pt = -- @(PT p"

16− after: "f c e pt =\n -- @(PT"

17−Please, consider reporting the bug.

18−

19−Formatting is not idempotent:

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

21− before: " text op <> pretty"

22− after: " text op\n <"

23−Please, consider reporting the bug.

24−

25−Formatting is not idempotent:

26− src/Idris/Core/WHNF.hs<rendered>:105:46

27− before: " n b sc) = -- stk mu"

28− after: " n b sc) =\n -- "

29−Please, consider reporting the bug.

30−

31−Formatting is not idempotent:

32− src/Idris/Delaborate.hs<rendered>:627:6

33− before: "ity\n -- Issue #"

34− after: "ity\n -- Issue"

35−Please, consider reporting the bug.

36−

37−Formatting is not idempotent:

38− src/Idris/Elab/Term.hs<rendered>:432:47

39− before: "K\" _ _)) = -- for ch"

40− after: "K\" _ _)) =\n -- "

41−Please, consider reporting the bug.

42−

43−Formatting is not idempotent:

44− src/Idris/ModeCommon.hs<rendered>:34:26

45− before: "s toline = -- furthe"

46− after: "s toline =\n -- furt"

47−Please, consider reporting the bug.

48−

49−Formatting is not idempotent:

50− src/Idris/Options.hs<rendered>:177:17

51− before: "timisation = PETrans"

52− after: "timisation\n = PETra"

53−Please, consider reporting the bug.

54−

55The GHC parser (in Haddock mode) failed:

1The GHC parser (in Haddock mode) failed:

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

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

57 parse error on input `@'

3 parse error on input `@'

58

4

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

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

61−Please, consider reporting the bug.

62−

63The GHC parser (in Haddock mode) failed:

5The GHC parser (in Haddock mode) failed:

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

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

65 parse error on input `@'

7 parse error on input `@'

66−

67−Formatting is not idempotent:

68− src/Idris/PartialEval.hs<rendered>:281:42

69− before: ": ns) as = -- Droppe"

70− after: ": ns) as =\n -- "

71−Please, consider reporting the bug.

72−

73−Formatting is not idempotent:

74− src/Idris/ProofSearch.hs<rendered>:487:20

75− before: "OK ty hs = -- if any"

76− after: "OK ty hs =\n -- "

77−Please, consider reporting the bug.

78−

79−Formatting is not idempotent:

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

81− before: " line <> bindin"

82− after: " line\n <"

83−Please, consider reporting the bug.

84−

85−Formatting is not idempotent:

86− src/Idris/REPL.hs<rendered>:1270:33

87− before: "ht c) _) = -- consta"

88− after: "ht c) _) =\n -- cons"

89−Please, consider reporting the bug.

90−

91−Formatting is not idempotent:

92− src/Idris/Reflection.hs<rendered>:934:27

93− before: "attern _ = -- for al"

94− after: "attern _ =\n -- for "

95−Please, consider reporting the bug.

96−

97−Formatting is not idempotent:

98− src/Idris/Transforms.hs<rendered>:26:32

99− before: "s, rhs)) = -- apply "

100− after: "s, rhs)) =\n -- "

101−Please, consider reporting the bug.

expected-failures/intero.txt+3−3

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

1Formatting is not idempotent:

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

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

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

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

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

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+54−26

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

@@ -103,17 +104,21 @@ mkComment ::

103mkComment ls (L l s) = (ls', comment)

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

104 where

105 where

105 comment =

106 comment =

106− L l . Comment atomsBefore . fmap dropTrailing $

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

107 if "{-" `L.isPrefixOf` s

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

108 then case NE.nonEmpty (lines s) of

109 then case NE.nonEmpty (lines s) of

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

@@ -143,28 +148,9 @@ isMultilineComment (Comment _ (x :| _)) = "{-" `L.isPrefixOf` x

143----------------------------------------------------------------------------

148----------------------------------------------------------------------------

144-- Helpers

149-- Helpers

145

150

146−-- | Get a 'String' from 'GHC.AnnotationComment'.

147−unAnnotationComment :: GHC.AnnotationComment -> Maybe String

148−unAnnotationComment = \case

149− GHC.AnnDocCommentNext _ -> Nothing -- @-- |@

150− GHC.AnnDocCommentPrev _ -> Nothing -- @-- ^@

151− GHC.AnnDocCommentNamed _ -> Nothing -- @-- $@

152− GHC.AnnDocSection _ _ -> Nothing -- @-- *@

153− GHC.AnnDocOptions s -> Just s

154− GHC.AnnLineComment s -> Just s

155− GHC.AnnBlockComment s -> Just s

156−

157−liftMaybe :: Located (Maybe a) -> Maybe (Located a)

158−liftMaybe = \case

159− L _ Nothing -> Nothing

160− L l (Just a) -> Just (L l a)

161−

162−toRealSpan :: Located a -> Maybe (RealLocated a)

163−toRealSpan (L (RealSrcSpan l) a) = Just (L l a)

164−toRealSpan _ = Nothing

165−

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

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

167extractStackHeader ::

152extractStackHeader ::

153+ -- | Comment stream to analyze

168 [RealLocated String] ->

154 [RealLocated String] ->

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

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

170extractStackHeader = \case

156extractStackHeader = \case

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

180

166

181-- | Extract pragmas and their associated comments.

167-- | Extract pragmas and their associated comments.

182extractPragmas ::

168extractPragmas ::

169+ -- | Input

183 String ->

170 String ->

171+ -- | Comment stream to analyze

184 [RealLocated String] ->

172 [RealLocated String] ->

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

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

186extractPragmas input = go initialLs id id

174extractPragmas input = go initialLs id id

@@ -194,5 +182,45 @@ extractPragmas input = go initialLs id id

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

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

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

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

196 Just pragma ->

184 Just pragma ->

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

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

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

196+

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

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

199+unAnnotationComment = \case

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

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

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

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

204+ GHC.AnnDocOptions s -> Just s

205+ GHC.AnnLineComment s -> Just s

206+ GHC.AnnBlockComment s -> Just s

207+

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

209+liftMaybe = \case

210+ L _ Nothing -> Nothing

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

212+

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

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

215+toRealSpan _ = Nothing

216+

217+-- | Remove consecutive blank lines.

218+removeConseqBlanks :: NonEmpty String -> NonEmpty String

219+removeConseqBlanks (x :| xs) = x :| go (null x) id xs

220+ where

221+ go seenBlank acc = \case

222+ [] -> acc []

223+ (y : ys) ->

224+ if seenBlank && null y

225+ then go True acc ys

226+ else go (null y) (acc . (y :)) ys

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+28−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,8 @@ module Ormolu.Printer.Combinators

51

52

52 -- ** Literals

53 -- ** Literals

53 comma,

54 comma,

55+ commaDel,

56+ equals,

54

57

55 -- ** Stateful markers

58 -- ** Stateful markers

56 SpanMark (..),

59 SpanMark (..),

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

71----------------------------------------------------------------------------

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

72-- Basic

75-- Basic

73

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+

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

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

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

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

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

173 xs' ->

185 xs' ->

174 if ub

186 if ub

175 then do

187 then do

176− txt "{ "

188+ txt "{"

189+ space

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

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

191+ space

178− txt " }"

192+ txt "}"

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

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

180 multiLine =

194 multiLine =

181 sep newline (dontUseBraces . f) xs

195 sep newline (dontUseBraces . f) xs

182

196

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

189 N

203 N

190 | -- | Shifted one level

204 | -- | Shifted one level

191 S

205 S

206+ deriving (Eq, Show)

192

207

193-- | Surround given entity by backticks.

208-- | Surround given entity by backticks.

194backticks :: R () -> R ()

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

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

265 then newline >> inci m

280 then newline >> inci m

266 else space >> sitcc m

281 else space >> sitcc m

267 newline

282 newline

268− case style of

269− N -> txt close

270− S -> inci (txt close)

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

271

284

272----------------------------------------------------------------------------

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

273-- Literals

286-- Literals

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

275-- | Print @,@.

288-- | Print @,@.

276comma :: R ()

289comma :: R ()

277comma = txt ","

290comma = txt ","

291+

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

293+commaDel :: R ()

294+commaDel = comma >> breakpoint

295+

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

297+equals :: R ()

298+equals = interferingTxt "="

src/Ormolu/Printer/Comments.hs+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+67−39

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

14

15 -- * Internal functions

16 txt,

17+ interferingTxt,

17 atom,

18 atom,

18 space,

19 space,

19 newline,

20 newline,

@@ -98,6 +99,8 @@ data RC = RC

98data SC = SC

99data SC = SC

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

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

100 scColumn :: !Int,

101 scColumn :: !Int,

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

103+ scIndent :: !Int,

101 -- | Rendered source code so far

104 -- | Rendered source code so far

102 scBuilder :: Builder,

105 scBuilder :: Builder,

103 -- | Span stream

106 -- | Span stream

@@ -108,7 +111,7 @@ data SC = SC

108 scCommentStream :: CommentStream,

111 scCommentStream :: CommentStream,

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

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

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

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

111− scPendingComments :: ![(CommentPosition, Int, Text)],

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

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

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

113 scRequestedDelimiter :: !RequestedDelimiter,

116 scRequestedDelimiter :: !RequestedDelimiter,

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

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

@@ -174,6 +177,7 @@ runR (R m) sstream cstream anns recDot =

174 sc =

177 sc =

175 SC

178 SC

176 { scColumn = 0,

179 { scColumn = 0,

180+ scIndent = 0,

177 scBuilder = mempty,

181 scBuilder = mempty,

178 scSpanStream = sstream,

182 scSpanStream = sstream,

179 scThisLineSpans = [],

183 scThisLineSpans = [],

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

186----------------------------------------------------------------------------

190----------------------------------------------------------------------------

187-- Internal functions

191-- Internal functions

188

192

193+-- | Type of the thing to output. Influences the primary low-level rendering

194+-- function 'spit'.

195+data SpitType

196+ = -- | Simple opaque text that breaks comment series.

197+ SimpleText

198+ | -- | Like 'SimpleText', but assume that when this text is inserted it

199+ -- will separate an 'Atom' and its pending comments, so insert an extra

200+ -- 'newline' in that case to force the pending comments and continue on

201+ -- a fresh line.

202+ InterferingText

203+ | -- | An atom that typically have span information in the AST and can

204+ -- have comments attached to it.

205+ Atom

206+ | -- | Used for rendering comment lines.

207+ CommentPart

208+ deriving (Show, Eq)

209+

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

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

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

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

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

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

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

197 -- | 'Text' to output

218 -- | 'Text' to output

198 Text ->

219 Text ->

199 R ()

220 R ()

200−txt = spit False False

221+txt = spit SimpleText

222+

223+-- | Similar to 'txt' but the text inserted this way is assumed to break the

224+-- “link” between the preceding atom and its pending comments.

225+interferingTxt ::

226+ -- | 'Text' to output

227+ Text ->

228+ R ()

229+interferingTxt = spit InterferingText

201

230

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

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

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

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

@@ -206,54 +235,60 @@ atom ::

206 Outputable a =>

235 Outputable a =>

207 a ->

236 a ->

208 R ()

237 R ()

209−atom = spit True False . T.pack . showOutputable

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

210

239

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

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

212spit ::

241spit ::

213− -- | Whether to register the outermost enclosing span

242+ -- | Type of the thing to spit

214− Bool ->

243+ SpitType ->

215− -- | Used during outputting of pending comments?

216− Bool ->

217 -- | 'Text' to output

244 -- | 'Text' to output

218 Text ->

245 Text ->

219 R ()

246 R ()

220−spit registerSpan printingComments text = do

247+spit _ "" = return ()

248+spit stype text = do

221 requestedDel <- R (gets scRequestedDelimiter)

249 requestedDel <- R (gets scRequestedDelimiter)

250+ pendingComments <- R (gets scPendingComments)

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

222 case requestedDel of

252 case requestedDel of

223 RequestedNewline -> do

253 RequestedNewline -> do

224 R . modify $ \sc ->

254 R . modify $ \sc ->

225 sc

255 sc

226 { scRequestedDelimiter = RequestedNothing

256 { scRequestedDelimiter = RequestedNothing

227 }

257 }

228− if printingComments

258+ case stype of

229− then newlineRaw

259+ CommentPart -> newlineRaw

230− else newline

260+ _ -> newline

231 _ -> return ()

261 _ -> return ()

232 R $ do

262 R $ do

233 i <- asks rcIndent

263 i <- asks rcIndent

234 c <- gets scColumn

264 c <- gets scColumn

235− outermostEnclosing <- listToMaybe <$> asks rcEnclosingSpans

265+ closestEnclosing <- listToMaybe <$> asks rcEnclosingSpans

236− let spaces =

266+ let indentedTxt = spaces <> text

267+ spaces = T.replicate spacesN " "

268+ spacesN =

237− if c < i

269+ if c == 0

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

270+ then i

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

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

240− indentedTxt = spaces <> text

241 modify $ \sc ->

272 modify $ \sc ->

242 sc

273 sc

243 { scBuilder = scBuilder sc <> fromText indentedTxt,

274 { scBuilder = scBuilder sc <> fromText indentedTxt,

244 scColumn = scColumn sc + T.length indentedTxt,

275 scColumn = scColumn sc + T.length indentedTxt,

276+ scIndent =

277+ if c == 0

278+ then i

279+ else scIndent sc,

245 scThisLineSpans =

280 scThisLineSpans =

246 let xs = scThisLineSpans sc

281 let xs = scThisLineSpans sc

247− in if registerSpan

282+ in case stype of

248− then case outermostEnclosing of

283+ Atom -> case closestEnclosing of

249 Nothing -> xs

284 Nothing -> xs

250 Just x -> x : xs

285 Just x -> x : xs

251− else xs,

286+ _ -> xs,

252 scRequestedDelimiter = RequestedNothing,

287 scRequestedDelimiter = RequestedNothing,

253 scSpanMark =

288 scSpanMark =

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

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

255 -- location.

290 -- location.

256− if printingComments || (not . null . scPendingComments) sc

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

257 then scSpanMark sc

292 then scSpanMark sc

258 else Nothing

293 else Nothing

259 }

294 }

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

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

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

286newline :: R ()

321newline :: R ()

287newline = do

322newline = do

323+ indent <- R (gets scIndent)

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

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

289 case cs of

325 case cs of

290 [] -> newlineRaw

326 [] -> newlineRaw

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

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

292 case position of

328 case position of

293 OnTheSameLine -> space

329 OnTheSameLine -> space

294 OnNextLine -> newlineRaw

330 OnNextLine -> newlineRaw

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

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

296 let modRC rc =

332 let modRC rc =

297 rc

333 rc

298 { rcIndent = indent

334 { rcIndent = indent

299 }

335 }

300 R m = do

336 R m = do

301 unless (T.null text) $

337 unless (T.null text) $

302− spit False True text

338+ spit CommentPart text

303 newlineRaw

339 newlineRaw

304 in local modRC m

340 in local modRC m

305 R . modify $ \sc ->

341 R . modify $ \sc ->

@@ -320,6 +356,7 @@ newlineRaw = R . modify $ \sc ->

320 VeryBeginning -> builderSoFar

356 VeryBeginning -> builderSoFar

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

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

322 scColumn = 0,

358 scColumn = 0,

359+ scIndent = 0,

323 scThisLineSpans = [],

360 scThisLineSpans = [],

324 scRequestedDelimiter = case scRequestedDelimiter sc of

361 scRequestedDelimiter = case scRequestedDelimiter sc of

325 AfterNewline -> RequestedNewline

362 AfterNewline -> RequestedNewline

@@ -330,7 +367,7 @@ newlineRaw = R . modify $ \sc ->

330

367

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

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

332useRecordDot :: R Bool

369useRecordDot :: R Bool

333−useRecordDot = R $ asks rcUseRecDot

370+useRecordDot = R (asks rcUseRecDot)

334

371

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

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

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

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

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

347

384

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

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

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

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

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

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

351−-- layout is multi-line.

352sitcc :: R () -> R ()

388sitcc :: R () -> R ()

353sitcc (R m) = do

389sitcc (R m) = do

354 requestedDel <- R (gets scRequestedDelimiter)

390 requestedDel <- R (gets scRequestedDelimiter)

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

356 c <- R (gets scColumn)

392 c <- R (gets scColumn)

357 let modRC rc =

393 let modRC rc =

358 rc

394 rc

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

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

360 }

396 }

361− vlayout (R m) . R $ do

362− modify $ \sc ->

363− sc

364− { scRequestedDelimiter = case requestedDel of

365− RequestedSpace -> RequestedNothing

366− other -> other

367− }

368− local modRC m

397+ R (local modRC m)

369

398

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

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

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

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

@@ -407,10 +436,9 @@ registerPendingCommentLine ::

407 Text ->

436 Text ->

408 R ()

437 R ()

409registerPendingCommentLine position text = R $ do

438registerPendingCommentLine position text = R $ do

410− i <- asks rcIndent

411 modify $ \sc ->

439 modify $ \sc ->

412 sc

440 sc

413− { scPendingComments = (position, i, text) : scPendingComments sc

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

414 }

442 }

415

443

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

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

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

539

567

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

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

541canUseBraces :: R Bool

569canUseBraces :: R Bool

542−canUseBraces = R $ asks rcCanUseBraces

570+canUseBraces = R (asks rcCanUseBraces)

543

571

544----------------------------------------------------------------------------

572----------------------------------------------------------------------------

545-- Constants

573-- Constants

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

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

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

154 LHsDocString ->

155 R ()

156p_hsDocString hstyle needsNewline (L l str) = do

157− goesAfterComment <- getSpanMark >>= \case

157+ let isCommentSpan = \case

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

158+ HaddockSpan _ _ -> True

159− Just (CommentSpan _) -> return True

159+ CommentSpan _ -> True

160− _ -> return False

160+ _ -> False

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

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

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

162 when goesAfterComment newline

163 when goesAfterComment newline

163 forM_ (zip (splitDocString str) (True : repeat False)) $ \(x, isFirst) -> do

164 forM_ (zip (splitDocString str) (True : repeat False)) $ \(x, isFirst) -> do

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

@@ -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,24 +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

67+ else

68+ if hasHaddocks dd_cons

69+ then newline

69− else breakpoint

70+ else breakpoint

70− txt "="

71+ equals

71− space

72+ space

73+ layout <- getLayout

72− let s =

74+ let s =

73− vlayout

75+ if layout == MultiLine || hasHaddocks dd_cons

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

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

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

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

76− sitcc' =

78+ sitcc' =

77− if singleConstRec

79+ if singleConstRec

78− then id

80+ then id

79− else sitcc

81+ else sitcc

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

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

81 unless (null $ unLoc dd_derivs) breakpoint

83 unless (null $ unLoc dd_derivs) breakpoint

82 inci . located dd_derivs $ \xs ->

84 inci . located dd_derivs $ \xs ->

83 sep newline (located' p_hsDerivingClause) xs

85 sep newline (located' p_hsDerivingClause) xs

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

102 (c : cs) -> do

104 (c : cs) -> do

103 p_rdrName c

105 p_rdrName c

104 unless (null cs) . inci $ do

106 unless (null cs) . inci $ do

105− comma

107+ commaDel

106− breakpoint

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

108+ sep commaDel p_rdrName cs

108− space

109 inci $ do

110+ space

110 txt "::"

111 txt "::"

111 let interArgBreak =

112 let interArgBreak =

112 if hasDocStrings (unLoc con_res_ty)

113 if hasDocStrings (unLoc con_res_ty)

@@ -150,15 +151,11 @@ p_conDecl singleConstRec = \case

150 PrefixCon xs -> do

151 PrefixCon xs -> do

151 p_rdrName con_name

152 p_rdrName con_name

152 unless (null xs) breakpoint

153 unless (null xs) breakpoint

153− inci . sitcc $ sep breakpoint (sitcc . located' p_hsType) xs

154+ inci . sitcc $ sep breakpoint (sitcc . located' p_hsTypePostDoc) xs

154 RecCon l -> do

155 RecCon l -> do

155 p_rdrName con_name

156 p_rdrName con_name

156 breakpoint

157 breakpoint

157− let inci' =

158− if singleConstRec

159− then id

160− else inci

161− inci' (located l p_conDeclFields)

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

162 InfixCon x y -> do

159 InfixCon x y -> do

163 located x p_hsType

160 located x p_hsType

164 breakpoint

161 breakpoint

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

207 let derivingWhat = located deriv_clause_tys $ \case

204 let derivingWhat = located deriv_clause_tys $ \case

208 [] -> txt "()"

205 [] -> txt "()"

209 xs ->

206 xs ->

210− parens N . sitcc $

207+ parens N $

211 sep

208 sep

212− (comma >> breakpoint)

209+ commaDel

213 (sitcc . located' p_hsType . hsib_body)

210 (sitcc . located' p_hsType . hsib_body)

214 xs

211 xs

215 space

212 space

@@ -256,3 +253,9 @@ isSingleConstRec [(L _ ConDeclH98 {..})] =

256 RecCon _ -> True

253 RecCon _ -> True

257 _ -> False

254 _ -> False

258isSingleConstRec _ = False

255isSingleConstRec _ = False

256+

257+hasHaddocks :: [LConDecl GhcPs] -> Bool

258+hasHaddocks = any (f . unLoc)

259+ where

260+ f ConDeclH98 {..} = isJust con_doc

261+ f _ = False

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

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

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

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

@@ -43,7 +43,7 @@ p_ruleDecl = \case

43 inci $ do

44 located lhs p_hsExpr

45 space

46− txt "="

46+ equals

47 inci $ do

48 breakpoint

49 located rhs p_hsExpr

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

@@ -28,11 +28,13 @@ 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

35− txt "="

35+ equals

36+ if hasDocStrings (unLoc t)

37+ then newline

36− breakpoint

38+ else breakpoint

37 inci (located t p_hsType)

39 inci (located t p_hsType)

38p_synDecl _ _ (XLHsQTyVars x) _ = noExtCon x

40p_synDecl _ _ (XLHsQTyVars x) _ = noExtCon x

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

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

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

@@ -69,7 +69,7 @@ p_familyResultSigL l =

69 breakpoint

70 located k p_hsType

71 TyVarSig NoExtField bndr -> Just $ do

72− txt "="

72+ equals

73 breakpoint

74 located bndr p_hsTyVarBndr

75 XFamilyResultSig x ->

@@ -92,16 +92,16 @@ 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

104− txt "="

104+ equals

105 breakpoint

106 inci (located feqn_rhs p_hsType)

107p_tyFamInstEqn HsIB {hsib_body = XFamEqn x} = noExtCon x

src/Ormolu/Printer/Meat/Declaration/Value.hs+168−158

@@ -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,15 +224,8 @@ 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− unless (length grhssGRHSs > 1) $

229− case style of

230− Function _ | hasGuards -> return ()

231− Function _ -> space >> txt "="

232− PatternBind -> space >> txt "="

233− s | isCase s && hasGuards -> return ()

234− _ -> space >> txt "->"

235− let grhssSpan =

228+ grhssSpan =

236 combineSrcSpans' $

229 combineSrcSpans' $

237 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

230 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

238 patGrhssSpan =

231 patGrhssSpan =

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

260 txt "where"

253 txt "where"

261 unless whereIsEmpty breakpoint

254 unless whereIsEmpty breakpoint

262 inci $ located grhssLocalBinds p_hsLocalBinds

255 inci $ located grhssLocalBinds p_hsLocalBinds

263− inci' $ do

256+ inciIf indentBody $ do

257+ unless (length grhssGRHSs > 1) $

258+ case style of

259+ Function _ | hasGuards -> return ()

260+ Function _ -> space >> inci equals

261+ PatternBind -> space >> inci equals

262+ s | isCase s && hasGuards -> return ()

263+ _ -> space >> txt "->"

264 switchLayout [patGrhssSpan] $

265 placeHanging placement p_body

266 inci p_where

@@ -284,11 +284,11 @@ 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− txt $ case style of

289+ inci $ case style of

290− EqualSign -> "="

290+ EqualSign -> equals

291− RightArrow -> "->"

291+ RightArrow -> txt "->"

292 placeHanging placement p_body

293 where

294 placement =

@@ -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,37 +471,31 @@ 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.

494 let p_ipBind (IPBind NoExtField (Left name) expr) = do

495 let p_ipBind (IPBind NoExtField (Left name) expr) = do

495 atom name

496 atom name

496 space

497 space

497− txt "="

498+ equals

498 breakpoint

499 breakpoint

499 useBraces $ inci $ located expr p_hsExpr

500 useBraces $ inci $ located expr p_hsExpr

500 p_ipBind (IPBind NoExtField (Right _) _) =

501 p_ipBind (IPBind NoExtField (Right _) _) =

@@ -513,19 +514,13 @@ p_hsRecField HsRecField {..} = do

513 p_rdrName hsRecFieldLbl

514 p_rdrName hsRecFieldLbl

514 unless hsRecPun $ do

515 unless hsRecPun $ do

515 space

516 space

516− txt "="

517+ equals

517 let placement =

518 let placement =

518 if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)

519 if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)

519 then exprPlacement (unLoc hsRecFieldArg)

520 then exprPlacement (unLoc hsRecFieldArg)

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

@@ -663,8 +666,9 @@ p_hsExpr' s = \case

663 HsIf NoExtField _ if' then' else' ->

666 HsIf NoExtField _ if' then' else' ->

664 p_if exprPlacement p_hsExpr if' then' else'

667 p_if exprPlacement p_hsExpr if' then' else'

665 HsMultiIf NoExtField guards -> do

668 HsMultiIf NoExtField guards -> do

666− txt "if "

669+ txt "if"

670+ breakpoint

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

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

668 HsLet NoExtField localBinds e ->

672 HsLet NoExtField localBinds e ->

669 p_let p_hsExpr localBinds e

673 p_let p_hsExpr localBinds e

670 HsDo NoExtField ctx es -> do

674 HsDo NoExtField ctx es -> do

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

676 sepSemi

680 sepSemi

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

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

678 (unLoc es)

682 (unLoc es)

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

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

680 let p_parBody =

684 let p_parBody =

681 sep

685 sep

682− (breakpoint >> txt "| ")

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

683 p_seqBody

687 p_seqBody

684 p_seqBody =

688 p_seqBody =

685 sitcc

689 sitcc

686 . sep

690 . sep

687− (comma >> breakpoint)

691+ commaDel

688 (located' (sitcc . p_stmt))

692 (located' (sitcc . p_stmt))

689 stmts = init xs

693 stmts = init xs

690 yield = last xs

694 yield = last xs

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

705 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"

709 ParStmtCtxt _ -> notImplemented "ParStmtCtxt"

706 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

710 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

707 ExplicitList _ _ xs ->

711 ExplicitList _ _ xs ->

708− brackets s . sitcc $

712+ brackets s $

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

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

710 RecordCon {..} -> do

714 RecordCon {..} -> do

711 located rcon_con_name atom

715 located rcon_con_name atom

712 breakpoint

716 breakpoint

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

722 case rec_dotdot of

726 case rec_dotdot of

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

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

724 Nothing -> []

728 Nothing -> []

725− inci . braces N . sitcc $

729+ inci . braces N $

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

730+ sep commaDel sitcc (fields <> dotdot)

727 RecordUpd {..} -> do

731 RecordUpd {..} -> do

728 located rupd_expr p_hsExpr

732 located rupd_expr p_hsExpr

729 useRecordDot' <- useRecordDot

733 useRecordDot' <- useRecordDot

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

741 Unambiguous _ n -> n

745 Unambiguous _ n -> n

742 XAmbiguousFieldOcc x -> noExtCon x

746 XAmbiguousFieldOcc x -> noExtCon x

743 }

747 }

744− inci . braces N . sitcc $

748+ inci . braces N $

745 sep

749 sep

746− (comma >> breakpoint)

750+ commaDel

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

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

748 rupd_flds

752 rupd_flds

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

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

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

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

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

757 ArithSeq NoExtField _ x ->

761 ArithSeq NoExtField _ x ->

758 case x of

762 case x of

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

763+ From from -> brackets s $ do

760 located from p_hsExpr

764 located from p_hsExpr

761 breakpoint

765 breakpoint

762 txt ".."

766 txt ".."

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

767+ FromThen from next -> brackets s $ do

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

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

765 breakpoint

769 breakpoint

766 txt ".."

770 txt ".."

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

771+ FromTo from to -> brackets s $ do

768 located from p_hsExpr

772 located from p_hsExpr

769 breakpoint

773 breakpoint

770 txt ".."

774 txt ".."

771 space

775 space

772 located to p_hsExpr

776 located to p_hsExpr

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

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

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

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

775 breakpoint

779 breakpoint

776 txt ".."

780 txt ".."

777 space

781 space

@@ -821,7 +825,7 @@ p_patSynBind PSB {..} = do

821 breakpoint

825 breakpoint

822 located psb_def p_pat

826 located psb_def p_pat

823 ImplicitBidirectional -> do

827 ImplicitBidirectional -> do

824− txt "="

828+ equals

825 breakpoint

829 breakpoint

826 located psb_def p_pat

830 located psb_def p_pat

827 ExplicitBidirectional mgroup -> do

831 ExplicitBidirectional mgroup -> do

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

848 inci $ do

852 inci $ do

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

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

850 unless (null xs) breakpoint

854 unless (null xs) breakpoint

851− braces N . sitcc $

855+ braces N $

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

856+ sep commaDel (p_rdrName . recordPatSynPatVar) xs

853 rhs

857 rhs

854 InfixCon l r -> do

858 InfixCon l r -> do

855 switchLayout [getLoc l, getLoc r] $ do

859 switchLayout [getLoc l, getLoc r] $ do

@@ -903,10 +907,12 @@ p_if placer render if' then' else' = do

903 breakpoint

907 breakpoint

904 inci $ do

908 inci $ do

905 txt "then"

909 txt "then"

910+ space

906 located then' $ \x ->

911 located then' $ \x ->

907 placeHanging (placer x) (render x)

912 placeHanging (placer x) (render x)

908 breakpoint

913 breakpoint

909 txt "else"

914 txt "else"

915+ space

910 located else' $ \x ->

916 located else' $ \x ->

911 placeHanging (placer x) (render x)

917 placeHanging (placer x) (render x)

912

918

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

943 txt "!"

949 txt "!"

944 located pat p_pat

950 located pat p_pat

945 ListPat NoExtField pats ->

951 ListPat NoExtField pats ->

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

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

947 TuplePat NoExtField pats boxing -> do

953 TuplePat NoExtField pats boxing -> do

948− let f =

954+ let parens' =

949 case boxing of

955 case boxing of

950 Boxed -> parens S

956 Boxed -> parens S

951 Unboxed -> parensHash S

957 Unboxed -> parensHash S

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

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

953 SumPat NoExtField pat tag arity ->

959 SumPat NoExtField pat tag arity ->

954 p_unboxedSum S tag arity (located pat p_pat)

960 p_unboxedSum S tag arity (located pat p_pat)

955 ConPatIn pat details ->

961 ConPatIn pat details ->

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

965 let f = \case

971 let f = \case

966 Nothing -> txt ".."

972 Nothing -> txt ".."

967 Just x -> located x p_pat_hsRecField

973 Just x -> located x p_pat_hsRecField

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

974+ inci . braces N . sep commaDel f $

969 case dotdot of

975 case dotdot of

970 Nothing -> Just <$> fields

976 Nothing -> Just <$> fields

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

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

@@ -1006,7 +1012,7 @@ p_pat_hsRecField HsRecField {..} = do

1006 p_rdrName (rdrNameFieldOcc x)

1012 p_rdrName (rdrNameFieldOcc x)

1007 unless hsRecPun $ do

1013 unless hsRecPun $ do

1008 space

1014 space

1009− txt "="

1015+ equals

1010 breakpoint

1016 breakpoint

1011 inci (located hsRecFieldArg p_pat)

1017 inci (located hsRecFieldArg p_pat)

1012

1018

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

1015 let before = tag - 1

1021 let before = tag - 1

1016 after = arity - before - 1

1022 after = arity - before - 1

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

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

1018− f (x, i) = do

1024+ f x =

1019− let isFirst = i == 0

1020− isLast = i == arity - 1

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

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

1022 Nothing ->

1026 Nothing ->

1023− unless (isFirst || isLast) space

1027+ space

1024 Just m' -> do

1028 Just m' -> do

1025− unless isFirst space

1029+ space

1026 m'

1030 m'

1027− unless isLast space

1031+ space

1028− parensHash s $ sep (txt "|") f (zip args [0 ..])

1032+ parensHash s $ sep (txt "|") f args

1029

1033

1030p_hsSplice :: HsSplice GhcPs -> R ()

1034p_hsSplice :: HsSplice GhcPs -> R ()

1031p_hsSplice = \case

1035p_hsSplice = \case

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

1227 HsCase NoExtField _ _ -> Hanging

1231 HsCase NoExtField _ _ -> Hanging

1228 HsDo NoExtField DoExpr _ -> Hanging

1232 HsDo NoExtField DoExpr _ -> Hanging

1229 HsDo NoExtField MDoExpr _ -> Hanging

1233 HsDo NoExtField MDoExpr _ -> Hanging

1230− -- If the rightmost expression in an operator chain is hanging, make the

1234+ OpApp NoExtField _ op y ->

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

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

1232− -- style.

1233− OpApp NoExtField _ _ y -> exprPlacement (unLoc y)

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

1234− -- Same thing for function applications (usually with -XBlockArguments)

1237+ _ -> Normal

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

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

1236 HsProc NoExtField p _ ->

1239 HsProc NoExtField p _ ->

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

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

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

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

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

1258 _ -> Nothing

1261 _ -> Nothing

1259

1262

1263+getOpNameStr :: RdrName -> String

1264+getOpNameStr = occNameString . rdrNameOcc

1265+

1260p_exprOpTree ::

1266p_exprOpTree ::

1261− -- | Can use special handling of dollar?

1262− Bool ->

1263 -- | Bracket style to use

1267 -- | Bracket style to use

1264 BracketStyle ->

1268 BracketStyle ->

1265 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->

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

1266 R ()

1270 R ()

1267−p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)

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

1268−p_exprOpTree isDollarSpecial s (OpBranch x op y) = do

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

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

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

1271 -- placement.

1275 -- placement.

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

1287 MultiLine -> case placement of

1291 MultiLine -> case placement of

1288 Hanging -> useBraces

1292 Hanging -> useBraces

1289 Normal -> dontUseBraces

1293 Normal -> dontUseBraces

1290− gotDollar = case getOpName (unLoc op) of

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

1291− Just rname -> mkVarOcc "$" == rdrNameOcc rname

1295+ gotDollar = opNameStr == Just "$"

1292− _ -> False

1296+ gotColon = opNameStr == Just ":"

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

1293 lhs =

1298 lhs =

1294 switchLayout [opTreeLoc x] $

1299 switchLayout [opTreeLoc x] $

1295− p_exprOpTree (not gotDollar) s x

1300+ p_exprOpTree s x

1296− let p_op = located op (opWrapper . p_hsExpr)

1301+ p_op = located op (opWrapper . p_hsExpr)

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

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

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

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

1299 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1304 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1300 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1305 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1301 _ -> False

1306 _ -> False

1307+ isDoBlock = \case

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

1309+ _ -> False

1302 useRecordDot' <- useRecordDot

1310 useRecordDot' <- useRecordDot

1303− let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)

1311+ if

1304− if useRecordDot' && isRecordDot'

1312+ | gotColon -> do

1305− then do

1306− lhs

1307− when isSection space

1308− p_op

1309− p_y

1310− else

1311− if isDollarSpecial

1312− && gotDollar

1313− && placement

1314− == Normal

1315− && isOneLineSpan (opTreeLoc x)

1316− then do

1317− useBraces lhs

1313+ lhs

1318− space

1314+ space

1319− p_op

1315+ p_op

1320− breakpoint

1316+ case placement of

1321− inci p_y

1317+ Hanging -> do

1322− else do

1323− ub lhs

1324− placeHanging placement $ do

1325− p_op

1326 space

1318 space

1327 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

1328

1342

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

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

1330isRecordDot ::

1344isRecordDot ::

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

1335 Bool

1349 Bool

1336isRecordDot op (RealSrcSpan ySpan) = case op of

1350isRecordDot op (RealSrcSpan ySpan) = case op of

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

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

1338− isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)

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

1339 _ -> False

1353 _ -> False

1340isRecordDot _ _ = False

1354isRecordDot _ _ = False

1341

1355

1342−-- | Check whether a given 'RdrName' is the dot operator.

1343−isDot :: RdrName -> Bool

1344−isDot name = rdrNameOcc name == mkVarOcc "."

1345−

1346-- | Get annotations for the enclosing element.

1356-- | Get annotations for the enclosing element.

1347getEnclosingAnns :: R [AnnKeywordId]

1357getEnclosingAnns :: R [AnnKeywordId]

1348getEnclosingAnns = 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+35−24

@@ -5,6 +5,7 @@

5-- | Rendering of types.

6module Ormolu.Printer.Meat.Type

7 ( p_hsType,

8+ p_hsTypePostDoc,

8 hasDocStrings,

9 hasDocStrings,

9 p_hsContext,

10 p_hsContext,

10 p_hsTyVarBndr,

11 p_hsTyVarBndr,

@@ -23,14 +24,22 @@ import Ormolu.Printer.Operators

23import Ormolu.Utils

24import Ormolu.Utils

24

25

25p_hsType :: HsType GhcPs -> R ()

26p_hsType :: HsType GhcPs -> R ()

26−p_hsType t = p_hsType' (hasDocStrings t) t

27+p_hsType t = p_hsType' (hasDocStrings t) PipeStyle t

27

28

29+p_hsTypePostDoc :: HsType GhcPs -> R ()

30+p_hsTypePostDoc t = p_hsType' (hasDocStrings t) CaretStyle t

31+

32+-- | How to render Haddocks associated with a type.

33+data TypeDocStyle

34+ = PipeStyle

35+ | CaretStyle

36+

28−p_hsType' :: Bool -> HsType GhcPs -> R ()

37+p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R ()

29−p_hsType' multilineArgs = \case

38+p_hsType' multilineArgs docStyle = \case

30 HsForAllTy NoExtField visibility bndrs t -> do

39 HsForAllTy NoExtField visibility bndrs t -> do

31 p_forallBndrs visibility p_hsTyVarBndr bndrs

40 p_forallBndrs visibility p_hsTyVarBndr bndrs

32 interArgBreak

41 interArgBreak

33− p_hsType' multilineArgs (unLoc t)

42+ p_hsTypeR (unLoc t)

34 HsQualTy NoExtField qs t -> do

43 HsQualTy NoExtField qs t -> do

35 located qs p_hsContext

44 located qs p_hsContext

36 space

45 space

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

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

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

59 _ -> (f', knownArgs)

68 _ -> (f', knownArgs)

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

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

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

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

62 located func p_hsType

71 located func p_hsType

63 breakpoint

72 breakpoint

64 inci $

73 inci $

@@ -89,10 +98,9 @@ p_hsType' multilineArgs = \case

89 HsBoxedTuple -> parens N

98 HsBoxedTuple -> parens N

90 HsConstraintTuple -> parens N

99 HsConstraintTuple -> parens N

91 HsBoxedOrConstraintTuple -> parens N

100 HsBoxedOrConstraintTuple -> parens N

92− in parens' . sitcc $

93− sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

101+ in parens' $ sep commaDel (sitcc . located' p_hsType) xs

94 HsSumTy NoExtField xs ->

102 HsSumTy NoExtField xs ->

95− parensHash N . sitcc $

103+ parensHash N $

96 sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs

104 sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs

97 HsOpTy NoExtField x op y ->

105 HsOpTy NoExtField x op y ->

98 sitcc $

106 sitcc $

@@ -109,14 +117,20 @@ p_hsType' multilineArgs = \case

109 HsStarTy NoExtField _ -> txt "*"

117 HsStarTy NoExtField _ -> txt "*"

110 HsKindSig NoExtField t k -> sitcc $ do

118 HsKindSig NoExtField t k -> sitcc $ do

111 located t p_hsType

119 located t p_hsType

112− space -- FIXME

113− txt "::"

114 space

120 space

121+ txt "::"

122+ breakpoint

115 inci (located k p_hsType)

123 inci (located k p_hsType)

116 HsSpliceTy NoExtField splice -> p_hsSplice splice

124 HsSpliceTy NoExtField splice -> p_hsSplice splice

117− HsDocTy NoExtField t str -> do

125+ HsDocTy NoExtField t str ->

126+ case docStyle of

127+ PipeStyle -> do

118− p_hsDocString Pipe True str

128+ p_hsDocString Pipe True str

129+ located t p_hsType

130+ CaretStyle -> do

119− located t p_hsType

131+ located t p_hsType

132+ newline

133+ p_hsDocString Caret False str

120 HsBangTy NoExtField (HsSrcBang _ u s) t -> do

134 HsBangTy NoExtField (HsSrcBang _ u s) t -> do

121 case u of

135 case u of

122 SrcUnpack -> txt "{-# UNPACK #-}" >> space

136 SrcUnpack -> txt "{-# UNPACK #-}" >> space

@@ -139,14 +153,14 @@ p_hsType' multilineArgs = \case

139 case (p, xs) of

153 case (p, xs) of

140 (IsPromoted, L _ t : _) | isPromoted t -> space

154 (IsPromoted, L _ t : _) | isPromoted t -> space

141 _ -> return ()

155 _ -> return ()

142− sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

156+ sep commaDel (sitcc . located' p_hsType) xs

143 HsExplicitTupleTy NoExtField xs -> do

157 HsExplicitTupleTy NoExtField xs -> do

144 txt "'"

158 txt "'"

145 parens N $ do

159 parens N $ do

146 case xs of

160 case xs of

147 L _ t : _ | isPromoted t -> space

161 L _ t : _ | isPromoted t -> space

148 _ -> return ()

162 _ -> return ()

149− sep (comma >> breakpoint) (located' p_hsType) xs

163+ sep commaDel (located' p_hsType) xs

150 HsTyLit NoExtField t ->

164 HsTyLit NoExtField t ->

151 case t of

165 case t of

152 HsStrTy (SourceText s) _ -> p_stringLit s

166 HsStrTy (SourceText s) _ -> p_stringLit s

@@ -156,14 +170,14 @@ p_hsType' multilineArgs = \case

156 where

170 where

157 isPromoted = \case

171 isPromoted = \case

158 HsTyVar _ IsPromoted _ -> True

172 HsTyVar _ IsPromoted _ -> True

159− HsExplicitListTy {} -> True

160 HsExplicitTupleTy {} -> True

173 HsExplicitTupleTy {} -> True

174+ HsExplicitListTy {} -> True

161 _ -> False

175 _ -> False

162 interArgBreak =

176 interArgBreak =

163 if multilineArgs

177 if multilineArgs

164 then newline

178 then newline

165 else breakpoint

179 else breakpoint

166− p_hsTypeR = p_hsType' multilineArgs

180+ p_hsTypeR = p_hsType' multilineArgs docStyle

167

181

168-- | Return 'True' if at least one argument in 'HsType' has a doc string

182-- | Return 'True' if at least one argument in 'HsType' has a doc string

169-- attached to it.

183-- attached to it.

@@ -177,9 +191,7 @@ p_hsContext :: HsContext GhcPs -> R ()

177p_hsContext = \case

191p_hsContext = \case

178 [] -> txt "()"

192 [] -> txt "()"

179 [x] -> located x p_hsType

193 [x] -> located x p_hsType

180− xs ->

181− parens N . sitcc $

182− sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

194+ xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs

183

195

184p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

196p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

185p_hsTyVarBndr = \case

197p_hsTyVarBndr = \case

@@ -209,15 +221,14 @@ p_forallBndrs vis p tyvars =

209

221

210p_conDeclFields :: [LConDeclField GhcPs] -> R ()

222p_conDeclFields :: [LConDeclField GhcPs] -> R ()

211p_conDeclFields xs =

223p_conDeclFields xs =

212− braces N . sitcc $

213− sep (comma >> breakpoint) (sitcc . located' p_conDeclField) xs

224+ braces N $ sep commaDel (sitcc . located' p_conDeclField) xs

214

225

215p_conDeclField :: ConDeclField GhcPs -> R ()

226p_conDeclField :: ConDeclField GhcPs -> R ()

216p_conDeclField ConDeclField {..} = do

227p_conDeclField ConDeclField {..} = do

217 mapM_ (p_hsDocString Pipe True) cd_fld_doc

228 mapM_ (p_hsDocString Pipe True) cd_fld_doc

218 sitcc $

229 sitcc $

219 sep

230 sep

220− (comma >> breakpoint)

231+ commaDel

221 (located' (p_rdrName . rdrNameFieldOcc))

232 (located' (p_rdrName . rdrNameFieldOcc))

222 cd_fld_names

233 cd_fld_names

223 space

234 space

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

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

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

261 -- declarations.

272 -- declarations.

262− HsParTy NoExtField $ noLoc $

273+ HsParTy NoExtField . noLoc $

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

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

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