ormolu 0.7.7.0 → 0.9.0.0

raw patch · 275 files changed

Files

• CHANGELOG.md +235/−29
• CONTRIBUTING.md +27/−21
• DESIGN.md +28/−28
• LICENSE.md +2/−2
• README.md +116/−89
• app/Main.hs +29/−14
• data/examples/declaration/data/comment-in-empty-record-out.hs +6/−0
• data/examples/declaration/data/comment-in-empty-record.hs +5/−0
• data/examples/declaration/data/haddock-before-deriving-out.hs +5/−0
• data/examples/declaration/data/haddock-before-deriving.hs +3/−0
• data/examples/declaration/data/haddock-before-record-braces-out.hs +6/−0
• data/examples/declaration/data/haddock-before-record-braces.hs +5/−0
• data/examples/declaration/data/infix-haddocks-out.hs +2/−2
• data/examples/declaration/data/linear-out.hs +11/−0
• data/examples/declaration/data/linear.hs +10/−0
• data/examples/declaration/data/record-empty-haddock-out.hs +5/−0
• data/examples/declaration/data/record-empty-haddock.hs +6/−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/unnamed-field-comment-3-out.hs +1/−5
• data/examples/declaration/data/unpack-field-comment-0-out.hs +4/−0
• data/examples/declaration/data/unpack-field-comment-0.hs +2/−0
• data/examples/declaration/data/unpack-field-comment-1-out.hs +4/−0
• data/examples/declaration/data/unpack-field-comment-1.hs +2/−0
• data/examples/declaration/data/unpack-field-comment-2-out.hs +4/−0
• data/examples/declaration/data/unpack-field-comment-2.hs +3/−0
• data/examples/declaration/data/unpack-field-comment-3-out.hs +4/−0
• data/examples/declaration/data/unpack-field-comment-3.hs +3/−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/rewrite-rule/prelude4-out.hs +1/−0
• 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-families/closed-type-family/multi-line-out.hs +1/−2
• data/examples/declaration/type-synonyms/multi-line-out.hs +1/−2
• 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 +2/−3
• 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/arrow/proc-lambdas-out.hs +1/−2
• data/examples/declaration/value/function/awkward-comment-0-out.hs +1/−2
• data/examples/declaration/value/function/awkward-comment-1-out.hs +1/−2
• data/examples/declaration/value/function/case-comment-after-pattern-out.hs +3/−0
• data/examples/declaration/value/function/case-comment-after-pattern.hs +3/−0
• data/examples/declaration/value/function/case-comment-between-alt-and-where-out.hs +6/−0
• data/examples/declaration/value/function/case-comment-between-alt-and-where.hs +6/−0
• data/examples/declaration/value/function/case-multi-line-out.hs +1/−2
• 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/lambda-comment-after-arrow-out.hs +2/−0
• data/examples/declaration/value/function/lambda-comment-after-arrow.hs +2/−0
• 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/newline-single-line-body-out.hs +1/−2
• data/examples/declaration/value/function/operator-comments-3-out.hs +5/−0
• data/examples/declaration/value/function/operator-comments-3.hs +5/−0
• data/examples/declaration/value/function/operator-comments-4-out.hs +4/−0
• data/examples/declaration/value/function/operator-comments-4.hs +4/−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/record/wildcard-comments-0-out.hs +12/−0
• data/examples/declaration/value/function/record/wildcard-comments-0.hs +11/−0
• data/examples/declaration/value/function/record/wildcard-comments-1-out.hs +12/−0
• data/examples/declaration/value/function/record/wildcard-comments-1.hs +11/−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/comment-before-merged-import-lists-out.hs +7/−0
• data/examples/import/comment-before-merged-import-lists.hs +7/−0
• data/examples/import/comment-before-merged-imports-out.hs +7/−0
• data/examples/import/comment-before-merged-imports.hs +3/−0
• data/examples/import/comment-between-merged-imports-out.hs +7/−0
• data/examples/import/comment-between-merged-imports.hs +6/−0
• data/examples/import/comment-inside-empty-import-list-out.hs +6/−0
• data/examples/import/comment-inside-empty-import-list.hs +5/−0
• data/examples/import/comment-inside-sorted-import-list-out.hs +7/−0
• data/examples/import/comment-inside-sorted-import-list.hs +7/−0
• data/examples/import/comments-inside-imports-out.hs +2/−3
• data/examples/import/comments-per-import-out.hs +1/−2
• data/examples/import/data-out.hs +7/−0
• data/examples/import/data.hs +6/−0
• data/examples/import/explicit-imports-with-comments-out.hs +3/−5
• data/examples/import/explicit-level-imports-out.hs +16/−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/merging-0-out.hs +4/−1
• data/examples/import/merging-1-out.hs +4/−1
• data/examples/import/merging-2-out.hs +8/−2
• 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/import/simple-out.hs +10/−2
• 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/module-header/empty-haddock-out.hs +2/−0
• data/examples/other/block-comment-before-argument-out.hs +5/−0
• data/examples/other/block-comment-before-argument.hs +4/−0
• data/examples/other/block-comment-before-element-out.hs +6/−0
• data/examples/other/block-comment-before-element.hs +6/−0
• data/examples/other/comment-around-quasiquote-out.hs +9/−0
• data/examples/other/comment-around-quasiquote.hs +9/−0
• data/examples/other/comment-block-section-heading-out.hs +3/−0
• data/examples/other/comment-block-section-heading.hs +3/−0
• data/examples/other/comment-glued-together-out.hs +1/−1
• data/examples/other/comment-in-empty-list-out.hs +9/−0
• data/examples/other/comment-in-empty-list.hs +6/−0
• data/examples/other/comment-opening-a-list-out.hs +11/−0
• data/examples/other/comment-opening-a-list.hs +11/−0
• data/examples/other/comment-style-transform-out.hs +17/−14
• 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/comment-trigger-escaping-out.hs +15/−0
• data/examples/other/comment-trigger-escaping.hs +15/−0
• data/examples/other/comment-two-blocks-out.hs +3/−2
• data/examples/other/empty-forall-out.hs +1/−1
• data/examples/other/empty-haddock-out.hs +6/−2
• data/examples/other/invalid-haddock-weird-out.hs +1/−3
• data/examples/other/pragma-below-header-out.hs +19/−0
• data/examples/other/pragma-below-header.hs +18/−0
• data/examples/other/pragma-comment-multi-extension-out.hs +5/−0
• data/examples/other/pragma-comment-multi-extension.hs +4/−0
• extract-hackage-info/hackage-info.bin binary
• ormolu.cabal +206/−180
• src/GHC/DynFlags.hs +6/−0
• src/Ormolu.hs +50/−20
• src/Ormolu/Comments/Anchor.hs +326/−0
• src/Ormolu/Comments/Invariants.hs +135/−0
• src/Ormolu/Comments/Tree.hs +74/−0
• src/Ormolu/Config.hs +4/−3
• src/Ormolu/Diff/ParseResult.hs +102/−23
• src/Ormolu/Diff/Text.hs +1/−5
• src/Ormolu/Exception.hs +25/−4
• src/Ormolu/Fixity.hs +2/−17
• src/Ormolu/Fixity/Imports.hs +1/−1
• src/Ormolu/Fixity/Internal.hs +38/−70
• src/Ormolu/Fixity/Parser.hs +3/−1
• src/Ormolu/Fixity/Printer.hs +11/−1
• src/Ormolu/Imports.hs +79/−36
• src/Ormolu/Parser.hs +64/−21
• src/Ormolu/Parser/CommentStream.hs +251/−105
• src/Ormolu/Parser/Pragma.hs +1/−1
• src/Ormolu/Parser/Result.hs +24/−3
• src/Ormolu/Printer.hs +79/−19
• src/Ormolu/Printer/Combinators.hs +144/−60
• src/Ormolu/Printer/CommentPlacement.hs +57/−0
• src/Ormolu/Printer/Comments.hs +110/−188
• src/Ormolu/Printer/Internal.hs +196/−151
• src/Ormolu/Printer/Meat/Common.hs +198/−35
• src/Ormolu/Printer/Meat/Declaration.hs +23/−14
• src/Ormolu/Printer/Meat/Declaration/Class.hs +8/−3
• src/Ormolu/Printer/Meat/Declaration/Data.hs +102/−97
• src/Ormolu/Printer/Meat/Declaration/Default.hs +6/−1
• src/Ormolu/Printer/Meat/Declaration/Foreign.hs +13/−8
• src/Ormolu/Printer/Meat/Declaration/Instance.hs +1/−1
• src/Ormolu/Printer/Meat/Declaration/OpTree.hs +58/−29
• src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs +1/−1
• src/Ormolu/Printer/Meat/Declaration/Rule.hs +16/−14
• 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 +10/−3
• src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs +11/−6
• src/Ormolu/Printer/Meat/Declaration/Value.hs +240/−240
• src/Ormolu/Printer/Meat/Declaration/Value.hs-boot +0/−3
• src/Ormolu/Printer/Meat/ImportExport.hs +36/−8
• src/Ormolu/Printer/Meat/Module.hs +35/−28
• src/Ormolu/Printer/Meat/Pragma.hs +10/−3
• src/Ormolu/Printer/Meat/Type.hs +120/−79
• src/Ormolu/Printer/Operators.hs +32/−32
• src/Ormolu/Printer/SpanStream.hs +0/−49
• src/Ormolu/Processing/Common.hs +2/−2
• src/Ormolu/Processing/Preprocess.hs +17/−10
• src/Ormolu/Terminal.hs +2/−2
• src/Ormolu/Utils.hs +21/−15
• src/Ormolu/Utils/Cabal.hs +7/−8
• src/Ormolu/Utils/Fixity.hs +9/−12
• src/Ormolu/Utils/IO.hs +45/−25
• tests/Ormolu/CabalInfoSpec.hs +1/−1
• tests/Ormolu/Comments/AnchorSpec.hs +140/−0
• tests/Ormolu/Fixity/ParserSpec.hs +23/−1
• tests/Ormolu/Fixity/PrinterSpec.hs +6/−1
• tests/Ormolu/FixitySpec.hs +8/−20
• tests/Ormolu/PrinterSpec.hs +12/−36
• tests/Ormolu/TestConfig.hs +49/−0

@@ -1,3 +1,209 @@+## Ormolu 0.9.0.0++* Comments are now attached to the syntax tree by position, before anything+  is printed, rather than by a cursor advanced as the printer walks the+  tree. Which element owns a comment no longer depends on the order in which+  the printer happens to visit things, so comments stop escaping the+  construct they were written in when Ormolu sorts or regroups it: a comment+  inside an import list stays there, a comment after a quasi-quote stops+  floating to the bottom of the file, and a comment attached to an import+  travels with that import when the imports are sorted. [Issue+  1074](https://github.com/tweag/ormolu/issues/1074) and [issue+  1076](https://github.com/tweag/ormolu/issues/1076).++* Haddock comments are now printed as they were written instead of being+  rebuilt from the documentation string GHC parsed out of them. A `{- | …+  -}` stays a block comment rather than becoming `--` lines, an empty `-- |`+  is no longer dropped, and a `{- *** … -}` section heading keeps its+  meaning. [Issue 641](https://github.com/tweag/ormolu/issues/641), [issue+  822](https://github.com/tweag/ormolu/issues/822), and [issue+  1159](https://github.com/tweag/ormolu/issues/1159).++  Ormolu still puts a space after a Haddock's trigger, re-indents a block+  Haddock to line up with the code it documents, and rewrites a trailing `--+  ^ X` as a leading `-- | X` when it moves the comment in front of what it+  documents.++* Backslashes are no longer added to lines in the middle of a comment block,+  where Haddock does not look for a trigger anyway. [Issue+  1131](https://github.com/tweag/ormolu/issues/1131).++* A comment written on its own line in front of an operator no longer+  strands the operator at the start of the next line. In a `do` block that+  changed what the code meant, because `$` at the beginning of a line is+  read as a new statement rather than as a continuation of the previous one.+  [Issue 1028](https://github.com/tweag/ormolu/issues/1028).++* A comment written after `=`, `->`, or a lambda arrow now stays on that+  line instead of being pushed onto the next one, and the result is+  idempotent. `f x = -- note` no longer becomes an `=` stranded on a line of+  its own. [Issue 786](https://github.com/tweag/ormolu/issues/786), [issue+  810](https://github.com/tweag/ormolu/issues/810), and [issue+  936](https://github.com/tweag/ormolu/issues/936).++* Layout decisions now take comments into account. A comment that falls+  inside a construct can no longer be squeezed into a single-line rendering+  of it.++* A comment block that trails a line of code and continues below it no+  longer drops to the start of the line, which could put the rest of the+  block outside the construct it was written in.++* A construct that brackets its contents is no longer put on one line when+  something inside it is documented with a `-- |` Haddock. Such a Haddock+  takes whole lines, so it used to swallow the closing bracket: a documented+  `deriving` clause came out as `deriving (-- | B`, and a documented field+  of a short record as `{-- | …`, which did not even parse. [Issue+  752](https://github.com/tweag/ormolu/issues/752) and [issue+  1164](https://github.com/tweag/ormolu/issues/1164).++  A `{- | … -}` Haddock is self-delimiting and does not force anything, so+  a declaration documented that way is left as it was written rather than+  being broken up: `data A = A {- | a number -} Int Bool` stays on one line+  where it used to be spread over five.++* Only pragmas in the file header are hoisted to the top of the module now.+  A `LANGUAGE` or `OPTIONS_GHC` pragma written after the first import or+  declaration stays where it is, and no longer drags the comments above it+  to the top of the file. GHC reads the header and stops, so such a pragma+  never affected compilation; moving it was giving it an effect it did not+  have. [Issue 1168](https://github.com/tweag/ormolu/issues/1168).++* A comment above a `{-# LANGUAGE A, B #-}` pragma is no longer duplicated+  when the pragma is split into one per extension; it stays with the first.+  [Issue 787](https://github.com/tweag/ormolu/issues/787).++* Ormolu now checks that the comments of the output correspond to the+  comments of the input—none dropped, duplicated, invented, or reordered—and+  refuses to format when they do not. This runs alongside the existing check+  that the AST is unchanged, is disabled by `--unsafe`, and costs nothing+  extra: the printer already records where it put each comment.++## 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 +425,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 +674,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 +687,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 +697,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 +713,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 +738,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 +787,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 +824,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 +845,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 +863,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 +883,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 +901,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 +934,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

@@ -1,46 +1,52 @@ # Contributing -Issues (bugs, feature requests or otherwise feedback) may be reported in-[the GitHub issue tracker for this project][issues]. Pull requests are also+Issues (bugs, feature requests, or other feedback) may be reported in [the+GitHub issue tracker for this project][issues]. Pull requests are also welcome.  When contributing to this repository, please first discuss the change you wish to make via an issue, unless it's entirely trivial (typo fixes, etc.). If there is already an issue that describes the change you have in mind,-comment on it indicating that you're going to work on that. This way we can-avoid the situation when several people work on the same thing.+comment on it to indicate that you're going to work on it. This way we can+avoid situations where several people work on the same thing. -Please make sure that all non-trivial changes are described in commit+Please make sure that all non-trivial changes are described in the commit messages and PR descriptions.  ## Testing -Testing has been taken good care of and now it amounts to just adding-examples under `data/examples`. Each example is a pair of files:-`<example-name>.hs` for input and `<example-name>-out.hs` for corresponding-expected output.+Testing is well taken care of, so it usually amounts to just adding examples+under `data/examples`. Each example is a pair of files: `<example-name>.hs`+for the input and `<example-name>-out.hs` for the corresponding expected+output. -Testing is performed as following:+Testing is performed as follows: -* Given snippet of source code is parsed and pretty-printed.-* The result of printing is parsed back again and the AST is compared to the-  AST obtained from the original file. They should match.-* The output of printer is checked against the expected output.-* Idempotence property is verified: formatting already formatted code+* The given snippet of source code is parsed and pretty-printed.+* The result of printing is parsed again, and its AST is compared to the AST+  obtained from the original file. The two should match.+* The output of the printer is checked against the expected output.+* The idempotence property is verified: formatting already formatted code   results in exactly the same output. -Examples can be organized in sub-directories, see the existing ones for+Examples can be organized into sub-directories; see the existing ones for 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.+Please note that we try to keep individual files at most 25 lines long,+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 the `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+   installed automatically when you enter the Nix shell. You can also run it+   via `pre-commit run` or `pre-commit run -a`.++If Ormolu is not formatted this way, 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,15 +4,18 @@ [![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) +*Ormolu gratefully acknowledges the support and contributions of+[Tweag][tweag] during the period 2019–2026.*+ * [Installation](#installation) * [Building from source](#building-from-source) * [Usage](#usage)     * [Ormolu Live](#ormolu-live)     * [Editor integration](#editor-integration)     * [Haskell Language Server](#haskell-language-server)-    * [GitHub actions](#github-actions)+    * [GitHub Actions](#github-actions)     * [Language extensions, dependencies, and fixities](#language-extensions-dependencies-and-fixities)     * [Magic comments](#magic-comments)     * [Regions](#regions)@@ -29,39 +32,37 @@ Ormolu is a formatter for Haskell source code. The project was created with the following goals in mind: -* Using GHC's own parser to avoid parsing problems caused by+* Use GHC's own parser to avoid the parsing problems caused by   [`haskell-src-exts`][haskell-src-exts].-* Let some whitespace be programmable. The layout of the input influences-  the layout choices in the output. This means that the choices between-  single-line/multi-line layouts in certain situations are made by the user,-  not by an algorithm. This makes the implementation simpler and leaves some-  control to the user while still guaranteeing that the formatted code is-  stylistically consistent.-* Writing code in such a way so it's easy to modify and maintain.-* Implementing one “true” formatting style which admits no configuration.-* The formatting style aims to result in minimal diffs.+* Make some whitespace programmable. The layout of the input influences the+  layout choices in the output, so the choice between single-line and+  multi-line layouts is made by the user rather than by an algorithm. This+  keeps the implementation simpler and leaves some control to the user while+  still guaranteeing that the formatted code is stylistically consistent.+* Implement one “true” formatting style that admits no configuration.+* Produce minimal diffs. * Choose a style compatible with modern dialects of Haskell. As new Haskell-  extensions enter broad use, we may change the style to accommodate them.-* Idempotence: formatting already formatted code doesn't change it.-* Be well-tested and robust so that the formatter can be used in large+  extensions enter broad use, we may adjust the style to accommodate them.+* Guarantee idempotence: formatting already formatted code doesn't change it.+* Stay 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 -The [release page][releases] has binaries for Linux, macOS and Windows.+The [release page][releases] has binaries for Linux, macOS, and Windows. -You can also install using `cabal` or `stack`:+You can also install Ormolu with `cabal` or `stack`:  ```console $ cabal install ormolu $ stack install ormolu ``` -Ormolu is also included in several package repositories. E.g., on Arch Linux,-one can use [the package on AUR][aur]:+Ormolu is also included in several package repositories. For example, on Arch+Linux you can use [the package on AUR][aur]:  ```console $ yay -S ormolu@@ -75,21 +76,37 @@ $ 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 uses them only if you allow it to. The simplest way is+to pass `--accept-flake-config`: -Alternatively, `stack` could be used as follows:+```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, you can use `stack`:+ ```console $ stack build # to build $ stack install # to install ``` -To use Ormolu directly from GitHub with Nix flakes, this snippet may come in handy:+To use Ormolu directly from GitHub with Nix flakes, this snippet may come in+handy:  ```nix {-  inputs.ormolu.url = "github:tweag/ormolu";+  inputs.ormolu.url = "github:mrkkrp/ormolu";   outputs = { ormolu, ... }: {     # use ormolu.packages.${system}.default here   };@@ -98,14 +115,14 @@  ## Usage -The following will print the formatted output to the standard output.+The following prints the formatted output to the standard output:  ```console $ ormolu Module.hs ```  Add `--mode inplace` to replace the contents of the input file with the-formatted output.+formatted output:  ```console $ ormolu --mode inplace Module.hs@@ -123,7 +140,7 @@ $ ormolu --mode inplace $(git ls-files '*.hs') ``` -To check if files are are already formatted (useful on CI):+To check whether files are already formatted (useful on CI):  ```console $ ormolu --mode check $(find . -name '*.hs')@@ -140,8 +157,9 @@ ### 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, where `COMMITHASH` is the hash of the+commit you want.  ### Editor integration @@ -156,25 +174,24 @@ [Haskell Language Server](https://haskell-language-server.readthedocs.io) has built-in support for using Ormolu as a formatter. -### GitHub actions+### GitHub Actions  [`run-ormolu`][run-ormolu] is the recommended way to ensure that a project-is formatted with Ormolu.+stays formatted with Ormolu.  ### Language extensions, dependencies, and fixities  Ormolu automatically locates the Cabal file that corresponds to a given-source code file. Cabal files are used to extract both default extensions-and dependencies. Default extensions directly affect behavior of the GHC-parser, while dependencies are used to figure out fixities of operators that-appear in the source code. Fixities can also be overridden via an `.ormolu`-file which should be located at a higher level in the file system hierarchy-than the source file that is being formatted. When the input comes from-stdin, one can pass `--stdin-input-file` which will give Ormolu the location-that should be used as the starting point for searching for `.cabal` and-`.ormolu` files.+source file. Cabal files are used to extract both default extensions and+dependencies. Default extensions directly affect the behavior of the GHC+parser, while dependencies are used to determine the fixities of operators+that appear in the source code. Fixities can also be overridden via an+`.ormolu` file, which should be located higher in the file system hierarchy+than the source file being formatted. When the input comes from stdin, you+can pass `--stdin-input-file` to tell Ormolu which location to use as the+starting point when searching for `.cabal` and `.ormolu` files. -Here is an example of `.ormolu` file:+Here is an example of an `.ormolu` file:  ```haskell infixr 9  .@@ -184,21 +201,26 @@ 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 uses exactly the same syntax as ordinary Haskell fixity declarations,+which makes it easier for Haskellers to edit and maintain. Since Ormolu+0.7.8.0, fractional precedences are supported for more precise control over+the 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-because at the moment Ormolu cannot know about all possible module-re-exports in the ecosystem and only few of them are actually important when-it comes to fixity deduction. In 99% of cases the user won't have to do-anything, especially since most common re-exports are already programmed-into Ormolu. (You are welcome to open PRs to make Ormolu aware of more-re-exports by default.) However, when the fixity of an operator is not-inferred correctly, making Ormolu aware of a re-export may come in handy.-Here is an example:+module re-exports that Ormolu should be aware of. This can be useful because+Ormolu cannot know about every possible module re-export in the ecosystem,+and only a few of them actually matter for fixity deduction. In 99% of cases+you won't have to do anything, especially since the most common re-exports+are already built into Ormolu. (You are welcome to open PRs to make Ormolu+aware of more re-exports by default.) However, when the fixity of an operator+is not inferred correctly, making Ormolu aware of a re-export may help. Here+is an example:  ```haskell module Control.Lens exports Control.Lens.At@@ -234,19 +256,19 @@ {- ORMOLU_ENABLE -} ``` -This allows us to disable formatting selectively for code between these-markers or disable it for the entire file. To achieve the latter, just put-`{- ORMOLU_DISABLE -}` at the very top. Note that for Ormolu to work the-fragments where Ormolu is enabled must be parseable on their own. Because of-that the magic comments cannot be placed arbitrarily, but rather must-enclose independent top-level definitions.+These let you disable formatting selectively for the code between the two+markers, or for the entire file. To disable formatting for the whole file,+just put `{- ORMOLU_DISABLE -}` at the very top. Note that the fragments+where Ormolu is enabled must be parseable on their own. Because of this, the+magic comments cannot be placed arbitrarily; they must enclose independent+top-level definitions.  ### Regions -One can ask Ormolu to format a region of input and leave the rest-unformatted. This is accomplished by passing the `--start-line` and-`--end-line` command line options. `--start-line` defaults to the beginning-of the file, while `--end-line` defaults to the end.+You can ask Ormolu to format a region of the input and leave the rest+unformatted by passing the `--start-line` and `--end-line` command line+options. `--start-line` defaults to the beginning of the file, and+`--end-line` defaults to the end.  Note that the selected region needs to be parseable Haskell code on its own. @@ -265,16 +287,17 @@ 8         | Cabal file parsing failed 9         | Missing input file path when using stdin input and accounting for .cabal files 10        | Parse error while parsing fixity overrides+11        | Comments of original and formatted code differ 100       | In checking mode: unformatted files 101       | Inplace mode does not work with stdin 102       | Other issue (with multiple input files)  ### Using as a library -The `ormolu` package can also be depended upon from other Haskell programs.-For these purposes only the top `Ormolu` module should be considered stable.-It follows [PVP](https://pvp.haskell.org/) starting from the version-0.5.3.0. Rely on other modules at your own risk.+The `ormolu` package can also be used as a dependency from other Haskell+programs. For this purpose, only the top-level `Ormolu` module should be+considered stable. It follows the [PVP](https://pvp.haskell.org/) starting+from version 0.5.3.0. Rely on other modules at your own risk.  ## Troubleshooting @@ -289,40 +312,41 @@   specify the correct fixities in a `.ormolu` file.  * If this is a third-party operator (e.g. from `base` or some other package-  from Hackage), Ormolu probably doesn't recognize that the operator is the+  on Hackage), Ormolu probably doesn't recognize that the operator is the   same as the third-party one. -  Some reasons this might be the case:+  Some possible reasons for this: -    * You might have a custom Prelude that re-exports things from Prelude-    * You might have `-XNoImplicitPrelude` turned on+    * You have a custom Prelude that re-exports things from the standard+      Prelude.+    * You have `-XNoImplicitPrelude` turned on. -  If any of these are true, make sure to specify the reexports correctly in-  a `.ormolu` file.+  If either of these applies, make sure to specify the re-exports correctly+  in a `.ormolu` file. -You can see how Ormolu decides the fixity of operators if you use `--debug`.+You can see how Ormolu decides the fixity of operators by using `--debug`.  ## Limitations  * CPP support is experimental. CPP is virtually impossible to handle-  correctly, so we process them as a sort of unchangeable snippets. This-  works only in simple cases when CPP conditionals surround top-level-  declarations. See the [CPP][design-cpp] section in the design notes for a+  correctly, so Ormolu treats CPP sections as unchangeable snippets. This+  works only in simple cases, where CPP conditionals surround top-level+  declarations. See the [CPP][design-cpp] section of the design notes for a   discussion of the dangers.  ## Running on Hackage -It's possible to try Ormolu on arbitrary packages from Hackage. For that-execute (from the root of the cloned repo):+You can try Ormolu on arbitrary packages from Hackage. To do so, run the+following from the root of the cloned repo:  ```console $ nix build .#hackage.<package> ``` -Then inspect `result/log.txt` for possible problems. The derivation will-also contain formatted `.hs` files for inspection and original inputs with-`.hs-original` extension (those are with CPP dropped, exactly what is fed-into Ormolu).+Then inspect `result/log.txt` for possible problems. The derivation also+contains the formatted `.hs` files for inspection, along with the original+inputs under the `.hs-original` extension (these have CPP dropped and are+exactly what is fed into Ormolu).  ## Forks and modifications @@ -333,23 +357,26 @@  ## Contributing -See [CONTRIBUTING.md][contributing].+Contributions of all kinds are welcome, from bug reports and documentation+fixes to new features. Please see [CONTRIBUTING.md][contributing] to get+started.  ## License  See [LICENSE.md][license]. -Copyright © 2018–present Tweag I/O+Copyright © 2018–2026 Tweag I/O, 2026–present Mark Karpov +[tweag]: https://tweag.io/ [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,12 +127,14 @@         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               stderr-              "In place editing is not supported when input comes from stdin."+              "In-place editing is not supported when the input comes from stdin."             -- 101 is different from all the other exit codes we already use.             return (ExitFailure 101)           Check -> do@@ -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@@ -183,7 +198,7 @@         Nothing -> return ExitSuccess         Just diff -> do           runTerm (printTextDiff diff) (cfgColorMode rawConfig) stderr-          -- 100 is different to all the other exit code that are emitted+          -- 100 is different from all the other exit codes that are emitted           -- either from an 'OrmoluException' or from 'error' and           -- 'notImplemented'.           return (ExitFailure 100)@@ -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,6 @@+instance StateKey ExampleReq where+  data State ExampleReq = ExampleState+    {+    -- in here you can put any state that the+    -- run.+    }

@@ -0,0 +1,5 @@+instance StateKey ExampleReq where+  data State ExampleReq = ExampleState {+        -- in here you can put any state that the+        -- run.+        }

@@ -0,0 +1,5 @@+data A = A+  deriving+    ( -- | B+      Eq+    )

@@ -0,0 +1,3 @@+data A = A+  -- | B+  deriving (Eq)

@@ -0,0 +1,6 @@+module Example where++data Hello = Hello+  { -- | hello world+    hello :: String+  }

@@ -0,0 +1,5 @@+module Example where++data Hello = Hello+  -- | hello world+  {hello :: String}

@@ -24,8 +24,8 @@  data DocPartial   = Left -- ^ left docs-    -- on multiple-    -- lines+         -- on multiple+         -- lines       :*:       Right   | -- | op

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

@@ -0,0 +1,5 @@+data A = A+  { -- \|+    --+    a :: Int+  }

@@ -0,0 +1,6 @@+data A = A+  {+    -- |+    -- +    a :: Int+  }

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

@@ -1,5 +1,1 @@-data A-  = A-      -- | a number-      Int-      Bool+data A = A {- | a number -} Int Bool

@@ -0,0 +1,4 @@+data Buffer+  = Buffer+      {-# UNPACK #-} !(ForeignPtr Word8) -- underlying pinned array+      {-# UNPACK #-} !(Ptr Word8) -- beginning of slice

@@ -0,0 +1,2 @@+data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8) -- underlying pinned array+                     {-# UNPACK #-} !(Ptr Word8)        -- beginning of slice

@@ -0,0 +1,4 @@+data P+  = P+      {-# UNPACK #-} !Word32 -- left word+      {-# UNPACK #-} !Word32 -- right word

@@ -0,0 +1,2 @@+data P = P {-# UNPACK #-} !Word32 -- left word+           {-# UNPACK #-} !Word32 -- right word

@@ -0,0 +1,4 @@+data TBQueue a+  = TBQueue+      {-# UNPACK #-} !(TVar Natural) -- CR:  read capacity+      {-# UNPACK #-} !(TVar [a]) -- R:   elements waiting to be read

@@ -0,0 +1,3 @@+data TBQueue a+   = TBQueue {-# UNPACK #-} !(TVar Natural) -- CR:  read capacity+             {-# UNPACK #-} !(TVar [a])     -- R:   elements waiting to be read

@@ -0,0 +1,4 @@+data Builder+  = Builder+      {-# UNPACK #-} !Int -- offset+      {-# UNPACK #-} !Int -- used units

@@ -0,0 +1,3 @@+data Builder = Builder+     {-# UNPACK #-} !Int -- offset+     {-# UNPACK #-} !Int -- used units

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

@@ -2,6 +2,7 @@ "unpack" [~1] forall a. unpackCString # a = build (unpackFoldrCString # a) "unpack-list" [1] forall a. unpackFoldrCString # a (:) [] = unpackCString # a "unpack-append" forall a n. unpackFoldrCString # a (:) n = unpackAppendCString # a n+ -- There's a built-in rule (in PrelRules.lhs) for --      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n   #-}

@@ -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 #-}

@@ -25,6 +25,5 @@   F a = String  type family F a where-  F a -- foo-    =+  F a = -- foo     a

@@ -19,6 +19,5 @@     :<|> "route2" :> ApiRoute2 -- comment here     :<|> OmitDocs :> "i" :> ASomething API -type A -- foo-  =+type A = -- foo   B

@@ -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@@ -29,8 +29,7 @@           Left             ( z,               w-              ) -> \u ->-              -- Procs can have lambdas+              ) -> \u -> -- Procs can have lambdas               let v =                     u -- Actually never used                       ^ 2

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

@@ -5,6 +5,5 @@ bar =   proc x -> \f g h ->     \() ->-      \(Left (x, y)) ->-        -- Tuple value+      \(Left (x, y)) -> -- Tuple value         f (g (h x)) -< y

@@ -1,6 +1,5 @@ mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a-mergeErrorReply err1 reply -- XXX where to put it?-  =+mergeErrorReply err1 reply = -- XXX where to put it?   case reply of     Ok x state err2 -> Ok x state (mergeError err1 err2)     Error err2 -> Error (mergeError err1 err2)

@@ -1,8 +1,7 @@ doForeign :: Vars -> [Name] -> [Term] -> Idris LExp doForeign x = x   where-    splitArg tm | (_, [_, _, l, r]) <- unApply tm -- pair, two implicits-      =+    splitArg tm | (_, [_, _, l, r]) <- unApply tm = -- pair, two implicits       do         let l' = toFDesc l         r' <- irTerm (sMN 0 "__foreignCall") vs env r

@@ -0,0 +1,3 @@+foo = case a of+  b -> -- comment+    c

@@ -0,0 +1,3 @@+foo = case a of+  b -- comment+    -> c

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

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

@@ -21,7 +21,6 @@ quux x = case x of   x -> x -funnyComment =-  -- comment+funnyComment = -- comment   case () of     () -> ()

@@ -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,2 @@+f = \a -> -- foo+  a

@@ -0,0 +1,2 @@+f = \a -> -- foo+  a

@@ -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+  """

@@ -4,7 +4,6 @@  function' :: String -> String function' s = case s of-  "ThisString" ->-    -- And a comment here is okay+  "ThisString" -> -- And a comment here is okay     "Yay"   _ -> "Boo"

@@ -0,0 +1,5 @@+data X = X {x :: Int}++f =+  id+    . (\s -> s {x = 1}) -- Some comment

@@ -0,0 +1,5 @@+data X = X { x :: Int }++f = id+    . -- Some comment+    (\s -> s { x = 1 })

@@ -0,0 +1,4 @@+foo = do+  bar+    -- txt+    $ baz

@@ -0,0 +1,4 @@+foo = do+  bar+    -- txt+    $ baz

@@ -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,12 @@+{-# LANGUAGE RecordWildCards #-}++example =+  Record+    { -- A+      field = (), -- B+      -- C+      field = (), -- D+      -- E+      -- F+      ..+    } -- G

@@ -0,0 +1,11 @@+{-# LANGUAGE RecordWildCards #-}++example =+  Record+    { -- A+      field = (), -- B+      -- C+      field = (), -- D+      -- E+      .. -- F+    } -- G

@@ -0,0 +1,12 @@+{-# LANGUAGE RecordWildCards #-}++example =+  Record+    { -- A+      field = (),+      -- C+      field = (),+      -- E+      -- F+      ..+    } -- G

@@ -0,0 +1,11 @@+{-# LANGUAGE RecordWildCards #-}++example =+  Record+    { -- A+      field = (),+      -- C+      field = (),+      -- E+      .. -- F+    } -- G

@@ -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,7 @@+-- their own formatters.+import Test.Hspec.Core.Formatters.V1.Monad+  ( FormatM,+    Formatter (..),+    Item (..),+    interpretWith,+  )

@@ -0,0 +1,7 @@+-- their own formatters.+import Test.Hspec.Core.Formatters.V1.Monad (+    Formatter(..)+  , FormatM+  )++import Test.Hspec.Core.Formatters.V1.Monad (Item(..), interpretWith)

@@ -0,0 +1,7 @@+-- Import stuff from Prelude explicitly+import Prelude+  ( Eq (..),+    Int,+    ($),+    (.),+  )

@@ -0,0 +1,3 @@+-- Import stuff from Prelude explicitly+import Prelude (Eq(..), Int)+import Prelude ((.), ($))

@@ -0,0 +1,7 @@+import HscMain (newHscEnv)+-- Implementations of the various modes+import LoadIface+  ( -- Imports for --abi-hash+    loadUserInterface,+    showIface,+  )

@@ -0,0 +1,6 @@+-- Implementations of the various modes+import           LoadIface ( showIface )+import           HscMain ( newHscEnv )++-- Imports for --abi-hash+import           LoadIface ( loadUserInterface )

@@ -0,0 +1,6 @@+import Package1+import Package2+import Package3+  (+  -- , import1+  )

@@ -0,0 +1,5 @@+import Package1+import Package3 (+ -- , import1+ )+import Package2

@@ -0,0 +1,7 @@+import Package1+import Package2+import Package3+  ( hi,+    -- , import1+    test,+  )

@@ -0,0 +1,7 @@+import Package1+import Package3 (+ hi,+ -- , import1+ test,+ )+import Package2

@@ -1,7 +1,6 @@--- x- import qualified -- x   Bar import qualified -- x   Baz-import Foo+import -- x+  Foo

@@ -1,4 +1,3 @@--- (1) import Bar -- (2) import Baz -- (3)-import Foo+import Foo -- (1)

@@ -0,0 +1,7 @@+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)

@@ -1,7 +1,5 @@ import qualified MegaModule as M-  ( -- (1)-    -- (2)-    Either, -- (3)-    (<<<),-    (>>>),+  ( Either, -- (3)+    (<<<), -- (2)+    (>>>), -- (1)   )

@@ -0,0 +1,16 @@+{-# 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)

@@ -1,3 +1,6 @@ import Foo-import Foo (bar, foo)+import Foo+  ( bar,+    foo,+  ) import Foo as F

@@ -1,2 +1,5 @@ import "bar" Foo (bar)-import "foo" Foo (baz, foo)+import "foo" Foo+  ( baz,+    foo,+  )

@@ -1,2 +1,8 @@-import Foo hiding (bar4, foo2)-import qualified Foo (bar3, foo1)+import Foo hiding+  ( bar4,+    foo2,+  )+import qualified Foo+  ( bar3,+    foo1,+  )

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

@@ -1,5 +1,13 @@ import Data.Text-import Data.Text (a, b, c)-import Data.Text hiding (a, b, c)+import Data.Text+  ( a,+    b,+    c,+  )+import Data.Text hiding+  ( a,+    b,+    c,+  ) import qualified Data.Text (a, b, c) import qualified Data.Text as T

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

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

@@ -1,1 +1,3 @@+-- \|+-- module Test where

@@ -0,0 +1,5 @@+checkPragma =+  ifM+    (anyM isBuiltin [builtinNat, builtinBool])+    {-then-} ok+    {-else-} notPostulate

@@ -0,0 +1,4 @@+checkPragma =+        ifM (anyM isBuiltin [builtinNat, builtinBool])+          {-then-} ok+          {-else-} notPostulate

@@ -0,0 +1,6 @@+eeExtensions =+  catMaybes+    [ {- 0x00 -} sniExt,+      {- 0x0a -} groupExt,+      {- 0x10 -} alpnExt+    ]

@@ -0,0 +1,6 @@+eeExtensions =+    catMaybes+        [ {- 0x00 -} sniExt+        , {- 0x0a -} groupExt+        , {- 0x10 -} alpnExt+        ]

@@ -0,0 +1,9 @@+{-# LANGUAGE QuasiQuotes #-}++example =+  [ -- A+    [u||], -- B+    -- C+    [u||] -- D+    -- E+  ] -- F

@@ -0,0 +1,9 @@+{-# LANGUAGE QuasiQuotes #-}++example =+  [ -- A+    [u||], -- B+    -- C+    [u||] -- D+    -- E+  ] -- F

@@ -0,0 +1,3 @@+{- ***+   aaa+-}

@@ -0,0 +1,3 @@+{- ***+   aaa+-}

@@ -1,6 +1,6 @@ module Main (main) where --- | Foo.+{- | Foo. -}  -- Bar main :: IO ()

@@ -0,0 +1,9 @@+tests_Cli_Utils =+  testGroup+    "Utils"+    [++    --  testGroup "journalApplyValue" [+    --    testCase "time" $ do+    --  ]+    ]

@@ -0,0 +1,6 @@+tests_Cli_Utils = testGroup "Utils" [++  --  testGroup "journalApplyValue" [+  --    testCase "time" $ do+  --  ]+  ]

@@ -0,0 +1,11 @@+module Hledger.Cli.Commands where++commandsList :: String -> [String] -> [String]+commandsList progversion othercmds =+  map (bold' . accent) _banner_smslant+    ++ [ -- XXX not showing bold, why ?+         -- Keep the following synced with:+         --  commands.m4+         "----------",+         progversion+       ]

@@ -0,0 +1,11 @@+module Hledger.Cli.Commands where++commandsList :: String -> [String] -> [String]+commandsList progversion othercmds =+  map (bold' . accent) _banner_smslant ++   -- XXX not showing bold, why ?+  [+  -- Keep the following synced with:+  --  commands.m4+   "----------"+  ,progversion+  ]

@@ -1,17 +1,20 @@--- |--- Module:      Data.Aeson.TH--- Copyright:   (c) 2011-2016 Bryan O'Sullivan---              (c) 2011 MailRank, Inc.--- License:     BSD3--- Stability:   experimental--- Portability: portable+{-|+Module:      Data.Aeson.TH+Copyright:   (c) 2011-2016 Bryan O'Sullivan+             (c) 2011 MailRank, Inc.+License:     BSD3+Stability:   experimental+Portability: portable+-} module Main where --- |------ Here is a snippet:------ @--- x = y + 2--- @+{- |++Here is a snippet:++@+x = y + 2+@++-} x = y + 2

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

@@ -0,0 +1,15 @@+-- Excessive backslashes in multi line:+{-+*+|+-}++test = do+  -- Maybe excessive in single line:+  -- \* (if there's nothing after the * the line is completely dropped)+  line1+  -- Maybe excessive in multi line:+  {- \| is this excessive?+  * no excessive here at least+  -}+  line2

@@ -0,0 +1,15 @@+-- Excessive backslashes in multi line:+{-+*+|+-}++test = do+  -- Maybe excessive in single line:+  -- * (if there's nothing after the * the line is completely dropped)+  line1+  -- Maybe excessive in multi line:+  {- | is this excessive?+  * no excessive here at least+  -}+  line2

@@ -2,7 +2,8 @@ newNames =   let (*) = flip (,)    in [ "Control" * "Monad"-  -- Foo -  -- Bar+      -- Foo++      -- Bar       ]

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

@@ -1,9 +1,13 @@+-- \| module Test-  ( test,+  ( -- \|+    test,   ) where +-- \| test ::+  -- \|   test -data T = T+data T = T {- \^ -}

@@ -1,5 +1,3 @@ {-# LANGUAGE TemplateHaskell #-} -foo = foo---- \|# ${+foo = foo -- \|# ${

@@ -0,0 +1,19 @@+module Plugin.Data.Spec where++{-+foo bar boz+-}+monoConstructor :: Int+monoConstructor = 1++-- hello world++-- | A type of rose trees with empty leaves.+data EmptyRose = EmptyRose [EmptyRose]++-- This seems to cause issue+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}++-- bob alice eve+f :: ()+f = ()

@@ -0,0 +1,18 @@+module Plugin.Data.Spec where++{-+foo bar boz+-}+monoConstructor :: Int+monoConstructor = 1++-- hello world+-- | A type of rose trees with empty leaves.+data EmptyRose = EmptyRose [EmptyRose]++-- This seems to cause issue+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}++-- bob alice eve+f :: ()+f = ()

@@ -0,0 +1,5 @@+-- comment+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}++module Foo where

@@ -0,0 +1,4 @@+-- comment+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}++module Foo where

binary file changed (989821 → 1243493 bytes)

@@ -1,199 +1,225 @@-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.9.0.0+license: BSD-3-Clause+license-file: LICENSE.md+maintainer: Mark Karpov <markkarpov92@gmail.com>+tested-with:+  ghc ==9.10.3+  ghc ==9.12.4+  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.Comments.Anchor+    Ormolu.Comments.Invariants+    Ormolu.Comments.Tree+    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.CommentPlacement+    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.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+      -haddock+      -Winvalid-haddock+  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+      -haddock+      -Winvalid-haddock+  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.Comments.AnchorSpec+    Ormolu.Diff.TextSpec+    Ormolu.Fixity.ParserSpec+    Ormolu.Fixity.PrinterSpec+    Ormolu.FixitySpec+    Ormolu.OpTreeSpec+    Ormolu.Parser.OptionsSpec+    Ormolu.Parser.ParseFailureSpec+    Ormolu.Parser.PragmaSpec+    Ormolu.PrinterSpec+    Ormolu.TestConfig -    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+      -haddock+      -Winvalid-haddock+  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,

@@ -2,7 +2,7 @@ {-# LANGUAGE RecordWildCards #-}  -- | A formatter for Haskell source code. This module exposes the official--- stable API, other modules may be not as reliable.+-- stable API; other modules may not be as reliable. module Ormolu   ( -- * Top-level formatting functions     ormolu,@@ -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@@ -48,9 +49,11 @@ import Data.Text.IO.Utf8 qualified as T.Utf8 import Debug.Trace import GHC.Driver.Errors.Types+import GHC.Hs (HsModule (..), locA) import GHC.Types.Error import GHC.Types.SrcLoc import GHC.Utils.Error+import Ormolu.Comments.Invariants import Ormolu.Config import Ormolu.Diff.ParseResult import Ormolu.Diff.Text@@ -67,12 +70,12 @@  -- | Format a 'Text'. ----- The function+-- The function: -----     * Needs 'IO' because some functions from GHC that are necessary to---       setup parsing context require 'IO'. There should be no visible---       side-effects though.---     * Takes file name just to use it in parse error messages.+--     * Needs 'IO' because some GHC functions that are necessary to set up+--       the parsing context require 'IO'. There should be no visible+--       side effects, though.+--     * Takes a file name only to use it in parse error messages. --     * Throws 'OrmoluException'. -- -- __NOTE__: The caller is responsible for setting the appropriate value in@@ -107,15 +110,41 @@         forM_ comments $ \(L loc comment) ->           traceM $ unwords ["*** COMMENT ***", showOutputable loc, show comment]       _ -> pure ()-  -- We're forcing 'formattedText' here because otherwise errors (such as-  -- messages about not-yet-supported functionality) will be thrown later-  -- 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+  -- We force 'formattedText' here because otherwise errors (such as+  -- messages about not-yet-supported functionality) would be thrown later,+  -- when we try to parse the rendered code back inside the GHC monad+  -- wrapper, which would lead to error messages presenting the exceptions+  -- as GHC bugs.+  let printed =+        printSnippetsWithPlacements (Choice.fromBool (cfgDebug cfg)) result0+      !formattedText = T.concat (fst <$> printed)+  -- Every comment of the input should come out exactly once, and in the+  -- order it went in. The AST check below does not cover this: it compares+  -- the comment streams as multisets, and the comments that travel with+  -- pragmas are not in the stream at all.+  unless (cfgUnsafe cfg) . liftIO $ do+    let violations =+          concat+            [ checkCommentInvariants+                (getLoc <$> inputComments r)+                (reorderableSpans (prParsedSource r))+                placements+            | (ParsedSnippet r, (_, placements)) <- result0 `zip` printed+            ]+        -- Imports are sorted and merged, so a comment attached to one of+        -- them may legitimately come out in a different order than it went+        -- in.+        reorderableSpans hsmod =+          [ spn+          | L l _ <- hsmodImports hsmod,+            Just spn <- [srcSpanToRealSrcSpan (locA l)]+          ]+    unless (null violations) $+      throwIO (OrmoluCommentInvariantsViolated path violations)   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.+    -- Parse the result of pretty-printing again and make sure that its AST+    -- is the same as the AST of the original snippet, modulo span+    -- positions.     (_, result1) <-       parseModule'         cfg@@ -138,7 +167,8 @@     -- 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)@@ -175,11 +205,11 @@ ormoluStdin cfg =   liftIO T.Utf8.getContents >>= ormolu cfg "<stdin>" --- | Refine a 'Config' by incorporating given 'SourceType', 'CabalInfo', and--- fixity overrides 'FixityMap'. You can use 'detectSourceType' to deduce--- 'SourceType' based on the file extension,--- 'CabalUtils.getCabalInfoForSourceFile' to obtain 'CabalInfo' and--- 'getFixityOverridesForSourceFile' for 'FixityMap'.+-- | Refine a 'Config' by incorporating the given 'SourceType', 'CabalInfo',+-- and fixity overrides 'FixityMap'. You can use 'detectSourceType' to deduce+-- the 'SourceType' from the file extension,+-- 'CabalUtils.getCabalInfoForSourceFile' to obtain the 'CabalInfo', and+-- 'getFixityOverridesForSourceFile' for the 'FixityMap'. -- -- @since 0.5.3.0 refineConfig ::

@@ -0,0 +1,326 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Positional comment attachment.+--+-- This module decides who owns a comment from where it sits in the source,+-- once, before anything is printed. The answer therefore does not depend on+-- the order in which the printer visits elements, which is what made+-- reordered imports and reassociated operator trees lose comments before.+--+-- The rule is short enough to state in full. Find the element that encloses+-- the comment most tightly. Within that element, find which gap between its+-- children the comment falls into. Then:+--+--   * a comment that starts on the line where the preceding sibling ends+--     trails that sibling;+--   * otherwise, if a sibling follows, the comment goes before it;+--   * otherwise the comment trails the last sibling;+--   * an element with no children at all owns the comment outright.+module Ormolu.Comments.Anchor+  ( CommentAnchor (..),+    attachComments,+    anchorFor,++    -- * Using the anchors while printing+    AnchorMap,+    mkAnchorMap,+    noComments,+    claimBefore,+    commentsBefore,+    claimTrailing,+    claimRemaining,+    pendingComments,+    commentsAnchoredWithin,+  )+where++import Data.List (find, sortOn)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (listToMaybe)+import Data.Set qualified as Set+import GHC.Types.SrcLoc+import Ormolu.Comments.Tree+import Ormolu.Parser.CommentStream++-- | Where a comment belongs.+data CommentAnchor+  = -- | On its own line(s) above the element+    AnchorBefore RealSrcSpan+  | -- | After the element, either on the same line or below it+    AnchorTrailing RealSrcSpan+  | -- | Inside the element, which has no children of its own+    AnchorInside RealSrcSpan+  | -- | Not inside anything: the comment belongs to the module+    AnchorModule+  deriving (Eq, Show)++-- | Attach every comment of a module.+attachComments ::+  -- | Comments, in source order+  [LComment] ->+  -- | Spans of all \"located\" elements of the module+  [RealSrcSpan] ->+  [(LComment, CommentAnchor)]+attachComments comments eltSpans =+  joinBlocks eltSpans [(c, anchorFor forest c) | c <- comments]+  where+    forest = mkSpanForest eltSpans++-- | Make a run of comment lines share one anchor.+--+-- Consecutive lines with nothing but comment between them are one block as+-- far as the reader is concerned, so splitting them across two elements+-- would tear the block apart. The first line decides where the whole block+-- goes.+joinBlocks ::+  -- | Spans of all elements, used to tell whether one stands between two+  -- comments+  [RealSrcSpan] ->+  [(LComment, CommentAnchor)] ->+  [(LComment, CommentAnchor)]+joinBlocks eltSpans = go Nothing+  where+    -- Only the start positions matter below, and only whether one of them+    -- falls in a range, so they are held as a set: this runs for every+    -- comment and scanning the module's spans each time is quadratic.+    eltStarts = Set.fromList (realSrcSpanStart <$> eltSpans)++    go _ [] = []+    go previous ((c@(L spn theComment), anchor) : rest) =+      let anchor' = case previous of+            Just (prevSpn, prevAnchor)+              | continues prevSpn -> prevAnchor+            _ -> anchor+          continues prevSpn =+            not (hasAtomsBefore theComment)+              && srcSpanEndLine prevSpn + 1 == srcSpanStartLine spn+              && not (elementBetween prevSpn spn)+       in (c, anchor') : go (Just (spn, anchor')) rest++    -- Consecutive lines are not one block if an element begins between+    -- them. @{- 0x00 -} sniExt@ followed by @{- 0x0a -} groupExt@ is two+    -- blocks, each leading its own element, not one block of two lines. It+    -- is enough for the element to *start* in the gap: in @f $ {-else-} do@+    -- the @do@ block opens on the first comment's line and runs well past+    -- the second, and the comment on the next line belongs inside it rather+    -- than to the block above.+    elementBetween from to =+      case Set.lookupGE (realSrcSpanEnd from) eltStarts of+        Just s -> s <= realSrcSpanStart to+        Nothing -> False++-- | Attach a single comment to the forest of element spans.+anchorFor :: [SpanTree] -> LComment -> CommentAnchor+anchorFor forest (L comment theComment) = go Nothing Nothing forest+  where+    go enclosing outerTrailing trees =+      case find (\t -> stSpan t `containsSpan` comment) trees of+        -- Descend into the element that encloses the comment, so that the+        -- anchor is always as tight as the source allows. Carry down the+        -- code this level has already put on the comment's line: an element+        -- that opens on that line, such as the right-hand side in @f x = --+        -- c@, has nothing of its own before the comment, but the comment+        -- still trails the @x@ one level up.+        --+        -- Only an element that wraps a single thing may carry it. One with+        -- several children is a list of items, and a comment written at the+        -- head of such a list introduces the items rather than trailing+        -- what stands before the bracket. In+        --+        -- > xs ++ [ -- why?+        -- >   a, b ]+        --+        -- the comment must stay inside the brackets; carrying it up would+        -- pull it, and the block of comment lines below it, out of the list.+        Just t+          | [_] <- stChildren t -> go (Just (stSpan t)) trailingHere (stChildren t)+          | otherwise -> go (Just (stSpan t)) Nothing (stChildren t)+        Nothing -> case (precedingSibling, followingSibling) of+          (Just p, _)+            | trailsCodeOn (stSpan p) -> AnchorTrailing (innermostEndingOnLine p)+          -- A comment with an element right after it on the same line and+          -- nothing of its own before it leads that element: a run of @{-+          -- 0x00 -} sniExt@ must not be read as trailing whatever comes+          -- before and pile up in one place. This outranks the code carried+          -- down from an outer level, so that the @{-a-}@ of @x = ({-a-} b,+          -- c)@ stays with @b@ rather than being pulled out to trail the+          -- @x@.+          (_, Just n)+            | startsOnCommentLine (stSpan n) -> AnchorBefore (stSpan n)+          -- Nothing at this level stands before the comment, but an outer+          -- level put code on its line: the comment trails that code. This+          -- is what keeps @f x = -- c@ on one line, the right-hand side+          -- having opened on that line with the comment as its first+          -- content.+          --+          -- Only a line comment may do this. It runs to the end of the line+          -- either way, so trailing an element one level up still renders+          -- it exactly where it was written. A block comment renders in+          -- place instead, and would end up ahead of the tokens that opened+          -- the element it was written inside: the pragma of @corebar = {-#+          -- CORE "bar baz" #-}@ would move before the @=@.+          (Nothing, _)+            | not (isMultilineComment theComment),+              Just p <- outerTrailing ->+                AnchorTrailing (innermostEndingOnLine p)+          (_, Just n) -> AnchorBefore (stSpan n)+          -- A comment after the last child of an element belongs to that+          -- element, but a comment after everything at the top level+          -- belongs to the module: there is nothing it can trail without+          -- being rendered before syntax that preceded it in the input,+          -- such as the @where@ of a module header.+          (Just p, Nothing)+            | Just _ <- enclosing -> AnchorTrailing (stSpan p)+            | otherwise -> AnchorModule+          (Nothing, Nothing) -> maybe AnchorModule AnchorInside enclosing+          where+            followingSibling =+              listToMaybe+                [ t+                | t <- trees,+                  realSrcSpanStart (stSpan t) >= realSrcSpanEnd comment+                ]+            startsOnCommentLine s =+              srcSpanStartLine s == srcSpanEndLine comment+      where+        precedingSibling =+          lastMaybe+            [ t+            | t <- trees,+              realSrcSpanEnd (stSpan t) <= realSrcSpanStart comment+            ]+        trailingHere = case precedingSibling of+          Just p | trailsCodeOn (stSpan p) -> Just p+          _ -> outerTrailing++    -- A comment only trails an element when it really does sit after code+    -- on that line. Checking the line alone is not enough, because the AST+    -- has zero-width spans that happen to share a line with a comment while+    -- standing before it.+    trailsCodeOn s =+      srcSpanEndLine s == srcSpanStartLine comment+        && hasAtomsBefore theComment++    -- A comment that trails a bracketed construct belongs to the innermost+    -- element that ends on its line, not to the bracket: @(x + y) -- c@+    -- attaches to @y@, so that the comment is rendered next to the+    -- expression it was written next to rather than after the closing+    -- bracket.+    innermostEndingOnLine t =+      case lastMaybe (filter (trailsCodeOn . stSpan) (stChildren t)) of+        Nothing -> stSpan t+        Just t' -> innermostEndingOnLine t'++    lastMaybe xs = if null xs then Nothing else Just (last xs)++----------------------------------------------------------------------------+-- Using the anchors while printing++-- | Anchored comments, arranged so that the printer can look them up by the+-- span of the element it is entering or leaving.+--+-- Comments are claimed rather than consumed: the first element with a given+-- span takes them, and every later element with the same span finds+-- nothing. Since several AST nodes routinely share a span, and the printer+-- enters them outermost first, this gives the comment to the outermost of+-- them, which is what one wants—a comment belongs outside the parentheses,+-- not inside them.+data AnchorMap = AnchorMap+  { amBefore :: Map RealSrcSpan [LComment],+    amTrailing :: Map RealSrcSpan [LComment],+    amModule :: [LComment]+  }++-- | An empty map, for the first of the two rendering passes: it collects+-- the spans of the elements the printer enters, and emits no comments.+noComments :: AnchorMap+noComments =+  AnchorMap {amBefore = Map.empty, amTrailing = Map.empty, amModule = []}++-- | Arrange anchored comments for lookup.+--+-- __NOTE__: 'AnchorInside' is currently folded into 'AnchorTrailing'. Doing+-- it properly needs a combinator for elements that can have no children at+-- all.+mkAnchorMap :: [(LComment, CommentAnchor)] -> AnchorMap+mkAnchorMap anchored =+  AnchorMap+    { amBefore = collect [(spn, c) | (c, AnchorBefore spn) <- anchored],+      amTrailing =+        collect $+          [(spn, c) | (c, AnchorTrailing spn) <- anchored]+            <> [(spn, c) | (c, AnchorInside spn) <- anchored],+      amModule = [c | (c, AnchorModule) <- anchored]+    }+  where+    collect = Map.fromListWith (flip (<>)) . fmap (fmap pure)++-- | The comments that go before the element with the given span, without+-- claiming them.+commentsBefore :: RealSrcSpan -> AnchorMap -> [LComment]+commentsBefore spn = Map.findWithDefault [] spn . amBefore++-- | Claim the comments that go before the element with the given span.+claimBefore :: RealSrcSpan -> AnchorMap -> ([LComment], AnchorMap)+claimBefore spn am =+  case Map.lookup spn (amBefore am) of+    Nothing -> ([], am)+    Just cs -> (cs, am {amBefore = Map.delete spn (amBefore am)})++-- | Claim the comments that go after the element with the given span.+claimTrailing :: RealSrcSpan -> AnchorMap -> ([LComment], AnchorMap)+claimTrailing spn am =+  case Map.lookup spn (amTrailing am) of+    Nothing -> ([], am)+    Just cs -> (cs, am {amTrailing = Map.delete spn (amTrailing am)})++-- | Claim everything that is left: the comments that belong to no element,+-- plus anything that was anchored to an element the printer never entered.+claimRemaining :: AnchorMap -> ([LComment], AnchorMap)+claimRemaining am =+  ( pendingComments am,+    AnchorMap {amBefore = Map.empty, amTrailing = Map.empty, amModule = []}+  )++-- | The comments anchored to the element at the given span, or to any+-- element inside it.+--+-- This is the question the layout decision needs to ask. "Which comments+-- are contained in this element" is a different and much coarser one: a+-- comment anywhere in a declaration is contained in it, but is attached to+-- one particular element, and only that element's layout should have to+-- account for it. This runs for every element the printer enters, so it+-- must not walk the whole map. Anchors are 'RealSrcSpan's ordered by start+-- position, and all of a module's spans share a file, so the anchors that+-- could be contained in the region are the contiguous run whose start lies+-- within it. Cutting the map down to that run first makes the cost+-- proportional to the size of the region rather than to the number of+-- comments in the module.+commentsAnchoredWithin :: RealSrcSpan -> AnchorMap -> [LComment]+commentsAnchoredWithin region AnchorMap {..} =+  sortOn getLoc . concat $+    within amBefore <> within amTrailing+  where+    within =+      Map.elems+        . Map.filterWithKey (\anchor _ -> region `containsSpan` anchor)+        . startingWithin++    -- Antitone in map order: as keys ascend their start position never+    -- decreases, so each predicate holds on a prefix and then stops.+    startingWithin =+      fst+        . Map.spanAntitone ((<= realSrcSpanEnd region) . realSrcSpanStart)+        . snd+        . Map.spanAntitone ((< realSrcSpanStart region) . realSrcSpanStart)++-- | Every comment that has not been emitted yet, in source order.+pendingComments :: AnchorMap -> [LComment]+pendingComments AnchorMap {..} =+  sortOn getLoc $+    amModule+      <> concat (Map.elems amBefore)+      <> concat (Map.elems amTrailing)

@@ -0,0 +1,135 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Properties that comment handling has to satisfy, and the check that+-- enforces them.+--+-- Every comment of the input should come out exactly once, and in the order+-- it went in. The check runs on every run of Ormolu, alongside the check+-- that the AST is unchanged, and is disabled by the same @--unsafe@ flag.+--+-- This is the half of comment checking that works on where the comments went+-- rather than on what they say. It compares the /spans/ of the comments a+-- module started with against the spans recorded as the printer emitted+-- them, so it can name the comment that was dropped, duplicated, invented+-- or moved.+--+-- It does /not/ look at the text of a comment at all: rendering one with+-- its contents mangled would pass. That is the other half, and it belongs+-- to 'Ormolu.Diff.ParseResult.diffCommentStream', which compares text and+-- ignores position. Neither check subsumes the other and both run by+-- default.+--+-- Haddocks are outside both halves. GHC's parser makes them part of the AST+-- rather than leaving them in the comment stream, so they are neither among+-- the comments a module started with nor in what the text check compares.+-- Losing or duplicating one changes the AST itself, and that is caught by+-- the third check, 'Ormolu.Diff.ParseResult.diffParseResult' comparing the+-- two syntax trees.+module Ormolu.Comments.Invariants+  ( InvariantViolation (..),+    checkCommentInvariants,+    renderInvariantViolation,+  )+where++import Data.List (sort)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Types.SrcLoc+import Ormolu.Printer.CommentPlacement++-- | A way in which the emitted comments failed to correspond to the+-- comments of the input.+data InvariantViolation+  = -- | A comment of the input was never emitted+    CommentDropped RealSrcSpan+  | -- | A comment was emitted more than once, the given number of times+    CommentDuplicated RealSrcSpan Int+  | -- | A comment was emitted that does not correspond to any comment of+    -- the input+    CommentInvented RealSrcSpan+  | -- | A comment was emitted after one that comes later in the input. The+    -- first span is the comment that was emitted too late, the second is+    -- the one it should have preceded.+    CommentReordered RealSrcSpan RealSrcSpan+  deriving (Eq, Show)++-- | Compare the comments of a snippet against the comments that were+-- emitted while rendering it.+checkCommentInvariants ::+  -- | Spans of all the comments the snippet started with+  [RealSrcSpan] ->+  -- | Spans of the elements the formatter is allowed to reorder, so that+  -- the comments travelling with them are exempt from the order check+  [RealSrcSpan] ->+  -- | Placements recorded while rendering it, in the order of emission+  [CommentPlacement] ->+  [InvariantViolation]+checkCommentInvariants inputSpans reorderable placements =+  dropped <> duplicated <> invented <> reordered+  where+    emitted = cpSpan <$> placements+    -- Pragmas and imports are deliberately sorted and the comments attached+    -- to them travel along, so the order they come out in says nothing.+    -- They are still expected to come out exactly once, which is what+    -- catches a comment being duplicated.+    ordered =+      [ spn+      | CommentPlacement {cpSpan = spn, cpSlot} <- placements,+        cpSlot /= SlotPragma,+        not (travelsWithAReorderedElement cpSlot)+      ]+    travelsWithAReorderedElement slot = case slotAnchor slot of+      Nothing -> False+      Just anchor -> any (`containsSpan` anchor) reorderable+    inputSet = Map.fromList ((,()) <$> inputSpans)+    counts = Map.fromListWith (+) ((,1 :: Int) <$> emitted)++    dropped =+      [CommentDropped spn | spn <- sort inputSpans, not (spn `Map.member` counts)]+    duplicated =+      [ CommentDuplicated spn n+      | (spn, n) <- Map.toAscList counts,+        n > 1+      ]+    invented =+      [ CommentInvented spn+      | spn <- Map.keys counts,+        not (spn `Map.member` inputSet)+      ]++    -- Only the first emission of each comment is considered, so that a+    -- comment reported as duplicated is not also reported as reordered.+    reordered = go [] (dedupe [] ordered)+      where+        dedupe _ [] = []+        dedupe seen (x : xs)+          | x `elem` seen = dedupe seen xs+          | otherwise = x : dedupe (x : seen) xs+        go _ [] = []+        go seen (x : xs) =+          [CommentReordered x y | y <- seen, x < y]+            <> go (x : seen) xs++-- | Render a violation as a single line.+renderInvariantViolation :: InvariantViolation -> Text+renderInvariantViolation = \case+  CommentDropped spn ->+    "dropped     " <> renderSpan spn+  CommentDuplicated spn n ->+    "duplicated  " <> renderSpan spn <> " (emitted " <> showT n <> " times)"+  CommentInvented spn ->+    "invented    " <> renderSpan spn+  CommentReordered spn before ->+    "reordered   " <> renderSpan spn <> " (emitted after " <> renderSpan before <> ")"++renderSpan :: RealSrcSpan -> Text+renderSpan spn =+  renderLoc (realSrcSpanStart spn) <> "-" <> renderLoc (realSrcSpanEnd spn)+  where+    renderLoc l = showT (srcLocLine l) <> ":" <> showT (srcLocCol l)++showT :: (Show a) => a -> Text+showT = T.pack . show

@@ -0,0 +1,74 @@+-- | The containment tree of AST element spans.+--+-- This is the structure "Ormolu.Comments.Anchor" reads to place a comment:+-- given a comment, which element encloses it most tightly, and which of+-- that element's children does it fall between. Arranging the spans by+-- containment is what makes those questions answerable from position alone,+-- without reference to the order in which the printer visits anything.+module Ormolu.Comments.Tree+  ( SpanTree (..),+    mkSpanForest,+    countNodes,+  )+where++import Data.List (sortOn)+import Data.Ord (Down (..))+import GHC.Types.SrcLoc++-- | An element span together with the element spans it encloses. Children+-- are in ascending order and do not overlap each other.+data SpanTree = SpanTree+  { stSpan :: RealSrcSpan,+    stChildren :: [SpanTree]+  }+  deriving (Eq, Show)++-- | Arrange spans into a forest by containment.+--+-- Duplicates are dropped: several AST nodes routinely share one span (a+-- wrapper and the thing it wraps, say), and for the purpose of owning a+-- comment they are one element. Spans that overlap another without being+-- contained in it are dropped too—the GHC AST does produce such spans+-- occasionally, and they cannot be placed in a tree.+--+-- Zero-width spans are kept. An empty bracketed construct—an export or+-- import list, @[]@, a record with no fields—contains no element at all, so+-- the printer enters a zero-width one at its opening bracket+-- ('Ormolu.Printer.Combinators.locatedEmpty') to give a comment written+-- between the brackets something to attach to.+mkSpanForest :: [RealSrcSpan] -> [SpanTree]+mkSpanForest = goForest . dedupe . sortOn nestingOrder+  where+    -- Outermost first, so that a span is always seen before the spans it+    -- contains.+    nestingOrder s = (realSrcSpanStart s, Down (realSrcSpanEnd s))++    dedupe (x : y : rest) | x == y = dedupe (y : rest)+    dedupe (x : rest) = x : dedupe rest+    dedupe [] = []++    goForest [] = []+    goForest (s : rest) =+      let (children, rest') = goChildren s rest+       in SpanTree s children : goForest rest'++    goChildren parent = go []+      where+        go acc [] = (reverse acc, [])+        go acc (s : rest)+          | parent `containsSpan` s =+              let (children, rest') = goChildren s rest+               in go (SpanTree s children : acc) rest'+          | realSrcSpanStart s < realSrcSpanEnd parent =+              -- Overlaps the parent without being contained in it; there is+              -- no correct place for it, so leave it out.+              go acc rest+          | otherwise = (reverse acc, s : rest)++-- | How many elements the forest holds. Used by the tests to check that+-- duplicate and overlapping spans are dropped.+countNodes :: [SpanTree] -> Int+countNodes = sum . fmap node+  where+    node t = 1 + countNodes (stChildren t)

@@ -39,7 +39,8 @@     cfgDynOptions :: ![DynOption],     -- | Fixity overrides     cfgFixityOverrides :: !FixityOverrides,-    -- | Module reexports to take into account when doing fixity resolution+    -- | Module re-exports to take into account when performing fixity+    -- resolution     cfgModuleReexports :: !ModuleReexports,     -- | Known dependencies, if any     cfgDependencies :: !(Set PackageName),@@ -47,9 +48,9 @@     cfgUnsafe :: !Bool,     -- | Output information useful for debugging     cfgDebug :: !Bool,-    -- | Checks if re-formatting the result is idempotent+    -- | Check that re-formatting the result is idempotent     cfgCheckIdempotence :: !Bool,-    -- | How to parse the input (regular haskell module or Backpack file)+    -- | How to parse the input (a regular Haskell module or a Backpack file)     cfgSourceType :: !SourceType,     -- | Whether to use colors and other features of ANSI terminals     cfgColorMode :: !ColorMode,

@@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeepSubsumption #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} @@ -7,19 +9,25 @@ module Ormolu.Diff.ParseResult   ( ParseResultDiff (..),     diffParseResult,+    diffCommentStream,   ) where  import Data.ByteString (ByteString)+import Data.Char (isSpace) import Data.Foldable import Data.Function import Data.Generics+import Data.List (sort)+import Data.Text qualified as T+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@@ -37,7 +45,12 @@ instance Monoid ParseResultDiff where   mempty = Same --- | Return 'Diff' of two 'ParseResult's.+-- | Compare the parse result of the input against that of the output.+--+-- Two of Ormolu's three comment checks live here: 'diffCommentStream' for+-- the text of the comments, and the syntax tree comparison for the+-- Haddocks, which are part of the tree rather than of the comment stream.+-- The third, "Ormolu.Comments.Invariants", checks where the comments went. diffParseResult ::   ParseResult ->   ParseResult ->@@ -54,23 +67,38 @@     diffCommentStream cstream0 cstream1       <> diffHsModule hs0 hs1 +-- | Check that formatting did not change the /text/ of any comment.+--+-- This is the half of comment checking that works on what the comments say+-- rather than on where they went. Ormolu edits comment text on purpose—it+-- escapes Haddock triggers, re-indents block comments and normalizes the+-- spacing after a trigger—and both sides of this comparison have been+-- through 'Ormolu.Parser.CommentStream.mkCommentStream', so the intended+-- edits cancel out and only unintended ones show up.+--+-- What it deliberately does /not/ check:+--+--   * __order__, because Ormolu sorts imports, import lists and pragmas,+--     and a comment attached to one of those travels with it;+--   * __which comment is which__, since the lines are compared as a+--     multiset; a failure cannot say more than that the two sides differ,+--     which is why 'Different' is returned with no spans;+--   * __comments outside the stream__ — the Stack header and the comments+--     that travel with pragmas are lifted out of it during parsing, so+--     duplicating one of those is invisible here.+--+-- All three are covered by "Ormolu.Comments.Invariants", which compares+-- spans instead of text. Neither check subsumes the other and both run by+-- default. diffCommentStream :: CommentStream -> CommentStream -> ParseResultDiff diffCommentStream (CommentStream cs) (CommentStream cs')   | commentLines cs == commentLines cs' = Same   | otherwise = Different []   where-    commentLines = concatMap (toList . unComment . unLoc)+    commentLines = sort . 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 +111,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,14 +186,37 @@     epAnnEq :: EpAnn a -> b -> ParseResultDiff     epAnnEq _ _ = Same +    importDeclQualifiedStyleEq :: forall a. (Data a) => ImportDeclQualifiedStyle -> a -> ParseResultDiff     importDeclQualifiedStyleEq = considerEqualVia' f       where         f QualifiedPre QualifiedPost = True         f QualifiedPost QualifiedPre = True         f x x' = x == x' +    -- Documentation is compared up to the normalizations Ormolu performs+    -- on it: the space it puts after a Haddock's trigger, the+    -- re-indentation it gives a @{- | … -}@ so that the comment lines up+    -- with the code it documents, and the collapsing of consecutive blank+    -- lines. All three change the doc string GHC parses back out, and all+    -- three are intended.     hsDocStringEq :: HsDocString -> GenericQ ParseResultDiff-    hsDocStringEq = considerEqualVia' ((==) `on` splitDocString)+    hsDocStringEq =+      considerEqualVia' ((==) `on` (collapseBlanks . dedent . splitDocString))+      where+        -- The printer emits at most one blank line in a row, as it does for+        -- ordinary comments.+        collapseBlanks = \case+          (x : y : rest)+            | T.null x, T.null y -> collapseBlanks (y : rest)+          (x : rest) -> x : collapseBlanks rest+          [] -> []+        dedent = \case+          [] -> []+          (x : xs) ->+            let indentOf l = T.length (T.takeWhile (== ' ') l)+                indents = indentOf <$> filter (not . T.all isSpace) xs+                n = if null indents then 0 else minimum indents+             in x : fmap (T.drop n) xs      forLocated ::       (Data e0, Data e1) =>

@@ -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@@ -260,7 +256,7 @@       hunkDiff = mapDiff (fmap third) xs   return Hunk {..} --- | Trim empty “both” lines from beginning and end of a 'DiffList''.+-- | Trim empty “both” lines from the beginning and end of a 'DiffList''. trimEmpty :: DiffList' -> DiffList' trimEmpty = go True id   where

@@ -19,6 +19,7 @@ import Data.Void (Void) import Distribution.Parsec.Error (PError, showPError) import GHC.Types.SrcLoc+import Ormolu.Comments.Invariants (InvariantViolation, renderInvariantViolation) import Ormolu.Diff.Text (TextDiff, printTextDiff) import Ormolu.Terminal import Ormolu.Terminal.QualifiedDo qualified as Term@@ -36,6 +37,9 @@     OrmoluASTDiffers TextDiff [RealSrcSpan]   | -- | Formatted source code is not idempotent     OrmoluNonIdempotentOutput TextDiff+  | -- | The comments that came out do not correspond to the comments that+    -- went in+    OrmoluCommentInvariantsViolated FilePath [InvariantViolation]   | -- | Some GHC options were not recognized     OrmoluUnrecognizedOpts (NonEmpty String)   | -- | Cabal file parsing failed@@ -91,6 +95,22 @@     newline     put "  Please, consider reporting the bug."     newline+  OrmoluCommentInvariantsViolated path violations -> Term.do+    put (T.pack path)+    newline+    for_ violations $ \violation -> Term.do+      put "  "+      put (renderInvariantViolation violation)+      newline+    newline+    put "  The comments of the output do not correspond to the comments of"+    newline+    put "  the input."+    newline+    put "  Please, consider reporting the bug."+    newline+    put "  To format anyway, use --unsafe."+    newline   OrmoluUnrecognizedOpts opts -> Term.do     put "The following GHC options were not recognized:"     newline@@ -106,13 +126,13 @@   OrmoluMissingStdinInputFile -> Term.do     put "The --stdin-input-file option is necessary when using input"     newline-    put "from stdin and accounting for .cabal files"+    put "from stdin and accounting for .cabal files."     newline   OrmoluFixityOverridesParseError errorBundle -> Term.do     put . T.pack . errorBundlePretty $ errorBundle     newline --- | Inside this wrapper 'OrmoluException' will be caught and displayed+-- | Inside this wrapper, 'OrmoluException' will be caught and displayed -- nicely. withPrettyOrmoluExceptions ::   -- | Color mode@@ -126,12 +146,13 @@       runTerm (printOrmoluException e) colorMode stderr       return . ExitFailure $         case e of-          -- Error code 1 is for 'error' or 'notImplemented'-          -- 2 used to be for erroring out on CPP+          -- Error code 1 is for 'error' or 'notImplemented'.+          -- 2 used to be for erroring out on CPP.           OrmoluParsingFailed {} -> 3           OrmoluOutputParsingFailed {} -> 4           OrmoluASTDiffers {} -> 5           OrmoluNonIdempotentOutput {} -> 6+          OrmoluCommentInvariantsViolated {} -> 11           OrmoluUnrecognizedOpts {} -> 7           OrmoluCabalFileParsingFailed {} -> 8           OrmoluMissingStdinInputFile {} -> 9

@@ -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,29 +46,14 @@ 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+-- | Default set of packages to assume as dependencies, e.g. when no Cabal -- file is found or taken into consideration. defaultDependencies :: Set PackageName defaultDependencies = Set.singleton (mkPackageName "base")

@@ -75,7 +75,7 @@   IEThingWith _ (L _ x) _ xs _ -> occName x : fmap (occName . unLoc) xs   _ -> [] --- | Apply given module re-exports.+-- | Apply the given module re-exports. applyModuleReexports :: ModuleReexports -> [FixityImport] -> [FixityImport] applyModuleReexports (ModuleReexports reexports) imports = imports >>= expand   where

@@ -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@@ -72,7 +74,7 @@  {-# COMPLETE OpName #-} --- | Convert an 'OccName to an 'OpName'.+-- | Convert an 'OccName' to an 'OpName'. occOpName :: OccName -> OpName occOpName = MkOpName . fs_sbs . occNameFS @@ -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@@ -114,18 +125,29 @@ data FixityApproximation = FixityApproximation   { -- | Fixity direction if it is known     faDirection :: Maybe FixityDirection,-    -- | Minimum precedence level found in the (maybe conflicting)+    -- | Minimum precedence level found in the (possibly conflicting)     -- definitions for the operator (inclusive)-    faMinPrecedence :: Int,-    -- | Maximum precedence level found in the (maybe conflicting)+    faMinPrecedence :: Double,+    -- | Maximum precedence level found in the (possibly conflicting)     -- definitions for the operator (inclusive)-    faMaxPrecedence :: Int+    faMaxPrecedence :: Double   }   deriving stock (Eq, Ord, Show, Generic)-  deriving anyclass (Binary, NFData) --- | Gives the ability to merge two (maybe conflicting) definitions for an--- operator, keeping the higher level of compatible information from both.+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 (possibly conflicting) definitions for+-- an operator, keeping the higher level of compatible information from both. instance Semigroup FixityApproximation where   FixityApproximation {faDirection = dir1, faMinPrecedence = min1, faMaxPrecedence = max1}     <> FixityApproximation {faDirection = dir2, faMinPrecedence = min2, faMaxPrecedence = max2} =@@ -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 {..}) =@@ -52,20 +55,41 @@   LImportDecl GhcPs ->   LImportDecl GhcPs ->   LImportDecl GhcPs-combineImports (L lx ImportDecl {..}) (L _ y) =-  L-    lx-    ImportDecl-      { ideclImportList = case (ideclImportList, GHC.ideclImportList y) of-          (Just (hiding, L l' xs), Just (_, L _ ys)) ->-            Just (hiding, (L l' (normalizeLies (xs ++ ys))))-          _ -> Nothing,-        ..-      }+combineImports x y =+  L widenedLoc earlier {ideclImportList = combinedImportList}+  where+    -- The merged declaration spans both of the ones it came from, so that+    -- it is laid out over several lines and a comment that was written+    -- between them has somewhere to go. Its own span would otherwise still+    -- describe a single line.+    widenedLoc =+      l {entry = EpaSpan (combineSrcSpans (locA (getLoc x)) (locA (getLoc y)))} --- | Import id, a collection of all things that justify having a separate--- import entry. This is used for merging of imports. If two imports have--- the same 'ImportId' they can be merged.+    -- Take the declaration that comes first in the source whole, rather+    -- than mixing the span of one with the contents of the other: a+    -- declaration whose span sits before its own module name or import+    -- list cannot be placed in a containment tree, which is what comment+    -- attachment needs.+    (L l earlier, L _ later)+      | startsFirst (locA (getLoc x)) (locA (getLoc y)) = (x, y)+      | otherwise = (y, x)+    combinedImportList =+      case (GHC.ideclImportList earlier, GHC.ideclImportList later) of+        (Just (hiding, L l' xs), Just (_, L _ ys)) ->+          Just (hiding, L l' (normalizeLies (xs ++ ys)))+        _ -> Nothing++-- | Does the first span start before the second? Spans without a real+-- location are treated as coming first, arbitrarily but consistently.+startsFirst :: SrcSpan -> SrcSpan -> Bool+startsFirst a b = case (srcSpanToRealSrcSpan a, srcSpanToRealSrcSpan b) of+  (Just a', Just b') -> realSrcSpanStart a' <= realSrcSpanStart b'+  (Nothing, _) -> True+  _ -> False++-- | An import id, a collection of all the things that justify having a+-- separate import entry. This is used for merging imports: if two imports+-- have the same 'ImportId', they can be merged. data ImportId = ImportId   { importIsPrelude :: Bool,     importPkgQual :: ImportPkgQual,@@ -74,10 +98,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 +145,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 +158,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 +198,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' _ ->@@ -205,17 +248,17 @@ compareLIewn :: LIEWrappedName GhcPs -> LIEWrappedName GhcPs -> Ordering compareLIewn = compareIewn `on` unLoc --- | Compare two @'IEWrapppedName' 'GhcPs'@ things.+-- | Compare two @'IEWrappedName' '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,20 +150,23 @@       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 "_"-            -- by the parser and the modified AST is propagated to the-            -- later stages; but we fail in those cases.+            -- Some malformed inputs (pattern/arrow syntax in an+            -- expression context) do not cause a parse error; instead the+            -- parser replaces them with "_" and propagates the modified AST+            -- to the later stages. We fail in those cases.             Just err -> Left err             Nothing ->-              let (stackHeader, pragmas, comments) =+              let (stackHeader, pragmas, comments, haddockText) =                     mkCommentStream input hsModule                in Right                     ParseResult@@ -164,6 +175,7 @@                         prStackHeader = stackHeader,                         prPragmas = pragmas,                         prCommentStream = comments,+                        prHaddockText = haddockText,                         prExtensions = GHC.extensionFlags dynFlags,                         prModuleFixityMap = modFixityMap,                         prIndent = indent@@ -172,13 +184,21 @@  -- | 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` dropBlankConDeclFieldHaddocks+        `extT` patchContext+        `extT` patchExprContext+    )     hsmod       { hsmodImports =-          normalizeImports (hsmodImports hsmod),+          normalizeImports implicitPrelude (hsmodImports hsmod),         hsmodDecls =           filter (not . isBlankDocD . unLoc) (hsmodDecls hsmod),         hsmodExt =@@ -202,6 +222,13 @@       L _ (HsDocTy _ ty s) :: LHsType GhcPs         | isBlankDocString s -> ty       a -> a+    -- A Haddock on a field that holds nothing but whitespace is dropped,+    -- the same way one on a constructor is. Without this, whether it+    -- survives depends on whether it happened to end in a space.+    dropBlankConDeclFieldHaddocks = \case+      CDF {cdf_doc = Just s, ..} :: HsConDeclField GhcPs+        | isBlankDocString s -> CDF {cdf_doc = Nothing, ..}+      a -> a     dropBlankDataDeclHaddocks = \case       ConDeclGADT {con_doc = Just s, ..} :: ConDecl GhcPs         | isBlankDocString s -> ConDeclGADT {con_doc = Nothing, ..}@@ -209,11 +236,18 @@         | isBlankDocString s -> ConDeclH98 {con_doc = Nothing, ..}       a -> a +    -- For constraint contexts (both in types and in expressions), normalize+    -- parentheses 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.@@ -224,7 +258,7 @@     allExts = [minBound .. maxBound]  -- | Extensions that are not enabled automatically and should be activated--- by user.+-- by the user. manualExts :: [Extension] manualExts =   [ Arrows, -- steals proc@@ -242,18 +276,19 @@     UnboxedSums,     UnicodeSyntax, -- gives special meanings to operators like (→)     TemplateHaskell, -- changes how $foo is parsed-    TemplateHaskellQuotes, -- enables TH subset of quasi-quotes, this+    TemplateHaskellQuotes, -- enables the TH subset of quasi-quotes, which     -- apparently interferes with QuasiQuotes in     -- weird ways     ImportQualifiedPost, -- affects how Ormolu renders imports, so the-    -- decision of enabling this style is left to the user+    -- decision to enable this style is left to the user     NegativeLiterals, -- with this, `- 1` and `-1` have differing AST     LexicalNegation, -- implies NegativeLiterals     LinearTypes, -- steals the (%) type operator in some cases     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 +329,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 +348,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 +371,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

@@ -2,11 +2,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} --- | Functions for working with comment stream.+-- | Functions for working with the comment stream. module Ormolu.Parser.CommentStream   ( -- * Comment stream     CommentStream (..),     mkCommentStream,+    HaddockText,      -- * Comment     LComment,@@ -17,10 +18,10 @@   ) where -import Control.Monad ((<=<)) import Data.Char (isSpace) import Data.Data (Data) import Data.Generics.Schemes+import Data.List qualified as L import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import Data.Map.Lazy qualified as M@@ -29,7 +30,7 @@ import Data.Text (Text) import Data.Text qualified as T import GHC.Data.Strict qualified as Strict-import GHC.Hs (HsModule)+import GHC.Hs (HsModule (..)) import GHC.Hs.Doc import GHC.Hs.Extension import GHC.Hs.ImpExp@@ -43,29 +44,63 @@ -- Comment stream  -- | A stream of 'RealLocated' 'Comment's in ascending order with respect to--- beginning of corresponding spans.+-- the beginning of the corresponding spans. newtype CommentStream = CommentStream [LComment]   deriving (Eq, Data, Semigroup, Monoid) --- | Create 'CommentStream' from 'HsModule'. The pragmas are--- removed from the 'CommentStream'.+-- | The source text of the Haddocks of a module, keyed by span.+--+-- Haddocks are printed from the text the author wrote rather than+-- reconstructed from the 'GHC.Hs.Doc.HsDocString' GHC parsed out of it.+-- Reconstruction cannot preserve everything — an empty @-- |@ vanishes, and+-- a @{- | … -}@ cannot come back as anything but @--@ lines — and what it+-- loses, it loses from the AST as well, which is why Ormolu refuses to+-- format some modules it should be able to.+type HaddockText = M.Map RealSrcSpan Comment++-- | Create a 'CommentStream' from an 'HsModule'. The pragmas are removed+-- from the 'CommentStream'. mkCommentStream ::   -- | Original input   Text ->   -- | Module to use for comment extraction   HsModule GhcPs ->-  -- | Stack header, pragmas, and comment stream+  -- | Stack header, pragmas, comment stream, and Haddock source text   ( Maybe LComment,     [([LComment], Pragma)],-    CommentStream+    CommentStream,+    HaddockText   ) mkCommentStream input hsModule =   ( mstackHeader,     pragmas,-    CommentStream comments+    CommentStream comments,+    haddockText   )   where-    (comments, pragmas) = extractPragmas input rawComments1+    -- The Haddocks are kept out of the comment stream, because they are+    -- printed from the AST, but their text is kept so that the printer can+    -- reproduce what the author wrote.+    haddockText =+      M.fromList+        [ (spn, mkHaddockComment (L spn (sliceSpan input spn)))+        | spn <- S.toList validHaddockCommentSpans+        ]++    (comments, pragmas) = extractPragmas input headerEnd rawComments1++    -- Where the file header stops and the module proper begins. Only+    -- pragmas before this point are hoisted and normalized; GHC reads the+    -- header and nothing else, so a pragma below it has no effect on+    -- compilation and moving it to the top would give it one.+    headerEnd =+      listToMaybe . L.sort $+        [ realSrcSpanStart spn+        | l <-+            (getLocA <$> hsmodImports hsModule)+              <> (getLocA <$> hsmodDecls hsModule),+          Just spn <- [srcSpanToRealSrcSpan l]+        ]     (rawComments1, mstackHeader) = extractStackHeader rawComments0      -- We want to extract all comments except _valid_ Haddock comments@@ -75,32 +110,33 @@         . flip M.withoutKeys validHaddockCommentSpans         . M.fromList         . fmap (\(L l a) -> (l, a))-        $ allComments+        $ allRawComments++    -- All comments, including valid and invalid Haddock comments+    allRawComments =+      mapMaybe (unAnnotationComment input) $+        epAnnCommentsToList =<< listify (only @EpAnnComments) hsModule       where-        -- All comments, including valid and invalid Haddock comments-        allComments =-          mapMaybe unAnnotationComment $-            epAnnCommentsToList =<< listify (only @EpAnnComments) hsModule-          where-            epAnnCommentsToList = \case-              EpaComments cs -> cs-              EpaCommentsBalanced pcs fcs -> pcs <> fcs-        -- All spans of valid Haddock comments-        validHaddockCommentSpans =-          S.fromList-            . mapMaybe srcSpanToRealSrcSpan-            . mconcat-              [ fmap getLoc . listify (only @(LHsDoc GhcPs)),-                fmap getLocA . listify isIEDocLike-              ]-            $ hsModule-          where-            isIEDocLike :: LIE GhcPs -> Bool-            isIEDocLike = \case-              L _ IEGroup {} -> True-              L _ IEDoc {} -> True-              L _ IEDocNamed {} -> True-              _ -> False+        epAnnCommentsToList = \case+          EpaComments cs -> cs+          EpaCommentsBalanced pcs fcs -> pcs <> fcs++    -- All spans of valid Haddock comments+    validHaddockCommentSpans =+      S.fromList+        . mapMaybe srcSpanToRealSrcSpan+        . mconcat+          [ fmap getLoc . listify (only @(LHsDoc GhcPs)),+            fmap getLocA . listify isIEDocLike+          ]+        $ hsModule+      where+        isIEDocLike :: LIE GhcPs -> Bool+        isIEDocLike = \case+          L _ IEGroup {} -> True+          L _ IEDoc {} -> True+          L _ IEDocNamed {} -> True+          _ -> False     only :: a -> Bool     only _ = True @@ -110,15 +146,15 @@ type LComment = RealLocated Comment  -- | A wrapper for a single comment. The 'Bool' indicates whether there were--- atoms before beginning of the comment in the original input. The--- 'NonEmpty' list inside contains lines of multiline comment @{- … -}@ or--- just single item\/line otherwise.+-- atoms before the beginning of the comment in the original input. The+-- 'NonEmpty' list inside contains the lines of a multiline comment+-- @{- … -}@, or just a single item\/line otherwise. data Comment = Comment Bool (NonEmpty Text)   deriving (Eq, Show, Data) --- | Normalize comment string. Sometimes one multi-line comment is turned--- into several lines for subsequent outputting with correct indentation for--- each line.+-- | Normalize a comment string. Sometimes a single multi-line comment is+-- split into several lines so that it can later be output with correct+-- indentation on each line. mkComment ::   -- | Lines of original input with their indices   [(Int, Text)] ->@@ -138,27 +174,85 @@                     then startIndent                     else T.length (T.takeWhile isSpace y)                 n = minimum (startIndent : fmap getIndent xs)-                commentPrefix = if "{-" `T.isPrefixOf` s then "" else "-- "-             in x :| ((commentPrefix <>) . escapeHaddockTriggers . T.drop n <$> xs)+             in x :| (escapeOpeningTrigger . T.drop n <$> xs)     (atomsBefore, ls') =       case dropWhile ((< commentLine) . fst) ls of         [] -> (False, [])         ((_, i) : ls'') ->-          case T.take 2 (T.stripStart i) of-            "--" -> (False, ls'')-            "{-" -> (False, ls'')-            _ -> (True, ls'')-    startIndent-      -- srcSpanStartCol counts columns starting from 1, so we subtract 1-      | "{-" `T.isPrefixOf` s = srcSpanStartCol l - 1-      -- For single-line comments, the only case where xs != [] is when an-      -- invalid haddock comment composed of several single-line comments is-      -- encountered. In that case, each line of xs is prefixed with an-      -- extra space (not present in the original comment), so we set-      -- startIndent = 1 to remove this space.-      | otherwise = 1+          let lineStart = T.stripStart i+              -- A pragma is code, not a comment, even though it opens the+              -- same way. Without this a comment trailing @{-# UNPACK #-}+              -- !Int@ looks as though nothing preceded it on the line.+              startsWithComment =+                "--" `T.isPrefixOf` lineStart+                  || ( "{-" `T.isPrefixOf` lineStart+                         && not ("{-#" `T.isPrefixOf` lineStart)+                     )+           in (not startsWithComment, ls'')+    -- srcSpanStartCol counts columns starting from 1, so we subtract 1.+    -- A multi-line run of @--@ lines reaches us as the source wrote it, so+    -- it is dedented the same way a block comment is.+    startIndent = srcSpanStartCol l - 1     commentLine = srcSpanStartLine l +-- | Turn the source text of a Haddock into a 'Comment'.+--+-- Only the indentation of the continuation lines is touched, so that the+-- comment can be re-indented along with the code it documents. Nothing is+-- re-prefixed and no Haddock triggers are escaped: the whole point is that+-- what the author wrote comes back out.+mkHaddockComment :: RealLocated Text -> Comment+mkHaddockComment (L l s) =+  -- Blank lines are kept: inside a doc comment they are the author's+  -- paragraph breaks, not the incidental spacing that 'removeConseqBlanks'+  -- tidies up between ordinary comment lines.+  Comment False . fmap T.stripEnd . spaceAfterTrigger $+    case NE.nonEmpty (T.lines s) of+      Nothing -> s :| []+      Just (x :| xs) ->+        let startIndent = srcSpanStartCol l - 1+            getIndent y =+              if T.all isSpace y+                then startIndent+                else T.length (T.takeWhile isSpace y)+            n = minimum (startIndent : fmap getIndent xs)+         in x :| fmap (T.drop n) xs++-- | Put a space between a Haddock's trigger and what follows it, so that+-- @-- |Foo@ comes out as @-- | Foo@.+--+-- Named anchors are left alone: the name in @-- $section@ is part of the+-- anchor, and a space would make it a different one.+spaceAfterTrigger :: NonEmpty Text -> NonEmpty Text+spaceAfterTrigger (x :| xs) =+  case go x of+    Nothing -> x :| xs+    -- The whole comment shifts right by one, not just the first line.+    -- Haddock drops a leading space from every line of a doc string when+    -- the first line has one, so padding the first line alone would take a+    -- space away from all the others.+    Just x' -> x' :| fmap indentContinuation xs+  where+    go t = do+      (o, afterOpener) <- opener t+      let (spaces, rest) = T.span (== ' ') afterOpener+      (trg, body) <- trigger rest+      if T.null body || " " `T.isPrefixOf` body+        then Nothing+        else Just (o <> spaces <> trg <> " " <> body)+    indentContinuation t = case opener t of+      Just (o, rest) -> o <> " " <> rest+      Nothing -> " " <> t+    opener t+      | Just rest <- T.stripPrefix "--" t = Just ("--", rest)+      | Just rest <- T.stripPrefix "{-" t = Just ("{-", rest)+      | otherwise = Nothing+    trigger t+      | Just body <- T.stripPrefix "|" t = Just ("|", body)+      | Just body <- T.stripPrefix "^" t = Just ("^", body)+      | (stars, body) <- T.span (== '*') t, not (T.null stars) = Just (stars, body)+      | otherwise = Nothing+ -- | Get a collection of lines from a 'Comment'. unComment :: Comment -> NonEmpty Text unComment (Comment _ xs) = xs@@ -175,7 +269,7 @@ ---------------------------------------------------------------------------- -- Helpers --- | Detect and extract stack header if it is present.+-- | Detect and extract the stack header if it is present. extractStackHeader ::   -- | Comment stream to analyze   [RealLocated Text] ->@@ -195,71 +289,123 @@ extractPragmas ::   -- | Input   Text ->+  -- | Where the file header ends, if the module has anything after it+  Maybe RealSrcLoc ->   -- | Comment stream to analyze   [RealLocated Text] ->   ([LComment], [([LComment], Pragma)])-extractPragmas input = go initialLs id id+extractPragmas input headerEnd = go initialLs id id   where     initialLs = zip [1 ..] (T.lines input)++    -- A pragma below the header is not a pragma as far as GHC is+    -- concerned, so it stays in the comment stream and is printed where it+    -- was written. Hoisting it would both give it an effect it did not+    -- have and drag every comment above it to the top of the module.+    inHeader x = case headerEnd of+      Nothing -> True+      Just end -> realSrcSpanStart (getRealSrcSpan x) < end+     go ls csSoFar pragmasSoFar = \case       [] -> (csSoFar [], pragmasSoFar [])       (x : xs) ->         case parsePragma (unRealSrcSpan x) of-          Nothing ->+          Just pragma+            | inHeader x ->+                let combined ys = (csSoFar ys, pragma)+                    go' ls' ys rest = go ls' id (pragmasSoFar . (combined ys :)) rest+                 in case xs of+                      [] -> go' ls [] xs+                      (y : ys) ->+                        let (ls', y') = mkComment ls y+                         in if onTheSameLine+                              (RealSrcSpan (getRealSrcSpan x) Strict.Nothing)+                              (RealSrcSpan (getRealSrcSpan y) Strict.Nothing)+                              then go' ls' [y'] ys+                              else go' ls [] xs+          _ ->             let (ls', x') = mkComment ls x              in go ls' (csSoFar . (x' :)) pragmasSoFar xs-          Just pragma ->-            let combined ys = (csSoFar ys, pragma)-                go' ls' ys rest = go ls' id (pragmasSoFar . (combined ys :)) rest-             in case xs of-                  [] -> go' ls [] xs-                  (y : ys) ->-                    let (ls', y') = mkComment ls y-                     in if onTheSameLine-                          (RealSrcSpan (getRealSrcSpan x) Strict.Nothing)-                          (RealSrcSpan (getRealSrcSpan y) Strict.Nothing)-                          then go' ls' [y'] ys-                          else go' ls [] xs  -- | Extract @'RealLocated' 'Text'@ from 'GHC.LEpaComment'.-unAnnotationComment :: GHC.LEpaComment -> Maybe (RealLocated Text)-unAnnotationComment (L epaLoc (GHC.EpaComment eck _)) =+unAnnotationComment :: Text -> GHC.LEpaComment -> Maybe (RealLocated Text)+unAnnotationComment input (L epaLoc (GHC.EpaComment eck _)) =   case eck of-    GHC.EpaDocComment s ->-      let trigger = case s of-            MultiLineDocString t _ -> Just t-            NestedDocString t _ -> Just t-            -- should not occur-            GeneratedDocString _ -> Nothing-       in haddock trigger (T.pack $ renderHsDocString s)+    -- A doc comment is taken from the source rather than rebuilt from the+    -- 'HsDocString' GHC parsed out of it: rebuilding cannot preserve a+    -- @{- | … -}@, nor an empty @-- |@, and losing either changes the AST.+    -- A comment that GHC lexed as a doc comment but that did not become+    -- part of the AST is not a Haddock at all. It still looks like one, so+    -- its trigger is escaped: Ormolu may move it somewhere a Haddock would+    -- be accepted, and it must not turn into one there.+    GHC.EpaDocComment _ ->+      withSpan $ \s ->+        Just (escapeOpeningTrigger (normalizeSpacing (sliceSpan input s)))     GHC.EpaDocOptions s -> mkL (T.pack s)-    GHC.EpaLineComment (T.pack -> s) -> mkL $-      case T.take 3 s of-        "-- " -> s-        "---" -> s-        _ -> insertAt " " s 3+    GHC.EpaLineComment (T.pack -> s) -> mkL (normalizeSpacing s)     GHC.EpaBlockComment s -> mkL (T.pack s)   where-    mkL = case epaLoc of-      GHC.EpaSpan (RealSrcSpan s _) -> Just . L s-      _ -> const Nothing-    insertAt x xs n = T.take (n - 1) xs <> x <> T.drop (n - 1) xs-    haddock mtrigger =-      mkL . dashPrefix . escapeHaddockTriggers . (trigger <>) <=< dropBlank-      where-        trigger = case mtrigger of-          Just HsDocStringNext -> "|"-          Just HsDocStringPrevious -> "^"-          Just (HsDocStringNamed n) -> "$" <> T.pack n-          Just (HsDocStringGroup k) -> T.replicate k "*"-          Nothing -> ""-        dashPrefix s = "--" <> spaceIfNecessary <> s-          where-            spaceIfNecessary = case T.uncons s of-              Just (c, _) | c /= ' ' -> " "-              _ -> ""-        dropBlank :: Text -> Maybe Text-        dropBlank s = if T.all isSpace s then Nothing else Just s+    realSpan = case epaLoc of+      GHC.EpaSpan (RealSrcSpan s _) -> Just s+      _ -> Nothing+    mkL = case realSpan of+      Just s -> Just . L s+      Nothing -> const Nothing+    withSpan f = do+      s <- realSpan+      L s <$> f s++-- | Put a space after the dashes of a line comment when there is none.+--+-- This is the one normalization that survives: @--foo@ becomes @-- foo@ and+-- @--|foo@ becomes @-- |foo@, which is what one expects of a formatter.+-- Everything else about a comment is left as it was written.+normalizeSpacing :: Text -> Text+normalizeSpacing s+  | not ("--" `T.isPrefixOf` s) = s+  | otherwise = case T.uncons (T.drop 2 s) of+      Nothing -> s+      Just (c, _)+        | c == ' ' || c == '-' -> s+        | otherwise -> "-- " <> T.drop 2 s++-- | Escape a Haddock trigger that opens a comment line, so that the line+-- cannot be read as a Haddock wherever it ends up.+--+-- A line that does not open a comment is left alone: a @*@ in the middle of+-- a @{- … -}@ block is just a character, and escaping it there only+-- disfigures the text.+escapeOpeningTrigger :: Text -> Text+escapeOpeningTrigger t =+  case T.stripPrefix "--" t of+    Just rest -> "--" <> escapeAfterSpaces rest+    Nothing -> case T.stripPrefix "{-" t of+      Just rest -> "{-" <> escapeAfterSpaces rest+      Nothing -> t+  where+    escapeAfterSpaces x =+      let (spaces, rest) = T.span (== ' ') x+       in spaces <> escapeHaddockTriggers rest++-- | Extract the source text a span covers.+sliceSpan :: Text -> RealSrcSpan -> Text+sliceSpan input spn =+  case spannedLines of+    [] -> ""+    [single] -> T.take (endCol - startCol) (T.drop (startCol - 1) single)+    (firstLine : rest) ->+      T.intercalate "\n" $+        T.drop (startCol - 1) firstLine : trimLast rest+  where+    startLine = srcSpanStartLine spn+    endLine = srcSpanEndLine spn+    startCol = srcSpanStartCol spn+    endCol = srcSpanEndCol spn+    spannedLines =+      take (endLine - startLine + 1) (drop (startLine - 1) (T.lines input))+    trimLast xs = case reverse xs of+      [] -> []+      (y : ys) -> reverse (T.take (endCol - 1) y : ys)  -- | Remove consecutive blank lines. removeConseqBlanks :: NonEmpty Text -> NonEmpty Text

@@ -1,7 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} --- | A module for parsing of pragmas from comments.+-- | A module for parsing pragmas from comments. module Ormolu.Parser.Pragma   ( Pragma (..),     parsePragma,

@@ -1,14 +1,18 @@--- | A type for result of parsing.+-- | A type for the result of parsing. module Ormolu.Parser.Result   ( SourceSnippet (..),     ParseResult (..),+    inputComments,   ) where +import Data.List (sortOn)+import Data.Maybe (maybeToList) import Data.Text (Text) import GHC.Data.EnumSet (EnumSet) import GHC.Hs import GHC.LanguageExtensions.Type+import GHC.Types.SrcLoc (getLoc) import Ormolu.Config (SourceType) import Ormolu.Fixity (ModuleFixityMap) import Ormolu.Parser.CommentStream@@ -21,7 +25,7 @@ data ParseResult = ParseResult   { -- | Parsed module or signature     prParsedSource :: HsModule GhcPs,-    -- | Either regular module or signature file+    -- | Whether this is a regular module or a signature file     prSourceType :: SourceType,     -- | Stack header     prStackHeader :: Maybe LComment,@@ -29,10 +33,27 @@     prPragmas :: [([LComment], Pragma)],     -- | Comment stream     prCommentStream :: CommentStream,+    -- | Source text of the module's Haddocks, keyed by span+    prHaddockText :: HaddockText,     -- | Enabled extensions     prExtensions :: EnumSet Extension,     -- | Fixity map for operators     prModuleFixityMap :: ModuleFixityMap,-    -- | Indentation level, can be non-zero in case of region formatting+    -- | Indentation level; can be non-zero in the case of region formatting     prIndent :: Int   }++-- | All the comments a snippet started with, in source order.+--+-- This is not simply the comment stream: the Stack header and the comments+-- that precede pragmas are lifted out of the stream while parsing, and are+-- emitted separately. Haddocks, on the other hand, are not included at all,+-- because GHC's parser makes them part of the AST.+inputComments :: ParseResult -> [LComment]+inputComments ParseResult {prStackHeader, prPragmas, prCommentStream} =+  sortOn getLoc $+    maybeToList prStackHeader+      <> concatMap fst prPragmas+      <> streamComments+  where+    CommentStream streamComments = prCommentStream

@@ -1,43 +1,103 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}  -- | Pretty-printer for Haskell AST.+--+-- Each snippet is rendered twice. Comments are attached to the elements the+-- printer enters, and the only way to know which elements those are is to+-- render once and see; the first pass therefore runs with no comments at+-- all and is kept only for the spans it visited. See 'render'. module Ormolu.Printer   ( printSnippets,+    printSnippetsWithPlacements,   ) where +import Data.Choice (Choice) import Data.Text (Text) import Data.Text qualified as T+import GHC.Types.SrcLoc (RealSrcSpan)+import Ormolu.Comments.Anchor+import Ormolu.Parser.CommentStream (CommentStream (..)) import Ormolu.Parser.Result import Ormolu.Printer.Combinators+import Ormolu.Printer.CommentPlacement import Ormolu.Printer.Meat.Module-import Ormolu.Printer.SpanStream import Ormolu.Processing.Common  -- | Render several source snippets. printSnippets ::   -- | Whether to print out debug information during printing-  Bool ->+  Choice "debug" ->   -- | Result of parsing   [SourceSnippet] ->   -- | Resulting rendition   Text-printSnippets debug = T.concat . fmap printSnippet+printSnippets debug = T.concat . fmap fst . printSnippetsWithPlacements debug++-- | Like 'printSnippets', but also return, for each snippet, the placement+-- of every comment it emitted.+--+-- Snippets are rendered separately and their spans are relative to+-- themselves, so the placements stay grouped by snippet: anything that+-- compares them against the input has to work one snippet at a time.+printSnippetsWithPlacements ::+  -- | Whether to print out debug information during printing+  Choice "debug" ->+  -- | Result of parsing+  [SourceSnippet] ->+  -- | For each snippet, its rendition and the comments it emitted+  [(Text, [CommentPlacement])]+printSnippetsWithPlacements debug = fmap (renderSnippet debug)++-- | Render one snippet. A snippet that could not be parsed is passed+-- through as it was.+renderSnippet ::+  Choice "debug" ->+  SourceSnippet ->+  (Text, [CommentPlacement])+renderSnippet debug = \case+  ParsedSnippet r -> render debug r+  RawSnippet r -> (r, [])++-- | Render one parsed snippet, along with the placement of every comment it+-- emitted.+--+-- This renders twice. Anchoring a comment to an element the printer never+-- enters would leave the comment stranded, and there is no way to know+-- which elements those are but to render once and see. The first pass is+-- given an empty 'AnchorMap', so it emits no comments and its output is+-- thrown away; what it is for is the spans it visited, which is what the+-- second pass attaches the comments to.+render ::+  Choice "debug" ->+  ParseResult ->+  (Text, [CommentPlacement])+render debug r@ParseResult {..} =+  let (_, _, visited) = renderWith noComments+      (rendered, placements, _) = renderWith (anchorMapFor r visited)+   in (rendered, placements)   where-    printSnippet = \case-      ParsedSnippet ParseResult {..} ->-        reindent prIndent $-          runR-            ( p_hsModule-                prStackHeader-                prPragmas-                prParsedSource-            )-            (mkSpanStream prParsedSource)-            prCommentStream-            prSourceType-            prExtensions-            prModuleFixityMap-            debug-      RawSnippet r -> r+    renderWith anchorMap =+      let (rendered, placements, visited) =+            runR+              ( p_hsModule+                  prStackHeader+                  prPragmas+                  prParsedSource+              )+              anchorMap+              prSourceType+              prExtensions+              prModuleFixityMap+              debug+              prHaddockText+       in (reindent prIndent rendered, placements, visited)++-- | Attach the comments of a snippet to the elements the printer enters.+anchorMapFor :: ParseResult -> [RealSrcSpan] -> AnchorMap+anchorMapFor ParseResult {..} visited =+  mkAnchorMap (attachComments comments visited)+  where+    CommentStream comments = prCommentStream

@@ -3,15 +3,15 @@ {-# LANGUAGE OverloadedStrings #-}  -- | Printing combinators. The definitions here are presented in such an--- order so you can just go through the Haddocks and by the end of the file--- you should have a pretty good idea how to program rendering logic.+-- order that you can just read through the Haddocks, and by the end of the+-- file you should have a pretty good idea of how to program rendering logic. module Ormolu.Printer.Combinators   ( -- * The 'R' monad     R,     runR,     getEnclosingSpan,-    getEnclosingSpanWhere,-    getEnclosingComments,+    getCommentsAnchoredWithin,+    getCommentsBefore,     isExtensionEnabled,      -- * Combinators@@ -21,15 +21,18 @@     atom,     space,     newline,+    newlineLiteral,     inci,     inciIf,     askSourceType,     askModuleFixityMap,     askDebug,     located,-    encloseLocated,+    locatedEmpty,     located',     switchLayout,+    switchLayoutWithEnclosingComments,+    enterLayout,     Layout (..),     vlayout,     getLayout,@@ -39,6 +42,7 @@     -- ** Formatting lists     sep,     sepSemi,+    sepSemi',     canUseBraces,     useBraces,     dontUseBraces,@@ -58,15 +62,17 @@     -- ** Literals     comma,     commaDel,-    equals,      -- ** Stateful markers-    SpanMark (..),-    spanMarkSpan,+    LastEmitted (..),+    lastEmittedSpan,     HaddockStyle (..),-    setSpanMark,-    getSpanMark,+    setLastEmitted,+    getLastEmitted, +    -- ** Haddocks+    lookupHaddockText,+     -- ** Placement     Placement (..),     placeHanging,@@ -75,12 +81,14 @@  import Control.Monad import Data.List (intersperse)+import Data.List.NonEmpty qualified as NE import Data.Text (Text) import GHC.Data.Strict qualified as Strict import GHC.Parser.Annotation import GHC.Types.SrcLoc import Ormolu.Printer.Comments import Ormolu.Printer.Internal+import Ormolu.Utils (combineSrcSpans')  ---------------------------------------------------------------------------- -- Basic@@ -95,7 +103,7 @@ inciIf b m = if b then inci m else m  -- | Enter a 'GenLocated' entity. This combinator handles outputting comments--- and sets layout (single-line vs multi-line) for the inner computation.+-- and sets the layout (single-line vs multi-line) for the inner computation. -- Roughly, the rule for using 'located' is that every time there is a -- 'Located' wrapper, it should be “discharged” with a corresponding -- 'located' invocation.@@ -103,59 +111,117 @@   (HasLoc l) =>   -- | Thing to enter   GenLocated l a ->-  -- | How to render inner value+  -- | How to render the inner value   (a -> R ()) ->   R () located (L l' a) f = case locA l' of   UnhelpfulSpan _ -> f a   RealSrcSpan l _ -> do+    recordVisitedSpan l     spitPrecedingComments l     withEnclosingSpan l $       switchLayout [RealSrcSpan l Strict.Nothing] (f a)     spitFollowingComments l --- | Similar to 'located', but when the "payload" is an empty list, print--- virtual elements at the start and end of the source span to prevent comments--- from "floating out".-encloseLocated ::-  (HasLoc l) =>-  GenLocated l [a] ->-  ([a] -> R ()) ->+-- | Give an empty bracketed construct something for a comment written+-- inside it to attach to.+--+-- Brackets are rendered with 'txt', so an empty export or import list, an+-- empty @[]@ or a record with no fields contains no element at all. A+-- comment written between the brackets would be attached to whatever+-- encloses them and rendered outside them, so a zero-width element is+-- entered at the opening bracket instead.+locatedEmpty ::+  -- | Span of the empty construct+  SrcSpan ->   R ()-encloseLocated la f = located la $ \a -> do-  when (null a) $ located (L startSpan ()) pure-  f a-  when (null a) $ located (L endSpan ()) pure-  where-    l = locA la-    (startLoc, endLoc) = (srcSpanStart l, srcSpanEnd l)-    (startSpan, endSpan) = (mkSrcSpan startLoc startLoc, mkSrcSpan endLoc endLoc)+locatedEmpty l =+  let loc = srcSpanStart l+   in located (L (mkSrcSpan loc loc) ()) pure --- | A version of 'located' with arguments flipped.+-- | A version of 'located' with the arguments flipped. located' ::   (HasLoc l) =>-  -- | How to render inner value+  -- | How to render the inner value   (a -> R ()) ->   -- | Thing to enter   GenLocated l a ->   R () located' = flip located --- | Set layout according to combination of given 'SrcSpan's for a given.--- Use this only when you need to set layout based on e.g. combined span of--- several elements when there is no corresponding 'Located' wrapper--- provided by GHC AST. It is relatively rare that this one is needed.+-- | Set the layout according to the combination of the given 'SrcSpan's,+-- together with the spans of the comments that belong inside them. ----- Given empty list this function will set layout to single line.+-- Comments count towards the layout: a construct that would fit on one line+-- has to be broken up anyway if a comment was written inside it, or the+-- comment would swallow whatever follows it on the line.+--+-- 'located' calls this for you. Call it directly only when the layout has+-- to come from something the GHC AST has no 'Located' wrapper for, such as+-- the combined span of several elements; that is rare.+--+-- Given an empty list and no comments, this function will set the layout to+-- single-line. switchLayout ::   -- | Span that controls layout   [SrcSpan] ->   -- | Computation to run with changed layout   R () ->   R ()-switchLayout spans' = enterLayout (spansLayout spans')+switchLayout spans' m = do+  csSpans <- commentSpansIn (combineSrcSpans' <$> NE.nonEmpty spans')+  enterLayout (spansLayout (spans' <> csSpans)) m --- | Which layout combined spans result in?+-- | Like 'switchLayout', but the comments are looked for in the enclosing+-- element rather than in the given spans.+--+-- This is what a bracketed construct needs. In+--+-- > ( -- c+-- >   x+-- > )+--+-- the comment sits between the bracket and @x@, so it is inside neither of+-- them, and the parentheses would be put on one line despite it. Widening+-- the question to the enclosing element catches it. Do not reach for this+-- elsewhere: it is deliberately coarser than 'switchLayout', and applying+-- it where the enclosing element is large would let one comment break every+-- layout decision inside it.+switchLayoutWithEnclosingComments ::+  -- | Span that controls layout+  [SrcSpan] ->+  -- | Computation to run with changed layout+  R () ->+  R ()+switchLayoutWithEnclosingComments spans' m = do+  enclosing <- getEnclosingSpan+  csSpans <- commentSpansIn (flip RealSrcSpan Strict.Nothing <$> enclosing)+  enterLayout (spansLayout (spans' <> csSpans)) m++-- | The spans of the comments that belong inside the given region: both+-- attached to something in it and written inside it.+--+-- Both halves are needed. Without the first, a comment anywhere in a+-- declaration would force every layout decision inside that declaration to+-- multi-line. Without the second, a comment trailing an element would force+-- that element itself to be broken up.+--+-- Haddocks are not consulted here. They do not travel in the anchor map,+-- and their spans sit where the author wrote them rather than where they+-- will be printed, which is the wrong question; see+-- 'Ormolu.Printer.Meat.Common.multiLineIfDocumented'.+commentSpansIn :: Maybe SrcSpan -> R [SrcSpan]+commentSpansIn = \case+  Just (RealSrcSpan region _) -> do+    comments <- getCommentsAnchoredWithin region+    pure+      [ RealSrcSpan spn Strict.Nothing+      | L spn _ <- comments,+        region `containsSpan` spn+      ]+  _ -> pure []++-- | Which layout do the combined spans result in? spansLayout :: [SrcSpan] -> Layout spansLayout = \case   [] -> SingleLine@@ -164,14 +230,14 @@       then SingleLine       else MultiLine --- | Insert a space if enclosing layout is single-line, or newline if it's--- multiline.+-- | Insert a space if the enclosing layout is single-line, or a newline if+-- it is multi-line. -- -- > breakpoint = vlayout space newline breakpoint :: R () breakpoint = vlayout space newline --- | Similar to 'breakpoint' but outputs nothing in case of single-line+-- | Similar to 'breakpoint', but outputs nothing in the case of single-line -- layout. -- -- > breakpoint' = vlayout (return ()) newline@@ -181,7 +247,7 @@ ---------------------------------------------------------------------------- -- Formatting lists --- | Render a collection of elements inserting a separator between them.+-- | Render a collection of elements, inserting a separator between them. sep ::   -- | Separator   R () ->@@ -192,9 +258,9 @@   R () sep s f xs = sequence_ (intersperse s (f <$> xs)) --- | Render a collection of elements layout-sensitively using given printer,--- inserting semicolons if necessary and respecting 'useBraces' and--- 'dontUseBraces' combinators.+-- | Render a collection of elements layout-sensitively using the given+-- printer, inserting semicolons if necessary and respecting the 'useBraces'+-- and 'dontUseBraces' combinators. -- -- > useBraces $ sepSemi txt ["foo", "bar"] -- >   == vlayout (txt "{ foo; bar }") (txt "foo\nbar")@@ -207,7 +273,25 @@   -- | Elements to render   [a] ->   R ()-sepSemi f xs = vlayout singleLine multiLine+sepSemi = sepSemi' False++-- | A version of 'sepSemi' that allows one 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,12 +307,15 @@               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 --- | 'BracketStyle' controlling how closing bracket is rendered.+-- | 'BracketStyle' controlling how the closing bracket is rendered. data BracketStyle   = -- | Normal     N@@ -236,30 +323,31 @@     S   deriving (Eq, Show) --- | Surround given entity by backticks.+-- | Surround the given entity with backticks. backticks :: R () -> R () backticks m = do   txt "`"   m   txt "`" --- | Surround given entity by banana brackets (i.e., from arrow notation.)+-- | Surround the given entity with banana brackets (i.e. from arrow+-- notation). banana :: BracketStyle -> R () -> R () banana = brackets_ True "(|" "|)" --- | Surround given entity by curly braces @{@ and  @}@.+-- | Surround the given entity with curly braces @{@ and @}@. braces :: BracketStyle -> R () -> R () braces = brackets_ False "{" "}" --- | Surround given entity by square brackets @[@ and @]@.+-- | Surround the given entity with square brackets @[@ and @]@. brackets :: BracketStyle -> R () -> R () brackets = brackets_ False "[" "]" --- | Surround given entity by parentheses @(@ and @)@.+-- | Surround the given entity with parentheses @(@ and @)@. parens :: BracketStyle -> R () -> R () parens = brackets_ False "(" ")" --- | Surround given entity by @(# @ and @ #)@.+-- | Surround the given entity with @(# @ and @ #)@. parensHash :: BracketStyle -> R () -> R () parensHash = brackets_ True "(#" "#)" @@ -324,21 +412,17 @@ commaDel :: R () commaDel = comma >> breakpoint --- | Print @=@. Do not use @'txt' "="@.-equals :: R ()-equals = interferingTxt "="- ---------------------------------------------------------------------------- -- Placement  -- | Expression placement. This marks the places where expressions that--- implement handing forms may use them.+-- support hanging forms may use them. data Placement   = -- | Multi-line layout should cause-    -- insertion of a newline and indentation-    -- bump+    -- insertion of a newline and an+    -- indentation bump     Normal-  | -- | Expressions that have hanging form+  | -- | Expressions that have a hanging form     -- should use it and avoid bumping one level     -- of indentation     Hanging