06f2cf4...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+51−1

@@ -1,6 +1,56 @@

1## Unreleased

2

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

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

4

54

5## Ormolu 0.1.0.0

55## Ormolu 0.1.0.0

6

56

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/signature/type/infix-promoted-type-constructor-out.hs−1

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

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

2−

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

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

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

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

1+clientFunc1 :: SomeType1

2+clientFunc2 :: SomeType2

3+clientFunc3 :: SomeType3

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

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

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

1+clientFunc1 :: SomeType1

2+clientFunc2 :: SomeType2

3+clientFunc3 :: SomeType3

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

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

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

1+foo

2+ bar =

3+ body

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

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

1+foo

2+ bar =

3+ body

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

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

1+foo =

2+ let x = 10

3+

4+ y = 11

5+ z = 12

6+ in x + y + z

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

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

1+foo =

2+ let

3+

4+ x = 10

5+

6+ y = 11

7+ z = 12

8+

9+ in x + y + z

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

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

1+foo = x + y + z

2+ where

3+ x = 10

4+

5+ y = 11

6+ z = 12

data/examples/declaration/value/function/blank-lines-where.hsnew file+7

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

1+foo = x + y + z

2+ where

3+

4+ x = 10

5+

6+ y = 11

7+ z = 12

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

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

1{-# LANGUAGE ImplicitParams #-}

2

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

4+sortBy = undefined

4

5

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

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

6sort = sortBy ?cmp

7sort = sortBy ?cmp

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

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

1{-# LANGUAGE ImplicitParams #-}

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

3

4+sortBy = undefined

5+

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

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

5sort = sortBy ?cmp

7sort = sortBy ?cmp

6

8

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

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

13 throwIO (OrmoluCppEnabled path)

14

15foo =

16− bar

16+ bar $

17− $ baz

17+ baz $

18− $ quux

18+ quux

19

20x =

21 case l of { A -> B } $

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

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

17 `catch` \case

18 a -> a

19

20−foo = bar

20+foo =

21+ bar

21− ++ case foo of

22+ ++ case foo of

22− a -> a

23+ a -> a

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

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

1lenses =

2+ Just $

2− Just $ M.fromList $

3+ M.fromList $

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

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

4− # "connection" .= uc

5+ # "connection" .= uc

5− # "user" .= case name of

6+ # "user" .= case name of

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

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

7− Nothing -> Nothing

8+ Nothing -> Nothing

8− # []

9+ # []

9

10

10foo =

11foo =

11 a

12 a

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

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

1+foo =

2+ testCase "Foo" testFoo :

3+ testCase "Bar" testBar :

4+ testCase "Baz" testBaz :

5+ []

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

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

1+foo =

2+ testCase "Foo" testFoo :

3+ testCase "Bar" testBar :

4+ testCase "Baz" testBaz :

5+ []

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

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

1+instance A.ToJSON UpdateTable where

2+ toJSON a =

3+ A.object $

4+ "TableName" .= updateTableName a :

5+ "ProvisionedThroughput" .= updateProvisionedThroughput a :

6+ case updateGlobalSecondaryIndexUpdates a of

7+ [] -> []

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

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

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

1+instance A.ToJSON UpdateTable where

2+ toJSON a = A.object

3+ $ "TableName" .= updateTableName a

4+ : "ProvisionedThroughput" .= updateProvisionedThroughput a

5+ : case updateGlobalSecondaryIndexUpdates a of

6+ [] -> []

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

data/examples/declaration/value/function/list-notation-2-out.hsnew file+6

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

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

2+getPath tree t =

3+ t :

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

5+ Nothing -> []

6+ Just parent -> getPath tree parent

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

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

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

2+getPath tree t = t :

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

4+ Nothing -> []

5+ Just parent -> getPath tree parent

data/examples/declaration/value/function/list-notation-3-out.hsnew file+12

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

1+foo =

2+ reportSDoc "tc.cc" 30 $

3+ sep $ do

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

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

6+

7+foo =

8+ reportSDoc "tc.cc" 30 $

9+ sep $ do

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

11+ do

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

data/examples/declaration/value/function/list-notation-3.hsnew file+10

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

1+foo =

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

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

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

5+

6+foo =

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

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

9+ do

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

data/examples/declaration/value/function/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/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−5

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

1import Data.Text

2−import Data.Text

3−import qualified Data.Text as T

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

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

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

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

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

8import 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/sorted-export-list-out.hsnew file+1

@@ -0,0 +1 @@

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

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

@@ -0,0 +1 @@

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

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

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

9 -- | Foo

10 Int ->

11 Int

12−

13foo ::

12foo ::

14 Foo a =>

13 Foo a =>

15 -- | Foo

14 -- | Foo

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

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

1+module Main (main) where

2+

3+-- | Foo.

4+

5+-- Bar

6+main :: IO ()

7+main = return ()

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

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

1+module Main (main) where

2+

3+{- | Foo. -}

4+-- Bar

5+main :: IO ()

6+main = return ()

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

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

1+data T

2+ = {-

3+

4+ some multi-line comment

5+

6+ with empty lines

7+

8+ -}

9+ A

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

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

1+data T

2+ = {-

3+

4+ some multi-line comment

5+

6+ with empty lines

7+

8+ -}

9+ A

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

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

1ffff, ffffffff :: Natural

2−

3#ifdef HASKELL_ZIP_DEV_MODE

2#ifdef HASKELL_ZIP_DEV_MODE

4ffff = 200

3ffff = 200

5ffffffff = 5000

4ffffffff = 5000

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

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

1+foo =

2+ {- ORMOLU_DISABLE -}

3+ testCase "Foo" testFoo :

4+ testCase "Bar" testBar :

5+ testCase "Baz" testBaz :

6+ {- ORMOLU_ENABLE -}

7+ []

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

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

1+foo =

2+ {- ORMOLU_DISABLE -}

3+ testCase "Foo" testFoo :

4+ testCase "Bar" testBar :

5+ testCase "Baz" testBaz :

6+ {- ORMOLU_ENABLE -}

7+ []

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

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

1+{-# LANGUAGE AllowAmbiguousTypes #-}

2+{-# LANGUAGE ConstraintKinds #-}

3+-- TODO: Fix and delete this pragma

4+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

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

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

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

2+{-# LANGUAGE AllowAmbiguousTypes #-}

3+{-# LANGUAGE ConstraintKinds #-}

default.nix+17−16

@@ -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,14 +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− ];

39+ "tensorflow"

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

44 ormolizedPackages = doCheck:

41 ormolizedPackages = doCheck:

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

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

46 package = p;

43 package = p;

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

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

1Formatting is not idempotent:

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

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

3 before: " = (check_ac"

4 after: " =\n "

5Please, consider reporting the bug.

6

7Formatting is not idempotent:

8− src/full/Agda/Syntax/Translation/InternalToAbstract.hs<rendered>:745:4

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

9 before: " nes\n\n "

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

11Please, consider reporting the bug.

expected-failures/esqueleto.txt+1−1

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

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

4

5The GHC parser (in Haddock mode) failed:

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

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

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

expected-failures/hlint.txtnew file+11

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

1+Formatting is not idempotent:

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

3+ before: "DoRec , -} Recursive"

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

5+Please, consider reporting the bug.

6+

7+Formatting is not idempotent:

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

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

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

11+Please, consider reporting the bug.

expected-failures/idris.txt−4

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

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

3 parse error on input `@'

4

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

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

7−Please, consider reporting the bug.

8−

9The GHC parser (in Haddock mode) failed:

5The GHC parser (in Haddock mode) failed:

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

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

11 parse error on input `@'

7 parse error on input `@'

expected-failures/intero.txt+1−1

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

1Formatting is not idempotent:

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

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

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

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

5Please, consider reporting the bug.

expected-failures/leksah.txt+1−1

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

1Formatting is not idempotent:

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

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

3 before: "cr\n -- show"

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

5Please, consider reporting the bug.

expected-failures/pandoc.txt+1−1

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

3 parse error on input `import'

4

5Formatting is not idempotent:

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

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

7 before: ".softbreak <$ endlin"

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

9Please, consider reporting the bug.

expected-failures/postgrest.txtnew file+5

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

1+Formatting is not idempotent:

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

3+ before: " || -- clients"

4+ after: " || ( origin ="

5+Please, consider reporting the bug.

expected-failures/purescript.txt+2−2

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

1The GHC parser (in Haddock mode) failed:

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

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

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

4Perhaps you meant to use PatternSynonyms?

5

6The GHC parser (in Haddock mode) failed:

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

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

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

9Perhaps you meant to use PatternSynonyms?

10

expected-failures/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.1.0.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−47

@@ -4,85 +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 (nubBy, sortBy)

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

15+import Data.Map.Strict (Map)

16+import qualified Data.Map.Strict as M

17+import FastString (FastString)

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, dropping duplicates.

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

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

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

49−sortLies =

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

50− nubBy (\x y -> compareLIE x y == EQ)

99+ where

51− . sortBy compareLIE

100+ combine ::

52− . fmap (fmap sortThings)

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

53

151

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

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

55−sortThings :: IE GhcPs -> IE GhcPs

153+-- 'Ord' instance for it.

56−sortThings = \case

154+newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)

57− IEThingWith NoExtField x w xs fl ->

155+ deriving (Eq)

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

59− other -> other

60

156

61−-- | Compare a pair of located imports or exports.

157+instance Ord IEWrappedNameOrd where

62−compareLIE :: LIE GhcPs -> LIE GhcPs -> Ordering

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

63−compareLIE = compareIewn `on` getIewn . unLoc

64

159

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

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

66−getIewn :: IE GhcPs -> IEWrappedName RdrName

161+getIewn :: IE GhcPs -> IEWrappedNameOrd

67getIewn = \case

162getIewn = \case

68− IEVar NoExtField x -> unLoc x

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

69− IEThingAbs NoExtField x -> unLoc x

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

70− IEThingAll NoExtField x -> unLoc x

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

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

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

72 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

167 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

73 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

168 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

74 IEDoc NoExtField _ -> notImplemented "IEDoc"

169 IEDoc NoExtField _ -> notImplemented "IEDoc"

75 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

170 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

76 XIE x -> noExtCon x

171 XIE x -> noExtCon x

77

172

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

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

175+compareLIewn = compareIewn `on` unLoc

176+

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

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

79compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

187+compareIewn (IEType x) (IEType y) = unLoc x `compareRdrName` unLoc y

188+

189+compareRdrName :: RdrName -> RdrName -> Ordering

190+compareRdrName x y =

191+ case (getNameStr x, getNameStr y) of

192+ ([], []) -> EQ

193+ ((_ : _), []) -> GT

194+ ([], (_ : _)) -> LT

195+ ((x' : _), (y' : _)) ->

196+ case (isAlphaNum x', isAlphaNum y') of

197+ (False, False) -> x `compare` y

198+ (True, False) -> LT

199+ (False, True) -> GT

200+ (True, True) -> x `compare` y

201+ where

202+ getNameStr = showOutputable . rdrNameOcc

src/Ormolu/Parser.hs+5−3

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

32import Ormolu.Parser.CommentStream

33import Ormolu.Parser.Result

34import Ormolu.Processing.Preprocess (preprocess)

35−import Ormolu.Utils (incSpanLine)

35+import Ormolu.Utils (incSpanLine, removeIndentation)

36import qualified Panic as GHC

37import qualified Parser as GHC

38import qualified StringBuffer as GHC

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

51 Either (SrcSpan, String) ParseResult

52 )

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

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

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

55 preprocess path rawInput cfgRegion

56+ (input, indent) = removeIndentation indentedInput

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

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

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

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

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

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

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

110 prImportQualifiedPost =

111 prImportQualifiedPost =

111 GHC.xopt ImportQualifiedPost dynFlags,

112 GHC.xopt ImportQualifiedPost dynFlags,

112 prLiteralPrefix = T.pack literalPrefix,

113 prLiteralPrefix = T.pack literalPrefix,

113− prLiteralSuffix = T.pack literalSuffix

114+ prLiteralSuffix = T.pack literalSuffix,

115+ prIndent = indent

114 }

116 }

115 return (warnings, r)

117 return (warnings, r)

116

118

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

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

27import qualified Lexer as GHC

28import Ormolu.Parser.Pragma

29import Ormolu.Parser.Shebang

30+import Ormolu.Processing.Common

30−import Ormolu.Utils (showOutputable)

31+import Ormolu.Utils (onTheSameLine, showOutputable)

31import SrcLoc

32import SrcLoc

32

33

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

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

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

109 Nothing -> s :| []

110 Nothing -> s :| []

110 Just (x :| xs) ->

111 Just (x :| xs) ->

111 let getIndent y =

112 let getIndent y =

112− if all isSpace y

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

113 then startIndent

114 then startIndent

114 else length (takeWhile isSpace y)

115 else length (takeWhile isSpace y)

115 n = minimum (startIndent : fmap getIndent xs)

116 n = minimum (startIndent : fmap getIndent xs)

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

117+ removeIndent y =

118+ if y == endDisabling

119+ then y

120+ else drop n y

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

117 else s :| []

122 else s :| []

118 (atomsBefore, ls') =

123 (atomsBefore, ls') =

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

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

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

145

150

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

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

147extractStackHeader ::

152extractStackHeader ::

153+ -- | Comment stream to analyze

148 [RealLocated String] ->

154 [RealLocated String] ->

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

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

150extractStackHeader = \case

156extractStackHeader = \case

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

160

166

161-- | Extract pragmas and their associated comments.

167-- | Extract pragmas and their associated comments.

162extractPragmas ::

168extractPragmas ::

169+ -- | Input

163 String ->

170 String ->

171+ -- | Comment stream to analyze

164 [RealLocated String] ->

172 [RealLocated String] ->

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

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

166extractPragmas input = go initialLs id id

174extractPragmas input = go initialLs id id

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

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

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

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

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

176 Just pragma ->

184 Just pragma ->

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

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

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

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

187+ in case xs of

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

189+ (y : ys) ->

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

191+ in if onTheSameLine

192+ (RealSrcSpan (getRealSrcSpan x))

193+ (RealSrcSpan (getRealSrcSpan y))

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

195+ else go' ls [] xs

179

196

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

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

181unAnnotationComment :: GHC.AnnotationComment -> Maybe String

198unAnnotationComment :: GHC.AnnotationComment -> Maybe String

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

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

35 -- | Literal prefix

36 prLiteralPrefix :: Text,

37 -- | Literal suffix

38− prLiteralSuffix :: Text

38+ prLiteralSuffix :: Text,

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

40+ prIndent :: Int

39 }

41 }

40

42

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

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

src/Ormolu/Printer.hs+1−1

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

23 prLiteralPrefix <> region <> prLiteralSuffix

24 where

25 region =

26− postprocess $

26+ postprocess prIndent $

27 runR

28 ( p_hsModule

29 prStackHeader

src/Ormolu/Printer/Combinators.hs+11−3

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

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

73----------------------------------------------------------------------------

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

74-- Basic

75-- Basic

75

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+

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

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

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

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

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

270 then newline >> inci m

280 then newline >> inci m

271 else space >> sitcc m

281 else space >> sitcc m

272 newline

282 newline

273− case style of

274− N -> txt close

275− S -> inci (txt close)

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

276

284

277----------------------------------------------------------------------------

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

278-- Literals

286-- Literals

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

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

154 -- | Last printed comment span

155 Maybe SpanMark ->

156 Bool

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

157needsNewlineBefore l mlastMark =

158needsNewlineBefore l mlastMark =

158 case spanMarkSpan <$> mlastMark of

159 case spanMarkSpan <$> mlastMark of

159 Nothing -> False

160 Nothing -> False

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

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

239 not (hasAtomsBefore comment)

240 not (hasAtomsBefore comment)

240 && ( case mlastMark of

241 && ( case mlastMark of

241− Just (HaddockSpan _ spn) ->

242+ Just (HaddockSpan _ _) -> False

242− srcSpanEndLine spn + 1 == srcSpanStartLine l

243 Just (CommentSpan spn) ->

244 srcSpanEndLine spn + 1 == srcSpanStartLine l

245 _ -> False

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

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

220 R ()

221txt = spit SimpleText

222

223−-- |

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

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

224interferingTxt ::

225interferingTxt ::

225 -- | 'Text' to output

226 -- | 'Text' to output

226 Text ->

227 Text ->

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

243 -- | 'Text' to output

244 -- | 'Text' to output

244 Text ->

245 Text ->

245 R ()

246 R ()

247+spit _ "" = return ()

246spit stype text = do

248spit stype text = do

247 requestedDel <- R (gets scRequestedDelimiter)

249 requestedDel <- R (gets scRequestedDelimiter)

248 pendingComments <- R (gets scPendingComments)

250 pendingComments <- R (gets scPendingComments)

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

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

114p_infixDefHelper ::

115 -- | Whether to format in infix style

116 Bool ->

117− -- | Indentation-bumping wrapper

117+ -- | Whether to bump indentation for arguments

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

118+ Bool ->

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

120 R () ->

121 -- | How to print the arguments

122 [R ()] ->

123 R ()

124−p_infixDefHelper isInfix inci' name args =

124+p_infixDefHelper isInfix indentArgs name args =

125 case (isInfix, args) of

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

127 let parens' =

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

131 parens' $ do

132 p0

133 breakpoint

134− inci $ sitcc $ do

134+ inci . sitcc $ do

135 name

136 space

137 p1

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

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

139 breakpoint

140 sitcc (sep breakpoint sitcc ps)

141 (_, ps) -> do

142 name

143 unless (null ps) $ do

144 breakpoint

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

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

146

147-- | Print a Haddock.

148p_hsDocString ::

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

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

12where

13

14import Data.List (sort)

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

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

16import qualified Data.List.NonEmpty as NE

17import GHC hiding (InlinePragma)

18import OccName (occNameFS)

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

54p_hsDeclsRespectGrouping = p_hsDecls' Respect

55

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

57−p_hsDecls' grouping style decls = sepSemi id $

57+p_hsDecls' grouping style decls =

58+ sepSemi id $

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

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

59− -- groups.

60+ -- groups.

60− case groupDecls decls of

61+ case groupDecls decls of

61− [] -> []

62+ [] -> []

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

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

63 where

64 where

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

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

65 renderGroupWithPrev prev curr =

66 renderGroupWithPrev prev curr =

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

84 isHaddock _ = False

85 isHaddock _ = False

85

86

86-- | Group relevant declarations together.

87-- | Group relevant declarations together.

87−--

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

89−-- the preceding declaration in the group.

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

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

91groupDecls [] = []

89groupDecls [] = []

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

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

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

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

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

100 let relevantToHdr = groupedDecls header current

98 let relevantToHdr = groupedDecls header current

101 relevantToPrev = groupedDecls previous current

99 relevantToPrev = groupedDecls previous current

100+ isDeclSeries = declSeries previous current

102− in relevantToHdr || relevantToPrev

101+ in isDeclSeries || relevantToHdr || relevantToPrev

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

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

104

103

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

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

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

196 (_, DocPrev) -> True

195 (_, DocPrev) -> True

197 _ -> False

196 _ -> False

198

197

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

199+declSeries ::

200+ LHsDecl GhcPs ->

201+ LHsDecl GhcPs ->

202+ Bool

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

204+ case (x, y) of

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

206+ SigD NoExtField (TypeSig NoExtField _ _)

207+ ) -> True

208+ _ -> False

209+

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

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

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

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

201 where

212 where

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

288patSigRdrNames _ = Nothing

299patSigRdrNames _ = Nothing

289

300

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

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

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

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

303+ flip concatMap ws $ \case

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

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

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

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

294warnSigRdrNames _ = Nothing

306warnSigRdrNames _ = Nothing

295

307

296patBindNames :: Pat GhcPs -> [RdrName]

308patBindNames :: Pat GhcPs -> [RdrName]

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

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

9import Ormolu.Printer.Meat.Common

10

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

12−

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

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

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

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

58 switchLayout signatureSpans $

59 p_infixDefHelper

60 (isInfix fixity)

61− inci

61+ True

62 (p_rdrName name)

63 (located' p_hsTyVarBndr <$> hsq_explicit)

64 inci (p_classFundeps fdeps)

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

82 breakpoint

83 txt "|"

84 space

85− sitcc $ sep commaDel (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+25−32

@@ -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,28 +60,26 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do

60 txt "where"

61 breakpoint

62 sepSemi (located' (p_conDecl False)) dd_cons

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

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

64− $ inci

65− $ do

66− let singleConstRec = isSingleConstRec dd_cons

64+ let singleConstRec = isSingleConstRec dd_cons

67− if singleConstRec

65+ if singleConstRec

68− then space

66+ then space

69− else

67+ else

70− if hasHaddocks dd_cons

68+ if hasHaddocks dd_cons

71− then newline

69+ then newline

72− else breakpoint

70+ else breakpoint

73− equals

71+ equals

74− space

72+ space

75− layout <- getLayout

73+ layout <- getLayout

76− let s =

74+ let s =

77− if layout == MultiLine || hasHaddocks dd_cons

75+ if layout == MultiLine || hasHaddocks dd_cons

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

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

79− else space >> txt "|" >> space

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

80− sitcc' =

78+ sitcc' =

81− if singleConstRec

79+ if singleConstRec

82− then id

80+ then id

83− else sitcc

81+ else sitcc

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

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

85 unless (null $ unLoc dd_derivs) breakpoint

83 unless (null $ unLoc dd_derivs) breakpoint

86 inci . located dd_derivs $ \xs ->

84 inci . located dd_derivs $ \xs ->

87 sep newline (located' p_hsDerivingClause) xs

85 sep newline (located' p_hsDerivingClause) xs

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

106 (c : cs) -> do

104 (c : cs) -> do

107 p_rdrName c

105 p_rdrName c

108 unless (null cs) . inci $ do

106 unless (null cs) . inci $ do

109− comma

107+ commaDel

110− breakpoint

111− sitcc $ sep commaDel p_rdrName cs

108+ sep commaDel p_rdrName cs

112− space

113 inci $ do

109 inci $ do

110+ space

114 txt "::"

111 txt "::"

115 let interArgBreak =

112 let interArgBreak =

116 if hasDocStrings (unLoc con_res_ty)

113 if hasDocStrings (unLoc con_res_ty)

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

158 RecCon l -> do

155 RecCon l -> do

159 p_rdrName con_name

156 p_rdrName con_name

160 breakpoint

157 breakpoint

161− let inci' =

162− if singleConstRec

163− then id

164− else inci

165− inci' (located l p_conDeclFields)

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

166 InfixCon x y -> do

159 InfixCon x y -> do

167 located x p_hsType

160 located x p_hsType

168 breakpoint

161 breakpoint

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/Signature.hs+17−18

@@ -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,7 +47,7 @@ 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 bool id inci indentTail $ do

50+ else inciIf indentTail $ do

52 commaDel

51 commaDel

53 sep commaDel p_rdrName ns

52 sep commaDel p_rdrName ns

54 p_typeAscription hswc

53 p_typeAscription hswc

@@ -56,15 +55,14 @@ p_typeSig indentTail (n : ns) hswc = do

56p_typeAscription ::

55p_typeAscription ::

57 LHsSigWcType GhcPs ->

56 LHsSigWcType GhcPs ->

58 R ()

57 R ()

59−p_typeAscription HsWC {..} = do

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

60 space

59 space

61− inci $ do

62− txt "::"

60+ txt "::"

63− let t = hsib_body hswc_body

61+ let t = hsib_body hswc_body

64− if hasDocStrings (unLoc t)

62+ if hasDocStrings (unLoc t)

65− then newline

63+ then newline

66− else breakpoint

64+ else breakpoint

67− located t p_hsType

65+ located t p_hsType

68p_typeAscription (XHsWildCardBndrs x) = noExtCon x

66p_typeAscription (XHsWildCardBndrs x) = noExtCon x

69

67

70p_patSynSig ::

68p_patSynSig ::

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

226p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()

224p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()

227p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do

225p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do

228 txt "type"

226 txt "type"

227+ inci $ do

229− space

228+ space

230− p_rdrName name

229+ p_rdrName name

231− space

230+ space

232− txt "::"

231+ txt "::"

233− breakpoint

232+ breakpoint

234− inci $ case bndrs of

233+ case bndrs of

235− HsIB NoExtField sig -> located sig p_hsType

234+ HsIB NoExtField sig -> located sig p_hsType

236− XHsImplicitBndrs x -> noExtCon x

235+ XHsImplicitBndrs x -> noExtCon x

237p_standaloneKindSig (XStandaloneKindSig c) = noExtCon c

236p_standaloneKindSig (XStandaloneKindSig c) = noExtCon c

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

@@ -28,7 +28,7 @@ p_synDecl name fixity HsQTvs {..} t = do

28 switchLayout (getLoc name : map getLoc hsq_explicit) $

29 p_infixDefHelper

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

31− inci

31+ True

32 (p_rdrName name)

33 (map (located' p_hsTyVarBndr) hsq_explicit)

34 space

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

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

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

32 p_infixDefHelper

33 (isInfix fdFixity)

34− inci

34+ True

35 (p_rdrName fdLName)

36 (located' p_hsTyVarBndr <$> hsq_explicit)

37 let resultSig = p_familyResultSigL fdResultSig

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

92 Just bndrs -> do

93 p_forallBndrs ForallInvis p_hsTyVarBndr bndrs

94 breakpoint

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

95+ inciIf (not $ null feqn_bndrs) $ do

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

97 switchLayout famLhsSpn $

98 p_infixDefHelper

99 (isInfix feqn_fixity)

100− inci

100+ True

101 (p_rdrName feqn_tycon)

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

103 space

src/Ormolu/Printer/Meat/Declaration/Value.hs+121−112

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

1{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE MultiWayIf #-}

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE RecordWildCards #-}

4{-# LANGUAGE RecordWildCards #-}

4{-# LANGUAGE TypeApplications #-}

5{-# LANGUAGE TypeApplications #-}

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

21import Data.Data hiding (Infix, Prefix)

22import Data.Data hiding (Infix, Prefix)

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

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

23import Data.List (intersperse, sortOn)

24import Data.List (intersperse, sortOn)

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

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

25import qualified Data.List.NonEmpty as NE

26import qualified Data.List.NonEmpty as NE

26import Data.Text (Text)

27import Data.Text (Text)

27import qualified Data.Text as Text

28import qualified Data.Text as Text

28import GHC

29import GHC

29−import OccName (mkVarOcc)

30+import OccName (occNameString)

30import Ormolu.Printer.Combinators

31import Ormolu.Printer.Combinators

31import Ormolu.Printer.Internal

32import Ormolu.Printer.Internal

32import Ormolu.Printer.Meat.Common

33import Ormolu.Printer.Meat.Common

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

60 -- should use it and avoid bumping one level

61 -- should use it and avoid bumping one level

61 -- of indentation

62 -- of indentation

62 Hanging

63 Hanging

63− deriving (Eq)

64+ deriving (Eq, Show)

64

65

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

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

66p_valDecl = \case

67p_valDecl = \case

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

179 NoSrcStrict -> return ()

180 NoSrcStrict -> return ()

180 SrcStrict -> txt "!"

181 SrcStrict -> txt "!"

181 SrcLazy -> txt "~"

182 SrcLazy -> txt "~"

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

183+ indentBody <- case NE.nonEmpty m_pats of

184+ Nothing ->

183− Nothing -> id <$ case style of

185+ False <$ case style of

184− Function name -> p_rdrName name

186+ Function name -> p_rdrName name

185− _ -> return ()

187+ _ -> return ()

186 Just ne_pats -> do

188 Just ne_pats -> do

187− let combinedSpans =

189+ let combinedSpans = case style of

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

191+ _ -> patSpans

188− combineSrcSpans' $

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

189− getLoc <$> ne_pats

190− inci' =

191− if isOneLineSpan combinedSpans

193+ indentBody = not (isOneLineSpan combinedSpans)

192− then id

193− else inci

194 switchLayout [combinedSpans] $ do

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

196 case style of

197 Function name ->

198 p_infixDefHelper

199 isInfix

200− inci'

200+ indentBody

201 (p_rdrName name)

202 (located' p_pat <$> m_pats)

203 PatternBind -> stdCase

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

212 when needsSpace space

213 sitcc stdCase

214 LambdaCase -> stdCase

215− return inci'

215+ return indentBody

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

217 -- about putting certain constructions in hanging positions.

218 endOfPats = case NE.nonEmpty m_pats of

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

224 Case -> True

225 LambdaCase -> True

226 _ -> False

227− let hasGuards = withGuards grhssGRHSs

227+ hasGuards = withGuards grhssGRHSs

228 grhssSpan =

229 combineSrcSpans' $

230 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

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

253 txt "where"

254 unless whereIsEmpty breakpoint

255 inci $ located grhssLocalBinds p_hsLocalBinds

256− inci' $ do

256+ inciIf indentBody $ do

257 unless (length grhssGRHSs > 1) $

258 case style of

259 Function _ | hasGuards -> return ()

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

353 HsCmdTop NoExtField cmd -> located cmd p_hsCmd

354 XCmdTop x -> noExtCon x

355

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

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

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

358+withSpacing ::

359+ -- | Rendering function

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

361+ -- | Entity to render

362+ Located a ->

363+ R ()

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

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

358 case getLoc l of

365 case getLoc l of

359 UnhelpfulSpan _ -> f x

366 UnhelpfulSpan _ -> f x

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

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

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

465p_hsLocalBinds = \case

472p_hsLocalBinds = \case

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

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

467− let ssStart =

468− either

469− (srcSpanStart . getLoc)

470− (srcSpanStart . getLoc)

471− items =

472− (Left <$> bagToList bag) ++ (Right <$> lsigs)

473− p_item (Left x) = located x p_valDecl

474− p_item (Right x) = located x p_sigDecl

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

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

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

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

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

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

478 br <- layoutToBraces <$> getLayout

477 br <- layoutToBraces <$> getLayout

479− sitcc $

478+ let items =

480− sepSemi

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

481− ( \(p, i) ->

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

482− ( case p of

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

482+ positionToBracing = \case

483− SinglePos -> id

483+ SinglePos -> id

484− FirstPos -> br

484+ FirstPos -> br

485− MiddlePos -> br

485+ MiddlePos -> br

486− LastPos -> id

486+ LastPos -> id

487− )

487+ p_item' (p, item) =

488− (p_item i)

488+ positionToBracing p $

489− )

489+ withSpacing (either p_valDecl p_sigDecl) item

490+ binds = sortOn (srcSpanStart . getLoc) items

490− (attachRelativePos $ sortOn ssStart items)

491+ sitcc $ sepSemi p_item' (attachRelativePos binds)

491 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

492 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

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

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

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

520 else Normal

521 else Normal

521 placeHanging placement (located hsRecFieldArg p_hsExpr)

522 placeHanging placement (located hsRecFieldArg p_hsExpr)

522

523

523−p_hsTupArg :: HsTupArg GhcPs -> R ()

524−p_hsTupArg = \case

525− Present NoExtField x -> located x p_hsExpr

526− Missing NoExtField -> pure ()

527− XTupArg x -> noExtCon x

528−

529p_hsExpr :: HsExpr GhcPs -> R ()

524p_hsExpr :: HsExpr GhcPs -> R ()

530p_hsExpr = p_hsExpr' N

525p_hsExpr = p_hsExpr' N

531

526

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

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

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

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

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

591 -- expression is parenthesised.

586 -- expression is parenthesised.

592− indent =

587+ doIndent =

593 case func of

588 case func of

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

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

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

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

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

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

597− L spn _ ->

598− if isOneLineSpan spn

592+ L spn _ -> isOneLineSpan spn

599− then inci

593+ ub <-

600− else id

601− ub <- getLayout <&> \case

594+ getLayout <&> \case

602− SingleLine -> useBraces

595+ SingleLine -> useBraces

603− MultiLine -> id

596+ MultiLine -> id

604 ub $ do

597 ub $ do

605 located func (p_hsExpr' s)

598 located func (p_hsExpr' s)

606 breakpoint

599 breakpoint

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

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

608− indent $ do

601+ inciIf doIndent $ do

609 unless (null initp) breakpoint

602 unless (null initp) breakpoint

610 located lastp p_hsExpr

603 located lastp p_hsExpr

611 Hanging -> do

604 Hanging -> do

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

620 breakpoint

613 breakpoint

621 inci $ do

614 inci $ do

622 txt "@"

615 txt "@"

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

617+ -- gluing @ and $ together.

618+ case unLoc (hswc_body a) of

619+ HsSpliceTy {} -> space

620+ _ -> return ()

623 located (hswc_body a) p_hsType

621 located (hswc_body a) p_hsType

624 OpApp NoExtField x op y -> do

622 OpApp NoExtField x op y -> do

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

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

626− p_exprOpTree True s (reassociateOpTree getOpName opTree)

624+ p_exprOpTree s (reassociateOpTree getOpName opTree)

627 NegApp NoExtField e _ -> do

625 NegApp NoExtField e _ -> do

628 txt "-"

626 txt "-"

629 space

627 space

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

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

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

641 unless (useRecordDot' && isRecordDot') breakpoint

639 unless (useRecordDot' && isRecordDot') breakpoint

642 inci (located x p_hsExpr)

640 inci (located x p_hsExpr)

643− ExplicitTuple NoExtField args boxity -> do

641+ ExplicitTuple NoExtField args boxity ->

644 let isSection = any (isMissing . unLoc) args

642 let isSection = any (isMissing . unLoc) args

645 isMissing = \case

643 isMissing = \case

646 Missing NoExtField -> True

644 Missing NoExtField -> True

647 _ -> False

645 _ -> False

646+ p_arg = \case

647+ Present NoExtField x -> located x p_hsExpr

648+ Missing NoExtField -> pure ()

649+ XTupArg x -> noExtCon x

650+ p_larg = sitcc . located' p_arg

648− let parens' =

651+ parens' =

649 case boxity of

652 case boxity of

650 Boxed -> parens

653 Boxed -> parens

651 Unboxed -> parensHash

654 Unboxed -> parensHash

652− if isSection

655+ in if isSection

653− then

656+ then

654− switchLayout [] . parens' s $

657+ switchLayout [] . parens' s $

655− sep comma (located' p_hsTupArg) args

658+ sep comma p_larg args

656− else

659+ else

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

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

658− sep commaDel (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 ->

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

677 sepSemi

680 sepSemi

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

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

679 (unLoc es)

682 (unLoc es)

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

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

681 let p_parBody =

684 let p_parBody =

682 sep

685 sep

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

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

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

1228 HsCase NoExtField _ _ -> Hanging

1231 HsCase NoExtField _ _ -> Hanging

1229 HsDo NoExtField DoExpr _ -> Hanging

1232 HsDo NoExtField DoExpr _ -> Hanging

1230 HsDo NoExtField MDoExpr _ -> Hanging

1233 HsDo NoExtField MDoExpr _ -> Hanging

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

1234+ OpApp NoExtField _ op y ->

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

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

1233− -- style.

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

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

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

1237+ _ -> Normal

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

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

1237 HsProc NoExtField p _ ->

1239 HsProc NoExtField p _ ->

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

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

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

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

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

1259 _ -> Nothing

1261 _ -> Nothing

1260

1262

1263+getOpNameStr :: RdrName -> String

1264+getOpNameStr = occNameString . rdrNameOcc

1265+

1261p_exprOpTree ::

1266p_exprOpTree ::

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

1263− Bool ->

1264 -- | Bracket style to use

1267 -- | Bracket style to use

1265 BracketStyle ->

1268 BracketStyle ->

1266 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->

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

1267 R ()

1270 R ()

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

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

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

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

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

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

1272 -- placement.

1275 -- placement.

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

1288 MultiLine -> case placement of

1291 MultiLine -> case placement of

1289 Hanging -> useBraces

1292 Hanging -> useBraces

1290 Normal -> dontUseBraces

1293 Normal -> dontUseBraces

1291− gotDollar = case getOpName (unLoc op) of

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

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

1295+ gotDollar = opNameStr == Just "$"

1293− _ -> False

1296+ gotColon = opNameStr == Just ":"

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

1294 lhs =

1298 lhs =

1295 switchLayout [opTreeLoc x] $

1299 switchLayout [opTreeLoc x] $

1296− p_exprOpTree (not gotDollar) s x

1300+ p_exprOpTree s x

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

1301+ p_op = located op (opWrapper . p_hsExpr)

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

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

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

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

1300 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1304 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1301 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1305 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1302 _ -> False

1306 _ -> False

1307+ isDoBlock = \case

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

1309+ _ -> False

1303 useRecordDot' <- useRecordDot

1310 useRecordDot' <- useRecordDot

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

1311+ if

1305− if useRecordDot' && isRecordDot'

1312+ | gotColon -> do

1306− then do

1307− lhs

1308− when isSection space

1309− p_op

1310− p_y

1311− else

1312− if isDollarSpecial

1313− && gotDollar

1314− && placement

1315− == Normal

1316− && isOneLineSpan (opTreeLoc x)

1317− then do

1318− useBraces lhs

1313+ lhs

1319− space

1314+ space

1320− p_op

1315+ p_op

1321− breakpoint

1316+ case placement of

1322− inci p_y

1317+ Hanging -> do

1323− else do

1324− ub lhs

1325− placeHanging placement $ do

1326− p_op

1327 space

1318 space

1328 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

1329

1342

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

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

1331isRecordDot ::

1344isRecordDot ::

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

1336 Bool

1349 Bool

1337isRecordDot op (RealSrcSpan ySpan) = case op of

1350isRecordDot op (RealSrcSpan ySpan) = case op of

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

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

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

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

1340 _ -> False

1353 _ -> False

1341isRecordDot _ _ = False

1354isRecordDot _ _ = False

1342

1355

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

1344−isDot :: RdrName -> Bool

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

1346−

1347-- | Get annotations for the enclosing element.

1356-- | Get annotations for the enclosing element.

1348getEnclosingAnns :: R [AnnKeywordId]

1357getEnclosingAnns :: R [AnnKeywordId]

1349getEnclosingAnns = 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+2−3

@@ -32,9 +32,8 @@ 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 sep commaDel p_rdrName fnames

37 sep commaDel p_rdrName fnames

39 breakpoint

38 breakpoint

40 p_lits lits

39 p_lits lits

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

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

97− $ sep commaDel sitcc

96+ parens N . sep commaDel 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+4−4

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

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

68 _ -> (f', knownArgs)

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

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

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

71 located func p_hsType

72 breakpoint

73 inci $

@@ -117,9 +117,9 @@ p_hsType' multilineArgs docStyle = \case

117 HsStarTy NoExtField _ -> txt "*"

118 HsKindSig NoExtField t k -> sitcc $ do

119 located t p_hsType

120− space -- FIXME

121− txt "::"

122 space

120 space

121+ txt "::"

122+ breakpoint

123 inci (located k p_hsType)

124 HsSpliceTy NoExtField splice -> p_hsSplice splice

125 HsDocTy NoExtField t str ->

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

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

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

272 -- declarations.

273− HsParTy NoExtField $ noLoc $

273+ HsParTy NoExtField . noLoc $

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

275 XTyVarBndr x -> noExtCon x

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

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

16import qualified Data.Map.Strict as M

17import Data.Maybe (fromMaybe, mapMaybe)

18import GHC

19−import OccName (mkVarOcc)

19+import OccName (occNameString)

20import Ormolu.Utils (unSrcSpan)

21

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

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

57reassociateOpTreeWith ::

58 forall ty op.

59 -- | Fixity map for operators

60− Map RdrName Fixity ->

60+ Map String Fixity ->

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

62 (op -> Maybe RdrName) ->

63 -- | Original 'OpTree'

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

68 where

69 fixityOf :: op -> Fixity

70 fixityOf op = fromMaybe defaultFixity $ do

71− opName <- getOpName op

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

72− M.lookup opName fixityMap

72+ M.lookup s fixityMap

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

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

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

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

112 -- | Operator tree

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

114 -- | Fixity map

115− Map RdrName Fixity

115+ Map String Fixity

116buildFixityMap getOpName opTree =

117 addOverrides

118 . M.fromList

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

120− . zip [1 ..]

120+ . zip [2 ..]

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

122 . selectScores

123 $ score opTree

124 where

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

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

126 addOverrides m =

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

128− in M.fromList

127+ M.fromList

129− [ mk "$" 0,

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

130− mk "." 9

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

130+ (".", fixity 100 InfixL)

131− ]

131+ ]

132− `M.union` m

132+ `M.union` m

133 fixity = Fixity NoSourceText

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

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

135 score (OpNode _) = []

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

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

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

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

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

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

144− opName <- getOpName (unLoc o)

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

145 let s

146 | le < ob = AtBeginning oc

147 | oe < rb = AtEnd

148 | otherwise = InBetween

149 return $ (opName, s) : score r

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

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

151 selectScores =

152 L.sortOn snd

153 . mapMaybe

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)