master..a44fdea · ormolu

git.iko.soy/ormolu

106 files changed+446−997

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

6+ - label: Build and test with GHC 8.8.3

77 command: |

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

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

99 timeout: 100

1010 - label: Build and test with GHC 8.10.1

1111 command: |

.github/workflows/binaries.ymldeleted−39

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

1−name: Build binaries

2−on:

3− release:

4− types: [published]

5−jobs:

6− build:

7− strategy:

8− fail-fast: false

9− matrix:

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

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

12− steps:

13− - uses: actions/checkout@v2

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

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

16− with:

17− ghc-version: '8.10.1'

18− cabal-version: '3.2'

19− - name: Build Linux binary

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

21− run: |

22− docker run \

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

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

25− bash .github/workflows/build.sh

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

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

28− shell: bash

29− run: |

30− cabal build exe:ormolu

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

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

33− env:

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

35− with:

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

37− asset_path: ormolu

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

39− asset_content_type: application/octet-stream

.github/workflows/build.shdeleted−7

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

1−set -e

2−

3−cabal update

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

5−

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

7−strip -s ormolu

CHANGELOG.md+1−51

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

11## Unreleased

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

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

5−

6−## Ormolu 0.1.2.0

7−

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

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

10−

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

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

13−

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

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

16−

17−## Ormolu 0.1.1.0

18−

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

20− combined/eliminated intelligently.

21−

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

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

24−

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

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

27− disabled part is still syntactically correct. [Issue

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

29−

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

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

32−

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

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

35−

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

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

38−

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

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

41−

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

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

44−

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

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

47−

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

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

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

51−

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

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

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

544

555## Ormolu 0.1.0.0

566

README.md+11−21

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

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

4545

4646```console

4747$ cat stack.yaml

48−resolver: lts-16.0

48+resolver: lts-14.3

4949packages:

5050- '.'

5151

52−$ stack build # to build

53−$ stack install # to install

52+$ stack build

5453```

5554

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

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

130129 criterion than just being valid Haskell modules.

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

132131

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+

133140## Running on Hackage

134141

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

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

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

145152into Ormolu).

146153

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−

163154## Contributing

164155

165156See [CONTRIBUTING.md][contributing].

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

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

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

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

app/Main.hs+13−23

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

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

1010import Control.Monad

11−import Data.Bool (bool)

1211import Data.Either (lefts)

1312import Data.List (intercalate, sort)

1413import qualified Data.Text.IO as TIO

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

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

6261 exitWith (ExitFailure 101)

6362 Just inputFile -> do

64− originalInput <- TIO.readFile inputFile

65− formattedInput <- ormoluFile config inputFile

63+ r <- ormoluFile config inputFile

6664 case mode of

6765 Stdout ->

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

66+ TIO.putStr r

67+ InPlace ->

68+ TIO.writeFile inputFile r

7569 Check -> do

76− when (formattedInput /= originalInput) $

70+ r' <- TIO.readFile inputFile

71+ when (r /= r') $

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

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

7974 -- 'notImplemented'.

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

139134optsParser :: Parser Opts

140135optsParser =

141136 Opts

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

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

154144 <*> configParser

155145 <*> (many . strArgument . mconcat)

156146 [ metavar "FILE",

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

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

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

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

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

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

1−clientFunc1 :: SomeType1

2−clientFunc2 :: SomeType2

3−clientFunc3 :: SomeType3

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

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

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

1−clientFunc1 :: SomeType1

2−clientFunc2 :: SomeType2

3−clientFunc3 :: SomeType3

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

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

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

1−foo

2− bar =

3− body

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

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

1−foo

2− bar =

3− body

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

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

1−foo =

2− let x = 10

3−

4− y = 11

5− z = 12

6− in x + y + z

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

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

1−foo =

2− let

3−

4− x = 10

5−

6− y = 11

7− z = 12

8−

9− in x + y + z

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

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

1−foo = x + y + z

2− where

3− x = 10

4−

5− y = 11

6− z = 12

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

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

1−foo = x + y + z

2− where

3−

4− x = 10

5−

6− y = 11

7− z = 12

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

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

11{-# LANGUAGE ImplicitParams #-}

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

4−sortBy = undefined

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

76sort = sortBy ?cmp

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

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

11{-# LANGUAGE ImplicitParams #-}

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

4−sortBy = undefined

5−

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

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

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

1717 `catch` \case

1818 a -> a

1919

20−foo =

21− bar

22− ++ case foo of

23− a -> a

20+foo = bar

21+ ++ case foo of

22+ a -> a

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

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

11lenses =

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− # []

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+ # []

109

1110foo =

1211 a

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

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

1−foo =

2− testCase "Foo" testFoo :

3− testCase "Bar" testBar :

4− testCase "Baz" testBaz :

5− []

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

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

1−foo =

2− testCase "Foo" testFoo :

3− testCase "Bar" testBar :

4− testCase "Baz" testBaz :

5− []

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

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

1−instance A.ToJSON UpdateTable where

2− toJSON a =

3− A.object $

4− "TableName" .= updateTableName a :

5− "ProvisionedThroughput" .= updateProvisionedThroughput a :

6− case updateGlobalSecondaryIndexUpdates a of

7− [] -> []

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

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

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

1−instance A.ToJSON UpdateTable where

2− toJSON a = A.object

3− $ "TableName" .= updateTableName a

4− : "ProvisionedThroughput" .= updateProvisionedThroughput a

5− : case updateGlobalSecondaryIndexUpdates a of

6− [] -> []

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

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

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

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

2−getPath tree t =

3− t :

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

5− Nothing -> []

6− Just parent -> getPath tree parent

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

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

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

2−getPath tree t = t :

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

4− Nothing -> []

5− Just parent -> getPath tree parent

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

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

1−foo =

2− reportSDoc "tc.cc" 30 $

3− sep $ do

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

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

6−

7−foo =

8− reportSDoc "tc.cc" 30 $

9− sep $ do

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

11− do

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

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

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

1−foo =

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

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

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

5−

6−foo =

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

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

9− do

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

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

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

1−{-# LANGUAGE TemplateHaskell #-}

2−{-# LANGUAGE TypeApplications #-}

3−

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

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

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

1−{-# LANGUAGE TemplateHaskell #-}

2−{-# LANGUAGE TypeApplications #-}

3−

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

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

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

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

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

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

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

5−import Foo5 (Bar5 (x1))

6−import Foo6 (Bar6 (..))

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

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

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

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

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

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

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

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

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

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

11import qualified MegaModule as M

2− ( Either,

2+ ( (<<<),

3+ (>>>),

4+ Either,

35 Maybe (Just, Nothing),

46 MaybeT (..),

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

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

68 MonadBaseControl,

79 join,

810 liftIO,

911 void,

10− (<<<),

11− (>>>),

1212 )

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

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

11import qualified MegaModule as M

22 ( -- (1)

3− -- (2)

4− Either, -- (3)

5− (<<<),

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

64 (>>>),

5+ Either, -- (3)

76 )

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

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

1−import Foo

2−import Foo (bar, foo)

3−import Foo as F

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

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

1−import Foo

2−import Foo (foo)

3−import Foo (bar)

4−import Foo as F

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

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

1−import "bar" Foo (bar)

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

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

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

1−import "foo" Foo (foo)

2−import "bar" Foo (bar)

3−import "foo" Foo (baz)

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

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

1−import Foo hiding (bar4, foo2)

2−import qualified Foo (bar3, foo1)

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

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

1−import qualified Foo (foo1)

2−import Foo hiding (foo2)

3−import qualified Foo (bar3)

4−import Foo hiding (bar4)

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

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

11import qualified MegaModule as M

2− ( Either,

2+ ( (<<<),

3+ (>>>),

4+ Either,

35 Monad

4− ( return,

5− (>>),

6− (>>=)

6+ ( (>>),

7+ (>>=),

8+ return

79 ),

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

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

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

43import qualified Prelude

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

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

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

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)

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

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

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

5−import qualified Data.Text as T

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

@@ -1 +0,0 @@

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

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

@@ -1 +0,0 @@

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

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

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

99 -- | Foo

1010 Int ->

1111 Int

12+

1213foo ::

1314 Foo a =>

1415 -- | Foo

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

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

1−module Main (main) where

2−

3−-- | Foo.

4−

5−-- Bar

6−main :: IO ()

7−main = return ()

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

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

1−module Main (main) where

2−

3−{- | Foo. -}

4−-- Bar

5−main :: IO ()

6−main = return ()

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

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

1−data T

2− = {-

3−

4− some multi-line comment

5−

6− with empty lines

7−

8− -}

9− A

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

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

1−data T

2− = {-

3−

4− some multi-line comment

5−

6− with empty lines

7−

8− -}

9− A

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

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

11ffff, ffffffff :: Natural

23#ifdef HASKELL_ZIP_DEV_MODE

34ffff = 200

45ffffffff = 5000

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

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

1−foo =

2− {- ORMOLU_DISABLE -}

3− testCase "Foo" testFoo :

4− testCase "Bar" testBar :

5− testCase "Baz" testBaz :

6− {- ORMOLU_ENABLE -}

7− []

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

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

1−foo =

2− {- ORMOLU_DISABLE -}

3− testCase "Foo" testFoo :

4− testCase "Bar" testBar :

5− testCase "Baz" testBaz :

6− {- ORMOLU_ENABLE -}

7− []

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

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

1−{-# LANGUAGE AllowAmbiguousTypes #-}

2−{-# LANGUAGE ConstraintKinds #-}

3−-- TODO: Fix and delete this pragma

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

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

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

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

2−{-# LANGUAGE AllowAmbiguousTypes #-}

3−{-# LANGUAGE ConstraintKinds #-}

default.nix+16−17

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

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

2−, system ? builtins.currentSystem

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

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

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

43}:

65let

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

1716 };

1817 ormoluOverlay = self: super: {

1918 "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+ } {});

2025 };

2126 ormolize = import ./nix/ormolize {

2227 inherit pkgs;

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

2833 "distributed-process"

2934 "esqueleto"

3035 "fay"

31− "hlint"

3236 "idris"

3337 "intero"

3438 "leksah"

39+ "lens"

3540 "pandoc"

3641 "pipes"

37− "postgrest"

3842 "purescript"

39− "tensorflow"

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

43+ ];

4144 ormolizedPackages = doCheck:

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

4346 package = p;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

140143 ormolu --check-idempotence --mode inplace --start-line 6 --end-line 8 result-6-8.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

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

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

145146 '';

146147 checkPhase = ''

147148 echo result-all-implicit.hs

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

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

157158 echo result-6-8.hs

158159 diff --color=always expected-result-6-8.hs result-6-8.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

160+ echo result-9-13.hs

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

163162 '';

164163 installPhase = ''

165164 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>:1602:17

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

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

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

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

expected-failures/hlint.txtdeleted−11

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

1−Formatting is not idempotent:

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

3− before: "DoRec , -} Recursive"

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

5−Please, consider reporting the bug.

6−

7−Formatting is not idempotent:

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

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

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

11−Please, consider reporting the bug.

expected-failures/idris.txt+4

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

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.

59The GHC parser (in Haddock mode) failed:

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

711 parse error on input `@'

expected-failures/intero.txt+1−1

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

11Formatting is not idempotent:

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

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

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

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

77 before: ".softbreak <$ endlin"

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

99Please, consider reporting the bug.

expected-failures/postgrest.txtdeleted−5

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

1−Formatting is not idempotent:

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

3− before: " || -- clients"

4− after: " || ( origin ="

5−Please, consider reporting the bug.

expected-failures/purescript.txt+2−2

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

11The GHC parser (in Haddock mode) failed:

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

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

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:99:1-22

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

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

99Perhaps you meant to use PatternSynonyms?

1010

expected-failures/tensorflow.txtdeleted−7

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

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

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

3− parse error on input `->'

4−

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

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

7− parse error on input `import'

nix/nixpkgs/default.nix+3−7

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

1−{ system ? builtins.currentSystem }:

21let

3− rev = "32b46dd897ab2143a609988a04d87452f0bbef59";

4− sha256 = "1gzfrpjnr1bz9zljsyg3a4zrhk8r927sz761mrgcg56dwinkhpjk";

2+ rev = "807ca93fadd5197c2260490de0c76e500562dc05";

3+ sha256 = "10yq8bnls77fh3pk5chkkb1sv5lbdgyk1rr2v9xn71rr1k2x563p";

54 nixpkgs = builtins.fetchTarball {

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

76 inherit sha256;

87 };

9− pkgs = import nixpkgs {

10− inherit system;

11− config.allowUnfree = true;

12− };

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

139in pkgs

ormolu.cabal+4−5

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

11cabal-version: 1.18

22name: ormolu

3−version: 0.1.2.0

3+version: 0.1.0.0

44license: BSD3

55license-file: LICENSE.md

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

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

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

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 && <2.0,

122+ dlist >=0.8 && <0.9,

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.17,

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

148148 ormolu -any,

149149 text >=0.2 && <1.3

150150

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

156155

157156 else

158157 ghc-options: -O2 -Wall -rtsopts

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

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

1−{-# LANGUAGE LambdaCase #-}

2−

3−module Foo (

4− foo, bar, baz) where

5−

6−foo :: Int

7−foo = 5

8−

9−bar :: Int -> Int

10−bar = \case

11− 0 -> foo

12− x -> x - foo

13−

14−baz :: Int -> Int

15−baz = gege

16− where

17− gege = 1 + 2

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

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

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

66foo :: Int

77foo = 5

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

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

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

66foo :: Int

77foo = 5

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

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

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

66foo :: Int

77foo = 5

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

33module Foo

44 ( foo,

55 bar,

6− baz,

76 )

87where

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

1413bar = \case

1514 0 -> foo

1615 x -> x - foo

17−

18−baz :: Int -> Int

19−baz = gege

20− where

21− gege = 1 + 2

region-tests/src.hs+1−6

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

11{-# LANGUAGE LambdaCase #-}

33module Foo (

4− foo, bar, baz) where

4+ foo, bar) where

66foo :: Int

77foo = 5

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

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

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

2−, system ? builtins.currentSystem

3−}:

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

53(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 (normalizeImports)

17+import Ormolu.Imports (sortImports)

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

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

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

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

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

55-- | Manipulations on import lists.

66module Ormolu.Imports

7− ( normalizeImports,

7+ ( sortImports,

88 )

99where

1010

1111import Data.Bifunctor

12−import Data.Char (isAlphaNum)

1312import Data.Function (on)

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)

13+import Data.Generics (gcompare)

14+import Data.List (nubBy, sortBy)

1815import GHC hiding (GhcPs, IE)

1916import GHC.Hs.Extension

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

21−import Ormolu.Utils (notImplemented, showOutputable)

18+import Ormolu.Utils (notImplemented)

2219

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

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)

3024 where

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

32− L

33− l

25+ sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs

26+ sortImportLists = \case

27+ ImportDecl {..} ->

3428 ImportDecl

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

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

3630 ..

3731 }

38− g _ = notImplemented "XImportDecl"

32+ XImportDecl x -> noExtCon x

3933

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

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

9142 where

92− isPrelude = moduleNameString moduleName == "Prelude"

93− moduleName = unLoc ideclName

94−importId _ = notImplemented "XImportDecl"

43+ n0 = unLoc (ideclName m0)

44+ n1 = unLoc (ideclName m1)

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

9546

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

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)

15153

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)

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

15660

157−instance Ord IEWrappedNameOrd where

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

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

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

63+compareLIE = compareIewn `on` getIewn . unLoc

15964

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

161−getIewn :: IE GhcPs -> IEWrappedNameOrd

66+getIewn :: IE GhcPs -> IEWrappedName RdrName

16267getIewn = \case

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)

68+ IEVar NoExtField x -> unLoc x

69+ IEThingAbs NoExtField x -> unLoc x

70+ IEThingAll NoExtField x -> unLoc x

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

16772 IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"

16873 IEGroup NoExtField _ _ -> notImplemented "IEGroup"

16974 IEDoc NoExtField _ -> notImplemented "IEDoc"

17075 IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"

17176 XIE x -> noExtCon x

17277

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

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

175−compareLIewn = compareIewn `on` unLoc

176−

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

17879compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering

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

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

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

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

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

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

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

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

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

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

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

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

src/Ormolu/Parser.hs+3−5

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

35+import Ormolu.Utils (incSpanLine)

3636import qualified Panic as GHC

3737import qualified Parser as GHC

3838import qualified StringBuffer as GHC

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

5151 Either (SrcSpan, String) ParseResult

5252 )

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

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

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

5555 preprocess path rawInput cfgRegion

56− (input, indent) = removeIndentation indentedInput

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

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

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

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

111110 prImportQualifiedPost =

112111 GHC.xopt ImportQualifiedPost dynFlags,

113112 prLiteralPrefix = T.pack literalPrefix,

114− prLiteralSuffix = T.pack literalSuffix,

115− prIndent = indent

113+ prLiteralSuffix = T.pack literalSuffix

116114 }

117115 return (warnings, r)

118116

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

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

2727import qualified Lexer as GHC

2828import Ormolu.Parser.Pragma

2929import Ormolu.Parser.Shebang

30−import Ormolu.Processing.Common

31−import Ormolu.Utils (onTheSameLine, showOutputable)

30+import Ormolu.Utils (showOutputable)

3231import SrcLoc

3332

3433----------------------------------------------------------------------------

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

110109 Nothing -> s :| []

111110 Just (x :| xs) ->

112111 let getIndent y =

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

112+ if all isSpace y

114113 then startIndent

115114 else length (takeWhile isSpace y)

116115 n = minimum (startIndent : fmap getIndent xs)

117− removeIndent y =

118− if y == endDisabling

119− then y

120− else drop n y

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

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

122117 else s :| []

123118 (atomsBefore, ls') =

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

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

150145

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

152147extractStackHeader ::

153− -- | Comment stream to analyze

154148 [RealLocated String] ->

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

156150extractStackHeader = \case

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

166160

167161-- | Extract pragmas and their associated comments.

168162extractPragmas ::

169− -- | Input

170163 String ->

171− -- | Comment stream to analyze

172164 [RealLocated String] ->

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

174166extractPragmas input = go initialLs id id

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

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

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

184176 Just pragma ->

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

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

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

196179

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

198181unAnnotationComment :: GHC.AnnotationComment -> Maybe String

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

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

3535 -- | Literal prefix

3636 prLiteralPrefix :: Text,

3737 -- | Literal suffix

38− prLiteralSuffix :: Text,

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

40− prIndent :: Int

38+ prLiteralSuffix :: Text

4139 }

4240

4341-- | 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 prIndent $

26+ postprocess $

2727 runR

2828 ( p_hsModule

2929 prStackHeader

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

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

2121 space,

2222 newline,

2323 inci,

24− inciIf,

2524 located,

2625 located',

2726 switchLayout,

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

5251

5352 -- ** Literals

5453 comma,

55− commaDel,

5654 equals,

5755

5856 -- ** Stateful markers

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

7472----------------------------------------------------------------------------

7573-- Basic

7674

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−

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

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

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

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

185174 xs' ->

186175 if ub

187176 then do

188− txt "{"

189− space

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

191− space

192− txt "}"

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

177+ txt "{ "

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

179+ txt " }"

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

194181 multiLine =

195182 sep newline (dontUseBraces . f) xs

196183

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

203190 N

204191 | -- | Shifted one level

205192 S

206− deriving (Eq, Show)

207193

208194-- | Surround given entity by backticks.

209195backticks :: R () -> R ()

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

280266 then newline >> inci m

281267 else space >> sitcc m

282268 newline

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

269+ case style of

270+ N -> txt close

271+ S -> inci (txt close)

284272

285273----------------------------------------------------------------------------

286274-- Literals

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

289277comma :: R ()

290278comma = txt ","

291279

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

293−commaDel :: R ()

294−commaDel = comma >> breakpoint

295−

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

297281equals :: R ()

298282equals = interferingTxt "="

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

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

154154 -- | Last printed comment span

155155 Maybe SpanMark ->

156156 Bool

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

158157needsNewlineBefore l mlastMark =

159158 case spanMarkSpan <$> mlastMark of

160159 Nothing -> False

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

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

240239 not (hasAtomsBefore comment)

241240 && ( case mlastMark of

242− Just (HaddockSpan _ _) -> False

241+ Just (HaddockSpan _ spn) ->

242+ srcSpanEndLine spn + 1 == srcSpanStartLine l

243243 Just (CommentSpan spn) ->

244244 srcSpanEndLine spn + 1 == srcSpanStartLine l

245245 _ -> False

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

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

220220 R ()

221221txt = spit SimpleText

222222

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.

223+-- |

225224interferingTxt ::

226225 -- | 'Text' to output

227226 Text ->

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

244243 -- | 'Text' to output

245244 Text ->

246245 R ()

247−spit _ "" = return ()

248246spit stype text = do

249247 requestedDel <- R (gets scRequestedDelimiter)

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

118− Bool ->

117+ -- | Indentation-bumping wrapper

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

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

120120 R () ->

121121 -- | How to print the arguments

122122 [R ()] ->

123123 R ()

124−p_infixDefHelper isInfix indentArgs name args =

124+p_infixDefHelper isInfix inci' name args =

125125 case (isInfix, args) of

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

127127 let parens' =

@@ -131,18 +131,18 @@ p_infixDefHelper isInfix indentArgs 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) . inciIf indentArgs $ do

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

139139 breakpoint

140140 sitcc (sep breakpoint sitcc ps)

141141 (_, ps) -> do

142142 name

143143 unless (null ps) $ do

144144 breakpoint

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

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

146146

147147-- | Print a Haddock.

148148p_hsDocString ::

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

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

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)

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)

6463 where

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

6665 renderGroupWithPrev prev curr =

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

8584 isHaddock _ = False

8685

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

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

8991groupDecls [] = []

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

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

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

98100 let relevantToHdr = groupedDecls header current

99101 relevantToPrev = groupedDecls previous current

100− isDeclSeries = declSeries previous current

101− in isDeclSeries || relevantToHdr || relevantToPrev

102+ in relevantToHdr || relevantToPrev

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

103104

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

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

195196 (_, DocPrev) -> True

196197 _ -> False

197198

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−

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

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

212201 where

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

299288patSigRdrNames _ = Nothing

300289

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

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

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

306294warnSigRdrNames _ = Nothing

307295

308296patBindNames :: Pat GhcPs -> [RdrName]

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

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

99import Ormolu.Printer.Meat.Common

1010

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

12+

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

61+ inci

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

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

8686

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

8888p_funDep (before, after) = do

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

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

4141 inci $

4242 p_infixDefHelper

4343 (isInfix fixity)

44− True

44+ inci

4545 (p_rdrName name)

4646 (located' p_hsType <$> tpats)

4747 case dd_kindSig of

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

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

8385 unless (null $ unLoc dd_derivs) breakpoint

8486 inci . located dd_derivs $ \xs ->

8587 sep newline (located' p_hsDerivingClause) xs

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

104106 (c : cs) -> do

105107 p_rdrName c

106108 unless (null cs) . inci $ do

107− commaDel

108− sep commaDel p_rdrName cs

109+ comma

110+ breakpoint

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

112+ space

109113 inci $ do

110− space

111114 txt "::"

112115 let interArgBreak =

113116 if hasDocStrings (unLoc con_res_ty)

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

155158 RecCon l -> do

156159 p_rdrName con_name

157160 breakpoint

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

161+ let inci' =

162+ if singleConstRec

163+ then id

164+ else inci

165+ inci' (located l p_conDeclFields)

159166 InfixCon x y -> do

160167 located x p_hsType

161168 breakpoint

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

206213 xs ->

207214 parens N $

208215 sep

209− commaDel

216+ (comma >> breakpoint)

210217 (sitcc . located' p_hsType . hsib_body)

211218 xs

212219 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 commaDel (sitcc . located' p_hsType) ts

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

2020 XDefaultDecl x -> noExtCon x

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

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

3232 txt "instance"

3333 breakpoint

3434 match_overlap_mode deriv_overlap_mode breakpoint

35− inciIf toIndent typesAfterInstance

35+ if toIndent

36+ then inci typesAfterInstance

37+ else typesAfterInstance

3638 txt "deriving"

3739 space

3840 case deriv_strategy of

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

8890 unless (null allDecls) $ do

8991 breakpoint

9092 txt "where"

91− unless (null allDecls) . inci $ do

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

93− breakpoint

94− dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

93+ unless (null allDecls)

94+ $ inci

95+ $ do

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

97+ breakpoint

98+ dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

9599 XHsImplicitBndrs x -> noExtCon x

96100 XClsInstDecl x -> noExtCon x

97101

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

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

1414import BasicTypes

1515import BooleanFormula

1616import Control.Monad

17+import Data.Bool (bool)

1718import GHC

1819import Ormolu.Printer.Combinators

1920import Ormolu.Printer.Meat.Common

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

4748 p_rdrName n

4849 if null ns

4950 then p_typeAscription hswc

50− else inciIf indentTail $ do

51− commaDel

52− sep commaDel p_rdrName ns

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

5457

5558p_typeAscription ::

5659 LHsSigWcType GhcPs ->

5760 R ()

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

61+p_typeAscription HsWC {..} = do

5962 space

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

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

6670p_typeAscription (XHsWildCardBndrs x) = noExtCon x

6771

6872p_patSynSig ::

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

104108 space

105109 atom n

106110 space

107− sitcc $ sep commaDel p_rdrName names

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

108112 XFixitySig x -> noExtCon x

109113

110114p_inlineSig ::

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

143147 space

144148 txt "::"

145149 breakpoint

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

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

147151

148152p_inlineSpec :: InlineSpec -> R ()

149153p_inlineSpec = \case

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

187191 And xs ->

188192 sitcc $

189193 sep

190− commaDel

194+ (comma >> breakpoint)

191195 (located' p_booleanFormula)

192196 xs

193197 Or xs ->

194198 sitcc $

195199 sep

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

200+ (breakpoint >> txt "| ")

197201 (located' p_booleanFormula)

198202 xs

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

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

207211p_completeSig cs' mty =

208212 located cs' $ \cs ->

209213 pragma "COMPLETE" . inci $ do

210− sep commaDel p_rdrName cs

214+ sep (comma >> breakpoint) p_rdrName cs

211215 forM_ mty $ \ty -> do

212216 space

213217 txt "::"

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

224228p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()

225229p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do

226230 txt "type"

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

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

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

31+ inci

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

34+ inci

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

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

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

9797 switchLayout famLhsSpn $

9898 p_infixDefHelper

9999 (isInfix feqn_fixity)

100− True

100+ inci

101101 (p_rdrName feqn_tycon)

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

103103 space

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

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

11{-# LANGUAGE LambdaCase #-}

2−{-# LANGUAGE MultiWayIf #-}

32{-# LANGUAGE OverloadedStrings #-}

43{-# LANGUAGE RecordWildCards #-}

54{-# LANGUAGE TypeApplications #-}

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

2221import Data.Data hiding (Infix, Prefix)

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

2423import Data.List (intersperse, sortOn)

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

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

2625import qualified Data.List.NonEmpty as NE

2726import Data.Text (Text)

2827import qualified Data.Text as Text

2928import GHC

30−import OccName (occNameString)

29+import OccName (mkVarOcc)

3130import Ormolu.Printer.Combinators

3231import Ormolu.Printer.Internal

3332import Ormolu.Printer.Meat.Common

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

6160 -- should use it and avoid bumping one level

6261 -- of indentation

6362 Hanging

64− deriving (Eq, Show)

63+ deriving (Eq)

6564

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

6766p_valDecl = \case

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

180179 NoSrcStrict -> return ()

181180 SrcStrict -> txt "!"

182181 SrcLazy -> txt "~"

183− indentBody <- case NE.nonEmpty m_pats of

184− Nothing ->

185− False <$ case style of

186− Function name -> p_rdrName name

187− _ -> return ()

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

183+ Nothing -> id <$ case style of

184+ Function name -> p_rdrName name

185+ _ -> return ()

188186 Just ne_pats -> do

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)

187+ let combinedSpans =

188+ combineSrcSpans' $

189+ getLoc <$> ne_pats

190+ inci' =

191+ if isOneLineSpan combinedSpans

192+ then id

193+ else inci

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

200+ inci'

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 indentBody

215+ return inci'

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

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

256+ inci' $ 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 commaDel (sitcc . located' p_stmt) xs)

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

288288 space

289289 inci $ case style of

290290 EqualSign -> equals

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

353353 HsCmdTop NoExtField cmd -> located cmd p_hsCmd

354354 XCmdTop x -> noExtCon x

355355

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

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

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

365358 case getLoc l of

366359 UnhelpfulSpan _ -> f x

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

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

472465p_hsLocalBinds = \case

473466 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

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

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

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

477478 br <- layoutToBraces <$> getLayout

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)

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)

492491 HsValBinds NoExtField _ -> notImplemented "HsValBinds"

493492 HsIPBinds NoExtField (IPBinds NoExtField xs) ->

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

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

521520 else Normal

522521 placeHanging placement (located hsRecFieldArg p_hsExpr)

523522

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+

524529p_hsExpr :: HsExpr GhcPs -> R ()

525530p_hsExpr = p_hsExpr' N

526531

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

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

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

586591 -- expression is parenthesised.

587− doIndent =

592+ indent =

588593 case func of

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

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

597604 ub $ do

598605 located func (p_hsExpr' s)

599606 breakpoint

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

601− inciIf doIndent $ do

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

608+ indent $ do

602609 unless (null initp) breakpoint

603610 located lastp p_hsExpr

604611 Hanging -> do

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

613620 breakpoint

614621 inci $ do

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

621623 located (hswc_body a) p_hsType

622624 OpApp NoExtField x op y -> do

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

624− p_exprOpTree s (reassociateOpTree getOpName opTree)

626+ p_exprOpTree True s (reassociateOpTree getOpName opTree)

625627 NegApp NoExtField e _ -> do

626628 txt "-"

627629 space

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

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

639641 unless (useRecordDot' && isRecordDot') breakpoint

640642 inci (located x p_hsExpr)

641− ExplicitTuple NoExtField args boxity ->

643+ ExplicitTuple NoExtField args boxity -> do

642644 let isSection = any (isMissing . unLoc) args

643645 isMissing = \case

644646 Missing NoExtField -> True

645647 _ -> False

646− p_arg = \case

647− Present NoExtField x -> located x p_hsExpr

648− Missing NoExtField -> pure ()

649− XTupArg x -> noExtCon x

650− p_larg = sitcc . located' p_arg

651− parens' =

648+ let parens' =

652649 case boxity of

653650 Boxed -> parens

654651 Unboxed -> parensHash

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

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

662659 ExplicitSum NoExtField tag arity e ->

663660 p_unboxedSum N tag arity (located e p_hsExpr)

664661 HsCase NoExtField e mgroup ->

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

680677 sepSemi

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

682679 (unLoc es)

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

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

684681 let p_parBody =

685682 sep

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

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

688685 p_seqBody =

689686 sitcc

690687 . sep

691− commaDel

688+ (comma >> breakpoint)

692689 (located' (sitcc . p_stmt))

693690 stmts = init xs

694691 yield = last xs

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

710707 TransStmtCtxt _ -> notImplemented "TransStmtCtxt"

711708 ExplicitList _ _ xs ->

712709 brackets s $

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

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

714711 RecordCon {..} -> do

715712 located rcon_con_name atom

716713 breakpoint

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

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

728725 Nothing -> []

729726 inci . braces N $

730− sep commaDel sitcc (fields <> dotdot)

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

731728 RecordUpd {..} -> do

732729 located rupd_expr p_hsExpr

733730 useRecordDot' <- useRecordDot

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

747744 }

748745 inci . braces N $

749746 sep

750− commaDel

747+ (comma >> breakpoint)

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

752749 rupd_flds

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

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

765762 breakpoint

766763 txt ".."

767764 FromThen from next -> brackets s $ do

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

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

769766 breakpoint

770767 txt ".."

771768 FromTo from to -> brackets s $ do

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

775772 space

776773 located to p_hsExpr

777774 FromThenTo from next to -> brackets s $ do

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

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

779776 breakpoint

780777 txt ".."

781778 space

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

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

854851 unless (null xs) breakpoint

855852 braces N $

856− sep commaDel (p_rdrName . recordPatSynPatVar) xs

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

857854 rhs

858855 InfixCon l r -> do

859856 switchLayout [getLoc l, getLoc r] $ do

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

949946 txt "!"

950947 located pat p_pat

951948 ListPat NoExtField pats ->

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

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

953950 TuplePat NoExtField pats boxing -> do

954951 let parens' =

955952 case boxing of

956953 Boxed -> parens S

957954 Unboxed -> parensHash S

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

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

959956 SumPat NoExtField pat tag arity ->

960957 p_unboxedSum S tag arity (located pat p_pat)

961958 ConPatIn pat details ->

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

971968 let f = \case

972969 Nothing -> txt ".."

973970 Just x -> located x p_pat_hsRecField

974− inci . braces N . sep commaDel f $

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

975972 case dotdot of

976973 Nothing -> Just <$> fields

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

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

12311228 HsCase NoExtField _ _ -> Hanging

12321229 HsDo NoExtField DoExpr _ -> Hanging

12331230 HsDo NoExtField MDoExpr _ -> Hanging

1234− OpApp NoExtField _ op y ->

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

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

1237− _ -> Normal

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)

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

12391237 HsProc NoExtField p _ ->

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

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

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

12611259 _ -> Nothing

12621260

1263−getOpNameStr :: RdrName -> String

1264−getOpNameStr = occNameString . rdrNameOcc

1265−

12661261p_exprOpTree ::

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

1263+ Bool ->

12671264 -- | Bracket style to use

12681265 BracketStyle ->

12691266 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->

12701267 R ()

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

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

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

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

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

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

12751272 -- placement.

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

12911288 MultiLine -> case placement of

12921289 Hanging -> useBraces

12931290 Normal -> dontUseBraces

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

1295− gotDollar = opNameStr == Just "$"

1296− gotColon = opNameStr == Just ":"

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

1291+ gotDollar = case getOpName (unLoc op) of

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

1293+ _ -> False

12981294 lhs =

12991295 switchLayout [opTreeLoc x] $

1300− p_exprOpTree s x

1301− p_op = located op (opWrapper . p_hsExpr)

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

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)

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

13041300 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

13051301 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

13061302 _ -> False

1307− isDoBlock = \case

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

1309− _ -> False

13101303 useRecordDot' <- useRecordDot

1311− if

1312− | gotColon -> do

1313− lhs

1314− space

1315− p_op

1316− case placement of

1317− Hanging -> do

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

13181327 space

13191328 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

13421329

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

13441331isRecordDot ::

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

13491336 Bool

13501337isRecordDot op (RealSrcSpan ySpan) = case op of

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

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

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

13531340 _ -> False

13541341isRecordDot _ _ = False

13551342

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

1344+isDot :: RdrName -> Bool

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

1346+

13561347-- | Get annotations for the enclosing element.

13571348getEnclosingAnns :: R [AnnKeywordId]

13581349getEnclosingAnns = do

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

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

1111import Ormolu.Printer.Combinators

1212

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

14+

1415p_pat :: Pat GhcPs -> R ()

16+

1517p_hsExpr :: HsExpr GhcPs -> R ()

18+

1619p_hsSplice :: HsSplice GhcPs -> R ()

20+

1721p_stringLit :: String -> R ()

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

@@ -32,9 +32,10 @@ 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 $ do

37− sep commaDel p_rdrName fnames

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

36+ $ pragma pragmaText . inci

37+ $ do

38+ sep (comma >> breakpoint) p_rdrName fnames

3839 breakpoint

3940 p_lits lits

4041

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

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

4748p_lits = \case

4849 [l] -> atom l

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

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

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

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

9393 inci $ do

9494 let names :: [R ()]

9595 names = located' p_ieWrappedName <$> xs

96− parens N . sep commaDel sitcc $

97− case w of

96+ parens N

97+ $ sep (comma >> breakpoint) sitcc

98+ $ case w of

9899 NoIEWildcard -> names

99100 IEWildcard n ->

100101 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 (normalizeImports)

14+import Ormolu.Imports

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_ (normalizeImports hsmodImports) (located' (p_hsmodImport qualifiedPost))

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

7373 newline

7474 switchLayout (getLoc <$> hsmodDecls) $ do

7575 p_hsDecls Free hsmodDecls

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

@@ -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,7 +98,8 @@ p_hsType' multilineArgs docStyle = \case

9898 HsBoxedTuple -> parens N

9999 HsConstraintTuple -> parens N

100100 HsBoxedOrConstraintTuple -> parens N

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

101+ in parens' $

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

102103 HsSumTy NoExtField xs ->

103104 parensHash N $

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

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

117118 HsStarTy NoExtField _ -> txt "*"

118119 HsKindSig NoExtField t k -> sitcc $ do

119120 located t p_hsType

120− space

121+ space -- FIXME

121122 txt "::"

122− breakpoint

123+ space

123124 inci (located k p_hsType)

124125 HsSpliceTy NoExtField splice -> p_hsSplice splice

125126 HsDocTy NoExtField t str ->

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

153154 case (p, xs) of

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

155156 _ -> return ()

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

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

157158 HsExplicitTupleTy NoExtField xs -> do

158159 txt "'"

159160 parens N $ do

160161 case xs of

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

162163 _ -> return ()

163− sep commaDel (located' p_hsType) xs

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

164165 HsTyLit NoExtField t ->

165166 case t of

166167 HsStrTy (SourceText s) _ -> p_stringLit s

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

191192p_hsContext = \case

192193 [] -> txt "()"

193194 [x] -> located x p_hsType

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

195+ xs ->

196+ parens N $

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

195198

196199p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

197200p_hsTyVarBndr = \case

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

221224

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

223226p_conDeclFields xs =

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

227+ braces N $

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

225229

226230p_conDeclField :: ConDeclField GhcPs -> R ()

227231p_conDeclField ConDeclField {..} = do

228232 mapM_ (p_hsDocString Pipe True) cd_fld_doc

229233 sitcc $

230234 sep

231− commaDel

235+ (comma >> breakpoint)

232236 (located' (p_rdrName . rdrNameFieldOcc))

233237 cd_fld_names

234238 space

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

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

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

272276 -- declarations.

273− HsParTy NoExtField . noLoc $

277+ HsParTy NoExtField $ noLoc $

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

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

19+import OccName (mkVarOcc)

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

60+ Map RdrName 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− s <- occNameString . rdrNameOcc <$> getOpName op

72− M.lookup s fixityMap

71+ opName <- getOpName op

72+ M.lookup opName 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 String Fixity

115+ Map RdrName Fixity

116116buildFixityMap getOpName opTree =

117117 addOverrides

118118 . M.fromList

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

120− . zip [2 ..]

120+ . zip [1 ..]

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

122122 . selectScores

123123 $ score opTree

124124 where

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

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

126126 addOverrides m =

127− M.fromList

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

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

130− (".", fixity 100 InfixL)

131− ]

132− `M.union` 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

133133 fixity = Fixity NoSourceText

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

134+ score :: OpTree (Located ty) (Located op) -> [(RdrName, 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 <- occNameString . rdrNameOcc <$> getOpName (unLoc o)

144+ opName <- 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 :: [(String, Score)] -> [(String, Score)]

150+ selectScores :: [(RdrName, Score)] -> [(RdrName, 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_DISABLE_START"

23+startDisabling = "{- ORMOLU_DISABLING_START"

2424

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

2626endDisabling :: IsString s => s

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

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

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE ViewPatterns #-}

3−

41-- | Postprocessing for the results of printing.

52module Ormolu.Processing.Postprocess

63 ( postprocess,

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

1310import qualified Ormolu.Processing.Cpp as Cpp

1411

1512-- | Postprocess output of the formatter.

16−postprocess ::

17− -- | Desired indentation level

18− Int ->

19− -- | Input to process

20− Text ->

21− Text

22−postprocess indent =

13+postprocess :: Text -> Text

14+postprocess =

2315 T.unlines

24− . fmap indentLine

2516 . fmap Cpp.unmaskLine

2617 . filter (not . magicComment)

2718 . T.lines

2819 where

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

20+ magicComment x =

3021 x == startDisabling || x == endDisabling

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

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

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

1111import Control.Monad

1212import Data.Char (isSpace)

1313import qualified Data.List as L

14−import Data.Maybe (isJust, maybeToList)

14+import Data.Maybe (isJust)

15+import Data.Maybe (maybeToList)

1516import FastString

1617import Ormolu.Config (RegionDeltas (..))

1718import Ormolu.Parser.Shebang (isShebang)

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

142143 -- | Whether or not the two strings watch

143144 Bool

144145magicComment expected s0 = isJust $ do

145− let trim = dropWhile isSpace

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

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

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

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

148148 s3 <- L.stripPrefix "-}" s2

149149 guard (all isSpace s3)

src/Ormolu/Utils.hs+1−15

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

11{-# LANGUAGE LambdaCase #-}

22{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ViewPatterns #-}

54-- | Random utilities used by the code.

65module Ormolu.Utils

@@ -16,14 +15,12 @@ module Ormolu.Utils

1615 separatedByBlank,

1716 separatedByBlankNE,

1817 onTheSameLine,

19− removeIndentation,

2018 )

2119where

2220

23−import Data.Char (isSpace)

2421import Data.List (dropWhileEnd)

25−import Data.List.NonEmpty (NonEmpty (..))

2622import qualified Data.List.NonEmpty as NE

23+import Data.List.NonEmpty (NonEmpty (..))

2724import Data.Maybe (fromMaybe)

2825import Data.Text (Text)

2926import qualified Data.Text as T

@@ -142,14 +139,3 @@ separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b)

142139onTheSameLine :: SrcSpan -> SrcSpan -> Bool

143140onTheSameLine a b =

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