a44fdea...master · ormolu

git.iko.soy/ormolu

106 files changed+997−446

since splitsnapshots

unifiedsplit

.buildkite/pipeline.yml+2−2

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

33 command: |

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

55 timeout: 100

6− - label: Build and test with GHC 8.8.3

6+ - label: Build and test with GHC 8.8.4

77 command: |

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

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

99 timeout: 100

1010 - label: Build and test with GHC 8.10.1

1111 command: |

.github/workflows/binaries.ymlnew file+39

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

1+name: Build binaries

2+on:

3+ release:

4+ types: [published]

5+jobs:

6+ build:

7+ strategy:

8+ fail-fast: false

9+ matrix:

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

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

12+ steps:

13+ - uses: actions/checkout@v2

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

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

16+ with:

17+ ghc-version: '8.10.1'

18+ cabal-version: '3.2'

19+ - name: Build Linux binary

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

21+ run: |

22+ docker run \

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

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

25+ bash .github/workflows/build.sh

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

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

28+ shell: bash

29+ run: |

30+ cabal build exe:ormolu

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

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

33+ env:

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

35+ with:

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

37+ asset_path: ormolu

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

39+ asset_content_type: application/octet-stream

.github/workflows/build.shnew file+7

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

1+set -e

3+cabal update

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

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

7+strip -s ormolu

CHANGELOG.md+51−1

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

11## Unreleased

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

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

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

6+## Ormolu 0.1.2.0

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

454

555## Ormolu 0.1.0.0

656

README.md+21−11

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

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

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

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

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

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

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

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

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

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

4545

4646```console

4747$ cat stack.yaml

48−resolver: lts-14.3

48+resolver: lts-16.0

4949packages:

5050- '.'

5151

52−$ stack build

52+$ stack build # to build

53+$ stack install # to install

5354```

5455

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

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

129130 criterion than just being valid Haskell modules.

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

131132

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−

140133## Running on Hackage

141134

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

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

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

152145into Ormolu).

153146

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+

154163## Contributing

155164

156165See [CONTRIBUTING.md][contributing].

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

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

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

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

app/Main.hs+23−13

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

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

1010import Control.Monad

11+import Data.Bool (bool)

1112import Data.Either (lefts)

1213import Data.List (intercalate, sort)

1314import qualified Data.Text.IO as TIO

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

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

6162 exitWith (ExitFailure 101)

6263 Just inputFile -> do

63− r <- ormoluFile config inputFile

64+ originalInput <- TIO.readFile inputFile

65+ formattedInput <- ormoluFile config inputFile

6466 case mode of

6567 Stdout ->

66− TIO.putStr r

67− InPlace ->

68− TIO.writeFile inputFile r

68+ TIO.putStr formattedInput

69+ InPlace -> do

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

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

72+ -- formatted.

73+ when (formattedInput /= originalInput) $

74+ TIO.writeFile inputFile formattedInput

6975 Check -> do

70− r' <- TIO.readFile inputFile

71− when (r /= r') $

76+ when (formattedInput /= originalInput) $

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

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

7479 -- 'notImplemented'.

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

134139optsParser :: Parser Opts

135140optsParser =

136141 Opts

137− <$> (option parseMode . mconcat)

138− [ long "mode",

139− short 'm',

140− metavar "MODE",

141− value Stdout,

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

143− ]

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

143+ [ short 'i',

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

145+ ]

146+ <|> (option parseMode . mconcat)

147+ [ long "mode",

148+ short 'm',

149+ metavar "MODE",

150+ value Stdout,

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

152+ ]

153+ )

144154 <*> configParser

145155 <*> (many . strArgument . mconcat)

146156 [ metavar "FILE",

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

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

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

2−

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

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

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

1+clientFunc1 :: SomeType1

2+clientFunc2 :: SomeType2

3+clientFunc3 :: SomeType3

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

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

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

1+clientFunc1 :: SomeType1

2+clientFunc2 :: SomeType2

3+clientFunc3 :: SomeType3

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

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

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

1+foo

2+ bar =

3+ body

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

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

1+foo

2+ bar =

3+ body

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

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

1+foo =

2+ let x = 10

4+ y = 11

5+ z = 12

6+ in x + y + z

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

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

1+foo =

2+ let

4+ x = 10

6+ y = 11

7+ z = 12

9+ in x + y + z

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

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

1+foo = x + y + z

2+ where

3+ x = 10

5+ y = 11

6+ z = 12

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

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

1+foo = x + y + z

2+ where

4+ x = 10

6+ y = 11

7+ z = 12

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

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

11{-# LANGUAGE ImplicitParams #-}

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

4+sortBy = undefined

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

67sort = sortBy ?cmp

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

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

11{-# LANGUAGE ImplicitParams #-}

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

4+sortBy = undefined

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

57sort = sortBy ?cmp

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

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

1313 throwIO (OrmoluCppEnabled path)

1414

1515foo =

16− bar

17− $ baz

18− $ quux

16+ bar $

17+ baz $

18+ quux

1919

2020x =

2121 case l of { A -> B } $

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

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

1717 `catch` \case

1818 a -> a

1919

20−foo = bar

21− ++ case foo of

22− a -> a

20+foo =

21+ bar

22+ ++ case foo of

23+ a -> a

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

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

11lenses =

2− Just $ M.fromList $

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

4− # "connection" .= uc

5− # "user" .= case name of

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

7− Nothing -> Nothing

8− # []

2+ Just $

3+ M.fromList $

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

5+ # "connection" .= uc

6+ # "user" .= case name of

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

8+ Nothing -> Nothing

9+ # []

910

1011foo =

1112 a

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

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

1+foo =

2+ testCase "Foo" testFoo :

3+ testCase "Bar" testBar :

4+ testCase "Baz" testBaz :

5+ []

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

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

1+foo =

2+ testCase "Foo" testFoo :

3+ testCase "Bar" testBar :

4+ testCase "Baz" testBaz :

5+ []

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

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

1+instance A.ToJSON UpdateTable where

2+ toJSON a =

3+ A.object $

4+ "TableName" .= updateTableName a :

5+ "ProvisionedThroughput" .= updateProvisionedThroughput a :

6+ case updateGlobalSecondaryIndexUpdates a of

7+ [] -> []

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

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

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

1+instance A.ToJSON UpdateTable where

2+ toJSON a = A.object

3+ $ "TableName" .= updateTableName a

4+ : "ProvisionedThroughput" .= updateProvisionedThroughput a

5+ : case updateGlobalSecondaryIndexUpdates a of

6+ [] -> []

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

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

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

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

2+getPath tree t =

3+ t :

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

5+ Nothing -> []

6+ Just parent -> getPath tree parent

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

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

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

2+getPath tree t = t :

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

4+ Nothing -> []

5+ Just parent -> getPath tree parent

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

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

1+foo =

2+ reportSDoc "tc.cc" 30 $

3+ sep $ do

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

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

7+foo =

8+ reportSDoc "tc.cc" 30 $

9+ sep $ do

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

11+ do

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

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

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

1+foo =

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

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

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

6+foo =

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

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

9+ do

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

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

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

1+{-# LANGUAGE TemplateHaskell #-}

2+{-# LANGUAGE TypeApplications #-}

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

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

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

1+{-# LANGUAGE TemplateHaskell #-}

2+{-# LANGUAGE TypeApplications #-}

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

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

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

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

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

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

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

5+import Foo5 (Bar5 (x1))

6+import Foo6 (Bar6 (..))

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

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

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

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

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

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

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

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

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

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

11import qualified MegaModule as M

2− ( (<<<),

3− (>>>),

4− Either,

2+ ( Either,

53 Maybe (Just, Nothing),

64 MaybeT (..),

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

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

86 MonadBaseControl,

97 join,

108 liftIO,

119 void,

10+ (<<<),

11+ (>>>),

1212 )

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

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

11import qualified MegaModule as M

22 ( -- (1)

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

4− (>>>),

3+ -- (2)

54 Either, -- (3)

5+ (<<<),

6+ (>>>),

67 )

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

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

1+import Foo

2+import Foo (bar, foo)

3+import Foo as F

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

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

1+import Foo

2+import Foo (foo)

3+import Foo (bar)

4+import Foo as F

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

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

1+import "bar" Foo (bar)

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

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

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

1+import "foo" Foo (foo)

2+import "bar" Foo (bar)

3+import "foo" Foo (baz)

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

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

1+import Foo hiding (bar4, foo2)

2+import qualified Foo (bar3, foo1)

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

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

1+import qualified Foo (foo1)

2+import Foo hiding (foo2)

3+import qualified Foo (bar3)

4+import Foo hiding (bar4)

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

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

11import qualified MegaModule as M

2− ( (<<<),

3− (>>>),

4− Either,

2+ ( Either,

53 Monad

6− ( (>>),

7− (>>=),

8− return

4+ ( return,

5+ (>>),

6+ (>>=)

97 ),

8+ (<<<),

9+ (>>>),

1010 )

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

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

11{-# LANGUAGE ImportQualifiedPost #-}

3−import Data.Text qualified as T

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

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

11module P where

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

34import qualified Prelude

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

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

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

11import 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)

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

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

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

5+import qualified Data.Text as T

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

@@ -0,0 +1 @@

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

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

@@ -0,0 +1 @@

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

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

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

99 -- | Foo

1010 Int ->

1111 Int

12−

1312foo ::

1413 Foo a =>

1514 -- | Foo

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

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

1+module Main (main) where

3+-- | Foo.

5+-- Bar

6+main :: IO ()

7+main = return ()

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

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

1+module Main (main) where

3+{- | Foo. -}

4+-- Bar

5+main :: IO ()

6+main = return ()

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

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

1+data T

2+ = {-

4+ some multi-line comment

6+ with empty lines

8+ -}

9+ A

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

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

1+data T

2+ = {-

4+ some multi-line comment

6+ with empty lines

8+ -}

9+ A

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

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

11ffff, ffffffff :: Natural

2−

32#ifdef HASKELL_ZIP_DEV_MODE

43ffff = 200

54ffffffff = 5000

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

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

1+foo =

2+ {- ORMOLU_DISABLE -}

3+ testCase "Foo" testFoo :

4+ testCase "Bar" testBar :

5+ testCase "Baz" testBaz :

6+ {- ORMOLU_ENABLE -}

7+ []

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

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

1+foo =

2+ {- ORMOLU_DISABLE -}

3+ testCase "Foo" testFoo :

4+ testCase "Bar" testBar :

5+ testCase "Baz" testBaz :

6+ {- ORMOLU_ENABLE -}

7+ []

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

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

1+{-# LANGUAGE AllowAmbiguousTypes #-}

2+{-# LANGUAGE ConstraintKinds #-}

3+-- TODO: Fix and delete this pragma

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

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

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

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

2+{-# LANGUAGE AllowAmbiguousTypes #-}

3+{-# LANGUAGE ConstraintKinds #-}

default.nix+17−16

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

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

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

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

2+, system ? builtins.currentSystem

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

34}:

56let

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

1617 };

1718 ormoluOverlay = self: super: {

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

2520 };

2621 ormolize = import ./nix/ormolize {

2722 inherit pkgs;

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

3328 "distributed-process"

3429 "esqueleto"

3530 "fay"

31+ "hlint"

3632 "idris"

3733 "intero"

3834 "leksah"

39− "lens"

4035 "pandoc"

4136 "pipes"

37+ "postgrest"

4238 "purescript"

43− ];

39+ "tensorflow"

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

4441 ormolizedPackages = doCheck:

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

4643 package = p;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

146145 '';

147146 checkPhase = ''

148147 echo result-all-implicit.hs

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

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

158157 echo result-6-8.hs

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

160− echo result-9-13.hs

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

159+ echo result-9-12.hs

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

161+ echo result-17-18.hs

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

162163 '';

163164 installPhase = ''

164165 mkdir "$out"

expected-failures/Agda.txt+2−2

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

11Formatting is not idempotent:

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

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

33 before: " = (check_ac"

44 after: " =\n "

55Please, consider reporting the bug.

77Formatting is not idempotent:

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

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

99 before: " nes\n\n "

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

1111Please, consider reporting the bug.

expected-failures/esqueleto.txt+1−1

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

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

55The GHC parser (in Haddock mode) failed:

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

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

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

expected-failures/hlint.txtnew file+11

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

1+Formatting is not idempotent:

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

3+ before: "DoRec , -} Recursive"

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

5+Please, consider reporting the bug.

7+Formatting is not idempotent:

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

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

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

11+Please, consider reporting the bug.

expected-failures/idris.txt−4

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

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

33 parse error on input `@'

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−

95The GHC parser (in Haddock mode) failed:

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

117 parse error on input `@'

expected-failures/intero.txt+1−1

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

11Formatting is not idempotent:

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

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

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

44 after: "text \"Try\"\n "

55Please, consider reporting the bug.

expected-failures/leksah.txt+1−1

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

11Formatting is not idempotent:

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

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

33 before: "cr\n -- show"

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

55Please, consider reporting the bug.

expected-failures/pandoc.txt+1−1

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

33 parse error on input `import'

55Formatting is not idempotent:

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

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

77 before: ".softbreak <$ endlin"

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

99Please, consider reporting the bug.

expected-failures/postgrest.txtnew file+5

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

1+Formatting is not idempotent:

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

3+ before: " || -- clients"

4+ after: " || ( origin ="

5+Please, consider reporting the bug.

expected-failures/purescript.txt+2−2

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

11The GHC parser (in Haddock mode) failed:

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

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

33 Invalid type signature: pattern ValueDecl :: ...

44Perhaps you meant to use PatternSynonyms?

66The GHC parser (in Haddock mode) failed:

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

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

88 Invalid type signature: pattern NullSourceSpan :: ...

99Perhaps you meant to use PatternSynonyms?

1010

expected-failures/tensorflow.txtnew file+7

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

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

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

3+ parse error on input `->'

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

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

7+ parse error on input `import'

nix/nixpkgs/default.nix+7−3

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

1+{ system ? builtins.currentSystem }:

12let

2− rev = "807ca93fadd5197c2260490de0c76e500562dc05";

3− sha256 = "10yq8bnls77fh3pk5chkkb1sv5lbdgyk1rr2v9xn71rr1k2x563p";

3+ rev = "32b46dd897ab2143a609988a04d87452f0bbef59";

4+ sha256 = "1gzfrpjnr1bz9zljsyg3a4zrhk8r927sz761mrgcg56dwinkhpjk";

45 nixpkgs = builtins.fetchTarball {

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

67 inherit sha256;

78 };

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

9+ pkgs = import nixpkgs {

10+ inherit system;

11+ config.allowUnfree = true;

12+ };

913in pkgs

ormolu.cabal+5−4

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

11cabal-version: 1.18

22name: ormolu

3−version: 0.1.0.0

3+version: 0.1.2.0

44license: BSD3

55license-file: LICENSE.md

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

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

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

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

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

1010synopsis: A formatter for Haskell source code

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

119119 base >=4.12 && <5.0,

120120 bytestring >=0.2 && <0.11,

121121 containers >=0.5 && <0.7,

122− dlist >=0.8 && <0.9,

122+ dlist >=0.8 && <2.0,

123123 exceptions >=0.6 && <0.11,

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

125125 mtl >=2.0 && <3.0,

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

144144 base >=4.12 && <5.0,

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

146146 gitrev >=1.3 && <1.4,

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

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

148148 ormolu -any,

149149 text >=0.2 && <1.3

150150

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

152152 ghc-options:

153153 -Wall -Werror -Wcompat -Wincomplete-record-updates

154154 -Wincomplete-uni-patterns -Wnoncanonical-monad-instances

155+ -optP-Wno-nonportable-include-path

155156

156157 else

157158 ghc-options: -O2 -Wall -rtsopts

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

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

1+{-# LANGUAGE LambdaCase #-}

3+module Foo (

4+ foo, bar, baz) where

6+foo :: Int

7+foo = 5

9+bar :: Int -> Int

10+bar = \case

11+ 0 -> foo

12+ x -> x - foo

13+

14+baz :: Int -> Int

15+baz = gege

16+ where

17+ gege = 1 + 2

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

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

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar) where

4+ foo, bar, baz) where

66foo :: Int

77foo = 5

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

1010bar = \case

1111 0 -> foo

1212 x -> x - foo

13+

14+baz :: Int -> Int

15+baz = gege

16+ where

17+ gege = 1 + 2

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

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

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar) where

4+ foo, bar, baz) where

66foo :: Int

77foo = 5

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

99bar = \case

1010 0 -> foo

1111 x -> x - foo

12+

13+baz :: Int -> Int

14+baz = gege

15+ where

16+ gege = 1 + 2

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

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

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar) where

4+ foo, bar, baz) where

66foo :: Int

77foo = 5

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

1010bar = \case

1111 0 -> foo

1212 x -> x - foo

13+

14+baz :: Int -> Int

15+baz = gege

16+ where

17+ gege = 1 + 2

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

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

33module Foo

44 ( foo,

55 bar,

6+ baz,

67 )

78where

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

1314bar = \case

1415 0 -> foo

1516 x -> x - foo

17+

18+baz :: Int -> Int

19+baz = gege

20+ where

21+ gege = 1 + 2

region-tests/src.hs+6−1

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

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar) where

4+ foo, bar, baz) where

66foo :: Int

77foo = 5

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

1010bar = \case

1111 0 -> foo

1212 x -> x - foo

13+

14+baz :: Int -> Int

15+baz = gege

16+ where

17+ gege = 1 + 2

shell.nix+3−1

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

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

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

2+, system ? builtins.currentSystem

3+}:

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

src/Ormolu/Diff.hs+3−3

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

1414import qualified Data.Text as T

1515import qualified FastString as GHC

1616import GHC

17−import Ormolu.Imports (sortImports)

17+import Ormolu.Imports (normalizeImports)

1818import Ormolu.Parser.CommentStream

1919import Ormolu.Parser.Result

2020import Ormolu.Utils

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

4747 } =

4848 matchIgnoringSrcSpans cstream0 cstream1

4949 <> matchIgnoringSrcSpans

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

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

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

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

5252

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

5454-- and the ordering of import lists.

src/Ormolu/Imports.hs+161−47

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

55-- | Manipulations on import lists.

66module Ormolu.Imports

7− ( sortImports,

7+ ( normalizeImports,

88 )

99where

1010

1111import Data.Bifunctor

12+import Data.Char (isAlphaNum)

1213import Data.Function (on)

13−import Data.Generics (gcompare)

14−import Data.List (nubBy, sortBy)

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

15+import Data.Map.Strict (Map)

16+import qualified Data.Map.Strict as M

17+import FastString (FastString)

1518import GHC hiding (GhcPs, IE)

1619import GHC.Hs.Extension

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

18−import Ormolu.Utils (notImplemented)

21+import Ormolu.Utils (notImplemented, showOutputable)

1922

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

21−-- each declaration.

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

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

23+-- | Sort and normalize imports.

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

25+normalizeImports =

26+ fmap snd

27+ . M.toAscList

28+ . M.fromListWith combineImports

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

2430 where

25− sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs

26− sortImportLists = \case

27− ImportDecl {..} ->

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

32+ L

33+ l

2834 ImportDecl

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

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

3036 ..

3137 }

32− XImportDecl x -> noExtCon x

38+ g _ = notImplemented "XImportDecl"

3339

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

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

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

37− case (isPrelude n0, isPrelude n1) of

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

39− (True, False) -> GT

40− (False, True) -> LT

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

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

41+-- are equal.

42+combineImports ::

43+ LImportDecl GhcPs ->

44+ LImportDecl GhcPs ->

45+ LImportDecl GhcPs

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

47+ L

48+ lx

49+ ImportDecl

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

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

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

53+ _ -> Nothing,

54+ ..

55+ }

56+combineImports _ _ = notImplemented "XImportDecl"

57+

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

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

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

61+data ImportId = ImportId

62+ { importIsPrelude :: Bool,

63+ importIdName :: ModuleName,

64+ importPkgQual :: Maybe FastString,

65+ importSource :: Bool,

66+ importSafe :: Bool,

67+ importQualified :: Bool,

68+ importImplicit :: Bool,

69+ importAs :: Maybe ModuleName,

70+ importHiding :: Maybe Bool

71+ }

72+ deriving (Eq, Ord)

73+

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

75+importId :: LImportDecl GhcPs -> ImportId

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

77+ ImportId

78+ { importIsPrelude = isPrelude,

79+ importIdName = moduleName,

80+ importPkgQual = sl_fs <$> ideclPkgQual,

81+ importSource = ideclSource,

82+ importSafe = ideclSafe,

83+ importQualified = case ideclQualified of

84+ QualifiedPre -> True

85+ QualifiedPost -> True

86+ NotQualified -> False,

87+ importImplicit = ideclImplicit,

88+ importAs = unLoc <$> ideclAs,

89+ importHiding = fst <$> ideclHiding

90+ }

4291 where

43− n0 = unLoc (ideclName m0)

44− n1 = unLoc (ideclName m1)

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

92+ isPrelude = moduleNameString moduleName == "Prelude"

93+ moduleName = unLoc ideclName

94+importId _ = notImplemented "XImportDecl"

4695

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

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

49−sortLies =

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

51− . sortBy compareLIE

52− . fmap (fmap sortThings)

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

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

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

99+ where

100+ combine ::

101+ Map IEWrappedNameOrd (LIE GhcPs) ->

102+ LIE GhcPs ->

103+ Map IEWrappedNameOrd (LIE GhcPs)

104+ combine m (L new_l new) =

105+ let wname = getIewn new

106+ normalizeWNames =

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

108+ alter = \case

109+ Nothing -> Just . L new_l $

110+ case new of

111+ IEThingWith NoExtField n wildcard g flbl ->

112+ IEThingWith NoExtField n wildcard (normalizeWNames g) flbl

113+ other -> other

114+ Just old ->

115+ let f = \case

116+ IEVar NoExtField n -> IEVar NoExtField n

117+ IEThingAbs NoExtField _ -> new

118+ IEThingAll NoExtField n -> IEThingAll NoExtField n

119+ IEThingWith NoExtField n wildcard g flbl ->

120+ case new of

121+ IEVar NoExtField _ ->

122+ error "Ormolu.Imports broken presupposition"

123+ IEThingAbs NoExtField _ ->

124+ IEThingWith NoExtField n wildcard g flbl

125+ IEThingAll NoExtField n' ->

126+ IEThingAll NoExtField n'

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

128+ let combinedWildcard =

129+ case (wildcard, wildcard') of

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

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

132+ _ -> NoIEWildcard

133+ in IEThingWith

134+ NoExtField

135+ n'

136+ combinedWildcard

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

138+ flbl'

139+ IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

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

141+ IEDoc NoExtField _ -> notImplemented "IEDoc"

142+ IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

143+ XIE x -> noExtCon x

144+ IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

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

146+ IEDoc NoExtField _ -> notImplemented "IEDoc"

147+ IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

148+ XIE x -> noExtCon x

149+ in Just (f <$> old)

150+ in M.alter alter wname m

53151

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

55−sortThings :: IE GhcPs -> IE GhcPs

56−sortThings = \case

57− IEThingWith NoExtField x w xs fl ->

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

59− other -> other

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

153+-- 'Ord' instance for it.

154+newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)

155+ deriving (Eq)

60156

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

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

63−compareLIE = compareIewn `on` getIewn . unLoc

157+instance Ord IEWrappedNameOrd where

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

64159

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

66−getIewn :: IE GhcPs -> IEWrappedName RdrName

161+getIewn :: IE GhcPs -> IEWrappedNameOrd

67162getIewn = \case

68− IEVar NoExtField x -> unLoc x

69− IEThingAbs NoExtField x -> unLoc x

70− IEThingAll NoExtField x -> unLoc x

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

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

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

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

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

72167 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

73168 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

74169 IEDoc NoExtField _ -> notImplemented "IEDoc"

75170 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

76171 XIE x -> noExtCon x

77172

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

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

175+compareLIewn = compareIewn `on` unLoc

176+

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

79178compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering

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

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

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

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

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

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

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

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

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

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

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

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

188+

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

190+compareRdrName x y =

191+ case (getNameStr x, getNameStr y) of

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

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

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

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

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

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

198+ (True, False) -> LT

199+ (False, True) -> GT

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

201+ where

202+ getNameStr = showOutputable . rdrNameOcc

src/Ormolu/Parser.hs+5−3

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

3232import Ormolu.Parser.CommentStream

3333import Ormolu.Parser.Result

3434import Ormolu.Processing.Preprocess (preprocess)

35−import Ormolu.Utils (incSpanLine)

35+import Ormolu.Utils (incSpanLine, removeIndentation)

3636import qualified Panic as GHC

3737import qualified Parser as GHC

3838import qualified StringBuffer as GHC

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

5151 Either (SrcSpan, String) ParseResult

5252 )

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

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

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

5555 preprocess path rawInput cfgRegion

56+ (input, indent) = removeIndentation indentedInput

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

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

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

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

110111 prImportQualifiedPost =

111112 GHC.xopt ImportQualifiedPost dynFlags,

112113 prLiteralPrefix = T.pack literalPrefix,

113− prLiteralSuffix = T.pack literalSuffix

114+ prLiteralSuffix = T.pack literalSuffix,

115+ prIndent = indent

114116 }

115117 return (warnings, r)

116118

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

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

2727import qualified Lexer as GHC

2828import Ormolu.Parser.Pragma

2929import Ormolu.Parser.Shebang

30−import Ormolu.Utils (showOutputable)

30+import Ormolu.Processing.Common

31+import Ormolu.Utils (onTheSameLine, showOutputable)

3132import SrcLoc

3233

3334----------------------------------------------------------------------------

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

109110 Nothing -> s :| []

110111 Just (x :| xs) ->

111112 let getIndent y =

112− if all isSpace y

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

113114 then startIndent

114115 else length (takeWhile isSpace y)

115116 n = minimum (startIndent : fmap getIndent xs)

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

117+ removeIndent y =

118+ if y == endDisabling

119+ then y

120+ else drop n y

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

117122 else s :| []

118123 (atomsBefore, ls') =

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

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

145150

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

147152extractStackHeader ::

153+ -- | Comment stream to analyze

148154 [RealLocated String] ->

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

150156extractStackHeader = \case

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

160166

161167-- | Extract pragmas and their associated comments.

162168extractPragmas ::

169+ -- | Input

163170 String ->

171+ -- | Comment stream to analyze

164172 [RealLocated String] ->

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

166174extractPragmas input = go initialLs id id

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

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

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

176184 Just pragma ->

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

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

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

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

187+ in case xs of

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

189+ (y : ys) ->

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

191+ in if onTheSameLine

192+ (RealSrcSpan (getRealSrcSpan x))

193+ (RealSrcSpan (getRealSrcSpan y))

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

195+ else go' ls [] xs

179196

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

181198unAnnotationComment :: GHC.AnnotationComment -> Maybe String

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

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

3535 -- | Literal prefix

3636 prLiteralPrefix :: Text,

3737 -- | Literal suffix

38− prLiteralSuffix :: Text

38+ prLiteralSuffix :: Text,

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

40+ prIndent :: Int

3941 }

4042

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

src/Ormolu/Printer.hs+1−1

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

2323 prLiteralPrefix <> region <> prLiteralSuffix

2424 where

2525 region =

26− postprocess $

26+ postprocess prIndent $

2727 runR

2828 ( p_hsModule

2929 prStackHeader

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

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

2121 space,

2222 newline,

2323 inci,

24+ inciIf,

2425 located,

2526 located',

2627 switchLayout,

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

5152

5253 -- ** Literals

5354 comma,

55+ commaDel,

5456 equals,

5557

5658 -- ** Stateful markers

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

7274----------------------------------------------------------------------------

7375-- Basic

7476

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+

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

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

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

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

174185 xs' ->

175186 if ub

176187 then do

177− txt "{ "

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

179− txt " }"

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

188+ txt "{"

189+ space

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

191+ space

192+ txt "}"

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

181194 multiLine =

182195 sep newline (dontUseBraces . f) xs

183196

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

190203 N

191204 | -- | Shifted one level

192205 S

206+ deriving (Eq, Show)

193207

194208-- | Surround given entity by backticks.

195209backticks :: R () -> R ()

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

266280 then newline >> inci m

267281 else space >> sitcc m

268282 newline

269− case style of

270− N -> txt close

271− S -> inci (txt close)

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

272284

273285----------------------------------------------------------------------------

274286-- Literals

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

277289comma :: R ()

278290comma = txt ","

279291

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

293+commaDel :: R ()

294+commaDel = comma >> breakpoint

295+

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

281297equals :: R ()

282298equals = interferingTxt "="

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

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

154154 -- | Last printed comment span

155155 Maybe SpanMark ->

156156 Bool

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

157158needsNewlineBefore l mlastMark =

158159 case spanMarkSpan <$> mlastMark of

159160 Nothing -> False

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

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

239240 not (hasAtomsBefore comment)

240241 && ( case mlastMark of

241− Just (HaddockSpan _ spn) ->

242− srcSpanEndLine spn + 1 == srcSpanStartLine l

242+ Just (HaddockSpan _ _) -> False

243243 Just (CommentSpan spn) ->

244244 srcSpanEndLine spn + 1 == srcSpanStartLine l

245245 _ -> False

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

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

220220 R ()

221221txt = spit SimpleText

222222

223−-- |

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

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

224225interferingTxt ::

225226 -- | 'Text' to output

226227 Text ->

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

243244 -- | 'Text' to output

244245 Text ->

245246 R ()

247+spit _ "" = return ()

246248spit stype text = do

247249 requestedDel <- R (gets scRequestedDelimiter)

248250 pendingComments <- R (gets scPendingComments)

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

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

114114p_infixDefHelper ::

115115 -- | Whether to format in infix style

116116 Bool ->

117− -- | Indentation-bumping wrapper

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

117+ -- | Whether to bump indentation for arguments

118+ Bool ->

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

120120 R () ->

121121 -- | How to print the arguments

122122 [R ()] ->

123123 R ()

124−p_infixDefHelper isInfix inci' name args =

124+p_infixDefHelper isInfix indentArgs name args =

125125 case (isInfix, args) of

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

127127 let parens' =

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

131131 parens' $ do

132132 p0

133133 breakpoint

134− inci $ sitcc $ do

134+ inci . sitcc $ do

135135 name

136136 space

137137 p1

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

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

139139 breakpoint

140140 sitcc (sep breakpoint sitcc ps)

141141 (_, ps) -> do

142142 name

143143 unless (null ps) $ do

144144 breakpoint

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

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

146146

147147-- | Print a Haddock.

148148p_hsDocString ::

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

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

1212where

1313

1414import Data.List (sort)

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

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

1616import qualified Data.List.NonEmpty as NE

1717import GHC hiding (InlinePragma)

1818import OccName (occNameFS)

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

5454p_hsDeclsRespectGrouping = p_hsDecls' Respect

5555

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

57−p_hsDecls' grouping style decls = sepSemi id $

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

59− -- groups.

60− case groupDecls decls of

61− [] -> []

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

57+p_hsDecls' grouping style decls =

58+ sepSemi id $

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

60+ -- groups.

61+ case groupDecls decls of

62+ [] -> []

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

6364 where

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

6566 renderGroupWithPrev prev curr =

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

8485 isHaddock _ = False

8586

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

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

9189groupDecls [] = []

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

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

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

10098 let relevantToHdr = groupedDecls header current

10199 relevantToPrev = groupedDecls previous current

102− in relevantToHdr || relevantToPrev

100+ isDeclSeries = declSeries previous current

101+ in isDeclSeries || relevantToHdr || relevantToPrev

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

104103

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

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

196195 (_, DocPrev) -> True

197196 _ -> False

198197

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+

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

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

201212 where

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

288299patSigRdrNames _ = Nothing

289300

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

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

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

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

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

303+ flip concatMap ws $ \case

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

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

294306warnSigRdrNames _ = Nothing

295307

296308patBindNames :: Pat GhcPs -> [RdrName]

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

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

99import Ormolu.Printer.Meat.Common

1010

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

12−

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

5858 switchLayout signatureSpans $

5959 p_infixDefHelper

6060 (isInfix fixity)

61− inci

61+ True

6262 (p_rdrName name)

6363 (located' p_hsTyVarBndr <$> hsq_explicit)

6464 inci (p_classFundeps fdeps)

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

8282 breakpoint

8383 txt "|"

8484 space

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

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

8686

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

8888p_funDep (before, after) = do

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

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

4141 inci $

4242 p_infixDefHelper

4343 (isInfix fixity)

44− inci

44+ True

4545 (p_rdrName name)

4646 (located' p_hsType <$> tpats)

4747 case dd_kindSig of

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

6060 txt "where"

6161 breakpoint

6262 sepSemi (located' (p_conDecl False)) dd_cons

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

64− $ inci

65− $ do

66− let singleConstRec = isSingleConstRec dd_cons

67− if singleConstRec

68− then space

69− else

70− if hasHaddocks dd_cons

71− then newline

72− else breakpoint

73− equals

74− space

75− layout <- getLayout

76− let s =

77− if layout == MultiLine || hasHaddocks dd_cons

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

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

80− sitcc' =

81− if singleConstRec

82− then id

83− else sitcc

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

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

64+ let singleConstRec = isSingleConstRec dd_cons

65+ if singleConstRec

66+ then space

67+ else

68+ if hasHaddocks dd_cons

69+ then newline

70+ else breakpoint

71+ equals

72+ space

73+ layout <- getLayout

74+ let s =

75+ if layout == MultiLine || hasHaddocks dd_cons

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

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

78+ sitcc' =

79+ if singleConstRec

80+ then id

81+ else sitcc

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

8583 unless (null $ unLoc dd_derivs) breakpoint

8684 inci . located dd_derivs $ \xs ->

8785 sep newline (located' p_hsDerivingClause) xs

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

106104 (c : cs) -> do

107105 p_rdrName c

108106 unless (null cs) . inci $ do

109− comma

110− breakpoint

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

112− space

107+ commaDel

108+ sep commaDel p_rdrName cs

113109 inci $ do

110+ space

114111 txt "::"

115112 let interArgBreak =

116113 if hasDocStrings (unLoc con_res_ty)

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

158155 RecCon l -> do

159156 p_rdrName con_name

160157 breakpoint

161− let inci' =

162− if singleConstRec

163− then id

164− else inci

165− inci' (located l p_conDeclFields)

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

166159 InfixCon x y -> do

167160 located x p_hsType

168161 breakpoint

@@ -213,7 +206,7 @@ p_hsDerivingClause HsDerivingClause {..} = do

213206 xs ->

214207 parens N $

215208 sep

216− (comma >> breakpoint)

209+ commaDel

217210 (sitcc . located' p_hsType . hsib_body)

218211 xs

219212 space

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

@@ -16,5 +16,5 @@ p_defaultDecl = \case

1616 txt "default"

1717 breakpoint

1818 inci . parens N $

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

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

2020 XDefaultDecl x -> noExtCon x

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

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

3232 txt "instance"

3333 breakpoint

3434 match_overlap_mode deriv_overlap_mode breakpoint

35− if toIndent

36− then inci typesAfterInstance

37− else typesAfterInstance

35+ inciIf toIndent typesAfterInstance

3836 txt "deriving"

3937 space

4038 case deriv_strategy of

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

9088 unless (null allDecls) $ do

9189 breakpoint

9290 txt "where"

93− unless (null allDecls)

94− $ inci

95− $ do

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

97− breakpoint

98− dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

91+ unless (null allDecls) . inci $ do

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

93+ breakpoint

94+ dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

9995 XHsImplicitBndrs x -> noExtCon x

10096 XClsInstDecl x -> noExtCon x

10197

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

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

1414import BasicTypes

1515import BooleanFormula

1616import Control.Monad

17−import Data.Bool (bool)

1817import GHC

1918import Ormolu.Printer.Combinators

2019import Ormolu.Printer.Meat.Common

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

4847 p_rdrName n

4948 if null ns

5049 then p_typeAscription hswc

51− else do

52− comma

53− breakpoint

54− bool id inci indentTail $ do

55− sep (comma >> breakpoint) p_rdrName ns

56− p_typeAscription hswc

50+ else inciIf indentTail $ do

51+ commaDel

52+ sep commaDel p_rdrName ns

53+ p_typeAscription hswc

5754

5855p_typeAscription ::

5956 LHsSigWcType GhcPs ->

6057 R ()

61−p_typeAscription HsWC {..} = do

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

6259 space

63− inci $ do

64− txt "::"

65− let t = hsib_body hswc_body

66− if hasDocStrings (unLoc t)

67− then newline

68− else breakpoint

69− located t p_hsType

60+ txt "::"

61+ let t = hsib_body hswc_body

62+ if hasDocStrings (unLoc t)

63+ then newline

64+ else breakpoint

65+ located t p_hsType

7066p_typeAscription (XHsWildCardBndrs x) = noExtCon x

7167

7268p_patSynSig ::

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

108104 space

109105 atom n

110106 space

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

107+ sitcc $ sep commaDel p_rdrName names

112108 XFixitySig x -> noExtCon x

113109

114110p_inlineSig ::

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

147143 space

148144 txt "::"

149145 breakpoint

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

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

151147

152148p_inlineSpec :: InlineSpec -> R ()

153149p_inlineSpec = \case

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

191187 And xs ->

192188 sitcc $

193189 sep

194− (comma >> breakpoint)

190+ commaDel

195191 (located' p_booleanFormula)

196192 xs

197193 Or xs ->

198194 sitcc $

199195 sep

200− (breakpoint >> txt "| ")

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

201197 (located' p_booleanFormula)

202198 xs

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

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

211207p_completeSig cs' mty =

212208 located cs' $ \cs ->

213209 pragma "COMPLETE" . inci $ do

214− sep (comma >> breakpoint) p_rdrName cs

210+ sep commaDel p_rdrName cs

215211 forM_ mty $ \ty -> do

216212 space

217213 txt "::"

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

228224p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()

229225p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do

230226 txt "type"

231− space

232− p_rdrName name

233− space

234− txt "::"

235− breakpoint

236− inci $ case bndrs of

237− HsIB NoExtField sig -> located sig p_hsType

238− XHsImplicitBndrs x -> noExtCon x

227+ inci $ do

228+ space

229+ p_rdrName name

230+ space

231+ txt "::"

232+ breakpoint

233+ case bndrs of

234+ HsIB NoExtField sig -> located sig p_hsType

235+ XHsImplicitBndrs x -> noExtCon x

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

2828 switchLayout (getLoc name : map getLoc hsq_explicit) $

2929 p_infixDefHelper

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

31− inci

31+ True

3232 (p_rdrName name)

3333 (map (located' p_hsTyVarBndr) hsq_explicit)

3434 space

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

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

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

3232 p_infixDefHelper

3333 (isInfix fdFixity)

34− inci

34+ True

3535 (p_rdrName fdLName)

3636 (located' p_hsTyVarBndr <$> hsq_explicit)

3737 let resultSig = p_familyResultSigL fdResultSig

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

9292 Just bndrs -> do

9393 p_forallBndrs ForallInvis p_hsTyVarBndr bndrs

9494 breakpoint

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

95+ inciIf (not $ null feqn_bndrs) $ do

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

9797 switchLayout famLhsSpn $

9898 p_infixDefHelper

9999 (isInfix feqn_fixity)

100− inci

100+ True

101101 (p_rdrName feqn_tycon)

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

103103 space

src/Ormolu/Printer/Meat/Declaration/Value.hs+132−123

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

11{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE MultiWayIf #-}

23{-# LANGUAGE OverloadedStrings #-}

34{-# LANGUAGE RecordWildCards #-}

45{-# LANGUAGE TypeApplications #-}

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

2122import Data.Data hiding (Infix, Prefix)

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

2324import Data.List (intersperse, sortOn)

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

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

2526import qualified Data.List.NonEmpty as NE

2627import Data.Text (Text)

2728import qualified Data.Text as Text

2829import GHC

29−import OccName (mkVarOcc)

30+import OccName (occNameString)

3031import Ormolu.Printer.Combinators

3132import Ormolu.Printer.Internal

3233import Ormolu.Printer.Meat.Common

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

6061 -- should use it and avoid bumping one level

6162 -- of indentation

6263 Hanging

63− deriving (Eq)

64+ deriving (Eq, Show)

6465

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

6667p_valDecl = \case

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

179180 NoSrcStrict -> return ()

180181 SrcStrict -> txt "!"

181182 SrcLazy -> txt "~"

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

183− Nothing -> id <$ case style of

184− Function name -> p_rdrName name

185− _ -> return ()

183+ indentBody <- case NE.nonEmpty m_pats of

184+ Nothing ->

185+ False <$ case style of

186+ Function name -> p_rdrName name

187+ _ -> return ()

186188 Just ne_pats -> do

187− let combinedSpans =

188− combineSrcSpans' $

189− getLoc <$> ne_pats

190− inci' =

191− if isOneLineSpan combinedSpans

192− then id

193− else inci

189+ let combinedSpans = case style of

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

191+ _ -> patSpans

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

193+ indentBody = not (isOneLineSpan combinedSpans)

194194 switchLayout [combinedSpans] $ do

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

196196 case style of

197197 Function name ->

198198 p_infixDefHelper

199199 isInfix

200− inci'

200+ indentBody

201201 (p_rdrName name)

202202 (located' p_pat <$> m_pats)

203203 PatternBind -> stdCase

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

212212 when needsSpace space

213213 sitcc stdCase

214214 LambdaCase -> stdCase

215− return inci'

215+ return indentBody

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

217217 -- about putting certain constructions in hanging positions.

218218 endOfPats = case NE.nonEmpty m_pats of

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

224224 Case -> True

225225 LambdaCase -> True

226226 _ -> False

227− let hasGuards = withGuards grhssGRHSs

227+ hasGuards = withGuards grhssGRHSs

228228 grhssSpan =

229229 combineSrcSpans' $

230230 getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs

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

253253 txt "where"

254254 unless whereIsEmpty breakpoint

255255 inci $ located grhssLocalBinds p_hsLocalBinds

256− inci' $ do

256+ inciIf indentBody $ do

257257 unless (length grhssGRHSs > 1) $

258258 case style of

259259 Function _ | hasGuards -> return ()

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

284284 xs -> do

285285 txt "|"

286286 space

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

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

288288 space

289289 inci $ case style of

290290 EqualSign -> equals

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

353353 HsCmdTop NoExtField cmd -> located cmd p_hsCmd

354354 XCmdTop x -> noExtCon x

355355

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

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

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

358+withSpacing ::

359+ -- | Rendering function

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

361+ -- | Entity to render

362+ Located a ->

363+ R ()

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

358365 case getLoc l of

359366 UnhelpfulSpan _ -> f x

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

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

465472p_hsLocalBinds = \case

466473 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

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

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

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

478477 br <- layoutToBraces <$> getLayout

479− sitcc $

480− sepSemi

481− ( \(p, i) ->

482− ( case p of

483− SinglePos -> id

484− FirstPos -> br

485− MiddlePos -> br

486− LastPos -> id

487− )

488− (p_item i)

489− )

490− (attachRelativePos $ sortOn ssStart items)

478+ let items =

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

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

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

482+ positionToBracing = \case

483+ SinglePos -> id

484+ FirstPos -> br

485+ MiddlePos -> br

486+ LastPos -> id

487+ p_item' (p, item) =

488+ positionToBracing p $

489+ withSpacing (either p_valDecl p_sigDecl) item

490+ binds = sortOn (srcSpanStart . getLoc) items

491+ sitcc $ sepSemi p_item' (attachRelativePos binds)

491492 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

492493 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

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

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

520521 else Normal

521522 placeHanging placement (located hsRecFieldArg p_hsExpr)

522523

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−

529524p_hsExpr :: HsExpr GhcPs -> R ()

530525p_hsExpr = p_hsExpr' N

531526

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

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

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

591586 -- expression is parenthesised.

592− indent =

587+ doIndent =

593588 case func of

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

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

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

597− L spn _ ->

598− if isOneLineSpan spn

599− then inci

600− else id

601− ub <- getLayout <&> \case

602− SingleLine -> useBraces

603− MultiLine -> id

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

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

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

592+ L spn _ -> isOneLineSpan spn

593+ ub <-

594+ getLayout <&> \case

595+ SingleLine -> useBraces

596+ MultiLine -> id

604597 ub $ do

605598 located func (p_hsExpr' s)

606599 breakpoint

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

608− indent $ do

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

601+ inciIf doIndent $ do

609602 unless (null initp) breakpoint

610603 located lastp p_hsExpr

611604 Hanging -> do

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

620613 breakpoint

621614 inci $ do

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

623621 located (hswc_body a) p_hsType

624622 OpApp NoExtField x op y -> do

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

626− p_exprOpTree True s (reassociateOpTree getOpName opTree)

624+ p_exprOpTree s (reassociateOpTree getOpName opTree)

627625 NegApp NoExtField e _ -> do

628626 txt "-"

629627 space

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

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

641639 unless (useRecordDot' && isRecordDot') breakpoint

642640 inci (located x p_hsExpr)

643− ExplicitTuple NoExtField args boxity -> do

641+ ExplicitTuple NoExtField args boxity ->

644642 let isSection = any (isMissing . unLoc) args

645643 isMissing = \case

646644 Missing NoExtField -> True

647645 _ -> False

648− let parens' =

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

649652 case boxity of

650653 Boxed -> parens

651654 Unboxed -> parensHash

652− if isSection

653− then

654− switchLayout [] . parens' s $

655− sep comma (located' p_hsTupArg) args

656− else

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

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

655+ in if isSection

656+ then

657+ switchLayout [] . parens' s $

658+ sep comma p_larg args

659+ else

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

661+ sep commaDel p_larg args

659662 ExplicitSum NoExtField tag arity e ->

660663 p_unboxedSum N tag arity (located e p_hsExpr)

661664 HsCase NoExtField e mgroup ->

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

677680 sepSemi

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

679682 (unLoc es)

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

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

681684 let p_parBody =

682685 sep

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

@@ -685,7 +688,7 @@ p_hsExpr' s = \case

685688 p_seqBody =

686689 sitcc

687690 . sep

688− (comma >> breakpoint)

691+ commaDel

689692 (located' (sitcc . p_stmt))

690693 stmts = init xs

691694 yield = last xs

@@ -707,7 +710,7 @@ p_hsExpr' s = \case

707710 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

708711 ExplicitList _ _ xs ->

709712 brackets s $

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

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

711714 RecordCon {..} -> do

712715 located rcon_con_name atom

713716 breakpoint

@@ -724,7 +727,7 @@ p_hsExpr' s = \case

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

725728 Nothing -> []

726729 inci . braces N $

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

730+ sep commaDel sitcc (fields <> dotdot)

728731 RecordUpd {..} -> do

729732 located rupd_expr p_hsExpr

730733 useRecordDot' <- useRecordDot

@@ -744,7 +747,7 @@ p_hsExpr' s = \case

744747 }

745748 inci . braces N $

746749 sep

747− (comma >> breakpoint)

750+ commaDel

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

749752 rupd_flds

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

@@ -762,7 +765,7 @@ p_hsExpr' s = \case

762765 breakpoint

763766 txt ".."

764767 FromThen from next -> brackets s $ do

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

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

766769 breakpoint

767770 txt ".."

768771 FromTo from to -> brackets s $ do

@@ -772,7 +775,7 @@ p_hsExpr' s = \case

772775 space

773776 located to p_hsExpr

774777 FromThenTo from next to -> brackets s $ do

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

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

776779 breakpoint

777780 txt ".."

778781 space

@@ -850,7 +853,7 @@ p_patSynBind PSB {..} = do

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

851854 unless (null xs) breakpoint

852855 braces N $

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

856+ sep commaDel (p_rdrName . recordPatSynPatVar) xs

854857 rhs

855858 InfixCon l r -> do

856859 switchLayout [getLoc l, getLoc r] $ do

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

946949 txt "!"

947950 located pat p_pat

948951 ListPat NoExtField pats ->

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

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

950953 TuplePat NoExtField pats boxing -> do

951954 let parens' =

952955 case boxing of

953956 Boxed -> parens S

954957 Unboxed -> parensHash S

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

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

956959 SumPat NoExtField pat tag arity ->

957960 p_unboxedSum S tag arity (located pat p_pat)

958961 ConPatIn pat details ->

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

968971 let f = \case

969972 Nothing -> txt ".."

970973 Just x -> located x p_pat_hsRecField

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

974+ inci . braces N . sep commaDel f $

972975 case dotdot of

973976 Nothing -> Just <$> fields

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

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

12281231 HsCase NoExtField _ _ -> Hanging

12291232 HsDo NoExtField DoExpr _ -> Hanging

12301233 HsDo NoExtField MDoExpr _ -> Hanging

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

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

1233− -- style.

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

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

1234+ OpApp NoExtField _ op y ->

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

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

1237+ _ -> Normal

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

12371239 HsProc NoExtField p _ ->

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

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

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

12591261 _ -> Nothing

12601262

1263+getOpNameStr :: RdrName -> String

1264+getOpNameStr = occNameString . rdrNameOcc

1265+

12611266p_exprOpTree ::

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

1263− Bool ->

12641267 -- | Bracket style to use

12651268 BracketStyle ->

12661269 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->

12671270 R ()

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

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

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

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

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

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

12721275 -- placement.

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

12881291 MultiLine -> case placement of

12891292 Hanging -> useBraces

12901293 Normal -> dontUseBraces

1291− gotDollar = case getOpName (unLoc op) of

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

1293− _ -> False

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

1295+ gotDollar = opNameStr == Just "$"

1296+ gotColon = opNameStr == Just ":"

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

12941298 lhs =

12951299 switchLayout [opTreeLoc x] $

1296− p_exprOpTree (not gotDollar) s x

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

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

1300+ p_exprOpTree s x

1301+ p_op = located op (opWrapper . p_hsExpr)

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

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

13001304 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

13011305 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

13021306 _ -> False

1307+ isDoBlock = \case

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

1309+ _ -> False

13031310 useRecordDot' <- useRecordDot

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

1305− if useRecordDot' && isRecordDot'

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

1319− space

1320− p_op

1321− breakpoint

1322− inci p_y

1323− else do

1324− ub lhs

1325− placeHanging placement $ do

1326− p_op

1311+ if

1312+ | gotColon -> do

1313+ lhs

1314+ space

1315+ p_op

1316+ case placement of

1317+ Hanging -> do

13271318 space

13281319 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

13291342

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

13311344isRecordDot ::

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

13361349 Bool

13371350isRecordDot op (RealSrcSpan ySpan) = case op of

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

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

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

13401353 _ -> False

13411354isRecordDot _ _ = False

13421355

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

1344−isDot :: RdrName -> Bool

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

1346−

13471356-- | Get annotations for the enclosing element.

13481357getEnclosingAnns :: R [AnnKeywordId]

13491358getEnclosingAnns = do

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

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

1111import Ormolu.Printer.Combinators

1212

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

14−

1514p_pat :: Pat GhcPs -> R ()

16−

1715p_hsExpr :: HsExpr GhcPs -> R ()

18−

1916p_hsSplice :: HsSplice GhcPs -> R ()

20−

2117p_stringLit :: String -> R ()

src/Ormolu/Printer/Meat/Declaration/Warning.hs+4−5

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

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

3333p_topLevelWarning fnames wtxt = do

3434 let (pragmaText, lits) = warningText wtxt

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

36− $ pragma pragmaText . inci

37− $ do

38− sep (comma >> breakpoint) p_rdrName fnames

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

36+ pragma pragmaText . inci $ do

37+ sep commaDel p_rdrName fnames

3938 breakpoint

4039 p_lits lits

4140

@@ -47,4 +46,4 @@ warningText = \case

4746p_lits :: [Located StringLiteral] -> R ()

4847p_lits = \case

4948 [l] -> atom l

50− ls -> brackets N $ sep (comma >> breakpoint) atom ls

49+ ls -> brackets N $ sep commaDel atom ls

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

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

9393 inci $ do

9494 let names :: [R ()]

9595 names = located' p_ieWrappedName <$> xs

96− parens N

97− $ sep (comma >> breakpoint) sitcc

98− $ case w of

96+ parens N . sep commaDel sitcc $

97+ case w of

9998 NoIEWildcard -> names

10099 IEWildcard n ->

101100 let (before, after) = splitAt n names

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

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

1111import Control.Monad

1212import qualified Data.Text as T

1313import GHC

14−import Ormolu.Imports

14+import Ormolu.Imports (normalizeImports)

1515import Ormolu.Parser.CommentStream

1616import Ormolu.Parser.Pragma

1717import Ormolu.Parser.Shebang

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

6969 txt "where"

7070 newline

7171 newline

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

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

7373 newline

7474 switchLayout (getLoc <$> hsmodDecls) $ do

7575 p_hsDecls Free hsmodDecls

src/Ormolu/Printer/Meat/Type.hs+10−14

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

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

6868 _ -> (f', knownArgs)

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

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

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

7171 located func p_hsType

7272 breakpoint

7373 inci $

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

9898 HsBoxedTuple -> parens N

9999 HsConstraintTuple -> parens N

100100 HsBoxedOrConstraintTuple -> parens N

101− in parens' $

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

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

103102 HsSumTy NoExtField xs ->

104103 parensHash N $

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

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

118117 HsStarTy NoExtField _ -> txt "*"

119118 HsKindSig NoExtField t k -> sitcc $ do

120119 located t p_hsType

121− space -- FIXME

122− txt "::"

123120 space

121+ txt "::"

122+ breakpoint

124123 inci (located k p_hsType)

125124 HsSpliceTy NoExtField splice -> p_hsSplice splice

126125 HsDocTy NoExtField t str ->

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

154153 case (p, xs) of

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

156155 _ -> return ()

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

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

158157 HsExplicitTupleTy NoExtField xs -> do

159158 txt "'"

160159 parens N $ do

161160 case xs of

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

163162 _ -> return ()

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

163+ sep commaDel (located' p_hsType) xs

165164 HsTyLit NoExtField t ->

166165 case t of

167166 HsStrTy (SourceText s) _ -> p_stringLit s

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

192191p_hsContext = \case

193192 [] -> txt "()"

194193 [x] -> located x p_hsType

195− xs ->

196− parens N $

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

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

198195

199196p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

200197p_hsTyVarBndr = \case

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

224221

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

226223p_conDeclFields xs =

227− braces N $

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

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

229225

230226p_conDeclField :: ConDeclField GhcPs -> R ()

231227p_conDeclField ConDeclField {..} = do

232228 mapM_ (p_hsDocString Pipe True) cd_fld_doc

233229 sitcc $

234230 sep

235− (comma >> breakpoint)

231+ commaDel

236232 (located' (p_rdrName . rdrNameFieldOcc))

237233 cd_fld_names

238234 space

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

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

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

276272 -- declarations.

277− HsParTy NoExtField $ noLoc $

273+ HsParTy NoExtField . noLoc $

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

279275 XTyVarBndr x -> noExtCon x

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

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

1616import qualified Data.Map.Strict as M

1717import Data.Maybe (fromMaybe, mapMaybe)

1818import GHC

19−import OccName (mkVarOcc)

19+import OccName (occNameString)

2020import Ormolu.Utils (unSrcSpan)

2121

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

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

5757reassociateOpTreeWith ::

5858 forall ty op.

5959 -- | Fixity map for operators

60− Map RdrName Fixity ->

60+ Map String Fixity ->

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

6262 (op -> Maybe RdrName) ->

6363 -- | Original 'OpTree'

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

6868 where

6969 fixityOf :: op -> Fixity

7070 fixityOf op = fromMaybe defaultFixity $ do

71− opName <- getOpName op

72− M.lookup opName fixityMap

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

72+ M.lookup s fixityMap

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

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

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

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

112112 -- | Operator tree

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

114114 -- | Fixity map

115− Map RdrName Fixity

115+ Map String Fixity

116116buildFixityMap getOpName opTree =

117117 addOverrides

118118 . M.fromList

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

120− . zip [1 ..]

120+ . zip [2 ..]

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

122122 . selectScores

123123 $ score opTree

124124 where

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

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

126126 addOverrides m =

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

128− in M.fromList

129− [ mk "$" 0,

130− mk "." 9

131− ]

132− `M.union` m

127+ M.fromList

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

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

130+ (".", fixity 100 InfixL)

131+ ]

132+ `M.union` m

133133 fixity = Fixity NoSourceText

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

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

135135 score (OpNode _) = []

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

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

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

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

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

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

144− opName <- getOpName (unLoc o)

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

145145 let s

146146 | le < ob = AtBeginning oc

147147 | oe < rb = AtEnd

148148 | otherwise = InBetween

149149 return $ (opName, s) : score r

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

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

151151 selectScores =

152152 L.sortOn snd

153153 . mapMaybe

src/Ormolu/Processing/Common.hs+1−1

@@ -20,7 +20,7 @@ data OrmoluState

2020

2121-- | Marker for the beginning of the region where Ormolu should be disabled.

2222startDisabling :: IsString s => s

23−startDisabling = "{- ORMOLU_DISABLING_START"

23+startDisabling = "{- ORMOLU_DISABLE_START"

2424

2525-- | Marker for the end of the region where Ormolu should be disabled.

2626endDisabling :: IsString s => s

src/Ormolu/Processing/Postprocess.hs+13−3

@@ -1,3 +1,6 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE ViewPatterns #-}

14-- | Postprocessing for the results of printing.

25module Ormolu.Processing.Postprocess

36 ( postprocess,

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

1013import qualified Ormolu.Processing.Cpp as Cpp

1114

1215-- | Postprocess output of the formatter.

13−postprocess :: Text -> Text

14−postprocess =

16+postprocess ::

17+ -- | Desired indentation level

18+ Int ->

19+ -- | Input to process

20+ Text ->

21+ Text

22+postprocess indent =

1523 T.unlines

24+ . fmap indentLine

1625 . fmap Cpp.unmaskLine

1726 . filter (not . magicComment)

1827 . T.lines

1928 where

20− magicComment x =

29+ magicComment (T.stripStart -> x) =

2130 x == startDisabling || x == endDisabling

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

src/Ormolu/Processing/Preprocess.hs+4−4

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

1111import Control.Monad

1212import Data.Char (isSpace)

1313import qualified Data.List as L

14−import Data.Maybe (isJust)

15−import Data.Maybe (maybeToList)

14+import Data.Maybe (isJust, maybeToList)

1615import FastString

1716import Ormolu.Config (RegionDeltas (..))

1817import Ormolu.Parser.Shebang (isShebang)

@@ -143,7 +142,8 @@ magicComment ::

143142 -- | Whether or not the two strings watch

144143 Bool

145144magicComment expected s0 = isJust $ do

146− s1 <- dropWhile isSpace <$> L.stripPrefix "{-" s0

147− s2 <- dropWhile isSpace <$> L.stripPrefix expected s1

145+ let trim = dropWhile isSpace

146+ s1 <- trim <$> L.stripPrefix "{-" (trim s0)

147+ s2 <- trim <$> L.stripPrefix expected s1

148148 s3 <- L.stripPrefix "-}" s2

149149 guard (all isSpace s3)

src/Ormolu/Utils.hs+15−1

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

11{-# LANGUAGE LambdaCase #-}

22{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE ViewPatterns #-}

45-- | Random utilities used by the code.

56module Ormolu.Utils

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

1516 separatedByBlank,

1617 separatedByBlankNE,

1718 onTheSameLine,

19+ removeIndentation,

1820 )

1921where

2022

23+import Data.Char (isSpace)

2124import Data.List (dropWhileEnd)

22−import qualified Data.List.NonEmpty as NE

2325import Data.List.NonEmpty (NonEmpty (..))

26+import qualified Data.List.NonEmpty as NE

2427import Data.Maybe (fromMaybe)

2528import Data.Text (Text)

2629import qualified Data.Text as T

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

139142onTheSameLine :: SrcSpan -> SrcSpan -> Bool

140143onTheSameLine a b =

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