ormolu 0.1.4.1 → 0.2.0.0

raw patch · 151 files changed

+1802/−629 lines, 151 filesdep ~ghc-lib-parserdep ~path

Dependency ranges changed: ghc-lib-parser, path

Files

• CHANGELOG.md +71/−0
• README.md +19/−6
• app/Main.hs +2/−5
• data/diff-tests/inputs/no-trailing-blank-line.hs +1/−0
• data/diff-tests/inputs/with-trailing-blank-line.hs +1/−0
• data/diff-tests/outputs/no-preceding.txt +1/−2
• data/diff-tests/outputs/simple-hunk.txt +1/−2
• data/diff-tests/outputs/trailing-blank-line.txt +4/−0
• data/examples/declaration/data/ctype-out.hs +1/−0
• data/examples/declaration/data/ctype.hs +1/−0
• data/examples/declaration/data/field-layout/gadt-out.hs +11/−0
• data/examples/declaration/data/field-layout/gadt.hs +10/−0
• data/examples/declaration/data/field-layout/record-out.hs +12/−0
• data/examples/declaration/data/field-layout/record.hs +11/−0
• data/examples/declaration/data/field-layout/variants-out.hs +10/−0
• data/examples/declaration/data/field-layout/variants.hs +10/−0
• data/examples/declaration/instance/newlines-between-methods-out.hs +1/−1
• data/examples/declaration/signature/standalone-kind-out.hs +16/−0
• data/examples/declaration/signature/standalone-kind.hs +17/−0
• data/examples/declaration/splice/bracket-declaration-out.hs +9/−0
• data/examples/declaration/splice/bracket-declaration.hs +8/−0
• data/examples/declaration/splice/bracket-out.hs +4/−0
• data/examples/declaration/splice/bracket.hs +4/−0
• data/examples/declaration/splice/grouped-splices-out.hs +2/−0
• data/examples/declaration/splice/grouped-splices.hs +2/−0
• data/examples/declaration/type-families/closed-type-family/type-arguments-out.hs +4/−0
• data/examples/declaration/type-families/closed-type-family/type-arguments.hs +4/−0
• data/examples/declaration/type-families/data-family/type-arguments-out.hs +5/−0
• data/examples/declaration/type-families/data-family/type-arguments.hs +5/−0
• data/examples/declaration/type/misc-kind-signatures-out.hs +6/−0
• data/examples/declaration/type/misc-kind-signatures.hs +5/−0
• data/examples/declaration/value/function/application-1-out.hs +7/−7
• data/examples/declaration/value/function/application-2-out.hs +38/−0
• data/examples/declaration/value/function/application-2.hs +36/−0
• data/examples/declaration/value/function/arrow/proc-applications-out.hs +4/−0
• data/examples/declaration/value/function/arrow/proc-applications.hs +4/−0
• data/examples/declaration/value/function/arrow/proc-applications2-out.hs +11/−0
• data/examples/declaration/value/function/arrow/proc-applications2.hs +11/−0
• data/examples/declaration/value/function/arrow/proc-cases-out.hs +5/−0
• data/examples/declaration/value/function/arrow/proc-cases.hs +5/−0
• data/examples/declaration/value/function/arrow/proc-form-do-indent-out.hs +13/−0
• data/examples/declaration/value/function/arrow/proc-form-do-indent.hs +13/−0
• data/examples/declaration/value/function/arrow/proc-forms2-out.hs +19/−0
• data/examples/declaration/value/function/arrow/proc-forms2.hs +17/−0
• data/examples/declaration/value/function/lambda-single-line-out.hs +1/−0
• data/examples/declaration/value/function/lambda-single-line.hs +1/−0
• data/examples/declaration/value/function/lexical-negation-out.hs +8/−0
• data/examples/declaration/value/function/lexical-negation.hs +8/−0
• data/examples/declaration/value/function/negation-out.hs +13/−1
• data/examples/declaration/value/function/negation.hs +12/−0
• data/examples/declaration/value/function/negative-literals-out.hs +13/−0
• data/examples/declaration/value/function/negative-literals.hs +13/−0
• data/examples/declaration/value/function/pattern/as-pattern.hs +1/−1
• data/examples/declaration/value/function/pragmas-out.hs +4/−2
• data/examples/declaration/value/function/pragmas.hs +2/−0
• data/examples/declaration/value/function/record/constructors-out.hs +31/−0
• data/examples/declaration/value/function/record/constructors.hs +22/−0
• data/examples/declaration/value/function/record/dot-multiline-out.hs +15/−0
• data/examples/declaration/value/function/record/dot-multiline.hs +10/−0
• data/examples/declaration/value/function/record/dot-singleline-out.hs +15/−0
• data/examples/declaration/value/function/record/dot-singleline.hs +14/−0
• data/examples/declaration/value/function/record/hanging-after-equal-con-out.hs +8/−0
• data/examples/declaration/value/function/record/hanging-after-equal-con.hs +7/−0
• data/examples/declaration/value/function/record/hanging-after-equal-update-out.hs +8/−0
• data/examples/declaration/value/function/record/hanging-after-equal-update.hs +7/−0
• data/examples/declaration/value/function/record/inter-comments-out.hs +13/−0
• data/examples/declaration/value/function/record/inter-comments.hs +11/−0
• data/examples/declaration/value/function/record/updaters-out.hs +11/−0
• data/examples/declaration/value/function/record/updaters.hs +7/−0
• data/examples/declaration/value/function/record/wildcards-out.hs +14/−0
• data/examples/declaration/value/function/record/wildcards.hs +13/−0
• data/examples/other/cpp/continuation-out.hs +8/−0
• data/examples/other/cpp/continuation.hs +8/−0
• data/examples/other/cpp/lonely-hash-out.hs +14/−0
• data/examples/other/cpp/lonely-hash.hs +14/−0
• data/examples/other/cpp/separation-0a-out.hs +7/−0
• data/examples/other/cpp/separation-0a.hs +6/−0
• data/examples/other/cpp/separation-0b-out.hs +10/−0
• data/examples/other/cpp/separation-0b.hs +9/−0
• data/examples/other/cpp/separation-1a-out.hs +12/−0
• data/examples/other/cpp/separation-1a.hs +11/−0
• data/examples/other/cpp/separation-1b-out.hs +15/−0
• data/examples/other/cpp/separation-1b.hs +14/−0
• data/examples/other/cpp/separation-2a-out.hs +9/−0
• data/examples/other/cpp/separation-2a.hs +8/−0
• data/examples/other/cpp/separation-2b-out.hs +11/−0
• data/examples/other/cpp/separation-2b.hs +11/−0
• data/examples/other/cpp/shifted-out.hs +21/−0
• data/examples/other/cpp/shifted.hs +17/−0
• data/examples/other/cpp/simple-import-out.hs +14/−0
• data/examples/other/cpp/simple-import.hs +14/−0
• data/examples/other/disabling/indented-fragment-out.hs +7/−0
• data/examples/other/disabling/indented-fragment.hs +7/−0
• data/examples/other/disabling/single-definition-out.hs +10/−0
• data/examples/other/disabling/single-definition.hs +10/−0
• data/examples/other/disabling/whole-file-out.hs +10/−0
• data/examples/other/disabling/whole-file.hs +10/−0
• data/examples/other/haddock-without-module-header-out.hs +5/−0
• data/examples/other/haddock-without-module-header.hs +5/−0
• data/examples/other/linear-arrows-out.hs +23/−0
• data/examples/other/linear-arrows.hs +20/−0
• data/examples/other/no-linear-arrows-out.hs +5/−0
• data/examples/other/no-linear-arrows.hs +4/−0
• ormolu.cabal +33/−67
• src/GHC.hs +0/−12
• src/GHC/DynFlags.hs +12/−5
• src/Ormolu.hs +2/−2
• src/Ormolu/Config.hs +1/−1
• src/Ormolu/Diff/ParseResult.hs +29/−4
• src/Ormolu/Diff/Text.hs +3/−1
• src/Ormolu/Exception.hs +4/−4
• src/Ormolu/Imports.hs +8/−10
• src/Ormolu/Parser.hs +22/−19
• src/Ormolu/Parser/Anns.hs +11/−15
• src/Ormolu/Parser/CommentStream.hs +9/−13
• src/Ormolu/Parser/Pragma.hs +7/−7
• src/Ormolu/Parser/Result.hs +7/−4
• src/Ormolu/Parser/Shebang.hs +3/−3
• src/Ormolu/Printer.hs +1/−1
• src/Ormolu/Printer/Combinators.hs +17/−5
• src/Ormolu/Printer/Comments.hs +1/−1
• src/Ormolu/Printer/Internal.hs +38/−11
• src/Ormolu/Printer/Meat/Common.hs +16/−4
• src/Ormolu/Printer/Meat/Declaration.hs +17/−22
• src/Ormolu/Printer/Meat/Declaration.hs-boot +2/−1
• src/Ormolu/Printer/Meat/Declaration/Annotation.hs +4/−4
• src/Ormolu/Printer/Meat/Declaration/Class.hs +11/−5
• src/Ormolu/Printer/Meat/Declaration/Data.hs +52/−40
• src/Ormolu/Printer/Meat/Declaration/Default.hs +7/−8
• src/Ormolu/Printer/Meat/Declaration/Foreign.hs +5/−10
• src/Ormolu/Printer/Meat/Declaration/Instance.hs +46/−56
• src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs +6/−5
• src/Ormolu/Printer/Meat/Declaration/Rule.hs +31/−33
• src/Ormolu/Printer/Meat/Declaration/Signature.hs +11/−10
• src/Ormolu/Printer/Meat/Declaration/Splice.hs +2/−2
• src/Ormolu/Printer/Meat/Declaration/Type.hs +5/−2
• src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs +18/−24
• src/Ormolu/Printer/Meat/Declaration/Value.hs +145/−122
• src/Ormolu/Printer/Meat/Declaration/Value.hs-boot +4/−1
• src/Ormolu/Printer/Meat/Declaration/Warning.hs +5/−4
• src/Ormolu/Printer/Meat/ImportExport.hs +9/−6
• src/Ormolu/Printer/Meat/Module.hs +6/−7
• src/Ormolu/Printer/Meat/Pragma.hs +1/−1
• src/Ormolu/Printer/Meat/Type.hs +65/−24
• src/Ormolu/Printer/Operators.hs +4/−2
• src/Ormolu/Printer/SpanStream.hs +2/−2
• src/Ormolu/Processing/Preprocess.hs +7/−7
• src/Ormolu/Terminal.hs +2/−2
• src/Ormolu/Utils.hs +6/−13
• tests/Ormolu/Diff/TextSpec.hs +1/−0
• tests/Ormolu/Parser/OptionsSpec.hs +32/−0

@@ -1,3 +1,74 @@+## Ormolu 0.2.0.0++* Now standalone kind signatures are grouped with type synonyms. [Issue+  683](https://github.com/tweag/ormolu/issues/683).++* `TemplateHaskell` is not enabled by default anymore. [Issue+  699](https://github.com/tweag/ormolu/issues/699).++* Made record dot pre-processor rendering idempotent in certain specific+  cases. [Issue 701](https://github.com/tweag/ormolu/issues/701).++* Added support for arrow command application. [Issue+  716](https://github.com/tweag/ormolu/issues/716).++* Switched to `ghc-lib-parser-9.0.1`. [PR+  722](https://github.com/tweag/ormolu/pull/722).+   * Support for the new language extensions:+      * `LexicalNegation`, `LinearTypes`: disabled by default+      * `QualifiedDo`: enabled by default+   * Due to [upstream changes in whitespace sensitity](+     https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.0#whitespace-sensitive-and-),+     `TypeApplications` is now *enabled* by default. [Issue+     452](https://github.com/tweag/ormolu/issues/452).+   * Haddocks on declarations in files without a `module` header are no longer+     deleted. [Issue 480](https://github.com/tweag/ormolu/issues/480).+   * Due to a change in Haddock parsing, empty Haddock comments on function+     arguments now get deleted.++* CTYPE pragmas are now preserved. [Issue 689](+  https://github.com/tweag/ormolu/issues/689).++* `TypeApplications` in data/type family instances are now supported. [Issue+  698](https://github.com/tweag/ormolu/issues/698).++* Formatting infix arrow command formations now preserves the AST. [Issue+  718](https://github.com/tweag/ormolu/issues/718).++* Surround code in brackets with spaces if it contains a `StarIsType` `*` to+  prevent unparseable output. [Issue 704](https://github.com/tweag/ormolu/issues/704).++* Formatting applied multiline constructs in do blocks now preserves the AST.+  [Issue 707](https://github.com/tweag/ormolu/issues/707).++  This will sometimes result in odd indentations, e.g. this snippet is a+  fixed point:+  ```haskell+  foo = do+    do+      (+1)+     1+  ```++* GHC options passed in via the CLI can now be overridden in local files.+  Previously, if an extension was disabled via the CLI, it could not be+  re-enabled per file.++* `LexicalNegation` is no longer enabled by default. Also, spaces after+  negation via `-` are removed where possible. [Issue+  694](https://github.com/tweag/ormolu/issues/694).++* Minus signs in literal patterns are now preserved in all cases. [Issue+  733](https://github.com/tweag/ormolu/issues/733).++* Added support for left-to-right arrow application. [Issue+  737](https://github.com/tweag/ormolu/issues/737).++* Now `--mode check` fails on missing trailing blank lines.++* Fixed indentation of arrow forms in do blocks. [Issue+  739](https://github.com/tweag/ormolu/issues/739).+ ## Ormolu 0.1.4.1  * Added command line option `--color` to control how diffs are printed.

@@ -10,6 +10,7 @@     * [Arch Linux](#arch-linux) * [Usage](#usage)     * [Editor integration](#editor-integration)+    * [GitHub actions](#github-actions)     * [Magic comments](#magic-comments)     * [Exit codes](#exit-codes) * [Limitations](#limitations)@@ -116,6 +117,12 @@ $ ormolu --mode inplace $(find . -name '*.hs') ``` +Or find all files in a project with `git ls-files`:++```console+$ ormolu --mode inplace $(git ls-files '*.hs')+```+ To check if files are are already formatted (useful on CI):  ```console@@ -130,6 +137,11 @@ * [VS Code][vs-code-plugin] * Vim: [neoformat][neoformat], [vim-ormolu][vim-ormolu] +### GitHub actions++[`ormolu-action`][ormolu-action] is the recommended way to ensure that a+project is formatted with Ormolu.+ ### Magic comments  Ormolu understands two magic comments:@@ -201,12 +213,13 @@  Copyright © 2018–present Tweag I/O -[design-cpp]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp+[aur]: https://aur.archlinux.org/packages/ormolu [contributing]: https://github.com/tweag/ormolu/blob/master/CONTRIBUTING.md-[license]: https://github.com/tweag/ormolu/blob/master/LICENSE.md-[haskell-src-exts]: https://hackage.haskell.org/package/haskell-src-exts+[design-cpp]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp [emacs-package]: https://github.com/vyorkin/ormolu.el-[vs-code-plugin]: https://marketplace.visualstudio.com/items?itemName=sjurmillidahl.ormolu-vscode-[vim-ormolu]: https://github.com/sdiehl/vim-ormolu+[haskell-src-exts]: https://hackage.haskell.org/package/haskell-src-exts+[license]: https://github.com/tweag/ormolu/blob/master/LICENSE.md [neoformat]: https://github.com/sbdchd/neoformat-[aur]: https://aur.archlinux.org/packages/ormolu+[ormolu-action]: https://github.com/marketplace/actions/ormolu-action+[vim-ormolu]: https://github.com/sdiehl/vim-ormolu+[vs-code-plugin]: https://marketplace.visualstudio.com/items?itemName=sjurmillidahl.ormolu-vscode

@@ -97,7 +97,7 @@               return (ExitFailure 100)  ------------------------------------------------------------------------------- Command line options parsing.+-- Command line options parsing  data Opts = Opts   { -- | Mode of operation@@ -122,10 +122,7 @@ optsParserInfo :: ParserInfo Opts optsParserInfo =   info (helper <*> ver <*> exts <*> optsParser) . mconcat $-    [ fullDesc,-      progDesc "",-      header ""-    ]+    [fullDesc]   where     ver :: Parser (a -> a)     ver =

@@ -0,0 +1,1 @@+data Test = Test

@@ -0,0 +1,1 @@+data Test = Test

@@ -1,7 +1,6 @@ TEST-@@ -1,4 +1,4 @@+@@ -1,3 +1,3 @@ - module Main (foo) where + module Main (main) where-   main :: IO ()   main = return ()

@@ -1,10 +1,9 @@ TEST-@@ -1,7 +1,7 @@+@@ -1,6 +1,6 @@   module Main (main) where    main :: IO () - main = return () + main = pure ()-   foo :: Int   foo = 5

@@ -0,0 +1,4 @@+TEST+@@ -1,1 +1,2 @@+  data Test = Test++

@@ -0,0 +1,1 @@+data {-# CTYPE "unistd.h" "useconds_t" #-} T

@@ -0,0 +1,1 @@+data    {-# CTYPE "unistd.h" "useconds_t" #-} T

@@ -0,0 +1,11 @@+module Main where++-- | Foo.+data Foo a b where+  -- | Something+  Foo :: Foo Int Int+  -- | Something else+  Bar ::+    Foo+      Char+      Char

@@ -0,0 +1,10 @@+module Main where++-- | Foo.++data Foo a b where+  -- | Something+  Foo :: Foo Int Int+  -- | Something else+  Bar :: Foo Char+    Char

@@ -0,0 +1,12 @@+module Main where++-- | Foo.+data Foo = Foo+  { -- | Something+    foo :: Foo Int Int,+    -- | Something else+    bar ::+      Bar+        Char+        Char+  }

@@ -0,0 +1,11 @@+module Main where++-- | Foo.++data Foo = Foo+  { foo :: Foo Int Int+    -- ^ Something+  , bar :: Bar Char+           Char+    -- ^ Something else+  }

@@ -0,0 +1,10 @@+module Main where++-- | Foo.+data Foo+  = -- | Something+    Foo Int Int+  | -- | Something else+    Bar+      Char+      Char

@@ -0,0 +1,10 @@+module Main where++-- | Foo.++data Foo =+  Foo Int Int+  -- ^ Something+  | Bar Char+        Char+  -- ^ Something else

@@ -4,7 +4,7 @@   D u dudx * D v dvdx = D (u * v) (u * dvdx + v * dudx)    -- Comment before definition-  negate (D u dudx) = D (- u) (- dudx)+  negate (D u dudx) = D (-u) (-dudx)   negate (Z u dudx) = undefined    -- Comment after definition

@@ -0,0 +1,16 @@+{-# LANGUAGE StandaloneKindSignatures #-}++type T ::+  (k -> Type) ->+  k ->+  Type+data T m a = MkT (m a) (T Maybe (m a))++type C1 :: Type -> Constraint+class C1 a++type F :: Type -> Type+type family F++type G :: Type+type G = a

@@ -0,0 +1,17 @@+{-# LANGUAGE StandaloneKindSignatures #-}++type T :: (k -> Type)+       -> k+       -> Type++data T m a = MkT (m a) (T Maybe (m a))++type C1 :: Type -> Constraint+class C1 a++type F :: Type -> Type+type family F++type G :: Type++type G = a

@@ -24,3 +24,12 @@          deriving (Eq, Ord, Enum, Bounded, Show)        |]  )++foo = [d| type X = * |]++foo =+  [d|+    type X = *++    data A+    |]

@@ -20,3 +20,11 @@   data T = T     deriving (Eq, Ord, Enum, Bounded, Show)  |])+++foo = [d|type X = * |]++foo = [d|+  type X = *+  data A+        |]

@@ -16,3 +16,7 @@   [||   foo bar   ||]++foo = [t| * |]++foo = [t| a -> * -> a |]

@@ -10,3 +10,7 @@  foo = [|| foo bar   ||]++foo = [t| * |]++foo = [t|a -> * -> a|]

@@ -1,3 +1,5 @@+{-# LANGUAGE TemplateHaskell #-}+ $(deriveJSON fieldLabelMod ''A) $(deriveJSON fieldLabelMod ''B) $(deriveJSON fieldLabelMod ''C)

@@ -1,3 +1,5 @@+{-# LANGUAGE TemplateHaskell #-}+ $(deriveJSON fieldLabelMod ''A) $(deriveJSON fieldLabelMod ''B) $(deriveJSON fieldLabelMod ''C)

@@ -0,0 +1,4 @@+type PickType :: forall k. Nat -> k+type family PickType n where+  PickType @Type 1 = Bool+  PickType @(Type -> Type) 2 = Maybe

@@ -0,0 +1,4 @@+type PickType :: forall k. Nat -> k+type family PickType n where+  PickType @Type 1 = Bool+  PickType @(Type -> Type) 2 = Maybe

@@ -0,0 +1,5 @@+type PickType :: forall k. (k -> Type) -> Type+data family PickType m++data instance PickType @Nat M where+  Foo :: PickType M

@@ -0,0 +1,5 @@+type PickType :: forall k. (k -> Type) -> Type+data family PickType m++data instance PickType @Nat M where+  Foo :: PickType M

@@ -3,3 +3,9 @@  b :: (Bool :: *) b = True++unP :: forall {k} (a :: k). P a -> Proxy a++data ProxyKInvis (a :: k) :: forall k. k -> Type++data ProxyKVis k (a :: k) :: forall k -> k -> Type

@@ -3,3 +3,8 @@  b :: (Bool :: *) b = True++unP :: forall {k} (a :: k). P a -> Proxy a++data ProxyKInvis (a :: k) :: forall k. k -> Type+data ProxyKVis k (a :: k) :: forall k -> k -> Type

@@ -2,18 +2,18 @@   do     x     y-  z+   z  main =   case foo of     x -> a-  foo-  a-  b+   foo+   a+   b  main =   do     if x then y else z-  foo-  a-  b+   foo+   a+   b

@@ -0,0 +1,38 @@+{-# LANGUAGE TemplateHaskell #-}++foo = do+  $( bar+   )+    baz++foo = do+  $$( bar+    )+    baz++foo = do+  do (+ 1)+    2++foo = do+  do+    (+ 1)+   2++foo = do+  case () of () -> (+ 1)+    2++foo = do+  case () of+    () -> (+ 1)+   2++foo = do+  \case 2 -> 3+    2++foo = do+  \case+    2 -> 3+   2

@@ -0,0 +1,36 @@+{-# LANGUAGE TemplateHaskell #-}++foo = do+  $( bar+   ) baz++foo = do+  $$( bar+    ) baz++foo = do+  do (+1)+   2++foo = do+  do+    (+1)+   2++foo = do+  case () of () -> (+1)+   2++foo = do+  case () of+    () -> (+1)+   2++foo = do+  \case 2 -> 3+   2++foo = do+  \case+    2 -> 3+   2

@@ -2,6 +2,8 @@  foo x = proc a -> a -< x +foolr x = proc a -> x >- a+ bar f x =   proc     ( y,@@ -17,3 +19,5 @@         )  baz x = proc a -> a -<< x++bazlr x = proc a -> x >>- a

@@ -2,6 +2,8 @@  foo x = proc a -> a -< x +foolr x = proc a -> x >- a+ bar f x =     proc (         y,@@ -15,3 +17,5 @@     )  baz x = proc a -> a -<< x++bazlr x = proc a -> x >>- a

@@ -0,0 +1,11 @@+{-# LANGUAGE Arrows #-}++t = proc ys ->+  (| f (\y -> returnA -< y) |) ys++g x = proc (y, z) ->+  ( case compare x y of+      LT -> \a -> returnA -< x + a+      EQ -> \b -> returnA -< y + z + b+      GT -> \c -> returnA -< z + x+  ) 1

@@ -0,0 +1,11 @@+{-# LANGUAGE Arrows #-}++t = proc ys ->+  (| f (\y -> returnA -< y) |) ys++g x = proc (y, z) ->+  ( case compare x y of+      LT -> \a -> returnA -< x + a+      EQ -> \b -> returnA -< y + z + b+      GT -> \c -> returnA -< z + x+  ) 1

@@ -14,3 +14,8 @@     Right       (Right b) ->         j -< b++baz = proc x ->+  (f -< x) `catchA` \case+    Right a -> f -< a+    Left e -> h -< e

@@ -15,3 +15,8 @@         Right           (Right b) ->             j -< b+++baz = proc x -> (f -< x) `catchA`  \case+                    Right a -> f -< a+                    Left e  -> h -< e

@@ -0,0 +1,13 @@+{-# LANGUAGE Arrows #-}++foo x = proc (y, z) -> do+  (|+    bar+      (bindA -< y)+    |)++foo1 x = proc (y, z) -> do+  (|+    bar+      (bindA -< y)+    |) z

@@ -0,0 +1,13 @@+{-# LANGUAGE Arrows #-}++foo x = proc (y, z) -> do+  (|+    bar+      (bindA -< y)+    |)++foo1 x = proc (y, z) -> do+  (|+    bar+      (bindA -< y)+    |) z

@@ -20,3 +20,22 @@           -<             y z . (y x)       )++bar4 = proc x ->+  case x of+    Just f -> f -< ()+    Nothing -> x -< ()+  <+> do+    g -< x++expr' = proc x ->+  do+    returnA -< x+  <+> do+    symbol Plus -< ()+    y <- term -< ()+    expr' -< x + y+  <+> do+    symbol Minus -< ()+    y <- term -< ()+    expr' -< x - y

@@ -17,3 +17,20 @@   |||     ((h g  .  h f)       -<y z  .  (y x))++bar4 = proc x -> case x of+    Just f -> f -< ()+    Nothing -> x -< ()+ <+> do+         g -< x++expr' = proc x -> do+                returnA -< x+        <+> do+                symbol Plus -< ()+                y <- term -< ()+                expr' -< x + y+        <+> do+                symbol Minus -< ()+                y <- term -< ()+                expr' -< x - y

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TemplateHaskell #-}  foo :: a -> a -> a foo x = \y -> x

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TemplateHaskell #-}  foo :: a -> a -> a foo x = \y -> x

@@ -0,0 +1,8 @@+{-# LANGUAGE LexicalNegation #-}++foo = -1++foo = -x++weird :: (Int -> Int) -> Int -> Int+weird x y = x -y

@@ -0,0 +1,8 @@+{-# LANGUAGE LexicalNegation #-}++foo = -1++foo = -x++weird :: (Int -> Int) -> Int -> Int+weird x y = x -y

@@ -5,4 +5,16 @@ bar = -2  baz :: Int-baz = - 2+baz = -2++neg :: Int -> Int+neg x = (-x)+neg x = -x+neg x = -x++weird :: Int -> Int -> Int+weird x y = x - y++pat = \case -1 -> 1++pat = \case -1 -> 1

@@ -6,3 +6,15 @@  baz :: Int baz = - 2++neg :: Int -> Int+neg x = (- x)+neg x = - x+neg x = -x++weird :: Int -> Int -> Int+weird x y = x -y++pat = \case -1 -> 1++pat = \case - 1 -> 1

@@ -0,0 +1,13 @@+{-# LANGUAGE NegativeLiterals #-}++foo = - 1++foo = -1++foo = -x++foo = -x++pat = \case -1 -> 1++pat = \case - 1 -> 1

@@ -0,0 +1,13 @@+{-# LANGUAGE NegativeLiterals #-}++foo = - 1++foo = -1++foo = - x++foo = -x++pat = \case -1 -> 1++pat = \case - 1 -> 1

@@ -1,3 +1,3 @@ main = case [1] of-  xs @ (x:_) -> print (x, xs)+  xs@(x:_) -> print (x, xs)   xs@[] -> print xs

@@ -4,8 +4,10 @@   {-# SCC "barbaz" #-}   "hello" -corefoo = {-# CORE "foo" #-} 1+-- CORE pragma got removed in https://gitlab.haskell.org/ghc/ghc/-/commit/12f9035200424ec8104484f154a040d612fee99d +corefoo = {-# CORE "foo"#-} 1+ corebar =-  {-# CORE "bar baz" #-}+  {-# CORE "bar baz"#-}   "hello"

@@ -2,6 +2,8 @@ sccbar = {-# SCC "barbaz"#-}   "hello" +-- CORE pragma got removed in https://gitlab.haskell.org/ghc/ghc/-/commit/12f9035200424ec8104484f154a040d612fee99d+ corefoo = {-# CORE "foo"#-}  1 corebar = {-# CORE "bar baz"#-}   "hello"

@@ -0,0 +1,31 @@+foo = Foo {a = 3}++bar =+  Bar+    { abc = foo,+      def = Foo {a = 10}+    }++baz = Baz {}++sym = Foo {(+) = 3}++aLongVariableName =+  ALongRecordName+    { short = baz,+      aLongRecordFieldName =+        YetAnotherLongRecordName+          { yetAnotherLongRecordFieldName = "a long string"+          },+      aLongRecordFieldName2 =+        Just+          YetAnotherLongRecordName+            { yetAnotherLongRecordFieldName = "a long string",+              yetAnotherLongRecordFieldName =+                Just+                  "a long string"+            },+      aLongRecordFieldName3 = do+        foo+        bar+    }

@@ -0,0 +1,22 @@+foo = Foo { a = 3 }+bar = Bar {+    abc = foo,+    def = Foo {a = 10}+}+baz = Baz{ }+sym = Foo { (+) = 3 }+aLongVariableName =+  ALongRecordName+    { short = baz,+      aLongRecordFieldName = YetAnotherLongRecordName+        { yetAnotherLongRecordFieldName = "a long string"+          },+      aLongRecordFieldName2 = Just YetAnotherLongRecordName+                                 { yetAnotherLongRecordFieldName = "a long string",+                                   yetAnotherLongRecordFieldName = Just+                                                                     "a long string"+                                   },+      aLongRecordFieldName3 = do+                               foo+                               bar+      }

@@ -0,0 +1,15 @@+{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}++bar' =+  (Foo 1){bar = 2+         }++fooplus'''' f n =+  f{foo = n,+    bar = n+   }++fooplus''''' f n =+  f+    { foo = n+    }

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}+bar' = (Foo 1){bar = 2+              }++fooplus'''' f n = f{foo = n,+                    bar = n+                   }++fooplus''''' f n = f+                   { foo = n }

@@ -0,0 +1,15 @@+{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}++data Foo = Foo {bar :: Int}++mfoo = fmap (.bar) $ Nothing++bar = (Foo 1).bar++fooplus f n = f{foo = f.bar + n}++fooplus' f n = f {foo = f.bar + n}++fooplus'' f n = f {foo = f.bar + n}++fooplus''' f n = f {foo = f.bar + n}

@@ -0,0 +1,14 @@+{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}+data Foo = Foo { bar :: Int }++mfoo = fmap (.bar)   $ Nothing++bar = (  Foo 1).bar++fooplus f n = f{foo = f.bar + n}++fooplus' f n = f { foo = f.bar + n}++fooplus'' f n = f {foo = f.bar + n}++fooplus''' f n = f{ foo = f.bar + n}

@@ -0,0 +1,8 @@+foo =+  Foo+    { foo =+        -- Blah blah+        case x of+          Blah -> 1+          Blim -> 2+    }

@@ -0,0 +1,7 @@+foo = Foo+  { foo =+    -- Blah blah+    case x of+      Blah -> 1+      Blim -> 2+  }

@@ -0,0 +1,8 @@+foo =+  foo+    { foo =+        -- Blah blah+        case x of+          Blah -> 1+          Blim -> 2+    }

@@ -0,0 +1,7 @@+foo = foo+  { foo =+    -- Blah blah+    case x of+      Blah -> 1+      Blim -> 2+  }

@@ -0,0 +1,13 @@+x =+  Just+    -- comment+    A+      { x+      }++x =+  Just+    -- comment+    a+      { x+      }

@@ -0,0 +1,11 @@+x = Just+  -- comment+  A+   { x+   }++x = Just+  -- comment+  a+   { x+   }

@@ -0,0 +1,11 @@+foo x = x {a = 3}++bar x =+  x+    { abc = foo,+      def = Foo {a = 10}+    }++baz x = x {}++sym x = x {(+) = 4}

@@ -0,0 +1,7 @@+foo x = x { a = 3 }+bar x = x {+    abc = foo,+    def = Foo {a = 10}+}+baz x = x{ }+sym x = x { (+) = 4 }

@@ -0,0 +1,14 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}++foo x y = Foo {x, y}++bar x y z =+  Bar+    { x,+      y,+      z,+      ..+    }++baz = Baz {..}

@@ -0,0 +1,13 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}++foo x y = Foo { x, y }++bar x y z = Bar {+    x,+    y,+    z,+    ..+}++baz = Baz { .. }

@@ -0,0 +1,8 @@+foo :: Int+foo = 5++#define  message_for(a, b)  \+   printf(#a " and " #b ": We love you!\n")++bar :: Int+bar = 6

@@ -0,0 +1,8 @@+foo :: Int+foo = 5++#define  message_for(a, b)  \+   printf(#a " and " #b ": We love you!\n")++bar :: Int+bar = 6

@@ -0,0 +1,14 @@+module Main (main) where++import Data.Void+import Test.Hspec+import Test.Hspec.Megaparsec+import Text.Megaparsec+import Text.Megaparsec.Char++# if !MIN_VERSION_base(4,13,0)+import Data.Semigroup ((<>))+# endif++main :: IO ()+main = return ()

@@ -0,0 +1,14 @@+module Main (main) where++import Data.Void+import Test.Hspec+import Test.Hspec.Megaparsec+import Text.Megaparsec+import Text.Megaparsec.Char++# if !MIN_VERSION_base(4,13,0)+import Data.Semigroup ((<>))+# endif++main :: IO ()+main = return ()

@@ -0,0 +1,7 @@+instance Stream s => Monad (ParsecT e s m) where+  return = pure+  (>>=) = pBind++#if !(MIN_VERSION_base(4,13,0))+  fail   = Fail.fail+#endif

@@ -0,0 +1,6 @@+instance Stream s => Monad (ParsecT e s m) where+  return = pure+  (>>=)  = pBind+#if !(MIN_VERSION_base(4,13,0))+  fail   = Fail.fail+#endif

@@ -0,0 +1,10 @@+instance Stream s => Monad (ParsecT e s m) where+  return = pure+  (>>=) = pBind++#if !(MIN_VERSION_base(4,13,0))+  fail   = Fail.fail+#endif++foo :: Int+foo = undefined

@@ -0,0 +1,9 @@+instance Stream s => Monad (ParsecT e s m) where+  return = pure+  (>>=)  = pBind+#if !(MIN_VERSION_base(4,13,0))+  fail   = Fail.fail+#endif++foo :: Int+foo = undefined

@@ -0,0 +1,12 @@+decompressingPipe ::+  (PrimMonad m, MonadThrow m, MonadResource m) =>+  CompressionMethod ->+  ConduitT ByteString ByteString m ()+decompressingPipe Store = C.awaitForever C.yield+decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15)++#ifdef ENABLE_BZIP2+decompressingPipe BZip2   = BZ.bunzip2+#else+decompressingPipe BZip2   = throwM BZip2Unsupported+#endif

@@ -0,0 +1,11 @@+decompressingPipe+  :: (PrimMonad m, MonadThrow m, MonadResource m)+  => CompressionMethod+  -> ConduitT ByteString ByteString m ()+decompressingPipe Store   = C.awaitForever C.yield+decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15)+#ifdef ENABLE_BZIP2+decompressingPipe BZip2   = BZ.bunzip2+#else+decompressingPipe BZip2   = throwM BZip2Unsupported+#endif

@@ -0,0 +1,15 @@+decompressingPipe ::+  (PrimMonad m, MonadThrow m, MonadResource m) =>+  CompressionMethod ->+  ConduitT ByteString ByteString m ()+decompressingPipe Store = C.awaitForever C.yield+decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15)++#ifdef ENABLE_BZIP2+decompressingPipe BZip2   = BZ.bunzip2+#else+decompressingPipe BZip2   = throwM BZip2Unsupported+#endif++foo :: Int+foo = undefined

@@ -0,0 +1,14 @@+decompressingPipe+  :: (PrimMonad m, MonadThrow m, MonadResource m)+  => CompressionMethod+  -> ConduitT ByteString ByteString m ()+decompressingPipe Store   = C.awaitForever C.yield+decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15)+#ifdef ENABLE_BZIP2+decompressingPipe BZip2   = BZ.bunzip2+#else+decompressingPipe BZip2   = throwM BZip2Unsupported+#endif++foo :: Int+foo = undefined

@@ -0,0 +1,9 @@+ffff, ffffffff :: Natural++#ifdef HASKELL_ZIP_DEV_MODE+ffff     = 200+ffffffff = 5000+#else+ffff     = 0xffff+ffffffff = 0xffffffff+#endif

@@ -0,0 +1,8 @@+ffff, ffffffff :: Natural+#ifdef HASKELL_ZIP_DEV_MODE+ffff     = 200+ffffffff = 5000+#else+ffff     = 0xffff+ffffffff = 0xffffffff+#endif

@@ -0,0 +1,11 @@+ffff, ffffffff :: Natural+#ifdef HASKELL_ZIP_DEV_MODE+ffff     = 200+ffffffff = 5000+#else+ffff     = 0xffff+ffffffff = 0xffffffff+#endif++foo :: Int+foo = undefined

@@ -0,0 +1,11 @@+ffff, ffffffff :: Natural+#ifdef HASKELL_ZIP_DEV_MODE+ffff     = 200+ffffffff = 5000+#else+ffff     = 0xffff+ffffffff = 0xffffffff+#endif++foo :: Int+foo = undefined

@@ -0,0 +1,21 @@+sinkData h compression = do+  (uncompressedSize, crc32, compressedSize) <-+    case compression of+      Store ->+        withCompression+          dataSink+      Deflate ->+        withCompression $+          Z.compress 9 (Z.WindowBits (-15)) .| dataSink+#ifdef ENABLE_BZIP2+      BZip2   -> withCompression $+        BZ.bzip2 .| dataSink+#else+      BZip2   -> throwM BZip2Unsupported+#endif+  return+    DataDescriptor+      { ddCRC32 = fromIntegral crc32,+        ddCompressedSize = compressedSize,+        ddUncompressedSize = uncompressedSize+      }

@@ -0,0 +1,17 @@+sinkData h compression = do+  (uncompressedSize, crc32, compressedSize) <-+    case compression of+      Store   -> withCompression+        dataSink+      Deflate -> withCompression $+        Z.compress 9 (Z.WindowBits (-15)) .| dataSink+#ifdef ENABLE_BZIP2+      BZip2   -> withCompression $+        BZ.bzip2 .| dataSink+#else+      BZip2   -> throwM BZip2Unsupported+#endif+  return DataDescriptor+    { ddCRC32            = fromIntegral crc32+    , ddCompressedSize   = compressedSize+    , ddUncompressedSize = uncompressedSize }

@@ -0,0 +1,14 @@+module Main (main) where++import Data.Void+import Test.Hspec+import Test.Hspec.Megaparsec+import Text.Megaparsec+import Text.Megaparsec.Char++#if !MIN_VERSION_base(4,13,0)+import Data.Semigroup ((<>))+#endif++main :: IO ()+main = return ()

@@ -0,0 +1,14 @@+module Main (main) where++import Data.Void+import Test.Hspec+import Test.Hspec.Megaparsec+import Text.Megaparsec+import Text.Megaparsec.Char++#if !MIN_VERSION_base(4,13,0)+import Data.Semigroup ((<>))+#endif++main :: IO ()+main = return ()

@@ -0,0 +1,7 @@+foo =+  {- ORMOLU_DISABLE -}+  testCase "Foo" testFoo :+  testCase "Bar" testBar :+  testCase "Baz" testBaz :+  {- ORMOLU_ENABLE -}+  []

@@ -0,0 +1,7 @@+foo =+    {- ORMOLU_DISABLE -}+    testCase "Foo" testFoo :+    testCase "Bar" testBar :+    testCase "Baz" testBaz :+    {- ORMOLU_ENABLE -}+    []

@@ -0,0 +1,10 @@+module Foo (foo, bar) where++{- ORMOLU_DISABLE -}+foo :: Int -> Int+foo = (+5)+{- ORMOLU_ENABLE -}++bar :: Bool -> Bool+bar True = True+bar False = True

@@ -0,0 +1,10 @@+module Foo (foo,bar) where++{- ORMOLU_DISABLE -}+foo :: Int -> Int+foo = (+5)+{- ORMOLU_ENABLE -}++bar :: Bool -> Bool+bar True  = True+bar False = True

@@ -0,0 +1,10 @@+{- ORMOLU_DISABLE -}++module Foo (foo,bar) where++foo :: Int -> Int+foo = (+5)++bar :: Bool -> Bool+bar True  = True+bar False = True

@@ -0,0 +1,10 @@+{-    ORMOLU_DISABLE     -}++module Foo (foo,bar) where++foo :: Int -> Int+foo = (+5)++bar :: Bool -> Bool+bar True  = True+bar False = True

@@ -0,0 +1,5 @@+-- | Foo+main = main++-- | Bar+data Bar

@@ -0,0 +1,5 @@+-- | Foo+main =  main++-- | Bar+data Bar

@@ -0,0 +1,23 @@+{-# LANGUAGE LinearTypes #-}+{-# LANGUAGE UnicodeSyntax #-}++type a % b = (a, b)++type Foo a m b = a % m -> b++type Bar a m b = a %m -> b++type Baz = a %1 -> b++type M =+  a %1 ->+  b %m ->+  c %1 ->+  d++test ::+  a %1 ->+  b %1 ->+  c %m ->+  d+test = test

@@ -0,0 +1,20 @@+{-# LANGUAGE LinearTypes #-}+{-# LANGUAGE UnicodeSyntax #-}++type a % b = (a,b)++type Foo a m b = a % m -> b+type Bar a m b = a %m -> b++type Baz = a ⊸ b++type M = a %1+  -> b %m ->+  c+  %1 -> d++test :: a+      ⊸ b+  %1 -> c+  %m -> d+test = test

@@ -0,0 +1,5 @@+type a % b = (a, b)++type Foo a m b = a % m -> b++type Bar a m b = a % m -> b

@@ -0,0 +1,4 @@+type a % b = (a,b)++type Foo a m b = a % m -> b+type Bar a m b = a %m -> b

@@ -1,55 +1,19 @@-cabal-version:   1.18-name:            ormolu-version:         0.1.4.1-license:         BSD3-license-file:    LICENSE.md-maintainer:      Mark Karpov <mark.karpov@tweag.io>-tested-with:     ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.2-homepage:        https://github.com/tweag/ormolu-bug-reports:     https://github.com/tweag/ormolu/issues-synopsis:        A formatter for Haskell source code-description:     A formatter for Haskell source code.-category:        Development, Formatting-build-type:      Simple-data-files:-    data/examples/declaration/annotation/*.hs-    data/examples/declaration/class/*.hs-    data/examples/declaration/data/*.hs-    data/examples/declaration/data/gadt/*.hs-    data/examples/declaration/default/*.hs-    data/examples/declaration/deriving/*.hs-    data/examples/declaration/foreign/*.hs-    data/examples/declaration/instance/*.hs-    data/examples/declaration/rewrite-rule/*.hs-    data/examples/declaration/role-annotation/*.hs-    data/examples/declaration/signature/complete/*.hs-    data/examples/declaration/signature/fixity/*.hs-    data/examples/declaration/signature/inline/*.hs-    data/examples/declaration/signature/minimal/*.hs-    data/examples/declaration/signature/pattern/*.hs-    data/examples/declaration/signature/set-cost-centre/*.hs-    data/examples/declaration/signature/specialize/*.hs-    data/examples/declaration/signature/type/*.hs-    data/examples/declaration/splice/*.hs-    data/examples/declaration/type-families/closed-type-family/*.hs-    data/examples/declaration/type-families/data-family/*.hs-    data/examples/declaration/type-families/type-family/*.hs-    data/examples/declaration/type-synonyms/*.hs-    data/examples/declaration/type/*.hs-    data/examples/declaration/value/function/*.hs-    data/examples/declaration/value/function/arrow/*.hs-    data/examples/declaration/value/function/comprehension/*.hs-    data/examples/declaration/value/function/do/*.hs-    data/examples/declaration/value/function/infix/*.hs-    data/examples/declaration/value/function/pattern/*.hs-    data/examples/declaration/value/other/*.hs-    data/examples/declaration/value/pattern-synonyms/*.hs-    data/examples/declaration/warning/*.hs-    data/examples/import/*.hs-    data/examples/module-header/*.hs-    data/examples/other/*.hs-    data/diff-tests/inputs/*.hs-    data/diff-tests/outputs/*.txt+cabal-version:      2.4+name:               ormolu+version:            0.2.0.0+license:            BSD-3-Clause+license-file:       LICENSE.md+maintainer:         Mark Karpov <mark.karpov@tweag.io>+tested-with:        ghc ==8.8.4 ghc ==8.10.4 ghc ==9.0.1+homepage:           https://github.com/tweag/ormolu+bug-reports:        https://github.com/tweag/ormolu/issues+synopsis:           A formatter for Haskell source code+description:        A formatter for Haskell source code.+category:           Development, Formatting+build-type:         Simple+extra-source-files:+    data/**/*.hs+    data/**/*.txt  extra-doc-files:     CONTRIBUTING.md@@ -114,20 +78,17 @@         Ormolu.Utils      hs-source-dirs:   src-    other-modules:-        GHC-        GHC.DynFlags-+    other-modules:    GHC.DynFlags     default-language: Haskell2010     build-depends:         Diff >=0.4 && <1.0,         ansi-terminal >=0.10 && <1.0,         base >=4.12 && <5.0,-        bytestring >=0.2 && <0.11,+        bytestring >=0.2 && <0.12,         containers >=0.5 && <0.7,         dlist >=0.8 && <2.0,         exceptions >=0.6 && <0.11,-        ghc-lib-parser >=8.10 && <8.11,+        ghc-lib-parser >=9.0 && <9.1,         mtl >=2.0 && <3.0,         syb >=0.7 && <0.8,         text >=0.2 && <1.3@@ -141,18 +102,22 @@     else         ghc-options: -O2 -Wall +    if impl(ghc <8.10.0)+        ghc-options: -fmax-pmcheck-iterations=3000000+ executable ormolu     main-is:          Main.hs     hs-source-dirs:   app     other-modules:    Paths_ormolu+    autogen-modules:  Paths_ormolu     default-language: Haskell2010     build-depends:         base >=4.12 && <5.0,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=8.10 && <8.11,+        ghc-lib-parser >=9.0 && <9.1,         gitrev >=1.3 && <1.4,         optparse-applicative >=0.14 && <0.17,-        ormolu -any,+        ormolu,         text >=0.2 && <1.3      if flag(dev)@@ -165,23 +130,24 @@         ghc-options: -O2 -Wall -rtsopts  test-suite tests-    type:             exitcode-stdio-1.0-    main-is:          Spec.hs-    build-tools:      hspec-discover >=2.0 && <3.0-    hs-source-dirs:   tests+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    build-tool-depends: hspec-discover:hspec-discover >=2.0 && <3.0+    hs-source-dirs:     tests     other-modules:         Ormolu.Diff.TextSpec+        Ormolu.Parser.OptionsSpec         Ormolu.Parser.PragmaSpec         Ormolu.PrinterSpec -    default-language: Haskell2010+    default-language:   Haskell2010     build-depends:         base >=4.12 && <5.0,         containers >=0.5 && <0.7,         filepath >=1.2 && <1.5,         hspec >=2.0 && <3.0,-        ormolu -any,-        path >=0.6 && <0.9,+        ormolu,+        path >=0.6 && <0.10,         path-io >=1.4.2 && <2.0,         text >=0.2 && <1.3 

@@ -1,12 +0,0 @@-module GHC-  ( module X,-  )-where--import ApiAnnotation as X-import BasicTypes as X-import GHC.Hs as X-import GHC.Hs.Instances as X ()-import Module as X-import RdrName as X-import SrcLoc as X

@@ -7,11 +7,11 @@   ) where -import Config-import DynFlags-import Fingerprint+import GHC.Driver.Session import GHC.Platform-import ToolSettings+import GHC.Settings+import GHC.Settings.Config+import GHC.Utils.Fingerprint  fakeSettings :: Settings fakeSettings =@@ -30,7 +30,14 @@                 { platformMini_arch = ArchUnknown,                   platformMini_os = OSUnknown                 },-            platformUnregisterised = True+            platformUnregisterised = True,+            platformByteOrder = LittleEndian,+            platformHasGnuNonexecStack = False,+            platformHasIdentDirective = False,+            platformHasSubsectionsViaSymbols = False,+            platformIsCrossCompiling = False,+            platformLeadingUnderscore = False,+            platformTablesNextToCode = False           },       sPlatformMisc = PlatformMisc {},       sPlatformConstants =

@@ -15,13 +15,14 @@   ) where -import qualified CmdLineParser as GHC import Control.Exception import Control.Monad import Control.Monad.IO.Class (MonadIO (..)) import Data.Text (Text) import qualified Data.Text as T import Debug.Trace+import qualified GHC.Driver.CmdLine as GHC+import qualified GHC.Types.SrcLoc as GHC import Ormolu.Config import Ormolu.Diff.ParseResult import Ormolu.Diff.Text@@ -30,7 +31,6 @@ import Ormolu.Parser.Result import Ormolu.Printer import Ormolu.Utils (showOutputable)-import qualified SrcLoc as GHC  -- | Format a 'String', return formatted version as 'Text'. --

@@ -14,8 +14,8 @@   ) where +import qualified GHC.Types.SrcLoc as GHC import Ormolu.Terminal (ColorMode (..))-import qualified SrcLoc as GHC  -- | Ormolu configuration. data Config region = Config

@@ -1,7 +1,12 @@ {-# LANGUAGE BangPatterns #-}+-- needed on GHC 9.0 due to simplified subsumption+{-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}  -- | This module allows us to diff two 'ParseResult's. module Ormolu.Diff.ParseResult@@ -12,7 +17,9 @@  import Data.ByteString (ByteString) import Data.Generics-import GHC+import GHC.Hs+import GHC.Types.Basic+import GHC.Types.SrcLoc import Ormolu.Imports (normalizeImports) import Ormolu.Parser.CommentStream import Ormolu.Parser.Result@@ -52,10 +59,14 @@         hs0 {hsmodImports = normalizeImports (hsmodImports hs0)}         hs1 {hsmodImports = normalizeImports (hsmodImports hs1)} --- | Compare two values for equality disregarding differences in 'SrcSpan's--- and the ordering of import lists.+-- | Compare two values for equality disregarding the following aspects:+--+--     * 'SrcSpan's+--     * ordering of import lists+--     * style (ASCII vs Unicode) of arrows+--     * LayoutInfo (brace style) in extension fields matchIgnoringSrcSpans :: Data a => a -> a -> ParseResultDiff-matchIgnoringSrcSpans = genericQuery+matchIgnoringSrcSpans a = genericQuery a   where     genericQuery :: GenericQ (GenericQ ParseResultDiff)     genericQuery x y@@ -76,6 +87,8 @@                 `extQ` sourceTextEq                 `extQ` hsDocStringEq                 `extQ` importDeclQualifiedStyleEq+                `extQ` unicodeArrowStyleEq+                `extQ` layoutInfoEq                 `ext2Q` forLocated             )             x@@ -122,3 +135,15 @@         fresh = not $ any (`isSubspanOf` s) ss         helpful = isGoodSrcSpan s     appendSpan _ d = d+    -- as we normalize arrow styles (e.g. -> vs →), we consider them equal here+    unicodeArrowStyleEq :: HsArrow GhcPs -> GenericQ ParseResultDiff+    unicodeArrowStyleEq (HsUnrestrictedArrow _) (castArrow -> Just (HsUnrestrictedArrow _)) = Same+    unicodeArrowStyleEq (HsLinearArrow _) (castArrow -> Just (HsLinearArrow _)) = Same+    unicodeArrowStyleEq (HsExplicitMult _ t) (castArrow -> Just (HsExplicitMult _ t')) = genericQuery t t'+    unicodeArrowStyleEq _ _ = Different []+    castArrow :: Typeable a => a -> Maybe (HsArrow GhcPs)+    castArrow = cast+    -- LayoutInfo ~ XClassDecl GhcPs tracks brace information+    layoutInfoEq :: LayoutInfo -> GenericQ ParseResultDiff+    layoutInfoEq _ (cast -> Just (_ :: LayoutInfo)) = Same+    layoutInfoEq _ _ = Different []

@@ -62,11 +62,13 @@     then Nothing     else Just (TextDiff path xs)   where-    xs = D.getGroupedDiff (T.lines a) (T.lines b)+    xs = D.getGroupedDiff (lines' a) (lines' b)     isBoth = \case       D.Both _ _ -> True       D.First _ -> False       D.Second _ -> False+    -- T.lines ignores trailing blank lines+    lines' = T.splitOn "\n"  -- | Print the given 'TextDiff' as a 'Term' action. This function tries to -- mimic the style of @git diff@.

@@ -14,7 +14,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import qualified Data.Text as T-import qualified GHC+import GHC.Types.SrcLoc import Ormolu.Diff.Text (TextDiff, printTextDiff) import Ormolu.Terminal import System.Exit (ExitCode (..))@@ -23,11 +23,11 @@ -- | Ormolu exception representing all cases when Ormolu can fail. data OrmoluException   = -- | Parsing of original source code failed-    OrmoluParsingFailed GHC.SrcSpan String+    OrmoluParsingFailed SrcSpan String   | -- | Parsing of formatted source code failed-    OrmoluOutputParsingFailed GHC.SrcSpan String+    OrmoluOutputParsingFailed SrcSpan String   | -- | Original and resulting ASTs differ-    OrmoluASTDiffers FilePath [GHC.SrcSpan]+    OrmoluASTDiffers FilePath [SrcSpan]   | -- | Formatted source code is not idempotent     OrmoluNonIdempotentOutput TextDiff   | -- | Some GHC options were not recognized

@@ -14,10 +14,14 @@ import Data.List (foldl', nubBy, sortBy, sortOn) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M-import FastString (FastString)-import GHC hiding (GhcPs, IE)+import GHC.Data.FastString (FastString) import GHC.Hs.Extension-import GHC.Hs.ImpExp (IE (..))+import GHC.Hs.ImpExp as GHC+import GHC.Types.Basic+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc+import GHC.Unit.Module.Name+import GHC.Unit.Types import Ormolu.Utils (notImplemented, showOutputable)  -- | Sort and normalize imports.@@ -35,7 +39,6 @@           { ideclHiding = second (fmap normalizeLies) <$> ideclHiding,             ..           }-    g _ = notImplemented "XImportDecl"  -- | Combine two import declarations. It should be assumed that 'ImportId's -- are equal.@@ -53,7 +56,6 @@           _ -> Nothing,         ..       }-combineImports _ _ = notImplemented "XImportDecl"  -- | Import id, a collection of all things that justify having a separate -- import entry. This is used for merging of imports. If two imports have@@ -62,7 +64,7 @@   { importIsPrelude :: Bool,     importIdName :: ModuleName,     importPkgQual :: Maybe FastString,-    importSource :: Bool,+    importSource :: IsBootInterface,     importSafe :: Bool,     importQualified :: Bool,     importImplicit :: Bool,@@ -91,7 +93,6 @@   where     isPrelude = moduleNameString moduleName == "Prelude"     moduleName = unLoc ideclName-importId _ = notImplemented "XImportDecl"  -- | Normalize a collection of import\/export items. normalizeLies :: [LIE GhcPs] -> [LIE GhcPs]@@ -140,12 +141,10 @@                         IEGroup NoExtField _ _ -> notImplemented "IEGroup"                         IEDoc NoExtField _ -> notImplemented "IEDoc"                         IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"-                        XIE x -> noExtCon x                     IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"                     IEGroup NoExtField _ _ -> notImplemented "IEGroup"                     IEDoc NoExtField _ -> notImplemented "IEDoc"                     IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"-                    XIE x -> noExtCon x                in Just (f <$> old)        in M.alter alter wname m @@ -168,7 +167,6 @@   IEGroup NoExtField _ _ -> notImplemented "IEGroup"   IEDoc NoExtField _ -> notImplemented "IEDoc"   IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"-  XIE x -> noExtCon x  -- | Like 'compareIewn' for located wrapped names. compareLIewn :: LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering

@@ -9,23 +9,27 @@   ) where -import Bag (bagToList)-import qualified CmdLineParser as GHC import Control.Exception import Control.Monad.IO.Class import qualified Data.List as L import qualified Data.List.NonEmpty as NE import Data.Ord (Down (Down)) import qualified Data.Text as T-import DynFlags as GHC-import ErrUtils (Severity (..), errMsgSeverity, errMsgSpan)-import qualified FastString as GHC-import GHC hiding (IE, UnicodeSyntax)+import GHC.Data.Bag (bagToList)+import qualified GHC.Data.FastString as GHC+import qualified GHC.Data.StringBuffer as GHC+import qualified GHC.Driver.CmdLine as GHC+import GHC.Driver.Session as GHC+import qualified GHC.Driver.Types as GHC import GHC.DynFlags (baseDynFlags) import GHC.LanguageExtensions.Type (Extension (..))-import qualified HeaderInfo as GHC-import qualified HscTypes as GHC-import qualified Lexer as GHC+import qualified GHC.Parser as GHC+import qualified GHC.Parser.Header as GHC+import qualified GHC.Parser.Lexer as GHC+import GHC.Types.SrcLoc+import GHC.Unit.Module.Name+import GHC.Utils.Error (Severity (..), errMsgSeverity, errMsgSpan)+import qualified GHC.Utils.Panic as GHC import Ormolu.Config import Ormolu.Exception import Ormolu.Parser.Anns@@ -33,9 +37,6 @@ import Ormolu.Parser.Result import Ormolu.Processing.Preprocess (preprocess) import Ormolu.Utils (incSpanLine, removeIndentation)-import qualified Panic as GHC-import qualified Parser as GHC-import qualified StringBuffer as GHC  -- | Parse a complete module from string. parseModule ::@@ -108,8 +109,7 @@                         prPragmas = pragmas,                         prCommentStream = comments,                         prUseRecordDot = useRecordDot,-                        prImportQualifiedPost =-                          GHC.xopt ImportQualifiedPost dynFlags,+                        prExtensions = GHC.extensionFlags dynFlags,                         prLiteralPrefix = T.pack literalPrefix,                         prLiteralSuffix = T.pack literalSuffix,                         prIndent = indent@@ -137,17 +137,20 @@     TransformListComp, -- steals the group keyword     UnboxedTuples, -- breaks (#) lens operator     MagicHash, -- screws {-# these things #-}-    TypeApplications, -- steals (@) operator on some cases     AlternativeLayoutRule,     AlternativeLayoutRuleTransitional,     MonadComprehensions,     UnboxedSums,     UnicodeSyntax, -- gives special meanings to operators like (→)+    TemplateHaskell, -- changes how $foo is parsed     TemplateHaskellQuotes, -- enables TH subset of quasi-quotes, this     -- apparently interferes with QuasiQuotes in     -- weird ways-    ImportQualifiedPost -- affects how Ormolu renders imports, so the+    ImportQualifiedPost, -- affects how Ormolu renders imports, so the     -- decision of enabling this style is left to the user+    NegativeLiterals, -- with this, `- 1` and `-1` have differing AST+    LexicalNegation, -- implies NegativeLiterals+    LinearTypes -- steals the (%) type operator in some cases   ]  -- | Run a 'GHC.P' computation.@@ -164,7 +167,7 @@   GHC.ParseResult a runParser parser flags filename input = GHC.unP parser parseState   where-    location = GHC.mkRealSrcLoc (GHC.mkFastString filename) 1 1+    location = mkRealSrcLoc (GHC.mkFastString filename) 1 1     buffer = GHC.stringToStringBuffer input     parseState = GHC.mkPState flags buffer location @@ -202,9 +205,9 @@   IO (Either String ([GHC.Warn], DynFlags)) parsePragmasIntoDynFlags flags extraOpts filepath str =   catchErrors $ do-    let opts = GHC.getOptions flags (GHC.stringToStringBuffer str) filepath+    let fileOpts = GHC.getOptions flags (GHC.stringToStringBuffer str) filepath     (flags', leftovers, warnings) <--      parseDynamicFilePragma flags (opts <> extraOpts)+      parseDynamicFilePragma flags (extraOpts <> fileOpts)     case NE.nonEmpty leftovers of       Nothing -> return ()       Just unrecognizedOpts ->

@@ -9,38 +9,34 @@  import Data.Map.Strict (Map) import qualified Data.Map.Strict as M-import Data.Maybe (mapMaybe)-import qualified GHC-import qualified Lexer as GHC-import SrcLoc+import GHC.Parser.Annotation+import GHC.Parser.Lexer+import GHC.Types.SrcLoc  -- | Ormolu-specific representation of GHC annotations.-newtype Anns = Anns (Map RealSrcSpan [GHC.AnnKeywordId])+newtype Anns = Anns (Map RealSrcSpan [AnnKeywordId])   deriving (Eq)  -- | Empty 'Anns'. emptyAnns :: Anns emptyAnns = Anns M.empty --- | Create 'Anns' from 'GHC.PState'.+-- | Create 'Anns' from 'PState'. mkAnns ::-  GHC.PState ->+  PState ->   Anns mkAnns pstate =   Anns $-    M.fromListWith (++) (mapMaybe f (GHC.annotations pstate))+    M.fromListWith (++) (f <$> annotations pstate)   where-    f ((spn, kid), _) =-      case spn of-        RealSrcSpan rspn -> Just (rspn, [kid])-        UnhelpfulSpan _ -> Nothing+    f ((rspn, kid), _) = (rspn, [kid]) --- | Lookup 'GHC.AnnKeywordId's corresponding to a given 'SrcSpan'.+-- | Lookup 'AnnKeywordId's corresponding to a given 'SrcSpan'. lookupAnns ::   -- | Span to lookup with   SrcSpan ->   -- | Collection of annotations   Anns ->-  [GHC.AnnKeywordId]-lookupAnns (RealSrcSpan rspn) (Anns m) = M.findWithDefault [] rspn m+  [AnnKeywordId]+lookupAnns (RealSrcSpan rspn _) (Anns m) = M.findWithDefault [] rspn m lookupAnns (UnhelpfulSpan _) _ = []

@@ -23,13 +23,13 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (mapMaybe)-import qualified GHC-import qualified Lexer as GHC+import qualified GHC.Parser.Annotation as GHC+import qualified GHC.Parser.Lexer as GHC+import GHC.Types.SrcLoc import Ormolu.Parser.Pragma import Ormolu.Parser.Shebang import Ormolu.Processing.Common import Ormolu.Utils (onTheSameLine, showOutputable)-import SrcLoc  ---------------------------------------------------------------------------- -- Comment stream@@ -46,7 +46,7 @@   -- | Original input   String ->   -- | Extra comments to include-  [Located String] ->+  [RealLocated String] ->   -- | Parser state to use for comment extraction   GHC.PState ->   -- | Stack header, shebangs, pragmas, and comment stream@@ -65,7 +65,7 @@     (comments, pragmas) = extractPragmas input rawComments1     (rawComments1, mstackHeader) = extractStackHeader rawComments0     rawComments0 =-      L.sortOn (realSrcSpanStart . getRealSrcSpan) . mapMaybe toRealSpan $+      L.sortOn (realSrcSpanStart . getRealSrcSpan) $         otherExtraComments           ++ mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate)           ++ concatMap@@ -79,7 +79,7 @@   unlines $     showComment <$> xs   where-    showComment (GHC.L l str) = showOutputable l ++ " " ++ show str+    showComment (L l str) = showOutputable l ++ " " ++ show str  ---------------------------------------------------------------------------- -- Comment@@ -189,8 +189,8 @@                   (y : ys) ->                     let (ls', y') = mkComment ls y                      in if onTheSameLine-                          (RealSrcSpan (getRealSrcSpan x))-                          (RealSrcSpan (getRealSrcSpan y))+                          (RealSrcSpan (getRealSrcSpan x) Nothing)+                          (RealSrcSpan (getRealSrcSpan y) Nothing)                           then go' ls' [y'] ys                           else go' ls [] xs @@ -205,14 +205,10 @@   GHC.AnnLineComment s -> Just s   GHC.AnnBlockComment s -> Just s -liftMaybe :: Located (Maybe a) -> Maybe (Located a)+liftMaybe :: GenLocated l (Maybe a) -> Maybe (GenLocated l a) liftMaybe = \case   L _ Nothing -> Nothing   L l (Just a) -> Just (L l a)--toRealSpan :: Located a -> Maybe (RealLocated a)-toRealSpan (L (RealSrcSpan l) a) = Just (L l a)-toRealSpan _ = Nothing  -- | Remove consecutive blank lines. removeConseqBlanks :: NonEmpty String -> NonEmpty String

@@ -11,12 +11,12 @@ import Control.Monad import Data.Char (isSpace, toLower) import qualified Data.List as L-import qualified EnumSet as ES-import FastString (mkFastString, unpackFS)-import qualified Lexer as L-import Module (ComponentId (..), newSimpleUnitId)-import SrcLoc-import StringBuffer+import qualified GHC.Data.EnumSet as ES+import GHC.Data.FastString (mkFastString, unpackFS)+import GHC.Data.StringBuffer+import qualified GHC.Parser.Lexer as L+import GHC.Types.SrcLoc+import GHC.Unit.Module (stringToUnitId)  -- | Ormolu's representation of pragmas. data Pragma@@ -72,7 +72,7 @@       L.mkParserFlags'         ES.empty         ES.empty-        (newSimpleUnitId (ComponentId (mkFastString "")))+        (stringToUnitId "")         True         True         True

@@ -8,7 +8,10 @@ where  import Data.Text (Text)-import GHC+import GHC.Data.EnumSet (EnumSet)+import GHC.Hs+import GHC.LanguageExtensions.Type+import GHC.Types.SrcLoc import Ormolu.Parser.Anns import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma (Pragma)@@ -17,7 +20,7 @@ -- | A collection of data that represents a parsed module in Ormolu. data ParseResult = ParseResult   { -- | 'ParsedSource' from GHC-    prParsedSource :: HsModule GhcPs,+    prParsedSource :: HsModule,     -- | Ormolu-specfic representation of annotations     prAnns :: Anns,     -- | Stack header@@ -30,8 +33,8 @@     prCommentStream :: CommentStream,     -- | Whether or not record dot syntax is enabled     prUseRecordDot :: Bool,-    -- | Whether or not ImportQualifiedPost is enabled-    prImportQualifiedPost :: Bool,+    -- | Enabled extensions+    prExtensions :: EnumSet Extension,     -- | Literal prefix     prLiteralPrefix :: Text,     -- | Literal suffix

@@ -10,14 +10,14 @@  import Data.Data (Data) import qualified Data.List as L-import SrcLoc+import GHC.Types.SrcLoc  -- | A wrapper for a shebang.-newtype Shebang = Shebang (Located String)+newtype Shebang = Shebang (RealLocated String)   deriving (Eq, Data)  -- | Extract shebangs from the beginning of a comment stream.-extractShebangs :: [Located String] -> ([Shebang], [Located String])+extractShebangs :: [RealLocated String] -> ([Shebang], [RealLocated String]) extractShebangs comments = (Shebang <$> shebangs, rest)   where     (shebangs, rest) = span (isShebang . unLoc) comments

@@ -29,10 +29,10 @@               prStackHeader               prShebangs               prPragmas-              prImportQualifiedPost               prParsedSource           )           (mkSpanStream prParsedSource)           prCommentStream           prAnns           prUseRecordDot+          prExtensions

@@ -12,6 +12,7 @@     runR,     getAnns,     getEnclosingSpan,+    isExtensionEnabled,      -- * Combinators @@ -22,8 +23,10 @@     newline,     inci,     inciIf,+    inciHalf,     located,     located',+    realLocated,     switchLayout,     Layout (..),     vlayout,@@ -68,9 +71,9 @@ import Control.Monad import Data.List (intersperse) import Data.Text (Text)+import GHC.Types.SrcLoc import Ormolu.Printer.Comments import Ormolu.Printer.Internal-import SrcLoc  ---------------------------------------------------------------------------- -- Basic@@ -96,10 +99,19 @@   (a -> R ()) ->   R () located (L (UnhelpfulSpan _) a) f = f a-located (L (RealSrcSpan l) a) f = do+located (L (RealSrcSpan l _) a) f = realLocated (L l a) f++-- | See 'located'+realLocated ::+  -- | Thing to enter+  RealLocated a ->+  -- | How to render inner value+  (a -> R ()) ->+  R ()+realLocated (L l a) f = do   spitPrecedingComments l   withEnclosingSpan l $-    switchLayout [RealSrcSpan l] (f a)+    switchLayout [RealSrcSpan l Nothing] (f a)   spitFollowingComments l  -- | A version of 'located' with arguments flipped.@@ -214,8 +226,8 @@   txt "`"  -- | Surround given entity by banana brackets (i.e., from arrow notation.)-banana :: R () -> R ()-banana = brackets_ True "(|" "|)" N+banana :: BracketStyle -> R () -> R ()+banana = brackets_ True "(|" "|)"  -- | Surround given entity by curly braces @{@ and  @}@. braces :: BracketStyle -> R () -> R ()

@@ -16,9 +16,9 @@ import qualified Data.List.NonEmpty as NE import Data.Maybe (listToMaybe) import qualified Data.Text as T+import GHC.Types.SrcLoc import Ormolu.Parser.CommentStream import Ormolu.Printer.Internal-import SrcLoc  ---------------------------------------------------------------------------- -- Top-level

@@ -20,6 +20,7 @@     newline,     useRecordDot,     inci,+    inciHalf,     sitcc,     Layout (..),     enterLayout,@@ -50,6 +51,9 @@      -- * Annotations     getAnns,++    -- * Extensions+    isExtensionEnabled,   ) where @@ -62,12 +66,16 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder-import GHC+import GHC.Data.EnumSet (EnumSet)+import qualified GHC.Data.EnumSet as EnumSet+import GHC.LanguageExtensions.Type+import GHC.Parser.Annotation+import GHC.Types.SrcLoc+import GHC.Utils.Outputable (Outputable) import Ormolu.Parser.Anns import Ormolu.Parser.CommentStream import Ormolu.Printer.SpanStream import Ormolu.Utils (showOutputable)-import Outputable (Outputable)  ---------------------------------------------------------------------------- -- The 'R' monad@@ -92,7 +100,9 @@     -- | Whether the last expression in the layout can use braces     rcCanUseBraces :: Bool,     -- | Whether the source could have used the record dot preprocessor-    rcUseRecDot :: Bool+    rcUseRecDot :: Bool,+    -- | Enabled extensions+    rcExtensions :: EnumSet Extension   }  -- | State context of 'R'.@@ -160,9 +170,11 @@   Anns ->   -- | Use Record Dot Syntax   Bool ->+  -- | Enabled extensions+  EnumSet Extension ->   -- | Resulting rendition   Text-runR (R m) sstream cstream anns recDot =+runR (R m) sstream cstream anns recDot extensions =   TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc   where     rc =@@ -172,7 +184,8 @@           rcEnclosingSpans = [],           rcAnns = anns,           rcCanUseBraces = False,-          rcUseRecDot = recDot+          rcUseRecDot = recDot,+          rcExtensions = extensions         }     sc =       SC@@ -369,19 +382,27 @@ useRecordDot :: R Bool useRecordDot = R (asks rcUseRecDot) +inciBy :: Int -> R () -> R ()+inciBy step (R m) = R (local modRC m)+  where+    modRC rc =+      rc+        { rcIndent = rcIndent rc + step+        }+ -- | Increase indentation level by one indentation step for the inner -- computation. 'inci' should be used when a part of code must be more -- indented relative to the parts outside of 'inci' in order for the output -- to be valid Haskell. When layout is single-line there is no obvious -- effect, but with multi-line layout correct indentation levels matter. inci :: R () -> R ()-inci (R m) = R (local modRC m)-  where-    modRC rc =-      rc-        { rcIndent = rcIndent rc + indentStep-        }+inci = inciBy indentStep +-- | In rare cases, we have to indent by a positive amount smaller+-- than 'indentStep'.+inciHalf :: R () -> R ()+inciHalf = inciBy $ (indentStep `div` 2) `max` 1+ -- | Set indentation level for the inner computation equal to current -- column. This makes sure that the entire inner block is uniformly -- \"shifted\" to the right.@@ -575,3 +596,9 @@ -- | Indentation step. indentStep :: Int indentStep = 2++----------------------------------------------------------------------------+-- Extensions++isExtensionEnabled :: Extension -> R Bool+isExtensionEnabled ext = R . asks $ EnumSet.member ext . rcExtensions

@@ -12,15 +12,22 @@     p_infixDefHelper,     p_hsDocString,     p_hsDocName,+    p_sourceText,   ) where  import Control.Monad import Data.List (isPrefixOf) import qualified Data.Text as T-import GHC hiding (GhcPs, IE)-import Name (nameStableString)-import OccName (OccName (..))+import GHC.Hs.Doc+import GHC.Hs.ImpExp+import GHC.Parser.Annotation+import GHC.Types.Basic+import GHC.Types.Name (nameStableString)+import GHC.Types.Name.Occurrence (OccName (..))+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc+import GHC.Unit.Module.Name import Ormolu.Printer.Combinators import Ormolu.Utils @@ -178,8 +185,13 @@       -- attached to it and instead its location can be obtained from       -- nearest enclosing span.       getEnclosingSpan (const True) >>= mapM_ (setSpanMark . HaddockSpan hstyle)-    RealSrcSpan spn -> setSpanMark (HaddockSpan hstyle spn)+    RealSrcSpan spn _ -> setSpanMark (HaddockSpan hstyle spn)  -- | Print anchor of named doc section. p_hsDocName :: String -> R () p_hsDocName name = txt ("-- $" <> T.pack name)++p_sourceText :: SourceText -> R ()+p_sourceText = \case+  NoSourceText -> pure ()+  SourceText s -> space >> txt (T.pack s)

@@ -14,8 +14,13 @@ import Data.List (sort) import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE-import GHC hiding (InlinePragma)-import OccName (occNameFS)+import GHC.Hs.Binds+import GHC.Hs.Decls+import GHC.Hs.Extension+import GHC.Hs.Pat+import GHC.Types.Name.Occurrence (occNameFS)+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Annotation@@ -107,7 +112,7 @@   ValD NoExtField x -> p_valDecl x   SigD NoExtField x -> p_sigDecl x   InstD NoExtField x -> p_instDecl style x-  DerivD NoExtField x -> p_derivDecl x+  DerivD NoExtField x -> p_standaloneDerivDecl x   DefD NoExtField x -> p_defaultDecl x   ForD NoExtField x -> p_foreignDecl x   WarningD NoExtField x -> p_warnDecls x@@ -122,7 +127,6 @@       DocGroup n str -> p_hsDocString (Asterisk n) False (noLoc str)   RoleAnnotD NoExtField x -> p_roleAnnot x   KindSigD NoExtField s -> p_standaloneKindSig s-  XHsDecl x -> noExtCon x  p_tyClDecl :: FamilyStyle -> TyClDecl GhcPs -> R () p_tyClDecl style = \case@@ -132,7 +136,7 @@     p_dataDecl       Associated       tcdLName-      (tyVarsToTypes tcdTyVars)+      (tyVarsToTyPats tcdTyVars)       tcdFixity       tcdDataDefn   ClassDecl {..} ->@@ -147,20 +151,13 @@       tcdATs       tcdATDefs       tcdDocs-  XTyClDecl x -> noExtCon x  p_instDecl :: FamilyStyle -> InstDecl GhcPs -> R () p_instDecl style = \case   ClsInstD NoExtField x -> p_clsInstDecl x   TyFamInstD NoExtField x -> p_tyFamInstDecl style x   DataFamInstD NoExtField x -> p_dataFamInstDecl style x-  XInstDecl x -> noExtCon x -p_derivDecl :: DerivDecl GhcPs -> R ()-p_derivDecl = \case-  d@DerivDecl {} -> p_standaloneDerivDecl d-  XDerivDecl x -> noExtCon x- -- | Determine if these declarations should be grouped together. groupedDecls ::   LHsDecl GhcPs ->@@ -188,6 +185,7 @@     (KindSignature n, DataDeclaration n') -> n == n'     (KindSignature n, ClassDeclaration n') -> n == n'     (KindSignature n, FamilyDeclaration n') -> n == n'+    (KindSignature n, TypeSynonym n') -> n == n'     -- Special case for TH splices, we look at locations     (Splice, Splice) -> not (separatedByBlank id l_x l_y)     -- This looks only at Haddocks, normal comments are handled elsewhere@@ -247,7 +245,8 @@   DataDeclaration,   ClassDeclaration,   KindSignature,-  FamilyDeclaration ::+  FamilyDeclaration,+  TypeSynonym ::     RdrName -> HsDecl GhcPs pattern InlinePragma n <- SigD NoExtField (InlineSig NoExtField (L _ n) _) pattern SpecializePragma n <- SigD NoExtField (SpecSig NoExtField (L _ n) _ _)@@ -256,9 +255,10 @@ pattern AnnValuePragma n <- AnnD NoExtField (HsAnnotation NoExtField _ (ValueAnnProvenance (L _ n)) _) pattern Pattern n <- ValD NoExtField (PatSynBind NoExtField (PSB _ (L _ n) _ _ _)) pattern DataDeclaration n <- TyClD NoExtField (DataDecl NoExtField (L _ n) _ _ _)-pattern ClassDeclaration n <- TyClD NoExtField (ClassDecl NoExtField _ (L _ n) _ _ _ _ _ _ _ _)+pattern ClassDeclaration n <- TyClD NoExtField (ClassDecl _ _ (L _ n) _ _ _ _ _ _ _ _) pattern KindSignature n <- KindSigD NoExtField (StandaloneKindSig NoExtField (L _ n) _) pattern FamilyDeclaration n <- TyClD NoExtField (FamDecl NoExtField (FamilyDecl NoExtField _ (L _ n) _ _ _ _))+pattern TypeSynonym n <- TyClD NoExtField (SynDecl NoExtField (L _ n) _ _ _)  -- Declarations which can refer to multiple names @@ -290,7 +290,7 @@ defSigRdrNames _ = Nothing  funRdrNames :: HsDecl GhcPs -> Maybe [RdrName]-funRdrNames (ValD NoExtField (FunBind NoExtField (L _ n) _ _ _)) = Just [n]+funRdrNames (ValD NoExtField (FunBind NoExtField (L _ n) _ _)) = Just [n] funRdrNames (ValD NoExtField (PatBind NoExtField (L _ n) _ _)) = Just $ patBindNames n funRdrNames _ = Nothing @@ -300,9 +300,7 @@  warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName] warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $-  flip concatMap ws $ \case-    L _ (Warning NoExtField ns _) -> map unLoc ns-    L _ (XWarnDecl x) -> noExtCon x+  flip concatMap ws $ \(L _ (Warning NoExtField ns _)) -> map unLoc ns warnSigRdrNames _ = Nothing  patBindNames :: Pat GhcPs -> [RdrName]@@ -321,7 +319,4 @@ patBindNames (SigPat _ (L _ p) _) = patBindNames p patBindNames (NPat NoExtField _ _ _) = [] patBindNames (NPlusKPat NoExtField (L _ n) _ _ _ _) = [n]-patBindNames (ConPatIn _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d)-patBindNames ConPatOut {} = notImplemented "ConPatOut" -- created by renamer-patBindNames (CoPat NoExtField _ p _) = patBindNames p-patBindNames (XPat x) = noExtCon x+patBindNames (ConPat NoExtField _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d)

@@ -4,7 +4,8 @@   ) where -import GHC+import GHC.Hs.Decls+import GHC.Hs.Extension import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common 

@@ -6,18 +6,18 @@   ) where -import GHC+import GHC.Hs.Decls+import GHC.Hs.Extension import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Value  p_annDecl :: AnnDecl GhcPs -> R ()-p_annDecl = \case-  HsAnnotation NoExtField _ annProv expr -> pragma "ANN" . inci $ do+p_annDecl (HsAnnotation NoExtField _ annProv expr) =+  pragma "ANN" . inci $ do     p_annProv annProv     breakpoint     located expr p_hsExpr-  XAnnDecl x -> noExtCon x  p_annProv :: AnnProvenance (IdP GhcPs) -> R () p_annProv = \case

@@ -8,12 +8,19 @@   ) where -import Class import Control.Arrow import Control.Monad import Data.Foldable-import Data.List (sortOn)-import GHC+import Data.Function (on)+import Data.List (sortBy)+import GHC.Core.Class+import GHC.Hs.Binds+import GHC.Hs.Decls+import GHC.Hs.Extension+import GHC.Hs.Type+import GHC.Types.Basic+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration@@ -49,7 +56,7 @@         )           <$> catdefs       allDecls =-        snd <$> sortOn fst (sigs <> vals <> tyFams <> tyFamDefs <> docs)+        snd <$> sortBy (leftmost_smallest `on` fst) (sigs <> vals <> tyFams <> tyFamDefs <> docs)   txt "class"   switchLayout combinedSpans $ do     breakpoint@@ -68,7 +75,6 @@   unless (null allDecls) $ do     breakpoint -- Ensure whitespace is added after where clause.     inci (p_hsDeclsRespectGrouping Associated allDecls)-p_classDecl _ _ (XLHsQTyVars c) _ _ _ _ _ _ _ = noExtCon c  p_classContext :: LHsContext GhcPs -> R () p_classContext ctx = unless (null (unLoc ctx)) $ do

@@ -1,3 +1,4 @@+{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -10,7 +11,14 @@  import Control.Monad import Data.Maybe (isJust, maybeToList)-import GHC+import GHC.Hs.Decls+import GHC.Hs.Extension+import GHC.Hs.Type+import GHC.Parser.Annotation+import GHC.Types.Basic+import GHC.Types.ForeignCall+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type@@ -22,7 +30,7 @@   -- | Type constructor   Located RdrName ->   -- | Type patterns-  [LHsType GhcPs] ->+  HsTyPats GhcPs ->   -- | Lexical fixity   LexicalFixity ->   -- | Data definition@@ -35,7 +43,16 @@   txt $ case style of     Associated -> mempty     Free -> " instance"-  let constructorSpans = getLoc name : fmap getLoc tpats+  case unLoc <$> dd_cType of+    Nothing -> pure ()+    Just (CType prag header (type_, _)) -> do+      p_sourceText prag+      case header of+        Nothing -> pure ()+        Just (Header h _) -> space *> p_sourceText h+      p_sourceText type_+      txt " #-}"+  let constructorSpans = getLoc name : fmap lhsTypeArgSrcSpan tpats   switchLayout constructorSpans $ do     breakpoint     inci $@@ -43,7 +60,7 @@         (isInfix fixity)         True         (p_rdrName name)-        (located' p_hsType <$> tpats)+        (p_lhsTypeArg <$> tpats)   case dd_kindSig of     Nothing -> return ()     Just k -> do@@ -83,7 +100,6 @@   unless (null $ unLoc dd_derivs) breakpoint   inci . located dd_derivs $ \xs ->     sep newline (located' p_hsDerivingClause) xs-p_dataDecl _ _ _ _ (XHsDataDefn x) = noExtCon x  p_conDecl ::   Bool ->@@ -95,7 +111,7 @@     let conDeclSpn =           fmap getLoc con_names             <> [getLoc con_forall]-            <> conTyVarsSpans con_qvars+            <> fmap getLoc con_qvars             <> maybeToList (fmap getLoc con_mb_cxt)             <> conArgsSpans con_args     switchLayout conDeclSpn $ do@@ -114,25 +130,31 @@                 then newline                 else breakpoint         interArgBreak-        when (unLoc con_forall) $ do-          p_forallBndrs ForallInvis p_hsTyVarBndr (hsq_explicit con_qvars)-          interArgBreak-        forM_ con_mb_cxt p_lhsContext-        case con_args of-          PrefixCon xs -> do-            sep breakpoint (located' p_hsType) xs-            unless (null xs) $ do-              space-              txt "->"-              breakpoint-          RecCon l -> do-            located l p_conDeclFields-            unless (null $ unLoc l) $ do-              space-              txt "->"-              breakpoint-          InfixCon _ _ -> notImplemented "InfixCon"-        p_hsType (unLoc con_res_ty)+        conTy <- case con_args of+          PrefixCon xs ->+            let go (HsScaled a b) t = L (combineLocs t b) (HsFunTy NoExtField a b t)+             in pure $ foldr go con_res_ty xs+          RecCon r@(L l rs) ->+            pure+              . L (combineLocs r con_res_ty)+              $ HsFunTy+                NoExtField+                (HsUnrestrictedArrow NormalSyntax)+                (L l $ HsRecTy NoExtField rs)+                con_res_ty+          InfixCon _ _ -> notImplemented "InfixCon" -- NOTE(amesgen) should be unreachable+        let qualTy = case con_mb_cxt of+              Nothing -> conTy+              Just qs ->+                L (combineLocs qs conTy) $+                  HsQualTy NoExtField qs conTy+        let quantifiedTy =+              if unLoc con_forall+                then+                  L (combineLocs con_forall qualTy) $+                    HsForAllTy NoExtField (mkHsForAllInvisTele con_qvars) qualTy+                else qualTy+        p_hsType (unLoc quantifiedTy)   ConDeclH98 {..} -> do     mapM_ (p_hsDocString Pipe True) con_doc     let conDeclWithContextSpn =@@ -144,40 +166,34 @@           getLoc con_name : conArgsSpans con_args     switchLayout conDeclWithContextSpn $ do       when (unLoc con_forall) $ do-        p_forallBndrs ForallInvis p_hsTyVarBndr con_ex_tvs+        p_forallBndrs ForAllInvis p_hsTyVarBndr con_ex_tvs         breakpoint       forM_ con_mb_cxt p_lhsContext       switchLayout conDeclSpn $ case con_args of         PrefixCon xs -> do           p_rdrName con_name           unless (null xs) breakpoint-          inci . sitcc $ sep breakpoint (sitcc . located' p_hsTypePostDoc) xs+          inci . sitcc $ sep breakpoint (sitcc . located' p_hsTypePostDoc) (hsScaledThing <$> xs)         RecCon l -> do           p_rdrName con_name           breakpoint           inciIf (not singleConstRec) (located l p_conDeclFields)-        InfixCon x y -> do+        InfixCon (HsScaled _ x) (HsScaled _ y) -> do           located x p_hsType           breakpoint           inci $ do             p_rdrName con_name             space             located y p_hsType-  XConDecl x -> noExtCon x  conArgsSpans :: HsConDeclDetails GhcPs -> [SrcSpan] conArgsSpans = \case   PrefixCon xs ->-    getLoc <$> xs+    getLoc . hsScaledThing <$> xs   RecCon l ->     [getLoc l]   InfixCon x y ->-    [getLoc x, getLoc y]--conTyVarsSpans :: LHsQTyVars GhcPs -> [SrcSpan]-conTyVarsSpans = \case-  HsQTvs {..} -> getLoc <$> hsq_explicit-  XLHsQTyVars x -> noExtCon x+    getLoc . hsScaledThing <$> [x, y]  p_lhsContext ::   LHsContext GhcPs ->@@ -194,7 +210,6 @@ isGadt = \case   ConDeclGADT {} -> True   ConDeclH98 {} -> False-  XConDecl {} -> False  p_hsDerivingClause ::   HsDerivingClause GhcPs ->@@ -235,9 +250,6 @@           txt "via"           space           located hsib_body p_hsType-      ViaStrategy (XHsImplicitBndrs x) ->-        noExtCon x-p_hsDerivingClause (XHsDerivingClause x) = noExtCon x  ---------------------------------------------------------------------------- -- Helpers

@@ -6,15 +6,14 @@   ) where -import GHC+import GHC.Hs.Decls+import GHC.Hs.Extension import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Type  p_defaultDecl :: DefaultDecl GhcPs -> R ()-p_defaultDecl = \case-  DefaultDecl NoExtField ts -> do-    txt "default"-    breakpoint-    inci . parens N $-      sep commaDel (sitcc . located' p_hsType) ts-  XDefaultDecl x -> noExtCon x+p_defaultDecl (DefaultDecl NoExtField ts) = do+  txt "default"+  breakpoint+  inci . parens N $+    sep commaDel (sitcc . located' p_hsType) ts

@@ -7,11 +7,12 @@   ) where -import BasicTypes import Control.Monad-import Data.Text-import ForeignCall-import GHC+import GHC.Hs.Decls+import GHC.Hs.Extension+import GHC.Hs.Type+import GHC.Types.ForeignCall+import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Signature@@ -24,7 +25,6 @@   fd@ForeignExport {fd_fe} -> do     p_foreignExport fd_fe     p_foreignTypeSig fd-  XForeignDecl x -> noExtCon x  -- | Printer for the last part of an import\/export, which is function name -- and type signature.@@ -67,8 +67,3 @@   space   located (L loc cCallConv) atom   located sourceText p_sourceText--p_sourceText :: SourceText -> R ()-p_sourceText = \case-  NoSourceText -> pure ()-  SourceText s -> space >> txt (pack s)

@@ -11,19 +11,22 @@   ) where -import BasicTypes import Control.Arrow import Control.Monad import Data.Foldable-import Data.List (sortOn)-import GHC+import Data.Function (on)+import Data.List (sortBy)+import GHC.Hs.Decls+import GHC.Hs.Extension+import GHC.Hs.Type+import GHC.Types.Basic+import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration import Ormolu.Printer.Meat.Declaration.Data import Ormolu.Printer.Meat.Declaration.TypeFamily import Ormolu.Printer.Meat.Type-import Ormolu.Utils  p_standaloneDerivDecl :: DerivDecl GhcPs -> R () p_standaloneDerivDecl DerivDecl {..} = do@@ -54,64 +57,51 @@         inci (located hsib_body p_hsType)         breakpoint         instTypes True-      ViaStrategy (XHsImplicitBndrs x) ->-        noExtCon x-p_standaloneDerivDecl (XDerivDecl _) = notImplemented "XDerivDecl"  p_clsInstDecl :: ClsInstDecl GhcPs -> R ()-p_clsInstDecl = \case-  ClsInstDecl {..} -> do-    txt "instance"-    case cid_poly_ty of-      HsIB {..} -> do-        -- GHC's AST does not necessarily store each kind of element in source-        -- location order. This happens because different declarations are stored in-        -- different lists. Consequently, to get all the declarations in proper-        -- order, they need to be manually sorted.-        let sigs = (getLoc &&& fmap (SigD NoExtField)) <$> cid_sigs-            vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cid_binds-            tyFamInsts =-              ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField)-              )-                <$> cid_tyfam_insts-            dataFamInsts =-              ( getLoc &&& fmap (InstD NoExtField . DataFamInstD NoExtField)-              )-                <$> cid_datafam_insts-            allDecls =-              snd <$> sortOn fst (sigs <> vals <> tyFamInsts <> dataFamInsts)-        located hsib_body $ \x -> do-          breakpoint-          inci $ do-            match_overlap_mode cid_overlap_mode breakpoint-            p_hsType x-            unless (null allDecls) $ do-              breakpoint-              txt "where"-        unless (null allDecls) . inci $ do-          -- Ensure whitespace is added after where clause.-          breakpoint-          dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls-      XHsImplicitBndrs x -> noExtCon x-  XClsInstDecl x -> noExtCon x+p_clsInstDecl ClsInstDecl {..} = do+  txt "instance"+  let HsIB {..} = cid_poly_ty+  -- GHC's AST does not necessarily store each kind of element in source+  -- location order. This happens because different declarations are stored in+  -- different lists. Consequently, to get all the declarations in proper+  -- order, they need to be manually sorted.+  let sigs = (getLoc &&& fmap (SigD NoExtField)) <$> cid_sigs+      vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cid_binds+      tyFamInsts =+        ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField)+        )+          <$> cid_tyfam_insts+      dataFamInsts =+        ( getLoc &&& fmap (InstD NoExtField . DataFamInstD NoExtField)+        )+          <$> cid_datafam_insts+      allDecls =+        snd <$> sortBy (leftmost_smallest `on` fst) (sigs <> vals <> tyFamInsts <> dataFamInsts)+  located hsib_body $ \x -> do+    breakpoint+    inci $ do+      match_overlap_mode cid_overlap_mode breakpoint+      p_hsType x+      unless (null allDecls) $ do+        breakpoint+        txt "where"+  unless (null allDecls) . inci $ do+    -- Ensure whitespace is added after where clause.+    breakpoint+    dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls  p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()-p_tyFamInstDecl style = \case-  TyFamInstDecl {..} -> do-    txt $ case style of-      Associated -> "type"-      Free -> "type instance"-    breakpoint-    inci (p_tyFamInstEqn tfid_eqn)+p_tyFamInstDecl style TyFamInstDecl {..} = do+  txt $ case style of+    Associated -> "type"+    Free -> "type instance"+  breakpoint+  inci (p_tyFamInstEqn tfid_eqn)  p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R ()-p_dataFamInstDecl style = \case-  DataFamInstDecl {dfid_eqn = HsIB {hsib_body = FamEqn {..}}} ->-    p_dataDecl style feqn_tycon (map typeArgToType feqn_pats) feqn_fixity feqn_rhs-  DataFamInstDecl {dfid_eqn = HsIB {hsib_body = XFamEqn {}}} ->-    notImplemented "XFamEqn"-  DataFamInstDecl {dfid_eqn = XHsImplicitBndrs {}} ->-    notImplemented "XHsImplicitBndrs"+p_dataFamInstDecl style (DataFamInstDecl {dfid_eqn = HsIB {hsib_body = FamEqn {..}}}) =+  p_dataDecl style feqn_tycon feqn_pats feqn_fixity feqn_rhs  match_overlap_mode :: Maybe (Located OverlapMode) -> R () -> R () match_overlap_mode overlap_mode layoutStrategy =

@@ -8,15 +8,16 @@   ) where -import CoAxiom-import GHC+import GHC.Core.Coercion.Axiom+import GHC.Hs.Decls+import GHC.Hs.Extension+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common  p_roleAnnot :: RoleAnnotDecl GhcPs -> R ()-p_roleAnnot = \case-  RoleAnnotDecl NoExtField l_name anns -> p_roleAnnot' l_name anns-  XRoleAnnotDecl x -> noExtCon x+p_roleAnnot (RoleAnnotDecl NoExtField l_name anns) = p_roleAnnot' l_name anns  p_roleAnnot' :: Located RdrName -> [Located (Maybe Role)] -> R () p_roleAnnot' l_name anns = do

@@ -1,14 +1,18 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}  module Ormolu.Printer.Meat.Declaration.Rule   ( p_ruleDecls,   ) where -import BasicTypes import Control.Monad (unless)-import GHC+import GHC.Hs.Decls+import GHC.Hs.Extension+import GHC.Hs.Lit+import GHC.Hs.Type+import GHC.Types.Basic import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Signature@@ -16,38 +20,33 @@ import Ormolu.Printer.Meat.Type  p_ruleDecls :: RuleDecls GhcPs -> R ()-p_ruleDecls = \case-  HsRules NoExtField _ xs ->-    pragma "RULES" $-      sep breakpoint (sitcc . located' p_ruleDecl) xs-  XRuleDecls x -> noExtCon x+p_ruleDecls (HsRules NoExtField _ xs) =+  pragma "RULES" $ sep breakpoint (sitcc . located' p_ruleDecl) xs  p_ruleDecl :: RuleDecl GhcPs -> R ()-p_ruleDecl = \case-  HsRule NoExtField ruleName activation tyvars ruleBndrs lhs rhs -> do-    located ruleName p_ruleName-    space-    p_activation activation+p_ruleDecl (HsRule NoExtField ruleName activation tyvars ruleBndrs lhs rhs) = do+  located ruleName p_ruleName+  space+  p_activation activation+  space+  case tyvars of+    Nothing -> return ()+    Just xs -> do+      p_forallBndrs ForAllInvis p_hsTyVarBndr xs+      space+  -- It appears that there is no way to tell if there was an empty forall+  -- in the input or no forall at all. We do not want to add redundant+  -- foralls, so let's just skip the empty ones.+  unless (null ruleBndrs) $+    p_forallBndrs ForAllInvis p_ruleBndr ruleBndrs+  breakpoint+  inci $ do+    located lhs p_hsExpr     space-    case tyvars of-      Nothing -> return ()-      Just xs -> do-        p_forallBndrs ForallInvis p_hsTyVarBndr xs-        space-    -- It appears that there is no way to tell if there was an empty forall-    -- in the input or no forall at all. We do not want to add redundant-    -- foralls, so let's just skip the empty ones.-    unless (null ruleBndrs) $-      p_forallBndrs ForallInvis p_ruleBndr ruleBndrs-    breakpoint+    equals     inci $ do-      located lhs p_hsExpr-      space-      equals-      inci $ do-        breakpoint-        located rhs p_hsExpr-  XRuleDecl x -> noExtCon x+      breakpoint+      located rhs p_hsExpr  p_ruleName :: (SourceText, RuleName) -> R () p_ruleName (_, name) = atom $ (HsString NoSourceText name :: HsLit GhcPs)@@ -55,7 +54,6 @@ p_ruleBndr :: RuleBndr GhcPs -> R () p_ruleBndr = \case   RuleBndr NoExtField x -> p_rdrName x-  RuleBndrSig NoExtField x hswc -> parens N $ do+  RuleBndrSig NoExtField x HsPS {..} -> parens N $ do     p_rdrName x-    p_typeAscription hswc-  XRuleBndr x -> noExtCon x+    p_typeAscription (HsWC NoExtField (HsIB NoExtField hsps_body))

@@ -11,10 +11,15 @@   ) where -import BasicTypes-import BooleanFormula import Control.Monad-import GHC+import GHC.Data.BooleanFormula+import GHC.Hs.Binds+import GHC.Hs.Decls+import GHC.Hs.Extension+import GHC.Hs.Type+import GHC.Types.Basic+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type@@ -63,7 +68,6 @@     then newline     else breakpoint   located t p_hsType-p_typeAscription (XHsWildCardBndrs x) = noExtCon x  p_patSynSig ::   [Located RdrName] ->@@ -105,7 +109,6 @@     atom n     space     sitcc $ sep commaDel p_rdrName names-  XFixitySig x -> noExtCon x  p_inlineSig ::   -- | Name@@ -164,6 +167,7 @@     txt "["     atom n     txt "]"+  FinalActive -> notImplemented "FinalActive" -- NOTE(amesgen) is this unreachable or just not implemented?  p_specInstSig :: LHsSigType GhcPs -> R () p_specInstSig hsib =@@ -222,7 +226,7 @@     atom x  p_standaloneKindSig :: StandaloneKindSig GhcPs -> R ()-p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do+p_standaloneKindSig (StandaloneKindSig NoExtField name (HsIB NoExtField sig)) = do   txt "type"   inci $ do     space@@ -230,7 +234,4 @@     space     txt "::"     breakpoint-    case bndrs of-      HsIB NoExtField sig -> located sig p_hsType-      XHsImplicitBndrs x -> noExtCon x-p_standaloneKindSig (XStandaloneKindSig c) = noExtCon c+    located sig p_hsType

@@ -5,11 +5,11 @@   ) where -import GHC+import GHC.Hs.Decls+import GHC.Hs.Extension import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Declaration.Value (p_hsSplice)  p_spliceDecl :: SpliceDecl GhcPs -> R () p_spliceDecl = \case   SpliceDecl NoExtField splice _explicit -> located splice p_hsSplice-  XSpliceDecl x -> noExtCon x

@@ -7,7 +7,11 @@   ) where -import GHC+import GHC.Hs.Extension+import GHC.Hs.Type+import GHC.Types.Basic+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type@@ -37,4 +41,3 @@     then newline     else breakpoint   inci (located t p_hsType)-p_synDecl _ _ (XLHsQTyVars x) _ = noExtCon x

@@ -11,11 +11,14 @@  import Control.Monad import Data.Maybe (isNothing)-import GHC+import GHC.Hs.Decls+import GHC.Hs.Extension+import GHC.Hs.Type+import GHC.Types.Basic+import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type-import Ormolu.Utils  p_famDecl :: FamilyStyle -> FamilyDecl GhcPs -> R () p_famDecl style FamilyDecl {fdTyVars = HsQTvs {..}, ..} = do@@ -53,27 +56,20 @@         Just eqs -> do           newline           sep newline (located' (inci . p_tyFamInstEqn)) eqs-p_famDecl _ FamilyDecl {fdTyVars = XLHsQTyVars {}} =-  notImplemented "XLHsQTyVars"-p_famDecl _ (XFamilyDecl x) = noExtCon x  p_familyResultSigL ::   Located (FamilyResultSig GhcPs) ->   Maybe (R ())-p_familyResultSigL l =-  case l of-    L _ a -> case a of-      NoSig NoExtField -> Nothing-      KindSig NoExtField k -> Just $ do-        txt "::"-        breakpoint-        located k p_hsType-      TyVarSig NoExtField bndr -> Just $ do-        equals-        breakpoint-        located bndr p_hsTyVarBndr-      XFamilyResultSig x ->-        noExtCon x+p_familyResultSigL (L _ a) = case a of+  NoSig NoExtField -> Nothing+  KindSig NoExtField k -> Just $ do+    txt "::"+    breakpoint+    located k p_hsType+  TyVarSig NoExtField bndr -> Just $ do+    equals+    breakpoint+    located bndr p_hsTyVarBndr  p_injectivityAnn :: InjectivityAnn GhcPs -> R () p_injectivityAnn (InjectivityAnn a bs) = do@@ -90,22 +86,20 @@   case feqn_bndrs of     Nothing -> return ()     Just bndrs -> do-      p_forallBndrs ForallInvis p_hsTyVarBndr bndrs+      p_forallBndrs ForAllInvis p_hsTyVarBndr bndrs       breakpoint   inciIf (not $ null feqn_bndrs) $ do-    let famLhsSpn = getLoc feqn_tycon : fmap (getLoc . typeArgToType) feqn_pats+    let famLhsSpn = getLoc feqn_tycon : fmap lhsTypeArgSrcSpan feqn_pats     switchLayout famLhsSpn $       p_infixDefHelper         (isInfix feqn_fixity)         True         (p_rdrName feqn_tycon)-        (located' p_hsType . typeArgToType <$> feqn_pats)+        (p_lhsTypeArg <$> feqn_pats)     space     equals     breakpoint     inci (located feqn_rhs p_hsType)-p_tyFamInstEqn HsIB {hsib_body = XFamEqn x} = noExtCon x-p_tyFamInstEqn (XHsImplicitBndrs x) = noExtCon x  ---------------------------------------------------------------------------- -- Helpers

@@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}  module Ormolu.Printer.Meat.Declaration.Value   ( p_valDecl,@@ -13,21 +14,33 @@   ) where -import Bag (bagToList)-import BasicTypes import Control.Monad-import Ctype (is_space) import Data.Bool (bool) import Data.Char (isPunctuation, isSymbol) import Data.Data hiding (Infix, Prefix)+import Data.Function (on) import Data.Functor ((<&>))-import Data.List (intersperse, sortOn)+import Data.Generics.Schemes (everything)+import Data.List (intersperse, sortBy) import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE+import Data.Maybe (isJust) import Data.Text (Text) import qualified Data.Text as Text-import GHC-import OccName (occNameString)+import GHC.Data.Bag (bagToList)+import GHC.Hs.Binds+import GHC.Hs.Expr+import GHC.Hs.Extension+import GHC.Hs.Lit+import GHC.Hs.Pat+import GHC.Hs.Type+import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))+import GHC.Parser.Annotation+import GHC.Parser.CharClass (is_space)+import GHC.Types.Basic+import GHC.Types.Name.Occurrence (occNameString)+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Internal import Ormolu.Printer.Meat.Common@@ -65,12 +78,11 @@  p_valDecl :: HsBindLR GhcPs GhcPs -> R () p_valDecl = \case-  FunBind NoExtField funId funMatches _ _ -> p_funBind funId funMatches+  FunBind NoExtField funId funMatches _ -> p_funBind funId funMatches   PatBind NoExtField pat grhss _ -> p_match PatternBind False NoSrcStrict [pat] grhss   VarBind {} -> notImplemented "VarBinds" -- introduced by the type checker   AbsBinds {} -> notImplemented "AbsBinds" -- introduced by the type checker   PatSynBind NoExtField psb -> p_patSynBind psb-  XHsBindsLR x -> noExtCon x  p_funBind ::   Located RdrName ->@@ -114,8 +126,6 @@         (matchStrictness m)         m_pats         m_grhss-    p_Match (XMatch x) = noExtCon x-p_matchGroup' _ _ _ (XMatchGroup x) = noExtCon x  -- | Function id obtained through pattern matching on 'FunBind' should not -- be used to print the actual equations because the different ‘RdrNames’@@ -247,8 +257,8 @@                 else EqualSign         sep newline (located' (p_grhs' placer render groupStyle)) grhssGRHSs       p_where = do-        let whereIsEmpty = GHC.isEmptyLocalBindsPR (unLoc grhssLocalBinds)-        unless (GHC.eqEmptyLocalBinds (unLoc grhssLocalBinds)) $ do+        let whereIsEmpty = eqEmptyLocalBinds (unLoc grhssLocalBinds)+        unless (eqEmptyLocalBinds (unLoc grhssLocalBinds)) $ do           breakpoint           txt "where"           unless whereIsEmpty breakpoint@@ -264,7 +274,6 @@     switchLayout [patGrhssSpan] $       placeHanging placement p_body     inci p_where-p_match' _ _ _ _ _ _ (XGRHSs x) = noExtCon x  p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R () p_grhs = p_grhs' exprPlacement p_hsExpr@@ -303,39 +312,48 @@         Nothing -> Nothing         Just gs -> (Just . getLoc . NE.last) gs     p_body = located body render-p_grhs' _ _ _ (XGRHS x) = noExtCon x  p_hsCmd :: HsCmd GhcPs -> R ()-p_hsCmd = \case-  HsCmdArrApp NoExtField body input arrType _ -> do-    located body p_hsExpr+p_hsCmd = p_hsCmd' N++p_hsCmd' :: BracketStyle -> HsCmd GhcPs -> R ()+p_hsCmd' s = \case+  HsCmdArrApp NoExtField body input arrType rightToLeft -> do+    let (l, r) = if rightToLeft then (body, input) else (input, body)+    located l p_hsExpr     breakpoint     inci $ do-      case arrType of-        HsFirstOrderApp -> txt "-<"-        HsHigherOrderApp -> txt "-<<"+      case (arrType, rightToLeft) of+        (HsFirstOrderApp, True) -> txt "-<"+        (HsHigherOrderApp, True) -> txt "-<<"+        (HsFirstOrderApp, False) -> txt ">-"+        (HsHigherOrderApp, False) -> txt ">>-"       placeHanging (exprPlacement (unLoc input)) $-        located input p_hsExpr-  HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ do+        located r p_hsExpr+  HsCmdArrForm NoExtField form Prefix _ cmds -> banana s $ do     located form p_hsExpr     unless (null cmds) $ do       breakpoint       inci (sequence_ (intersperse breakpoint (located' p_hsCmdTop <$> cmds)))   HsCmdArrForm NoExtField form Infix _ [left, right] -> do     located left p_hsCmdTop-    space+    case unLoc left of+      HsCmdTop NoExtField (L _ HsCmdPar {}) -> space+      _ -> breakpoint     located form p_hsExpr     placeHanging (cmdTopPlacement (unLoc right)) $       located right p_hsCmdTop   HsCmdArrForm NoExtField _ Infix _ _ -> notImplemented "HsCmdArrForm"-  HsCmdApp {} ->-    -- XXX Does this ever occur in the syntax tree? It does not seem like it-    -- does. Open an issue and ping @yumiova if this ever occurs in output.-    notImplemented "HsCmdApp"+  HsCmdApp NoExtField cmd expr -> do+    located cmd (p_hsCmd' s)+    space+    located expr p_hsExpr   HsCmdLam NoExtField mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup   HsCmdPar NoExtField c -> parens N (located c p_hsCmd)   HsCmdCase NoExtField e mgroup ->     p_case cmdPlacement p_hsCmd e mgroup+  HsCmdLamCase NoExtField mgroup ->+    p_lamcase cmdPlacement p_hsCmd mgroup   HsCmdIf NoExtField _ if' then' else' ->     p_if cmdPlacement p_hsCmd if' then' else'   HsCmdLet NoExtField localBinds c ->@@ -344,14 +362,10 @@     txt "do"     newline     inci . located es $-      sitcc . sep newline (sitcc . withSpacing (p_stmt' cmdPlacement p_hsCmd))-  HsCmdWrap {} -> notImplemented "HsCmdWrap"-  XCmd x -> noExtCon x+      sitcc . sep newline (sitcc . withSpacing (p_stmt' cmdPlacement (p_hsCmd' S)))  p_hsCmdTop :: HsCmdTop GhcPs -> R ()-p_hsCmdTop = \case-  HsCmdTop NoExtField cmd -> located cmd p_hsCmd-  XCmdTop x -> noExtCon x+p_hsCmdTop (HsCmdTop NoExtField cmd) = located cmd p_hsCmd  -- | Render an expression preserving blank lines between such consecutive -- expressions found in the original source code.@@ -364,7 +378,7 @@ withSpacing f l = located l $ \x -> do   case getLoc l of     UnhelpfulSpan _ -> f x-    RealSrcSpan currentSpn -> do+    RealSrcSpan currentSpn _ -> do       getSpanMark >>= \case         -- Spacing before comments will be handled by the code         -- that prints comments, so we just have to deal with@@ -396,19 +410,15 @@   R () p_stmt' placer render = \case   LastStmt NoExtField body _ _ -> located body render-  BindStmt NoExtField p f _ _ -> do+  BindStmt NoExtField p f@(L l x) -> do     located p p_pat     space     txt "<-"     let loc = getLoc p-        placement =-          case f of-            L l' x ->-              if isOneLineSpan-                (mkSrcSpan (srcSpanEnd loc) (srcSpanStart l'))-                then placer x-                else Normal-    switchLayout [loc, getLoc f] $+        placement+          | isOneLineSpan (mkSrcSpan (srcSpanEnd loc) (srcSpanStart l)) = placer x+          | otherwise = Normal+    switchLayout [loc, l] $       placeHanging placement (located f render)   ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer   BodyStmt NoExtField body _ _ -> located body render@@ -454,7 +464,6 @@     txt "rec"     space     sitcc $ sepSemi (withSpacing (p_stmt' placer render)) recS_stmts-  XStmtLR c -> noExtCon c  gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]] gatherStmt (L _ (ParStmt NoExtField block _ _)) =@@ -466,7 +475,6 @@ gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]] gatherStmtBlock (ParStmtBlock _ stmts _ _) =   foldr (liftAppend . gatherStmt) [] stmts-gatherStmtBlock (XParStmtBlock x) = noExtCon x  p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R () p_hsLocalBinds = \case@@ -487,7 +495,7 @@         p_item' (p, item) =           positionToBracing p $             withSpacing (either p_valDecl p_sigDecl) item-        binds = sortOn (srcSpanStart . getLoc) items+        binds = sortBy (leftmost_smallest `on` getLoc) items     sitcc $ sepSemi p_item' (attachRelativePos binds)   HsValBinds NoExtField _ -> notImplemented "HsValBinds"   HsIPBinds NoExtField (IPBinds NoExtField xs) ->@@ -501,11 +509,8 @@         p_ipBind (IPBind NoExtField (Right _) _) =           -- Should only occur after the type checker           notImplemented "IPBind _ (Right _) _"-        p_ipBind (XIPBind x) = noExtCon x      in sepSemi (located' p_ipBind) xs-  HsIPBinds NoExtField _ -> notImplemented "HsIpBinds"   EmptyLocalBinds NoExtField -> return ()-  XHsLocalBindsLR x -> noExtCon x  p_hsRecField ::   HsRecField' RdrName (LHsExpr GhcPs) ->@@ -527,13 +532,12 @@ p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R () p_hsExpr' s = \case   HsVar NoExtField name -> p_rdrName name-  HsUnboundVar NoExtField v -> atom (unboundVarOcc v)+  HsUnboundVar NoExtField occ -> atom occ   HsConLikeOut NoExtField _ -> notImplemented "HsConLikeOut"   HsRecFld NoExtField x ->     case x of       Unambiguous NoExtField name -> p_rdrName name       Ambiguous NoExtField name -> p_rdrName name-      XAmbiguousFieldOcc xx -> noExtCon xx   HsOverLabel NoExtField _ v -> do     txt "#"     atom v@@ -548,10 +552,8 @@       r -> atom r   HsLam NoExtField mgroup ->     p_matchGroup Lambda mgroup-  HsLamCase NoExtField mgroup -> do-    txt "\\case"-    breakpoint-    inci (p_matchGroup LambdaCase mgroup)+  HsLamCase NoExtField mgroup ->+    p_lamcase exprPlacement p_hsExpr mgroup   HsApp NoExtField f x -> do     let -- In order to format function applications with multiple parameters         -- nicer, traverse the AST to gather the function and all the@@ -580,16 +582,20 @@     case placement of       Normal -> do         let -- Usually we want to bump indentation for arguments for the-            -- sake of readability. However, when the function itself is a-            -- do-block or case expression it is not a good idea. It seems-            -- to be safe to always bump indentation when the function-            -- expression is parenthesised.-            doIndent =-              case func of-                L _ (HsPar NoExtField _) -> True-                L _ (HsAppType NoExtField _ _) -> True-                L _ (HsMultiIf NoExtField _) -> True-                L spn _ -> isOneLineSpan spn+            -- sake of readability. However:+            -- When the function is itself a multi line do-block or a case+            -- expression, we can't indent by indentStep or more.+            -- When we are on the other hand *in* a do block, we have to+            -- indent by at least 1.+            -- Thus, we indent by half of indentStep when the function is+            -- a multi line do block or case expression.+            indentArg+              | isOneLineSpan (getLoc func) = inci+              | otherwise = case unLoc func of+                HsDo {} -> inciHalf+                HsCase {} -> inciHalf+                HsLamCase {} -> inciHalf+                _ -> inci         ub <-           getLayout <&> \case             SingleLine -> useBraces@@ -597,8 +603,8 @@         ub $ do           located func (p_hsExpr' s)           breakpoint-          inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp-        inciIf doIndent $ do+          indentArg $ sep breakpoint (located' p_hsExpr) initp+        indentArg $ do           unless (null initp) breakpoint           located lastp p_hsExpr       Hanging -> do@@ -622,9 +628,16 @@   OpApp NoExtField x op y -> do     let opTree = OpBranch (exprOpTree x) op (exprOpTree y)     p_exprOpTree s (reassociateOpTree getOpName opTree)-  NegApp NoExtField e _ -> do+  NegApp NoExtField e NoExtField -> do+    negativeLiterals <- isExtensionEnabled NegativeLiterals+    let isLiteral = case unLoc e of+          HsLit {} -> True+          HsOverLit {} -> True+          _ -> False     txt "-"-    space+    -- If NegativeLiterals is enabled, we have to insert a space before+    -- negated literals, as `- 1` and `-1` have differing AST.+    when (negativeLiterals && isLiteral) space     located e p_hsExpr   HsPar NoExtField e ->     parens s (located e (dontUseBraces . p_hsExpr))@@ -646,7 +659,6 @@         p_arg = \case           Present NoExtField x -> located x p_hsExpr           Missing NoExtField -> pure ()-          XTupArg x -> noExtCon x         p_larg = sitcc . located' p_arg         parens' =           case boxity of@@ -663,7 +675,7 @@     p_unboxedSum N tag arity (located e p_hsExpr)   HsCase NoExtField e mgroup ->     p_case exprPlacement p_hsExpr e mgroup-  HsIf NoExtField _ if' then' else' ->+  HsIf NoExtField if' then' else' ->     p_if exprPlacement p_hsExpr if' then' else'   HsMultiIf NoExtField guards -> do     txt "if"@@ -672,7 +684,8 @@   HsLet NoExtField localBinds e ->     p_let p_hsExpr localBinds e   HsDo NoExtField ctx es -> do-    let doBody header = do+    let doBody moduleName header = do+          forM_ moduleName $ \m -> atom m *> txt "."           txt header           breakpoint           ub <- layoutToBraces <$> getLayout@@ -699,8 +712,8 @@           space           p_parBody lists     case ctx of-      DoExpr -> doBody "do"-      MDoExpr -> doBody "mdo"+      DoExpr moduleName -> doBody moduleName "do"+      MDoExpr moduleName -> doBody moduleName "mdo"       ListComp -> compBody       MonadComp -> compBody       ArrowExpr -> notImplemented "ArrowExpr"@@ -719,7 +732,6 @@           (f :: HsRecField GhcPs (LHsExpr GhcPs))             { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of                 FieldOcc _ n -> n-                XFieldOcc x -> noExtCon x             }         fields = located' (p_hsRecField . updName) <$> rec_flds         dotdot =@@ -732,18 +744,18 @@     located rupd_expr p_hsExpr     useRecordDot' <- useRecordDot     let mrs sp = case getLoc sp of-          RealSrcSpan r -> Just r+          RealSrcSpan r _ -> Just r           _ -> Nothing     let isPluginForm =           ((1 +) . srcSpanEndCol <$> mrs rupd_expr)             == (srcSpanStartCol <$> mrs (head rupd_flds))+            && onTheSameLine (getLoc rupd_expr) (getLoc $ head rupd_flds)     unless (useRecordDot' && isPluginForm) breakpoint     let updName f =           (f :: HsRecUpdField GhcPs)             { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of                 Ambiguous _ n -> n                 Unambiguous _ n -> n-                XAmbiguousFieldOcc x -> noExtCon x             }         updBraces =           if useRecordDot' && isPluginForm@@ -760,8 +772,6 @@     txt "::"     breakpoint     inci $ located hsib_body p_hsType-  ExprWithTySig NoExtField _ HsWC {hswc_body = XHsImplicitBndrs x} -> noExtCon x-  ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x   ArithSeq NoExtField _ x ->     case x of       From from -> brackets s $ do@@ -784,18 +794,6 @@         txt ".."         space         located to p_hsExpr-  HsSCC NoExtField _ name x -> do-    txt "{-# SCC "-    atom name-    txt " #-}"-    breakpoint-    located x p_hsExpr-  HsCoreAnn NoExtField _ value x -> do-    txt "{-# CORE "-    atom value-    txt " #-}"-    breakpoint-    located x p_hsExpr   HsBracket NoExtField x -> p_hsBracket x   HsRnBracketOut {} -> notImplemented "HsRnBracketOut"   HsTcBracketOut {} -> notImplemented "HsTcBracketOut"@@ -815,9 +813,14 @@     inci (located e p_hsExpr)   HsTick {} -> notImplemented "HsTick"   HsBinTick {} -> notImplemented "HsBinTick"-  HsTickPragma {} -> notImplemented "HsTickPragma"-  HsWrap {} -> notImplemented "HsWrap"-  XExpr x -> noExtCon x+  HsPragE NoExtField prag x -> case prag of+    HsPragSCC NoExtField _ name -> do+      txt "{-# SCC "+      atom name+      txt " #-}"+      breakpoint+      located x p_hsExpr+    HsPragTick {} -> notImplemented "HsTickPragma"  p_patSynBind :: PatSynBind GhcPs GhcPs -> R () p_patSynBind PSB {..} = do@@ -869,7 +872,6 @@           space           p_rdrName r       inci rhs-p_patSynBind (XPatSynBind x) = noExtCon x  p_case ::   Data body =>@@ -891,6 +893,20 @@   breakpoint   inci (p_matchGroup' placer render Case mgroup) +p_lamcase ::+  Data body =>+  -- | Placer+  (body -> Placement) ->+  -- | Render+  (body -> R ()) ->+  -- | Expression+  MatchGroup GhcPs (Located body) ->+  R ()+p_lamcase placer render mgroup = do+  txt "\\case"+  breakpoint+  inci (p_matchGroup' placer render LambdaCase mgroup)+ p_if ::   Data body =>   -- | Placer@@ -962,7 +978,7 @@     parens' $ sep commaDel (sitcc . located' p_pat) pats   SumPat NoExtField pat tag arity ->     p_unboxedSum S tag arity (located pat p_pat)-  ConPatIn pat details ->+  ConPat NoExtField pat details ->     case details of       PrefixCon xs -> sitcc $ do         p_rdrName pat@@ -987,7 +1003,6 @@             p_rdrName pat             space             located r p_pat-  ConPatOut {} -> notImplemented "ConPatOut" -- presumably created by renamer?   ViewPat NoExtField expr pat -> sitcc $ do     located expr p_hsExpr     space@@ -996,7 +1011,12 @@     inci (located pat p_pat)   SplicePat NoExtField splice -> p_hsSplice splice   LitPat NoExtField p -> atom p-  NPat NoExtField v _ _ -> located v (atom . ol_val)+  NPat NoExtField v (isJust -> isNegated) NoExtField -> do+    when isNegated $ do+      txt "-"+      negativeLiterals <- isExtensionEnabled NegativeLiterals+      when negativeLiterals space+    located v (atom . ol_val)   NPlusKPat NoExtField n k _ _ _ -> sitcc $ do     p_rdrName n     breakpoint@@ -1004,11 +1024,9 @@       txt "+"       space       located k (atom . ol_val)-  SigPat NoExtField pat hswc -> do+  SigPat NoExtField pat HsPS {..} -> do     located pat p_pat-    p_typeAscription hswc-  CoPat {} -> notImplemented "CoPat" -- apparently created at some later stage-  XPat x -> noExtCon x+    p_typeAscription (HsWC NoExtField (HsIB NoExtField hsps_body))  p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R () p_pat_hsRecField HsRecField {..} = do@@ -1048,8 +1066,6 @@     atom str     txt "|]"   HsSpliced {} -> notImplemented "HsSpliced"-  HsSplicedT {} -> notImplemented "HsSplicedT"-  XSplice x -> noExtCon x  p_hsSpliceTH ::   -- | Typed splice?@@ -1060,13 +1076,10 @@   SpliceDecoration ->   R () p_hsSpliceTH isTyped expr = \case-  HasParens -> do-    txt decoSymbol-    parens N (located expr (sitcc . p_hsExpr))-  HasDollar -> do+  DollarSplice -> do     txt decoSymbol     located expr (sitcc . p_hsExpr)-  NoParens ->+  BareSplice ->     located expr (sitcc . p_hsExpr)   where     decoSymbol = if isTyped then "$$" else "$"@@ -1080,9 +1093,9 @@           _ -> "e"     quote name (located expr p_hsExpr)   PatBr NoExtField pat -> located pat (quote "p" . p_pat)-  DecBrL NoExtField decls -> quote "d" (p_hsDecls Free decls)+  DecBrL NoExtField decls -> quote "d" (handleStarIsType decls (p_hsDecls Free decls))   DecBrG NoExtField _ -> notImplemented "DecBrG" -- result of renamer-  TypBr NoExtField ty -> quote "t" (located ty p_hsType)+  TypBr NoExtField ty -> quote "t" (located ty (handleStarIsType ty . p_hsType))   VarBr NoExtField isSingleQuote name -> do     txt (bool "''" "'" isSingleQuote)     -- HACK As you can see we use 'noLoc' here to be able to pass name into@@ -1104,7 +1117,6 @@     located expr p_hsExpr     breakpoint'     txt "||]"-  XBracket x -> noExtCon x   where     quote :: Text -> R () -> R ()     quote name body = do@@ -1116,6 +1128,19 @@         dontUseBraces body         breakpoint'         txt "|]"+    -- With StarIsType, type and declaration brackets might end with a *,+    -- so we have to insert a space in the end to prevent the (mis)parsing+    -- of an (*|) operator.+    -- The detection is a bit overcautious, as it adds the spaces as soon as+    -- HsStarTy is anywhere in the type/declaration.+    handleStarIsType :: Data a => a -> R () -> R ()+    handleStarIsType a p+      | containsHsStarTy a = space *> p <* space+      | otherwise = p+      where+        containsHsStarTy = everything (||) $ \b -> case cast @_ @(HsType GhcPs) b of+          Just HsStarTy {} -> True+          _ -> False  -- Print the source text of a string literal while indenting -- gaps correctly.@@ -1185,7 +1210,6 @@ getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan getGRHSSpan (GRHS NoExtField guards body) =   combineSrcSpans' $ getLoc body :| map getLoc guards-getGRHSSpan (XGRHS x) = noExtCon x  -- | Place a thing that may have a hanging form. This function handles how -- to separate it from preceding expressions and whether to bump indentation@@ -1214,13 +1238,12 @@ cmdPlacement = \case   HsCmdLam NoExtField _ -> Hanging   HsCmdCase NoExtField _ _ -> Hanging+  HsCmdLamCase NoExtField _ -> Hanging   HsCmdDo NoExtField _ -> Hanging   _ -> Normal  cmdTopPlacement :: HsCmdTop GhcPs -> Placement-cmdTopPlacement = \case-  HsCmdTop NoExtField (L _ x) -> cmdPlacement x-  XCmdTop x -> noExtCon x+cmdTopPlacement (HsCmdTop NoExtField (L _ x)) = cmdPlacement x  -- | Check if given expression has a hanging form. exprPlacement :: HsExpr GhcPs -> Placement@@ -1233,8 +1256,8 @@     _ -> Normal   HsLamCase NoExtField _ -> Hanging   HsCase NoExtField _ _ -> Hanging-  HsDo NoExtField DoExpr _ -> Hanging-  HsDo NoExtField MDoExpr _ -> Hanging+  HsDo NoExtField (DoExpr _) _ -> Hanging+  HsDo NoExtField (MDoExpr _) _ -> Hanging   OpApp NoExtField _ op y ->     case (fmap getOpNameStr . getOpName . unLoc) op of       Just "$" -> exprPlacement (unLoc y)@@ -1305,7 +1328,7 @@       p_op = located op (opWrapper . p_hsExpr)       p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y)       isSection = case (opTreeLoc x, getLoc op) of-        (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->+        (RealSrcSpan treeSpan _, RealSrcSpan opSpan _) ->           srcSpanEndCol treeSpan /= srcSpanStartCol opSpan         _ -> False       isDoBlock = \case@@ -1351,8 +1374,8 @@   -- | Span of the expression on the right-hand side of the operator   SrcSpan ->   Bool-isRecordDot op (RealSrcSpan ySpan) = case op of-  HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->+isRecordDot op (RealSrcSpan ySpan _) = case op of+  HsVar NoExtField (L (RealSrcSpan opSpan _) opName) ->     (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)   _ -> False isRecordDot _ _ = False@@ -1363,4 +1386,4 @@   e <- getEnclosingSpan (const True)   case e of     Nothing -> return []-    Just e' -> getAnns (RealSrcSpan e')+    Just e' -> getAnns (RealSrcSpan e' Nothing)

@@ -7,7 +7,10 @@   ) where -import GHC+import GHC.Hs.Binds+import GHC.Hs.Expr+import GHC.Hs.Extension+import GHC.Hs.Pat import Ormolu.Printer.Combinators  p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

@@ -7,22 +7,23 @@   ) where -import BasicTypes import Data.Foldable import Data.Text (Text)-import GHC+import GHC.Hs.Decls+import GHC.Hs.Extension+import GHC.Types.Basic+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common  p_warnDecls :: WarnDecls GhcPs -> R () p_warnDecls (Warnings NoExtField _ warnings) =   traverse_ (located' p_warnDecl) warnings-p_warnDecls (XWarnDecls x) = noExtCon x  p_warnDecl :: WarnDecl GhcPs -> R () p_warnDecl (Warning NoExtField functions warningTxt) =   p_topLevelWarning functions warningTxt-p_warnDecl (XWarnDecl x) = noExtCon x  p_moduleWarning :: WarningTxt -> R () p_moduleWarning wtxt = do

@@ -10,7 +10,11 @@ where  import Control.Monad-import GHC+import GHC.Hs.Extension+import GHC.Hs.ImpExp+import GHC.LanguageExtensions.Type+import GHC.Types.SrcLoc+import GHC.Unit.Types import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Utils (RelativePos (..), attachRelativePos)@@ -28,11 +32,12 @@       (\(p, l) -> sitcc (located l (p_lie layout p)))       (attachRelativePos xs) -p_hsmodImport :: Bool -> ImportDecl GhcPs -> R ()-p_hsmodImport useQualifiedPost ImportDecl {..} = do+p_hsmodImport :: ImportDecl GhcPs -> R ()+p_hsmodImport ImportDecl {..} = do+  useQualifiedPost <- isExtensionEnabled ImportQualifiedPost   txt "import"   space-  when ideclSource (txt "{-# SOURCE #-}")+  when (ideclSource == IsBoot) (txt "{-# SOURCE #-}")   space   when ideclSafe (txt "safe")   space@@ -72,7 +77,6 @@             (\(p, l) -> sitcc (located l (p_lie layout p)))             (attachRelativePos xs)     newline-p_hsmodImport _ (XImportDecl x) = noExtCon x  p_lie :: Layout -> RelativePos -> IE GhcPs -> R () p_lie encLayout relativePos = \case@@ -113,7 +117,6 @@   IEDoc NoExtField str ->     p_hsDocString Pipe False (noLoc str)   IEDocNamed NoExtField str -> p_hsDocName str-  XIE x -> noExtCon x   where     p_comma =       case encLayout of

@@ -10,7 +10,8 @@  import Control.Monad import qualified Data.Text as T-import GHC+import GHC.Hs+import GHC.Types.SrcLoc import Ormolu.Imports (normalizeImports) import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma@@ -31,17 +32,15 @@   [Shebang] ->   -- | Pragmas and the associated comments   [([RealLocated Comment], Pragma)] ->-  -- | Whether to use postfix qualified imports-  Bool ->   -- | AST to print-  HsModule GhcPs ->+  HsModule ->   R ()-p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do+p_hsModule mstackHeader shebangs pragmas HsModule {..} = do   let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage       exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports   switchLayout (deprecSpan <> exportSpans) $ do     forM_ shebangs $ \(Shebang x) ->-      located x $ \shebang -> do+      realLocated x $ \shebang -> do         txt (T.pack shebang)         newline     forM_ mstackHeader $ \(L spn comment) -> do@@ -69,7 +68,7 @@         txt "where"         newline     newline-    forM_ (normalizeImports hsmodImports) (located' (p_hsmodImport qualifiedPost))+    forM_ (normalizeImports hsmodImports) (located' p_hsmodImport)     newline     switchLayout (getLoc <$> hsmodDecls) $ do       p_hsDecls Free hsmodDecls

@@ -13,11 +13,11 @@ import qualified Data.List as L import Data.Maybe (listToMaybe) import qualified Data.Text as T+import GHC.Types.SrcLoc import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma (Pragma (..)) import Ormolu.Printer.Combinators import Ormolu.Printer.Comments-import SrcLoc  -- | Pragma classification. data PragmaTy

@@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}  -- | Rendering of types.@@ -9,14 +10,23 @@     hasDocStrings,     p_hsContext,     p_hsTyVarBndr,+    ForAllVisibility (..),     p_forallBndrs,     p_conDeclFields,+    p_lhsTypeArg,     tyVarsToTypes,+    tyVarsToTyPats,   ) where  import Data.Data (Data)-import GHC hiding (isPromoted)+import GHC.Hs.Decls+import GHC.Hs.Extension+import GHC.Hs.Type+import GHC.Types.Basic hiding (isPromoted)+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc+import GHC.Types.Var import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice, p_stringLit)@@ -36,8 +46,10 @@  p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R () p_hsType' multilineArgs docStyle = \case-  HsForAllTy NoExtField visibility bndrs t -> do-    p_forallBndrs visibility p_hsTyVarBndr bndrs+  HsForAllTy NoExtField tele t -> do+    case tele of+      HsForAllInvis NoExtField bndrs -> p_forallBndrs ForAllInvis p_hsTyVarBndr bndrs+      HsForAllVis NoExtField bndrs -> p_forallBndrs ForAllVis p_hsTyVarBndr bndrs     interArgBreak     p_hsTypeR (unLoc t)   HsQualTy NoExtField qs t -> do@@ -81,10 +93,17 @@     inci $ do       txt "@"       located kd p_hsType-  HsFunTy NoExtField x y@(L _ y') -> do+  HsFunTy NoExtField arrow x y@(L _ y') -> do     located x p_hsType     space-    txt "->"+    case arrow of+      HsUnrestrictedArrow _ -> txt "->"+      HsLinearArrow _ -> txt "%1 ->"+      HsExplicitMult _ mult -> do+        txt "%"+        p_hsTypeR (unLoc mult)+        space+        txt "->"     interArgBreak     case y' of       HsFunTy {} -> p_hsTypeR y'@@ -185,7 +204,9 @@ hasDocStrings :: HsType GhcPs -> Bool hasDocStrings = \case   HsDocTy {} -> True-  HsFunTy _ (L _ x) (L _ y) -> hasDocStrings x || hasDocStrings y+  HsFunTy _ _ (L _ x) (L _ y) -> hasDocStrings x || hasDocStrings y+  HsForAllTy _ _ (L _ x) -> hasDocStrings x+  HsQualTy _ _ (L _ x) -> hasDocStrings x   _ -> False  p_hsContext :: HsContext GhcPs -> R ()@@ -194,22 +215,34 @@   [x] -> located x p_hsType   xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs -p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()+class IsInferredTyVarBndr flag where+  isInferred :: flag -> Bool++instance IsInferredTyVarBndr () where+  isInferred () = False++instance IsInferredTyVarBndr Specificity where+  isInferred = \case+    InferredSpec -> True+    SpecifiedSpec -> False++p_hsTyVarBndr :: IsInferredTyVarBndr flag => HsTyVarBndr flag GhcPs -> R () p_hsTyVarBndr = \case-  UserTyVar NoExtField x ->-    p_rdrName x-  KindedTyVar NoExtField l k -> parens N $ do+  UserTyVar NoExtField flag x ->+    (if isInferred flag then braces N else id) $ p_rdrName x+  KindedTyVar NoExtField flag l k -> (if isInferred flag then braces else parens) N $ do     located l atom     space     txt "::"     breakpoint     inci (located k p_hsType)-  XTyVarBndr x -> noExtCon x +data ForAllVisibility = ForAllInvis | ForAllVis+ -- | Render several @forall@-ed variables.-p_forallBndrs :: Data a => ForallVisFlag -> (a -> R ()) -> [Located a] -> R ()-p_forallBndrs ForallInvis _ [] = txt "forall."-p_forallBndrs ForallVis _ [] = txt "forall ->"+p_forallBndrs :: Data a => ForAllVisibility -> (a -> R ()) -> [Located a] -> R ()+p_forallBndrs ForAllInvis _ [] = txt "forall."+p_forallBndrs ForAllVis _ [] = txt "forall ->" p_forallBndrs vis p tyvars =   switchLayout (getLoc <$> tyvars) $ do     txt "forall"@@ -217,8 +250,8 @@     inci $ do       sitcc $ sep breakpoint (sitcc . located' p) tyvars       case vis of-        ForallInvis -> txt "."-        ForallVis -> space >> txt "->"+        ForAllInvis -> txt "."+        ForAllVis -> space >> txt "->"  p_conDeclFields :: [LConDeclField GhcPs] -> R () p_conDeclFields xs =@@ -236,7 +269,6 @@   txt "::"   breakpoint   sitcc . inci $ p_hsType (unLoc cd_fld_type)-p_conDeclField (XConDeclField x) = noExtCon x  tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName) tyOpTree (L _ (HsOpTy NoExtField l op r)) =@@ -254,18 +286,25 @@     space     p_tyOpTree r +p_lhsTypeArg :: LHsTypeArg GhcPs -> R ()+p_lhsTypeArg = \case+  HsValArg ty -> located ty p_hsType+  -- first argument is the SrcSpan of the @,+  -- but the @ always has to be directly before the type argument+  HsTypeArg _ ty -> txt "@" *> located ty p_hsType+  -- NOTE(amesgen) is this unreachable or just not implemented?+  HsArgPar _ -> notImplemented "HsArgPar"+ ---------------------------------------------------------------------------- -- Conversion functions  tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]-tyVarsToTypes = \case-  HsQTvs {..} -> fmap tyVarToType <$> hsq_explicit-  XLHsQTyVars x -> noExtCon x+tyVarsToTypes HsQTvs {..} = fmap tyVarToType <$> hsq_explicit -tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs+tyVarToType :: HsTyVarBndr () GhcPs -> HsType GhcPs tyVarToType = \case-  UserTyVar NoExtField tvar -> HsTyVar NoExtField NotPromoted tvar-  KindedTyVar NoExtField tvar kind ->+  UserTyVar NoExtField () tvar -> HsTyVar NoExtField NotPromoted tvar+  KindedTyVar NoExtField () tvar kind ->     -- Note: we always add parentheses because for whatever reason GHC does     -- not use HsParTy for left-hand sides of declarations. Please see     -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as@@ -273,4 +312,6 @@     -- declarations.     HsParTy NoExtField . noLoc $       HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind-  XTyVarBndr x -> noExtCon x++tyVarsToTyPats :: LHsQTyVars GhcPs -> HsTyPats GhcPs+tyVarsToTyPats HsQTvs {..} = HsValArg . fmap tyVarToType <$> hsq_explicit

@@ -15,8 +15,10 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, mapMaybe)-import GHC-import OccName (occNameString)+import GHC.Types.Basic+import GHC.Types.Name.Occurrence (occNameString)+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc import Ormolu.Utils (unSrcSpan)  -- | Intermediate representation of operator trees. It has two type

@@ -14,7 +14,7 @@ import Data.Generics (everything, ext2Q) import Data.List (sortOn) import Data.Typeable (cast)-import SrcLoc+import GHC.Types.SrcLoc  -- | A stream of 'RealSrcSpan's in ascending order. This allows us to tell -- e.g. whether there is another \"located\" element of AST between current@@ -43,4 +43,4 @@       case cast mspn :: Maybe SrcSpan of         Nothing -> mempty         Just (UnhelpfulSpan _) -> mempty-        Just (RealSrcSpan spn) -> D.singleton spn+        Just (RealSrcSpan spn _) -> D.singleton spn

@@ -12,12 +12,12 @@ import Data.Char (isSpace) import qualified Data.List as L import Data.Maybe (isJust, maybeToList)-import FastString+import GHC.Data.FastString+import GHC.Types.SrcLoc import Ormolu.Config (RegionDeltas (..)) import Ormolu.Parser.Shebang (isShebang) import Ormolu.Processing.Common import qualified Ormolu.Processing.Cpp as Cpp-import SrcLoc  -- | Transform given input possibly returning comments extracted from it. -- This handles LINE pragmas, CPP, shebangs, and the magic comments for@@ -30,7 +30,7 @@   -- | Region deltas   RegionDeltas ->   -- | Literal prefix, pre-processed input, literal suffix, extra comments-  (String, String, String, [Located String])+  (String, String, String, [RealLocated String]) preprocess path input RegionDeltas {..} =   go 1 OrmoluEnabled Cpp.Outside id id regionLines   where@@ -72,12 +72,12 @@   -- | The actual line   String ->   -- | Adjusted line and possibly a comment extracted from it-  (String, OrmoluState, Cpp.State, Maybe (Located String))+  (String, OrmoluState, Cpp.State, Maybe (RealLocated String)) processLine path n ormoluState Cpp.Outside line   | "{-# LINE" `L.isPrefixOf` line =     let (pragma, res) = getPragma line         size = length pragma-        ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1))+        ss = mkRealSrcSpan (mkRealSrcLoc' 1) (mkRealSrcLoc' (size + 1))      in (res, ormoluState, Cpp.Outside, Just (L ss pragma))   | isOrmoluEnable line =     case ormoluState of@@ -92,13 +92,13 @@       OrmoluDisabled ->         (disableMarker, OrmoluDisabled, Cpp.Outside, Nothing)   | isShebang line =-    let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length line))+    let ss = mkRealSrcSpan (mkRealSrcLoc' 1) (mkRealSrcLoc' (length line))      in ("", ormoluState, Cpp.Outside, Just (L ss line))   | otherwise =     let (line', cppState') = Cpp.processLine line Cpp.Outside      in (line', ormoluState, cppState', Nothing)   where-    mkSrcLoc' = mkSrcLoc (mkFastString path) n+    mkRealSrcLoc' = mkRealSrcLoc (mkFastString path) n processLine _ _ ormoluState cppState line =   let (line', cppState') = Cpp.processLine line cppState    in (line', ormoluState, cppState', Nothing)

@@ -26,7 +26,7 @@ import Control.Monad.Reader import Data.Text (Text) import qualified Data.Text.IO as T-import qualified GHC+import GHC.Types.SrcLoc import Ormolu.Utils (showOutputable) import System.Console.ANSI import System.IO (Handle, hFlush, hPutStr)@@ -115,7 +115,7 @@   liftIO $ hPutStr rcHandle str  -- | Output a 'GHC.SrcSpan'.-putSrcSpan :: GHC.SrcSpan -> Term ()+putSrcSpan :: SrcSpan -> Term () putSrcSpan = putS . showOutputable  -- | Output a newline.

@@ -10,7 +10,6 @@     notImplemented,     showOutputable,     splitDocString,-    typeArgToType,     unSrcSpan,     incSpanLine,     separatedByBlank,@@ -27,9 +26,10 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T-import GHC import GHC.DynFlags (baseDynFlags)-import qualified Outputable as GHC+import GHC.Hs+import GHC.Types.SrcLoc+import qualified GHC.Utils.Outputable as GHC  -- | Relative positions in a list. data RelativePos@@ -99,23 +99,16 @@                 then dropSpace <$> xs                 else xs --- | Get 'LHsType' out of 'LHsTypeArg'.-typeArgToType :: LHsTypeArg p -> LHsType p-typeArgToType = \case-  HsValArg tm -> tm-  HsTypeArg _ ty -> ty-  HsArgPar _ -> notImplemented "HsArgPar"- -- | Get 'RealSrcSpan' out of 'SrcSpan' if the span is “helpful”. unSrcSpan :: SrcSpan -> Maybe RealSrcSpan unSrcSpan = \case-  RealSrcSpan r -> Just r+  RealSrcSpan r _ -> Just r   UnhelpfulSpan _ -> Nothing  -- | Increment line number in a 'SrcSpan'. incSpanLine :: Int -> SrcSpan -> SrcSpan incSpanLine i = \case-  RealSrcSpan s ->+  RealSrcSpan s _ ->     let start = realSrcSpanStart s         end = realSrcSpanEnd s         incLine x =@@ -123,7 +116,7 @@               line = srcLocLine x               col = srcLocCol x            in mkRealSrcLoc file (line + i) col-     in RealSrcSpan (mkRealSrcSpan (incLine start) (incLine end))+     in RealSrcSpan (mkRealSrcSpan (incLine start) (incLine end)) Nothing   UnhelpfulSpan x -> UnhelpfulSpan x  -- | Do two declarations have a blank between them?

@@ -23,6 +23,7 @@     stdTest "joined-hunk" "main-and-bar" "main-and-bar-v2"     stdTest "two-hunks" "main-and-baz" "main-and-baz-v2"     stdTest "trimming" "spaced" "spaced-v2"+    stdTest "trailing-blank-line" "no-trailing-blank-line" "with-trailing-blank-line"  -- | Test diff printig. stdTest ::

@@ -0,0 +1,32 @@+{-# LANGUAGE LambdaCase #-}++module Ormolu.Parser.OptionsSpec (spec) where++import qualified Data.Text as T+import Ormolu+import Test.Hspec++spec :: Spec+spec = describe "GHC options in source files take priority" $ do+  it "default extensions can be disabled locally" $ do+    let src =+          unlines+            [ "{-# LANGUAGE NoBlockArguments #-}",+              "",+              "test = test do test"+            ]+    fixedPoint [] src `shouldThrow` \case+      OrmoluParsingFailed {} -> True+      _ -> False+  it "extensions disabled via CLI can be enabled locally" $ do+    let src =+          unlines+            [ "{-# LANGUAGE BlockArguments #-}",+              "",+              "test = test do test"+            ]+    fixedPoint ["-XNoBlockArguments"] src+  where+    fixedPoint opts input = do+      output <- ormolu defaultConfig {cfgDynOptions = DynOption <$> opts} "<input>" input+      T.unpack output `shouldBe` input