master..20a06bf · ormolu

.buildkite/pipeline.yml+2−2

since splitsnapshots

unifiedsplit

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

3 command: |

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

5 timeout: 100

6− - label: Build and test with GHC 8.8.4

6+ - label: Build and test with GHC 8.8.3

7 command: |

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

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

9 timeout: 100

10 - label: Build and test with GHC 8.10.1

11 command: |

.github/workflows/binaries.ymldeleted−39

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

1−name: Build binaries

2−on:

3− release:

4− types: [published]

5−jobs:

6− build:

7− strategy:

8− fail-fast: false

9− matrix:

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

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

12− steps:

13− - uses: actions/checkout@v2

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

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

16− with:

17− ghc-version: '8.10.1'

18− cabal-version: '3.2'

19− - name: Build Linux binary

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

21− run: |

22− docker run \

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

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

25− bash .github/workflows/build.sh

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

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

28− shell: bash

29− run: |

30− cabal build exe:ormolu

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

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

33− env:

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

35− with:

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

37− asset_path: ormolu

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

39− asset_content_type: application/octet-stream

.github/workflows/build.shdeleted−7

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

1−set -e

2−

3−cabal update

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

5−

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

7−strip -s ormolu

CHANGELOG.md+1−51

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

1## Unreleased

2

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

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

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

5−

6−## Ormolu 0.1.2.0

7−

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

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

10−

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

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

13−

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

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

16−

17−## Ormolu 0.1.1.0

18−

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

20− combined/eliminated intelligently.

21−

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

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

24−

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

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

27− disabled part is still syntactically correct. [Issue

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

29−

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

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

32−

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

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

35−

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

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

38−

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

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

41−

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

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

44−

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

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

47−

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

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

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

51−

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

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

54

4

55## Ormolu 0.1.0.0

5## Ormolu 0.1.0.0

56

6

README.md+11−21

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

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

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

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

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

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

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

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

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

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

45

46```console

47$ cat stack.yaml

48−resolver: lts-16.0

48+resolver: lts-14.3

49packages:

50- '.'

51

52−$ stack build # to build

52+$ stack build

53−$ stack install # to install

54```

53```

55

54

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

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

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

130 criterion than just being valid Haskell modules.

129 criterion than just being valid Haskell modules.

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

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

132

131

132+## Editor integration

133+

134+We know of the following editor integrations:

135+

136+* [Emacs][emacs-package]

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

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

139+

133## Running on Hackage

140## Running on Hackage

134

141

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

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

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

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

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

145into Ormolu).

152into Ormolu).

146

153

147−## Editor integration

148−

149−We know of the following editor integrations:

150−

151−* [Emacs][emacs-package]

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

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

154−

155−## Arch Linux

156−

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

158−

159−```console

160−yay -S ormolu

161−```

162−

163## Contributing

154## Contributing

164

155

165See [CONTRIBUTING.md][contributing].

156See [CONTRIBUTING.md][contributing].

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

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

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

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

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

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

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

app/Main.hs+13−23

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

8

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

10import Control.Monad

11−import Data.Bool (bool)

12import Data.Either (lefts)

11import Data.Either (lefts)

13import Data.List (intercalate, sort)

12import Data.List (intercalate, sort)

14import qualified Data.Text.IO as TIO

13import qualified Data.Text.IO as TIO

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

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

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

62 exitWith (ExitFailure 101)

61 exitWith (ExitFailure 101)

63 Just inputFile -> do

62 Just inputFile -> do

64− originalInput <- TIO.readFile inputFile

65− formattedInput <- ormoluFile config inputFile

63+ r <- ormoluFile config inputFile

66 case mode of

64 case mode of

67 Stdout ->

65 Stdout ->

68− TIO.putStr formattedInput

66+ TIO.putStr r

69− InPlace -> do

67+ InPlace ->

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

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

72− -- formatted.

73− when (formattedInput /= originalInput) $

74− TIO.writeFile inputFile formattedInput

68+ TIO.writeFile inputFile r

75 Check -> do

69 Check -> do

76− when (formattedInput /= originalInput) $

70+ r' <- TIO.readFile inputFile

71+ when (r /= r') $

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

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

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

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

79 -- 'notImplemented'.

74 -- 'notImplemented'.

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

139optsParser :: Parser Opts

134optsParser :: Parser Opts

140optsParser =

135optsParser =

141 Opts

136 Opts

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

143− [ short 'i',

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

145− ]

146− <|> (option parseMode . mconcat)

137+ <$> (option parseMode . mconcat)

147− [ long "mode",

138+ [ long "mode",

148− short 'm',

139+ short 'm',

149− metavar "MODE",

140+ metavar "MODE",

150− value Stdout,

141+ value Stdout,

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

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

152− ]

143+ ]

153− )

154 <*> configParser

144 <*> configParser

155 <*> (many . strArgument . mconcat)

145 <*> (many . strArgument . mconcat)

156 [ metavar "FILE",

146 [ metavar "FILE",

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

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

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

2+

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

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

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

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

1−clientFunc1 :: SomeType1

2−clientFunc2 :: SomeType2

3−clientFunc3 :: SomeType3

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

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

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

1−clientFunc1 :: SomeType1

2−clientFunc2 :: SomeType2

3−clientFunc3 :: SomeType3

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

data/examples/declaration/value/function/arg-breakpoints-out.hsdeleted−3

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

1−foo

2− bar =

3− body

data/examples/declaration/value/function/arg-breakpoints.hsdeleted−3

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

1−foo

2− bar =

3− body

data/examples/declaration/value/function/blank-lines-let-out.hsdeleted−6

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

1−foo =

2− let x = 10

3−

4− y = 11

5− z = 12

6− in x + y + z

data/examples/declaration/value/function/blank-lines-let.hsdeleted−9

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

1−foo =

2− let

3−

4− x = 10

5−

6− y = 11

7− z = 12

8−

9− in x + y + z

data/examples/declaration/value/function/blank-lines-where-out.hsdeleted−6

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

1−foo = x + y + z

2− where

3− x = 10

4−

5− y = 11

6− z = 12

data/examples/declaration/value/function/blank-lines-where.hsdeleted−7

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

1−foo = x + y + z

2− where

3−

4− x = 10

5−

6− y = 11

7− z = 12

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

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

1{-# LANGUAGE ImplicitParams #-}

2

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

4−sortBy = undefined

5

4

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

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

7sort = sortBy ?cmp

6sort = sortBy ?cmp

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

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

1{-# LANGUAGE ImplicitParams #-}

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

3

4−sortBy = undefined

5−

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

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

7sort = sortBy ?cmp

5sort = sortBy ?cmp

8

6

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

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

13 throwIO (OrmoluCppEnabled path)

14

15foo =

16− bar $

16+ bar

17− baz $

17+ $ baz

18− quux

18+ $ quux

19

20x =

21 case l of { A -> B } $

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

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

17 `catch` \case

18 a -> a

19

20−foo =

20+foo = bar

21− bar

22− ++ case foo of

21+ ++ case foo of

23− a -> a

22+ a -> a

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

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

1lenses =

2− Just $

3− M.fromList $

2+ Just $ M.fromList $

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

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

5− # "connection" .= uc

4+ # "connection" .= uc

6− # "user" .= case name of

5+ # "user" .= case name of

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

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

8− Nothing -> Nothing

7+ Nothing -> Nothing

9− # []

8+ # []

10

9

11foo =

10foo =

12 a

11 a

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

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

1−foo =

2− testCase "Foo" testFoo :

3− testCase "Bar" testBar :

4− testCase "Baz" testBaz :

5− []

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

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

1−foo =

2− testCase "Foo" testFoo :

3− testCase "Bar" testBar :

4− testCase "Baz" testBaz :

5− []

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

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

1−instance A.ToJSON UpdateTable where

2− toJSON a =

3− A.object $

4− "TableName" .= updateTableName a :

5− "ProvisionedThroughput" .= updateProvisionedThroughput a :

6− case updateGlobalSecondaryIndexUpdates a of

7− [] -> []

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

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

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

1−instance A.ToJSON UpdateTable where

2− toJSON a = A.object

3− $ "TableName" .= updateTableName a

4− : "ProvisionedThroughput" .= updateProvisionedThroughput a

5− : case updateGlobalSecondaryIndexUpdates a of

6− [] -> []

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

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

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

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

2−getPath tree t =

3− t :

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

5− Nothing -> []

6− Just parent -> getPath tree parent

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

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

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

2−getPath tree t = t :

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

4− Nothing -> []

5− Just parent -> getPath tree parent

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

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

1−foo =

2− reportSDoc "tc.cc" 30 $

3− sep $ do

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

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

6−

7−foo =

8− reportSDoc "tc.cc" 30 $

9− sep $ do

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

11− do

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

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

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

1−foo =

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

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

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

5−

6−foo =

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

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

9− do

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

data/examples/declaration/value/function/type-applications-and-splice-out.hsdeleted−4

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

1−{-# LANGUAGE TemplateHaskell #-}

2−{-# LANGUAGE TypeApplications #-}

3−

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

data/examples/declaration/value/function/type-applications-and-splice.hsdeleted−4

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

1−{-# LANGUAGE TemplateHaskell #-}

2−{-# LANGUAGE TypeApplications #-}

3−

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

data/examples/import/deduplication-bug-out.hsdeleted−6

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

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

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

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

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

5−import Foo5 (Bar5 (x1))

6−import Foo6 (Bar6 (..))

data/examples/import/deduplication-bug.hsdeleted−6

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

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

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

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

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

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

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

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

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

1import qualified MegaModule as M

2+ ( (<<<),

3+ (>>>),

2− ( Either,

4+ Either,

3 Maybe (Just, Nothing),

5 Maybe (Just, Nothing),

4 MaybeT (..),

6 MaybeT (..),

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

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

6 MonadBaseControl,

8 MonadBaseControl,

7 join,

9 join,

8 liftIO,

10 liftIO,

9 void,

11 void,

10− (<<<),

11− (>>>),

12 )

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

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

1import qualified MegaModule as M

2 ( -- (1)

3− -- (2)

4− Either, -- (3)

5− (<<<),

3+ (<<<), -- (2)

6 (>>>),

4 (>>>),

5+ Either, -- (3)

7 )

6 )

data/examples/import/merging-0-out.hsdeleted−3

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

1−import Foo

2−import Foo (bar, foo)

3−import Foo as F

data/examples/import/merging-0.hsdeleted−4

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

1−import Foo

2−import Foo (foo)

3−import Foo (bar)

4−import Foo as F

data/examples/import/merging-1-out.hsdeleted−2

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

1−import "bar" Foo (bar)

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

data/examples/import/merging-1.hsdeleted−3

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

1−import "foo" Foo (foo)

2−import "bar" Foo (bar)

3−import "foo" Foo (baz)

data/examples/import/merging-2-out.hsdeleted−2

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

1−import Foo hiding (bar4, foo2)

2−import qualified Foo (bar3, foo1)

data/examples/import/merging-2.hsdeleted−4

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

1−import qualified Foo (foo1)

2−import Foo hiding (foo2)

3−import qualified Foo (bar3)

4−import Foo hiding (bar4)

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

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

1import qualified MegaModule as M

2+ ( (<<<),

3+ (>>>),

2− ( Either,

4+ Either,

3 Monad

5 Monad

4− ( return,

5− (>>),

6+ ( (>>),

6− (>>=)

7+ (>>=),

8+ return

7 ),

9 ),

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

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

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

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

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

5−import Data.Text qualified as T

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

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

1module P where

2

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

4import qualified Prelude

3import qualified Prelude

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

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

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

1import Data.Text

2+import Data.Text

3+import qualified Data.Text as T

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

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

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

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

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

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

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

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

5−import qualified Data.Text as T

data/examples/import/sorted-export-list-out.hsdeleted−1

@@ -1 +0,0 @@

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

data/examples/import/sorted-export-list.hsdeleted−1

@@ -1 +0,0 @@

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

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

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

9 -- | Foo

10 Int ->

11 Int

12+

12foo ::

13foo ::

13 Foo a =>

14 Foo a =>

14 -- | Foo

15 -- | Foo

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

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

1−module Main (main) where

2−

3−-- | Foo.

4−

5−-- Bar

6−main :: IO ()

7−main = return ()

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

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

1−module Main (main) where

2−

3−{- | Foo. -}

4−-- Bar

5−main :: IO ()

6−main = return ()

data/examples/other/comment-trailing-space-out.hsdeleted−9

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

1−data T

2− = {-

3−

4− some multi-line comment

5−

6− with empty lines

7−

8− -}

9− A

data/examples/other/comment-trailing-space.hsdeleted−9

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

1−data T

2− = {-

3−

4− some multi-line comment

5−

6− with empty lines

7−

8− -}

9− A

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

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

1ffff, ffffffff :: Natural

2+

2#ifdef HASKELL_ZIP_DEV_MODE

3#ifdef HASKELL_ZIP_DEV_MODE

3ffff = 200

4ffff = 200

4ffffffff = 5000

5ffffffff = 5000

data/examples/other/disabling/indented-fragment-out.hsdeleted−7

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

1−foo =

2− {- ORMOLU_DISABLE -}

3− testCase "Foo" testFoo :

4− testCase "Bar" testBar :

5− testCase "Baz" testBaz :

6− {- ORMOLU_ENABLE -}

7− []

data/examples/other/disabling/indented-fragment.hsdeleted−7

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

1−foo =

2− {- ORMOLU_DISABLE -}

3− testCase "Foo" testFoo :

4− testCase "Bar" testBar :

5− testCase "Baz" testBaz :

6− {- ORMOLU_ENABLE -}

7− []

data/examples/other/pragma-comments-after-out.hsdeleted−4

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

1−{-# LANGUAGE AllowAmbiguousTypes #-}

2−{-# LANGUAGE ConstraintKinds #-}

3−-- TODO: Fix and delete this pragma

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

data/examples/other/pragma-comments-after.hsdeleted−3

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

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

2−{-# LANGUAGE AllowAmbiguousTypes #-}

3−{-# LANGUAGE ConstraintKinds #-}

default.nix+16−17

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

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

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

2−, system ? builtins.currentSystem

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

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

4}:

3}:

5

4

6let

5let

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

17 };

16 };

18 ormoluOverlay = self: super: {

17 ormoluOverlay = self: super: {

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

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

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

20+ (super.callHackageDirect {

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

22+ ver = "8.10.1.20200412";

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

24+ } {});

20 };

25 };

21 ormolize = import ./nix/ormolize {

26 ormolize = import ./nix/ormolize {

22 inherit pkgs;

27 inherit pkgs;

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

28 "distributed-process"

33 "distributed-process"

29 "esqueleto"

34 "esqueleto"

30 "fay"

35 "fay"

31− "hlint"

32 "idris"

36 "idris"

33 "intero"

37 "intero"

34 "leksah"

38 "leksah"

39+ "lens"

35 "pandoc"

40 "pandoc"

36 "pipes"

41 "pipes"

37− "postgrest"

38 "purescript"

42 "purescript"

39− "tensorflow"

43+ ];

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

41 ormolizedPackages = doCheck:

44 ormolizedPackages = doCheck:

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

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

43 package = p;

46 package = p;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

145 '';

146 '';

146 checkPhase = ''

147 checkPhase = ''

147 echo result-all-implicit.hs

148 echo result-all-implicit.hs

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

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

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

157 echo result-6-8.hs

158 echo result-6-8.hs

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

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

159− echo result-9-12.hs

160+ echo result-9-13.hs

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

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

161− echo result-17-18.hs

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

163 '';

162 '';

164 installPhase = ''

163 installPhase = ''

165 mkdir "$out"

164 mkdir "$out"

expected-failures/Agda.txt+2−2

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

1Formatting is not idempotent:

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

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

3 before: " = (check_ac"

4 after: " =\n "

5Please, consider reporting the bug.

6

7Formatting is not idempotent:

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

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

9 before: " nes\n\n "

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

11Please, consider reporting the bug.

expected-failures/esqueleto.txt+1−1

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

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

4

5The GHC parser (in Haddock mode) failed:

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

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

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

expected-failures/hlint.txtdeleted−11

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

1−Formatting is not idempotent:

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

3− before: "DoRec , -} Recursive"

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

5−Please, consider reporting the bug.

6−

7−Formatting is not idempotent:

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

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

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

11−Please, consider reporting the bug.

expected-failures/idris.txt+4

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

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

3 parse error on input `@'

4

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

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

7+Please, consider reporting the bug.

8+

5The GHC parser (in Haddock mode) failed:

9The GHC parser (in Haddock mode) failed:

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

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

7 parse error on input `@'

11 parse error on input `@'

expected-failures/intero.txt+1−1

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

1Formatting is not idempotent:

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

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

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

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

5Please, consider reporting the bug.

expected-failures/leksah.txt+1−1

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

1Formatting is not idempotent:

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

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

3 before: "cr\n -- show"

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

5Please, consider reporting the bug.

expected-failures/pandoc.txt+1−1

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

3 parse error on input `import'

4

5Formatting is not idempotent:

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

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

7 before: ".softbreak <$ endlin"

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

9Please, consider reporting the bug.

expected-failures/postgrest.txtdeleted−5

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

1−Formatting is not idempotent:

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

3− before: " || -- clients"

4− after: " || ( origin ="

5−Please, consider reporting the bug.

expected-failures/purescript.txt+2−2

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

1The GHC parser (in Haddock mode) failed:

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

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

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

4Perhaps you meant to use PatternSynonyms?

5

6The GHC parser (in Haddock mode) failed:

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

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

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

9Perhaps you meant to use PatternSynonyms?

10

expected-failures/tensorflow.txtdeleted−7

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

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

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

3− parse error on input `->'

4−

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

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

7− parse error on input `import'

nix/nixpkgs/default.nix+3−7

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

1−{ system ? builtins.currentSystem }:

2let

1let

3− rev = "32b46dd897ab2143a609988a04d87452f0bbef59";

2+ rev = "807ca93fadd5197c2260490de0c76e500562dc05";

4− sha256 = "1gzfrpjnr1bz9zljsyg3a4zrhk8r927sz761mrgcg56dwinkhpjk";

3+ sha256 = "10yq8bnls77fh3pk5chkkb1sv5lbdgyk1rr2v9xn71rr1k2x563p";

5 nixpkgs = builtins.fetchTarball {

4 nixpkgs = builtins.fetchTarball {

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

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

7 inherit sha256;

6 inherit sha256;

8 };

7 };

9− pkgs = import nixpkgs {

10− inherit system;

11− config.allowUnfree = true;

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

12− };

13in pkgs

9in pkgs

ormolu.cabal+4−5

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

1cabal-version: 1.18

2name: ormolu

3−version: 0.1.2.0

3+version: 0.1.0.0

4license: BSD3

5license-file: LICENSE.md

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

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

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

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

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

10synopsis: A formatter for Haskell source code

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

119 base >=4.12 && <5.0,

120 bytestring >=0.2 && <0.11,

121 containers >=0.5 && <0.7,

122− dlist >=0.8 && <2.0,

122+ dlist >=0.8 && <0.9,

123 exceptions >=0.6 && <0.11,

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

125 mtl >=2.0 && <3.0,

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

144 base >=4.12 && <5.0,

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

146 gitrev >=1.3 && <1.4,

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

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

148 ormolu -any,

149 text >=0.2 && <1.3

150

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

152 ghc-options:

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

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

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

156

155

157 else

156 else

158 ghc-options: -O2 -Wall -rtsopts

157 ghc-options: -O2 -Wall -rtsopts

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

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

1−{-# LANGUAGE LambdaCase #-}

2−

3−module Foo (

4− foo, bar, baz) where

5−

6−foo :: Int

7−foo = 5

8−

9−bar :: Int -> Int

10−bar = \case

11− 0 -> foo

12− x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

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

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

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

10bar = \case

11 0 -> foo

12 x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

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

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

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

9bar = \case

10 0 -> foo

11 x -> x - foo

12−

13−baz :: Int -> Int

14−baz = gege

15− where

16− gege = 1 + 2

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

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

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

10bar = \case

11 0 -> foo

12 x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

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

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

3module Foo

4 ( foo,

5 bar,

6− baz,

7 )

6 )

8where

7where

9

8

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

14bar = \case

13bar = \case

15 0 -> foo

14 0 -> foo

16 x -> x - foo

15 x -> x - foo

17−

18−baz :: Int -> Int

19−baz = gege

20− where

21− gege = 1 + 2

region-tests/src.hs+1−6

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

1{-# LANGUAGE LambdaCase #-}

2

3module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

5

6foo :: Int

7foo = 5

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

10bar = \case

11 0 -> foo

12 x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

shell.nix+1−3

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

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

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

2−, system ? builtins.currentSystem

3−}:

4

2

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

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

src/Ormolu/Diff.hs+3−3

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

14import qualified Data.Text as T

15import qualified FastString as GHC

16import GHC

17−import Ormolu.Imports (normalizeImports)

17+import Ormolu.Imports (sortImports)

18import Ormolu.Parser.CommentStream

19import Ormolu.Parser.Result

20import Ormolu.Utils

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

47 } =

48 matchIgnoringSrcSpans cstream0 cstream1

49 <> matchIgnoringSrcSpans

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

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

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

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

52

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

54-- and the ordering of import lists.

src/Ormolu/Imports.hs+47−161

@@ -4,199 +4,85 @@

4

5-- | Manipulations on import lists.

6module Ormolu.Imports

7− ( normalizeImports,

7+ ( sortImports,

8 )

9where

10

11import Data.Bifunctor

12−import Data.Char (isAlphaNum)

13import Data.Function (on)

12import Data.Function (on)

13+import Data.Generics (gcompare)

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

14+import Data.List (nubBy, sortBy)

15−import Data.Map.Strict (Map)

16−import qualified Data.Map.Strict as M

17−import FastString (FastString)

18import GHC hiding (GhcPs, IE)

15import GHC hiding (GhcPs, IE)

19import GHC.Hs.Extension

16import GHC.Hs.Extension

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

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

21−import Ormolu.Utils (notImplemented, showOutputable)

18+import Ormolu.Utils (notImplemented)

22

19

23−-- | Sort and normalize imports.

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

21+-- each declaration.

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

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

25−normalizeImports =

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

26− fmap snd

27− . M.toAscList

28− . M.fromListWith combineImports

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

30 where

24 where

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

25+ sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs

32− L

26+ sortImportLists = \case

33− l

27+ ImportDecl {..} ->

34 ImportDecl

28 ImportDecl

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

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

36 ..

30 ..

37 }

31 }

38− g _ = notImplemented "XImportDecl"

32+ XImportDecl x -> noExtCon x

39

33

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

41−-- are equal.

42−combineImports ::

43− LImportDecl GhcPs ->

44− LImportDecl GhcPs ->

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

45− LImportDecl GhcPs

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

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

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

47− L

37+ case (isPrelude n0, isPrelude n1) of

48− lx

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

49− ImportDecl

39+ (True, False) -> GT

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

40+ (False, True) -> LT

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

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

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

53− _ -> Nothing,

54− ..

55− }

56−combineImports _ _ = notImplemented "XImportDecl"

57−

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

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

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

61−data ImportId = ImportId

62− { importIsPrelude :: Bool,

63− importIdName :: ModuleName,

64− importPkgQual :: Maybe FastString,

65− importSource :: Bool,

66− importSafe :: Bool,

67− importQualified :: Bool,

68− importImplicit :: Bool,

69− importAs :: Maybe ModuleName,

70− importHiding :: Maybe Bool

71− }

72− deriving (Eq, Ord)

73−

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

75−importId :: LImportDecl GhcPs -> ImportId

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

77− ImportId

78− { importIsPrelude = isPrelude,

79− importIdName = moduleName,

80− importPkgQual = sl_fs <$> ideclPkgQual,

81− importSource = ideclSource,

82− importSafe = ideclSafe,

83− importQualified = case ideclQualified of

84− QualifiedPre -> True

85− QualifiedPost -> True

86− NotQualified -> False,

87− importImplicit = ideclImplicit,

88− importAs = unLoc <$> ideclAs,

89− importHiding = fst <$> ideclHiding

90− }

91 where

42 where

43+ n0 = unLoc (ideclName m0)

44+ n1 = unLoc (ideclName m1)

92− isPrelude = moduleNameString moduleName == "Prelude"

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

93− moduleName = unLoc ideclName

94−importId _ = notImplemented "XImportDecl"

95

46

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

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

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

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

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

49+sortLies =

99− where

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

100− combine ::

51+ . sortBy compareLIE

101− Map IEWrappedNameOrd (LIE GhcPs) ->

52+ . fmap (fmap sortThings)

102− LIE GhcPs ->

103− Map IEWrappedNameOrd (LIE GhcPs)

104− combine m (L new_l new) =

105− let wname = getIewn new

106− normalizeWNames =

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

108− alter = \case

109− Nothing -> Just . L new_l $

110− case new of

111− IEThingWith NoExtField n wildcard g flbl ->

112− IEThingWith NoExtField n wildcard (normalizeWNames g) flbl

113− other -> other

114− Just old ->

115− let f = \case

116− IEVar NoExtField n -> IEVar NoExtField n

117− IEThingAbs NoExtField _ -> new

118− IEThingAll NoExtField n -> IEThingAll NoExtField n

119− IEThingWith NoExtField n wildcard g flbl ->

120− case new of

121− IEVar NoExtField _ ->

122− error "Ormolu.Imports broken presupposition"

123− IEThingAbs NoExtField _ ->

124− IEThingWith NoExtField n wildcard g flbl

125− IEThingAll NoExtField n' ->

126− IEThingAll NoExtField n'

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

128− let combinedWildcard =

129− case (wildcard, wildcard') of

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

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

132− _ -> NoIEWildcard

133− in IEThingWith

134− NoExtField

135− n'

136− combinedWildcard

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

138− flbl'

139− IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

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

141− IEDoc NoExtField _ -> notImplemented "IEDoc"

142− IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

143− XIE x -> noExtCon x

144− IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

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

146− IEDoc NoExtField _ -> notImplemented "IEDoc"

147− IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

148− XIE x -> noExtCon x

149− in Just (f <$> old)

150− in M.alter alter wname m

151

53

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

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

153−-- 'Ord' instance for it.

55+sortThings :: IE GhcPs -> IE GhcPs

154−newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)

56+sortThings = \case

155− deriving (Eq)

57+ IEThingWith NoExtField x w xs fl ->

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

59+ other -> other

156

60

157−instance Ord IEWrappedNameOrd where

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

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

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

63+compareLIE = compareIewn `on` getIewn . unLoc

159

64

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

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

161−getIewn :: IE GhcPs -> IEWrappedNameOrd

66+getIewn :: IE GhcPs -> IEWrappedName RdrName

162getIewn = \case

67getIewn = \case

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

68+ IEVar NoExtField x -> unLoc x

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

69+ IEThingAbs NoExtField x -> unLoc x

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

70+ IEThingAll NoExtField x -> unLoc x

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

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

167 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

72 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

168 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

73 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

169 IEDoc NoExtField _ -> notImplemented "IEDoc"

74 IEDoc NoExtField _ -> notImplemented "IEDoc"

170 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

75 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

171 XIE x -> noExtCon x

76 XIE x -> noExtCon x

172

77

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

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

175−compareLIewn = compareIewn `on` unLoc

176−

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

88+compareIewn (IEType x) (IEType y) = unLoc x `compare` 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+3−5

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

32import Ormolu.Parser.CommentStream

33import Ormolu.Parser.Result

34import Ormolu.Processing.Preprocess (preprocess)

35−import Ormolu.Utils (incSpanLine, removeIndentation)

35+import Ormolu.Utils (incSpanLine)

36import qualified Panic as GHC

37import qualified Parser as GHC

38import qualified StringBuffer as GHC

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

51 Either (SrcSpan, String) ParseResult

52 )

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

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

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

55 preprocess path rawInput cfgRegion

56− (input, indent) = removeIndentation indentedInput

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

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

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

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

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

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

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

111 prImportQualifiedPost =

110 prImportQualifiedPost =

112 GHC.xopt ImportQualifiedPost dynFlags,

111 GHC.xopt ImportQualifiedPost dynFlags,

113 prLiteralPrefix = T.pack literalPrefix,

112 prLiteralPrefix = T.pack literalPrefix,

114− prLiteralSuffix = T.pack literalSuffix,

113+ prLiteralSuffix = T.pack literalSuffix

115− prIndent = indent

116 }

114 }

117 return (warnings, r)

115 return (warnings, r)

118

116

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

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

27import qualified Lexer as GHC

28import Ormolu.Parser.Pragma

29import Ormolu.Parser.Shebang

30−import Ormolu.Processing.Common

31−import Ormolu.Utils (onTheSameLine, showOutputable)

30+import Ormolu.Utils (showOutputable)

32import SrcLoc

31import SrcLoc

33

32

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

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

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

110 Nothing -> s :| []

109 Nothing -> s :| []

111 Just (x :| xs) ->

110 Just (x :| xs) ->

112 let getIndent y =

111 let getIndent y =

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

112+ if all isSpace y

114 then startIndent

113 then startIndent

115 else length (takeWhile isSpace y)

114 else length (takeWhile isSpace y)

116 n = minimum (startIndent : fmap getIndent xs)

115 n = minimum (startIndent : fmap getIndent xs)

117− removeIndent y =

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

118− if y == endDisabling

119− then y

120− else drop n y

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

122 else s :| []

117 else s :| []

123 (atomsBefore, ls') =

118 (atomsBefore, ls') =

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

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

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

150

145

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

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

152extractStackHeader ::

147extractStackHeader ::

153− -- | Comment stream to analyze

154 [RealLocated String] ->

148 [RealLocated String] ->

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

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

156extractStackHeader = \case

150extractStackHeader = \case

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

166

160

167-- | Extract pragmas and their associated comments.

161-- | Extract pragmas and their associated comments.

168extractPragmas ::

162extractPragmas ::

169− -- | Input

170 String ->

163 String ->

171− -- | Comment stream to analyze

172 [RealLocated String] ->

164 [RealLocated String] ->

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

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

174extractPragmas input = go initialLs id id

166extractPragmas input = go initialLs id id

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

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

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

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

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

184 Just pragma ->

176 Just pragma ->

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

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

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

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

187− in case xs of

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

189− (y : ys) ->

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

191− in if onTheSameLine

192− (RealSrcSpan (getRealSrcSpan x))

193− (RealSrcSpan (getRealSrcSpan y))

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

195− else go' ls [] xs

196

179

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

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

198unAnnotationComment :: GHC.AnnotationComment -> Maybe String

181unAnnotationComment :: GHC.AnnotationComment -> Maybe String

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

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

35 -- | Literal prefix

36 prLiteralPrefix :: Text,

37 -- | Literal suffix

38− prLiteralSuffix :: Text,

38+ prLiteralSuffix :: Text

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

40− prIndent :: Int

41 }

39 }

42

40

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

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

src/Ormolu/Printer.hs+1−1

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

23 prLiteralPrefix <> region <> prLiteralSuffix

24 where

25 region =

26− postprocess prIndent $

26+ postprocess $

27 runR

28 ( p_hsModule

29 prStackHeader

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

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

21 space,

22 newline,

23 inci,

24− inciIf,

25 located,

24 located,

26 located',

25 located',

27 switchLayout,

26 switchLayout,

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

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

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

75-- Basic

74-- Basic

76

75

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−

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

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

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

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

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

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

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

280 then newline >> inci m

270 then newline >> inci m

281 else space >> sitcc m

271 else space >> sitcc m

282 newline

272 newline

273+ case style of

274+ N -> txt close

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

275+ S -> inci (txt close)

284

276

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

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

286-- Literals

278-- Literals

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

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

154 -- | Last printed comment span

155 Maybe SpanMark ->

156 Bool

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

158needsNewlineBefore l mlastMark =

157needsNewlineBefore l mlastMark =

159 case spanMarkSpan <$> mlastMark of

158 case spanMarkSpan <$> mlastMark of

160 Nothing -> False

159 Nothing -> False

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

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

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

240 not (hasAtomsBefore comment)

239 not (hasAtomsBefore comment)

241 && ( case mlastMark of

240 && ( case mlastMark of

242− Just (HaddockSpan _ _) -> False

241+ Just (HaddockSpan _ spn) ->

242+ srcSpanEndLine spn + 1 == srcSpanStartLine l

243 Just (CommentSpan spn) ->

244 srcSpanEndLine spn + 1 == srcSpanStartLine l

245 _ -> False

src/Ormolu/Printer/Internal.hs−1

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

244 -- | 'Text' to output

245 Text ->

246 R ()

247−spit _ "" = return ()

248spit stype text = do

247spit stype text = do

249 requestedDel <- R (gets scRequestedDelimiter)

248 requestedDel <- R (gets scRequestedDelimiter)

250 pendingComments <- R (gets scPendingComments)

249 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− -- | Whether to bump indentation for arguments

117+ -- | Indentation-bumping wrapper

118− Bool ->

118+ (R () -> R ()) ->

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

120 R () ->

121 -- | How to print the arguments

122 [R ()] ->

123 R ()

124−p_infixDefHelper isInfix indentArgs name args =

124+p_infixDefHelper isInfix inci' name args =

125 case (isInfix, args) of

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

127 let parens' =

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

131 parens' $ do

132 p0

133 breakpoint

134− inci . sitcc $ do

134+ inci $ sitcc $ do

135 name

136 space

137 p1

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

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

139 breakpoint

140 sitcc (sep breakpoint sitcc ps)

141 (_, ps) -> do

142 name

143 unless (null ps) $ do

144 breakpoint

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

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

146

147-- | Print a Haddock.

148p_hsDocString ::

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

@@ -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,13 +54,12 @@ p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

54p_hsDeclsRespectGrouping = p_hsDecls' Respect

55

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

57−p_hsDecls' grouping style decls =

57+p_hsDecls' grouping style decls = sepSemi id $

58− sepSemi id $

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

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

60− -- groups.

59+ -- groups.

61− case groupDecls decls of

60+ case groupDecls decls of

62− [] -> []

61+ [] -> []

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

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

64 where

63 where

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

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

66 renderGroupWithPrev prev curr =

65 renderGroupWithPrev prev curr =

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

85 isHaddock _ = False

84 isHaddock _ = False

86

85

87-- | Group relevant declarations together.

86-- | Group relevant declarations together.

87+--

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

89+-- the preceding declaration in the group.

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

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

89groupDecls [] = []

91groupDecls [] = []

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

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

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

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

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

98 let relevantToHdr = groupedDecls header current

100 let relevantToHdr = groupedDecls header current

99 relevantToPrev = groupedDecls previous current

101 relevantToPrev = groupedDecls previous current

100− isDeclSeries = declSeries previous current

101− in isDeclSeries || relevantToHdr || relevantToPrev

102+ in relevantToHdr || relevantToPrev

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

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

103

104

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

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

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

195 (_, DocPrev) -> True

196 (_, DocPrev) -> True

196 _ -> False

197 _ -> False

197

198

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

199−declSeries ::

200− LHsDecl GhcPs ->

201− LHsDecl GhcPs ->

202− Bool

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

204− case (x, y) of

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

206− SigD NoExtField (TypeSig NoExtField _ _)

207− ) -> True

208− _ -> False

209−

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

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

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

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

212 where

201 where

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

299patSigRdrNames _ = Nothing

288patSigRdrNames _ = Nothing

300

289

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

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

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

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

303− flip concatMap ws $ \case

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

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

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

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

306warnSigRdrNames _ = Nothing

294warnSigRdrNames _ = Nothing

307

295

308patBindNames :: Pat GhcPs -> [RdrName]

296patBindNames :: Pat GhcPs -> [RdrName]

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

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

9import Ormolu.Printer.Meat.Common

10

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

12+

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

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

src/Ormolu/Printer/Meat/Declaration/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− True

61+ inci

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− inci $ sep commaDel (sitcc . located' p_funDep) fdeps

85+ sitcc $ 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+29−23

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

41 inci $

42 p_infixDefHelper

43 (isInfix fixity)

44− True

44+ inci

45 (p_rdrName name)

46 (located' p_hsType <$> tpats)

47 case dd_kindSig of

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

60 txt "where"

61 breakpoint

62 sepSemi (located' (p_conDecl False)) dd_cons

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

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

64+ $ inci

65+ $ do

64− let singleConstRec = isSingleConstRec dd_cons

66+ let singleConstRec = isSingleConstRec dd_cons

65− if singleConstRec

67+ if singleConstRec

66− then space

68+ then space

67− else

69+ else

68− if hasHaddocks dd_cons

70+ if hasHaddocks dd_cons

69− then newline

71+ then newline

70− else breakpoint

72+ else breakpoint

71− equals

73+ equals

72− space

74+ space

73− layout <- getLayout

75+ layout <- getLayout

74− let s =

76+ let s =

75− if layout == MultiLine || hasHaddocks dd_cons

77+ if layout == MultiLine || hasHaddocks dd_cons

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

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

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

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

78− sitcc' =

80+ sitcc' =

79− if singleConstRec

81+ if singleConstRec

80− then id

82+ then id

81− else sitcc

83+ else sitcc

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

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

83 unless (null $ unLoc dd_derivs) breakpoint

85 unless (null $ unLoc dd_derivs) breakpoint

84 inci . located dd_derivs $ \xs ->

86 inci . located dd_derivs $ \xs ->

85 sep newline (located' p_hsDerivingClause) xs

87 sep newline (located' p_hsDerivingClause) xs

@@ -106,8 +108,8 @@ p_conDecl singleConstRec = \case

106 unless (null cs) . inci $ do

108 unless (null cs) . inci $ do

107 commaDel

109 commaDel

108 sep commaDel p_rdrName cs

110 sep commaDel p_rdrName cs

111+ space

109 inci $ do

112 inci $ do

110− space

111 txt "::"

113 txt "::"

112 let interArgBreak =

114 let interArgBreak =

113 if hasDocStrings (unLoc con_res_ty)

115 if hasDocStrings (unLoc con_res_ty)

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

155 RecCon l -> do

157 RecCon l -> do

156 p_rdrName con_name

158 p_rdrName con_name

157 breakpoint

159 breakpoint

160+ let inci' =

161+ if singleConstRec

162+ then id

163+ else inci

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

164+ inci' (located l p_conDeclFields)

159 InfixCon x y -> do

165 InfixCon x y -> do

160 located x p_hsType

166 located x p_hsType

161 breakpoint

167 breakpoint

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

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

32 txt "instance"

33 breakpoint

34 match_overlap_mode deriv_overlap_mode breakpoint

35+ if toIndent

36+ then inci typesAfterInstance

35− inciIf toIndent typesAfterInstance

37+ else typesAfterInstance

36 txt "deriving"

38 txt "deriving"

37 space

39 space

38 case deriv_strategy of

40 case deriv_strategy of

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

88 unless (null allDecls) $ do

90 unless (null allDecls) $ do

89 breakpoint

91 breakpoint

90 txt "where"

92 txt "where"

91− unless (null allDecls) . inci $ do

93+ unless (null allDecls)

94+ $ inci

95+ $ do

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

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

93− breakpoint

97+ breakpoint

94− dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

98+ dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

95 XHsImplicitBndrs x -> noExtCon x

99 XHsImplicitBndrs x -> noExtCon x

96 XClsInstDecl x -> noExtCon x

100 XClsInstDecl x -> noExtCon x

97

101

src/Ormolu/Printer/Meat/Declaration/Signature.hs+18−17

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

14import BasicTypes

15import BooleanFormula

16import Control.Monad

17+import Data.Bool (bool)

17import GHC

18import GHC

18import Ormolu.Printer.Combinators

19import Ormolu.Printer.Combinators

19import Ormolu.Printer.Meat.Common

20import Ormolu.Printer.Meat.Common

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

47 p_rdrName n

48 p_rdrName n

48 if null ns

49 if null ns

49 then p_typeAscription hswc

50 then p_typeAscription hswc

50− else inciIf indentTail $ do

51+ else bool id inci indentTail $ do

51 commaDel

52 commaDel

52 sep commaDel p_rdrName ns

53 sep commaDel p_rdrName ns

53 p_typeAscription hswc

54 p_typeAscription hswc

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

55p_typeAscription ::

56p_typeAscription ::

56 LHsSigWcType GhcPs ->

57 LHsSigWcType GhcPs ->

57 R ()

58 R ()

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

59+p_typeAscription HsWC {..} = do

59 space

60 space

61+ inci $ do

60− txt "::"

62+ txt "::"

61− let t = hsib_body hswc_body

63+ let t = hsib_body hswc_body

62− if hasDocStrings (unLoc t)

64+ if hasDocStrings (unLoc t)

63− then newline

65+ then newline

64− else breakpoint

66+ else breakpoint

65− located t p_hsType

67+ located t p_hsType

66p_typeAscription (XHsWildCardBndrs x) = noExtCon x

68p_typeAscription (XHsWildCardBndrs x) = noExtCon x

67

69

68p_patSynSig ::

70p_patSynSig ::

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

224p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()

226p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()

225p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do

227p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do

226 txt "type"

228 txt "type"

227− inci $ do

228− space

229+ space

229− p_rdrName name

230+ p_rdrName name

230− space

231+ space

231− txt "::"

232+ txt "::"

232− breakpoint

233+ breakpoint

233− case bndrs of

234+ inci $ case bndrs of

234− HsIB NoExtField sig -> located sig p_hsType

235+ HsIB NoExtField sig -> located sig p_hsType

235− XHsImplicitBndrs x -> noExtCon x

236+ XHsImplicitBndrs x -> noExtCon x

236p_standaloneKindSig (XStandaloneKindSig c) = noExtCon c

237p_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− True

31+ inci

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

34+ inci

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− inciIf (not $ null feqn_bndrs) $ do

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

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

97 switchLayout famLhsSpn $

98 p_infixDefHelper

99 (isInfix feqn_fixity)

100− True

100+ inci

101 (p_rdrName feqn_tycon)

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

103 space

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

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

1{-# LANGUAGE LambdaCase #-}

2−{-# LANGUAGE MultiWayIf #-}

3{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE RecordWildCards #-}

3{-# LANGUAGE RecordWildCards #-}

5{-# LANGUAGE TypeApplications #-}

4{-# LANGUAGE TypeApplications #-}

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

22import Data.Data hiding (Infix, Prefix)

21import Data.Data hiding (Infix, Prefix)

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

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

24import Data.List (intersperse, sortOn)

23import Data.List (intersperse, sortOn)

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

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

26import qualified Data.List.NonEmpty as NE

25import qualified Data.List.NonEmpty as NE

27import Data.Text (Text)

26import Data.Text (Text)

28import qualified Data.Text as Text

27import qualified Data.Text as Text

29import GHC

28import GHC

30−import OccName (occNameString)

29+import OccName (mkVarOcc)

31import Ormolu.Printer.Combinators

30import Ormolu.Printer.Combinators

32import Ormolu.Printer.Internal

31import Ormolu.Printer.Internal

33import Ormolu.Printer.Meat.Common

32import Ormolu.Printer.Meat.Common

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

61 -- should use it and avoid bumping one level

60 -- should use it and avoid bumping one level

62 -- of indentation

61 -- of indentation

63 Hanging

62 Hanging

64− deriving (Eq, Show)

63+ deriving (Eq)

65

64

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

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

67p_valDecl = \case

66p_valDecl = \case

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

180 NoSrcStrict -> return ()

179 NoSrcStrict -> return ()

181 SrcStrict -> txt "!"

180 SrcStrict -> txt "!"

182 SrcLazy -> txt "~"

181 SrcLazy -> txt "~"

183− indentBody <- case NE.nonEmpty m_pats of

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

184− Nothing ->

185− False <$ case style of

183+ Nothing -> id <$ case style of

186− Function name -> p_rdrName name

184+ Function name -> p_rdrName name

187− _ -> return ()

185+ _ -> return ()

188 Just ne_pats -> do

186 Just ne_pats -> do

189− let combinedSpans = case style of

187+ let combinedSpans =

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

188+ combineSrcSpans' $

191− _ -> patSpans

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

189+ getLoc <$> ne_pats

190+ inci' =

193− indentBody = not (isOneLineSpan combinedSpans)

191+ if 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− indentBody

200+ inci'

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 indentBody

215+ return inci'

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− hasGuards = withGuards grhssGRHSs

227+ let 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− inciIf indentBody $ do

256+ inci' $ do

257 unless (length grhssGRHSs > 1) $

258 case style of

259 Function _ | hasGuards -> return ()

@@ -353,14 +353,7 @@ 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.

358−withSpacing ::

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

359− -- | Rendering function

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

361− -- | Entity to render

362− Located a ->

363− R ()

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

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

365 case getLoc l of

358 case getLoc l of

366 UnhelpfulSpan _ -> f x

359 UnhelpfulSpan _ -> f x

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

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

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

472p_hsLocalBinds = \case

465p_hsLocalBinds = \case

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

466 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

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

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

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

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

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

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

477 br <- layoutToBraces <$> getLayout

478 br <- layoutToBraces <$> getLayout

478− let items =

479+ sitcc $

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

480+ sepSemi

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

481+ ( \(p, i) ->

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

482+ ( case p of

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− p_item' (p, item) =

487+ )

488− positionToBracing p $

488+ (p_item i)

489− withSpacing (either p_valDecl p_sigDecl) item

489+ )

490− binds = sortOn (srcSpanStart . getLoc) items

490+ (attachRelativePos $ sortOn ssStart items)

491− sitcc $ sepSemi p_item' (attachRelativePos binds)

492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

491 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

492 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

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

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

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

521 else Normal

520 else Normal

522 placeHanging placement (located hsRecFieldArg p_hsExpr)

521 placeHanging placement (located hsRecFieldArg p_hsExpr)

523

522

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+

524p_hsExpr :: HsExpr GhcPs -> R ()

529p_hsExpr :: HsExpr GhcPs -> R ()

525p_hsExpr = p_hsExpr' N

530p_hsExpr = p_hsExpr' N

526

531

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

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

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

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

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

586 -- expression is parenthesised.

591 -- expression is parenthesised.

587− doIndent =

592+ indent =

588 case func of

593 case func of

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

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

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

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

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

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

597+ L spn _ ->

592− L spn _ -> isOneLineSpan spn

598+ if isOneLineSpan spn

593− ub <-

599+ then inci

600+ else id

594− getLayout <&> \case

601+ ub <- getLayout <&> \case

595− SingleLine -> useBraces

602+ SingleLine -> useBraces

596− MultiLine -> id

603+ MultiLine -> id

597 ub $ do

604 ub $ do

598 located func (p_hsExpr' s)

605 located func (p_hsExpr' s)

599 breakpoint

606 breakpoint

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

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

601− inciIf doIndent $ do

608+ indent $ do

602 unless (null initp) breakpoint

609 unless (null initp) breakpoint

603 located lastp p_hsExpr

610 located lastp p_hsExpr

604 Hanging -> do

611 Hanging -> do

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

613 breakpoint

620 breakpoint

614 inci $ do

621 inci $ do

615 txt "@"

622 txt "@"

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

617− -- gluing @ and $ together.

618− case unLoc (hswc_body a) of

619− HsSpliceTy {} -> space

620− _ -> return ()

621 located (hswc_body a) p_hsType

623 located (hswc_body a) p_hsType

622 OpApp NoExtField x op y -> do

624 OpApp NoExtField x op y -> do

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

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

624− p_exprOpTree s (reassociateOpTree getOpName opTree)

626+ p_exprOpTree True s (reassociateOpTree getOpName opTree)

625 NegApp NoExtField e _ -> do

627 NegApp NoExtField e _ -> do

626 txt "-"

628 txt "-"

627 space

629 space

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

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

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

639 unless (useRecordDot' && isRecordDot') breakpoint

641 unless (useRecordDot' && isRecordDot') breakpoint

640 inci (located x p_hsExpr)

642 inci (located x p_hsExpr)

641− ExplicitTuple NoExtField args boxity ->

643+ ExplicitTuple NoExtField args boxity -> do

642 let isSection = any (isMissing . unLoc) args

644 let isSection = any (isMissing . unLoc) args

643 isMissing = \case

645 isMissing = \case

644 Missing NoExtField -> True

646 Missing NoExtField -> True

645 _ -> False

647 _ -> False

646− p_arg = \case

647− Present NoExtField x -> located x p_hsExpr

648− Missing NoExtField -> pure ()

649− XTupArg x -> noExtCon x

650− p_larg = sitcc . located' p_arg

651− parens' =

648+ let parens' =

652 case boxity of

649 case boxity of

653 Boxed -> parens

650 Boxed -> parens

654 Unboxed -> parensHash

651 Unboxed -> parensHash

655− in if isSection

652+ if isSection

656− then

653+ then

657− switchLayout [] . parens' s $

654+ switchLayout [] . parens' s $

658− sep comma p_larg args

655+ sep comma (located' p_hsTupArg) args

659− else

656+ else

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

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

661− sep commaDel p_larg args

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

662 ExplicitSum NoExtField tag arity e ->

659 ExplicitSum NoExtField tag arity e ->

663 p_unboxedSum N tag arity (located e p_hsExpr)

660 p_unboxedSum N tag arity (located e p_hsExpr)

664 HsCase NoExtField e mgroup ->

661 HsCase NoExtField e mgroup ->

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

680 sepSemi

677 sepSemi

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

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

682 (unLoc es)

679 (unLoc es)

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

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

684 let p_parBody =

681 let p_parBody =

685 sep

682 sep

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

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

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

1231 HsCase NoExtField _ _ -> Hanging

1228 HsCase NoExtField _ _ -> Hanging

1232 HsDo NoExtField DoExpr _ -> Hanging

1229 HsDo NoExtField DoExpr _ -> Hanging

1233 HsDo NoExtField MDoExpr _ -> Hanging

1230 HsDo NoExtField MDoExpr _ -> Hanging

1234− OpApp NoExtField _ op y ->

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

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

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

1233+ -- style.

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

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

1237− _ -> Normal

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

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

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

1239 HsProc NoExtField p _ ->

1237 HsProc NoExtField p _ ->

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

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

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

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

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

1261 _ -> Nothing

1259 _ -> Nothing

1262

1260

1263−getOpNameStr :: RdrName -> String

1264−getOpNameStr = occNameString . rdrNameOcc

1265−

1266p_exprOpTree ::

1261p_exprOpTree ::

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

1263+ Bool ->

1267 -- | Bracket style to use

1264 -- | Bracket style to use

1268 BracketStyle ->

1265 BracketStyle ->

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

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

1270 R ()

1267 R ()

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

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

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

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

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

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

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

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

1275 -- placement.

1272 -- placement.

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

1291 MultiLine -> case placement of

1288 MultiLine -> case placement of

1292 Hanging -> useBraces

1289 Hanging -> useBraces

1293 Normal -> dontUseBraces

1290 Normal -> dontUseBraces

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

1291+ gotDollar = case getOpName (unLoc op) of

1295− gotDollar = opNameStr == Just "$"

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

1296− gotColon = opNameStr == Just ":"

1293+ _ -> False

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

1298 lhs =

1294 lhs =

1299 switchLayout [opTreeLoc x] $

1295 switchLayout [opTreeLoc x] $

1300− p_exprOpTree s x

1296+ p_exprOpTree (not gotDollar) s x

1301− p_op = located op (opWrapper . p_hsExpr)

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

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

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

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

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

1304 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1300 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

1305 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1301 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

1306 _ -> False

1302 _ -> False

1307− isDoBlock = \case

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

1309− _ -> False

1310 useRecordDot' <- useRecordDot

1303 useRecordDot' <- useRecordDot

1311− if

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

1312− | gotColon -> do

1305+ if useRecordDot' && isRecordDot'

1313− lhs

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

1314− space

1319+ space

1315− p_op

1320+ p_op

1316− case placement of

1321+ breakpoint

1317− Hanging -> do

1322+ inci p_y

1323+ else do

1324+ ub lhs

1325+ placeHanging placement $ do

1326+ p_op

1318 space

1327 space

1319 p_y

1328 p_y

1320− Normal -> do

1321− breakpoint

1322− inciIf (isDoBlock y) p_y

1323− | gotDollar

1324− && isOneLineSpan (opTreeLoc x)

1325− && placement == Normal -> do

1326− useBraces lhs

1327− space

1328− p_op

1329− breakpoint

1330− inci p_y

1331− | useRecordDot' && gotRecordDot -> do

1332− lhs

1333− when isSection space

1334− p_op

1335− p_y

1336− | otherwise -> do

1337− ub lhs

1338− placeHanging placement $ do

1339− p_op

1340− space

1341− p_y

1342

1329

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

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

1344isRecordDot ::

1331isRecordDot ::

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

1349 Bool

1336 Bool

1350isRecordDot op (RealSrcSpan ySpan) = case op of

1337isRecordDot op (RealSrcSpan ySpan) = case op of

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

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

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

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

1353 _ -> False

1340 _ -> False

1354isRecordDot _ _ = False

1341isRecordDot _ _ = False

1355

1342

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

1344+isDot :: RdrName -> Bool

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

1346+

1356-- | Get annotations for the enclosing element.

1347-- | Get annotations for the enclosing element.

1357getEnclosingAnns :: R [AnnKeywordId]

1348getEnclosingAnns :: R [AnnKeywordId]

1358getEnclosingAnns = do

1349getEnclosingAnns = do

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

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

11import Ormolu.Printer.Combinators

12

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

14+

14p_pat :: Pat GhcPs -> R ()

15p_pat :: Pat GhcPs -> R ()

16+

15p_hsExpr :: HsExpr GhcPs -> R ()

17p_hsExpr :: HsExpr GhcPs -> R ()

18+

16p_hsSplice :: HsSplice GhcPs -> R ()

19p_hsSplice :: HsSplice GhcPs -> R ()

20+

17p_stringLit :: String -> R ()

21p_stringLit :: String -> R ()

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

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

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

33p_topLevelWarning fnames wtxt = do

34 let (pragmaText, lits) = warningText wtxt

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

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

36− pragma pragmaText . inci $ do

36+ $ pragma pragmaText . inci

37+ $ do

37 sep commaDel p_rdrName fnames

38 sep commaDel p_rdrName fnames

38 breakpoint

39 breakpoint

39 p_lits lits

40 p_lits lits

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

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

93 inci $ do

94 let names :: [R ()]

95 names = located' p_ieWrappedName <$> xs

96+ parens N

96− parens N . sep commaDel sitcc $

97+ $ sep commaDel sitcc

97− case w of

98+ $ case w of

98 NoIEWildcard -> names

99 NoIEWildcard -> names

99 IEWildcard n ->

100 IEWildcard n ->

100 let (before, after) = splitAt n names

101 let (before, after) = splitAt n names

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

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

11import Control.Monad

12import qualified Data.Text as T

13import GHC

14−import Ormolu.Imports (normalizeImports)

14+import Ormolu.Imports

15import Ormolu.Parser.CommentStream

16import Ormolu.Parser.Pragma

17import Ormolu.Parser.Shebang

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

69 txt "where"

70 newline

71 newline

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

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

73 newline

74 switchLayout (getLoc <$> hsmodDecls) $ do

75 p_hsDecls Free hsmodDecls

src/Ormolu/Printer/Meat/Type.hs+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

120+ space -- FIXME

121 txt "::"

122− breakpoint

122+ space

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

19+import OccName (mkVarOcc)

20import Ormolu.Utils (unSrcSpan)

21

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

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

57reassociateOpTreeWith ::

58 forall ty op.

59 -- | Fixity map for operators

60− Map String Fixity ->

60+ Map RdrName Fixity ->

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

62 (op -> Maybe RdrName) ->

63 -- | Original 'OpTree'

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

68 where

69 fixityOf :: op -> Fixity

70 fixityOf op = fromMaybe defaultFixity $ do

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

71+ opName <- getOpName op

72− M.lookup s fixityMap

72+ M.lookup opName fixityMap

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

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

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

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

112 -- | Operator tree

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

114 -- | Fixity map

115− Map String Fixity

115+ Map RdrName Fixity

116buildFixityMap getOpName opTree =

117 addOverrides

118 . M.fromList

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

120− . zip [2 ..]

120+ . zip [1 ..]

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

122 . selectScores

123 $ score opTree

124 where

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

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

126 addOverrides m =

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

127− M.fromList

128+ in M.fromList

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

129+ [ mk "$" 0,

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

130+ mk "." 9

130− (".", fixity 100 InfixL)

131− ]

131+ ]

132− `M.union` m

132+ `M.union` m

133 fixity = Fixity NoSourceText

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

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

135 score (OpNode _) = []

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

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

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

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

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

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

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

144+ opName <- getOpName (unLoc o)

145 let s

146 | le < ob = AtBeginning oc

147 | oe < rb = AtEnd

148 | otherwise = InBetween

149 return $ (opName, s) : score r

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

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

151 selectScores =

152 L.sortOn snd

153 . mapMaybe

src/Ormolu/Processing/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_DISABLE_START"

23+startDisabling = "{- ORMOLU_DISABLING_START"

24

25-- | Marker for the end of the region where Ormolu should be disabled.

26endDisabling :: IsString s => s

src/Ormolu/Processing/Postprocess.hs+3−13

@@ -1,6 +1,3 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE ViewPatterns #-}

3−

4-- | Postprocessing for the results of printing.

1-- | Postprocessing for the results of printing.

5module Ormolu.Processing.Postprocess

2module Ormolu.Processing.Postprocess

6 ( postprocess,

3 ( postprocess,

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

13import qualified Ormolu.Processing.Cpp as Cpp

10import qualified Ormolu.Processing.Cpp as Cpp

14

11

15-- | Postprocess output of the formatter.

12-- | Postprocess output of the formatter.

16−postprocess ::

13+postprocess :: Text -> Text

17− -- | Desired indentation level

18− Int ->

19− -- | Input to process

20− Text ->

21− Text

22−postprocess indent =

14+postprocess =

23 T.unlines

15 T.unlines

24− . fmap indentLine

25 . fmap Cpp.unmaskLine

16 . fmap Cpp.unmaskLine

26 . filter (not . magicComment)

17 . filter (not . magicComment)

27 . T.lines

18 . T.lines

28 where

19 where

29− magicComment (T.stripStart -> x) =

20+ magicComment x =

30 x == startDisabling || x == endDisabling

21 x == startDisabling || x == endDisabling

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

src/Ormolu/Processing/Preprocess.hs+4−4

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

11import Control.Monad

12import Data.Char (isSpace)

13import qualified Data.List as L

14−import Data.Maybe (isJust, maybeToList)

14+import Data.Maybe (isJust)

15+import Data.Maybe (maybeToList)

15import FastString

16import FastString

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

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

17import Ormolu.Parser.Shebang (isShebang)

18import Ormolu.Parser.Shebang (isShebang)

@@ -142,8 +143,7 @@ magicComment ::

142 -- | Whether or not the two strings watch

143 -- | Whether or not the two strings watch

143 Bool

144 Bool

144magicComment expected s0 = isJust $ do

145magicComment expected s0 = isJust $ do

145− let trim = dropWhile isSpace

146+ s1 <- dropWhile isSpace <$> L.stripPrefix "{-" s0

146− s1 <- trim <$> L.stripPrefix "{-" (trim s0)

147− s2 <- trim <$> L.stripPrefix expected s1

147+ s2 <- dropWhile isSpace <$> L.stripPrefix expected s1

148 s3 <- L.stripPrefix "-}" s2

149 guard (all isSpace s3)

src/Ormolu/Utils.hs+1−15

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

1{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ViewPatterns #-}

4

3

5-- | Random utilities used by the code.

4-- | Random utilities used by the code.

6module Ormolu.Utils

5module Ormolu.Utils

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

16 separatedByBlank,

15 separatedByBlank,

17 separatedByBlankNE,

16 separatedByBlankNE,

18 onTheSameLine,

17 onTheSameLine,

19− removeIndentation,

20 )

18 )

21where

19where

22

20

23−import Data.Char (isSpace)

24import Data.List (dropWhileEnd)

21import Data.List (dropWhileEnd)

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

26import qualified Data.List.NonEmpty as NE

22import qualified Data.List.NonEmpty as NE

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

27import Data.Maybe (fromMaybe)

24import Data.Maybe (fromMaybe)

28import Data.Text (Text)

25import Data.Text (Text)

29import qualified Data.Text as T

26import qualified Data.Text as T

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

142onTheSameLine :: SrcSpan -> SrcSpan -> Bool

139onTheSameLine :: SrcSpan -> SrcSpan -> Bool

143onTheSameLine a b =

140onTheSameLine a b =

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

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

145−

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

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

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

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

150− where

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

152− getIndent y =

153− if all isSpace y

154− then 0

155− else length (takeWhile isSpace y)