ormolu 0.7.7.0 → 0.8.2.0

raw patch · 175 files changed

Files

• CHANGELOG.md +154/−29
• CONTRIBUTING.md +10/−4
• DESIGN.md +28/−28
• LICENSE.md +2/−2
• README.md +34/−13
• app/Main.hs +27/−12
• data/examples/declaration/data/linear-out.hs +11/−0
• data/examples/declaration/data/linear.hs +10/−0
• data/examples/declaration/data/record-out.hs +1/−1
• data/examples/declaration/data/record.hs +1/−1
• data/examples/declaration/data/required-type-arguments-out.hs +27/−0
• data/examples/declaration/data/required-type-arguments.hs +24/−0
• data/examples/declaration/data/wildcard-binders-out.hs +1/−0
• data/examples/declaration/data/wildcard-binders.hs +1/−0
• data/examples/declaration/default/default-out.hs +8/−0
• data/examples/declaration/default/default.hs +7/−0
• data/examples/declaration/foreign/foreign-import-multiline-out.hs +8/−0
• data/examples/declaration/foreign/foreign-import-multiline.hs +6/−0
• data/examples/declaration/rewrite-rule/prelude2-out.hs +1/−1
• data/examples/declaration/rewrite-rule/prelude2.hs +1/−1
• data/examples/declaration/signature/fixity/infix-out.hs +2/−0
• data/examples/declaration/signature/fixity/infix.hs +2/−0
• data/examples/declaration/signature/specialize/specialize-2-out.hs +8/−0
• data/examples/declaration/signature/specialize/specialize-2.hs +9/−0
• data/examples/declaration/signature/specialize/specialize-3-out.hs +10/−0
• data/examples/declaration/signature/specialize/specialize-3.hs +4/−0
• data/examples/declaration/type/promotion-no-puns-out.hs +5/−0
• data/examples/declaration/type/promotion-no-puns.hs +5/−0
• data/examples/declaration/type/wildcard-binders-out.hs +1/−0
• data/examples/declaration/type/wildcard-binders.hs +1/−0
• data/examples/declaration/value/function/arrow/proc-do-complex-out.hs +1/−1
• data/examples/declaration/value/function/arrow/proc-do-complex.hs +1/−1
• data/examples/declaration/value/function/arrow/proc-form-do-indent-out.hs +7/−0
• data/examples/declaration/value/function/arrow/proc-form-do-indent.hs +5/−0
• data/examples/declaration/value/function/case-single-line-with-braces-out.hs +2/−0
• data/examples/declaration/value/function/case-single-line-with-braces.hs +2/−0
• data/examples/declaration/value/function/case-with-comment-before-where-out.hs +14/−0
• data/examples/declaration/value/function/case-with-comment-before-where.hs +14/−0
• data/examples/declaration/value/function/do-multiline-with-case-out.hs +13/−0
• data/examples/declaration/value/function/do-multiline-with-case.hs +13/−0
• data/examples/declaration/value/function/do-single-line-case-guards-out.hs +2/−0
• data/examples/declaration/value/function/do-single-line-case-guards.hs +2/−0
• data/examples/declaration/value/function/do-single-line-lambda-case-out.hs +2/−0
• data/examples/declaration/value/function/do-single-line-lambda-case.hs +2/−0
• data/examples/declaration/value/function/do-single-line-multiple-cases-out.hs +2/−0
• data/examples/declaration/value/function/do-single-line-multiple-cases.hs +2/−0
• data/examples/declaration/value/function/do-single-line-nested-case-out.hs +2/−0
• data/examples/declaration/value/function/do-single-line-nested-case.hs +2/−0
• data/examples/declaration/value/function/do-single-line-with-case-out.hs +2/−0
• data/examples/declaration/value/function/do-single-line-with-case.hs +2/−0
• data/examples/declaration/value/function/guards-out.hs +2/−0
• data/examples/declaration/value/function/guards.hs +2/−0
• data/examples/declaration/value/function/infix/dollar-chains-1-out.hs +3/−3
• data/examples/declaration/value/function/infix/dollar-chains-3-out.hs +8/−8
• data/examples/declaration/value/function/infix/dollar-chains-4-out.hs +4/−4
• data/examples/declaration/value/function/infix/fractional-precedence-out.hs +3/−0
• data/examples/declaration/value/function/infix/fractional-precedence.hs +3/−0
• data/examples/declaration/value/function/infix/lenses-out.hs +8/−8
• data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-1-out.hs +8/−8
• data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-2-out.hs +8/−8
• data/examples/declaration/value/function/infix/op-chain-r-s-dollar-out.hs +4/−4
• data/examples/declaration/value/function/infix/qualified-ops-out.hs +8/−8
• data/examples/declaration/value/function/linear-bindings-out.hs +9/−0
• data/examples/declaration/value/function/linear-bindings.hs +9/−0
• data/examples/declaration/value/function/multi-way-if-out.hs +2/−0
• data/examples/declaration/value/function/multi-way-if.hs +2/−0
• data/examples/declaration/value/function/multiline-strings-0-out.hs +29/−0
• data/examples/declaration/value/function/multiline-strings-0.hs +31/−0
• data/examples/declaration/value/function/multiline-strings-1-out.hs +12/−0
• data/examples/declaration/value/function/multiline-strings-1.hs +13/−0
• data/examples/declaration/value/function/multiline-strings-2-out.hs +11/−0
• data/examples/declaration/value/function/multiline-strings-2.hs +11/−0
• data/examples/declaration/value/function/multiline-strings-3-out.hs +32/−0
• data/examples/declaration/value/function/multiline-strings-3.hs +32/−0
• data/examples/declaration/value/function/multiline-strings-4-out.hs +25/−0
• data/examples/declaration/value/function/multiline-strings-4.hs +26/−0
• data/examples/declaration/value/function/multiline-strings-5-out.hs +26/−0
• data/examples/declaration/value/function/multiline-strings-5.hs +26/−0
• data/examples/declaration/value/function/multiline-strings-6-out.hs +10/−0
• data/examples/declaration/value/function/multiline-strings-6.hs +10/−0
• data/examples/declaration/value/function/multiline-strings-7-out.hs +30/−0
• data/examples/declaration/value/function/multiline-strings-7.hs +30/−0
• data/examples/declaration/value/function/multiline-strings-8-out.hs +12/−0
• data/examples/declaration/value/function/multiline-strings-8.hs +9/−0
• data/examples/declaration/value/function/multiline-strings-9-out.hs +11/−0
• data/examples/declaration/value/function/multiline-strings-9.hs +11/−0
• data/examples/declaration/value/function/pattern/or-patterns-out.hs +44/−0
• data/examples/declaration/value/function/pattern/or-patterns.hs +39/−0
• data/examples/declaration/value/function/required-type-arguments-2-out.hs +23/−0
• data/examples/declaration/value/function/required-type-arguments-2.hs +14/−0
• data/examples/declaration/value/function/strings-out.hs +5/−1
• data/examples/declaration/value/function/strings.hs +4/−0
• data/examples/declaration/value/function/type-applications-out.hs +2/−0
• data/examples/declaration/value/function/type-applications.hs +2/−0
• data/examples/fixity/megaparsec-alternative-out.hs +8/−0
• data/examples/fixity/megaparsec-alternative.hs +8/−0
• data/examples/fixity/optics-mixed-out.hs +8/−0
• data/examples/fixity/optics-mixed.hs +8/−0
• data/examples/fixity/relude-default-operator-chain-out.hs +10/−0
• data/examples/fixity/relude-default-operator-chain.hs +10/−0
• data/examples/fixity/relude-default-operator-out.hs +7/−0
• data/examples/fixity/relude-default-operator.hs +7/−0
• data/examples/fixity/rio-ampersand-out.hs +7/−0
• data/examples/fixity/rio-ampersand.hs +7/−0
• data/examples/fixity/rio-deepseq-out.hs +7/−0
• data/examples/fixity/rio-deepseq.hs +7/−0
• data/examples/import/data-out.hs +3/−0
• data/examples/import/data.hs +6/−0
• data/examples/import/explicit-level-imports-out.hs +13/−0
• data/examples/import/explicit-level-imports-qualified-post-out.hs +5/−0
• data/examples/import/explicit-level-imports-qualified-post.hs +5/−0
• data/examples/import/explicit-level-imports.hs +14/−0
• data/examples/import/implicit-prelude-package-out.hs +7/−0
• data/examples/import/implicit-prelude-package.hs +7/−0
• data/examples/import/no-implicit-prelude-out.hs +6/−0
• data/examples/import/no-implicit-prelude-package-out.hs +8/−0
• data/examples/import/no-implicit-prelude-package.hs +8/−0
• data/examples/import/no-implicit-prelude.hs +6/−0
• data/examples/module-header/block-haddock-in-export-list-out.hs +5/−0
• data/examples/module-header/block-haddock-in-export-list.hs +1/−0
• data/examples/other/comment-trailing-blank-line-do-out.hs +4/−0
• data/examples/other/comment-trailing-blank-line-do.hs +4/−0
• data/examples/other/comment-trailing-blank-line-let-out.hs +5/−0
• data/examples/other/comment-trailing-blank-line-let.hs +5/−0
• data/examples/other/comment-trailing-blank-line-variants-out.hs +22/−0
• data/examples/other/comment-trailing-blank-line-variants.hs +22/−0
• data/examples/other/comment-trailing-blank-line-where-out.hs +5/−0
• data/examples/other/comment-trailing-blank-line-where.hs +5/−0
• data/examples/other/comment-trailing-no-blank-line-out.hs +25/−0
• data/examples/other/comment-trailing-no-blank-line.hs +25/−0
• data/examples/other/empty-forall-out.hs +1/−1
• extract-hackage-info/hackage-info.bin binary
• ormolu.cabal +195/−180
• src/GHC/DynFlags.hs +6/−0
• src/Ormolu.hs +3/−2
• src/Ormolu/Diff/ParseResult.hs +44/−20
• src/Ormolu/Diff/Text.hs +0/−4
• src/Ormolu/Fixity.hs +1/−16
• src/Ormolu/Fixity/Internal.hs +33/−65
• src/Ormolu/Fixity/Parser.hs +3/−1
• src/Ormolu/Fixity/Printer.hs +11/−1
• src/Ormolu/Imports.hs +44/−22
• src/Ormolu/Parser.hs +47/−13
• src/Ormolu/Printer.hs +3/−1
• src/Ormolu/Printer/Combinators.hs +26/−2
• src/Ormolu/Printer/Internal.hs +18/−4
• src/Ormolu/Printer/Meat/Common.hs +27/−10
• src/Ormolu/Printer/Meat/Declaration.hs +8/−1
• src/Ormolu/Printer/Meat/Declaration/Class.hs +7/−2
• src/Ormolu/Printer/Meat/Declaration/Data.hs +65/−67
• src/Ormolu/Printer/Meat/Declaration/Default.hs +6/−1
• src/Ormolu/Printer/Meat/Declaration/Foreign.hs +7/−2
• src/Ormolu/Printer/Meat/Declaration/OpTree.hs +22/−9
• src/Ormolu/Printer/Meat/Declaration/Rule.hs +15/−13
• src/Ormolu/Printer/Meat/Declaration/Signature.hs +67/−14
• src/Ormolu/Printer/Meat/Declaration/Signature.hs-boot +14/−0
• src/Ormolu/Printer/Meat/Declaration/StringLiteral.hs +174/−0
• src/Ormolu/Printer/Meat/Declaration/Type.hs +9/−2
• src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs +9/−4
• src/Ormolu/Printer/Meat/Declaration/Value.hs +174/−178
• src/Ormolu/Printer/Meat/Declaration/Value.hs-boot +0/−3
• src/Ormolu/Printer/Meat/ImportExport.hs +34/−6
• src/Ormolu/Printer/Meat/Module.hs +29/−28
• src/Ormolu/Printer/Meat/Type.hs +109/−69
• src/Ormolu/Printer/Operators.hs +3/−3
• src/Ormolu/Processing/Preprocess.hs +13/−6
• src/Ormolu/Utils.hs +0/−8
• src/Ormolu/Utils/Cabal.hs +7/−8
• src/Ormolu/Utils/Fixity.hs +4/−7
• src/Ormolu/Utils/IO.hs +45/−25
• tests/Ormolu/CabalInfoSpec.hs +1/−1
• tests/Ormolu/Fixity/ParserSpec.hs +23/−1
• tests/Ormolu/Fixity/PrinterSpec.hs +6/−1
• tests/Ormolu/FixitySpec.hs +7/−19
• tests/Ormolu/PrinterSpec.hs +8/−1

@@ -1,3 +1,128 @@+## Ormolu 0.8.2.0++* Overhaul how operator fixity information is collected. In addition to the+  Hoogle database, Ormolu now parses the sources of a curated set of important+  packages directly, which yields more accurate and complete fixity data than+  before. In particular it recovers fixities for operators re-exported through+  umbrella modules (e.g. `Servant.API`, `Control.Lens`) that recent Hoogle+  databases no longer record. As a result, formatting of operator chains is+  improved out of the box, and users should expect some operator-heavy code to+  be laid out differently (and more correctly) than in previous releases.++* Improve the layout of chains of `infixr 0` operators (`$`, `seq`, `?:`, and+  the like). Such operators are only laid out in the trailing "staircase" style+  when it is warranted: either the chain consists of a single operator, or its+  final operand is a hanging construct (a `do` block, lambda, `case`, etc.). A+  chain of several such operators that ends in an ordinary expression is now+  laid out with the operators in the leading position instead of an+  ever-deepening pyramid. [Issue+  1151](https://github.com/tweag/ormolu/issues/1151).++* Do not crash when a parent directory cannot be read due to insufficient+  permissions while searching for configuration files; the search for+  configuration files is stopped at that point instead. [Issue+  1212](https://github.com/tweag/ormolu/issues/1212).++* Preserve blank lines between blocks in layout contexts (`where`, `do`,+  `let`) when the preceding block ends with a trailing comment. [Issue+  1132](https://github.com/tweag/ormolu/issues/1132).++* Fix printing of single line export lists with inlined Haddock comments.+  [Issue 1051](https://github.com/tweag/ormolu/issues/1051).++* Fix preservation of the position of comments around the `where` keyword.+  [Issue 784](https://github.com/tweag/ormolu/issues/784).++* Do not sort `Prelude` to the end of the import list when the+  `NoImplicitPrelude` extension is enabled; instead sort it like any other+  import. [Issue 1189](https://github.com/tweag/ormolu/issues/1189).++## Ormolu 0.8.1.1++* Add missing braces for case expressions in single‑line do blocks. [Issue+  1180](https://github.com/tweag/ormolu/issues/1180).++* Fix the import grouping logic in the presence of imports with explicit+  levels. [Issue 1192](https://github.com/tweag/ormolu/issues/1192).++## Ormolu 0.8.1.0++* Fix printing of guards on pattern binds. [Issue+  1178](https://github.com/tweag/ormolu/issues/1178).++* Switched to `ghc-lib-parser-9.14`, with the following new syntactic features:+   * GHC proposal [#493](https://github.com/ghc-proposals/ghc-proposals/blob/e2c683698323cec3e33625369ae2b5f585387c70/proposals/0493-specialise-expressions.rst): expressions in SPECIALISE pragmas+   * Multiline strings in foreign import declarations.+   * `ExplicitNamespaces` supports the `data` namespace specifier in import and export lists, replacing `pattern`.+   * `LinearTypes` adds new syntax to support non-linear record fields.+   * `RequiredTypeArguments` allows visible forall in GADT syntax.++* Updated to `Cabal-syntax-3.16`.++* Correctly format string literals containing the `\^\` escape sequence. [Issue+  1165](https://github.com/tweag/ormolu/issues/1165).++* Correctly preserve consecutive blank lines in multiline strings. [Issue+  1194](https://github.com/tweag/ormolu/issues/1194).++* Fix printing of multi-line or-patterns inside as-patterns. [Issue+  1183](https://github.com/tweag/ormolu/issues/1183).++* Fix an issue where or-patterns would be indented twice. [Issue+  1188](https://github.com/tweag/ormolu/issues/1188).++* Add support for `ExplicitLevelImports`. [Issue+  1192](https://github.com/tweag/ormolu/issues/1192).++## Ormolu 0.8.0.2++* Fix a performance regression introduced in 0.8.0.0. [Issue+  1176](https://github.com/tweag/ormolu/issues/1176).++## Ormolu 0.8.0.1++* Correctly format edge cases where fully collapsing string gaps changes the+  string represented by a string literal. [Issue+  1160](https://github.com/tweag/ormolu/issues/1160).++* Fix false positives in AST diffing in fixity declarations with implicit+  fixity, such as `infix +`. [Issue+  1166](https://github.com/tweag/ormolu/issues/1166).++* Make multiline function signatures in RequiredTypeArguments consistent with+  types [PR 1170](https://github.com/tweag/ormolu/pull/1170).++* Correctly format single-line `MultiWayIf`s. [Issue+  1171](https://github.com/tweag/ormolu/issues/1171).++## Ormolu 0.8.0.0++* Format multiple files in parallel. [Issue+  1128](https://github.com/tweag/ormolu/issues/1128).++* Fractional precedences are now allowed in `.ormolu` files for more precise+  control over formatting of complex operator chains. [Issue+  1106](https://github.com/tweag/ormolu/issues/1106).++* Correctly format type applications of `QuasiQuotes`. [Issue+  1134](https://github.com/tweag/ormolu/issues/1134).++* Correctly format multi-line parentheses in arrow `do` blocks. [Issue+  1144](https://github.com/tweag/ormolu/issues/1144).++* Switched to `ghc-lib-parser-9.12`, with the following new syntactic features:+   * GHC proposal [#522](https://github.com/ghc-proposals/ghc-proposals/blob/c9401f037cb22d1661931b2ec621925101052997/proposals/0522-or-patterns.rst): `OrPatterns` (enabled by default)+   * GHC proposal [#569](https://github.com/ghc-proposals/ghc-proposals/blob/c9401f037cb22d1661931b2ec621925101052997/proposals/0569-multiline-strings.rst): `MultilineStrings` (disabled by default)+   * GHC proposal [#409](https://github.com/ghc-proposals/ghc-proposals/blob/f79438cf8dbfcd90187f7af3a380515ffe45dbdc/proposals/0409-exportable-named-default.rst): `NamedDefaults` (enabled by default)+   * GHC proposal [#281](https://github.com/ghc-proposals/ghc-proposals/blob/c9401f037cb22d1661931b2ec621925101052997/proposals/0281-visible-forall.rst): accept more types in terms: `forall` quantifications, constraint arrows `=>`, type arrows `->` (enabled by default)+   * Part of GHC proposal [#425](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0425-decl-invis-binders.rst): wildcard binders (enabled by default)++* Correctly format non-promoted type-level tuples with `NoListTuplePuns`. [Issue+  1146](https://github.com/tweag/ormolu/issues/1146).++* Updated to `Cabal-syntax-3.14`. [Issue+  1152](https://github.com/tweag/ormolu/issues/1152).+ ## Ormolu 0.7.7.0  * Use single-line layout for parens around single-line content. [Issue@@ -219,7 +344,7 @@  ## Ormolu 0.5.0.1 -* Fixed a bug in the diff printing functionality. [Issue+* Fix a bug in the diff printing functionality. [Issue   886](https://github.com/tweag/ormolu/issues/886).  * Indent closing bracket for list comprehensions in `do` blocks.@@ -468,7 +593,7 @@ * Now `--mode check` fails on missing trailing blank lines. [Issue   743](https://github.com/tweag/ormolu/issues/743). -* Fixed indentation of arrow forms in do blocks. [Issue+* Fix indentation of arrow forms in do blocks. [Issue   739](https://github.com/tweag/ormolu/issues/739).  ## Ormolu 0.1.4.1@@ -481,7 +606,7 @@ * Added support for monad comprehensions. [Issue   665](https://github.com/tweag/ormolu/issues/665). -* Fixed a bug when a space was inserted in front of promoted types even when+* Fix a bug when a space was inserted in front of promoted types even when   it wasn't strictly necessary. [Issue   668](https://github.com/tweag/ormolu/issues/668). @@ -491,7 +616,7 @@  ## Ormolu 0.1.3.1 -* Fixed a problem with multiline record updates using the record dot+* Fix a problem with multiline record updates using the record dot   preprocessor. [Issue 658](https://github.com/tweag/ormolu/issues/658).  ## Ormolu 0.1.3.0@@ -507,7 +632,7 @@  ## Ormolu 0.1.2.0 -* Fixed the bug when comments in different styles got glued together after+* Fix the bug when comments in different styles got glued together after   formatting. [Issue 589](https://github.com/tweag/ormolu/issues/589).  * Added `-i` as a shortcut for `--mode inplace`. [Issue@@ -532,48 +657,48 @@ * Improved sorting of operators in imports. [Issue   602](https://github.com/tweag/ormolu/issues/602). -* Fixed a bug related to trailing space in multiline comments in certain+* Fix a bug related to trailing space in multiline comments in certain   cases. [Issue 603](https://github.com/tweag/ormolu/issues/602).  * Added support for formatting linked lists with `(:)` as line terminator.   [Issue 478](https://github.com/tweag/ormolu/issues/478). -* Fixed rendering of function arguments in multiline layout. [Issue+* Fix rendering of function arguments in multiline layout. [Issue   609](https://github.com/tweag/ormolu/issues/609).  * Blank lines between definitions in `let` and `while` bindings are now   preserved. [Issue 554](https://github.com/tweag/ormolu/issues/554). -* Fixed the bug when type applications stuck to the `$` of TH splices that+* Fix the bug when type applications stuck to the `$` of TH splices that   followed them. [Issue 613](https://github.com/tweag/ormolu/issues/613).  * Improved region formatting so that indented fragments—such as definitions   inside of `where` clauses—can be formatted. [Issue   572](https://github.com/tweag/ormolu/issues/572). -* Fixed the bug related to the de-association of pragma comments. [Issue+* Fix the bug related to the de-association of pragma comments. [Issue   619](https://github.com/tweag/ormolu/issues/619).  ## Ormolu 0.1.0.0 -* Fixed rendering of type signatures concerning several identifiers. [Issue+* Fix rendering of type signatures concerning several identifiers. [Issue   566](https://github.com/tweag/ormolu/issues/566). -* Fixed an idempotence issue with inline comments in tuples and parentheses.+* Fix an idempotence issue with inline comments in tuples and parentheses.   [Issue 450](https://github.com/tweag/ormolu/issues/450). -* Fixed an idempotence issue when certain comments were picked up as+* Fix an idempotence issue when certain comments were picked up as   “continuation” of a series of comments [Issue   449](https://github.com/tweag/ormolu/issues/449). -* Fixed an idempotence issue related to different indentation levels in a+* Fix an idempotence issue related to different indentation levels in a   comment series. [Issue 512](https://github.com/tweag/ormolu/issues/512). -* Fixed an idempotence issue related to comments which may happen to be+* Fix an idempotence issue related to comments which may happen to be   separated from the elements they are attached to by the equality sign.   [Issue 340](https://github.com/tweag/ormolu/issues/340). -* Fixed an idempotence issue with type synonym and data declarations where+* Fix an idempotence issue with type synonym and data declarations where   the type has a Haddock. [Issue   578](https://github.com/tweag/ormolu/issues/578). @@ -581,17 +706,17 @@   multiple blank lines in a row. [Issue   518](https://github.com/tweag/ormolu/issues/518). -* Fixed rendering of comments around if expressions. [Issue+* Fix rendering of comments around if expressions. [Issue   458](https://github.com/tweag/ormolu/issues/458).  * Unnamed fields of data constructors are now documented using the `-- ^`   syntax. [Issue 445](https://github.com/tweag/ormolu/issues/445) and [Issue   428](https://github.com/tweag/ormolu/issues/428). -* Fixed non-idempotent transformation of partly documented data definition.+* Fix non-idempotent transformation of partly documented data definition.   [Issue 590](https://github.com/tweag/ormolu/issues/590). -* Fixed an idempotence issue related to operators. [Issue+* Fix an idempotence issue related to operators. [Issue   522](https://github.com/tweag/ormolu/issues/522).  * Renamed the `--check-idempotency` flag to `--check-idempotence`.@@ -618,7 +743,7 @@   select a region to format. [Issue   516](https://github.com/tweag/ormolu/issues/516). -* Fixed rendering of module headers in the presence of preceding comments or+* Fix rendering of module headers in the presence of preceding comments or   Haddocks. [Issue 561](https://github.com/tweag/ormolu/issues/561).  ## Ormolu 0.0.4.0@@ -639,7 +764,7 @@   now put on its own line. [Issue   509](https://github.com/tweag/ormolu/issues/509). -* Fixed the bug pertaining to rendering of arrow notation with multiline+* Fix the bug pertaining to rendering of arrow notation with multiline   expressions. [Issue 513](https://github.com/tweag/ormolu/issues/513).  * Made rendering of data type definitions, value-level applications, and@@ -657,15 +782,15 @@  ## Ormolu 0.0.3.1 -* Fixed rendering of record updates with the record dot preprocessor syntax+* Fix rendering of record updates with the record dot preprocessor syntax   [Issue 498](https://github.com/tweag/ormolu/issues/498).  ## Ormolu 0.0.3.0 -* Fixed an issue related to unnecessary use of curly braces. [Issue+* Fix an issue related to unnecessary use of curly braces. [Issue   473](https://github.com/tweag/ormolu/issues/473). -* Fixed the issue with formatting multi-way if when it happens to be a+* Fix the issue with formatting multi-way if when it happens to be a   function applied to arguments [Issue   488](https://github.com/tweag/ormolu/issues/488). This changed the way   multi-line if is formatted in general.@@ -677,7 +802,7 @@   potentially-hanging consturctions in the presence of comments. [Issue   447](https://github.com/tweag/ormolu/issues/447). -* Fixed indentation in presence of type applications. [Issue+* Fix indentation in presence of type applications. [Issue   493](https://github.com/tweag/ormolu/issues/493).  * Class and instance declarations now do not have a blank line after@@ -695,20 +820,20 @@ * Now unrecognized GHC options passed with `--ghc-opt` cause Ormolu to fail   (exit code 7). -* Fixed formatting of result type in closed type families. See [issue+* Fix formatting of result type in closed type families. See [issue   420](https://github.com/tweag/ormolu/issues/420). -* Fixed a minor inconsistency between formatting of normal and foreign type+* Fix a minor inconsistency between formatting of normal and foreign type   signatures. See [issue 408](https://github.com/tweag/ormolu/issues/408). -* Fixed a bug when comment before module header with Haddock was moved+* Fix a bug when comment before module header with Haddock was moved   inside the export list. See [issue   430](https://github.com/tweag/ormolu/issues/430).  * Empty `forall`s are now correctly preserved. See [issue   429](https://github.com/tweag/ormolu/issues/429). -* Fixed [issue 446](https://github.com/tweag/ormolu/issues/446), which+* Fix [issue 446](https://github.com/tweag/ormolu/issues/446), which   involved braces and operators.  * When there are comments between preceding Haddock (pipe-style) and its@@ -728,7 +853,7 @@ * Sorting language pragmas cannot not change meaning of the input program   anymore. [Issue 404](https://github.com/tweag/ormolu/issues/404). -* Fixed formatting of applications where function is a complex expression.+* Fix formatting of applications where function is a complex expression.   [Issue 444](https://github.com/tweag/ormolu/issues/444).  ## Ormolu 0.0.1.0

@@ -33,14 +33,20 @@ inspiration.  Please note that we try to keep individual files at most 25 lines long-because otherwise it's hard to figure out want went wrong when a test fails.+because otherwise it's hard to figure out what went wrong when a test fails.  To regenerate outputs that have changed, you can set the `ORMOLU_REGENERATE_EXAMPLES` environment variable before running tests.  ## Formatting -Use `nix run .#format` script to format Ormolu with the current version of-Ormolu. If Ormolu is not formatted like this, the CI will fail.+ - Use `nix run .#format` script to format Ormolu with the current version of+   Ormolu. -[issues]: https://github.com/tweag/ormolu/issues+ - Additional formatters are configured via a pre-commit hook which is+   automatically installed when entering the Nix shell. You can also run it via+   `pre-commit run`/`pre-commit run -a`.++If Ormolu is not formatted like this, the CI will fail.++[issues]: https://github.com/mrkkrp/ormolu/issues

@@ -19,10 +19,10 @@     * [Why not contribute to/fork Hindent or Brittany?](#why-not-contribute-tofork-hindent-or-brittany) * [Examples](#examples) -This document describes design of a new formatter for Haskell source code.+This document describes the design of a new formatter for Haskell source code. It also includes recommendations for future implementers. -We set for the following goals (mostly taken from+We set the following goals (mostly taken from [brittany](https://github.com/lspitzner/brittany)): * Preserve the meaning of the formatted functions when no CPP is used; * Make reasonable use of screen space;@@ -38,12 +38,12 @@ ### Brittany  [Brittany][brittany] builds on top of [`ghc-exactprint`][ghc-exactprint]—a-library that uses parser of GHC itself for parsing and thus it guarantees-that at least parsing phase is bug-free (which is admittedly the cause of-majority of bugs in other projects, see below).+library that uses the parser of GHC itself for parsing and thus it guarantees+that at least the parsing phase is bug-free (which is admittedly the cause of+the majority of bugs in other projects, see below). -After parsing, Haskell AST and a collection of annotations are available.-The annotations are there because Haskell AST doesn't provide enough+After parsing, the Haskell AST and a collection of annotations are available.+The annotations are there because the Haskell AST doesn't provide enough information to reconstruct source code (for example it doesn't include comments). The AST and the annotations are converted into a `BriDoc` value. A `BriDoc` value is a document representation like the `Doc` from the@@ -65,13 +65,13 @@ of which fit in linear space. So care is necessary to keep memory bounded. -The compexities of the `BriDoc` structure, together with the lack of+The complexities of the `BriDoc` structure, together with the lack of documentation, make Brittany at least challenging to maintain.  ### Hindent  [Hindent][hindent] uses [`haskell-src-exts`][haskell-src-exts] for parsing-like all older projects. `haskell-src-exts` does not use parser of GHC+like all older projects. `haskell-src-exts` does not use the parser of GHC itself, and is a source of endless parsing bugs. `Hindent` is affected by these upstream issues as well as Stylish Haskell and Haskell formatter (see below). This already makes all these projects unusable with some valid@@ -83,13 +83,13 @@ that the 70-80% of what the code does is a printing traversal.  Hindent code is easier to read and debug. Pretty-printing functions are-very straightforward. If there is a bug (in pretty-printer, not in parser+very straightforward. If there is a bug (in the pretty-printer, not in the parser which Hindent cannot control), it's easy to fix AFAIU.  Hindent is also notable for its ability to handle CPP and inputs that do not-constitute complete modules. It splits input stream into so-called “code+constitute complete modules. It splits the input stream into so-called “code blocks” recognizing CPP macros and then only pretty-prints “normal code”-without touching CPP directives. After that CPP is inserted between+without touching CPP directives. After that, CPP is inserted between pretty-printed blocks of source code. The approach fails when CPP breaks code in such a way that separate blocks do not form valid Haskell expressions, see@@ -98,20 +98,20 @@ Looking at the bug tracker there are many bugs. Part of them is because of the use of `haskell-src-exts`, the other part is because the maintainer doesn't care (anymore?) and doesn't fix them. Well it's as simple as that,-with any sort of commercial backing the bugs in pretty printer would be-fixed long time ago.+with any sort of commercial backing the bugs in the pretty printer would+have been fixed a long time ago.  ### Stylish Haskell  [Stylish Haskell][stylish-haskell] also uses `haskell-src-exts` and suffers from the same upstream problems. I haven't studied the transformations it performs, but it looks like it transforms the parsed source code partially-by manipulating AST and partially by manipulating raw text (e.g. to drop-trailing whitespace from each line). CPP Macros are just filtered out+by manipulating the AST and partially by manipulating raw text (e.g. to drop+trailing whitespace from each line). CPP macros are just filtered out silently as a preprocessing step before feeding the code to `haskell-src-exts`. -Stylish Haskell is not so invasive as the other formatters and most reported+Stylish Haskell is not as invasive as the other formatters and most reported bugs are about parsing issues and CPP. As I understand it, people mostly use it to sort their import lists. @@ -147,7 +147,7 @@  There are the following challenges when formatting a module with CPP: -* GHC parser won't accept anything but a valid, complete module. Therefore,+* The GHC parser won't accept anything but a valid, complete module. Therefore,   formatting the Haskell code between CPP directives is not an option.  * Ignoring the CPP directives and formatting the Haskell code can change@@ -226,7 +226,7 @@ code to avoid changing the meaning by reformatting. But this would introduce additional complexity, and the problem would need to be solved repeatedly for every tool out there which wants-to parse Haskell modules. If CPP is replaced with some language+to parse Haskell modules. If CPP is replaced by some language extension or mechanism to do conditional compilation, all tools will benefit from it. @@ -313,7 +313,7 @@ might be used in multiple projects, and we prefer to have it formatted the same in all of them. -See this [this+See [this post][hindent-5-blog] by Chris Done (the author of Hindent) which says that as long as the default style is conventional and good it doesn't really matter how code gets formatted. Consistency is more important.@@ -323,10 +323,10 @@ Some language extensions affect how parsing is done. We are going to deal with those in two ways: -* When language pragmas are present in source file, we must parse them+* When language pragmas are present in the source file, we must parse them   before we run the main parser (I guess) and they should determine how the   main parsing will be done.-* There also should be configuration file that may enable other language+* There should also be a configuration file that may enable other language   extensions to be used on all files. * Later we could try to locate Cabal files and fetch the list of extensions   that are enabled by default from there.@@ -337,11 +337,11 @@ pretty-printing code and new issues are discovered. For each Haskell module that we want to test, we perform the following steps: -1. Given input snippet of source code parse it and pretty print it.-2. Parse the result of pretty-printing again and make sure that AST is the-   same as AST of original snippet module span positions. We could make+1. Given an input snippet of source code, parse it and pretty print it.+2. Parse the result of pretty-printing again and make sure that the AST is the+   same as the AST of the original snippet module span positions. We could make    this part of a self-check in the formatter.-3. Check the output against expected output. Thus all tests should include+3. Check the output against the expected output. Thus all tests should include    two files: input and expected output. 4. Check that running the formatter on the output produces the same output    again (the transformation is idempotent).@@ -386,8 +386,8 @@ Forking or contributing to Hindent is not an option because if we replace `haskell-src-exts` with `ghc` (or `ghc-exact-print`) then we'll have to work with a different AST type and all the code in Hindent will become-incompatible and there won't be much code to be re-used in that case. It is-also possible that we'll find a nicer way to write pretty-printer.+incompatible and there won't be much code to be reused in that case. It is+also possible that we'll find a nicer way to write the pretty-printer.  ## Examples 

@@ -1,4 +1,4 @@-Copyright © 2018–present Tweag I/O+Copyright © 2018–2026 Tweag I/O, 2026–present Mark Karpov  All rights reserved. @@ -12,7 +12,7 @@   notice, this list of conditions and the following disclaimer in the   documentation and/or other materials provided with the distribution. -* Neither the name Tweag I/O nor the names of contributors may be used to+* Neither the names Tweag I/O and Mark Karpov nor the names of contributors may be used to   endorse or promote products derived from this software without specific   prior written permission. 

@@ -4,7 +4,7 @@ [![Hackage](https://img.shields.io/hackage/v/ormolu.svg?style=flat)](https://hackage.haskell.org/package/ormolu) [![Stackage Nightly](http://stackage.org/package/ormolu/badge/nightly)](http://stackage.org/nightly/package/ormolu) [![Stackage LTS](http://stackage.org/package/ormolu/badge/lts)](http://stackage.org/lts/package/ormolu)-[![CI](https://github.com/tweag/ormolu/actions/workflows/ci.yml/badge.svg)](https://github.com/tweag/ormolu/actions/workflows/ci.yml)+[![CI](https://github.com/mrkkrp/ormolu/actions/workflows/ci.yml/badge.svg)](https://github.com/mrkkrp/ormolu/actions/workflows/ci.yml)  * [Installation](#installation) * [Building from source](#building-from-source)@@ -46,7 +46,7 @@ * Be well-tested and robust so that the formatter can be used in large   projects. -Try it out in your browser at <https://ormolu-live.tweag.io>!+Try it out in your browser at <https://ormolu-live.markkarpov.com>! See [Ormolu Live](#ormolu-live) for more info.  ## Installation@@ -75,9 +75,24 @@ $ nix build ``` -Make sure to accept the offered Nix caches (in particular the IOG cache),-otherwise building may take a very long time.+Make sure to accept the offered Nix binary caches, otherwise building may+take a very long time. The flake declares the relevant caches (the IOG cache+and the project's own `ormolu.cachix.org`, which is populated by CI) via its+`nixConfig`, but Nix only uses them if you allow it to. The simplest way is+to pass `--accept-flake-config`: +```console+$ nix build --accept-flake-config+```++To avoid repeating the flag, add the following to your Nix configuration+(`/etc/nix/nix.conf`, or `nix.settings` on NixOS):++```+extra-substituters = https://cache.iog.io https://ormolu.cachix.org+extra-trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= ormolu.cachix.org-1:0L9Y4A+6dGpvfGtaeaq5w44pgX0AVRivKMfi2fiOzYE=+```+ Alternatively, `stack` could be used as follows:  ```console@@ -89,7 +104,7 @@  ```nix {-  inputs.ormolu.url = "github:tweag/ormolu";+  inputs.ormolu.url = "github:mrkkrp/ormolu";   outputs = { ormolu, ... }: {     # use ormolu.packages.${system}.default here   };@@ -140,8 +155,8 @@ ### Ormolu Live  On every new commit to `master`, [Ormolu Live](./ormolu-live) is deployed to-https://ormolu-live.tweag.io. Older versions are available at-https://COMMITHASH--ormolu-live.netlify.app.+https://ormolu-live.markkarpov.com. Older versions are available at+https://COMMITHASH--ormolu.netlify.app.  ### Editor integration @@ -184,10 +199,16 @@ infixr 1  =<< infixr 0  $, $! infixl 4 <*>, <*, *>, <**>++infixr 3 >~<+infixr 3.3 |~|+infixr 3.7 <~> ```  It uses exactly the same syntax as usual Haskell fixity declarations to make-it easier for Haskellers to edit and maintain.+it easier for Haskellers to edit and maintain. Since Ormolu 0.7.8.0+fractional precedences are supported for more precise control over+formatting of complex operator chains.  As of Ormolu 0.7.0.0, `.ormolu` files can also contain instructions about module re-exports that Ormolu should be aware of. This might be desirable@@ -339,17 +360,17 @@  See [LICENSE.md][license]. -Copyright © 2018–present Tweag I/O+Copyright © 2018–2026 Tweag I/O, 2026–present Mark Karpov  [aur]: https://aur.archlinux.org/packages/ormolu-[design-cpp]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp+[design-cpp]: https://github.com/mrkkrp/ormolu/blob/master/DESIGN.md#cpp [emacs-package]: https://github.com/vyorkin/ormolu.el [haskell-src-exts]: https://hackage.haskell.org/package/haskell-src-exts [neoformat]: https://github.com/sbdchd/neoformat-[releases]: https://github.com/tweag/ormolu/releases+[releases]: https://github.com/mrkkrp/ormolu/releases [run-ormolu]: https://github.com/haskell-actions/run-ormolu [vim-ormolu]: https://github.com/sdiehl/vim-ormolu [vs-code-plugin]: https://marketplace.visualstudio.com/items?itemName=sjurmillidahl.ormolu-vscode [fourmolu]: https://github.com/fourmolu/fourmolu-[contributing]: https://github.com/tweag/ormolu/blob/master/CONTRIBUTING.md-[license]: https://github.com/tweag/ormolu/blob/master/LICENSE.md+[contributing]: https://github.com/mrkkrp/ormolu/blob/master/CONTRIBUTING.md+[license]: https://github.com/mrkkrp/ormolu/blob/master/LICENSE.md

@@ -7,6 +7,7 @@  module Main (main) where +import Control.Concurrent (MVar, newMVar, withMVar) import Control.Exception (throwIO) import Control.Monad import Data.Bool (bool)@@ -33,17 +34,22 @@ import System.Exit (ExitCode (..), exitWith) import System.FilePath qualified as FP import System.IO (hPutStrLn, stderr)+import UnliftIO.Async (pooledMapConcurrently)  -- | Entry point of the program. main :: IO () main = do   Opts {..} <- execParser optsParserInfo+  -- We use this to guard writes to stdout in order to avoid+  -- garbled output from concurrent formatting processes.+  outputLock <- newMVar ()   let formatOne' =         formatOne           optConfigFileOpts           optMode           optSourceType           optConfig+          outputLock   exitCode <- case optInputFiles of     [] -> formatOne' Nothing     ["-"] -> formatOne' Nothing@@ -53,7 +59,8 @@             ExitSuccess -> Nothing             ExitFailure n -> Just n       errorCodes <--        mapMaybe selectFailure <$> mapM (formatOne' . Just) (sort xs)+        mapMaybe selectFailure+          <$> pooledMapConcurrently (formatOne' . Just) (sort xs)       return $         if null errorCodes           then ExitSuccess@@ -74,10 +81,12 @@   Maybe SourceType ->   -- | Configuration   Config RegionIndices ->+  -- | Lock for writing to output handles+  MVar () ->   -- | File to format or stdin as 'Nothing'   Maybe FilePath ->   IO ExitCode-formatOne ConfigFileOpts {..} mode reqSourceType rawConfig mpath =+formatOne ConfigFileOpts {..} mode reqSourceType rawConfig outputLock mpath =   withPrettyOrmoluExceptions (cfgColorMode rawConfig) $ do     let getCabalInfoForSourceFile' sourceFile = do           cabalSearchResult <- getCabalInfoForSourceFile sourceFile@@ -85,18 +94,20 @@           case cabalSearchResult of             CabalNotFound -> do               when debugEnabled $-                hPutStrLn stderr $-                  "Could not find a .cabal file for " <> sourceFile+                withMVar outputLock $ \_ ->+                  hPutStrLn stderr $+                    "Could not find a .cabal file for " <> sourceFile               return Nothing             CabalDidNotMention cabalInfo -> do               when debugEnabled $ do                 relativeCabalFile <-                   makeRelativeToCurrentDirectory (ciCabalFilePath cabalInfo)-                hPutStrLn stderr $-                  "Found .cabal file "-                    <> relativeCabalFile-                    <> ", but it did not mention "-                    <> sourceFile+                withMVar outputLock $ \_ ->+                  hPutStrLn stderr $+                    "Found .cabal file "+                      <> relativeCabalFile+                      <> ", but it did not mention "+                      <> sourceFile               return (Just cabalInfo)             CabalFound cabalInfo -> return (Just cabalInfo)         getDotOrmoluForSourceFile' sourceFile = do@@ -116,7 +127,9 @@         config <- patchConfig Nothing mcabalInfo mdotOrmolu         case mode of           Stdout -> do-            ormoluStdin config >>= T.Utf8.putStr+            output <- ormoluStdin config+            withMVar outputLock $ \_ ->+              T.Utf8.putStr output             return ExitSuccess           InPlace -> do             hPutStrLn@@ -145,7 +158,9 @@             mdotOrmolu         case mode of           Stdout -> do-            ormoluFile config inputFile >>= T.Utf8.putStr+            output <- ormoluFile config inputFile+            withMVar outputLock $ \_ ->+              T.Utf8.putStr output             return ExitSuccess           InPlace -> do             -- ormoluFile is not used because we need originalInput@@ -346,7 +361,7 @@         help "Fail if formatting is not idempotent"       ]     -- We cannot parse the source type here, because we might need to do-    -- autodection based on the input file extension (not available here)+    -- autodetection based on the input file extension (not available here)     -- before storing the resolved value in the config struct.     <*> pure ModuleSource     <*> (option parseColorMode . mconcat)

@@ -0,0 +1,11 @@+{-# LANGUAGE LinearTypes #-}++data Record = Rec {x %'Many :: Int, y :: Char}++data T2 a b c where+  MkT2 :: a -> b %1 -> c %1 -> T2 a b c++data T2 a b c = MkT2 {x %Many :: a, y :: b, z :: c}++data T3 a m where+  MkT3 :: a %m -> T3 a m

@@ -0,0 +1,10 @@+{-# LANGUAGE LinearTypes #-}+data Record = Rec { x %'Many :: Int, y :: Char }++data T2 a b c where+    MkT2 :: a -> b %1 -> c %1 -> T2 a b c++data T2 a b c = MkT2 { x %Many :: a, y :: b, z :: c }++data T3 a m where+    MkT3 :: a %m -> T3 a m

@@ -12,7 +12,7 @@     fooGag,     fooGog ::       NonEmpty-        ( Indentity+        ( Identity             Bool         ),     -- | Huh!

@@ -6,7 +6,7 @@   { fooX :: Int -- ^ X   , fooY :: Int -- ^ Y   , fooBar, fooBaz :: NonEmpty (Identity Bool) -- ^ BarBaz-  , fooGag, fooGog :: NonEmpty (Indentity+  , fooGag, fooGog :: NonEmpty (Identity                                   Bool)     -- ^ GagGog   , fooFoo

@@ -0,0 +1,27 @@+data T a where+  Typed :: forall a -> a -> T a++f1 (Typed a x) = x :: a++f2 (Typed Int n) = n * 2++f3 (Typed ((->) w Bool) g) = not . g++data D x where+  MkD1 ::+    forall a b ->+    a ->+    b ->+    D (a, b)+  MkD2 ::+    forall a.+    forall b ->+    a ->+    b ->+    D (a, b)+  MkD3 ::+    forall a ->+    a ->+    forall b ->+    b ->+    D (a, b)

@@ -0,0 +1,24 @@+data T a where+  Typed :: forall a -> a -> T a++f1 (Typed a x) = x :: a+f2 (Typed Int n) = n*2+f3 (Typed ((->) w Bool) g) = not . g++data D x where+  MkD1 :: forall a b ->+          a ->+          b ->+          D (a, b)++  MkD2 :: forall a.+          forall b ->+          a ->+          b ->+          D (a, b)++  MkD3 :: forall a ->+          a ->+          forall b ->+          b ->+          D (a, b)

@@ -0,0 +1,1 @@+data Proxy _ = Proxy

@@ -0,0 +1,1 @@+data Proxy _ = Proxy

@@ -1,3 +1,5 @@+module MyModule (default Monoid) where+ default (Int, Foo, Bar)  default@@ -5,3 +7,9 @@     Foo,     Bar   )++default Num (Int, Float)++default IsList ([], Vector)++default IsString (Text.Text, Foundation.String, String)

@@ -1,6 +1,13 @@+module MyModule (default Monoid) where+ default        (  Int , Foo     , Bar      )  default ( Int                , Foo,   Bar            )++default Num (Int, Float)+default IsList ([], Vector)++default IsString (Text.Text, Foundation.String, String)

@@ -0,0 +1,8 @@+{-# LANGUAGE MultilineStrings #-}++foreign import capi+  """+  foo+     bar+  """+  foo :: Int -> Int

@@ -0,0 +1,6 @@+{-# language MultilineStrings #-}++foreign import capi """+         foo+            bar+     """ foo :: Int -> Int

@@ -11,7 +11,7 @@ -- when we disable the rule that expands (++) into foldr  -- The foldr/cons rule looks nice, but it can give disastrously--- bloated code when commpiling+-- bloated code when compiling --      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ] -- i.e. when there are very very long literal lists -- So I've disabled it for now. We could have special cases

@@ -11,7 +11,7 @@         -- when we disable the rule that expands (++) into foldr  -- The foldr/cons rule looks nice, but it can give disastrously--- bloated code when commpiling+-- bloated code when compiling --      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ] -- i.e. when there are very very long literal lists -- So I've disabled it for now. We could have special cases

@@ -5,3 +5,5 @@ infix 2 ->  infix 0 type <!>++infix 9 +

@@ -4,3 +4,5 @@ infix 2 ->  infix 0 type <!>++infix +

@@ -0,0 +1,8 @@+{-# SPECIALIZE addMult @Double #-}+{-# SPECIALIZE addMult (5 :: Int) #-}+{-# SPECIALIZE addMult 5 :: Int -> Int #-}++{-# SPECIALIZE [1] forall x y. f @Int True (x, y) #-}++{-# SPECIALIZE forall x xs. loop (x : xs)+  #-}

@@ -0,0 +1,9 @@+{-# SPECIALISE addMult @Double #-}+{-# SPECIALISE addMult (5 :: Int) #-}+{-# SPECIALISE addMult 5 :: Int -> Int #-}++{-# SPECIALISE [1] forall x y. f @Int True (x,y) #-}++{-# SPECIALISE+  forall x xs .+  loop (x:xs) #-}

@@ -0,0 +1,10 @@+sep, fsep, hsep :: (Applicative m, Foldable t) => t (m Doc) -> m Doc+sep = fmap P.sep . sequenceAFoldable+{-# SPECIALIZE NOINLINE sep :: [TCM Doc] -> TCM Doc #-}+{-# SPECIALIZE NOINLINE sep :: List1 (TCM Doc) -> TCM Doc #-}+fsep = fmap P.fsep . sequenceAFoldable+{-# SPECIALIZE NOINLINE [2] fsep :: [TCM Doc] -> TCM Doc #-}+{-# SPECIALIZE NOINLINE [2] fsep :: List1 (TCM Doc) -> TCM Doc #-}+hsep = fmap P.hsep . sequenceAFoldable+{-# SPECIALIZE NOINLINE [~2] hsep :: [TCM Doc] -> TCM Doc #-}+{-# SPECIALIZE NOINLINE [~2] hsep :: List1 (TCM Doc) -> TCM Doc #-}

@@ -0,0 +1,4 @@+sep, fsep, hsep :: (Applicative m, Foldable t) => t (m Doc) -> m Doc+sep  = fmap P.sep  . sequenceAFoldable  ; {-# SPECIALIZE NOINLINE sep  :: [TCM Doc] -> TCM Doc #-} ; {-# SPECIALIZE NOINLINE sep  :: List1 (TCM Doc) -> TCM Doc #-}+fsep = fmap P.fsep . sequenceAFoldable  ; {-# SPECIALIZE NOINLINE [2] fsep :: [TCM Doc] -> TCM Doc #-} ; {-# SPECIALIZE NOINLINE [2] fsep :: List1 (TCM Doc) -> TCM Doc #-}+hsep = fmap P.hsep . sequenceAFoldable  ; {-# SPECIALIZE NOINLINE [~2] hsep :: [TCM Doc] -> TCM Doc #-} ; {-# SPECIALIZE NOINLINE [~2] hsep :: List1 (TCM Doc) -> TCM Doc #-}

@@ -0,0 +1,5 @@+{-# LANGUAGE NoListTuplePuns #-}++type X = (Int, String)++type Y = [String, Int]

@@ -0,0 +1,5 @@+{-# Language NoListTuplePuns #-}++type X = (Int, String)++type Y = [String, Int]

@@ -0,0 +1,1 @@+type Const a _ = a

@@ -0,0 +1,1 @@+type Const a _ = a

@@ -12,7 +12,7 @@         )     -> do       -- Begin do-      (x, y) <- -- GHC parser fails if layed out over multiple lines+      (x, y) <- -- GHC parser fails if laid out over multiple lines         f -- Call into f           ( a,             c -- Tuple together arguments

@@ -9,7 +9,7 @@         (e, f)       ) ->     do -- Begin do-        (x,y) -- GHC parser fails if layed out over multiple lines+        (x,y) -- GHC parser fails if laid out over multiple lines          <- f -- Call into f               (a,                c) -- Tuple together arguments

@@ -12,3 +12,10 @@       (bindA -< y)     |)     z++foo2 = proc () -> do+  ( proc () ->+      returnA -< ()+    )+    -<+      ()

@@ -11,3 +11,8 @@     bar       (bindA -< y)     |) z++foo2 = proc () -> do+  (proc () ->+    returnA -< ()+    ) -< ()

@@ -0,0 +1,2 @@+getValue :: Maybe Int -> Int+getValue x = case x of Just n -> n; Nothing -> 0

@@ -0,0 +1,2 @@+getValue :: Maybe Int -> Int+getValue x = case x of {Just n -> n; Nothing -> 0}

@@ -0,0 +1,14 @@+foo =+  case x of+    _ -> 1+  -- comment+  where+    -- comment 2+    x = 1++foo = case x of+  _ -> 1+  -- comment+  where+    -- comment 2+    x = 1

@@ -0,0 +1,14 @@+foo =+  case x of+    _ -> 1+    -- comment+    where+      -- comment 2+      x = 1++foo = case x of+    _ -> 1+    -- comment+    where+      -- comment 2+      x = 1

@@ -0,0 +1,13 @@+handleInput :: IO ()+handleInput = do+  putStrLn "Enter command:"+  cmd <- getLine+  case cmd of+    "quit" -> putStrLn "Goodbye"+    "help" -> do+      putStrLn "Available commands:"+      putStrLn "  quit - exit the program"+      putStrLn "  help - show this message"+    _ -> do+      putStrLn $ "Unknown command: " ++ cmd+      handleInput

@@ -0,0 +1,13 @@+handleInput :: IO ()+handleInput = do+  putStrLn "Enter command:"+  cmd <- getLine+  case cmd of+    "quit" -> putStrLn "Goodbye"+    "help" -> do+      putStrLn "Available commands:"+      putStrLn "  quit - exit the program"+      putStrLn "  help - show this message"+    _ -> do+      putStrLn $ "Unknown command: " ++ cmd+      handleInput

@@ -0,0 +1,2 @@+checkValue :: Int -> IO ()+checkValue n = do putStr "Value is: "; case () of { _ | n < 0 -> putStrLn "negative" | n == 0 -> putStrLn "zero" | otherwise -> putStrLn "positive" }

@@ -0,0 +1,2 @@+checkValue :: Int -> IO ()+checkValue n = do {putStr "Value is: "; case () of {_ | n < 0 -> putStrLn "negative" | n == 0 -> putStrLn "zero" | otherwise -> putStrLn "positive"}}

@@ -0,0 +1,2 @@+processValue :: Maybe Int -> IO ()+processValue x = do putStrLn "Processing:"; \case { Just n -> print n; Nothing -> putStrLn "Empty" } x; putStrLn "Done"

@@ -0,0 +1,2 @@+processValue :: Maybe Int -> IO ()+processValue x = do {putStrLn "Processing:"; \case {Just n -> print n; Nothing -> putStrLn "Empty"} x; putStrLn "Done"}

@@ -0,0 +1,2 @@+processPair :: Maybe Int -> Maybe String -> IO ()+processPair x y = do case x of { Just n -> print n; Nothing -> putStrLn "No number" }; case y of { Just s -> putStrLn s; Nothing -> putStrLn "No string" }

@@ -0,0 +1,2 @@+processPair :: Maybe Int -> Maybe String -> IO ()+processPair x y = do {case x of {Just n -> print n; Nothing -> putStrLn "No number"}; case y of {Just s -> putStrLn s; Nothing -> putStrLn "No string"}}

@@ -0,0 +1,2 @@+nestedDo :: Either String Int -> IO ()+nestedDo e = do putStr "Start: "; case e of { Left s -> do { putStr "Error: "; putStrLn s }; Right n -> do { putStr "Value: "; print n } }; putStrLn "End"

@@ -0,0 +1,2 @@+nestedDo :: Either String Int -> IO ()+nestedDo e = do {putStr "Start: "; case e of {Left s -> do {putStr "Error: "; putStrLn s}; Right n -> do {putStr "Value: "; print n}}; putStrLn "End"}

@@ -0,0 +1,2 @@+doGuessing :: (Ord t, Read t) => t -> IO ()+doGuessing num = do putStrLn "Enter your guess:"; guess <- getLine; case compare (read guess) num of { LT -> do { putStrLn "Too low!"; doGuessing num }; GT -> do { putStrLn "Too high!"; doGuessing num }; EQ -> putStrLn "You win!" }

@@ -0,0 +1,2 @@+doGuessing :: (Ord t, Read t) => t -> IO ()+doGuessing num = do {putStrLn "Enter your guess:"; guess <- getLine; case compare (read guess) num of {LT -> do {putStrLn "Too low!"; doGuessing num}; GT -> do { putStrLn "Too high!"; doGuessing num}; EQ -> putStrLn "You win!"}}

@@ -10,3 +10,5 @@ quux :: Int -> Int quux x | x < 0 = x quux x = x++(a, b) | c = d

@@ -10,3 +10,5 @@ quux :: Int -> Int quux x | x < 0 = x quux x = x++(a, b) | c = d

@@ -13,9 +13,9 @@     throwIO (OrmoluCppEnabled path)  foo =-  bar $-    baz $-      quux+  bar+    $ baz+    $ quux  x =   case l of { A -> B } $

@@ -1,11 +1,11 @@ ex1 =-  f1 $-    arg1 $-      arg2 $-        arg3+  f1+    $ arg1+    $ arg2+    $ arg3  ex3 =-  f1 $-    arg1 $-      arg2 $-        1 + 3+  f1+    $ arg1+    $ arg2+    $ 1 + 3

@@ -1,5 +1,5 @@ ex2 =-  f1 $-    arg1 $-      arg2 $-        f2 arg3+  f1+    $ arg1+    $ arg2+    $ f2 arg3

@@ -0,0 +1,3 @@+startFormTok |~| messageTag+  >~< startMessageTok |~| name+  >~< p' |~| endMessageTok |~| endFormTok

@@ -0,0 +1,3 @@+startFormTok |~| messageTag+  >~< startMessageTok |~| name+  >~< p' |~| endMessageTok |~| endFormTok

@@ -1,14 +1,14 @@ import Control.Lens  lenses =-  Just $-    M.fromList $-      "type" .= ("user.connection" :: Text)-        # "connection" .= uc-        # "user" .= case name of-          Just n -> Just $ object ["name" .= n]-          Nothing -> Nothing-        # []+  Just+    $ M.fromList+    $ "type" .= ("user.connection" :: Text)+      # "connection" .= uc+      # "user" .= case name of+        Just n -> Just $ object ["name" .= n]+        Nothing -> Nothing+      # []  foo =   a

@@ -1,11 +1,11 @@ -- Right chain, $ case, 2 operators with p($) == p(b) n :: Int n =-  1 $-    2 $-      3 $-        4 `seq`-          5 $-            6 $-              7 $-                8+  1+    $ 2+    $ 3+    $ 4+    `seq` 5+    $ 6+    $ 7+    $ 8

@@ -1,11 +1,11 @@ -- Right chain, $ case, 2 operators with p(a) == p($) p :: Int p =-  1 `seq`-    2 `seq`-      3 `seq`-        4 $-          5 `seq`-            6 `seq`-              7 `seq`-                8+  1+    `seq` 2+    `seq` 3+    `seq` 4+    $ 5+    `seq` 6+    `seq` 7+    `seq` 8

@@ -1,7 +1,7 @@ -- Right chain, $ case, 1 operator type c :: Int c =-  1 $-    2 $-      3 $-        4+  1+    $ 2+    $ 3+    $ 4

@@ -1,9 +1,9 @@ lenses =-  Just $-    M.fromList $-      "type" Foo..= ("user.connection" :: Text)-        Bar.# "connection" Foo..= uc-        Bar.# "user" Foo..= case name of-          Just n -> Just $ object ["name" .= n]-          Nothing -> Nothing-        Bar.# []+  Just+    $ M.fromList+    $ "type" Foo..= ("user.connection" :: Text)+      Bar.# "connection" Foo..= uc+      Bar.# "user" Foo..= case name of+        Just n -> Just $ object ["name" .= n]+        Nothing -> Nothing+      Bar.# []

@@ -0,0 +1,9 @@+{-# LANGUAGE LinearTypes #-}++h x = g y+  where+    %1 y = f x++let %1 x = u in ()+let %Many (x, y) = u in ()+let %1 ~(x, y) = u in ()

@@ -0,0 +1,9 @@+{-# Language LinearTypes #-}++h x = g y+  where+    %1 y = f x++let %1 x = u in ()+let %Many (x, y) = u in ()+let %1 ~(x, y) = u in ()

@@ -14,3 +14,5 @@       | p -> f       | otherwise -> g     x++x y = if | foo -> False | otherwise -> True

@@ -12,3 +12,5 @@   if | p -> f      | otherwise -> g     x++x y = if | foo -> False | otherwise -> True

@@ -0,0 +1,29 @@+{-# LANGUAGE MultilineStrings #-}++s =+  """Line 1+     Line 2+  Line 3+  """++s_2 =+  """\ \Line 1+     Line 2+  Line 3+  """++-- equivalent to+s' = "Line 1\n   Line 2\nLine 3"++-- the following are equivalent+s = """hello world"""++s' = "hello world"++s =+  """    hello+  world+  """++-- equivalent to+s' = "    hello\nworld"

@@ -0,0 +1,31 @@+{-# LANGUAGE MultilineStrings #-}++s =+  """Line 1+     Line 2+  Line 3+  """++s_2 =+  """\+ \Line 1+     Line 2+  Line 3+  """++-- equivalent to+s' = "Line 1\n   Line 2\nLine 3"+++-- the following are equivalent+s = """hello world"""+s' = "hello world"+++s =+  """    hello+  world+  """++-- equivalent to+s' = "    hello\nworld"

@@ -0,0 +1,12 @@+{-# LANGUAGE MultilineStrings #-}++s =+  """+  a b\ \ c d e+  f g+  """++-- equivalent to+s' = "a b c d e\nf g"++weirdGap = """\65\ \0"""

@@ -0,0 +1,13 @@+{-# LANGUAGE MultilineStrings #-}++s =+    """+      a b\+  \ c d e+      f g+    """++-- equivalent to+s' = "a b c d e\nf g"++weirdGap = """\65\ \0"""

@@ -0,0 +1,11 @@+{-# LANGUAGE MultilineStrings #-}++s =+  """+  a+  b+  c+  """++-- equivalent to+s' = "a\nb\nc"

@@ -0,0 +1,11 @@+{-# LANGUAGE MultilineStrings #-}++s =+	"""+	        a+	 	b+	    	c+	"""++-- equivalent to+s' = "a\nb\nc"

@@ -0,0 +1,32 @@+{-# LANGUAGE MultilineStrings #-}++s =+  """++  a+  b+  c+  """++-- equivalent to+s' = "\na\nb\nc"++s1 =+  """    a+  b+  c+  """++s2 =+  """+  a+  b+  c+  """++-- In the current proposal, these are equivalent to+-- the below. If leading newline were removed at the+-- beginning, both would result in s1'.+s1' = "    a\nb\nc"++s2' = "a\nb\nc"

@@ -0,0 +1,32 @@+{-# LANGUAGE MultilineStrings #-}++s =+  """++  a+  b+  c+  """++-- equivalent to+s' = "\na\nb\nc"+++s1 =+  """    a+  b+  c+  """++s2 =+  """+  a+  b+  c+  """++-- In the current proposal, these are equivalent to+-- the below. If leading newline were removed at the+-- beginning, both would result in s1'.+s1' = "    a\nb\nc"+s2' = "a\nb\nc"

@@ -0,0 +1,25 @@+{-# LANGUAGE MultilineStrings #-}++s =+  """+  a+  b++  """++-- equivalent to+s' = "a\nb\n"++s1 =+  """+  line 1+  line 2+  """++s2 = "line 3"++s3 =+  """+  line 4+  line 5+  """

@@ -0,0 +1,26 @@+{-# LANGUAGE MultilineStrings #-}++s =+  """+  a+  b++  """++-- equivalent to+s' = "a\nb\n"+++s1 =+  """+  line 1+  line 2+  """++s2 = "line 3"++s3 =+  """+  line 4+  line 5+  """

@@ -0,0 +1,26 @@+{-# LANGUAGE MultilineStrings #-}++s1 =+  """+  a+  b+  c+  """++s1' = "a\nb\nc"++s2 =+  """+  \&  a+    b+    c+  """++s2_2 =+  """+  \&  a+  \&  b+  \&  c+  """++s2' = "  a\n  b\n  c"

@@ -0,0 +1,26 @@+{-# LANGUAGE MultilineStrings #-}++s1 =+  """+    a+    b+    c+  """++s1' = "a\nb\nc"++s2 =+  """+  \&  a+    b+    c+  """++s2_2 =+  """+  \&  a+  \&  b+  \&  c+  """++s2' = "  a\n  b\n  c"

@@ -0,0 +1,10 @@+{-# LANGUAGE MultilineStrings #-}++x =+  """+  This is a literal multiline string:+  \"\"\"+  Hello+    world!+  \"""+  """

@@ -0,0 +1,10 @@+{-# LANGUAGE MultilineStrings #-}++x =+  """+  This is a literal multiline string:+  \"\"\"+  Hello+    world!+  \"""+  """

@@ -0,0 +1,30 @@+{-# LANGUAGE MultilineStrings #-}++printf+  """+  instance Aeson.FromJSON %s where+    parseJSON =+      Aeson.withText "%s" $ \\s ->+        either Aeson.parseFail pure $+          parsePrinterOptType (Text.unpack s)++  instance PrinterOptsFieldType %s where+    parsePrinterOptType s =+      case s of+  %s+        _ ->+          Left . unlines $+            [ "unknown value: " <> show s+            , "Valid values are: %s"+            ]++  """+  fieldTypeName+  fieldTypeName+  fieldTypeName+  ( unlines_+      [ printf "      \"%s\" -> Right %s" val con+      | (con, val) <- enumOptions+      ]+  )+  (renderEnumOptions enumOptions)

@@ -0,0 +1,30 @@+{-# LANGUAGE MultilineStrings #-}++printf+  """+  instance Aeson.FromJSON %s where+    parseJSON =+      Aeson.withText "%s" $ \\s ->+        either Aeson.parseFail pure $+          parsePrinterOptType (Text.unpack s)++  instance PrinterOptsFieldType %s where+    parsePrinterOptType s =+      case s of+  %s+        _ ->+          Left . unlines $+            [ "unknown value: " <> show s+            , "Valid values are: %s"+            ]++  """+  fieldTypeName+  fieldTypeName+  fieldTypeName+  ( unlines_+      [ printf "      \"%s\" -> Right %s" val con+      | (con, val) <- enumOptions+      ]+  )+  (renderEnumOptions enumOptions)

@@ -0,0 +1,12 @@+{-# LANGUAGE MultilineStrings #-}++type Foo =+  """+  yeah+    yeah"""++foo =+  foo+    @"""yeah+     yeah+     """

@@ -0,0 +1,9 @@+{-# LANGUAGE MultilineStrings #-}++type Foo = """+  yeah+    yeah"""++foo = foo @"""yeah+           yeah+           """

@@ -0,0 +1,11 @@+{-# LANGUAGE MultilineStrings #-}++multilineBlank =+  """+  1+++++  6+  """

@@ -0,0 +1,11 @@+{-# LANGUAGE MultilineStrings #-}++multilineBlank =+  """+  1+++++  6+  """

@@ -0,0 +1,44 @@+{-# LANGUAGE PatternSynonyms #-}++tasty (Cupcake; Cookie) = True+tasty (Liquorice; Raisins) = False++f :: (Eq a, Show a) => a -> a -> Bool+f a ((== a) -> True; show -> "yes") = True+f _ _ = False++small (abs -> (0; 1; 2); 3) = True -- -3 is not small+small _ = False++type Coll a = Either [a] (Set a)++pattern None <- (Left []; Right (toList -> []))++case e of+  1; 2; 3 -> x+  4; (5; 6) -> y++sane e = case e of+  1+  2+  3 ->+    a+  4+  5+  6 -> b+  7; 8 -> c++insane e = case e of+  A _ _+  B _+  C -> 3+  (D; E (Just _) Nothing) ->+    4+  F -> 5++food+  foo@( A;+        B;+        C+        ) = Just foo+food _ = Nothing

@@ -0,0 +1,39 @@+{-# LANGUAGE PatternSynonyms #-}++tasty (Cupcake; Cookie) = True+tasty (Liquorice; Raisins) = False++f :: (Eq a, Show a) => a -> a -> Bool+f a ((== a) -> True; show -> "yes") = True+f _ _ = False++small (abs -> (0; 1; 2); 3) = True -- -3 is not small+small _ = False++type Coll a = Either [a] (Set a)+pattern None <- (Left []; Right (toList -> []))++case e of+  1; 2; 3 -> x+  4; (5; 6) -> y++sane e = case e of+  1+  2+  3 ->+    a+  4+  5;6 -> b+  7;8 -> c++insane e = case e of+  A _ _; B _+  C -> 3+  (D; E (Just _) Nothing)+   -> 4+  F -> 5++food foo@(A;+          B;+          C) = Just foo+food _ = Nothing

@@ -0,0 +1,23 @@+{-# LANGUAGE LinearTypes #-}+{-# LANGUAGE UnicodeSyntax #-}++ex1 = f (forall a. Proxy a)++ex2 = f ((ctx) => Int)++ex2' = f ((ctx, ctx') => Int)++ex3 = f (String -> Bool)++long =+  f+    ( forall m a.+      (A a, M m) =>+      String ->+      Bool %1 ->+      Maybe Int ->+      Maybe+        (String, Int) %1 ->+      Word %m ->+      Text+    )

@@ -0,0 +1,14 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE LinearTypes #-}++ex1  = f (forall a. Proxy a)+ex2  = f (ctx => Int)+ex2' = f ((ctx,ctx') => Int)+ex3  = f (String -> Bool)++long = f (forall m a. (A a, M m) => String+       -> Bool %1 ->+          Maybe Int+       -> Maybe+             (String,Int)+        ⊸ Word %m -> Text )

@@ -2,9 +2,13 @@  foo = "foobar" -bar = "foo\&barbaz"+bar = "foo\&bar\ \baz"  baz =   "foo\   \bar\   \baz"++weirdGap = "\65\ \0"++weirdEscape = "\^\ "

@@ -5,3 +5,7 @@ baz = "foo\       \bar\     \baz"++weirdGap = "\65\ \0"++weirdEscape = "\^\ "

@@ -22,3 +22,5 @@     @u     v ->       ""++foo = foo @[k|bar|]

@@ -17,3 +17,5 @@   Bar    @t @u v     -> ""++foo = foo @[k|bar|]

@@ -0,0 +1,8 @@+module MegaparsecExample where++import Text.Megaparsec++pValue =+  Object <$> parseObjectBody+    <|> Array <$> parseArrayBody+    <|> String <$> parseStringBody

@@ -0,0 +1,8 @@+module MegaparsecExample where++import Text.Megaparsec++pValue =+  Object <$> parseObjectBody+    <|> Array <$> parseArrayBody+    <|> String <$> parseStringBody

@@ -0,0 +1,8 @@+module OpticsExample where++import Optics++updated =+  record+    & fieldLens % subFieldLens .~ someValue+    & otherLens %~ someTransformationFunctionApplied

@@ -0,0 +1,8 @@+module OpticsExample where++import Optics++updated =+  record+    & fieldLens % subFieldLens .~ someValue+    & otherLens %~ someTransformationFunctionApplied

@@ -0,0 +1,10 @@+module ReludeChainExample where++import Relude++resolveValue =+  primarySource+    ?: secondarySource+    ?: tertiarySource+    ?: quaternarySource+    ?: finalFallbackValue

@@ -0,0 +1,10 @@+module ReludeChainExample where++import Relude++resolveValue =+  primarySource+    ?: secondarySource+    ?: tertiarySource+    ?: quaternarySource+    ?: finalFallbackValue

@@ -0,0 +1,7 @@+module ReludeExample where++import Relude++config =+  lookupOptionalSetting environment ?:+    defaultConfigurationValue

@@ -0,0 +1,7 @@+module ReludeExample where++import Relude++config =+  lookupOptionalSetting environment+    ?: defaultConfigurationValue

@@ -0,0 +1,7 @@+module RioExample where++import RIO++message =+  greetingText <> userNameText+    & Text.strip

@@ -0,0 +1,7 @@+module RioExample where++import RIO++message =+  greetingText <> userNameText+    & Text.strip

@@ -0,0 +1,7 @@+module RioDeepseqExample where++import RIO++result =+  forceEvaluationOfBigStructure `deepseq`+    continueWithNextStep

@@ -0,0 +1,7 @@+module RioDeepseqExample where++import RIO++result =+  forceEvaluationOfBigStructure+    `deepseq` continueWithNextStep

@@ -0,0 +1,3 @@+module Bar (data P, T (data P), data f) where++import N (T (data P), data P, data f)

@@ -0,0 +1,6 @@++module Bar (data P, T(data P), data f) where++import N (data P)+import N (T(data P))+import N (data f)

@@ -0,0 +1,13 @@+{-# LANGUAGE ExplicitLevelImports #-}++import A splice+import {-# SOURCE #-} safe qualified A splice as QA hiding (a, b, c, d, e, f)+import quote qualified B as QB+import qualified C splice as SC+import qualified D splice+import Data.ByteString (e)+import Data.ByteString.Lazy quote (d)+import splice Data.Text (a, b, c)+import PyF ()+import splice PyF (fmt, tmf)+import quote PyF (abc)

@@ -0,0 +1,5 @@+{-# LANGUAGE ExplicitLevelImports #-}+{-# LANGUAGE ImportQualifiedPost #-}++import quote A qualified as QA+import B quote qualified as QB

@@ -0,0 +1,5 @@+{-# LANGUAGE ExplicitLevelImports #-}+{-# LANGUAGE ImportQualifiedPost #-}++import qualified B quote as QB+import quote qualified A as QA

@@ -0,0 +1,14 @@+{-# LANGUAGE ExplicitLevelImports #-}++import splice Data.Text (a, b, c)+import Data.ByteString.Lazy quote (d)+import Data.ByteString (e)+import {-# SOURCE #-} safe qualified A splice as QA hiding (a, b, c, d, e, f)+import quote qualified B as QB+import qualified C splice as SC+import A splice+import qualified D splice+import quote PyF (abc)+import splice PyF (fmt)+import splice PyF (tmf)+import PyF ()

@@ -0,0 +1,7 @@+{-# LANGUAGE PackageImports #-}++import "base" Control.Applicative (Alternative, (<|>))+import "base" Data.Maybe (Maybe (Nothing), maybe)+import "base" System.IO (IO)+import "yaya" Yaya.Fold (ana, cata)+import "base" Prelude ((+))

@@ -0,0 +1,7 @@+{-# LANGUAGE PackageImports #-}++import "base" System.IO (IO)+import "base" Prelude ((+))+import "yaya" Yaya.Fold (ana, cata)+import "base" Control.Applicative (Alternative, (<|>))+import "base" Data.Maybe (Maybe (Nothing), maybe)

@@ -0,0 +1,6 @@+{-# LANGUAGE NoImplicitPrelude #-}++import Control.Applicative (Alternative, (<|>))+import Data.Maybe (Maybe (Nothing), maybe)+import Prelude ((+))+import System.IO (IO)

@@ -0,0 +1,8 @@+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE NoImplicitPrelude #-}++import "base" Control.Applicative (Alternative, (<|>))+import "base" Data.Maybe (Maybe (Nothing), maybe)+import "base" Prelude ((+))+import "base" System.IO (IO)+import "yaya" Yaya.Fold (ana, cata)

@@ -0,0 +1,8 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE PackageImports #-}++import "base" System.IO (IO)+import "base" Prelude ((+))+import "yaya" Yaya.Fold (ana, cata)+import "base" Control.Applicative (Alternative, (<|>))+import "base" Data.Maybe (Maybe (Nothing), maybe)

@@ -0,0 +1,6 @@+{-# LANGUAGE NoImplicitPrelude #-}++import System.IO (IO)+import Prelude ((+))+import Control.Applicative (Alternative, (<|>))+import Data.Maybe (Maybe (Nothing), maybe)

@@ -0,0 +1,5 @@+module Foo+  ( -- | asdf+    foo,+  )+where

@@ -0,0 +1,1 @@+module Foo ({- | asdf -} foo) where

@@ -0,0 +1,4 @@+doBlock = do+  a --++  b

@@ -0,0 +1,4 @@+doBlock = do+  a --++  b

@@ -0,0 +1,5 @@+letBlock =+  let a = a --++      b = b+   in c

@@ -0,0 +1,5 @@+letBlock =+  let a = a --++      b = b+   in c

@@ -0,0 +1,22 @@+textComment = do+  a -- some text++  b++blockComment = do+  a {- foo -}++  b++twoComments = do+  a --++  --++  bar++adjacentThenBlank = do+  a --+  --++  bar

@@ -0,0 +1,22 @@+textComment = do+  a -- some text++  b++blockComment = do+  a {- foo -}++  b++twoComments = do+  a --++  --++  bar++adjacentThenBlank = do+  a --+  --++  bar

@@ -0,0 +1,5 @@+whereBlock = foo+  where+    a = a --++    b = b

@@ -0,0 +1,5 @@+whereBlock = foo+  where+    a = a --++    b = b

@@ -0,0 +1,25 @@+noBlankAfterComment = do+  a --+  b++noBlankTextComment = do+  a -- some text+  b++noBlankBlockComment = do+  a {- foo -}+  b++blockCommentFollowedByExpr = do+  a {- foo -} 1+  b++whereNoBlank = foo+  where+    a = a --+    b = b++letNoBlank =+  let a = a --+      b = b+   in c

@@ -0,0 +1,25 @@+noBlankAfterComment = do+  a --+  b++noBlankTextComment = do+  a -- some text+  b++noBlankBlockComment = do+  a {- foo -}+  b++blockCommentFollowedByExpr = do+  a {- foo -} 1+  b++whereNoBlank = foo+  where+    a = a --+    b = b++letNoBlank =+  let a = a --+      b = b+   in c

@@ -12,7 +12,7 @@   forall. T x = x  {-# RULES-"r"+"r" forall.   r a =     ()   #-}

binary file changed (989821 → 1243493 bytes)

@@ -1,199 +1,214 @@-cabal-version:      2.4-name:               ormolu-version:            0.7.7.0-license:            BSD-3-Clause-license-file:       LICENSE.md-maintainer:         Mark Karpov <mark.karpov@tweag.io>-tested-with:        ghc ==9.6.5 ghc ==9.8.2 ghc ==9.10.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+cabal-version: 2.4+name: ormolu+version: 0.8.2.0+license: BSD-3-Clause+license-file: LICENSE.md+maintainer: Mark Karpov <markkarpov92@gmail.com>+tested-with:+  ghc ==9.10.2+  ghc ==9.12.2+  ghc ==9.14.1++homepage: https://github.com/mrkkrp/ormolu+bug-reports: https://github.com/mrkkrp/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-    data/**/*.cabal-    extract-hackage-info/hackage-info.bin+  data/**/*.cabal+  data/**/*.hs+  data/**/*.txt+  extract-hackage-info/hackage-info.bin  extra-doc-files:-    CONTRIBUTING.md-    CHANGELOG.md-    DESIGN.md-    README.md+  CHANGELOG.md+  CONTRIBUTING.md+  DESIGN.md+  README.md  source-repository head-    type:     git-    location: https://github.com/tweag/ormolu.git+  type: git+  location: https://github.com/mrkkrp/ormolu.git  flag dev-    description: Turn on development settings.-    default:     False-    manual:      True--flag internal-bundle-fixities-    description:-        An internal ad-hoc flag that is enabled by default, Ormolu Live disables-        it due to missing WASM TH support.--    manual:      True+  description: Turn on development settings.+  default: False+  manual: True  library-    exposed-modules:-        Ormolu-        Ormolu.Config-        Ormolu.Diff.ParseResult-        Ormolu.Diff.Text-        Ormolu.Exception-        Ormolu.Imports-        Ormolu.Parser-        Ormolu.Parser.CommentStream-        Ormolu.Parser.Pragma-        Ormolu.Parser.Result-        Ormolu.Printer-        Ormolu.Printer.Combinators-        Ormolu.Printer.Comments-        Ormolu.Printer.Internal-        Ormolu.Printer.Meat.Common-        Ormolu.Printer.Meat.Declaration-        Ormolu.Printer.Meat.Declaration.Annotation-        Ormolu.Printer.Meat.Declaration.Class-        Ormolu.Printer.Meat.Declaration.Data-        Ormolu.Printer.Meat.Declaration.Default-        Ormolu.Printer.Meat.Declaration.Foreign-        Ormolu.Printer.Meat.Declaration.Instance-        Ormolu.Printer.Meat.Declaration.RoleAnnotation-        Ormolu.Printer.Meat.Declaration.Rule-        Ormolu.Printer.Meat.Declaration.Signature-        Ormolu.Printer.Meat.Declaration.Splice-        Ormolu.Printer.Meat.Declaration.Type-        Ormolu.Printer.Meat.Declaration.TypeFamily-        Ormolu.Printer.Meat.Declaration.Value-        Ormolu.Printer.Meat.Declaration.OpTree-        Ormolu.Printer.Meat.Declaration.Warning-        Ormolu.Printer.Meat.ImportExport-        Ormolu.Printer.Meat.Module-        Ormolu.Printer.Meat.Pragma-        Ormolu.Printer.Meat.Type-        Ormolu.Printer.Operators-        Ormolu.Fixity-        Ormolu.Fixity.Imports-        Ormolu.Fixity.Internal-        Ormolu.Fixity.Parser-        Ormolu.Fixity.Printer-        Ormolu.Printer.SpanStream-        Ormolu.Processing.Common-        Ormolu.Processing.Cpp-        Ormolu.Processing.Preprocess-        Ormolu.Terminal-        Ormolu.Terminal.QualifiedDo-        Ormolu.Utils-        Ormolu.Utils.Cabal-        Ormolu.Utils.Fixity-        Ormolu.Utils.IO--    hs-source-dirs:   src-    other-modules:    GHC.DynFlags-    default-language: GHC2021-    build-depends:-        Cabal-syntax >=3.12 && <3.13,-        Diff >=0.4 && <1,-        MemoTrie >=0.6 && <0.7,-        ansi-terminal >=0.10 && <1.2,-        array >=0.5 && <0.6,-        base >=4.14 && <5,-        binary >=0.8 && <0.9,-        bytestring >=0.2 && <0.13,-        choice >=0.2.4.1 && <0.3,-        containers >=0.5 && <0.8,-        deepseq >=1.4 && <1.6,-        directory ^>=1.3,-        file-embed >=0.0.15 && <0.1,-        filepath >=1.2 && <1.6,-        ghc-lib-parser >=9.10 && <9.11,-        megaparsec >=9,-        mtl >=2 && <3,-        syb >=0.7 && <0.8,-        text >=2.1 && <3--    if flag(dev)-        ghc-options:-            -Wall -Werror -Wredundant-constraints -Wpartial-fields-            -Wunused-packages+  exposed-modules:+    Ormolu+    Ormolu.Config+    Ormolu.Diff.ParseResult+    Ormolu.Diff.Text+    Ormolu.Exception+    Ormolu.Fixity+    Ormolu.Fixity.Imports+    Ormolu.Fixity.Internal+    Ormolu.Fixity.Parser+    Ormolu.Fixity.Printer+    Ormolu.Imports+    Ormolu.Parser+    Ormolu.Parser.CommentStream+    Ormolu.Parser.Pragma+    Ormolu.Parser.Result+    Ormolu.Printer+    Ormolu.Printer.Combinators+    Ormolu.Printer.Comments+    Ormolu.Printer.Internal+    Ormolu.Printer.Meat.Common+    Ormolu.Printer.Meat.Declaration+    Ormolu.Printer.Meat.Declaration.Annotation+    Ormolu.Printer.Meat.Declaration.Class+    Ormolu.Printer.Meat.Declaration.Data+    Ormolu.Printer.Meat.Declaration.Default+    Ormolu.Printer.Meat.Declaration.Foreign+    Ormolu.Printer.Meat.Declaration.Instance+    Ormolu.Printer.Meat.Declaration.OpTree+    Ormolu.Printer.Meat.Declaration.RoleAnnotation+    Ormolu.Printer.Meat.Declaration.Rule+    Ormolu.Printer.Meat.Declaration.Signature+    Ormolu.Printer.Meat.Declaration.Splice+    Ormolu.Printer.Meat.Declaration.StringLiteral+    Ormolu.Printer.Meat.Declaration.Type+    Ormolu.Printer.Meat.Declaration.TypeFamily+    Ormolu.Printer.Meat.Declaration.Value+    Ormolu.Printer.Meat.Declaration.Warning+    Ormolu.Printer.Meat.ImportExport+    Ormolu.Printer.Meat.Module+    Ormolu.Printer.Meat.Pragma+    Ormolu.Printer.Meat.Type+    Ormolu.Printer.Operators+    Ormolu.Printer.SpanStream+    Ormolu.Processing.Common+    Ormolu.Processing.Cpp+    Ormolu.Processing.Preprocess+    Ormolu.Terminal+    Ormolu.Terminal.QualifiedDo+    Ormolu.Utils+    Ormolu.Utils.Cabal+    Ormolu.Utils.Fixity+    Ormolu.Utils.IO -    else-        ghc-options: -O2 -Wall+  hs-source-dirs: src+  other-modules: GHC.DynFlags+  default-language: GHC2021+  build-depends:+    Cabal-syntax >=3.16 && <3.17,+    Diff >=0.4 && <2,+    MemoTrie >=0.6 && <0.7,+    ansi-terminal >=0.10 && <1.2,+    array >=0.5 && <0.6,+    base >=4.14 && <5,+    binary >=0.8 && <0.9,+    bytestring >=0.2 && <0.13,+    choice >=0.2.4.1 && <0.3,+    containers >=0.5 && <0.9,+    directory ^>=1.3,+    file-embed >=0.0.15 && <0.1,+    filepath >=1.2 && <1.6,+    ghc-lib-parser >=9.14 && <9.15,+    megaparsec >=9,+    mtl >=2 && <3,+    syb >=0.7 && <0.8,+    text >=2.1 && <3, -    if flag(internal-bundle-fixities)-        cpp-options: -DBUNDLE_FIXITIES+  if flag(dev)+    ghc-options:+      -Wall+      -Werror+      -Wredundant-constraints+      -Wpartial-fields+      -Wunused-packages+  else+    ghc-options:+      -O2+      -Wall  executable ormolu-    main-is:          Main.hs-    hs-source-dirs:   app-    other-modules:    Paths_ormolu-    autogen-modules:  Paths_ormolu-    default-language: GHC2021-    build-depends:-        Cabal-syntax >=3.12 && <3.13,-        base >=4.12 && <5,-        containers >=0.5 && <0.8,-        directory ^>=1.3,-        filepath >=1.2 && <1.6,-        ghc-lib-parser >=9.10 && <9.11,-        optparse-applicative >=0.14 && <0.19,-        ormolu,-        text >=2.1 && <3,-        th-env >=0.1.1 && <0.2+  main-is: Main.hs+  hs-source-dirs: app+  other-modules: Paths_ormolu+  autogen-modules: Paths_ormolu+  default-language: GHC2021+  build-depends:+    Cabal-syntax >=3.16 && <3.17,+    base >=4.12 && <5,+    containers >=0.5 && <0.9,+    directory ^>=1.3,+    filepath >=1.2 && <1.6,+    ghc-lib-parser >=9.14 && <9.15,+    optparse-applicative >=0.14 && <0.20,+    ormolu,+    text >=2.1 && <3,+    th-env >=0.1.1 && <0.2,+    unliftio >=0.2.10 && <0.3, -    if flag(dev)-        ghc-options:-            -Wall -Werror -Wredundant-constraints -Wpartial-fields-            -Wunused-packages -Wwarn=unused-packages+  -- We use parallelism so we need a threaded runtime to get any+  -- benefit.+  ghc-options:+    -threaded+    -rtsopts+    -with-rtsopts=-N -    else-        ghc-options: -O2 -Wall -rtsopts+  if flag(dev)+    ghc-options:+      -Wall+      -Werror+      -Wredundant-constraints+      -Wpartial-fields+      -Wunused-packages+      -Wwarn=unused-packages+  else+    ghc-options:+      -O2+      -Wall  test-suite tests-    type:               exitcode-stdio-1.0-    main-is:            Spec.hs-    build-tool-depends: hspec-discover:hspec-discover >=2 && <3-    hs-source-dirs:     tests-    other-modules:-        Ormolu.CabalInfoSpec-        Ormolu.Diff.TextSpec-        Ormolu.Fixity.ParserSpec-        Ormolu.Fixity.PrinterSpec-        Ormolu.FixitySpec-        Ormolu.OpTreeSpec-        Ormolu.Parser.OptionsSpec-        Ormolu.Parser.ParseFailureSpec-        Ormolu.Parser.PragmaSpec-        Ormolu.PrinterSpec--    default-language:   GHC2021-    build-depends:-        Cabal-syntax >=3.12 && <3.13,-        QuickCheck >=2.14,-        base >=4.14 && <5,-        choice >=0.2.4.1 && <0.3,-        containers >=0.5 && <0.8,-        directory ^>=1.3,-        filepath >=1.2 && <1.6,-        ghc-lib-parser >=9.10 && <9.11,-        hspec >=2 && <3,-        hspec-megaparsec >=2.2,-        megaparsec >=9,-        ormolu,-        path >=0.6 && <0.10,-        path-io >=1.4.2 && <2,-        temporary ^>=1.3,-        text >=2.1 && <3+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  build-tool-depends: hspec-discover:hspec-discover >=2 && <3+  hs-source-dirs: tests+  other-modules:+    Ormolu.CabalInfoSpec+    Ormolu.Diff.TextSpec+    Ormolu.Fixity.ParserSpec+    Ormolu.Fixity.PrinterSpec+    Ormolu.FixitySpec+    Ormolu.OpTreeSpec+    Ormolu.Parser.OptionsSpec+    Ormolu.Parser.ParseFailureSpec+    Ormolu.Parser.PragmaSpec+    Ormolu.PrinterSpec -    if flag(dev)-        ghc-options:-            -Wall -Werror -Wredundant-constraints -Wpartial-fields-            -Wunused-packages+  default-language: GHC2021+  build-depends:+    Cabal-syntax >=3.16 && <3.17,+    QuickCheck >=2.14,+    base >=4.14 && <5,+    choice >=0.2.4.1 && <0.3,+    containers >=0.5 && <0.9,+    directory ^>=1.3,+    filepath >=1.2 && <1.6,+    ghc-lib-parser >=9.14 && <9.15,+    hspec >=2 && <3,+    hspec-megaparsec >=2.2,+    megaparsec >=9,+    ormolu,+    path >=0.6 && <0.10,+    path-io >=1.4.2 && <2,+    temporary ^>=1.3,+    text >=2.1 && <3, -    else-        ghc-options: -O2 -Wall+  if flag(dev)+    ghc-options:+      -Wall+      -Werror+      -Wredundant-constraints+      -Wpartial-fields+      -Wunused-packages+  else+    ghc-options:+      -O2+      -Wall

@@ -7,10 +7,12 @@   ) where +import GHC.Data.FastString import GHC.Driver.Session import GHC.Platform import GHC.Settings import GHC.Settings.Config+import GHC.Unit.Types import GHC.Utils.Fingerprint  fakeSettings :: Settings@@ -43,6 +45,10 @@             platform_constants = Nothing           },       sPlatformMisc = PlatformMisc {},+      sUnitSettings =+        UnitSettings+          { unitSettings_baseUnitId = UnitId $ fsLit "ormolu"+          },       sToolSettings =         ToolSettings           { toolSettings_opt_P_fingerprint = fingerprint0,

@@ -40,6 +40,7 @@ import Control.Exception import Control.Monad import Control.Monad.IO.Class (MonadIO (..))+import Data.Choice qualified as Choice import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe) import Data.Set qualified as Set@@ -112,7 +113,7 @@   -- when we try to parse the rendered code back, inside of GHC monad   -- wrapper which will lead to error messages presenting the exceptions as   -- GHC bugs.-  let !formattedText = printSnippets (cfgDebug cfg) result0+  let !formattedText = printSnippets (Choice.fromBool (cfgDebug cfg)) result0   when (not (cfgUnsafe cfg) || cfgCheckIdempotence cfg) $ do     -- Parse the result of pretty-printing again and make sure that AST     -- is the same as AST of original snippet module span positions.@@ -138,7 +139,7 @@     -- Try re-formatting the formatted result to check if we get exactly     -- the same output.     when (cfgCheckIdempotence cfg) . liftIO $-      let reformattedText = printSnippets (cfgDebug cfg) result1+      let reformattedText = printSnippets (Choice.fromBool (cfgDebug cfg)) result1        in case diffText formattedText reformattedText path of             Nothing -> return ()             Just diff -> throwIO (OrmoluNonIdempotentOutput diff)

@@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeepSubsumption #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} @@ -14,12 +15,14 @@ import Data.Foldable import Data.Function import Data.Generics+import GHC.Data.FastString (FastString) import GHC.Hs import GHC.Types.SourceText import GHC.Types.SrcLoc import Ormolu.Parser.CommentStream import Ormolu.Parser.Result import Ormolu.Utils+import Type.Reflection qualified as TR  -- | Result of comparing two 'ParseResult's. data ParseResultDiff@@ -61,16 +64,8 @@   where     commentLines = concatMap (toList . unComment . unLoc) --- | Compare two modules for equality disregarding the following aspects:------     * 'SrcSpan's---     * ordering of import lists---     * style (ASCII vs Unicode) of arrows, colons---     * LayoutInfo (brace style) in extension fields---     * Empty contexts in type classes---     * Parens around derived type classes---     * 'TokenLocation' (in 'LHsToken'/'LHsUniToken')---     * 'EpaLocation'+-- | Compare two modules for equality disregarding certain semantically+-- irrelevant features like exact print annotations. diffHsModule :: HsModule GhcPs -> HsModule GhcPs -> ParseResultDiff diffHsModule = genericQuery   where@@ -83,35 +78,63 @@           if x' == (y' :: ByteString)             then Same             else Different []+      | Just rep <- isEpTokenish x,+        Just rep' <- isEpTokenish y =+          -- Only check whether the Ep(Uni)Tokens are of the same type; don't+          -- look at the actual payload (e.g. the location).+          if rep == rep' then Same else Different []       | typeOf x == typeOf y,         toConstr x == toConstr y =           mconcat $             gzipWithQ               ( genericQuery+                  -- EPA-related                   `extQ` considerEqual @SrcSpan                   `ext1Q` epAnnEq                   `extQ` considerEqual @SourceText-                  `extQ` hsDocStringEq-                  `extQ` importDeclQualifiedStyleEq-                  `extQ` classDeclCtxEq-                  `extQ` derivedTyClsParensEq                   `extQ` considerEqual @EpAnnComments -- ~ XCGRHSs GhcPs-                  `extQ` considerEqual @TokenLocation -- in LHs(Uni)Token                   `extQ` considerEqual @EpaLocation+                  `extQ` considerEqual @(Maybe EpaLocation)                   `extQ` considerEqual @EpLayout-                  `extQ` considerEqual @[AddEpAnn]                   `extQ` considerEqual @AnnSig                   `extQ` considerEqual @HsRuleAnn+                  `extQ` considerEqual @EpLinear+                  `extQ` considerEqual @AnnSynDecl+                  -- FastString (for example for string literals)+                  `extQ` considerEqualVia' ((==) @FastString)+                  -- ModuleName is a newtype of FastString+                  `extQ` considerEqualVia' ((==) @ModuleName)+                  -- Haddock strings+                  `extQ` hsDocStringEq+                  -- Whether imports are pre- or post-qualified+                  `extQ` importDeclQualifiedStyleEq+                  -- Whether a class has an empty context+                  `extQ` classDeclCtxEq+                  -- Whether there are parens around a derived type class+                  `extQ` derivedTyClsParensEq+                  -- For better error messages                   `ext2Q` forLocated-                  -- unicode-related-                  `extQ` considerEqual @(EpUniToken "->" "→")-                  `extQ` considerEqual @(EpUniToken "::" "∷")-                  `extQ` considerEqual @EpLinearArrow               )               x               y       | otherwise = Different [] +    -- Return the 'TR.SomeTypeRep' of the type of the given value if it is an+    -- 'EpToken', an 'EpUniToken', or a list of these.+    isEpTokenish :: (Typeable a) => a -> Maybe TR.SomeTypeRep+    isEpTokenish = fmap TR.SomeTypeRep . go . TR.typeOf+      where+        go :: TR.TypeRep a -> Maybe (TR.TypeRep a)+        go rep = case rep of+          TR.App t t'+            | Just HRefl <- TR.eqTypeRep t (TR.typeRep @[]) ->+                TR.App t <$> go t'+          TR.App (TR.App t _) _ ->+            rep <$ TR.eqTypeRep t (TR.typeRep @EpUniToken)+          TR.App t _ ->+            rep <$ TR.eqTypeRep t (TR.typeRep @EpToken)+          _ -> Nothing+     considerEqualVia ::       forall a.       (Typeable a) =>@@ -130,6 +153,7 @@     epAnnEq :: EpAnn a -> b -> ParseResultDiff     epAnnEq _ _ = Same +    importDeclQualifiedStyleEq :: forall a. (Data a) => ImportDeclQualifiedStyle -> a -> ParseResultDiff     importDeclQualifiedStyleEq = considerEqualVia' f       where         f QualifiedPre QualifiedPost = True

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QualifiedDo #-}@@ -24,9 +23,6 @@ import GHC.Types.SrcLoc import Ormolu.Terminal import Ormolu.Terminal.QualifiedDo qualified as Term-#if !MIN_VERSION_base(4,20,0)-import Data.List (foldl')-#endif  ---------------------------------------------------------------------------- -- Types

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}@@ -35,6 +34,7 @@ import Data.Binary qualified as Binary import Data.Binary.Get qualified as Binary import Data.ByteString.Lazy qualified as BL+import Data.FileEmbed (embedFile) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Map.Strict qualified as Map@@ -46,27 +46,12 @@ import Language.Haskell.Syntax.ImpExp (ImportListInterpretation (..)) import Ormolu.Fixity.Imports (FixityImport (..)) import Ormolu.Fixity.Internal-#if BUNDLE_FIXITIES-import Data.FileEmbed (embedFile)-#else-import qualified Data.ByteString as B-import System.IO.Unsafe (unsafePerformIO)-#endif  -- | The built-in 'HackageInfo' used by Ormolu. hackageInfo :: HackageInfo-#if BUNDLE_FIXITIES hackageInfo =   Binary.runGet Binary.get $     BL.fromStrict $(embedFile "extract-hackage-info/hackage-info.bin")-#else--- The GHC WASM backend does not yet support Template Haskell, so we instead--- pass in the encoded fixity DB via pre-initialization with Wizer.-hackageInfo =-  unsafePerformIO $-    Binary.runGet Binary.get . BL.fromStrict <$> B.readFile "hackage-info.bin"-{-# NOINLINE hackageInfo #-}-#endif  -- | Default set of packages to assume as dependencies e.g. when no Cabal -- file is found or taken into consideration.

@@ -30,8 +30,10 @@   ) where -import Control.DeepSeq (NFData) import Data.Binary (Binary)+import Data.Binary qualified as Binary+import Data.Binary.Get qualified as Binary+import Data.Binary.Put qualified as Binary import Data.ByteString.Short (ShortByteString) import Data.ByteString.Short qualified as SBS import Data.Choice (Choice)@@ -59,7 +61,7 @@   { -- | Invariant: UTF-8 encoded     getOpName :: ShortByteString   }-  deriving newtype (Eq, Ord, Binary, NFData)+  deriving newtype (Eq, Ord, Binary)  -- | Convert an 'OpName' to 'Text'. unOpName :: OpName -> Text@@ -88,7 +90,7 @@   | InfixR   | InfixN   deriving stock (Eq, Ord, Show, Generic)-  deriving anyclass (Binary, NFData)+  deriving anyclass (Binary)  -- | Fixity information about an infix operator. This type provides precise -- information as opposed to 'FixityApproximation'.@@ -96,11 +98,20 @@   { -- | Fixity direction     fiDirection :: FixityDirection,     -- | Precedence-    fiPrecedence :: Int+    fiPrecedence :: Double   }   deriving stock (Eq, Ord, Show, Generic)-  deriving anyclass (Binary, NFData) +instance Binary FixityInfo where+  put FixityInfo {..} = do+    Binary.put fiDirection+    Binary.putDoublele fiPrecedence++  get = do+    fiDirection <- Binary.get+    fiPrecedence <- Binary.getDoublele+    pure FixityInfo {..}+ -- | Fixity info of the built-in colon data constructor. colonFixityInfo :: FixityInfo colonFixityInfo = FixityInfo InfixR 5@@ -116,14 +127,25 @@     faDirection :: Maybe FixityDirection,     -- | Minimum precedence level found in the (maybe conflicting)     -- definitions for the operator (inclusive)-    faMinPrecedence :: Int,+    faMinPrecedence :: Double,     -- | Maximum precedence level found in the (maybe conflicting)     -- definitions for the operator (inclusive)-    faMaxPrecedence :: Int+    faMaxPrecedence :: Double   }   deriving stock (Eq, Ord, Show, Generic)-  deriving anyclass (Binary, NFData) +instance Binary FixityApproximation where+  put FixityApproximation {..} = do+    Binary.put faDirection+    Binary.putDoublele faMinPrecedence+    Binary.putDoublele faMaxPrecedence++  get = do+    faDirection <- Binary.get+    faMinPrecedence <- Binary.getDoublele+    faMaxPrecedence <- Binary.getDoublele+    pure FixityApproximation {..}+ -- | Gives the ability to merge two (maybe conflicting) definitions for an -- operator, keeping the higher level of compatible information from both. instance Semigroup FixityApproximation where@@ -156,7 +178,7 @@ newtype HackageInfo   = HackageInfo (Map PackageName (Map ModuleName (Map OpName FixityInfo)))   deriving stock (Generic)-  deriving anyclass (Binary, NFData)+  deriving anyclass (Binary)  -- | Map from the operator name to its 'FixityInfo'. newtype FixityOverrides = FixityOverrides@@ -168,7 +190,7 @@ defaultFixityOverrides :: FixityOverrides defaultFixityOverrides = FixityOverrides Map.empty --- | Module re-exports+-- | Module re-exports. newtype ModuleReexports = ModuleReexports   { unModuleReexports :: Map ModuleName (NonEmpty (Maybe PackageName, ModuleName))   }@@ -176,61 +198,7 @@  -- | Module re-exports to apply by default. defaultModuleReexports :: ModuleReexports-defaultModuleReexports =-  ModuleReexports . Map.fromList $-    [ ( "Control.Lens",-        l-          "lens"-          [ "Control.Lens.At",-            "Control.Lens.Cons",-            "Control.Lens.Each",-            "Control.Lens.Empty",-            "Control.Lens.Equality",-            "Control.Lens.Fold",-            "Control.Lens.Getter",-            "Control.Lens.Indexed",-            "Control.Lens.Iso",-            "Control.Lens.Lens",-            "Control.Lens.Level",-            "Control.Lens.Plated",-            "Control.Lens.Prism",-            "Control.Lens.Reified",-            "Control.Lens.Review",-            "Control.Lens.Setter",-            "Control.Lens.TH",-            "Control.Lens.Traversal",-            "Control.Lens.Tuple",-            "Control.Lens.Type",-            "Control.Lens.Wrapped",-            "Control.Lens.Zoom"-          ]-      ),-      ( "Servant",-        l-          "servant"-          [ "Servant.API"-          ]-      ),-      ( "Optics",-        l-          "optics"-          [ "Optics.Fold",-            "Optics.Operators",-            "Optics.IxAffineFold",-            "Optics.IxFold",-            "Optics.IxTraversal",-            "Optics.Traversal"-          ]-      ),-      ( "Test.Hspec",-        l-          "hspec-expectations"-          [ "Test.Hspec.Expectations"-          ]-      )-    ]-  where-    l packageName xs = (Just packageName,) <$> NE.fromList xs+defaultModuleReexports = ModuleReexports Map.empty  -- | Fixity information that is specific to a package being formatted. It -- requires module-specific imports in order to be usable.

@@ -103,7 +103,9 @@   fiDirection <- pFixityDirection   hidden hspace1   offsetAtPrecedence <- getOffset-  fiPrecedence <- L.decimal+  fiPrecedence <-+    try L.float+      <|> (fromIntegral <$> (L.decimal :: Parser Integer))   when (fiPrecedence > 9) $     region       (setErrorOffset offsetAtPrecedence)

@@ -19,6 +19,7 @@ import Data.Text.Lazy.Builder (Builder) import Data.Text.Lazy.Builder qualified as B import Data.Text.Lazy.Builder.Int qualified as B+import Data.Text.Lazy.Builder.RealFloat qualified as B import Distribution.ModuleName (ModuleName) import Distribution.ModuleName qualified as ModuleName import Distribution.Types.PackageName@@ -44,7 +45,7 @@         InfixR -> "infixr"         InfixN -> "infix",       " ",-      B.decimal fiPrecedence,+      renderPrecedence fiPrecedence,       " ",       if isTickedOperator operator         then "`" <> B.fromText operator <> "`"@@ -75,3 +76,12 @@  renderModuleName :: ModuleName -> Builder renderModuleName = B.fromString . intercalate "." . ModuleName.components++-- | Render precedence using integer representation for whole numbers.+renderPrecedence :: Double -> Builder+renderPrecedence x =+  let (n :: Int, fraction :: Double) = properFraction x+      isWholeEnough = fraction < 0.0001+   in if isWholeEnough+        then B.decimal n+        else B.realFloat x

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}@@ -13,10 +13,13 @@  import Data.Bifunctor import Data.Char (isAlphaNum)+import Data.Choice (Choice)+import Data.Choice qualified as Choice import Data.Function (on) import Data.List (nubBy, sortBy, sortOn) import Data.Map.Strict (Map) import Data.Map.Strict qualified as M+import Data.Ord (comparing) import GHC.Data.FastString import GHC.Hs import GHC.Hs.ImpExp as GHC@@ -25,17 +28,17 @@ import GHC.Types.SourceText import GHC.Types.SrcLoc import Ormolu.Utils (notImplemented, showOutputable)-#if !MIN_VERSION_base(4,20,0)-import Data.List (foldl')-#endif  -- | Sort and normalize imports.-normalizeImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]-normalizeImports =+normalizeImports ::+  Choice "implicitPrelude" ->+  [LImportDecl GhcPs] ->+  [LImportDecl GhcPs]+normalizeImports implicitPrelude =   fmap snd     . M.toAscList     . M.fromListWith combineImports-    . fmap (\x -> (importId x, g x))+    . fmap (\x -> (importId implicitPrelude x, g x))   where     g :: LImportDecl GhcPs -> LImportDecl GhcPs     g (L l ImportDecl {..}) =@@ -74,10 +77,23 @@     importSafe :: Bool,     importQualified :: Bool,     importAs :: Maybe ModuleName,-    importHiding :: Maybe ImportListInterpretationOrd+    importHiding :: Maybe ImportListInterpretationOrd,+    importLevel :: Maybe ImportDeclLevelOrd   }   deriving (Eq, Ord) +-- | A wrapper for 'ImportDeclLevel' that provides an 'Ord' instance.+newtype ImportDeclLevelOrd = ImportDeclLevelOrd+  { unImportDeclLevelOrd :: ImportDeclLevel+  }+  deriving stock (Eq)++instance Ord ImportDeclLevelOrd where+  compare = compare `on` toBool . unImportDeclLevelOrd+    where+      toBool ImportDeclSplice = False+      toBool ImportDeclQuote = True+ data ImportPkgQual   = -- | The import is not qualified by a package name.     NoImportPkgQual@@ -108,8 +124,8 @@       toBool EverythingBut = True  -- | Obtain an 'ImportId' for a given import.-importId :: LImportDecl GhcPs -> ImportId-importId (L _ ImportDecl {..}) =+importId :: Choice "implicitPrelude" -> LImportDecl GhcPs -> ImportId+importId implicitPrelude (L _ ImportDecl {..}) =   ImportId     { importIsPrelude = isPrelude,       importIdName = moduleName,@@ -121,11 +137,17 @@         QualifiedPost -> True         NotQualified -> False,       importAs = unLoc <$> ideclAs,-      importHiding = ImportListInterpretationOrd . fst <$> ideclImportList+      importHiding = ImportListInterpretationOrd . fst <$> ideclImportList,+      importLevel = importLevelOf ideclLevelSpec     }   where-    isPrelude = moduleNameString moduleName == "Prelude"+    isPrelude =+      Choice.isTrue implicitPrelude && moduleNameString moduleName == "Prelude"     moduleName = unLoc ideclName+    importLevelOf = \case+      LevelStylePre l -> Just (ImportDeclLevelOrd l)+      LevelStylePost l -> Just (ImportDeclLevelOrd l)+      NotLevelled -> Nothing  -- | Normalize a collection of import items. normalizeLies :: [LIE GhcPs] -> [LIE GhcPs]@@ -155,7 +177,7 @@                         IEVar _ _ _ ->                           error "Ormolu.Imports broken presupposition"                         IEThingAbs x _ _ ->-                          IEThingWith x n wildcard g Nothing+                          IEThingWith (x, noAnn) n wildcard g Nothing                         IEThingAll x n' _ ->                           IEThingAll x n' Nothing                         IEThingWith x n' wildcard' g' _ ->@@ -207,15 +229,15 @@  -- | Compare two @'IEWrapppedName' 'GhcPs'@ things. compareIewn :: IEWrappedName GhcPs -> IEWrappedName GhcPs -> Ordering-compareIewn (IEName _ x) (IEName _ y) = unLoc x `compareRdrName` unLoc y-compareIewn (IEName _ _) (IEPattern _ _) = LT-compareIewn (IEName _ _) (IEType _ _) = LT-compareIewn (IEPattern _ _) (IEName _ _) = GT-compareIewn (IEPattern _ x) (IEPattern _ y) = unLoc x `compareRdrName` unLoc y-compareIewn (IEPattern _ _) (IEType _ _) = LT-compareIewn (IEType _ _) (IEName _ _) = GT-compareIewn (IEType _ _) (IEPattern _ _) = GT-compareIewn (IEType _ x) (IEType _ y) = unLoc x `compareRdrName` unLoc y+compareIewn = (comparing fst <> (compareRdrName `on` unLoc . snd)) `on` classify+  where+    classify :: IEWrappedName GhcPs -> (Int, LocatedN RdrName)+    classify = \case+      IEName _ x -> (0, x)+      IEDefault _ x -> (1, x)+      IEPattern _ x -> (2, x)+      IEType _ x -> (3, x)+      IEData _ x -> (4, x)  compareRdrName :: RdrName -> RdrName -> Ordering compareRdrName x y =

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}@@ -17,6 +18,8 @@ import Control.Monad.Except (ExceptT (..), runExceptT) import Control.Monad.IO.Class import Data.Char (isSpace)+import Data.Choice (Choice)+import Data.Choice qualified as Choice import Data.Functor import Data.Generics hiding (orElse) import Data.List qualified as L@@ -28,7 +31,7 @@ import GHC.Data.FastString qualified as GHC import GHC.Data.Maybe (orElse) import GHC.Data.StringBuffer (StringBuffer)-import GHC.Driver.Config.Parser (initParserOpts)+import GHC.Driver.Config.Parser (initParserOpts, supportedLanguagePragmas) import GHC.Driver.Errors.Types qualified as GHC import GHC.Driver.Session as GHC import GHC.DynFlags (baseDynFlags)@@ -43,6 +46,7 @@ import GHC.Types.SrcLoc import GHC.Utils.Error import GHC.Utils.Exception (ExceptionMonad)+import GHC.Utils.Logger (initLogger) import GHC.Utils.Panic qualified as GHC import Ormolu.Config import Ormolu.Exception@@ -89,8 +93,12 @@     parsePragmasIntoDynFlags baseFlags extraOpts path rawInputStringBuffer >>= \case       Right res -> pure res       Left err -> throwIO (OrmoluParsingFailed beginningLoc err)-  let cppEnabled = EnumSet.member Cpp (GHC.extensionFlags dynFlags)-      implicitPrelude = EnumSet.member ImplicitPrelude (GHC.extensionFlags dynFlags)+  let cppEnabled =+        Choice.fromBool $+          EnumSet.member Cpp (GHC.extensionFlags dynFlags)+      implicitPrelude =+        Choice.fromBool $+          EnumSet.member ImplicitPrelude (GHC.extensionFlags dynFlags)   fixityImports <-     parseImports dynFlags implicitPrelude path rawInputStringBuffer >>= \case       Right res ->@@ -142,12 +150,15 @@       parser = case cfgSourceType of         ModuleSource -> GHC.parseModule         SignatureSource -> GHC.parseSignature+      implicitPrelude =+        Choice.fromBool $+          EnumSet.member ImplicitPrelude (GHC.extensionFlags dynFlags)       r = case runParser parser dynFlags path input of         GHC.PFailed pstate ->           case pStateErrors pstate of             Just err -> Left err             Nothing -> error "PFailed does not have an error"-        GHC.POk pstate (L _ (normalizeModule -> hsModule)) ->+        GHC.POk pstate (L _ (normalizeModule implicitPrelude -> hsModule)) ->           case pStateErrors pstate of             -- Some parse errors (pattern/arrow syntax in expr context)             -- do not cause a parse error, but they are replaced with "_"@@ -172,13 +183,20 @@  -- | Normalize a 'HsModule' by sorting its import\/export lists, dropping -- blank comments, etc.-normalizeModule :: HsModule GhcPs -> HsModule GhcPs-normalizeModule hsmod =+normalizeModule ::+  Choice "implicitPrelude" ->+  HsModule GhcPs ->+  HsModule GhcPs+normalizeModule implicitPrelude hsmod =   everywhere-    (mkT dropBlankTypeHaddocks `extT` dropBlankDataDeclHaddocks `extT` patchContext)+    ( mkT dropBlankTypeHaddocks+        `extT` dropBlankDataDeclHaddocks+        `extT` patchContext+        `extT` patchExprContext+    )     hsmod       { hsmodImports =-          normalizeImports (hsmodImports hsmod),+          normalizeImports implicitPrelude (hsmodImports hsmod),         hsmodDecls =           filter (not . isBlankDocD . unLoc) (hsmodDecls hsmod),         hsmodExt =@@ -209,11 +227,18 @@         | isBlankDocString s -> ConDeclH98 {con_doc = Nothing, ..}       a -> a +    -- For constraint contexts (both in types and in expressions), normalize+    -- parenthesis as decided in https://github.com/tweag/ormolu/issues/264.     patchContext :: LHsContext GhcPs -> LHsContext GhcPs     patchContext = fmap $ \case       [x@(L _ (HsParTy _ _))] -> [x]       [x@(L lx _)] -> [L lx (HsParTy noAnn x)]       xs -> xs+    patchExprContext :: LHsExpr GhcPs -> LHsExpr GhcPs+    patchExprContext = fmap $ \case+      x@(HsQual _ (L _ [L _ HsPar {}]) _) -> x+      HsQual l0 (L l1 [x@(L lx _)]) e -> HsQual l0 (L l1 [L lx (HsPar noAnn x)]) e+      x -> x  -- | Enable all language extensions that we think should be enabled by -- default for ease of use.@@ -253,7 +278,8 @@     OverloadedRecordDot, -- f.g parses differently     OverloadedRecordUpdate, -- qualified fields are not supported     OverloadedLabels, -- a#b is parsed differently-    ExtendedLiterals -- 1#Word32 is parsed differently+    ExtendedLiterals, -- 1#Word32 is parsed differently+    MultilineStrings -- """""" is parsed differently   ]  -- | Run a 'GHC.P' computation.@@ -294,10 +320,14 @@     let (_warnings, fileOpts) =           GHC.getOptions             (initParserOpts flags)+            (supportedLanguagePragmas flags)             input             filepath+    -- 'initLogger' does not have any hooks installed, so we don't get any+    -- (unwanted) output.+    logger <- initLogger     (flags', leftovers, warnings) <--      parseDynamicFilePragma flags (extraOpts <> fileOpts)+      parseDynamicFilePragma logger flags (extraOpts <> fileOpts)     case NE.nonEmpty leftovers of       Nothing -> return ()       Just unrecognizedOpts ->@@ -309,8 +339,8 @@ parseImports ::   -- | Pre-set 'DynFlags'   DynFlags ->-  -- | Implicit Prelude?-  Bool ->+  -- | Whether the implicit Prelude is in effect+  Choice "implicitPrelude" ->   -- | File name (only for source location annotations)   FilePath ->   -- | Input for the parser@@ -332,7 +362,11 @@                     mod' = mmoduleName `orElse` L (GHC.noAnnSrcSpan main_loc) mAIN_NAME                     explicitImports = hsmodImports hsmod                     implicitImports =-                      GHC.mkPrelImports (unLoc mod') main_loc implicitPrelude explicitImports+                      GHC.mkPrelImports+                        (unLoc mod')+                        main_loc+                        (Choice.toBool implicitPrelude)+                        explicitImports                  in Right (explicitImports ++ implicitImports)   where     popts = initParserOpts flags

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} @@ -7,6 +8,7 @@   ) where +import Data.Choice (Choice) import Data.Text (Text) import Data.Text qualified as T import Ormolu.Parser.Result@@ -18,7 +20,7 @@ -- | Render several source snippets. printSnippets ::   -- | Whether to print out debug information during printing-  Bool ->+  Choice "debug" ->   -- | Result of parsing   [SourceSnippet] ->   -- | Resulting rendition

@@ -21,6 +21,7 @@     atom,     space,     newline,+    newlineLiteral,     inci,     inciIf,     askSourceType,@@ -30,6 +31,7 @@     encloseLocated,     located',     switchLayout,+    enterLayout,     Layout (..),     vlayout,     getLayout,@@ -39,6 +41,7 @@     -- ** Formatting lists     sep,     sepSemi,+    sepSemi',     canUseBraces,     useBraces,     dontUseBraces,@@ -207,7 +210,25 @@   -- | Elements to render   [a] ->   R ()-sepSemi f xs = vlayout singleLine multiLine+sepSemi = sepSemi' False++-- | A version of 'sepSemi' that allows to control whether semicolons should+-- be inserted in multi-line layout.+--+-- > useBraces $ sepSemi' False txt ["foo", "bar"]+-- >   == vlayout (txt "{ foo; bar }") (txt "foo\nbar")+--+-- > dontUseBraces $ sepSemi' True txt ["foo", "bar"]+-- >   == vlayout (txt "foo; bar") (txt "foo;\nbar")+sepSemi' ::+  -- | Whether to insert semicolons in multi-line layout+  Bool ->+  -- | How to render an element+  (a -> R ()) ->+  -- | Elements to render+  [a] ->+  R ()+sepSemi' addMultiColSemi f xs = vlayout singleLine multiLine   where     singleLine = do       ub <- canUseBraces@@ -223,7 +244,10 @@               txt "}"             else sep (txt ";" >> space) f xs'     multiLine =-      sep newline (dontUseBraces . f) xs+      sep+        (if addMultiColSemi then txt ";" >> newline else newline)+        (dontUseBraces . f)+        xs  ---------------------------------------------------------------------------- -- Wrapping

@@ -17,6 +17,7 @@     atom,     space,     newline,+    newlineLiteral,     askSourceType,     askModuleFixityMap,     askDebug,@@ -61,7 +62,6 @@ import Control.Monad.State.Strict import Data.Bool (bool) import Data.Choice (Choice)-import Data.Choice qualified as Choice import Data.Coerce import Data.Functor ((<&>)) import Data.List (find)@@ -108,7 +108,7 @@     -- | Module fixity map     rcModuleFixityMap :: ModuleFixityMap,     -- | Whether to print out debug information during printing-    rcDebug :: !Bool+    rcDebug :: !(Choice "debug")   }  -- | State context of 'R'.@@ -178,8 +178,9 @@   EnumSet Extension ->   -- | Module fixity map   ModuleFixityMap ->+  -- | Whether to print out debug information during printing+  Choice "debug" ->   -- | Resulting rendition-  Bool ->   Text runR (R m) sstream cstream sourceType extensions moduleFixityMap debug =   TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc@@ -386,6 +387,19 @@             _ -> AfterNewline         } +-- | Insert a newline literal without modifying the internal state of the+-- parser. This is to be used exceptionally, e.g. for printing multiline+-- string literals.+newlineLiteral :: R ()+newlineLiteral = R . modify $ \sc ->+  sc+    { scBuilder = scBuilder sc <> "\n",+      scColumn = 0,+      scIndent = 0,+      scThisLineSpans = [],+      scRequestedDelimiter = AfterNewline+    }+ -- | Return the source type. askSourceType :: R SourceType askSourceType = R (asks rcSourceType)@@ -397,7 +411,7 @@ -- | Retrieve whether we should print out certain debug information while -- printing. askDebug :: R (Choice "debug")-askDebug = R (asks (Choice.fromBool . rcDebug))+askDebug = R (asks rcDebug)  inciBy :: Int -> R () -> R () inciBy step (R m) = R (local modRC m)

@@ -15,6 +15,7 @@     p_hsDocName,     p_sourceText,     p_namespaceSpec,+    p_hsMultAnn,   ) where @@ -27,6 +28,7 @@ import GHC.Hs.Doc import GHC.Hs.Extension (GhcPs) import GHC.Hs.ImpExp+import GHC.Hs.Type import GHC.LanguageExtensions.Type (Extension (..)) import GHC.Parser.Annotation import GHC.Types.Name.Occurrence (OccName (..), occNameString)@@ -45,7 +47,7 @@   | -- | Top-level declarations     Free --- | Outputs the name of the module-like entity, preceeded by the correct prefix ("module" or "signature").+-- | Outputs the name of the module-like entity, preceded by the correct prefix ("module" or "signature"). p_hsmodName :: ModuleName -> R () p_hsmodName mname = do   sourceType <- askSourceType@@ -58,6 +60,10 @@ p_ieWrappedName :: IEWrappedName GhcPs -> R () p_ieWrappedName = \case   IEName _ x -> p_rdrName x+  IEDefault _ x -> do+    txt "default"+    space+    p_rdrName x   IEPattern _ x -> do     txt "pattern"     space@@ -66,6 +72,10 @@     txt "type"     space     p_rdrName x+  IEData _ x -> do+    txt "data"+    space+    p_rdrName x  -- | Render a @'LocatedN' 'RdrName'@. p_rdrName :: LocatedN RdrName -> R ()@@ -73,20 +83,20 @@   unboxedSums <- isExtensionEnabled UnboxedSums   let wrapper EpAnn {anns} = case anns of         NameAnnQuote {nann_quoted} -> tickPrefix . wrapper nann_quoted-        NameAnn {nann_adornment = NameParens} ->+        NameAnn {nann_adornment = NameParens {}} ->           parens N . handleUnboxedSumsAndHashInteraction-        NameAnn {nann_adornment = NameBackquotes} -> backticks+        NameAnn {nann_adornment = NameBackquotes {}} -> backticks         -- whether the `->` identifier is parenthesized         NameAnnRArrow {nann_mopen = Just _} -> parens N         -- special case for unboxed unit tuples-        NameAnnOnly {nann_adornment = NameParensHash} -> const $ txt "(# #)"+        NameAnnOnly {nann_adornment = NameParensHash {}} -> const $ txt "(# #)"         _ -> id        -- When UnboxedSums is enabled, `(#` is a single lexeme, so we have to       -- insert spaces when we have a parenthesized operator starting with `#`.       handleUnboxedSumsAndHashInteraction         | unboxedSums,-          -- Qualified names do not start wth a `#`.+          -- Qualified names do not start with a `#`.           Unqual (occNameString -> '#' : _) <- x =             \y -> space *> y <* space         | otherwise = id@@ -119,16 +129,16 @@ -- | A helper for formatting infix constructions in lhs of definitions. p_infixDefHelper ::   -- | Whether to format in infix style-  Bool ->+  Choice "infixStyle" ->   -- | Whether to bump indentation for arguments-  Bool ->+  Choice "indentArgs" ->   -- | How to print the operator\/name   R () ->   -- | How to print the arguments   [R ()] ->   R () p_infixDefHelper isInfix indentArgs name args =-  case (isInfix, args) of+  case (Choice.toBool isInfix, args) of     (True, p0 : p1 : ps) -> do       let parens' =             if null ps@@ -141,14 +151,15 @@           name           space           p1-      unless (null ps) . inciIf indentArgs $ do+      unless (null ps) . inciIf (Choice.toBool indentArgs) $ do         breakpoint         sitcc (sep breakpoint sitcc ps)     (_, ps) -> do       name       unless (null ps) $ do         breakpoint-        inciIf indentArgs $ sitcc (sep breakpoint sitcc args)+        inciIf (Choice.toBool indentArgs) $+          sitcc (sep breakpoint sitcc args)  -- | Print a Haddock. p_hsDoc ::@@ -201,3 +212,9 @@   NoNamespaceSpecifier -> pure ()   TypeNamespaceSpecifier _ -> txt "type" *> space   DataNamespaceSpecifier _ -> txt "data" *> space++p_hsMultAnn :: (mult -> R ()) -> HsMultAnnOf mult GhcPs -> R ()+p_hsMultAnn p_mult = \case+  HsUnannotated _ -> pure ()+  HsLinearAnn _ -> txt "%1"+  HsExplicitMult _ mult -> txt "%" *> p_mult mult

@@ -256,7 +256,7 @@   TypeSynonym ::     RdrName -> HsDecl GhcPs pattern InlinePragma n <- SigD _ (InlineSig _ (L _ n) _)-pattern SpecializePragma n <- SigD _ (SpecSig _ (L _ n) _ _)+pattern SpecializePragma n <- SigD _ (isSpecSig -> Just n) pattern SCCPragma n <- SigD _ (SCCFunSig _ (L _ n) _) pattern AnnTypePragma n <- AnnD _ (HsAnnotation _ (TypeAnnProvenance (L _ n)) _) pattern AnnValuePragma n <- AnnD _ (HsAnnotation _ (ValueAnnProvenance (L _ n)) _)@@ -267,6 +267,12 @@ pattern FamilyDeclaration n <- TyClD _ (FamDecl _ (FamilyDecl _ _ _ (L _ n) _ _ _ _)) pattern TypeSynonym n <- TyClD _ (SynDecl _ (L _ n) _ _ _) +isSpecSig :: Sig GhcPs -> Maybe RdrName+isSpecSig = \case+  SpecSig _ (L _ n) _ _ -> Just n+  SpecSigE _ _ (deconstructExprFromSpecSigE -> (L _ n, _, _)) _ -> Just n+  _ -> Nothing+ -- Declarations which can refer to multiple names  pattern@@ -313,6 +319,7 @@  patBindNames :: Pat GhcPs -> [RdrName] patBindNames (TuplePat _ ps _) = concatMap (patBindNames . unLoc) ps+patBindNames (OrPat _ ps) = foldMap (patBindNames . unLoc) ps patBindNames (VarPat _ (L _ n)) = [n] patBindNames (WildPat _) = [] patBindNames (LazyPat _ (L _ p)) = patBindNames p

@@ -1,5 +1,8 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}  -- | Rendering of type class declarations.@@ -10,6 +13,8 @@  import Control.Arrow import Control.Monad+import Data.Choice (pattern Is)+import Data.Choice qualified as Choice import Data.Foldable import Data.Function (on) import Data.List (sortBy)@@ -60,8 +65,8 @@       for_ ctx p_classContext       switchLayout signatureSpans $         p_infixDefHelper-          (isInfix fixity)-          True+          (Choice.fromBool (isInfix fixity))+          (Is #indentArgs)           (p_rdrName name)           (located' p_hsTyVarBndr <$> hsq_explicit)       inci (p_classFundeps fdeps)

@@ -18,9 +18,7 @@ import Data.Choice qualified as Choice import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE-import Data.Maybe (isJust, isNothing, mapMaybe, maybeToList)-import Data.Void-import GHC.Data.Strict qualified as Strict+import Data.Maybe (isJust, isNothing, maybeToList) import GHC.Hs import GHC.Types.Fixity import GHC.Types.ForeignCall@@ -77,8 +75,8 @@     forM_ dd_ctxt p_lhsContext     switchLayout constructorSpans $       p_infixDefHelper-        (isInfix fixity)-        True+        (Choice.fromBool (isInfix fixity))+        (Is #indentArgs)         (p_rdrName name)         (p_tyVar <$> tyVars)     forM_ dd_kindSig $ \k -> do@@ -142,66 +140,78 @@     unless (null cs) . inci $ do       commaDel       sep commaDel p_rdrName cs-    inci $ do-      let conTy = case con_g_args of-            PrefixConGADT NoExtField xs ->-              let go (HsScaled a b) t = addCLocA t b (HsFunTy NoExtField a b t)-               in foldr go con_res_ty xs-            RecConGADT _ r ->-              addCLocA r con_res_ty $-                HsFunTy-                  NoExtField-                  (HsUnrestrictedArrow noAnn)-                  (la2la $ HsRecTy noAnn <$> r)-                  con_res_ty-          qualTy = case con_mb_cxt of-            Nothing -> conTy-            Just qs ->-              addCLocA qs conTy $-                HsQualTy NoExtField qs conTy-          quantifiedTy :: LHsType GhcPs-          quantifiedTy =-            addCLocA con_bndrs qualTy $-              hsOuterTyVarBndrsToHsType (unLoc con_bndrs) qualTy-      space-      txt "::"-      if hasDocStrings (unLoc con_res_ty)-        then newline-        else breakpoint-      located quantifiedTy p_hsType+    space+    txt "::"+    delimiter+    inci . switchLayout conSigSpans $ do+      located con_outer_bndrs p_hsOuterTyVarBndrs+      case unLoc con_outer_bndrs of+        HsOuterImplicit {} -> pure ()+        HsOuterExplicit {} -> delimiter+      forM_ con_inner_bndrs $ \tele -> do+        p_hsForAllTelescope tele+        delimiter+      forM_ con_mb_cxt $ \qs -> do+        located qs p_hsContext+        space+        txt "=>"+        delimiter+      switchLayout conArgResSpans $ do+        case con_g_args of+          PrefixConGADT NoExtField xs ->+            forM_ xs $ \x -> do+              p_hsConDeclFieldWithDoc x+              space+              p_hsMultAnn (located' p_hsType) (cdf_multiplicity x)+              space+              txt "->"+              delimiter+          RecConGADT _ x -> do+            located x p_hsConDeclRecFields+            space+            txt "->"+            delimiter+        located con_res_ty p_hsType   where+    delimiter = if anyDocStrings then newline else breakpoint+    anyDocStrings =+      hasDocStrings (unLoc con_res_ty) || case con_g_args of+        PrefixConGADT _ xs -> conArgsHaveHaddocks xs+        RecConGADT _ (L _ xs) -> conArgsHaveHaddocks $ cdrf_spec . unLoc <$> xs+     conDeclSpn =-      fmap getLocA (NE.toList con_names)-        <> [getLocA con_bndrs]+      fmap getLocA (NE.toList con_names) <> conSigSpans+    conSigSpans =+      [getLocA con_outer_bndrs]         <> maybeToList (fmap getLocA con_mb_cxt)-        <> conArgsSpans-    conArgsSpans = case con_g_args of-      PrefixConGADT NoExtField xs -> getLocA . hsScaledThing <$> xs-      RecConGADT _ x -> [getLocA x]+        <> conArgResSpans+    conArgResSpans =+      getLocA con_res_ty : case con_g_args of+        PrefixConGADT NoExtField xs -> getLocA . cdf_type <$> xs+        RecConGADT _ x -> [getLocA x] p_conDecl singleRecCon ConDeclH98 {..} =   case con_args of-    PrefixCon (_ :: [Void]) xs -> do+    PrefixCon xs -> do       renderConDoc       renderContext       switchLayout conDeclSpn $ do         p_rdrName con_name-        let args = hsScaledThing <$> xs-            argsHaveDocs = conArgsHaveHaddocks args+        let argsHaveDocs = conArgsHaveHaddocks xs             delimiter = if argsHaveDocs then newline else breakpoint         unless (null xs) delimiter         inci . sitcc $-          sep delimiter (sitcc . located' p_hsType) args+          sep delimiter (sitcc . p_hsConDeclFieldWithDoc) xs     RecCon l -> do       renderConDoc       renderContext       switchLayout conDeclSpn $ do         p_rdrName con_name         breakpoint-        inciIf (Choice.isFalse singleRecCon) (located l p_conDeclFields)-    InfixCon (HsScaled _ l) (HsScaled _ r) -> do+        inciIf (Choice.isFalse singleRecCon) (located l p_hsConDeclRecFields)+    InfixCon l r -> do       -- manually render these-      let (lType, larg_doc) = splitDocTy l-      let (rType, rarg_doc) = splitDocTy r+      let larg_doc = cdf_doc l+          rarg_doc = cdf_doc r        -- the constructor haddock can go on top of the entire constructor       -- only if neither argument has haddocks@@ -214,10 +224,10 @@         if isJust con_doc           then do             mapM_ (p_hsDoc Pipe (With #endNewline)) larg_doc-            located lType p_hsType+            p_hsConDeclField l             breakpoint           else do-            located lType p_hsType+            p_hsConDeclField l             case larg_doc of               Just doc -> space >> p_hsDoc Caret (With #endNewline) doc               Nothing -> breakpoint@@ -227,7 +237,7 @@           case rarg_doc of             Just doc -> newline >> p_hsDoc Pipe (With #endNewline) doc             Nothing -> breakpoint-          located rType p_hsType+          p_hsConDeclField r   where     renderConDoc = mapM_ (p_hsDoc Pipe (With #endNewline)) con_doc     renderContext =@@ -238,23 +248,16 @@         forM_ con_mb_cxt p_lhsContext      conNameWithContextSpn =-      [ RealSrcSpan real Strict.Nothing-      | EpaSpan (RealSrcSpan real _) <--          mapMaybe (matchAddEpAnn AnnForall) con_ext-      ]+      [getHasLoc $ acdh_forall con_ext]         <> fmap getLocA con_ex_tvs         <> maybeToList (fmap getLocA con_mb_cxt)         <> [conNameSpn]     conDeclSpn = conNameSpn : conArgsSpans     conNameSpn = getLocA con_name     conArgsSpans = case con_args of-      PrefixCon (_ :: [Void]) xs -> getLocA . hsScaledThing <$> xs+      PrefixCon xs -> getLocA . cdf_type <$> xs       RecCon l -> [getLocA l]-      InfixCon x y -> getLocA . hsScaledThing <$> [x, y]--    splitDocTy = \case-      L _ (HsDocTy _ ty doc) -> (ty, Just doc)-      ty -> (ty, Nothing)+      InfixCon x y -> getLocA . cdf_type <$> [x, y]  p_lhsContext ::   LHsContext GhcPs ->@@ -325,14 +328,9 @@   where     f ConDeclH98 {..} =       isJust con_doc || case con_args of-        PrefixCon [] xs ->-          conArgsHaveHaddocks (hsScaledThing <$> xs)+        PrefixCon xs -> conArgsHaveHaddocks xs         _ -> False     f _ = False -conArgsHaveHaddocks :: [LBangType GhcPs] -> Bool-conArgsHaveHaddocks xs =-  let hasDocs = \case-        HsDocTy {} -> True-        _ -> False-   in any (hasDocs . unLoc) xs+conArgsHaveHaddocks :: [HsConDeclField GhcPs] -> Bool+conArgsHaveHaddocks = any (isJust . cdf_doc)

@@ -5,13 +5,18 @@   ) where +import GHC.Data.Maybe (whenIsJust) import GHC.Hs import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type  p_defaultDecl :: DefaultDecl GhcPs -> R ()-p_defaultDecl (DefaultDecl _ ts) = do+p_defaultDecl (DefaultDecl _ mclass ts) = do   txt "default"+  whenIsJust mclass $ \c -> do+    breakpoint+    p_rdrName c   breakpoint   inci . parens N $     sep commaDel (sitcc . located' p_hsType) ts

@@ -9,10 +9,12 @@ import Control.Monad import GHC.Hs import GHC.Types.ForeignCall+import GHC.Types.SourceText import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Signature+import Ormolu.Printer.Meat.Declaration.StringLiteral  p_foreignDecl :: ForeignDecl GhcPs -> R () p_foreignDecl = \case@@ -56,8 +58,11 @@   located cCallConv atom   -- Need to check for 'noLoc' for the 'safe' annotation   when (isGoodSrcSpan $ getLocA safety) (space >> atom safety)-  space-  located sourceText p_sourceText+  inci $ located sourceText $ \case+    NoSourceText -> pure ()+    SourceText lit -> do+      breakpoint+      p_stringLit lit  p_foreignExport :: ForeignExport GhcPs -> R () p_foreignExport (CExport sourceText (L loc (CExportStatic _ _ cCallConv))) = do

@@ -124,20 +124,33 @@           -- place the operator in a trailing position (because it would be           -- read as being part of the do-block)           && not (isDoBlock $ rightMostNode prevExpr)+      -- A staircase of two or more trailing operators is only worthwhile when+      -- the operand at the very end of the chain has a hanging form (a do+      -- block, lambda, case, etc.): the trailing operator then introduces that+      -- block. When such a chain ends in an ordinary expression (a variable,+      -- literal, or plain application) the trailing layout only produces+      -- ever-deepening indentation, so we fall back to the leading-operator+      -- layout. A single hard splitter is exempt: it does not form a pyramid+      -- and trailing is the idiomatic way to introduce its operand.+      chainEndsInHangingForm =+        case rightMostNode t of+          OpNode (L _ n) -> exprPlacement n == Hanging+          _ -> False+      isSingleOperator = case ops of+        [_] -> True+        _ -> False       -- If all operators at the current level match the conditions to be-      -- trailing, then put them in a trailing position-      isTrailing = all couldBeTrailing $ zip (NE.toList exprs) ops+      -- trailing, and the chain is either a single operator or ends in a+      -- hanging form, then put the operators in a trailing position.+      isTrailing =+        (isSingleOperator || chainEndsInHangingForm)+          && all couldBeTrailing (zip (NE.toList exprs) ops)   ub <- if isTrailing then return useBraces else opBranchBraceStyle placement   let p_x = ub $ p_exprOpTree s firstExpr       putOpsExprs prevExpr (opi : ops') (expr : exprs') = do         let isLast = null exprs'             ub' = if not isLast then ub else id-            -- Distinguish holes used in infix notation.-            -- eg. '1 _foo 2' and '1 `_foo` 2'-            opWrapper = case unLoc (opiOp opi) of-              HsUnboundVar _ _ -> backticks-              _ -> id-            p_op = located (opiOp opi) (opWrapper . p_hsExpr)+            p_op = located (opiOp opi) p_hsExpr             p_y = ub' $ p_exprOpTree N expr         if isTrailing           then do@@ -169,7 +182,7 @@ -- intermediate representation. cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) cmdOpTree = \case-  (L _ (HsCmdTop _ (L _ (HsCmdArrForm _ op Infix _ [x, y])))) ->+  (L _ (HsCmdTop _ (L _ (HsCmdArrForm _ op Infix [x, y])))) ->     BinaryOpBranches (cmdOpTree x) op (cmdOpTree y)   n -> OpNode n 

@@ -4,16 +4,16 @@  module Ormolu.Printer.Meat.Declaration.Rule   ( p_ruleDecls,+    p_ruleBndrs,   ) where -import Control.Monad (unless) import GHC.Hs import GHC.Types.Basic import GHC.Types.SourceText import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common-import Ormolu.Printer.Meat.Declaration.Signature+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Signature import Ormolu.Printer.Meat.Declaration.Value import Ormolu.Printer.Meat.Type @@ -22,21 +22,12 @@   pragma "RULES" $ sep breakpoint (sitcc . located' p_ruleDecl) xs  p_ruleDecl :: RuleDecl GhcPs -> R ()-p_ruleDecl (HsRule _ ruleName activation tyvars ruleBndrs lhs rhs) = do+p_ruleDecl (HsRule _ ruleName activation 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+  p_ruleBndrs ruleBndrs   breakpoint   inci $ do     located lhs p_hsExpr@@ -48,6 +39,17 @@  p_ruleName :: RuleName -> R () p_ruleName name = atom (HsString NoSourceText name :: HsLit GhcPs)++p_ruleBndrs :: RuleBndrs GhcPs -> R ()+p_ruleBndrs (RuleBndrs HsRuleBndrsAnn {..} tyvars ruleBndrs) = do+  case tyvars of+    Nothing -> return ()+    Just xs -> do+      p_forallBndrs ForAllInvis p_hsTyVarBndr xs+      space+  case rb_tmanns of+    Nothing -> pure ()+    Just _ -> p_forallBndrs ForAllInvis p_ruleBndr ruleBndrs  p_ruleBndr :: RuleBndr GhcPs -> R () p_ruleBndr = \case

@@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}  -- | Type signature declarations. module Ormolu.Printer.Meat.Declaration.Signature@@ -8,12 +9,15 @@     p_typeAscription,     p_activation,     p_standaloneKindSig,+    deconstructExprFromSpecSigE,   ) where  import Control.Monad+import Data.Maybe (maybeToList) import GHC.Data.BooleanFormula import GHC.Hs+import GHC.Stack (HasCallStack) import GHC.Types.Basic import GHC.Types.Fixity import GHC.Types.Name.Reader@@ -21,6 +25,8 @@ import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Declaration.Rule+import Ormolu.Printer.Meat.Declaration.Value (p_hsExpr) import Ormolu.Printer.Meat.Type import Ormolu.Utils @@ -31,7 +37,9 @@   ClassOpSig _ def names sigType -> p_classOpSig def names sigType   FixSig _ sig -> p_fixSig sig   InlineSig _ name inlinePragma -> p_inlineSig name inlinePragma-  SpecSig _ name ts inlinePragma -> p_specSig name ts inlinePragma+  SpecSig _ name ts inlinePragma ->+    p_specSig Nothing (noLocA $ HsVar NoExtField name) ts inlinePragma+  SpecSigE _ ruleBndrs expr inlinePragma -> p_specSigE ruleBndrs expr inlinePragma   SpecInstSig _ sigType -> p_specInstSig sigType   MinimalSig _ booleanFormula -> p_minimalSig booleanFormula   CompleteMatchSig _ cs ty -> p_completeSig cs ty@@ -93,7 +101,7 @@   FixitySig GhcPs ->   R () p_fixSig = \case-  FixitySig namespace names (Fixity _ n dir) -> do+  FixitySig namespace names (Fixity n dir) -> do     txt $ case dir of       InfixL -> "infixl"       InfixR -> "infixr"@@ -122,26 +130,71 @@   p_rdrName name  p_specSig ::-  -- | Name-  LocatedN RdrName ->+  -- | Rule binders+  Maybe (RuleBndrs GhcPs) ->+  -- | Expression to specialize+  LHsExpr GhcPs ->   -- | The types to specialize to   [LHsSigType GhcPs] ->   -- | For specialize inline   InlinePragma ->   R ()-p_specSig name ts InlinePragma {..} = pragmaBraces $ do+p_specSig mRuleBndrs specExpr ts InlinePragma {..} = pragmaBraces $ do   txt "SPECIALIZE"   space   p_inlineSpec inl_inline   space-  p_activation inl_act-  space-  p_rdrName name-  space-  txt "::"-  breakpoint-  inci $ sep commaDel (located' p_hsSigType) ts+  case (inl_inline, inl_act) of+    (NoInline _, NeverActive) -> return ()+    _ -> p_activation inl_act+  inci $ do+    space+    forM_ mRuleBndrs $ \ruleBndrs -> do+      p_ruleBndrs ruleBndrs+      space+    located specExpr p_hsExpr+    case ts of+      [] -> pure ()+      _ -> do+        space+        txt "::"+        breakpoint+        sep commaDel (located' p_hsSigType) ts +p_specSigE ::+  -- | Rule binders+  RuleBndrs GhcPs ->+  -- | Expression to specialize+  LHsExpr GhcPs ->+  -- | For specialize inline+  InlinePragma ->+  R ()+p_specSigE ruleBndrs expr =+  p_specSig (Just ruleBndrs) specExpr (maybeToList sigTy)+  where+    (_, specExpr, sigTy) = deconstructExprFromSpecSigE expr++-- | The 'LHsExpr' in a 'SpecSigE' can only be of a very specific form, namely a+-- variable applied to value/type-level arguments, optionally with a type+-- signature.+--+-- https://github.com/ghc-proposals/ghc-proposals/blob/e2c683698323cec3e33625369ae2b5f585387c70/proposals/0493-specialise-expressions.rst#2proposed-change-specification+deconstructExprFromSpecSigE ::+  (HasCallStack) =>+  LHsExpr GhcPs ->+  (LocatedN RdrName, LHsExpr GhcPs, Maybe (LHsSigType GhcPs))+deconstructExprFromSpecSigE = \case+  L _ (ExprWithTySig _ e HsWC {hswc_body}) ->+    (findVar e, e, Just hswc_body)+  e -> (findVar e, e, Nothing)+  where+    findVar :: LHsExpr GhcPs -> LocatedN RdrName+    findVar = \case+      L _ (HsVar _ name) -> name+      L _ (HsApp _ e _) -> findVar e+      L _ (HsAppType _ e _) -> findVar e+      _ -> error "unreachble"+ p_inlineSpec :: InlineSpec -> R () p_inlineSpec = \case   Inline _ -> txt "INLINE"@@ -171,7 +224,7 @@  p_minimalSig ::   -- | Boolean formula-  LBooleanFormula (LocatedN RdrName) ->+  LBooleanFormula GhcPs ->   R () p_minimalSig =   located' $ \booleanFormula ->@@ -179,7 +232,7 @@  p_booleanFormula ::   -- | Boolean formula-  BooleanFormula (LocatedN RdrName) ->+  BooleanFormula GhcPs ->   R () p_booleanFormula = \case   Var name -> p_rdrName name

@@ -0,0 +1,14 @@+module Ormolu.Printer.Meat.Declaration.Signature+  ( p_sigDecl,+    p_typeAscription,+    p_activation,+  )+where++import GHC.Hs+import GHC.Types.Basic+import Ormolu.Printer.Combinators++p_sigDecl :: Sig GhcPs -> R ()+p_typeAscription :: LHsSigType GhcPs -> R ()+p_activation :: Activation -> R ()

@@ -0,0 +1,174 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++module Ormolu.Printer.Meat.Declaration.StringLiteral (p_stringLit) where++import Control.Applicative (Alternative (..))+import Control.Category ((>>>))+import Control.Monad ((>=>))+import Data.Semigroup (Min (..))+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Data.FastString+import GHC.Parser.CharClass (is_space)+import Ormolu.Printer.Combinators+import Ormolu.Utils++-- | Print the source text of a string literal while indenting gaps and newlines+-- correctly.+p_stringLit :: FastString -> R ()+p_stringLit src = case parseStringLiteral $ T.pack $ unpackFS src of+  Nothing -> error $ "Internal Ormolu error: couldn't parse string literal: " <> show src+  Just ParsedStringLiteral {..} -> sitcc do+    txt startMarker+    case stringLiteralKind of+      RegularStringLiteral -> do+        let singleLine =+              txt $ intercalateMinimalStringGaps segments+            multiLine =+              sep breakpoint f (attachRelativePos segments)+              where+                f :: (RelativePos, Text) -> R ()+                f (pos, s) = case pos of+                  SinglePos -> txt s+                  FirstPos -> txt s *> txt "\\"+                  MiddlePos -> txt "\\" *> txt s *> txt "\\"+                  LastPos -> txt "\\" *> txt s+        vlayout singleLine multiLine+      MultilineStringLiteral ->+        sep newlineLiteral txt segments+    txt endMarker++-- | The start/end marker of the literal, whether it is a regular or a multiline+-- literal, and the segments of the literals (separated by gaps for a regular+-- literal, and separated by newlines for a multiline literal).+data ParsedStringLiteral = ParsedStringLiteral+  { startMarker, endMarker :: Text,+    stringLiteralKind :: StringLiteralKind,+    segments :: [Text]+  }+  deriving stock (Show, Eq)++-- | A regular or a multiline string literal.+data StringLiteralKind = RegularStringLiteral | MultilineStringLiteral+  deriving stock (Show, Eq)++-- | Turn a string literal (as it exists in the source) into a more structured+-- form for printing. This should never return 'Nothing' for literals that the+-- GHC parser accepted.+parseStringLiteral :: Text -> Maybe ParsedStringLiteral+parseStringLiteral = \s -> do+  psl <-+    (stripStartEndMarker MultilineStringLiteral "\"\"\"" s)+      <|> (stripStartEndMarker RegularStringLiteral "\"" s)+  let splitSegments = case stringLiteralKind psl of+        RegularStringLiteral -> splitGaps+        MultilineStringLiteral -> splitMultilineString+  pure psl {segments = concatMap splitSegments $ segments psl}+  where+    -- Remove the given marker from the start and the end (at the end,+    -- optionally also remove a #).+    stripStartEndMarker ::+      StringLiteralKind -> Text -> Text -> Maybe ParsedStringLiteral+    stripStartEndMarker stringLiteralKind marker s = do+      let startMarker = marker+      suffix <- T.stripPrefix startMarker s+      let markerWithHash = marker <> "#"+      (endMarker, infix_) <-+        ((markerWithHash,) <$> T.stripSuffix markerWithHash suffix)+          <|> ((marker,) <$> T.stripSuffix marker suffix)+      pure ParsedStringLiteral {segments = [infix_], ..}++    -- Split a string on gaps (backslash delimited whitespaces).+    --+    -- > splitGaps "bar\\  \\fo\\&o" == ["bar", "fo\\&o"]+    splitGaps :: Text -> [Text]+    splitGaps s = go $ T.breakOnAll "\\" s+      where+        go [] = [s]+        go ((pre, suf) : bs) = case T.uncons suf of+          Just ('\\', suf')+            | (gap, T.uncons -> Just ('\\', rest)) <- T.span is_space suf',+              -- If there is a space after the backslash, this definitely is a+              -- string gap. Continue parsing gaps after the next backslash.+              not $ T.null gap ->+                pre : splitGaps rest+            | otherwise ->+                -- Check whether @suf@ starts with an escape sequence involving+                -- another backslash. If so, it can not be the start of a string+                -- gap, so we skip it.+                let skipNextBackslash =+                      any (`T.isPrefixOf` suf') escapesWithAnotherBackslash+                 in go $ (if skipNextBackslash then drop 1 else id) bs+          _ -> go bs++        -- All escape sequences (without the initial backslash) with another+        -- backslash. See+        -- https://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6+        escapesWithAnotherBackslash = ["\\", "^\\"]++    -- See the the MultilineStrings GHC proposal and 'lexMultilineString' from+    -- "GHC.Parser.String" for reference.+    --+    -- https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0569-multiline-strings.rst#proposed-change-specification+    splitMultilineString :: Text -> [Text]+    splitMultilineString =+      splitGaps+        -- There is no reason to use gaps with multiline string literals just to+        -- emulate multi-line strings, so we replace them with "\\ \\".+        >>> intercalateMinimalStringGaps+        >>> splitNewlines+        >>> fmap expandLeadingTabs+        >>> rmCommonWhitespacePrefixAndBlank++    -- See the definition of newlines on+    -- <https://www.haskell.org/onlinereport/haskell2010/haskellch10.html#x17-17800010.3>.+    splitNewlines :: Text -> [Text]+    splitNewlines = T.splitOn "\r\n" >=> T.split isNewlineish+      where+        isNewlineish c = c == '\n' || c == '\r' || c == '\f'++    -- See GHC's 'lexMultilineString'.+    expandLeadingTabs :: Text -> Text+    expandLeadingTabs = T.concat . go 0+      where+        go :: Int -> Text -> [Text]+        go col s = case T.breakOn "\t" s of+          (pre, T.uncons -> Just (_, suf)) ->+            let col' = col + T.length pre+                fill = 8 - (col' `mod` 8)+             in pre : T.replicate fill " " : go (col' + fill) suf+          _ -> [s]++    -- Don't touch the first line, and remove common whitespace from all+    -- remaining lines as well as convert those consisting only of whitespace to+    -- empty lines.+    rmCommonWhitespacePrefixAndBlank :: [Text] -> [Text]+    rmCommonWhitespacePrefixAndBlank = \case+      [] -> []+      hd : tl -> hd : tl'+        where+          (leadingSpaces, tl') = unzip $ countLeadingAndBlank <$> tl++          commonWs :: Int+          commonWs = maybe 0 getMin $ mconcat leadingSpaces++          countLeadingAndBlank :: Text -> (Maybe (Min Int), Text)+          countLeadingAndBlank l+            | T.all is_space l = (Nothing, "")+            | otherwise = (Just $ Min leadingSpace, T.drop commonWs l)+            where+              leadingSpace = T.length $ T.takeWhile is_space l++-- | Add minimal string gaps between string literal chunks. Such string gaps+-- /can/ be semantically meaningful (so we preserve them for simplicity); for+-- example:+--+-- >>> "\65\ \0" == "\650"+-- False+intercalateMinimalStringGaps :: [Text] -> Text+intercalateMinimalStringGaps = T.intercalate "\\ \\"

@@ -1,4 +1,7 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}  -- | Rendering of type synonym declarations.@@ -7,6 +10,7 @@   ) where +import Data.Choice (pattern Is, pattern Isn't) import GHC.Hs.Extension import GHC.Hs.Type import GHC.Parser.Annotation@@ -32,8 +36,11 @@   space   switchLayout (getLocA name : map getLocA hsq_explicit) $     p_infixDefHelper-      (case fixity of Infix -> True; _ -> False)-      True+      ( case fixity of+          Infix -> Is #infixStyle+          _ -> Isn't #infixStyle+      )+      (Is #indentArgs)       (p_rdrName name)       (map (located' p_hsTyVarBndr) hsq_explicit)   inci $ do

@@ -1,5 +1,8 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}  -- | Rendering of data\/type families.@@ -10,6 +13,8 @@ where  import Control.Monad+import Data.Choice (pattern Is)+import Data.Choice qualified as Choice import Data.Maybe (isNothing) import GHC.Hs import GHC.Types.Fixity@@ -33,8 +38,8 @@     breakpoint     switchLayout headerSpns $ do       p_infixDefHelper-        (isInfix fdFixity)-        True+        (Choice.fromBool (isInfix fdFixity))+        (Is #indentArgs)         (p_rdrName fdLName)         (located' p_hsTyVarBndr <$> hsq_explicit)     let resultSig = p_familyResultSigL fdResultSig@@ -95,8 +100,8 @@     let famLhsSpn = getLocA feqn_tycon : fmap lhsTypeArgSrcSpan feqn_pats     switchLayout famLhsSpn $       p_infixDefHelper-        (isInfix feqn_fixity)-        True+        (Choice.fromBool (isInfix feqn_fixity))+        (Is #indentArgs)         (p_rdrName feqn_tycon)         (p_lhsTypeArg <$> feqn_pats)     inci $ do

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -9,7 +10,6 @@     p_pat,     p_hsExpr,     p_hsUntypedSplice,-    p_stringLit,     IsApplicand (..),     p_hsExpr',     p_hsCmdTop,@@ -20,24 +20,19 @@  import Control.Monad import Data.Bool (bool)-import Data.Coerce (coerce)+import Data.Choice qualified as Choice import Data.Data hiding (Infix, Prefix) import Data.Function (on) import Data.Functor ((<&>)) import Data.Generics.Schemes (everything)-import Data.List (intersperse, sortBy)+import Data.List (intersperse, sortBy, unsnoc) import Data.List.NonEmpty (NonEmpty (..), (<|)) import Data.List.NonEmpty qualified as NE import Data.Maybe import Data.Text (Text)-import Data.Text qualified as Text-import Data.Void-import GHC.Data.Bag (bagToList)-import GHC.Data.FastString import GHC.Data.Strict qualified as Strict import GHC.Hs import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))-import GHC.Parser.CharClass (is_space) import GHC.Types.Basic import GHC.Types.Fixity import GHC.Types.Name.Reader@@ -48,7 +43,8 @@ import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree-import Ormolu.Printer.Meat.Declaration.Signature+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Signature+import Ormolu.Printer.Meat.Declaration.StringLiteral import Ormolu.Printer.Meat.Type import Ormolu.Printer.Operators import Ormolu.Utils@@ -100,15 +96,15 @@   MatchGroup GhcPs (LocatedA body) ->   R () p_matchGroup' placer render style mg@MG {..} = do-  let ob = case style of-        Case -> bracesIfEmpty-        LambdaCase -> bracesIfEmpty-        _ -> dontUseBraces-        where-          bracesIfEmpty = if isEmptyMatchGroup mg then useBraces else id   -- Since we are forcing braces on 'sepSemi' based on 'ob', we have to   -- restore the brace state inside the sepsemi.   ub <- bool dontUseBraces useBraces <$> canUseBraces+  let ob = case style of+        Case -> bracesIfNecessary+        LambdaCase -> bracesIfNecessary+        _ -> dontUseBraces+        where+          bracesIfNecessary = if isEmptyMatchGroup mg then useBraces else ub   ob $ sepSemi (located' (ub . p_Match)) (unLoc mg_alts)   where     p_Match m@Match {..} =@@ -117,15 +113,16 @@         render         (adjustMatchGroupStyle m style)         (isInfixMatch m)-        (HsNoMultAnn NoExtField)+        (HsUnannotated EpPatBind)         (matchStrictness m)-        m_pats+        -- We use the spans of the individual patterns.+        (unLoc m_pats)         m_grhss  -- | Function id obtained through pattern matching on 'FunBind' should not -- be used to print the actual equations because the different ‘RdrNames’ -- used in the equations may have different “decorations” (such as backticks--- and paretheses) associated with them. It is necessary to use per-equation+-- and parentheses) associated with them. It is necessary to use per-equation -- names obtained from 'm_ctxt' of 'Match'. This function replaces function -- name inside of 'Function' accordingly. adjustMatchGroupStyle ::@@ -133,14 +130,13 @@   MatchGroupStyle ->   MatchGroupStyle adjustMatchGroupStyle m = \case-  Function _ -> (Function . mc_fun . m_ctxt) m+  Function _ | FunRhs {mc_fun = f} <- m_ctxt m -> Function f   style -> style  matchStrictness :: Match id body -> SrcStrictness-matchStrictness match =-  case m_ctxt match of-    FunRhs {mc_strictness = s} -> s-    _ -> NoSrcStrict+matchStrictness = \case+  Match {m_ctxt = FunRhs {mc_strictness = s}} -> s+  _ -> NoSrcStrict  p_match ::   -- | Style of the group@@ -185,17 +181,19 @@   -- would start with two indentation steps applied, which is ugly, so we   -- need to be a bit more clever here and bump indentation level only when   -- pattern group is multiline.+  p_hsMultAnn (located' p_hsType) multAnn   case multAnn of-    HsNoMultAnn NoExtField -> pure ()-    HsPct1Ann _ -> txt "%1" *> space-    HsMultAnn _ ty -> do-      txt "%"-      located ty p_hsType-      space+    HsUnannotated {} -> pure ()+    HsLinearAnn {} -> space+    HsExplicitMult {} -> space   case strictness of     NoSrcStrict -> return ()     SrcStrict -> txt "!"     SrcLazy -> txt "~"+  let isCase = \case+        Case -> True+        LambdaCase -> True+        _ -> False   indentBody <- case NE.nonEmpty m_pats of     Nothing ->       False <$ case style of@@ -206,14 +204,19 @@             Function name -> combineSrcSpans (getLocA name) patSpans             _ -> patSpans           patSpans = combineSrcSpans' (getLocA <$> ne_pats)-          indentBody = not (isOneLineSpan combinedSpans)+          containsOrPat = everything (||) $ \b -> case cast @_ @(Pat GhcPs) b of+            Just OrPat {} -> True+            _ -> False+          indentBody =+            not (isOneLineSpan combinedSpans)+              && not (isCase style && containsOrPat ne_pats)       switchLayout [combinedSpans] $ do         let stdCase = sep breakpoint (located' p_pat) m_pats         case style of           Function name ->             p_infixDefHelper-              isInfix-              indentBody+              (Choice.fromBool isInfix)+              (Choice.fromBool indentBody)               (p_rdrName name)               (located' p_pat <$> m_pats)           PatternBind -> stdCase@@ -243,14 +246,10 @@           Function name -> Just (getLocA name)           _ -> Nothing         Just pats -> (Just . getLocA . NE.last) pats-      isCase = \case-        Case -> True-        LambdaCase -> True-        _ -> False       hasGuards = withGuards grhssGRHSs       grhssSpan =         combineSrcSpans' $-          getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs+          getGRHSSpan . unLoc <$> grhssGRHSs       patGrhssSpan =         maybe           grhssSpan@@ -276,11 +275,17 @@         sep           breakpoint           (located' (p_grhs' placement placer render groupStyle))-          grhssGRHSs+          (NE.toList grhssGRHSs)+      localBindsWhereSpan = case grhssLocalBinds of+        HsValBinds (EpAnn {anns = AnnList {al_rest}}) _ ->+          locA al_rest+        HsIPBinds (EpAnn {anns = AnnList {al_rest}}) _ ->+          locA al_rest+        EmptyLocalBinds _ -> noSrcSpan       p_where = do         unless (eqEmptyLocalBinds grhssLocalBinds) $ do           breakpoint-          txt "where"+          located (L localBindsWhereSpan ()) $ \_ -> txt "where"           breakpoint           inci $ p_hsLocalBinds grhssLocalBinds   inciIf indentBody $ do@@ -288,6 +293,7 @@       case style of         Function _ | hasGuards -> return ()         Function _ -> space >> inci equals+        PatternBind | hasGuards -> return ()         PatternBind -> space >> inci equals         s | isCase s && hasGuards -> return ()         _ -> space >> txt "->"@@ -345,7 +351,7 @@ p_hsCmd' isApp s = \case   HsCmdArrApp _ body input arrType rightToLeft -> do     let (l, r) = if rightToLeft then (body, input) else (input, body)-    located l p_hsExpr+    located l $ p_hsExpr' NotApplicand s     breakpoint     inci $ do       case (arrType, rightToLeft) of@@ -355,27 +361,27 @@         (HsHigherOrderApp, False) -> txt ">>-"       placeHanging (exprPlacement (unLoc input)) $         located r p_hsExpr-  HsCmdArrForm _ form Prefix _ cmds -> banana s $ do+  HsCmdArrForm _ form Prefix cmds -> banana s $ do     located form p_hsExpr     unless (null cmds) $ do       breakpoint       inci (sequence_ (intersperse breakpoint (located' (p_hsCmdTop N) <$> cmds)))-  HsCmdArrForm _ form Infix _ [left, right] -> do+  HsCmdArrForm _ form Infix [left, right] -> do     modFixityMap <- askModuleFixityMap     debug <- askDebug     let opTree = BinaryOpBranches (cmdOpTree left) form (cmdOpTree right)     p_cmdOpTree       s       (reassociateOpTree debug (getOpName . unLoc) modFixityMap opTree)-  HsCmdArrForm _ _ Infix _ _ -> notImplemented "HsCmdArrForm"+  HsCmdArrForm _ _ Infix _ -> notImplemented "HsCmdArrForm"   HsCmdApp _ cmd expr -> do     located cmd (p_hsCmd' Applicand s)     breakpoint     inci $ located expr p_hsExpr-  HsCmdLam _ variant mgroup -> p_lam isApp variant cmdPlacement p_hsCmd mgroup+  HsCmdLam _ variant mgroup -> p_lam isApp s variant cmdPlacement p_hsCmd mgroup   HsCmdPar _ c -> parens N (located c p_hsCmd)   HsCmdCase _ e mgroup ->-    p_case isApp cmdPlacement p_hsCmd e mgroup+    p_case isApp s cmdPlacement p_hsCmd e mgroup   HsCmdIf anns _ if' then' else' ->     p_if cmdPlacement p_hsCmd anns if' then' else'   HsCmdLet _ localBinds c ->@@ -401,14 +407,15 @@     UnhelpfulSpan _ -> f x     RealSrcSpan currentSpn _ -> do       getSpanMark >>= \case-        -- Spacing before comments will be handled by the code-        -- that prints comments, so we just have to deal with-        -- blank lines between statements here.-        Just (StatementSpan lastSpn) ->-          if srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1-            then newline-            else return ()-        _ -> return ()+        -- We deal with blank lines between statements here. The last mark+        -- may be a 'StatementSpan' (the usual case) or a comment span: the+        -- latter happens when the previous statement ended with a trailing+        -- comment, in which case we still want to preserve a blank line that+        -- followed that comment in the original input.+        Just lastMark ->+          let lastSpn = spanMarkSpan lastMark+           in when (srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1) newline+        Nothing -> return ()       f x       -- In some cases the (f x) expression may insert a new mark. We want       -- to be careful not to override comment marks.@@ -421,8 +428,9 @@ p_stmt = p_stmt' N exprPlacement (p_hsExpr' NotApplicand)  p_stmt' ::-  ( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,-    Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL+  ( Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,+    Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,+    Anno body ~ SrcSpanAnnA   ) =>   BracketStyle ->   -- | Placer@@ -430,7 +438,7 @@   -- | Render   (BracketStyle -> body -> R ()) ->   -- | Statement to render-  Stmt GhcPs (LocatedA body) ->+  Stmt GhcPs (XRec GhcPs body) ->   R () p_stmt' s placer render = \case   LastStmt _ body _ _ -> located body (render s)@@ -444,7 +452,6 @@           | otherwise = Normal     switchLayout [loc, l] $       placeHanging placement (located f (render N))-  ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer   BodyStmt _ body _ _ -> located body (render s)   LetStmt _ binds -> do     txt "let"@@ -490,8 +497,9 @@     sitcc . located recS_stmts $ sepSemi (withSpacing (p_stmt' s placer render))  p_stmts ::-  ( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,-    Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL+  ( Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,+    Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,+    Anno body ~ SrcSpanAnnA   ) =>   BracketStyle ->   IsApplicand ->@@ -500,7 +508,7 @@   -- | Render   (BracketStyle -> body -> R ()) ->   -- | Statements to render-  LocatedL [LocatedA (Stmt GhcPs (LocatedA body))] ->+  XRec GhcPs [LStmt GhcPs (XRec GhcPs body)] ->   R () p_stmts s isApp placer render es = do   breakpoint@@ -520,7 +528,7 @@  p_hsLocalBinds :: HsLocalBinds GhcPs -> R () p_hsLocalBinds = \case-  HsValBinds epAnn (ValBinds _ bag lsigs) -> pseudoLocated epAnn $ do+  HsValBinds epAnn (ValBinds _ binds lsigs) -> pseudoLocated epAnn $ do     -- When in a single-line layout, there is a chance that the inner     -- elements will also contain semicolons and they will confuse the     -- parser. so we request braces around every element except the last.@@ -528,7 +536,7 @@     let items =           let injectLeft (L l x) = L l (Left x)               injectRight (L l x) = L l (Right x)-           in (injectLeft <$> bagToList bag) ++ (injectRight <$> lsigs)+           in (injectLeft <$> binds) ++ (injectRight <$> lsigs)         positionToBracing = \case           SinglePos -> id           FirstPos -> br@@ -537,8 +545,8 @@         p_item' (p, item) =           positionToBracing p $             withSpacing (either p_valDecl p_sigDecl) item-        binds = sortBy (leftmost_smallest `on` getLocA) items-    sitcc $ sepSemi p_item' (attachRelativePos binds)+        items' = sortBy (leftmost_smallest `on` getLocA) items+    sitcc $ sepSemi p_item' (attachRelativePos items')   HsValBinds _ _ -> notImplemented "HsValBinds"   HsIPBinds epAnn (IPBinds _ xs) -> pseudoLocated epAnn $ do     let p_ipBind (IPBind _ (L _ name) expr) = do@@ -560,12 +568,12 @@             located (L al_anchor ()) . const       _ -> id -p_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()-p_ldotFieldOcc =-  located' $ p_rdrName . fmap (mkVarUnqual . field_label) . dfoLabel+p_dotFieldOcc :: DotFieldOcc GhcPs -> R ()+p_dotFieldOcc =+  p_rdrName . fmap (mkVarUnqual . field_label) . dfoLabel -p_ldotFieldOccs :: [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()-p_ldotFieldOccs = sep (txt ".") p_ldotFieldOcc+p_dotFieldOccs :: NonEmpty (DotFieldOcc GhcPs) -> R ()+p_dotFieldOccs = sep (txt ".") p_dotFieldOcc . NE.toList  p_fieldOcc :: FieldOcc GhcPs -> R () p_fieldOcc FieldOcc {..} = p_rdrName foLabel@@ -590,7 +598,7 @@ p_hsExpr = p_hsExpr' NotApplicand N  -- | An applicand is the left-hand side in a function application, i.e. @f@ in--- @f a@. We need to track this in order to add extra identation in cases like+-- @f a@. We need to track this in order to add extra indentation in cases like -- -- > foo = -- >   do@@ -603,12 +611,19 @@   Applicand -> inci . inci   NotApplicand -> inci +-- | Adjust bracing as needed for certain cases e.g. involving case+-- expressions and lambdas.+adjustBracing :: IsApplicand -> BracketStyle -> R () -> R ()+adjustBracing isApp s p = do+  layout <- getLayout+  case (s, layout, isApp) of+    (S, SingleLine, NotApplicand) -> useBraces p+    _ -> p+ p_hsExpr' :: IsApplicand -> BracketStyle -> HsExpr GhcPs -> R () p_hsExpr' isApp s = \case   HsVar _ name -> p_rdrName name-  HsUnboundVar _ occ -> atom occ-  HsRecSel _ fldOcc -> p_fieldOcc fldOcc-  HsOverLabel _ sourceText _ -> do+  HsOverLabel sourceText _ -> do     txt "#"     p_sourceText sourceText   HsIPVar _ (HsIPName name) -> do@@ -619,9 +634,10 @@     case lit of       HsString (SourceText stxt) _ -> p_stringLit stxt       HsStringPrim (SourceText stxt) _ -> p_stringLit stxt+      HsMultilineString (SourceText stxt) _ -> p_stringLit stxt       r -> atom r   HsLam _ variant mgroup ->-    p_lam isApp variant exprPlacement p_hsExpr mgroup+    p_lam isApp s variant exprPlacement p_hsExpr mgroup   HsApp _ f x -> do     let -- In order to format function applications with multiple parameters         -- nicer, traverse the AST to gather the function and all the@@ -672,11 +688,6 @@     breakpoint     inci $ do       txt "@"-      -- Insert a space when the type is represented as a TH splice to avoid-      -- gluing @ and $ together.-      case unLoc (hswc_body a) of-        HsSpliceTy {} -> space-        _ -> return ()       located (hswc_body a) p_hsType   OpApp _ x op y -> do     modFixityMap <- askModuleFixityMap@@ -735,13 +746,14 @@   ExplicitSum _ tag arity e ->     p_unboxedSum N tag arity (located e p_hsExpr)   HsCase _ e mgroup ->-    p_case isApp exprPlacement p_hsExpr e mgroup+    p_case isApp s exprPlacement p_hsExpr e mgroup   HsIf anns if' then' else' ->     p_if exprPlacement p_hsExpr anns if' then' else'   HsMultiIf _ guards -> do     txt "if"     breakpoint-    inciApplicand isApp $ sep newline (located' (p_grhs RightArrow)) guards+    inciApplicand isApp $+      sep breakpoint (located' (p_grhs RightArrow)) (NE.toList guards)   HsLet _ localBinds e ->     p_let p_hsExpr localBinds e   HsDo _ doFlavor es -> do@@ -772,25 +784,22 @@   RecordUpd {..} -> do     located rupd_expr p_hsExpr     breakpoint-    let p_updLbl =-          located' $-            p_rdrName . \case-              (Unambiguous NoExtField n :: AmbiguousFieldOcc GhcPs) -> n-              Ambiguous NoExtField n -> n-        p_recFields p_lbl =+    let p_recFields p_lbl =           sep commaDel (sitcc . located' (p_hsFieldBind p_lbl))+        p_fieldLabelStrings (FieldLabelStrings flss) =+          p_dotFieldOccs $ unLoc <$> flss     inci . braces N $ case rupd_flds of       RegularRecUpdFields {..} ->-        p_recFields p_updLbl recUpdFields+        p_recFields (located' p_fieldOcc) recUpdFields       OverloadedRecUpdFields {..} ->-        p_recFields (located' (coerce p_ldotFieldOccs)) olRecUpdFields+        p_recFields (located' p_fieldLabelStrings) olRecUpdFields   HsGetField {..} -> do     located gf_expr p_hsExpr     txt "."-    p_ldotFieldOcc gf_field+    located gf_field p_dotFieldOcc   HsProjection {..} -> parens N $ do     txt "."-    p_ldotFieldOccs (NE.toList proj_flds)+    p_dotFieldOccs proj_flds   ExprWithTySig _ x HsWC {hswc_body} -> sitcc $ do     located x p_hsExpr     space@@ -825,8 +834,8 @@     located expr p_hsExpr     breakpoint'     txt "||]"-  HsUntypedBracket anns x -> p_hsQuote anns x-  HsTypedSplice _ expr -> p_hsSpliceTH True expr DollarSplice+  HsUntypedBracket _ x -> p_hsQuote x+  HsTypedSplice _ (HsTypedSpliceExpr _ expr) -> p_hsSpliceTH True expr DollarSplice   HsUntypedSplice _ untySplice -> p_hsUntypedSplice DollarSplice untySplice   HsProc _ p e -> do     txt "proc"@@ -853,11 +862,37 @@     txt "type"     space     located hswc_body p_hsType+  HsHole holeKind -> case holeKind of+    HoleVar name -> p_rdrName name+    HoleError -> error "parse error"+  -- similar to HsForAllTy+  HsForAll _ tele e -> do+    p_hsForAllTelescope tele+    breakpoint+    located e p_hsExpr+  -- similar to HsQualTy+  HsQual _ qs e -> do+    located qs $ p_hsContext' p_hsExpr+    space+    txt "=>"+    breakpoint+    located e p_hsExpr+  -- similar to HsFunTy+  HsFunArr _ multAnn x y -> do+    located x p_hsExpr+    space+    p_hsMultAnn (located' p_hsExpr) multAnn+    space+    txt "->"+    breakpoint+    case unLoc y of+      HsFunArr {} -> p_hsExpr (unLoc y)+      _ -> located y p_hsExpr  -- | Print a list comprehension. -- -- BracketStyle should be N except in a do-block, which must be S or else it's a parse error.-p_listComp :: BracketStyle -> GenLocated SrcSpanAnnL [ExprLStmt GhcPs] -> R ()+p_listComp :: BracketStyle -> XRec GhcPs [ExprLStmt GhcPs] -> R () p_listComp s es = sitcc (vlayout singleLine multiLine)   where     singleLine = do@@ -874,10 +909,9 @@     body = located es p_body     p_body xs = do       let (stmts, yield) =-            -- TODO: use unsnoc when require GHC 9.8+-            case xs of-              [] -> error $ "list comprehension unexpectedly had no expressions"-              _ -> (init xs, last xs)+            case unsnoc xs of+              Nothing -> error $ "list comprehension unexpectedly had no expressions"+              Just (ys, y) -> (ys, y)       sitcc $ located yield p_stmt       breakpoint       txt "|"@@ -952,7 +986,7 @@   -- will be ParStmt.   [L _ (ParStmt _ blocks _ _)] ->     [ concatMap collectNonParStmts stmts-    | ParStmtBlock _ stmts _ _ <- blocks+    | ParStmtBlock _ stmts _ _ <- NE.toList blocks     ]   -- Otherwise, list will not contain any ParStmt   stmts ->@@ -993,7 +1027,7 @@             inci (p_matchGroup (Function psb_id) mgroup)   txt "pattern"   case psb_args of-    PrefixCon [] xs -> do+    PrefixCon xs -> do       space       p_rdrName psb_id       inci $ do@@ -1002,7 +1036,6 @@           unless (null xs) breakpoint           sitcc (sep breakpoint p_rdrName xs)         rhs conSpans-    PrefixCon (v : _) _ -> absurd v     RecCon xs -> do       space       p_rdrName psb_id@@ -1030,6 +1063,7 @@     Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA   ) =>   IsApplicand ->+  BracketStyle ->   -- | Placer   (body -> Placement) ->   -- | Render@@ -1039,20 +1073,23 @@   -- | Match group   MatchGroup GhcPs (LocatedA body) ->   R ()-p_case isApp placer render e mgroup = do+p_case isApp s placer render e mgroup = do   txt "case"   space   located e p_hsExpr   space   txt "of"   breakpoint-  inciApplicand isApp (p_matchGroup' placer render Case mgroup)+  adjustBracing isApp s $+    inciApplicand isApp (p_matchGroup' placer render Case mgroup)  p_lam ::   ( Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,     Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA   ) =>   IsApplicand ->+  -- | BracketStyle (S when inside a do block)+  BracketStyle ->   -- | Variant (@\\@ or @\\case@ or @\\cases@)   HsLamVariant ->   -- | Placer@@ -1062,7 +1099,7 @@   -- | Expression   MatchGroup GhcPs (LocatedA body) ->   R ()-p_lam isApp variant placer render mgroup = do+p_lam isApp s variant placer render mgroup = do   let mCaseTxt = case variant of         LamSingle -> Nothing         LamCase -> Just "\\case"@@ -1074,7 +1111,7 @@     Just caseTxt -> do       txt caseTxt       breakpoint-      inciApplicand isApp pMatchGroup+      adjustBracing isApp s (inciApplicand isApp pMatchGroup)  p_if ::   -- | Placer@@ -1139,40 +1176,43 @@   sitcc (located e render)  p_pat :: Pat GhcPs -> R ()-p_pat = \case+p_pat = p_pat' False++p_pat' :: Bool -> Pat GhcPs -> R ()+p_pat' inAsPat = \case   WildPat _ -> txt "_"   VarPat _ name -> p_rdrName name   LazyPat _ pat -> do     txt "~"-    located pat p_pat+    located pat (p_pat' inAsPat)   AsPat _ name pat -> do     p_rdrName name     txt "@"-    located pat p_pat+    located pat (p_pat' True)   ParPat _ pat ->-    located pat (parens S . p_pat)+    located pat (parens S . p_pat' inAsPat)   BangPat _ pat -> do     txt "!"-    located pat p_pat+    located pat (p_pat' inAsPat)   ListPat _ pats ->-    brackets S $ sep commaDel (located' p_pat) pats+    brackets S $ sep commaDel (located' (p_pat' inAsPat)) pats   TuplePat _ pats boxing -> do     let parens' =           case boxing of             Boxed -> parens S             Unboxed -> parensHash S-    parens' $ sep commaDel (sitcc . located' p_pat) pats+    parens' $ sep commaDel (sitcc . located' (p_pat' inAsPat)) pats+  OrPat _ pats -> do+    sepSemi' inAsPat (located' (p_pat' inAsPat)) (NE.toList pats)   SumPat _ pat tag arity ->-    p_unboxedSum S tag arity (located pat p_pat)+    p_unboxedSum S tag arity (located pat (p_pat' inAsPat))   ConPat _ pat details ->     case details of-      PrefixCon tys xs -> sitcc $ do+      PrefixCon xs -> sitcc $ do         p_rdrName pat-        unless (null tys && null xs) breakpoint-        inci . sitcc $-          sep breakpoint (sitcc . either p_hsConPatTyArg (located' p_pat)) $-            (Left <$> tys) <> (Right <$> xs)-      RecCon (HsRecFields fields dotdot) -> do+        unless (null xs) breakpoint+        inci . sitcc $ sep breakpoint (sitcc . located' (p_pat' inAsPat)) xs+      RecCon (HsRecFields _ fields dotdot) -> do         p_rdrName pat         breakpoint         let f = \case@@ -1184,18 +1224,18 @@             Just (L _ (RecFieldsDotDot n)) -> (Just <$> take n fields) ++ [Nothing]       InfixCon l r -> do         switchLayout [getLocA l, getLocA r] $ do-          located l p_pat+          located l (p_pat' inAsPat)           breakpoint           inci $ do             p_rdrName pat             space-            located r p_pat+            located r (p_pat' inAsPat)   ViewPat _ expr pat -> sitcc $ do     located expr p_hsExpr     space     txt "->"     breakpoint-    inci (located pat p_pat)+    inci (located pat (p_pat' inAsPat))   SplicePat _ splice -> p_hsUntypedSplice DollarSplice splice   LitPat _ p -> atom p   NPat _ v (isJust -> isNegated) _ -> do@@ -1212,7 +1252,7 @@       space       located k (atom . ol_val)   SigPat _ pat HsPS {..} -> do-    located pat p_pat+    located pat (p_pat' inAsPat)     p_typeAscription (lhsTypeToSigType hsps_body)   EmbTyPat _ (HsTP _ ty) -> do     txt "type"@@ -1223,9 +1263,6 @@ p_tyPat :: HsTyPat GhcPs -> R () p_tyPat (HsTP _ ty) = txt "@" *> located ty p_hsType -p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()-p_hsConPatTyArg (HsConPatTyArg _ patSigTy) = p_tyPat patSigTy- p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R () p_pat_hsFieldBind HsFieldBind {..} = do   located hfbLHS p_fieldOcc@@ -1255,7 +1292,7 @@   HsUntypedSpliceExpr _ expr -> p_hsSpliceTH False expr deco   HsQuasiQuote _ quoterName str -> do     txt "["-    p_rdrName (noLocA quoterName)+    p_rdrName quoterName     txt "|"     -- QuasiQuoters often rely on precise custom strings. We cannot do any     -- formatting here without potentially breaking someone's code.@@ -1279,12 +1316,12 @@   where     decoSymbol = if isTyped then "$$" else "$" -p_hsQuote :: [AddEpAnn] -> HsQuote GhcPs -> R ()-p_hsQuote anns = \case-  ExpBr _ expr -> do-    let name-          | any (isJust . matchAddEpAnn AnnOpenEQ) anns = ""-          | otherwise = "e"+p_hsQuote :: HsQuote GhcPs -> R ()+p_hsQuote = \case+  ExpBr (bracketAnn, _) expr -> do+    let name = case bracketAnn of+          BracketNoE {} -> ""+          BracketHasE {} -> "e"     quote name (located expr p_hsExpr)   PatBr _ pat -> located pat (quote "p" . p_pat)   DecBrL _ decls -> quote "d" (handleStarIsType decls (p_hsDecls Free decls))@@ -1318,47 +1355,6 @@           Just HsStarTy {} -> True           _ -> False --- | Print the source text of a string literal while indenting gaps correctly.-p_stringLit :: FastString -> R ()-p_stringLit src =-  let s = splitGaps (unpackFS src)-      singleLine =-        txt $ Text.pack (mconcat s)-      multiLine =-        sitcc $ sep breakpoint (txt . Text.pack) (backslashes s)-   in vlayout singleLine multiLine-  where-    -- Split a string on gaps (backslash delimited whitespaces)-    ---    -- > splitGaps "bar\\  \\fo\\&o" == ["bar", "fo\\&o"]-    splitGaps :: String -> [String]-    splitGaps "" = []-    splitGaps s =-      let -- A backslash and a whitespace starts a "gap"-          p (Just '\\', _, _) = True-          p (_, '\\', Just c) | ghcSpace c = False-          p _ = True-       in case span p (zipPrevNext s) of-            (l, r) ->-              let -- drop the initial '\', any amount of 'ghcSpace', and another '\'-                  r' = drop 1 . dropWhile ghcSpace . drop 1 $ map orig r-               in map orig l : splitGaps r'-    -- GHC's definition of whitespaces in strings-    -- See: https://gitlab.haskell.org/ghc/ghc/blob/86753475/compiler/parser/Lexer.x#L1653-    ghcSpace :: Char -> Bool-    ghcSpace c = c <= '\x7f' && is_space c-    -- Add backslashes to the inner side of the strings-    ---    -- > backslashes ["a", "b", "c"] == ["a\\", "\\b\\", "\\c"]-    backslashes :: [String] -> [String]-    backslashes (x : y : xs) = (x ++ "\\") : backslashes (('\\' : y) : xs)-    backslashes xs = xs-    -- Attaches previous and next items to each list element-    zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]-    zipPrevNext xs =-      zip3 (Nothing : map Just xs) xs (map Just (drop 1 xs) ++ [Nothing])-    orig (_, x, _) = x- ---------------------------------------------------------------------------- -- Helpers @@ -1376,9 +1372,9 @@ -- | Determine placement of a given block. blockPlacement ::   (body -> Placement) ->-  [LGRHS GhcPs (LocatedA body)] ->+  NonEmpty (LGRHS GhcPs (LocatedA body)) ->   Placement-blockPlacement placer [L _ (GRHS _ _ (L _ x))] = placer x+blockPlacement placer (L _ (GRHS _ _ (L _ x)) :| []) = placer x blockPlacement _ _ = Normal  -- | Determine placement of a given command.@@ -1399,7 +1395,7 @@   -- Only hang lambdas with single line parameter lists   HsLam _ variant mg -> case variant of     LamSingle -> case mg of-      MG _ (L _ [L _ (Match _ _ (x : xs) _)])+      MG _ (L _ [L _ (Match _ _ (L _ (x : xs)) _)])         | isOneLineSpan (combineSrcSpans' $ fmap getLocA (x :| xs)) ->             Hanging       _ -> Normal@@ -1422,7 +1418,7 @@   _ -> Normal  -- | Return 'True' if any of the RHS expressions has guards.-withGuards :: [LGRHS GhcPs body] -> Bool+withGuards :: NonEmpty (LGRHS GhcPs body) -> Bool withGuards = any (checkOne . unLoc)   where     checkOne (GRHS _ [] _) = False

@@ -3,7 +3,6 @@     p_pat,     p_hsExpr,     p_hsUntypedSplice,-    p_stringLit,     p_hsExpr',     p_hsCmdTop,     exprPlacement,@@ -11,7 +10,6 @@   ) where -import GHC.Data.FastString import GHC.Hs import Ormolu.Printer.Combinators @@ -19,7 +17,6 @@ p_pat :: Pat GhcPs -> R () p_hsExpr :: HsExpr GhcPs -> R () p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()-p_stringLit :: FastString -> R ()  data IsApplicand 

@@ -8,6 +8,7 @@ module Ormolu.Printer.Meat.ImportExport   ( p_hsmodExports,     p_hsmodImport,+    enterMultilineLayoutIfContainsDocEntries,   ) where @@ -25,12 +26,13 @@  p_hsmodExports :: [LIE GhcPs] -> R () p_hsmodExports xs =-  parens N $ do-    layout <- getLayout-    sep-      breakpoint-      (\(p, l) -> sitcc (located (addDocSrcSpan l) (p_lie layout p)))-      (attachRelativePos xs)+  enterMultilineLayoutIfContainsDocEntries xs $+    parens N $ do+      layout <- getLayout+      sep+        breakpoint+        (\(p, l) -> sitcc (located (addDocSrcSpan l) (p_lie layout p)))+        (attachRelativePos xs)   where     -- In order to correctly set the layout when a doc comment is present.     addDocSrcSpan lie@(L l ie) = case ieExportDoc ie of@@ -46,6 +48,10 @@   space   when ideclSafe (txt "safe")   space+  case ideclLevelSpec of+    LevelStylePre l -> p_declLevel l+    _ -> return ()+  space   when     (isImportDeclQualified ideclQualified && not useQualifiedPost)     (txt "qualified")@@ -56,6 +62,10 @@   space   inci $ do     located ideclName atom+    space+    case ideclLevelSpec of+      LevelStylePost l -> p_declLevel l+      _ -> return ()     when       (isImportDeclQualified ideclQualified && useQualifiedPost)       (space >> txt "qualified")@@ -82,6 +92,11 @@             (attachRelativePos xs)     newline +p_declLevel :: ImportDeclLevel -> R ()+p_declLevel = \case+  ImportDeclSplice -> txt "splice"+  ImportDeclQuote -> txt "quote"+ p_lie :: Layout -> RelativePos -> IE GhcPs -> R () p_lie encLayout relativePos = \case   IEVar mwarn l1 exportDoc -> do@@ -159,3 +174,16 @@   IEGroup {} -> Nothing   IEDoc {} -> Nothing   IEDocNamed {} -> Nothing++enterMultilineLayoutIfContainsDocEntries :: [LIE GhcPs] -> R () -> R ()+enterMultilineLayoutIfContainsDocEntries xs =+  if any (isDocEntry . unLoc) xs+    then enterLayout MultiLine+    else id++isDocEntry :: (IE pass) -> Bool+isDocEntry = \case+  IEDoc {} -> True+  IEGroup {} -> True+  IEDocNamed {} -> True+  _ -> False

@@ -37,35 +37,36 @@   let XModulePs {..} = hsmodExt       deprecSpan = maybe [] (pure . getLocA) hsmodDeprecMessage       exportSpans = maybe [] (pure . getLocA) hsmodExports-  switchLayout (deprecSpan <> exportSpans) $ do-    forM_ mstackHeader $ \(L spn comment) -> do-      spitCommentNow spn comment+  switchLayout (deprecSpan <> exportSpans) $+    enterMultilineLayoutIfContainsDocEntries (maybe [] unLoc hsmodExports) $ do+      forM_ mstackHeader $ \(L spn comment) -> do+        spitCommentNow spn comment+        newline       newline-    newline-    p_pragmas pragmas-    newline-    case hsmodName of-      Nothing -> return ()-      Just hsmodName' -> do-        located hsmodName' $ \name -> do-          forM_ hsmodHaddockModHeader (p_hsDoc Pipe (With #endNewline))-          p_hsmodName name-        breakpoint-        forM_ hsmodDeprecMessage $ \w -> do-          located' p_warningTxt w+      p_pragmas pragmas+      newline+      case hsmodName of+        Nothing -> return ()+        Just hsmodName' -> do+          located hsmodName' $ \name -> do+            forM_ hsmodHaddockModHeader (p_hsDoc Pipe (With #endNewline))+            p_hsmodName name           breakpoint-        case hsmodExports of-          Nothing -> return ()-          Just l -> do-            encloseLocated l $ \exports -> do-              inci (p_hsmodExports exports)+          forM_ hsmodDeprecMessage $ \w -> do+            located' p_warningTxt w             breakpoint-        txt "where"-        newline-    newline-    forM_ hsmodImports (located' p_hsmodImport)-    newline-    switchLayout (getLocA <$> hsmodDecls) $ do-      p_hsDecls Free hsmodDecls+          case hsmodExports of+            Nothing -> return ()+            Just l -> do+              encloseLocated l $ \exports -> do+                inci (p_hsmodExports exports)+              breakpoint+          txt "where"+          newline       newline-      spitRemainingComments+      forM_ hsmodImports (located' p_hsmodImport)+      newline+      switchLayout (getLocA <$> hsmodDecls) $ do+        p_hsDecls Free hsmodDecls+        newline+        spitRemainingComments

@@ -10,13 +10,17 @@   ( p_hsType,     hasDocStrings,     p_hsContext,+    p_hsContext',     p_hsTyVarBndr,     ForAllVisibility (..),     p_forallBndrs,-    p_conDeclFields,+    p_hsConDeclRecFields,+    p_hsConDeclField,+    p_hsConDeclFieldWithDoc,     p_lhsTypeArg,     p_hsSigType,-    hsOuterTyVarBndrsToHsType,+    p_hsForAllTelescope,+    p_hsOuterTyVarBndrs,     lhsTypeToSigType,   ) where@@ -30,7 +34,8 @@ import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree (p_tyOpTree, tyOpTree)-import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsUntypedSplice, p_stringLit)+import Ormolu.Printer.Meat.Declaration.StringLiteral+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsUntypedSplice) import Ormolu.Printer.Operators import Ormolu.Utils @@ -40,9 +45,7 @@ p_hsType' :: Bool -> HsType GhcPs -> R () p_hsType' multilineArgs = \case   HsForAllTy _ tele t -> do-    case tele of-      HsForAllInvis _ bndrs -> p_forallBndrs ForAllInvis p_hsTyVarBndr bndrs-      HsForAllVis _ bndrs -> p_forallBndrs ForAllVis p_hsTyVarBndr bndrs+    p_hsForAllTelescope tele     interArgBreak     located t p_hsType   HsQualTy _ qs t -> do@@ -86,20 +89,15 @@     inci $ do       txt "@"       located kd p_hsType-  HsFunTy _ arrow x y@(L _ y') -> do+  HsFunTy _ multAnn x y -> do     located x p_hsType     space-    case arrow of-      HsUnrestrictedArrow _ -> txt "->"-      HsLinearArrow _ -> txt "%1 ->"-      HsExplicitMult _ mult -> do-        txt "%"-        p_hsTypeR (unLoc mult)-        space-        txt "->"+    p_hsMultAnn (located' p_hsTypeR) multAnn+    space+    txt "->"     interArgBreak-    case y' of-      HsFunTy {} -> p_hsTypeR y'+    case unLoc y of+      HsFunTy {} -> p_hsTypeR (unLoc y)       _ -> located y p_hsTypeR   HsListTy _ t ->     located t (brackets N . p_hsType)@@ -140,18 +138,6 @@   HsDocTy _ t str -> do     p_hsDoc Pipe (With #endNewline) str     located t p_hsType-  HsBangTy _ (HsSrcBang _ u s) t -> do-    case u of-      SrcUnpack -> txt "{-# UNPACK #-}" >> space-      SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space-      NoSrcUnpack -> return ()-    case s of-      SrcLazy -> txt "~"-      SrcStrict -> txt "!"-      NoSrcStrict -> return ()-    located t p_hsType-  HsRecTy _ fields ->-    p_conDeclFields fields   HsExplicitListTy _ p xs -> do     case p of       IsPromoted -> txt "'"@@ -163,11 +149,15 @@         (IsPromoted, L _ t : _) | startsWithSingleQuote t -> space         _ -> return ()       sep commaDel (sitcc . located' p_hsType) xs-  HsExplicitTupleTy _ xs -> do-    txt "'"+  HsExplicitTupleTy _ p xs -> do+    case p of+      IsPromoted -> txt "'"+      NotPromoted -> return ()     parens N $ do-      case xs of-        L _ t : _ | startsWithSingleQuote t -> space+      -- If this tuple is promoted and the first element starts with a single+      -- quote, we need to put a space in between or it fails to parse.+      case (p, xs) of+        (IsPromoted, L _ t : _) | startsWithSingleQuote t -> space         _ -> return ()       sep commaDel (located' p_hsType) xs   HsTyLit _ t ->@@ -175,7 +165,20 @@       HsStrTy (SourceText s) _ -> p_stringLit s       a -> atom a   HsWildCardTy _ -> txt "_"-  XHsType t -> atom t+  XHsType ext -> case ext of+    HsCoreTy t -> atom @HsCoreTy t+    HsBangTy _ (HsSrcBang _ u s) t -> do+      case u of+        SrcUnpack -> txt "{-# UNPACK #-}" >> space+        SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space+        NoSrcUnpack -> return ()+      case s of+        SrcLazy -> txt "~"+        SrcStrict -> txt "!"+        NoSrcStrict -> return ()+      located t p_hsType+    HsRecTy _ fields ->+      p_hsConDeclRecFields fields   where     startsWithSingleQuote = \case       HsAppTy _ (L _ f) _ -> startsWithSingleQuote f@@ -201,10 +204,13 @@   _ -> False  p_hsContext :: HsContext GhcPs -> R ()-p_hsContext = \case+p_hsContext = p_hsContext' p_hsType++p_hsContext' :: (HasLoc (Anno a)) => (a -> R ()) -> [XRec GhcPs a] -> R ()+p_hsContext' f = \case   [] -> txt "()"-  [x] -> located x p_hsType-  xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs+  [x] -> located x f+  xs -> parens N $ sep commaDel (sitcc . located' f) xs  class IsTyVarBndrFlag flag where   isInferred :: flag -> Bool@@ -226,18 +232,24 @@     HsBndrInvisible _ -> txt "@"  p_hsTyVarBndr :: (IsTyVarBndrFlag flag) => HsTyVarBndr flag GhcPs -> R ()-p_hsTyVarBndr = \case-  UserTyVar _ flag x -> do-    p_tyVarBndrFlag flag-    (if isInferred flag then braces N else id) $ p_rdrName x-  KindedTyVar _ flag l k -> do-    p_tyVarBndrFlag flag-    (if isInferred flag then braces else parens) N $ do-      located l atom-      space-      txt "::"-      breakpoint-      inci (located k p_hsType)+p_hsTyVarBndr HsTvb {..} = do+  p_tyVarBndrFlag tvb_flag+  let wrap+        | isInferred tvb_flag = braces N+        | otherwise = case tvb_kind of+            HsBndrKind {} -> parens N+            HsBndrNoKind {} -> id+  wrap $ do+    case tvb_var of+      HsBndrVar _ x -> p_rdrName x+      HsBndrWildCard _ -> txt "_"+    case tvb_kind of+      HsBndrKind _ k -> do+        space+        txt "::"+        breakpoint+        inci (located k p_hsType)+      HsBndrNoKind _ -> pure ()  data ForAllVisibility = ForAllInvis | ForAllVis @@ -260,23 +272,45 @@         ForAllInvis -> txt "."         ForAllVis -> space >> txt "->" -p_conDeclFields :: [LConDeclField GhcPs] -> R ()-p_conDeclFields xs =-  braces N $ sep commaDel (sitcc . located' p_conDeclField) xs+p_hsConDeclRecFields :: [LHsConDeclRecField GhcPs] -> R ()+p_hsConDeclRecFields xs =+  braces N $ sep commaDel (sitcc . located' p_hsConDeclRecField) xs -p_conDeclField :: ConDeclField GhcPs -> R ()-p_conDeclField ConDeclField {..} = do-  mapM_ (p_hsDoc Pipe (With #endNewline)) cd_fld_doc+p_hsConDeclRecField :: HsConDeclRecField GhcPs -> R ()+p_hsConDeclRecField HsConDeclRecField {..} = do+  mapM_ (p_hsDoc Pipe (With #endNewline)) (cdf_doc cdrf_spec)   sitcc $     sep       commaDel       (located' (p_rdrName . foLabel))-      cd_fld_names+      cdrf_names   space+  p_hsMultAnn (located' p_hsType) (cdf_multiplicity cdrf_spec)+  space   txt "::"   breakpoint-  sitcc . inci $ p_hsType (unLoc cd_fld_type)+  sitcc . inci $ p_hsConDeclField cdrf_spec +-- | This does not print 'cdf_doc' and 'cdf_multiplicity' as there is no single+-- strategy for where to print them (see call sites).+p_hsConDeclField :: HsConDeclField GhcPs -> R ()+p_hsConDeclField CDF {..} = do+  case cdf_unpack of+    SrcUnpack -> txt "{-# UNPACK #-}" *> space+    SrcNoUnpack -> txt "{-# NOUNPACK #-}" *> space+    NoSrcUnpack -> pure ()+  located cdf_type $ \ty -> do+    case cdf_bang of+      SrcLazy -> txt "~"+      SrcStrict -> txt "!"+      NoSrcStrict -> pure ()+    p_hsType ty++p_hsConDeclFieldWithDoc :: HsConDeclField GhcPs -> R ()+p_hsConDeclFieldWithDoc cdf = do+  mapM_ (p_hsDoc Pipe (With #endNewline)) (cdf_doc cdf)+  p_hsConDeclField cdf+ p_lhsTypeArg :: LHsTypeArg GhcPs -> R () p_lhsTypeArg = \case   HsValArg NoExtField ty -> located ty p_hsType@@ -287,21 +321,27 @@   HsArgPar _ -> notImplemented "HsArgPar"  p_hsSigType :: HsSigType GhcPs -> R ()-p_hsSigType HsSig {..} =-  p_hsType $ hsOuterTyVarBndrsToHsType sig_bndrs sig_body+p_hsSigType HsSig {..} = do+  p_hsOuterTyVarBndrs sig_bndrs+  case sig_bndrs of+    HsOuterImplicit {} -> pure ()+    HsOuterExplicit {} -> breakpoint+  located sig_body p_hsType -------------------------------------------------------------------------------- Conversion functions+p_hsForAllTelescope :: HsForAllTelescope GhcPs -> R ()+p_hsForAllTelescope = \case+  HsForAllInvis _ bndrs -> p_forallBndrs ForAllInvis p_hsTyVarBndr bndrs+  HsForAllVis _ bndrs -> p_forallBndrs ForAllVis p_hsTyVarBndr bndrs --- could be generalized to also handle () instead of Specificity-hsOuterTyVarBndrsToHsType ::+p_hsOuterTyVarBndrs ::   HsOuterTyVarBndrs Specificity GhcPs ->-  LHsType GhcPs ->-  HsType GhcPs-hsOuterTyVarBndrsToHsType obndrs ty = case obndrs of-  HsOuterImplicit NoExtField -> unLoc ty-  HsOuterExplicit _ bndrs ->-    HsForAllTy NoExtField (mkHsForAllInvisTele noAnn bndrs) ty+  R ()+p_hsOuterTyVarBndrs = \case+  HsOuterImplicit _ -> pure ()+  HsOuterExplicit _ bndrs -> p_hsForAllTelescope $ mkHsForAllInvisTele noAnn bndrs++----------------------------------------------------------------------------+-- Conversion functions  lhsTypeToSigType :: LHsType GhcPs -> LHsSigType GhcPs lhsTypeToSigType ty =

@@ -203,9 +203,9 @@       indices -> splitTree noptExprs noptOps indices   where     indicesOfHardSplitter =-      fmap fst $-        filter (isHardSplitterOp . opiFixityApproximation . snd) $-          zip [0 ..] noptOps+      fmap fst+        $ filter (isHardSplitterOp . opiFixityApproximation . snd)+        $ zip [0 ..] noptOps     indexOfMinMaxPrecOps [] = (Nothing, Nothing)     indexOfMinMaxPrecOps (oo : oos) = go oos 1 oo (Just [0]) oo (Just [0])       where

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -12,6 +13,8 @@ import Data.Array as A import Data.Bifunctor (bimap) import Data.Char (isSpace)+import Data.Choice (Choice)+import Data.Choice qualified as Choice import Data.Function ((&)) import Data.IntMap (IntMap) import Data.IntMap.Strict qualified as IntMap@@ -29,13 +32,14 @@ -- and subregions to be formatted. preprocess ::   -- | Whether CPP is enabled-  Bool ->+  Choice "cppEnabled" ->   RegionDeltas ->   Text ->   [Either Text RegionDeltas] preprocess cppEnabled region rawInput = rawSnippetsAndRegionsToFormat   where-    (linesNotToFormat', replacementLines) = linesNotToFormat cppEnabled region rawInput+    (linesNotToFormat', replacementLines) =+      linesNotToFormat cppEnabled region rawInput     regionsToFormat =       intSetToRegions rawLineLength $         IntSet.fromAscList [1 .. rawLineLength] IntSet.\\ linesNotToFormat'@@ -85,13 +89,13 @@     interleave [] bs = bs     interleave (a : as) bs = a : interleave bs as -    xs !!? i = if A.bounds rawLines `A.inRange` i then Just $ xs A.! i else Nothing+    xs !!? i = if A.bounds xs `A.inRange` i then Just $ xs A.! i else Nothing  -- | All lines we are not supposed to format, and a set of replacements -- for specific lines. linesNotToFormat ::   -- | Whether CPP is enabled-  Bool ->+  Choice "cppEnabled" ->   RegionDeltas ->   Text ->   (IntSet, IntMap Text)@@ -100,13 +104,16 @@   where     unconsidered =       IntSet.fromAscList $-        [1 .. regionPrefixLength] <> [totalLines - regionSuffixLength + 1 .. totalLines]+        [1 .. regionPrefixLength]+          <> [totalLines - regionSuffixLength + 1 .. totalLines]     totalLines = length (T.lines input)     regionLines = linesInRegion region input     (magicDisabled, lineUpdates) = magicDisabledLines regionLines     otherDisabled = mconcat allLines regionLines       where-        allLines = [shebangLines, linePragmaLines] <> [cppLines | cppEnabled]+        allLines =+          [shebangLines, linePragmaLines]+            <> [cppLines | Choice.isTrue cppEnabled]  -- | Ormolu state. data OrmoluState

@@ -13,7 +13,6 @@     separatedByBlank,     separatedByBlankNE,     onTheSameLine,-    matchAddEpAnn,     textToStringBuffer,     ghcModuleNameToCabal,   )@@ -138,13 +137,6 @@ onTheSameLine :: SrcSpan -> SrcSpan -> Bool onTheSameLine a b =   isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))---- | Check whether the given 'AnnKeywordId' or its Unicode variant is in an--- 'AddEpAnn', and return the 'EpaLocation' if so.-matchAddEpAnn :: AnnKeywordId -> AddEpAnn -> Maybe EpaLocation-matchAddEpAnn annId (AddEpAnn annId' loc)-  | annId == annId' || unicodeAnn annId == annId' = Just loc-  | otherwise = Nothing  -- | Convert 'Text' to a 'StringBuffer' by making a copy. textToStringBuffer :: Text -> StringBuffer

@@ -14,7 +14,6 @@ import Control.Exception import Control.Monad.IO.Class import Data.ByteString qualified as B-import Data.IORef import Data.Map.Lazy (Map) import Data.Map.Lazy qualified as M import Data.Maybe (maybeToList)@@ -29,7 +28,7 @@ import Ormolu.Config import Ormolu.Exception import Ormolu.Fixity-import Ormolu.Utils.IO (findClosestFileSatisfying, withIORefCache)+import Ormolu.Utils.IO (Cache, findClosestFileSatisfying, newCache, withCache) import System.Directory import System.FilePath import System.IO.Unsafe (unsafePerformIO)@@ -101,8 +100,8 @@   deriving (Show)  -- | Cache ref that stores 'CachedCabalFile' per Cabal file.-cacheRef :: IORef (Map FilePath CachedCabalFile)-cacheRef = unsafePerformIO $ newIORef M.empty+cacheRef :: Cache FilePath CachedCabalFile+cacheRef = unsafePerformIO newCache {-# NOINLINE cacheRef #-}  -- | Parse 'CabalInfo' from a @.cabal@ file at the given 'FilePath'.@@ -118,7 +117,7 @@ parseCabalInfo cabalFileAsGiven sourceFileAsGiven = liftIO $ do   cabalFile <- makeAbsolute cabalFileAsGiven   sourceFileAbs <- makeAbsolute sourceFileAsGiven-  CachedCabalFile {..} <- withIORefCache cacheRef cabalFile $ do+  CachedCabalFile {..} <- withCache cacheRef cabalFile $ do     cabalFileBs <- B.readFile cabalFile     genericPackageDescription <-       whenLeft (snd . runParseResult $ parseGenericPackageDescription cabalFileBs) $@@ -190,17 +189,17 @@     extractFromLibrary Library {..} =       extractFromBuildInfo (ModuleName.toFilePath <$> exposedModules) libBuildInfo     extractFromExecutable Executable {..} =-      extractFromBuildInfo [modulePath] buildInfo+      extractFromBuildInfo [getSymbolicPath modulePath] buildInfo     extractFromTestSuite TestSuite {..} =       extractFromBuildInfo mainPath testBuildInfo       where         mainPath = case testInterface of-          TestSuiteExeV10 _ p -> [p]+          TestSuiteExeV10 _ p -> [getSymbolicPath p]           TestSuiteLibV09 _ p -> [ModuleName.toFilePath p]           TestSuiteUnsupported {} -> []     extractFromBenchmark Benchmark {..} =       extractFromBuildInfo mainPath benchmarkBuildInfo       where         mainPath = case benchmarkInterface of-          BenchmarkExeV10 _ p -> [p]+          BenchmarkExeV10 _ p -> [getSymbolicPath p]           BenchmarkUnsupported {} -> []

@@ -10,10 +10,7 @@ import Control.Exception (throwIO) import Control.Monad.IO.Class import Data.Bifunctor (first)-import Data.IORef import Data.List.NonEmpty (NonEmpty)-import Data.Map.Strict (Map)-import Data.Map.Strict qualified as Map import Data.Text qualified as T import Data.Text.IO.Utf8 qualified as T.Utf8 import Distribution.ModuleName (ModuleName)@@ -21,7 +18,7 @@ import Ormolu.Exception import Ormolu.Fixity import Ormolu.Fixity.Parser-import Ormolu.Utils.IO (findClosestFileSatisfying, withIORefCache)+import Ormolu.Utils.IO (Cache, findClosestFileSatisfying, newCache, withCache) import System.Directory import System.IO.Unsafe (unsafePerformIO) import Text.Megaparsec (errorBundlePretty)@@ -37,7 +34,7 @@   m (FixityOverrides, ModuleReexports) getDotOrmoluForSourceFile sourceFile =   liftIO (findDotOrmoluFile sourceFile) >>= \case-    Just dotOrmoluFile -> liftIO $ withIORefCache cacheRef dotOrmoluFile $ do+    Just dotOrmoluFile -> liftIO $ withCache cacheRef dotOrmoluFile $ do       dotOrmoluRelative <- makeRelativeToCurrentDirectory dotOrmoluFile       contents <- T.Utf8.readFile dotOrmoluFile       case parseDotOrmolu dotOrmoluRelative contents of@@ -58,8 +55,8 @@   x == ".ormolu"  -- | Cache ref that maps names of @.ormolu@ files to their contents.-cacheRef :: IORef (Map FilePath (FixityOverrides, ModuleReexports))-cacheRef = unsafePerformIO (newIORef Map.empty)+cacheRef :: Cache FilePath (FixityOverrides, ModuleReexports)+cacheRef = unsafePerformIO newCache {-# NOINLINE cacheRef #-}  -- | A wrapper around 'parseFixityDeclaration' for parsing individual fixity

@@ -3,7 +3,9 @@  module Ormolu.Utils.IO   ( findClosestFileSatisfying,-    withIORefCache,+    Cache,+    newCache,+    withCache,   ) where @@ -14,7 +16,7 @@ import Data.Map.Lazy qualified as M import System.Directory import System.FilePath-import System.IO.Error (isDoesNotExistError)+import System.IO.Error (isDoesNotExistError, isPermissionError)  -- | Find the path to the closest file higher in the file hierarchy that -- satisfies a given predicate.@@ -28,34 +30,52 @@   m (Maybe FilePath) findClosestFileSatisfying isRightFile rootOfSearch = liftIO $ do   parentDir <- takeDirectory <$> makeAbsolute rootOfSearch-  dirEntries <--    listDirectory parentDir `catch` \case-      (isDoesNotExistError -> True) -> pure []+  maybeDirEntries <-+    (Just <$> listDirectory parentDir) `catch` \case+      -- The directory does not exist. This is expected: the search may start+      -- from a path that does not exist yet (e.g. a file about to be created),+      -- whose absolute form still lies below existing parent directories.+      -- Treat it as empty and keep searching upwards.+      (isDoesNotExistError -> True) -> pure (Just [])+      -- We lack the permissions to read the directory, e.g. when running in a+      -- sandbox that restricts access to parent directories. Abort the search:+      -- we almost certainly cannot read any parent directory either.+      (isPermissionError -> True) -> pure Nothing       e -> throwIO e-  let searchAtParentDirLevel = \case-        [] -> pure Nothing-        x : xs ->-          if isRightFile x-            then-              doesFileExist (parentDir </> x) >>= \case-                True -> pure (Just x)-                False -> searchAtParentDirLevel xs-            else searchAtParentDirLevel xs-  searchAtParentDirLevel dirEntries >>= \case-    Just foundFile -> pure . Just $ parentDir </> foundFile-    Nothing ->-      if isDrive parentDir-        then pure Nothing-        else findClosestFileSatisfying isRightFile parentDir+  case maybeDirEntries of+    Nothing -> pure Nothing+    Just entries -> do+      let searchAtParentDirLevel = \case+            [] -> pure Nothing+            x : xs ->+              if isRightFile x+                then+                  doesFileExist (parentDir </> x) >>= \case+                    True -> pure (Just x)+                    False -> searchAtParentDirLevel xs+                else searchAtParentDirLevel xs+      searchAtParentDirLevel entries >>= \case+        Just foundFile -> pure . Just $ parentDir </> foundFile+        Nothing ->+          if isDrive parentDir+            then pure Nothing+            else findClosestFileSatisfying isRightFile parentDir +newtype Cache k v = Cache (IORef (Map k v))++newCache :: (Ord k) => IO (Cache k v)+newCache = do+  var <- newIORef mempty+  pure (Cache var)+ -- | Execute an 'IO' action but only if the given key is not found in the--- 'IORef' cache.-withIORefCache :: (Ord k) => IORef (Map k v) -> k -> IO v -> IO v-withIORefCache cacheRef k action = do-  cache <- readIORef cacheRef+-- cache.+withCache :: (Ord k) => Cache k v -> k -> IO v -> IO v+withCache (Cache cacheVar) k action = do+  cache <- readIORef cacheVar   case M.lookup k cache of     Just v -> pure v     Nothing -> do       v <- action-      modifyIORef' cacheRef (M.insert k v)+      atomicModifyIORef cacheVar ((,()) . M.insert k v)       pure v

@@ -36,7 +36,7 @@       mentioned `shouldBe` True       unPackageName ciPackageName `shouldBe` "ormolu"       ciDynOpts `shouldBe` [DynOption "-XGHC2021"]-      Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "MemoTrie", "ansi-terminal", "array", "base", "binary", "bytestring", "choice", "containers", "deepseq", "directory", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "text"]+      Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "MemoTrie", "ansi-terminal", "array", "base", "binary", "bytestring", "choice", "containers", "directory", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "text"]       ciCabalFilePath `shouldSatisfy` isAbsolute       makeRelativeToCurrentDirectory ciCabalFilePath `shouldReturn` "ormolu.cabal"     it "extracts correct cabal info from ormolu.cabal for tests/Ormolu/PrinterSpec.hs" $ do

@@ -35,6 +35,18 @@         `shouldParse` ( exampleFixityOverrides,                         ModuleReexports Map.empty                       )+    it "accepts fractional operator precedences" $+      parseDotOrmolu+        ""+        ( T.unlines+            [ "infixr 3 >~<",+              "infixr 3.3 |~|",+              "infixr 3.7 <~>"+            ]+        )+        `shouldParse` ( fractionalFixityOverrides,+                        ModuleReexports Map.empty+                      )     it "combines conflicting fixity declarations correctly" $       parseDotOrmolu         ""@@ -202,7 +214,7 @@                 elabel "module name"               ]           )-    it "fails with correct parse error (typo: export intead exports)" $+    it "fails with correct parse error (typo: export instead exports)" $       parseModuleReexportDeclaration "module Control.Lens export Control.Lens.Lens"         `shouldFailWith` err           20@@ -228,6 +240,16 @@           ("=<<", FixityInfo InfixR 1),           (">>", FixityInfo InfixL 1),           (">>=", FixityInfo InfixL 1)+        ]+    )++fractionalFixityOverrides :: FixityOverrides+fractionalFixityOverrides =+  FixityOverrides+    ( Map.fromList+        [ (">~<", FixityInfo InfixR 3),+          ("|~|", FixityInfo InfixR 3.3),+          ("<~>", FixityInfo InfixR 3.7)         ]     ) 

@@ -37,7 +37,12 @@               InfixR,               InfixN             ]-        fiPrecedence <- chooseInt (0, 9)+        precedenceWholePart <- fromIntegral <$> chooseInt (0, 9)+        precedenceFractionalPart <-+          if precedenceWholePart < 9.0+            then (* 0.1) . fromIntegral <$> chooseInt (0, 1)+            else return 0+        let fiPrecedence = precedenceWholePart + precedenceFractionalPart         return FixityInfo {..}  instance Arbitrary ModuleReexports where

@@ -201,44 +201,32 @@       ["esqueleto"]       [package_ "bob" $ import_ "Database.Esqueleto.Experimental"]       [(unqual "++.", defaultFixityApproximation)]-  it "default module re-exports: Control.Lens brings into scope Control.Lens.Lens" $+  it "re-exports baked into the database: Control.Lens brings <+~ into scope" $     checkFixities       ["lens"]-      ( applyModuleReexports-          defaultModuleReexports-          [import_ "Control.Lens"]-      )+      [import_ "Control.Lens"]       [(unqual "<+~", FixityApproximation (Just InfixR) 4 4)]-  it "default module re-exports: Control.Lens qualified brings into scope Control.Lens.Lens" $+  it "re-exports baked into the database: Control.Lens qualified" $     checkFixities       ["lens"]-      ( applyModuleReexports-          defaultModuleReexports-          [import_ "Control.Lens" & qualified_]-      )+      [import_ "Control.Lens" & qualified_]       [ (unqual "<+~", defaultFixityApproximation),-        (qual "Control.Lens.Lens" "<+~", defaultFixityApproximation),         (qual "Control.Lens" "<+~", FixityApproximation (Just InfixR) 4 4)       ]-  it "default module re-exports: Control.Lens qualified as brings into scope Control.Lens.Lens" $+  it "re-exports baked into the database: Control.Lens qualified as" $     checkFixities       ["lens"]-      ( applyModuleReexports-          defaultModuleReexports-          [import_ "Control.Lens" & qualified_ & as_ "L"]-      )+      [import_ "Control.Lens" & qualified_ & as_ "L"]       [ (unqual "<+~", defaultFixityApproximation),-        (qual "Control.Lens.Lens" "<+~", defaultFixityApproximation),         (qual "Control.Lens" "<+~", defaultFixityApproximation),         (qual "L" "<+~", FixityApproximation (Just InfixR) 4 4)       ]   it "re-export chains: exported module can itself re-export another module" $ do     let reexports =           ModuleReexports $-            Map.insert+            Map.singleton               "Foo"               ((Nothing, "Control.Lens") :| [])-              (unModuleReexports defaultModuleReexports)     checkFixities       ["lens"]       ( applyModuleReexports

@@ -31,7 +31,10 @@   FixityOverrides     ( Map.fromList         [ (".=", FixityInfo InfixR 8),-          ("#", FixityInfo InfixR 5)+          ("#", FixityInfo InfixR 5),+          (">~<", FixityInfo InfixR 3),+          ("|~|", FixityInfo InfixR 3.3),+          ("<~>", FixityInfo InfixR 3.7)         ]     ) @@ -50,6 +53,10 @@                   "esqueleto",                   "hspec",                   "lens",+                  "megaparsec",+                  "optics",+                  "relude",+                  "rio",                   "servant"                 ]           }