diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -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
diff --git a/DESIGN.md b/DESIGN.md
--- a/DESIGN.md
+++ b/DESIGN.md
@@ -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
 
diff --git a/LICENSE.md b/LICENSE.md
--- a/LICENSE.md
+++ b/LICENSE.md
@@ -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.
 
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -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
diff --git a/app/Main.hs b/app/Main.hs
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -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)
diff --git a/data/examples/declaration/data/comment-in-empty-record-out.hs b/data/examples/declaration/data/comment-in-empty-record-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/comment-in-empty-record-out.hs
@@ -0,0 +1,6 @@
+instance StateKey ExampleReq where
+  data State ExampleReq = ExampleState
+    {
+    -- in here you can put any state that the
+    -- run.
+    }
diff --git a/data/examples/declaration/data/comment-in-empty-record.hs b/data/examples/declaration/data/comment-in-empty-record.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/comment-in-empty-record.hs
@@ -0,0 +1,5 @@
+instance StateKey ExampleReq where
+  data State ExampleReq = ExampleState {
+        -- in here you can put any state that the
+        -- run.
+        }
diff --git a/data/examples/declaration/data/haddock-before-deriving-out.hs b/data/examples/declaration/data/haddock-before-deriving-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/haddock-before-deriving-out.hs
@@ -0,0 +1,5 @@
+data A = A
+  deriving
+    ( -- | B
+      Eq
+    )
diff --git a/data/examples/declaration/data/haddock-before-deriving.hs b/data/examples/declaration/data/haddock-before-deriving.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/haddock-before-deriving.hs
@@ -0,0 +1,3 @@
+data A = A
+  -- | B
+  deriving (Eq)
diff --git a/data/examples/declaration/data/haddock-before-record-braces-out.hs b/data/examples/declaration/data/haddock-before-record-braces-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/haddock-before-record-braces-out.hs
@@ -0,0 +1,6 @@
+module Example where
+
+data Hello = Hello
+  { -- | hello world
+    hello :: String
+  }
diff --git a/data/examples/declaration/data/haddock-before-record-braces.hs b/data/examples/declaration/data/haddock-before-record-braces.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/haddock-before-record-braces.hs
@@ -0,0 +1,5 @@
+module Example where
+
+data Hello = Hello
+  -- | hello world
+  {hello :: String}
diff --git a/data/examples/declaration/data/infix-haddocks-out.hs b/data/examples/declaration/data/infix-haddocks-out.hs
--- a/data/examples/declaration/data/infix-haddocks-out.hs
+++ b/data/examples/declaration/data/infix-haddocks-out.hs
@@ -24,8 +24,8 @@
 
 data DocPartial
   = Left -- ^ left docs
-    -- on multiple
-    -- lines
+         -- on multiple
+         -- lines
       :*:
       Right
   | -- | op
diff --git a/data/examples/declaration/data/linear-out.hs b/data/examples/declaration/data/linear-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/linear-out.hs
@@ -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
diff --git a/data/examples/declaration/data/linear.hs b/data/examples/declaration/data/linear.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/linear.hs
@@ -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
diff --git a/data/examples/declaration/data/record-empty-haddock-out.hs b/data/examples/declaration/data/record-empty-haddock-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/record-empty-haddock-out.hs
@@ -0,0 +1,5 @@
+data A = A
+  { -- \|
+    --
+    a :: Int
+  }
diff --git a/data/examples/declaration/data/record-empty-haddock.hs b/data/examples/declaration/data/record-empty-haddock.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/record-empty-haddock.hs
@@ -0,0 +1,6 @@
+data A = A
+  {
+    -- |
+    -- 
+    a :: Int
+  }
diff --git a/data/examples/declaration/data/record-out.hs b/data/examples/declaration/data/record-out.hs
--- a/data/examples/declaration/data/record-out.hs
+++ b/data/examples/declaration/data/record-out.hs
@@ -12,7 +12,7 @@
     fooGag,
     fooGog ::
       NonEmpty
-        ( Indentity
+        ( Identity
             Bool
         ),
     -- | Huh!
diff --git a/data/examples/declaration/data/record.hs b/data/examples/declaration/data/record.hs
--- a/data/examples/declaration/data/record.hs
+++ b/data/examples/declaration/data/record.hs
@@ -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
diff --git a/data/examples/declaration/data/required-type-arguments-out.hs b/data/examples/declaration/data/required-type-arguments-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/required-type-arguments-out.hs
@@ -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)
diff --git a/data/examples/declaration/data/required-type-arguments.hs b/data/examples/declaration/data/required-type-arguments.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/required-type-arguments.hs
@@ -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)
diff --git a/data/examples/declaration/data/unnamed-field-comment-3-out.hs b/data/examples/declaration/data/unnamed-field-comment-3-out.hs
--- a/data/examples/declaration/data/unnamed-field-comment-3-out.hs
+++ b/data/examples/declaration/data/unnamed-field-comment-3-out.hs
@@ -1,5 +1,1 @@
-data A
-  = A
-      -- | a number
-      Int
-      Bool
+data A = A {- | a number -} Int Bool
diff --git a/data/examples/declaration/data/unpack-field-comment-0-out.hs b/data/examples/declaration/data/unpack-field-comment-0-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-0-out.hs
@@ -0,0 +1,4 @@
+data Buffer
+  = Buffer
+      {-# UNPACK #-} !(ForeignPtr Word8) -- underlying pinned array
+      {-# UNPACK #-} !(Ptr Word8) -- beginning of slice
diff --git a/data/examples/declaration/data/unpack-field-comment-0.hs b/data/examples/declaration/data/unpack-field-comment-0.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-0.hs
@@ -0,0 +1,2 @@
+data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8) -- underlying pinned array
+                     {-# UNPACK #-} !(Ptr Word8)        -- beginning of slice
diff --git a/data/examples/declaration/data/unpack-field-comment-1-out.hs b/data/examples/declaration/data/unpack-field-comment-1-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-1-out.hs
@@ -0,0 +1,4 @@
+data P
+  = P
+      {-# UNPACK #-} !Word32 -- left word
+      {-# UNPACK #-} !Word32 -- right word
diff --git a/data/examples/declaration/data/unpack-field-comment-1.hs b/data/examples/declaration/data/unpack-field-comment-1.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-1.hs
@@ -0,0 +1,2 @@
+data P = P {-# UNPACK #-} !Word32 -- left word
+           {-# UNPACK #-} !Word32 -- right word
diff --git a/data/examples/declaration/data/unpack-field-comment-2-out.hs b/data/examples/declaration/data/unpack-field-comment-2-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-2-out.hs
@@ -0,0 +1,4 @@
+data TBQueue a
+  = TBQueue
+      {-# UNPACK #-} !(TVar Natural) -- CR:  read capacity
+      {-# UNPACK #-} !(TVar [a]) -- R:   elements waiting to be read
diff --git a/data/examples/declaration/data/unpack-field-comment-2.hs b/data/examples/declaration/data/unpack-field-comment-2.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-2.hs
@@ -0,0 +1,3 @@
+data TBQueue a
+   = TBQueue {-# UNPACK #-} !(TVar Natural) -- CR:  read capacity
+             {-# UNPACK #-} !(TVar [a])     -- R:   elements waiting to be read
diff --git a/data/examples/declaration/data/unpack-field-comment-3-out.hs b/data/examples/declaration/data/unpack-field-comment-3-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-3-out.hs
@@ -0,0 +1,4 @@
+data Builder
+  = Builder
+      {-# UNPACK #-} !Int -- offset
+      {-# UNPACK #-} !Int -- used units
diff --git a/data/examples/declaration/data/unpack-field-comment-3.hs b/data/examples/declaration/data/unpack-field-comment-3.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-3.hs
@@ -0,0 +1,3 @@
+data Builder = Builder
+     {-# UNPACK #-} !Int -- offset
+     {-# UNPACK #-} !Int -- used units
diff --git a/data/examples/declaration/data/wildcard-binders-out.hs b/data/examples/declaration/data/wildcard-binders-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/wildcard-binders-out.hs
@@ -0,0 +1,1 @@
+data Proxy _ = Proxy
diff --git a/data/examples/declaration/data/wildcard-binders.hs b/data/examples/declaration/data/wildcard-binders.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/wildcard-binders.hs
@@ -0,0 +1,1 @@
+data Proxy _ = Proxy
diff --git a/data/examples/declaration/default/default-out.hs b/data/examples/declaration/default/default-out.hs
--- a/data/examples/declaration/default/default-out.hs
+++ b/data/examples/declaration/default/default-out.hs
@@ -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)
diff --git a/data/examples/declaration/default/default.hs b/data/examples/declaration/default/default.hs
--- a/data/examples/declaration/default/default.hs
+++ b/data/examples/declaration/default/default.hs
@@ -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)
diff --git a/data/examples/declaration/foreign/foreign-import-multiline-out.hs b/data/examples/declaration/foreign/foreign-import-multiline-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/foreign/foreign-import-multiline-out.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE MultilineStrings #-}
+
+foreign import capi
+  """
+  foo
+     bar
+  """
+  foo :: Int -> Int
diff --git a/data/examples/declaration/foreign/foreign-import-multiline.hs b/data/examples/declaration/foreign/foreign-import-multiline.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/foreign/foreign-import-multiline.hs
@@ -0,0 +1,6 @@
+{-# language MultilineStrings #-}
+
+foreign import capi """
+         foo
+            bar
+     """ foo :: Int -> Int
diff --git a/data/examples/declaration/rewrite-rule/prelude2-out.hs b/data/examples/declaration/rewrite-rule/prelude2-out.hs
--- a/data/examples/declaration/rewrite-rule/prelude2-out.hs
+++ b/data/examples/declaration/rewrite-rule/prelude2-out.hs
@@ -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
diff --git a/data/examples/declaration/rewrite-rule/prelude2.hs b/data/examples/declaration/rewrite-rule/prelude2.hs
--- a/data/examples/declaration/rewrite-rule/prelude2.hs
+++ b/data/examples/declaration/rewrite-rule/prelude2.hs
@@ -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
diff --git a/data/examples/declaration/rewrite-rule/prelude4-out.hs b/data/examples/declaration/rewrite-rule/prelude4-out.hs
--- a/data/examples/declaration/rewrite-rule/prelude4-out.hs
+++ b/data/examples/declaration/rewrite-rule/prelude4-out.hs
@@ -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
   #-}
diff --git a/data/examples/declaration/signature/fixity/infix-out.hs b/data/examples/declaration/signature/fixity/infix-out.hs
--- a/data/examples/declaration/signature/fixity/infix-out.hs
+++ b/data/examples/declaration/signature/fixity/infix-out.hs
@@ -5,3 +5,5 @@
 infix 2 ->
 
 infix 0 type <!>
+
+infix 9 +
diff --git a/data/examples/declaration/signature/fixity/infix.hs b/data/examples/declaration/signature/fixity/infix.hs
--- a/data/examples/declaration/signature/fixity/infix.hs
+++ b/data/examples/declaration/signature/fixity/infix.hs
@@ -4,3 +4,5 @@
 infix 2 ->
 
 infix 0 type <!>
+
+infix +
diff --git a/data/examples/declaration/signature/specialize/specialize-2-out.hs b/data/examples/declaration/signature/specialize/specialize-2-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/signature/specialize/specialize-2-out.hs
@@ -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)
+  #-}
diff --git a/data/examples/declaration/signature/specialize/specialize-2.hs b/data/examples/declaration/signature/specialize/specialize-2.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/signature/specialize/specialize-2.hs
@@ -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) #-}
diff --git a/data/examples/declaration/signature/specialize/specialize-3-out.hs b/data/examples/declaration/signature/specialize/specialize-3-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/signature/specialize/specialize-3-out.hs
@@ -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 #-}
diff --git a/data/examples/declaration/signature/specialize/specialize-3.hs b/data/examples/declaration/signature/specialize/specialize-3.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/signature/specialize/specialize-3.hs
@@ -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 #-}
diff --git a/data/examples/declaration/type-families/closed-type-family/multi-line-out.hs b/data/examples/declaration/type-families/closed-type-family/multi-line-out.hs
--- a/data/examples/declaration/type-families/closed-type-family/multi-line-out.hs
+++ b/data/examples/declaration/type-families/closed-type-family/multi-line-out.hs
@@ -25,6 +25,5 @@
   F a = String
 
 type family F a where
-  F a -- foo
-    =
+  F a = -- foo
     a
diff --git a/data/examples/declaration/type-synonyms/multi-line-out.hs b/data/examples/declaration/type-synonyms/multi-line-out.hs
--- a/data/examples/declaration/type-synonyms/multi-line-out.hs
+++ b/data/examples/declaration/type-synonyms/multi-line-out.hs
@@ -19,6 +19,5 @@
     :<|> "route2" :> ApiRoute2 -- comment here
     :<|> OmitDocs :> "i" :> ASomething API
 
-type A -- foo
-  =
+type A = -- foo
   B
diff --git a/data/examples/declaration/type/promotion-no-puns-out.hs b/data/examples/declaration/type/promotion-no-puns-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/type/promotion-no-puns-out.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE NoListTuplePuns #-}
+
+type X = (Int, String)
+
+type Y = [String, Int]
diff --git a/data/examples/declaration/type/promotion-no-puns.hs b/data/examples/declaration/type/promotion-no-puns.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/type/promotion-no-puns.hs
@@ -0,0 +1,5 @@
+{-# Language NoListTuplePuns #-}
+
+type X = (Int, String)
+
+type Y = [String, Int]
diff --git a/data/examples/declaration/type/wildcard-binders-out.hs b/data/examples/declaration/type/wildcard-binders-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/type/wildcard-binders-out.hs
@@ -0,0 +1,1 @@
+type Const a _ = a
diff --git a/data/examples/declaration/type/wildcard-binders.hs b/data/examples/declaration/type/wildcard-binders.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/type/wildcard-binders.hs
@@ -0,0 +1,1 @@
+type Const a _ = a
diff --git a/data/examples/declaration/value/function/arrow/proc-do-complex-out.hs b/data/examples/declaration/value/function/arrow/proc-do-complex-out.hs
--- a/data/examples/declaration/value/function/arrow/proc-do-complex-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-do-complex-out.hs
@@ -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
diff --git a/data/examples/declaration/value/function/arrow/proc-do-complex.hs b/data/examples/declaration/value/function/arrow/proc-do-complex.hs
--- a/data/examples/declaration/value/function/arrow/proc-do-complex.hs
+++ b/data/examples/declaration/value/function/arrow/proc-do-complex.hs
@@ -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
diff --git a/data/examples/declaration/value/function/arrow/proc-form-do-indent-out.hs b/data/examples/declaration/value/function/arrow/proc-form-do-indent-out.hs
--- a/data/examples/declaration/value/function/arrow/proc-form-do-indent-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-form-do-indent-out.hs
@@ -12,3 +12,10 @@
       (bindA -< y)
     |)
     z
+
+foo2 = proc () -> do
+  ( proc () ->
+      returnA -< ()
+    )
+    -<
+      ()
diff --git a/data/examples/declaration/value/function/arrow/proc-form-do-indent.hs b/data/examples/declaration/value/function/arrow/proc-form-do-indent.hs
--- a/data/examples/declaration/value/function/arrow/proc-form-do-indent.hs
+++ b/data/examples/declaration/value/function/arrow/proc-form-do-indent.hs
@@ -11,3 +11,8 @@
     bar
       (bindA -< y)
     |) z
+
+foo2 = proc () -> do
+  (proc () ->
+    returnA -< ()
+    ) -< ()
diff --git a/data/examples/declaration/value/function/arrow/proc-lambdas-out.hs b/data/examples/declaration/value/function/arrow/proc-lambdas-out.hs
--- a/data/examples/declaration/value/function/arrow/proc-lambdas-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-lambdas-out.hs
@@ -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
diff --git a/data/examples/declaration/value/function/awkward-comment-0-out.hs b/data/examples/declaration/value/function/awkward-comment-0-out.hs
--- a/data/examples/declaration/value/function/awkward-comment-0-out.hs
+++ b/data/examples/declaration/value/function/awkward-comment-0-out.hs
@@ -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)
diff --git a/data/examples/declaration/value/function/awkward-comment-1-out.hs b/data/examples/declaration/value/function/awkward-comment-1-out.hs
--- a/data/examples/declaration/value/function/awkward-comment-1-out.hs
+++ b/data/examples/declaration/value/function/awkward-comment-1-out.hs
@@ -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
diff --git a/data/examples/declaration/value/function/case-comment-after-pattern-out.hs b/data/examples/declaration/value/function/case-comment-after-pattern-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-comment-after-pattern-out.hs
@@ -0,0 +1,3 @@
+foo = case a of
+  b -> -- comment
+    c
diff --git a/data/examples/declaration/value/function/case-comment-after-pattern.hs b/data/examples/declaration/value/function/case-comment-after-pattern.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-comment-after-pattern.hs
@@ -0,0 +1,3 @@
+foo = case a of
+  b -- comment
+    -> c
diff --git a/data/examples/declaration/value/function/case-comment-between-alt-and-where-out.hs b/data/examples/declaration/value/function/case-comment-between-alt-and-where-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-comment-between-alt-and-where-out.hs
@@ -0,0 +1,6 @@
+foo =
+  case x of
+    _ -> 1
+  -- comment
+  where
+    x = 1
diff --git a/data/examples/declaration/value/function/case-comment-between-alt-and-where.hs b/data/examples/declaration/value/function/case-comment-between-alt-and-where.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-comment-between-alt-and-where.hs
@@ -0,0 +1,6 @@
+foo =
+  case x of
+    _ -> 1
+    -- comment
+    where
+      x = 1
diff --git a/data/examples/declaration/value/function/case-multi-line-out.hs b/data/examples/declaration/value/function/case-multi-line-out.hs
--- a/data/examples/declaration/value/function/case-multi-line-out.hs
+++ b/data/examples/declaration/value/function/case-multi-line-out.hs
@@ -21,7 +21,6 @@
 quux x = case x of
   x -> x
 
-funnyComment =
-  -- comment
+funnyComment = -- comment
   case () of
     () -> ()
diff --git a/data/examples/declaration/value/function/case-single-line-with-braces-out.hs b/data/examples/declaration/value/function/case-single-line-with-braces-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-single-line-with-braces-out.hs
@@ -0,0 +1,2 @@
+getValue :: Maybe Int -> Int
+getValue x = case x of Just n -> n; Nothing -> 0
diff --git a/data/examples/declaration/value/function/case-single-line-with-braces.hs b/data/examples/declaration/value/function/case-single-line-with-braces.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-single-line-with-braces.hs
@@ -0,0 +1,2 @@
+getValue :: Maybe Int -> Int
+getValue x = case x of {Just n -> n; Nothing -> 0}
diff --git a/data/examples/declaration/value/function/case-with-comment-before-where-out.hs b/data/examples/declaration/value/function/case-with-comment-before-where-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-with-comment-before-where-out.hs
@@ -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
diff --git a/data/examples/declaration/value/function/case-with-comment-before-where.hs b/data/examples/declaration/value/function/case-with-comment-before-where.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-with-comment-before-where.hs
@@ -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
diff --git a/data/examples/declaration/value/function/do-multiline-with-case-out.hs b/data/examples/declaration/value/function/do-multiline-with-case-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-multiline-with-case-out.hs
@@ -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
diff --git a/data/examples/declaration/value/function/do-multiline-with-case.hs b/data/examples/declaration/value/function/do-multiline-with-case.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-multiline-with-case.hs
@@ -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
diff --git a/data/examples/declaration/value/function/do-single-line-case-guards-out.hs b/data/examples/declaration/value/function/do-single-line-case-guards-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-case-guards-out.hs
@@ -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" }
diff --git a/data/examples/declaration/value/function/do-single-line-case-guards.hs b/data/examples/declaration/value/function/do-single-line-case-guards.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-case-guards.hs
@@ -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"}}
diff --git a/data/examples/declaration/value/function/do-single-line-lambda-case-out.hs b/data/examples/declaration/value/function/do-single-line-lambda-case-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-lambda-case-out.hs
@@ -0,0 +1,2 @@
+processValue :: Maybe Int -> IO ()
+processValue x = do putStrLn "Processing:"; \case { Just n -> print n; Nothing -> putStrLn "Empty" } x; putStrLn "Done"
diff --git a/data/examples/declaration/value/function/do-single-line-lambda-case.hs b/data/examples/declaration/value/function/do-single-line-lambda-case.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-lambda-case.hs
@@ -0,0 +1,2 @@
+processValue :: Maybe Int -> IO ()
+processValue x = do {putStrLn "Processing:"; \case {Just n -> print n; Nothing -> putStrLn "Empty"} x; putStrLn "Done"}
diff --git a/data/examples/declaration/value/function/do-single-line-multiple-cases-out.hs b/data/examples/declaration/value/function/do-single-line-multiple-cases-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-multiple-cases-out.hs
@@ -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" }
diff --git a/data/examples/declaration/value/function/do-single-line-multiple-cases.hs b/data/examples/declaration/value/function/do-single-line-multiple-cases.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-multiple-cases.hs
@@ -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"}}
diff --git a/data/examples/declaration/value/function/do-single-line-nested-case-out.hs b/data/examples/declaration/value/function/do-single-line-nested-case-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-nested-case-out.hs
@@ -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"
diff --git a/data/examples/declaration/value/function/do-single-line-nested-case.hs b/data/examples/declaration/value/function/do-single-line-nested-case.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-nested-case.hs
@@ -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"}
diff --git a/data/examples/declaration/value/function/do-single-line-with-case-out.hs b/data/examples/declaration/value/function/do-single-line-with-case-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-with-case-out.hs
@@ -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!" }
diff --git a/data/examples/declaration/value/function/do-single-line-with-case.hs b/data/examples/declaration/value/function/do-single-line-with-case.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-with-case.hs
@@ -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!"}}
diff --git a/data/examples/declaration/value/function/guards-out.hs b/data/examples/declaration/value/function/guards-out.hs
--- a/data/examples/declaration/value/function/guards-out.hs
+++ b/data/examples/declaration/value/function/guards-out.hs
@@ -10,3 +10,5 @@
 quux :: Int -> Int
 quux x | x < 0 = x
 quux x = x
+
+(a, b) | c = d
diff --git a/data/examples/declaration/value/function/guards.hs b/data/examples/declaration/value/function/guards.hs
--- a/data/examples/declaration/value/function/guards.hs
+++ b/data/examples/declaration/value/function/guards.hs
@@ -10,3 +10,5 @@
 quux :: Int -> Int
 quux x | x < 0 = x
 quux x = x
+
+(a, b) | c = d
diff --git a/data/examples/declaration/value/function/infix/dollar-chains-1-out.hs b/data/examples/declaration/value/function/infix/dollar-chains-1-out.hs
--- a/data/examples/declaration/value/function/infix/dollar-chains-1-out.hs
+++ b/data/examples/declaration/value/function/infix/dollar-chains-1-out.hs
@@ -13,9 +13,9 @@
     throwIO (OrmoluCppEnabled path)
 
 foo =
-  bar $
-    baz $
-      quux
+  bar
+    $ baz
+    $ quux
 
 x =
   case l of { A -> B } $
diff --git a/data/examples/declaration/value/function/infix/dollar-chains-3-out.hs b/data/examples/declaration/value/function/infix/dollar-chains-3-out.hs
--- a/data/examples/declaration/value/function/infix/dollar-chains-3-out.hs
+++ b/data/examples/declaration/value/function/infix/dollar-chains-3-out.hs
@@ -1,11 +1,11 @@
 ex1 =
-  f1 $
-    arg1 $
-      arg2 $
-        arg3
+  f1
+    $ arg1
+    $ arg2
+    $ arg3
 
 ex3 =
-  f1 $
-    arg1 $
-      arg2 $
-        1 + 3
+  f1
+    $ arg1
+    $ arg2
+    $ 1 + 3
diff --git a/data/examples/declaration/value/function/infix/dollar-chains-4-out.hs b/data/examples/declaration/value/function/infix/dollar-chains-4-out.hs
--- a/data/examples/declaration/value/function/infix/dollar-chains-4-out.hs
+++ b/data/examples/declaration/value/function/infix/dollar-chains-4-out.hs
@@ -1,5 +1,5 @@
 ex2 =
-  f1 $
-    arg1 $
-      arg2 $
-        f2 arg3
+  f1
+    $ arg1
+    $ arg2
+    $ f2 arg3
diff --git a/data/examples/declaration/value/function/infix/fractional-precedence-out.hs b/data/examples/declaration/value/function/infix/fractional-precedence-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/infix/fractional-precedence-out.hs
@@ -0,0 +1,3 @@
+startFormTok |~| messageTag
+  >~< startMessageTok |~| name
+  >~< p' |~| endMessageTok |~| endFormTok
diff --git a/data/examples/declaration/value/function/infix/fractional-precedence.hs b/data/examples/declaration/value/function/infix/fractional-precedence.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/infix/fractional-precedence.hs
@@ -0,0 +1,3 @@
+startFormTok |~| messageTag
+  >~< startMessageTok |~| name
+  >~< p' |~| endMessageTok |~| endFormTok
diff --git a/data/examples/declaration/value/function/infix/lenses-out.hs b/data/examples/declaration/value/function/infix/lenses-out.hs
--- a/data/examples/declaration/value/function/infix/lenses-out.hs
+++ b/data/examples/declaration/value/function/infix/lenses-out.hs
@@ -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
diff --git a/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-1-out.hs b/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-1-out.hs
--- a/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-1-out.hs
+++ b/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-1-out.hs
@@ -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
diff --git a/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-2-out.hs b/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-2-out.hs
--- a/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-2-out.hs
+++ b/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-2-out.hs
@@ -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
diff --git a/data/examples/declaration/value/function/infix/op-chain-r-s-dollar-out.hs b/data/examples/declaration/value/function/infix/op-chain-r-s-dollar-out.hs
--- a/data/examples/declaration/value/function/infix/op-chain-r-s-dollar-out.hs
+++ b/data/examples/declaration/value/function/infix/op-chain-r-s-dollar-out.hs
@@ -1,7 +1,7 @@
 -- Right chain, $ case, 1 operator type
 c :: Int
 c =
-  1 $
-    2 $
-      3 $
-        4
+  1
+    $ 2
+    $ 3
+    $ 4
diff --git a/data/examples/declaration/value/function/infix/qualified-ops-out.hs b/data/examples/declaration/value/function/infix/qualified-ops-out.hs
--- a/data/examples/declaration/value/function/infix/qualified-ops-out.hs
+++ b/data/examples/declaration/value/function/infix/qualified-ops-out.hs
@@ -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.# []
diff --git a/data/examples/declaration/value/function/lambda-comment-after-arrow-out.hs b/data/examples/declaration/value/function/lambda-comment-after-arrow-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/lambda-comment-after-arrow-out.hs
@@ -0,0 +1,2 @@
+f = \a -> -- foo
+  a
diff --git a/data/examples/declaration/value/function/lambda-comment-after-arrow.hs b/data/examples/declaration/value/function/lambda-comment-after-arrow.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/lambda-comment-after-arrow.hs
@@ -0,0 +1,2 @@
+f = \a -> -- foo
+  a
diff --git a/data/examples/declaration/value/function/linear-bindings-out.hs b/data/examples/declaration/value/function/linear-bindings-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/linear-bindings-out.hs
@@ -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 ()
diff --git a/data/examples/declaration/value/function/linear-bindings.hs b/data/examples/declaration/value/function/linear-bindings.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/linear-bindings.hs
@@ -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 ()
diff --git a/data/examples/declaration/value/function/multi-way-if-out.hs b/data/examples/declaration/value/function/multi-way-if-out.hs
--- a/data/examples/declaration/value/function/multi-way-if-out.hs
+++ b/data/examples/declaration/value/function/multi-way-if-out.hs
@@ -14,3 +14,5 @@
       | p -> f
       | otherwise -> g
     x
+
+x y = if | foo -> False | otherwise -> True
diff --git a/data/examples/declaration/value/function/multi-way-if.hs b/data/examples/declaration/value/function/multi-way-if.hs
--- a/data/examples/declaration/value/function/multi-way-if.hs
+++ b/data/examples/declaration/value/function/multi-way-if.hs
@@ -12,3 +12,5 @@
   if | p -> f
      | otherwise -> g
     x
+
+x y = if | foo -> False | otherwise -> True
diff --git a/data/examples/declaration/value/function/multiline-strings-0-out.hs b/data/examples/declaration/value/function/multiline-strings-0-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-0-out.hs
@@ -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"
diff --git a/data/examples/declaration/value/function/multiline-strings-0.hs b/data/examples/declaration/value/function/multiline-strings-0.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-0.hs
@@ -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"
diff --git a/data/examples/declaration/value/function/multiline-strings-1-out.hs b/data/examples/declaration/value/function/multiline-strings-1-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-1-out.hs
@@ -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"""
diff --git a/data/examples/declaration/value/function/multiline-strings-1.hs b/data/examples/declaration/value/function/multiline-strings-1.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-1.hs
@@ -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"""
diff --git a/data/examples/declaration/value/function/multiline-strings-2-out.hs b/data/examples/declaration/value/function/multiline-strings-2-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-2-out.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE MultilineStrings #-}
+
+s =
+  """
+  a
+  b
+  c
+  """
+
+-- equivalent to
+s' = "a\nb\nc"
diff --git a/data/examples/declaration/value/function/multiline-strings-2.hs b/data/examples/declaration/value/function/multiline-strings-2.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-2.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE MultilineStrings #-}
+
+s =
+	"""
+	        a
+	 	b
+	    	c
+	"""
+
+-- equivalent to
+s' = "a\nb\nc"
diff --git a/data/examples/declaration/value/function/multiline-strings-3-out.hs b/data/examples/declaration/value/function/multiline-strings-3-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-3-out.hs
@@ -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"
diff --git a/data/examples/declaration/value/function/multiline-strings-3.hs b/data/examples/declaration/value/function/multiline-strings-3.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-3.hs
@@ -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"
diff --git a/data/examples/declaration/value/function/multiline-strings-4-out.hs b/data/examples/declaration/value/function/multiline-strings-4-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-4-out.hs
@@ -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
+  """
diff --git a/data/examples/declaration/value/function/multiline-strings-4.hs b/data/examples/declaration/value/function/multiline-strings-4.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-4.hs
@@ -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
+  """
diff --git a/data/examples/declaration/value/function/multiline-strings-5-out.hs b/data/examples/declaration/value/function/multiline-strings-5-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-5-out.hs
@@ -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"
diff --git a/data/examples/declaration/value/function/multiline-strings-5.hs b/data/examples/declaration/value/function/multiline-strings-5.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-5.hs
@@ -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"
diff --git a/data/examples/declaration/value/function/multiline-strings-6-out.hs b/data/examples/declaration/value/function/multiline-strings-6-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-6-out.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE MultilineStrings #-}
+
+x =
+  """
+  This is a literal multiline string:
+  \"\"\"
+  Hello
+    world!
+  \"""
+  """
diff --git a/data/examples/declaration/value/function/multiline-strings-6.hs b/data/examples/declaration/value/function/multiline-strings-6.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-6.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE MultilineStrings #-}
+
+x =
+  """
+  This is a literal multiline string:
+  \"\"\"
+  Hello
+    world!
+  \"""
+  """
diff --git a/data/examples/declaration/value/function/multiline-strings-7-out.hs b/data/examples/declaration/value/function/multiline-strings-7-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-7-out.hs
@@ -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)
diff --git a/data/examples/declaration/value/function/multiline-strings-7.hs b/data/examples/declaration/value/function/multiline-strings-7.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-7.hs
@@ -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)
diff --git a/data/examples/declaration/value/function/multiline-strings-8-out.hs b/data/examples/declaration/value/function/multiline-strings-8-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-8-out.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE MultilineStrings #-}
+
+type Foo =
+  """
+  yeah
+    yeah"""
+
+foo =
+  foo
+    @"""yeah
+     yeah
+     """
diff --git a/data/examples/declaration/value/function/multiline-strings-8.hs b/data/examples/declaration/value/function/multiline-strings-8.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-8.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE MultilineStrings #-}
+
+type Foo = """
+  yeah
+    yeah"""
+
+foo = foo @"""yeah
+           yeah
+           """
diff --git a/data/examples/declaration/value/function/multiline-strings-9-out.hs b/data/examples/declaration/value/function/multiline-strings-9-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-9-out.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE MultilineStrings #-}
+
+multilineBlank =
+  """
+  1
+
+
+
+
+  6
+  """
diff --git a/data/examples/declaration/value/function/multiline-strings-9.hs b/data/examples/declaration/value/function/multiline-strings-9.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-9.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE MultilineStrings #-}
+
+multilineBlank =
+  """
+  1
+
+
+
+
+  6
+  """
diff --git a/data/examples/declaration/value/function/newline-single-line-body-out.hs b/data/examples/declaration/value/function/newline-single-line-body-out.hs
--- a/data/examples/declaration/value/function/newline-single-line-body-out.hs
+++ b/data/examples/declaration/value/function/newline-single-line-body-out.hs
@@ -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"
diff --git a/data/examples/declaration/value/function/operator-comments-3-out.hs b/data/examples/declaration/value/function/operator-comments-3-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/operator-comments-3-out.hs
@@ -0,0 +1,5 @@
+data X = X {x :: Int}
+
+f =
+  id
+    . (\s -> s {x = 1}) -- Some comment
diff --git a/data/examples/declaration/value/function/operator-comments-3.hs b/data/examples/declaration/value/function/operator-comments-3.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/operator-comments-3.hs
@@ -0,0 +1,5 @@
+data X = X { x :: Int }
+
+f = id
+    . -- Some comment
+    (\s -> s { x = 1 })
diff --git a/data/examples/declaration/value/function/operator-comments-4-out.hs b/data/examples/declaration/value/function/operator-comments-4-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/operator-comments-4-out.hs
@@ -0,0 +1,4 @@
+foo = do
+  bar
+    -- txt
+    $ baz
diff --git a/data/examples/declaration/value/function/operator-comments-4.hs b/data/examples/declaration/value/function/operator-comments-4.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/operator-comments-4.hs
@@ -0,0 +1,4 @@
+foo = do
+  bar
+    -- txt
+    $ baz
diff --git a/data/examples/declaration/value/function/pattern/or-patterns-out.hs b/data/examples/declaration/value/function/pattern/or-patterns-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/pattern/or-patterns-out.hs
@@ -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
diff --git a/data/examples/declaration/value/function/pattern/or-patterns.hs b/data/examples/declaration/value/function/pattern/or-patterns.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/pattern/or-patterns.hs
@@ -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
diff --git a/data/examples/declaration/value/function/record/wildcard-comments-0-out.hs b/data/examples/declaration/value/function/record/wildcard-comments-0-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/record/wildcard-comments-0-out.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE RecordWildCards #-}
+
+example =
+  Record
+    { -- A
+      field = (), -- B
+      -- C
+      field = (), -- D
+      -- E
+      -- F
+      ..
+    } -- G
diff --git a/data/examples/declaration/value/function/record/wildcard-comments-0.hs b/data/examples/declaration/value/function/record/wildcard-comments-0.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/record/wildcard-comments-0.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE RecordWildCards #-}
+
+example =
+  Record
+    { -- A
+      field = (), -- B
+      -- C
+      field = (), -- D
+      -- E
+      .. -- F
+    } -- G
diff --git a/data/examples/declaration/value/function/record/wildcard-comments-1-out.hs b/data/examples/declaration/value/function/record/wildcard-comments-1-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/record/wildcard-comments-1-out.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE RecordWildCards #-}
+
+example =
+  Record
+    { -- A
+      field = (),
+      -- C
+      field = (),
+      -- E
+      -- F
+      ..
+    } -- G
diff --git a/data/examples/declaration/value/function/record/wildcard-comments-1.hs b/data/examples/declaration/value/function/record/wildcard-comments-1.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/record/wildcard-comments-1.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE RecordWildCards #-}
+
+example =
+  Record
+    { -- A
+      field = (),
+      -- C
+      field = (),
+      -- E
+      .. -- F
+    } -- G
diff --git a/data/examples/declaration/value/function/required-type-arguments-2-out.hs b/data/examples/declaration/value/function/required-type-arguments-2-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/required-type-arguments-2-out.hs
@@ -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
+    )
diff --git a/data/examples/declaration/value/function/required-type-arguments-2.hs b/data/examples/declaration/value/function/required-type-arguments-2.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/required-type-arguments-2.hs
@@ -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 )
diff --git a/data/examples/declaration/value/function/strings-out.hs b/data/examples/declaration/value/function/strings-out.hs
--- a/data/examples/declaration/value/function/strings-out.hs
+++ b/data/examples/declaration/value/function/strings-out.hs
@@ -2,9 +2,13 @@
 
 foo = "foobar"
 
-bar = "foo\&barbaz"
+bar = "foo\&bar\ \baz"
 
 baz =
   "foo\
   \bar\
   \baz"
+
+weirdGap = "\65\ \0"
+
+weirdEscape = "\^\ "
diff --git a/data/examples/declaration/value/function/strings.hs b/data/examples/declaration/value/function/strings.hs
--- a/data/examples/declaration/value/function/strings.hs
+++ b/data/examples/declaration/value/function/strings.hs
@@ -5,3 +5,7 @@
 baz = "foo\
       \bar\
     \baz"
+
+weirdGap = "\65\ \0"
+
+weirdEscape = "\^\ "
diff --git a/data/examples/declaration/value/function/type-applications-out.hs b/data/examples/declaration/value/function/type-applications-out.hs
--- a/data/examples/declaration/value/function/type-applications-out.hs
+++ b/data/examples/declaration/value/function/type-applications-out.hs
@@ -22,3 +22,5 @@
     @u
     v ->
       ""
+
+foo = foo @[k|bar|]
diff --git a/data/examples/declaration/value/function/type-applications.hs b/data/examples/declaration/value/function/type-applications.hs
--- a/data/examples/declaration/value/function/type-applications.hs
+++ b/data/examples/declaration/value/function/type-applications.hs
@@ -17,3 +17,5 @@
   Bar
    @t @u v
     -> ""
+
+foo = foo @[k|bar|]
diff --git a/data/examples/fixity/megaparsec-alternative-out.hs b/data/examples/fixity/megaparsec-alternative-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/megaparsec-alternative-out.hs
@@ -0,0 +1,8 @@
+module MegaparsecExample where
+
+import Text.Megaparsec
+
+pValue =
+  Object <$> parseObjectBody
+    <|> Array <$> parseArrayBody
+    <|> String <$> parseStringBody
diff --git a/data/examples/fixity/megaparsec-alternative.hs b/data/examples/fixity/megaparsec-alternative.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/megaparsec-alternative.hs
@@ -0,0 +1,8 @@
+module MegaparsecExample where
+
+import Text.Megaparsec
+
+pValue =
+  Object <$> parseObjectBody
+    <|> Array <$> parseArrayBody
+    <|> String <$> parseStringBody
diff --git a/data/examples/fixity/optics-mixed-out.hs b/data/examples/fixity/optics-mixed-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/optics-mixed-out.hs
@@ -0,0 +1,8 @@
+module OpticsExample where
+
+import Optics
+
+updated =
+  record
+    & fieldLens % subFieldLens .~ someValue
+    & otherLens %~ someTransformationFunctionApplied
diff --git a/data/examples/fixity/optics-mixed.hs b/data/examples/fixity/optics-mixed.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/optics-mixed.hs
@@ -0,0 +1,8 @@
+module OpticsExample where
+
+import Optics
+
+updated =
+  record
+    & fieldLens % subFieldLens .~ someValue
+    & otherLens %~ someTransformationFunctionApplied
diff --git a/data/examples/fixity/relude-default-operator-chain-out.hs b/data/examples/fixity/relude-default-operator-chain-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/relude-default-operator-chain-out.hs
@@ -0,0 +1,10 @@
+module ReludeChainExample where
+
+import Relude
+
+resolveValue =
+  primarySource
+    ?: secondarySource
+    ?: tertiarySource
+    ?: quaternarySource
+    ?: finalFallbackValue
diff --git a/data/examples/fixity/relude-default-operator-chain.hs b/data/examples/fixity/relude-default-operator-chain.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/relude-default-operator-chain.hs
@@ -0,0 +1,10 @@
+module ReludeChainExample where
+
+import Relude
+
+resolveValue =
+  primarySource
+    ?: secondarySource
+    ?: tertiarySource
+    ?: quaternarySource
+    ?: finalFallbackValue
diff --git a/data/examples/fixity/relude-default-operator-out.hs b/data/examples/fixity/relude-default-operator-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/relude-default-operator-out.hs
@@ -0,0 +1,7 @@
+module ReludeExample where
+
+import Relude
+
+config =
+  lookupOptionalSetting environment ?:
+    defaultConfigurationValue
diff --git a/data/examples/fixity/relude-default-operator.hs b/data/examples/fixity/relude-default-operator.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/relude-default-operator.hs
@@ -0,0 +1,7 @@
+module ReludeExample where
+
+import Relude
+
+config =
+  lookupOptionalSetting environment
+    ?: defaultConfigurationValue
diff --git a/data/examples/fixity/rio-ampersand-out.hs b/data/examples/fixity/rio-ampersand-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/rio-ampersand-out.hs
@@ -0,0 +1,7 @@
+module RioExample where
+
+import RIO
+
+message =
+  greetingText <> userNameText
+    & Text.strip
diff --git a/data/examples/fixity/rio-ampersand.hs b/data/examples/fixity/rio-ampersand.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/rio-ampersand.hs
@@ -0,0 +1,7 @@
+module RioExample where
+
+import RIO
+
+message =
+  greetingText <> userNameText
+    & Text.strip
diff --git a/data/examples/fixity/rio-deepseq-out.hs b/data/examples/fixity/rio-deepseq-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/rio-deepseq-out.hs
@@ -0,0 +1,7 @@
+module RioDeepseqExample where
+
+import RIO
+
+result =
+  forceEvaluationOfBigStructure `deepseq`
+    continueWithNextStep
diff --git a/data/examples/fixity/rio-deepseq.hs b/data/examples/fixity/rio-deepseq.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/rio-deepseq.hs
@@ -0,0 +1,7 @@
+module RioDeepseqExample where
+
+import RIO
+
+result =
+  forceEvaluationOfBigStructure
+    `deepseq` continueWithNextStep
diff --git a/data/examples/import/comment-before-merged-import-lists-out.hs b/data/examples/import/comment-before-merged-import-lists-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-before-merged-import-lists-out.hs
@@ -0,0 +1,7 @@
+-- their own formatters.
+import Test.Hspec.Core.Formatters.V1.Monad
+  ( FormatM,
+    Formatter (..),
+    Item (..),
+    interpretWith,
+  )
diff --git a/data/examples/import/comment-before-merged-import-lists.hs b/data/examples/import/comment-before-merged-import-lists.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-before-merged-import-lists.hs
@@ -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)
diff --git a/data/examples/import/comment-before-merged-imports-out.hs b/data/examples/import/comment-before-merged-imports-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-before-merged-imports-out.hs
@@ -0,0 +1,7 @@
+-- Import stuff from Prelude explicitly
+import Prelude
+  ( Eq (..),
+    Int,
+    ($),
+    (.),
+  )
diff --git a/data/examples/import/comment-before-merged-imports.hs b/data/examples/import/comment-before-merged-imports.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-before-merged-imports.hs
@@ -0,0 +1,3 @@
+-- Import stuff from Prelude explicitly
+import Prelude (Eq(..), Int)
+import Prelude ((.), ($))
diff --git a/data/examples/import/comment-between-merged-imports-out.hs b/data/examples/import/comment-between-merged-imports-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-between-merged-imports-out.hs
@@ -0,0 +1,7 @@
+import HscMain (newHscEnv)
+-- Implementations of the various modes
+import LoadIface
+  ( -- Imports for --abi-hash
+    loadUserInterface,
+    showIface,
+  )
diff --git a/data/examples/import/comment-between-merged-imports.hs b/data/examples/import/comment-between-merged-imports.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-between-merged-imports.hs
@@ -0,0 +1,6 @@
+-- Implementations of the various modes
+import           LoadIface ( showIface )
+import           HscMain ( newHscEnv )
+
+-- Imports for --abi-hash
+import           LoadIface ( loadUserInterface )
diff --git a/data/examples/import/comment-inside-empty-import-list-out.hs b/data/examples/import/comment-inside-empty-import-list-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-inside-empty-import-list-out.hs
@@ -0,0 +1,6 @@
+import Package1
+import Package2
+import Package3
+  (
+  -- , import1
+  )
diff --git a/data/examples/import/comment-inside-empty-import-list.hs b/data/examples/import/comment-inside-empty-import-list.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-inside-empty-import-list.hs
@@ -0,0 +1,5 @@
+import Package1
+import Package3 (
+ -- , import1
+ )
+import Package2
diff --git a/data/examples/import/comment-inside-sorted-import-list-out.hs b/data/examples/import/comment-inside-sorted-import-list-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-inside-sorted-import-list-out.hs
@@ -0,0 +1,7 @@
+import Package1
+import Package2
+import Package3
+  ( hi,
+    -- , import1
+    test,
+  )
diff --git a/data/examples/import/comment-inside-sorted-import-list.hs b/data/examples/import/comment-inside-sorted-import-list.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-inside-sorted-import-list.hs
@@ -0,0 +1,7 @@
+import Package1
+import Package3 (
+ hi,
+ -- , import1
+ test,
+ )
+import Package2
diff --git a/data/examples/import/comments-inside-imports-out.hs b/data/examples/import/comments-inside-imports-out.hs
--- a/data/examples/import/comments-inside-imports-out.hs
+++ b/data/examples/import/comments-inside-imports-out.hs
@@ -1,7 +1,6 @@
--- x
-
 import qualified -- x
   Bar
 import qualified -- x
   Baz
-import Foo
+import -- x
+  Foo
diff --git a/data/examples/import/comments-per-import-out.hs b/data/examples/import/comments-per-import-out.hs
--- a/data/examples/import/comments-per-import-out.hs
+++ b/data/examples/import/comments-per-import-out.hs
@@ -1,4 +1,3 @@
--- (1)
 import Bar -- (2)
 import Baz -- (3)
-import Foo
+import Foo -- (1)
diff --git a/data/examples/import/data-out.hs b/data/examples/import/data-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/data-out.hs
@@ -0,0 +1,7 @@
+module Bar (data P, T (data P), data f) where
+
+import N
+  ( T (data P),
+    data P,
+    data f,
+  )
diff --git a/data/examples/import/data.hs b/data/examples/import/data.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/data.hs
@@ -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)
diff --git a/data/examples/import/explicit-imports-with-comments-out.hs b/data/examples/import/explicit-imports-with-comments-out.hs
--- a/data/examples/import/explicit-imports-with-comments-out.hs
+++ b/data/examples/import/explicit-imports-with-comments-out.hs
@@ -1,7 +1,5 @@
 import qualified MegaModule as M
-  ( -- (1)
-    -- (2)
-    Either, -- (3)
-    (<<<),
-    (>>>),
+  ( Either, -- (3)
+    (<<<), -- (2)
+    (>>>), -- (1)
   )
diff --git a/data/examples/import/explicit-level-imports-out.hs b/data/examples/import/explicit-level-imports-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/explicit-level-imports-out.hs
@@ -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)
diff --git a/data/examples/import/explicit-level-imports-qualified-post-out.hs b/data/examples/import/explicit-level-imports-qualified-post-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/explicit-level-imports-qualified-post-out.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE ExplicitLevelImports #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+
+import quote A qualified as QA
+import B quote qualified as QB
diff --git a/data/examples/import/explicit-level-imports-qualified-post.hs b/data/examples/import/explicit-level-imports-qualified-post.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/explicit-level-imports-qualified-post.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE ExplicitLevelImports #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+
+import qualified B quote as QB
+import quote qualified A as QA
diff --git a/data/examples/import/explicit-level-imports.hs b/data/examples/import/explicit-level-imports.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/explicit-level-imports.hs
@@ -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 ()
diff --git a/data/examples/import/implicit-prelude-package-out.hs b/data/examples/import/implicit-prelude-package-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/implicit-prelude-package-out.hs
@@ -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 ((+))
diff --git a/data/examples/import/implicit-prelude-package.hs b/data/examples/import/implicit-prelude-package.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/implicit-prelude-package.hs
@@ -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)
diff --git a/data/examples/import/merging-0-out.hs b/data/examples/import/merging-0-out.hs
--- a/data/examples/import/merging-0-out.hs
+++ b/data/examples/import/merging-0-out.hs
@@ -1,3 +1,6 @@
 import Foo
-import Foo (bar, foo)
+import Foo
+  ( bar,
+    foo,
+  )
 import Foo as F
diff --git a/data/examples/import/merging-1-out.hs b/data/examples/import/merging-1-out.hs
--- a/data/examples/import/merging-1-out.hs
+++ b/data/examples/import/merging-1-out.hs
@@ -1,2 +1,5 @@
 import "bar" Foo (bar)
-import "foo" Foo (baz, foo)
+import "foo" Foo
+  ( baz,
+    foo,
+  )
diff --git a/data/examples/import/merging-2-out.hs b/data/examples/import/merging-2-out.hs
--- a/data/examples/import/merging-2-out.hs
+++ b/data/examples/import/merging-2-out.hs
@@ -1,2 +1,8 @@
-import Foo hiding (bar4, foo2)
-import qualified Foo (bar3, foo1)
+import Foo hiding
+  ( bar4,
+    foo2,
+  )
+import qualified Foo
+  ( bar3,
+    foo1,
+  )
diff --git a/data/examples/import/no-implicit-prelude-out.hs b/data/examples/import/no-implicit-prelude-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/no-implicit-prelude-out.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+import Control.Applicative (Alternative, (<|>))
+import Data.Maybe (Maybe (Nothing), maybe)
+import Prelude ((+))
+import System.IO (IO)
diff --git a/data/examples/import/no-implicit-prelude-package-out.hs b/data/examples/import/no-implicit-prelude-package-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/no-implicit-prelude-package-out.hs
@@ -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)
diff --git a/data/examples/import/no-implicit-prelude-package.hs b/data/examples/import/no-implicit-prelude-package.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/no-implicit-prelude-package.hs
@@ -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)
diff --git a/data/examples/import/no-implicit-prelude.hs b/data/examples/import/no-implicit-prelude.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/no-implicit-prelude.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+import System.IO (IO)
+import Prelude ((+))
+import Control.Applicative (Alternative, (<|>))
+import Data.Maybe (Maybe (Nothing), maybe)
diff --git a/data/examples/import/simple-out.hs b/data/examples/import/simple-out.hs
--- a/data/examples/import/simple-out.hs
+++ b/data/examples/import/simple-out.hs
@@ -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
diff --git a/data/examples/module-header/block-haddock-in-export-list-out.hs b/data/examples/module-header/block-haddock-in-export-list-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/module-header/block-haddock-in-export-list-out.hs
@@ -0,0 +1,5 @@
+module Foo
+  ( {- | asdf -}
+    foo,
+  )
+where
diff --git a/data/examples/module-header/block-haddock-in-export-list.hs b/data/examples/module-header/block-haddock-in-export-list.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/module-header/block-haddock-in-export-list.hs
@@ -0,0 +1,1 @@
+module Foo ({- | asdf -} foo) where
diff --git a/data/examples/module-header/empty-haddock-out.hs b/data/examples/module-header/empty-haddock-out.hs
--- a/data/examples/module-header/empty-haddock-out.hs
+++ b/data/examples/module-header/empty-haddock-out.hs
@@ -1,1 +1,3 @@
+-- \|
+--
 module Test where
diff --git a/data/examples/other/block-comment-before-argument-out.hs b/data/examples/other/block-comment-before-argument-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/block-comment-before-argument-out.hs
@@ -0,0 +1,5 @@
+checkPragma =
+  ifM
+    (anyM isBuiltin [builtinNat, builtinBool])
+    {-then-} ok
+    {-else-} notPostulate
diff --git a/data/examples/other/block-comment-before-argument.hs b/data/examples/other/block-comment-before-argument.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/block-comment-before-argument.hs
@@ -0,0 +1,4 @@
+checkPragma =
+        ifM (anyM isBuiltin [builtinNat, builtinBool])
+          {-then-} ok
+          {-else-} notPostulate
diff --git a/data/examples/other/block-comment-before-element-out.hs b/data/examples/other/block-comment-before-element-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/block-comment-before-element-out.hs
@@ -0,0 +1,6 @@
+eeExtensions =
+  catMaybes
+    [ {- 0x00 -} sniExt,
+      {- 0x0a -} groupExt,
+      {- 0x10 -} alpnExt
+    ]
diff --git a/data/examples/other/block-comment-before-element.hs b/data/examples/other/block-comment-before-element.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/block-comment-before-element.hs
@@ -0,0 +1,6 @@
+eeExtensions =
+    catMaybes
+        [ {- 0x00 -} sniExt
+        , {- 0x0a -} groupExt
+        , {- 0x10 -} alpnExt
+        ]
diff --git a/data/examples/other/comment-around-quasiquote-out.hs b/data/examples/other/comment-around-quasiquote-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-around-quasiquote-out.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+example =
+  [ -- A
+    [u||], -- B
+    -- C
+    [u||] -- D
+    -- E
+  ] -- F
diff --git a/data/examples/other/comment-around-quasiquote.hs b/data/examples/other/comment-around-quasiquote.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-around-quasiquote.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+example =
+  [ -- A
+    [u||], -- B
+    -- C
+    [u||] -- D
+    -- E
+  ] -- F
diff --git a/data/examples/other/comment-block-section-heading-out.hs b/data/examples/other/comment-block-section-heading-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-block-section-heading-out.hs
@@ -0,0 +1,3 @@
+{- ***
+   aaa
+-}
diff --git a/data/examples/other/comment-block-section-heading.hs b/data/examples/other/comment-block-section-heading.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-block-section-heading.hs
@@ -0,0 +1,3 @@
+{- ***
+   aaa
+-}
diff --git a/data/examples/other/comment-glued-together-out.hs b/data/examples/other/comment-glued-together-out.hs
--- a/data/examples/other/comment-glued-together-out.hs
+++ b/data/examples/other/comment-glued-together-out.hs
@@ -1,6 +1,6 @@
 module Main (main) where
 
--- | Foo.
+{- | Foo. -}
 
 -- Bar
 main :: IO ()
diff --git a/data/examples/other/comment-in-empty-list-out.hs b/data/examples/other/comment-in-empty-list-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-in-empty-list-out.hs
@@ -0,0 +1,9 @@
+tests_Cli_Utils =
+  testGroup
+    "Utils"
+    [
+
+    --  testGroup "journalApplyValue" [
+    --    testCase "time" $ do
+    --  ]
+    ]
diff --git a/data/examples/other/comment-in-empty-list.hs b/data/examples/other/comment-in-empty-list.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-in-empty-list.hs
@@ -0,0 +1,6 @@
+tests_Cli_Utils = testGroup "Utils" [
+
+  --  testGroup "journalApplyValue" [
+  --    testCase "time" $ do
+  --  ]
+  ]
diff --git a/data/examples/other/comment-opening-a-list-out.hs b/data/examples/other/comment-opening-a-list-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-opening-a-list-out.hs
@@ -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
+       ]
diff --git a/data/examples/other/comment-opening-a-list.hs b/data/examples/other/comment-opening-a-list.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-opening-a-list.hs
@@ -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
+  ]
diff --git a/data/examples/other/comment-style-transform-out.hs b/data/examples/other/comment-style-transform-out.hs
--- a/data/examples/other/comment-style-transform-out.hs
+++ b/data/examples/other/comment-style-transform-out.hs
@@ -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
diff --git a/data/examples/other/comment-trailing-blank-line-do-out.hs b/data/examples/other/comment-trailing-blank-line-do-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-do-out.hs
@@ -0,0 +1,4 @@
+doBlock = do
+  a --
+
+  b
diff --git a/data/examples/other/comment-trailing-blank-line-do.hs b/data/examples/other/comment-trailing-blank-line-do.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-do.hs
@@ -0,0 +1,4 @@
+doBlock = do
+  a --
+
+  b
diff --git a/data/examples/other/comment-trailing-blank-line-let-out.hs b/data/examples/other/comment-trailing-blank-line-let-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-let-out.hs
@@ -0,0 +1,5 @@
+letBlock =
+  let a = a --
+
+      b = b
+   in c
diff --git a/data/examples/other/comment-trailing-blank-line-let.hs b/data/examples/other/comment-trailing-blank-line-let.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-let.hs
@@ -0,0 +1,5 @@
+letBlock =
+  let a = a --
+
+      b = b
+   in c
diff --git a/data/examples/other/comment-trailing-blank-line-variants-out.hs b/data/examples/other/comment-trailing-blank-line-variants-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-variants-out.hs
@@ -0,0 +1,22 @@
+textComment = do
+  a -- some text
+
+  b
+
+blockComment = do
+  a {- foo -}
+
+  b
+
+twoComments = do
+  a --
+
+  --
+
+  bar
+
+adjacentThenBlank = do
+  a --
+  --
+
+  bar
diff --git a/data/examples/other/comment-trailing-blank-line-variants.hs b/data/examples/other/comment-trailing-blank-line-variants.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-variants.hs
@@ -0,0 +1,22 @@
+textComment = do
+  a -- some text
+
+  b
+
+blockComment = do
+  a {- foo -}
+
+  b
+
+twoComments = do
+  a --
+
+  --
+
+  bar
+
+adjacentThenBlank = do
+  a --
+  --
+
+  bar
diff --git a/data/examples/other/comment-trailing-blank-line-where-out.hs b/data/examples/other/comment-trailing-blank-line-where-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-where-out.hs
@@ -0,0 +1,5 @@
+whereBlock = foo
+  where
+    a = a --
+
+    b = b
diff --git a/data/examples/other/comment-trailing-blank-line-where.hs b/data/examples/other/comment-trailing-blank-line-where.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-where.hs
@@ -0,0 +1,5 @@
+whereBlock = foo
+  where
+    a = a --
+
+    b = b
diff --git a/data/examples/other/comment-trailing-no-blank-line-out.hs b/data/examples/other/comment-trailing-no-blank-line-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-no-blank-line-out.hs
@@ -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
diff --git a/data/examples/other/comment-trailing-no-blank-line.hs b/data/examples/other/comment-trailing-no-blank-line.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-no-blank-line.hs
@@ -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
diff --git a/data/examples/other/comment-trigger-escaping-out.hs b/data/examples/other/comment-trigger-escaping-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trigger-escaping-out.hs
@@ -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
diff --git a/data/examples/other/comment-trigger-escaping.hs b/data/examples/other/comment-trigger-escaping.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trigger-escaping.hs
@@ -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
diff --git a/data/examples/other/comment-two-blocks-out.hs b/data/examples/other/comment-two-blocks-out.hs
--- a/data/examples/other/comment-two-blocks-out.hs
+++ b/data/examples/other/comment-two-blocks-out.hs
@@ -2,7 +2,8 @@
 newNames =
   let (*) = flip (,)
    in [ "Control" * "Monad"
-  -- Foo
 
-  -- Bar
+      -- Foo
+
+      -- Bar
       ]
diff --git a/data/examples/other/empty-forall-out.hs b/data/examples/other/empty-forall-out.hs
--- a/data/examples/other/empty-forall-out.hs
+++ b/data/examples/other/empty-forall-out.hs
@@ -12,7 +12,7 @@
   forall. T x = x
 
 {-# RULES
-"r"
+"r" forall.
   r a =
     ()
   #-}
diff --git a/data/examples/other/empty-haddock-out.hs b/data/examples/other/empty-haddock-out.hs
--- a/data/examples/other/empty-haddock-out.hs
+++ b/data/examples/other/empty-haddock-out.hs
@@ -1,9 +1,13 @@
+-- \|
 module Test
-  ( test,
+  ( -- \|
+    test,
   )
 where
 
+-- \|
 test ::
+  -- \|
   test
 
-data T = T
+data T = T {- \^ -}
diff --git a/data/examples/other/invalid-haddock-weird-out.hs b/data/examples/other/invalid-haddock-weird-out.hs
--- a/data/examples/other/invalid-haddock-weird-out.hs
+++ b/data/examples/other/invalid-haddock-weird-out.hs
@@ -1,5 +1,3 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-foo = foo
-
--- \|# ${
+foo = foo -- \|# ${
diff --git a/data/examples/other/pragma-below-header-out.hs b/data/examples/other/pragma-below-header-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/pragma-below-header-out.hs
@@ -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 = ()
diff --git a/data/examples/other/pragma-below-header.hs b/data/examples/other/pragma-below-header.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/pragma-below-header.hs
@@ -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 = ()
diff --git a/data/examples/other/pragma-comment-multi-extension-out.hs b/data/examples/other/pragma-comment-multi-extension-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/pragma-comment-multi-extension-out.hs
@@ -0,0 +1,5 @@
+-- comment
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Foo where
diff --git a/data/examples/other/pragma-comment-multi-extension.hs b/data/examples/other/pragma-comment-multi-extension.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/pragma-comment-multi-extension.hs
@@ -0,0 +1,4 @@
+-- comment
+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
+
+module Foo where
diff --git a/extract-hackage-info/hackage-info.bin b/extract-hackage-info/hackage-info.bin
Binary files a/extract-hackage-info/hackage-info.bin and b/extract-hackage-info/hackage-info.bin differ
diff --git a/ormolu.cabal b/ormolu.cabal
--- a/ormolu.cabal
+++ b/ormolu.cabal
@@ -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
diff --git a/src/GHC/DynFlags.hs b/src/GHC/DynFlags.hs
--- a/src/GHC/DynFlags.hs
+++ b/src/GHC/DynFlags.hs
@@ -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,
diff --git a/src/Ormolu.hs b/src/Ormolu.hs
--- a/src/Ormolu.hs
+++ b/src/Ormolu.hs
@@ -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 ::
diff --git a/src/Ormolu/Comments/Anchor.hs b/src/Ormolu/Comments/Anchor.hs
new file mode 100644
--- /dev/null
+++ b/src/Ormolu/Comments/Anchor.hs
@@ -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)
diff --git a/src/Ormolu/Comments/Invariants.hs b/src/Ormolu/Comments/Invariants.hs
new file mode 100644
--- /dev/null
+++ b/src/Ormolu/Comments/Invariants.hs
@@ -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
diff --git a/src/Ormolu/Comments/Tree.hs b/src/Ormolu/Comments/Tree.hs
new file mode 100644
--- /dev/null
+++ b/src/Ormolu/Comments/Tree.hs
@@ -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)
diff --git a/src/Ormolu/Config.hs b/src/Ormolu/Config.hs
--- a/src/Ormolu/Config.hs
+++ b/src/Ormolu/Config.hs
@@ -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,
diff --git a/src/Ormolu/Diff/ParseResult.hs b/src/Ormolu/Diff/ParseResult.hs
--- a/src/Ormolu/Diff/ParseResult.hs
+++ b/src/Ormolu/Diff/ParseResult.hs
@@ -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) =>
diff --git a/src/Ormolu/Diff/Text.hs b/src/Ormolu/Diff/Text.hs
--- a/src/Ormolu/Diff/Text.hs
+++ b/src/Ormolu/Diff/Text.hs
@@ -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
diff --git a/src/Ormolu/Exception.hs b/src/Ormolu/Exception.hs
--- a/src/Ormolu/Exception.hs
+++ b/src/Ormolu/Exception.hs
@@ -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
diff --git a/src/Ormolu/Fixity.hs b/src/Ormolu/Fixity.hs
--- a/src/Ormolu/Fixity.hs
+++ b/src/Ormolu/Fixity.hs
@@ -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")
diff --git a/src/Ormolu/Fixity/Imports.hs b/src/Ormolu/Fixity/Imports.hs
--- a/src/Ormolu/Fixity/Imports.hs
+++ b/src/Ormolu/Fixity/Imports.hs
@@ -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
diff --git a/src/Ormolu/Fixity/Internal.hs b/src/Ormolu/Fixity/Internal.hs
--- a/src/Ormolu/Fixity/Internal.hs
+++ b/src/Ormolu/Fixity/Internal.hs
@@ -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.
diff --git a/src/Ormolu/Fixity/Parser.hs b/src/Ormolu/Fixity/Parser.hs
--- a/src/Ormolu/Fixity/Parser.hs
+++ b/src/Ormolu/Fixity/Parser.hs
@@ -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)
diff --git a/src/Ormolu/Fixity/Printer.hs b/src/Ormolu/Fixity/Printer.hs
--- a/src/Ormolu/Fixity/Printer.hs
+++ b/src/Ormolu/Fixity/Printer.hs
@@ -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
diff --git a/src/Ormolu/Imports.hs b/src/Ormolu/Imports.hs
--- a/src/Ormolu/Imports.hs
+++ b/src/Ormolu/Imports.hs
@@ -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 =
diff --git a/src/Ormolu/Parser.hs b/src/Ormolu/Parser.hs
--- a/src/Ormolu/Parser.hs
+++ b/src/Ormolu/Parser.hs
@@ -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
diff --git a/src/Ormolu/Parser/CommentStream.hs b/src/Ormolu/Parser/CommentStream.hs
--- a/src/Ormolu/Parser/CommentStream.hs
+++ b/src/Ormolu/Parser/CommentStream.hs
@@ -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
diff --git a/src/Ormolu/Parser/Pragma.hs b/src/Ormolu/Parser/Pragma.hs
--- a/src/Ormolu/Parser/Pragma.hs
+++ b/src/Ormolu/Parser/Pragma.hs
@@ -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,
diff --git a/src/Ormolu/Parser/Result.hs b/src/Ormolu/Parser/Result.hs
--- a/src/Ormolu/Parser/Result.hs
+++ b/src/Ormolu/Parser/Result.hs
@@ -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
diff --git a/src/Ormolu/Printer.hs b/src/Ormolu/Printer.hs
--- a/src/Ormolu/Printer.hs
+++ b/src/Ormolu/Printer.hs
@@ -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
diff --git a/src/Ormolu/Printer/Combinators.hs b/src/Ormolu/Printer/Combinators.hs
--- a/src/Ormolu/Printer/Combinators.hs
+++ b/src/Ormolu/Printer/Combinators.hs
@@ -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
diff --git a/src/Ormolu/Printer/CommentPlacement.hs b/src/Ormolu/Printer/CommentPlacement.hs
new file mode 100644
--- /dev/null
+++ b/src/Ormolu/Printer/CommentPlacement.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- | A record of where each comment ended up in the rendered output.
+--
+-- The printer notes every comment as it emits it. Ormolu then checks that
+-- record against the comments of the input, which is how it can promise
+-- that formatting neither drops, duplicates, invents nor reorders a
+-- comment; see "Ormolu.Comments.Invariants".
+module Ormolu.Printer.CommentPlacement
+  ( CommentPlacement (..),
+    CommentSlot (..),
+    slotAnchor,
+  )
+where
+
+import GHC.Types.SrcLoc
+
+----------------------------------------------------------------------------
+-- Types
+
+-- | Where a comment ended up relative to the AST element it was attached
+-- to.
+--
+-- Only the distinctions a consumer can act on are kept: whether the comment
+-- was attached to an element, and whether it rode along with a pragma. See
+-- "Ormolu.Comments.Invariants", which is what reads this.
+data CommentSlot
+  = -- | Attached to the element at this span
+    SlotAt RealSrcSpan
+  | -- | Hoisted into the module header along with a pragma. Pragmas are
+    -- sorted on purpose, so the order such a comment comes out in says
+    -- nothing.
+    SlotPragma
+  | -- | Attached to nothing: the Stack header, or a leftover flushed at the
+    -- end of the module by 'Ormolu.Printer.Comments.spitRemainingComments'
+    SlotFloating
+  deriving (Eq, Show)
+
+-- | The span of the AST element that a comment was attached to, if the
+-- comment was attached to an element at all.
+slotAnchor :: CommentSlot -> Maybe RealSrcSpan
+slotAnchor = \case
+  SlotAt spn -> Just spn
+  SlotPragma -> Nothing
+  SlotFloating -> Nothing
+
+-- | A single placement decision: one comment and the slot it was rendered
+-- in.
+data CommentPlacement = CommentPlacement
+  { -- | Span of the comment in the input, which is what identifies it
+    cpSpan :: RealSrcSpan,
+    -- | Where the comment ended up
+    cpSlot :: CommentSlot
+  }
+  deriving (Eq, Show)
diff --git a/src/Ormolu/Printer/Comments.hs b/src/Ormolu/Printer/Comments.hs
--- a/src/Ormolu/Printer/Comments.hs
+++ b/src/Ormolu/Printer/Comments.hs
@@ -1,6 +1,7 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
--- | Helpers for formatting of comments. This is low-level code, use
+-- | Helpers for formatting comments. This is low-level code; use
 -- "Ormolu.Printer.Combinators" unless you know what you are doing.
 module Ormolu.Printer.Comments
   ( spitPrecedingComments,
@@ -8,6 +9,7 @@
     spitRemainingComments,
     spitCommentNow,
     spitCommentPending,
+    CommentSlot (..),
   )
 where
 
@@ -15,151 +17,130 @@
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe (listToMaybe)
 import GHC.Types.SrcLoc
+import Ormolu.Comments.Anchor
 import Ormolu.Parser.CommentStream
+import Ormolu.Printer.CommentPlacement
 import Ormolu.Printer.Internal
 
 ----------------------------------------------------------------------------
 -- Top-level
 
--- | Output all preceding comments for an element at given location.
+-- | Output all preceding comments for an element at the given location.
 spitPrecedingComments ::
   -- | Span of the element to attach comments to
   RealSrcSpan ->
   R ()
 spitPrecedingComments ref = do
-  comments <- handleCommentSeries (spitPrecedingComment ref)
-  when (not $ null comments) $ do
-    lastMark <- getSpanMark
+  comments <- withAnchorMap (claimBefore ref)
+  forM_ comments (spitPrecedingComment ref)
+  unless (null comments) $ do
+    lastEmitted <- getLastEmitted
     -- Insert a blank line between the preceding comments and the thing
     -- after them if there was a blank line in the input.
-    when (needsNewlineBefore ref lastMark) newline
+    when (needsNewlineBefore ref lastEmitted) newline
 
--- | Output all comments following an element at given location.
+-- | Output all comments following an element at the given location.
 spitFollowingComments ::
   -- | Span of the element to attach comments to
   RealSrcSpan ->
   R ()
 spitFollowingComments ref = do
-  trimSpanStream ref
-  void $ handleCommentSeries (spitFollowingComment ref)
+  comments <- withAnchorMap (claimTrailing ref)
+  forM_ comments (spitFollowingComment ref)
 
--- | Output all remaining comments in the comment stream.
+-- | Output every comment that no element claimed.
+--
+-- This is the safety net that keeps a misattached comment from being lost
+-- outright. It also means misattachment is silent, which is why
+-- "Ormolu.Comments.Invariants" exists.
 spitRemainingComments :: R ()
 spitRemainingComments = do
-  -- Make sure we have a blank a line between the last definition and the
+  -- Make sure we have a blank line between the last definition and the
   -- trailing comments.
   newline
-  void $ handleCommentSeries spitRemainingComment
+  comments <- withAnchorMap claimRemaining
+  forM_ comments spitRemainingComment
 
 ----------------------------------------------------------------------------
 -- Single-comment functions
 
--- | Output a single preceding comment for an element at given location.
+-- | Output a single preceding comment for an element at the given location.
 spitPrecedingComment ::
-  -- | Span of the element to attach comments to
+  -- | Span of the element the comment is attached to
   RealSrcSpan ->
-  -- | The comment that was output, if any
-  R (Maybe LComment)
-spitPrecedingComment ref = do
-  mlastMark <- getSpanMark
-  let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref
-  withPoppedComment p $ \l comment -> do
-    lineSpans <- thisLineSpans
-    let thisCommentLine = srcLocLine (realSrcSpanStart l)
-        needsNewline =
-          case listToMaybe lineSpans of
-            Nothing -> False
-            Just spn -> srcLocLine (realSrcSpanEnd spn) /= thisCommentLine
-    when (needsNewline || needsNewlineBefore l mlastMark) newline
-    spitCommentNow l comment
-    if theSameLinePre l ref
-      then space
-      else newline
+  -- | The comment to output
+  LComment ->
+  R ()
+spitPrecedingComment ref (L l comment) = do
+  lastEmitted <- getLastEmitted
+  lineSpans <- thisLineSpans
+  let thisCommentLine = srcLocLine (realSrcSpanStart l)
+      needsNewline =
+        case listToMaybe lineSpans of
+          Nothing -> False
+          Just spn -> srcLocLine (realSrcSpanEnd spn) /= thisCommentLine
+      sameLine = theSameLinePre l ref
+  when (needsNewline || needsNewlineBefore l lastEmitted) newline
+  spitCommentNow (SlotAt ref) l comment
+  if sameLine
+    then space
+    else newline
 
--- | Output a comment that follows element at given location immediately on
--- the same line, if there is any.
+-- | Output a single comment that follows an element at the given location.
 spitFollowingComment ::
-  -- | AST element to attach comments to
+  -- | Span of the element the comment is attached to
   RealSrcSpan ->
-  -- | The comment that was output, if any
-  R (Maybe LComment)
-spitFollowingComment ref = do
-  mlastMark <- getSpanMark
-  mnSpn <- nextEltSpan
-  -- Get first enclosing span that is not equal to reference span, i.e. it's
-  -- truly something enclosing the AST element.
-  meSpn <- getEnclosingSpanWhere (/= ref)
-  withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment ->
-    if theSameLinePost l ref
-      then
-        if isMultilineComment comment
-          then space >> spitCommentNow l comment
-          else spitCommentPending OnTheSameLine l comment
-      else do
-        when (needsNewlineBefore l mlastMark) $
-          registerPendingCommentLine OnNextLine ""
-        spitCommentPending OnNextLine l comment
+  -- | The comment to output
+  LComment ->
+  R ()
+spitFollowingComment ref (L l comment) = do
+  lastEmitted <- getLastEmitted
+  if theSameLinePost l ref
+    then
+      if isMultilineComment comment
+        then space >> spitCommentNow (SlotAt ref) l comment
+        else spitCommentPending (SlotAt ref) OnTheSameLine l comment
+    else do
+      -- A comment keeps the blank line the input had in front of it. When
+      -- nothing carrying a position has been emitted since, the element the
+      -- comment is attached to is what that blank line separated it from.
+      let lastEmitted' = case lastEmittedSpan lastEmitted of
+            Just _ -> lastEmitted
+            Nothing -> LastEmittedComment ref
+      when (needsNewlineBefore l lastEmitted') $
+        registerPendingCommentLine OnNextLine ""
+      spitCommentPending (SlotAt ref) OnNextLine l comment
 
--- | Output a single remaining comment from the comment stream.
+-- | Output a single unclaimed comment.
 spitRemainingComment ::
-  -- | The comment that was output, if any
-  R (Maybe LComment)
-spitRemainingComment = do
-  mlastMark <- getSpanMark
-  withPoppedComment (const True) $ \l comment -> do
-    when (needsNewlineBefore l mlastMark) newline
-    spitCommentNow l comment
-    newline
+  -- | The comment to output
+  LComment ->
+  R ()
+spitRemainingComment (L l comment) = do
+  lastEmitted <- getLastEmitted
+  when (needsNewlineBefore l lastEmitted) newline
+  spitCommentNow SlotFloating l comment
+  newline
 
 ----------------------------------------------------------------------------
 -- Helpers
 
--- | Output series of comments.
-handleCommentSeries ::
-  -- | Output and return the next comment, if any
-  R (Maybe LComment) ->
-  -- | The comments outputted
-  R [LComment]
-handleCommentSeries f = go
-  where
-    go = do
-      mComment <- f
-      case mComment of
-        Nothing -> return []
-        Just comment -> (comment :) <$> go
-
--- | Try to pop a comment using given predicate and if there is a comment
--- matching the predicate, print it out.
-withPoppedComment ::
-  -- | Comment predicate
-  (LComment -> Bool) ->
-  -- | Printing function
-  (RealSrcSpan -> Comment -> R ()) ->
-  -- | Are we done?
-  R (Maybe LComment)
-withPoppedComment p f = do
-  r <- popComment p
-  case r of
-    Nothing -> return ()
-    Just (L l comment) -> f l comment
-  return r
-
--- | Determine if we need to insert a newline between current comment and
--- last printed comment.
+-- | Determine whether we need to insert a newline between the current
+-- comment and the last printed comment.
 needsNewlineBefore ::
   -- | Current comment span
   RealSrcSpan ->
-  -- | Last printed comment span
-  Maybe SpanMark ->
+  -- | What was emitted last
+  LastEmitted ->
   Bool
-needsNewlineBefore _ (Just (HaddockSpan _ _)) = True
-needsNewlineBefore l mlastMark =
-  case spanMarkSpan <$> mlastMark of
+needsNewlineBefore _ (LastEmittedHaddock _) = True
+needsNewlineBefore l lastEmitted =
+  case lastEmittedSpan lastEmitted of
     Nothing -> False
-    Just lastMark ->
-      srcSpanStartLine l > srcSpanEndLine lastMark + 1
+    Just lastSpn ->
+      srcSpanStartLine l > srcSpanEndLine lastSpn + 1
 
--- | Is the preceding comment and AST element are on the same line?
+-- | Are the preceding comment and the AST element on the same line?
 theSameLinePre ::
   -- | Current comment span
   RealSrcSpan ->
@@ -169,7 +150,7 @@
 theSameLinePre l ref =
   srcSpanEndLine l == srcSpanStartLine ref
 
--- | Is the following comment and AST element are on the same line?
+-- | Are the following comment and the AST element on the same line?
 theSameLinePost ::
   -- | Current comment span
   RealSrcSpan ->
@@ -179,99 +160,40 @@
 theSameLinePost l ref =
   srcSpanStartLine l == srcSpanEndLine ref
 
--- | Determine if given comment follows AST element.
-commentFollowsElt ::
-  -- | Location of AST element
-  RealSrcSpan ->
-  -- | Location of next AST element
-  Maybe RealSrcSpan ->
-  -- | Location of enclosing AST element
-  Maybe RealSrcSpan ->
-  -- | Location of last comment in the series
-  Maybe SpanMark ->
-  -- | Comment to test
-  LComment ->
-  Bool
-commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =
-  -- A comment follows a AST element if all 4 conditions are satisfied:
-  goesAfter
-    && logicallyFollows
-    && noEltBetween
-    && (continuation || lastInEnclosing || supersedesParentElt)
-  where
-    -- 1) The comment starts after end of the AST element:
-    goesAfter =
-      realSrcSpanStart l >= realSrcSpanEnd ref
-    -- 2) The comment logically belongs to the element, four cases:
-    logicallyFollows =
-      theSameLinePost l ref -- a) it's on the same line
-        || continuation -- b) it's a continuation of a comment block
-        || lastInEnclosing -- c) it's the last element in the enclosing construct
-
-    -- 3) There is no other AST element between this element and the comment:
-    noEltBetween =
-      case mnSpn of
-        Nothing -> True
-        Just nspn ->
-          realSrcSpanStart nspn >= realSrcSpanEnd l
-    -- 4) Less obvious: if column of comment is closer to the start of
-    -- enclosing element, it probably related to that parent element, not to
-    -- the current child element. This rule is important because otherwise
-    -- all comments would end up assigned to closest inner elements, and
-    -- parent elements won't have a chance to get any comments assigned to
-    -- them. This is not OK because comments will get indented according to
-    -- the AST elements they are attached to.
-    --
-    -- Skip this rule if the comment is a continuation of a comment block.
-    supersedesParentElt =
-      case meSpn of
-        Nothing -> True
-        Just espn ->
-          let startColumn = srcLocCol . realSrcSpanStart
-           in startColumn espn > startColumn ref
-                || ( abs (startColumn espn - startColumn l)
-                       >= abs (startColumn ref - startColumn l)
-                   )
-    continuation =
-      -- A comment is a continuation when it doesn't have non-whitespace
-      -- lexemes in front of it and goes right after the previous comment.
-      not (hasAtomsBefore comment)
-        && ( case mlastMark of
-               Just (HaddockSpan _ _) -> False
-               Just (CommentSpan spn) ->
-                 srcSpanEndLine spn + 1 == srcSpanStartLine l
-               _ -> False
-           )
-    lastInEnclosing =
-      case meSpn of
-        -- When there is no enclosing element, return false
-        Nothing -> False
-        -- When there is an enclosing element,
-        Just espn ->
-          let -- Make sure that the comment is inside the enclosing element
-              insideParent = realSrcSpanEnd l <= realSrcSpanEnd espn
-              -- And check if the next element is outside of the parent
-              nextOutsideParent = case mnSpn of
-                Nothing -> True
-                Just nspn -> realSrcSpanEnd espn < realSrcSpanStart nspn
-           in insideParent && nextOutsideParent
-
 -- | Output a 'Comment' immediately. This is a low-level printing function.
-spitCommentNow :: RealSrcSpan -> Comment -> R ()
-spitCommentNow spn comment = do
+--
+-- Note that it records the placement as well as printing. Every path that
+-- emits a comment has to go through this or 'spitCommentPending', or
+-- "Ormolu.Comments.Invariants" will report the comment as dropped and
+-- Ormolu will refuse to format the file.
+spitCommentNow ::
+  -- | The slot the comment is being rendered in
+  CommentSlot ->
+  RealSrcSpan ->
+  Comment ->
+  R ()
+spitCommentNow slot spn comment = do
+  recordCommentPlacement CommentPlacement {cpSpan = spn, cpSlot = slot}
   sitcc
     . sequence_
     . NE.intersperse newline
     . fmap txt
     . unComment
     $ comment
-  setSpanMark (CommentSpan spn)
+  setLastEmitted (LastEmittedComment spn)
 
--- | Output a 'Comment' at the end of correct line or after it depending on
--- 'CommentPosition'. Used for comments that may potentially follow on the
--- same line as something we just rendered, but not immediately after it.
-spitCommentPending :: CommentPosition -> RealSrcSpan -> Comment -> R ()
-spitCommentPending position spn comment = do
+-- | Output a 'Comment' at the end of the correct line, or after it,
+-- depending on the 'CommentPosition'. Used for comments that may follow on
+-- the same line as something we just rendered, but not immediately after it.
+spitCommentPending ::
+  -- | The slot the comment is being rendered in
+  CommentSlot ->
+  CommentPosition ->
+  RealSrcSpan ->
+  Comment ->
+  R ()
+spitCommentPending slot position spn comment = do
+  recordCommentPlacement CommentPlacement {cpSpan = spn, cpSlot = slot}
   let wrapper = case position of
         OnTheSameLine -> sitcc
         OnNextLine -> id
@@ -281,4 +203,4 @@
     . fmap (registerPendingCommentLine position)
     . unComment
     $ comment
-  setSpanMark (CommentSpan spn)
+  setLastEmitted (LastEmittedComment spn)
diff --git a/src/Ormolu/Printer/Internal.hs b/src/Ormolu/Printer/Internal.hs
--- a/src/Ormolu/Printer/Internal.hs
+++ b/src/Ormolu/Printer/Internal.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
--- | In most cases import "Ormolu.Printer.Combinators" instead, these
+-- | In most cases, import "Ormolu.Printer.Combinators" instead; these
 -- functions are the low-level building blocks and should not be used on
 -- their own. The 'R' monad is re-exported from "Ormolu.Printer.Combinators"
 -- as well.
@@ -13,10 +13,10 @@
 
     -- * Internal functions
     txt,
-    interferingTxt,
     atom,
     space,
     newline,
+    newlineLiteral,
     askSourceType,
     askModuleFixityMap,
     askDebug,
@@ -35,22 +35,27 @@
     -- * Special helpers for comment placement
     CommentPosition (..),
     registerPendingCommentLine,
-    trimSpanStream,
-    nextEltSpan,
-    popComment,
-    getEnclosingComments,
+    withAnchorMap,
+    getCommentsAnchoredWithin,
+    getCommentsBefore,
     getEnclosingSpan,
-    getEnclosingSpanWhere,
     withEnclosingSpan,
     thisLineSpans,
 
     -- * Stateful markers
-    SpanMark (..),
-    spanMarkSpan,
+    LastEmitted (..),
+    lastEmittedSpan,
+    setLastEmitted,
+    getLastEmitted,
+
+    -- * Haddocks
     HaddockStyle (..),
-    setSpanMark,
-    getSpanMark,
+    lookupHaddockText,
 
+    -- * Recording comment placement
+    recordCommentPlacement,
+    recordVisitedSpan,
+
     -- * Extensions
     isExtensionEnabled,
   )
@@ -61,10 +66,8 @@
 import Control.Monad.State.Strict
 import Data.Bool (bool)
 import Data.Choice (Choice)
-import Data.Choice qualified as Choice
-import Data.Coerce
-import Data.Functor ((<&>))
 import Data.List (find)
+import Data.Map.Strict qualified as M
 import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import Data.Text qualified as T
@@ -75,17 +78,18 @@
 import GHC.LanguageExtensions.Type
 import GHC.Types.SrcLoc
 import GHC.Utils.Outputable (Outputable)
+import Ormolu.Comments.Anchor (AnchorMap, commentsAnchoredWithin, commentsBefore)
 import Ormolu.Config (SourceType (..))
 import Ormolu.Fixity (ModuleFixityMap)
 import Ormolu.Parser.CommentStream
-import Ormolu.Printer.SpanStream
+import Ormolu.Printer.CommentPlacement
 import Ormolu.Utils (showOutputable)
 
 ----------------------------------------------------------------------------
 -- The 'R' monad
 
 -- | The 'R' monad hosts combinators that allow us to describe how to render
--- AST.
+-- the AST.
 newtype R a = R (ReaderT RC (State SC) a)
   deriving (Functor, Applicative, Monad)
 
@@ -97,7 +101,7 @@
     rcIndent :: !Int,
     -- | Current layout
     rcLayout :: Layout,
-    -- | Spans of enclosing elements of AST
+    -- | Spans of enclosing elements of the AST
     rcEnclosingSpans :: [RealSrcSpan],
     -- | Whether the last expression in the layout can use braces
     rcCanUseBraces :: Bool,
@@ -108,7 +112,9 @@
     -- | Module fixity map
     rcModuleFixityMap :: ModuleFixityMap,
     -- | Whether to print out debug information during printing
-    rcDebug :: !Bool
+    rcDebug :: !(Choice "debug"),
+    -- | Source text of the module's Haddocks
+    rcHaddockText :: HaddockText
   }
 
 -- | State context of 'R'.
@@ -119,22 +125,26 @@
     scIndent :: !Int,
     -- | Rendered source code so far
     scBuilder :: Builder,
-    -- | Span stream
-    scSpanStream :: SpanStream,
     -- | Spans of atoms that have been printed on the current line so far
     scThisLineSpans :: [RealSrcSpan],
-    -- | Comment stream
-    scCommentStream :: CommentStream,
-    -- | Pending comment lines (in reverse order) to be inserted before next
-    -- newline, 'Int' is the indentation level
+    -- | Comments that have not been emitted yet, by the element they are
+    -- attached to
+    scAnchorMap :: AnchorMap,
+    -- | Pending comment lines (in reverse order) to be inserted before the
+    -- next newline
     scPendingComments :: ![(CommentPosition, Text)],
     -- | Whether to output a space before the next output
     scRequestedDelimiter :: !RequestedDelimiter,
-    -- | An auxiliary marker for keeping track of last output element
-    scSpanMark :: !(Maybe SpanMark)
+    -- | What was emitted last, used both for preserving blank lines from
+    -- the input and for recognizing runs of comments
+    scLastEmitted :: !LastEmitted,
+    -- | Comment placement decisions made so far, in reverse order
+    scCommentPlacements :: [CommentPlacement],
+    -- | Spans of the elements the printer has entered, in reverse order
+    scVisitedSpans :: [RealSrcSpan]
   }
 
--- | Make sure next output is delimited by one of the following.
+-- | Make sure the next output is delimited by one of the following.
 data RequestedDelimiter
   = -- | A space
     RequestedSpace
@@ -150,17 +160,17 @@
 
 -- | 'Layout' options.
 data Layout
-  = -- | Put everything on single line
+  = -- | Put everything on a single line
     SingleLine
   | -- | Use multiple lines
     MultiLine
   deriving (Eq, Show)
 
--- | Modes for rendering of pending comments.
+-- | Modes for rendering pending comments.
 data CommentPosition
   = -- | Put the comment on the same line
     OnTheSameLine
-  | -- | Put the comment on next line
+  | -- | Put the comment on the next line
     OnNextLine
   deriving (Eq, Show)
 
@@ -168,22 +178,28 @@
 runR ::
   -- | Monad to run
   R () ->
-  -- | Span stream
-  SpanStream ->
-  -- | Comment stream
-  CommentStream ->
+  -- | Comments, attached to the elements they belong to
+  AnchorMap ->
   -- | Whether the source is a signature or a regular module
   SourceType ->
   -- | Enabled extensions
   EnumSet Extension ->
   -- | Module fixity map
   ModuleFixityMap ->
-  -- | Resulting rendition
-  Bool ->
-  Text
-runR (R m) sstream cstream sourceType extensions moduleFixityMap debug =
-  TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc
+  -- | Whether to print out debug information during printing
+  Choice "debug" ->
+  -- | Source text of the module's Haddocks
+  HaddockText ->
+  -- | The rendition, the comment placement decisions that were made along
+  -- the way, and the spans of the elements that were entered
+  (Text, [CommentPlacement], [RealSrcSpan])
+runR (R m) anchorMap sourceType extensions moduleFixityMap debug haddockText =
+  ( TL.toStrict . toLazyText . scBuilder $ finalSc,
+    reverse (scCommentPlacements finalSc),
+    reverse (scVisitedSpans finalSc)
+  )
   where
+    finalSc = execState (runReaderT m rc) sc
     rc =
       RC
         { rcIndent = 0,
@@ -193,19 +209,21 @@
           rcExtensions = extensions,
           rcSourceType = sourceType,
           rcModuleFixityMap = moduleFixityMap,
-          rcDebug = debug
+          rcDebug = debug,
+          rcHaddockText = haddockText
         }
     sc =
       SC
         { scColumn = 0,
           scIndent = 0,
           scBuilder = mempty,
-          scSpanStream = sstream,
           scThisLineSpans = [],
-          scCommentStream = cstream,
+          scAnchorMap = anchorMap,
           scPendingComments = [],
           scRequestedDelimiter = VeryBeginning,
-          scSpanMark = Nothing
+          scLastEmitted = LastEmittedOther,
+          scCommentPlacements = [],
+          scVisitedSpans = []
         }
 
 ----------------------------------------------------------------------------
@@ -216,12 +234,7 @@
 data SpitType
   = -- | Simple opaque text that breaks comment series.
     SimpleText
-  | -- | Like 'SimpleText', but assume that when this text is inserted it
-    -- will separate an 'Atom' and its pending comments, so insert an extra
-    -- 'newline' in that case to force the pending comments and continue on
-    -- a fresh line.
-    InterferingText
-  | -- | An atom that typically have span information in the AST and can
+  | -- | An atom that typically has span information in the AST and can
     -- have comments attached to it.
     Atom
   | -- | Used for rendering comment lines.
@@ -241,17 +254,9 @@
   R ()
 txt = spit SimpleText
 
--- | Similar to 'txt' but the text inserted this way is assumed to break the
--- “link” between the preceding atom and its pending comments.
-interferingTxt ::
-  -- | 'Text' to output
-  Text ->
-  R ()
-interferingTxt = spit InterferingText
-
--- | Output 'Outputable' fragment of AST. This can be used to output numeric
--- literals and similar. Everything that doesn't have inner structure but
--- does have an 'Outputable' instance.
+-- | Output an 'Outputable' fragment of the AST. This can be used to output
+-- numeric literals and similar: anything that doesn't have inner structure
+-- but does have an 'Outputable' instance.
 atom ::
   (Outputable a) =>
   a ->
@@ -268,8 +273,6 @@
 spit _ "" = return ()
 spit stype text = do
   requestedDel <- R (gets scRequestedDelimiter)
-  pendingComments <- R (gets scPendingComments)
-  when (stype == InterferingText && not (null pendingComments)) newline
   case requestedDel of
     RequestedNewline -> do
       R . modify $ \sc ->
@@ -306,12 +309,12 @@
                     Just x -> x : xs
                   _ -> xs,
           scRequestedDelimiter = RequestedNothing,
-          scSpanMark =
+          scLastEmitted =
             -- If there are pending comments, do not reset last comment
             -- location.
             if (stype == CommentPart) || (not . null . scPendingComments) sc
-              then scSpanMark sc
-              else Nothing
+              then scLastEmitted sc
+              else LastEmittedOther
         }
 
 -- | This primitive /does not/ necessarily output a space. It just ensures
@@ -330,18 +333,25 @@
         other -> other
     }
 
--- | Output a newline. First time 'newline' is used after some non-'newline'
--- output it gets inserted immediately. Second use of 'newline' does not
--- output anything but makes sure that the next non-white space output will
--- be prefixed by a newline. Using 'newline' more than twice in a row has no
--- effect. Also, using 'newline' at the very beginning has no effect, this
--- is to avoid leading whitespace.
+-- | Output a newline. The first time 'newline' is used after some
+-- non-'newline' output, it gets inserted immediately. The second use of
+-- 'newline' does not output anything but makes sure that the next
+-- non-whitespace output will be prefixed by a newline. Using 'newline' more
+-- than twice in a row has no effect. Also, using 'newline' at the very
+-- beginning has no effect; this is to avoid leading whitespace.
 --
 -- Similarly to 'space', this design prevents trailing newlines and makes it
 -- hard to output more than one blank newline in a row.
 newline :: R ()
 newline = do
-  indent <- R (gets scIndent)
+  lineIndent <- R (gets scIndent)
+  logicalIndent <- R (asks rcIndent)
+  -- A trailing comment block spills onto the lines below the code it
+  -- trails. Those lines take the indentation of the line the block started
+  -- on, unless the construct being printed is indented further, in which
+  -- case they follow it: dropping to the start of the line would put the
+  -- rest of a block comment outside the declaration it was written in.
+  let indent = max lineIndent logicalIndent
   cs <- reverse <$> R (gets scPendingComments)
   case cs of
     [] -> newlineRaw
@@ -386,6 +396,19 @@
             _ -> AfterNewline
         }
 
+-- | Insert a literal newline without modifying the internal state of the
+-- printer. This is to be used in exceptional cases, e.g. for printing
+-- multiline string literals.
+newlineLiteral :: R ()
+newlineLiteral = R . modify $ \sc ->
+  sc
+    { scBuilder = scBuilder sc <> "\n",
+      scColumn = 0,
+      scIndent = 0,
+      scThisLineSpans = [],
+      scRequestedDelimiter = AfterNewline
+    }
+
 -- | Return the source type.
 askSourceType :: R SourceType
 askSourceType = R (asks rcSourceType)
@@ -397,7 +420,7 @@
 -- | Retrieve whether we should print out certain debug information while
 -- printing.
 askDebug :: R (Choice "debug")
-askDebug = R (asks (Choice.fromBool . rcDebug))
+askDebug = R (asks rcDebug)
 
 inciBy :: Int -> R () -> R ()
 inciBy step (R m) = R (local modRC m)
@@ -407,16 +430,16 @@
         { rcIndent = rcIndent rc + step
         }
 
--- | Increase indentation level by one indentation step for the inner
--- computation. 'inci' should be used when a part of code must be more
+-- | Increase the indentation level by one indentation step for the inner
+-- computation. 'inci' should be used when a piece of code must be more
 -- indented relative to the parts outside of 'inci' in order for the output
--- to be valid Haskell. When layout is single-line there is no obvious
--- effect, but with multi-line layout correct indentation levels matter.
+-- to be valid Haskell. With single-line layout there is no visible effect,
+-- but with multi-line layout correct indentation levels matter.
 inci :: R () -> R ()
 inci = inciBy indentStep
 
--- | Set indentation level for the inner computation equal to current
--- column. This makes sure that the entire inner block is uniformly
+-- | Set the indentation level for the inner computation equal to the
+-- current column. This makes sure that the entire inner block is uniformly
 -- \"shifted\" to the right.
 sitcc :: R () -> R ()
 sitcc (R m) = do
@@ -429,7 +452,7 @@
           }
   R (local modRC m)
 
--- | Set 'Layout' for internal computation.
+-- | Set the 'Layout' for the inner computation.
 enterLayout :: Layout -> R () -> R ()
 enterLayout l (R m) = R (local modRC m)
   where
@@ -438,7 +461,7 @@
         { rcLayout = l
         }
 
--- | Do one or another thing depending on current 'Layout'.
+-- | Do one thing or another depending on the current 'Layout'.
 vlayout ::
   -- | Single line
   R a ->
@@ -451,17 +474,17 @@
     SingleLine -> sline
     MultiLine -> mline
 
--- | Get current 'Layout'.
+-- | Get the current 'Layout'.
 getLayout :: R Layout
 getLayout = R (asks rcLayout)
 
 ----------------------------------------------------------------------------
 -- Special helpers for comment placement
 
--- | Register a comment line for outputting. It will be inserted right
--- before next newline. When the comment goes after something else on the
--- same line, a space will be inserted between preceding text and the
--- comment when necessary.
+-- | Register a comment line for output. It will be inserted right before
+-- the next newline. When the comment goes after something else on the same
+-- line, a space will be inserted between the preceding text and the comment
+-- when necessary.
 registerPendingCommentLine ::
   -- | Comment position
   CommentPosition ->
@@ -474,52 +497,34 @@
       { scPendingComments = (position, text) : scPendingComments sc
       }
 
--- | Drop elements that begin before or at the same place as given
--- 'SrcSpan'.
-trimSpanStream ::
-  -- | Reference span
-  RealSrcSpan ->
-  R ()
-trimSpanStream ref = do
-  let leRef :: RealSrcSpan -> Bool
-      leRef x = realSrcSpanStart x <= realSrcSpanStart ref
-  R . modify $ \sc ->
-    sc
-      { scSpanStream = coerce (dropWhile leRef) (scSpanStream sc)
-      }
-
--- | Get location of next element in AST.
-nextEltSpan :: R (Maybe RealSrcSpan)
-nextEltSpan = listToMaybe . coerce <$> R (gets scSpanStream)
+-- | Claim comments from the anchor map, storing what is left.
+withAnchorMap :: (AnchorMap -> (a, AnchorMap)) -> R a
+withAnchorMap f = R . state $ \sc ->
+  let (a, am) = f (scAnchorMap sc)
+   in (a, sc {scAnchorMap = am})
 
--- | Pop a 'Comment' from the 'CommentStream' if given predicate is
--- satisfied and there are comments in the stream.
-popComment ::
-  (LComment -> Bool) ->
-  R (Maybe LComment)
-popComment f = R $ do
-  CommentStream cstream <- gets scCommentStream
-  case cstream of
-    (x : xs) | f x -> do
-      modify $ \sc -> sc {scCommentStream = CommentStream xs}
-      return $ Just x
-    _ -> return Nothing
+-- | Get the comments that will be printed before the element at the given
+-- span. Like 'getCommentsAnchoredWithin', this only looks; it does not
+-- claim.
+getCommentsBefore :: RealSrcSpan -> R [LComment]
+getCommentsBefore spn = withAnchorMap (\am -> (commentsBefore spn am, am))
 
--- | Get the comments contained in the enclosing span.
-getEnclosingComments :: R [LComment]
-getEnclosingComments = do
-  isEnclosed <-
-    getEnclosingSpan <&> \case
-      Just enclSpan -> containsSpan enclSpan
-      Nothing -> const False
-  CommentStream cstream <- R $ gets scCommentStream
-  pure $ takeWhile (isEnclosed . getLoc) cstream
+-- | Get the comments attached to the element at the given span, or to
+-- anything inside it.
+--
+-- This only looks; it does not claim. The layout decisions that ask this
+-- run before the comments are emitted, and claiming here would leave
+-- nothing for the printer to emit later.
+getCommentsAnchoredWithin :: RealSrcSpan -> R [LComment]
+getCommentsAnchoredWithin region =
+  withAnchorMap (\am -> (commentsAnchoredWithin region am, am))
 
 -- | Get the immediately enclosing 'RealSrcSpan'.
 getEnclosingSpan :: R (Maybe RealSrcSpan)
 getEnclosingSpan = getEnclosingSpanWhere (const True)
 
--- | Get the first enclosing 'RealSrcSpan' that satisfies given predicate.
+-- | Get the first enclosing 'RealSrcSpan' that satisfies the given
+-- predicate.
 getEnclosingSpanWhere ::
   -- | Predicate to use
   (RealSrcSpan -> Bool) ->
@@ -527,7 +532,7 @@
 getEnclosingSpanWhere f =
   find f <$> R (asks rcEnclosingSpans)
 
--- | Set 'RealSrcSpan' of enclosing span for the given computation.
+-- | Set the 'RealSrcSpan' of the enclosing span for the given computation.
 withEnclosingSpan :: RealSrcSpan -> R () -> R ()
 withEnclosingSpan spn (R m) = R (local modRC m)
   where
@@ -543,23 +548,44 @@
 ----------------------------------------------------------------------------
 -- Stateful markers
 
--- | An auxiliary marker for keeping track of last output element.
-data SpanMark
-  = -- | Haddock comment
-    HaddockSpan HaddockStyle RealSrcSpan
-  | -- | Non-haddock comment
-    CommentSpan RealSrcSpan
-  | -- | A statement in a do-block and such span
-    StatementSpan RealSrcSpan
+-- | What the printer emitted last, and where it came from in the input.
+--
+-- This is about spacing, not about attachment: it is what lets a blank line
+-- in the input be preserved in the output, and what lets a run of comment
+-- lines be recognized as one. Statements are tracked for the first of those
+-- reasons, Haddocks for the second.
+data LastEmitted
+  = -- | Nothing yet, or ordinary code
+    LastEmittedOther
+  | -- | A comment occupying the given span of the input
+    LastEmittedComment RealSrcSpan
+  | -- | A Haddock occupying the given span of the input
+    LastEmittedHaddock RealSrcSpan
+  | -- | A statement of a layout block occupying the given span
+    LastEmittedStatement RealSrcSpan
+  deriving (Eq, Show)
 
--- | Project 'RealSrcSpan' from 'SpanMark'.
-spanMarkSpan :: SpanMark -> RealSrcSpan
-spanMarkSpan = \case
-  HaddockSpan _ s -> s
-  CommentSpan s -> s
-  StatementSpan s -> s
+-- | Where the last emitted thing came from in the input, if it came from
+-- anywhere in particular.
+lastEmittedSpan :: LastEmitted -> Maybe RealSrcSpan
+lastEmittedSpan = \case
+  LastEmittedOther -> Nothing
+  LastEmittedComment s -> Just s
+  LastEmittedHaddock s -> Just s
+  LastEmittedStatement s -> Just s
 
--- | Haddock string style.
+-- | Record what was emitted last.
+setLastEmitted :: LastEmitted -> R ()
+setLastEmitted lastEmitted = R . modify $ \sc ->
+  sc
+    { scLastEmitted = lastEmitted
+    }
+
+-- | Report what was emitted last.
+getLastEmitted :: R LastEmitted
+getLastEmitted = R (gets scLastEmitted)
+
+-- | Haddock string style, i.e. the trigger a Haddock is rendered with.
 data HaddockStyle
   = -- | @-- |@
     Pipe
@@ -570,19 +596,38 @@
   | -- | @-- $@
     Named String
 
--- | Set span of last output comment.
-setSpanMark ::
-  -- | Span mark to set
-  SpanMark ->
-  R ()
-setSpanMark spnMark = R . modify $ \sc ->
+-- | The source text of the Haddock at the given span, if it is one of the
+-- module's Haddocks. See 'Ormolu.Parser.CommentStream.HaddockText'.
+lookupHaddockText :: RealSrcSpan -> R (Maybe Comment)
+lookupHaddockText spn = R (asks (M.lookup spn . rcHaddockText))
+
+----------------------------------------------------------------------------
+-- Recording comment placement
+
+-- | Record the fact that a comment was rendered in a particular slot.
+--
+-- Every code path that emits a comment has to call this. What is recorded
+-- here is what "Ormolu.Comments.Invariants" checks the input's comments
+-- against, so a comment emitted without being recorded is reported as
+-- dropped and Ormolu refuses to format the file.
+recordCommentPlacement :: CommentPlacement -> R ()
+recordCommentPlacement placement = R . modify $ \sc ->
   sc
-    { scSpanMark = Just spnMark
+    { scCommentPlacements = placement : scCommentPlacements sc
     }
 
--- | Get span of last output comment.
-getSpanMark :: R (Maybe SpanMark)
-getSpanMark = R (gets scSpanMark)
+-- | Record that the printer entered the element with the given span.
+--
+-- Not every span in the AST is entered: the printer renders plenty of
+-- syntax with 'txt' rather than through 'Ormolu.Printer.Combinators.located',
+-- so a @where@ clause, for instance, has a span but is never entered. A
+-- comment can only be attached to an element that is entered, because
+-- entering it is the only moment at which the comment could be emitted.
+recordVisitedSpan :: RealSrcSpan -> R ()
+recordVisitedSpan spn = R . modify $ \sc ->
+  sc
+    { scVisitedSpans = spn : scVisitedSpans sc
+    }
 
 ----------------------------------------------------------------------------
 -- Helpers for braces
diff --git a/src/Ormolu/Printer/Meat/Common.hs b/src/Ormolu/Printer/Meat/Common.hs
--- a/src/Ormolu/Printer/Meat/Common.hs
+++ b/src/Ormolu/Printer/Meat/Common.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}
 
 -- | Rendering of commonly useful bits.
@@ -12,21 +14,31 @@
     p_qualName,
     p_infixDefHelper,
     p_hsDoc,
+    p_hsDocInline,
+    multiLineIfDocumented,
+    switchLayoutDocumented,
+    hasLineHaddocks,
     p_hsDocName,
     p_sourceText,
     p_namespaceSpec,
+    p_hsMultAnn,
   )
 where
 
 import Control.Monad
-import Data.Choice (Choice)
+import Data.Choice (Choice, pattern Is, pattern Isn't, pattern With)
 import Data.Choice qualified as Choice
+import Data.Data (Data)
+import Data.Generics.Schemes (listify)
+import Data.List.NonEmpty qualified as NE
+import Data.Text (Text)
 import Data.Text qualified as T
 import GHC.Data.FastString
 import GHC.Hs.Binds
 import GHC.Hs.Doc
 import GHC.Hs.Extension (GhcPs)
 import GHC.Hs.ImpExp
+import GHC.Hs.Type
 import GHC.LanguageExtensions.Type (Extension (..))
 import GHC.Parser.Annotation
 import GHC.Types.Name.Occurrence (OccName (..), occNameString)
@@ -35,6 +47,7 @@
 import GHC.Types.SrcLoc
 import Language.Haskell.Syntax.Module.Name
 import Ormolu.Config (SourceType (..))
+import Ormolu.Parser.CommentStream (Comment, isMultilineComment, unComment)
 import Ormolu.Printer.Combinators
 import Ormolu.Utils
 
@@ -45,7 +58,8 @@
   | -- | Top-level declarations
     Free
 
--- | Outputs the name of the module-like entity, preceeded by the correct prefix ("module" or "signature").
+-- | Output the name of the module-like entity, preceded by the correct
+-- prefix (@module@ or @signature@).
 p_hsmodName :: ModuleName -> R ()
 p_hsmodName mname = do
   sourceType <- askSourceType
@@ -58,6 +72,10 @@
 p_ieWrappedName :: IEWrappedName GhcPs -> R ()
 p_ieWrappedName = \case
   IEName _ x -> p_rdrName x
+  IEDefault _ x -> do
+    txt "default"
+    space
+    p_rdrName x
   IEPattern _ x -> do
     txt "pattern"
     space
@@ -66,6 +84,10 @@
     txt "type"
     space
     p_rdrName x
+  IEData _ x -> do
+    txt "data"
+    space
+    p_rdrName x
 
 -- | Render a @'LocatedN' 'RdrName'@.
 p_rdrName :: LocatedN RdrName -> R ()
@@ -73,20 +95,25 @@
   unboxedSums <- isExtensionEnabled UnboxedSums
   let wrapper EpAnn {anns} = case anns of
         NameAnnQuote {nann_quoted} -> tickPrefix . wrapper nann_quoted
-        NameAnn {nann_adornment = NameParens} ->
+        NameAnn {nann_adornment = NameParens {}} ->
           parens N . handleUnboxedSumsAndHashInteraction
-        NameAnn {nann_adornment = NameBackquotes} -> backticks
+        NameAnn {nann_adornment = NameBackquotes {}} -> backticks
         -- whether the `->` identifier is parenthesized
         NameAnnRArrow {nann_mopen = Just _} -> parens N
         -- special case for unboxed unit tuples
-        NameAnnOnly {nann_adornment = NameParensHash} -> const $ txt "(# #)"
+        NameAnnOnly {nann_adornment = NameParensHash {}} -> const $ txt "(# #)"
+        -- An empty list reaches the printer as a name, not as a list, so
+        -- this is the only place a comment written between its brackets can
+        -- be given something to attach to.
+        NameAnnOnly {nann_adornment = NameSquare open _} ->
+          const $ brackets N (locatedEmpty (getEpTokenSrcSpan open))
         _ -> id
 
       -- When UnboxedSums is enabled, `(#` is a single lexeme, so we have to
       -- insert spaces when we have a parenthesized operator starting with `#`.
       handleUnboxedSumsAndHashInteraction
         | unboxedSums,
-          -- Qualified names do not start wth a `#`.
+          -- Qualified names do not start with a `#`.
           Unqual (occNameString -> '#' : _) <- x =
             \y -> space *> y <* space
         | otherwise = id
@@ -99,7 +126,7 @@
     Orig _ occName ->
       -- This is used when GHC generates code that will be fed into
       -- the renamer (e.g. from deriving clauses), but where we want
-      -- to say that something comes from given module which is not
+      -- to say that something comes from a given module that is not
       -- specified in the source code, e.g. @Prelude.map@.
       --
       -- My current understanding is that the provided module name
@@ -116,19 +143,20 @@
   txt "."
   atom occName
 
--- | A helper for formatting infix constructions in lhs of definitions.
+-- | A helper for formatting infix constructions on the left-hand side of
+-- definitions.
 p_infixDefHelper ::
   -- | Whether to format in infix style
-  Bool ->
+  Choice "infixStyle" ->
   -- | Whether to bump indentation for arguments
-  Bool ->
+  Choice "indentArgs" ->
   -- | How to print the operator\/name
   R () ->
   -- | How to print the arguments
   [R ()] ->
   R ()
 p_infixDefHelper isInfix indentArgs name args =
-  case (isInfix, args) of
+  case (Choice.toBool isInfix, args) of
     (True, p0 : p1 : ps) -> do
       let parens' =
             if null ps
@@ -141,16 +169,22 @@
           name
           space
           p1
-      unless (null ps) . inciIf indentArgs $ do
+      unless (null ps) . inciIf (Choice.toBool indentArgs) $ do
         breakpoint
         sitcc (sep breakpoint sitcc ps)
     (_, ps) -> do
       name
       unless (null ps) $ do
         breakpoint
-        inciIf indentArgs $ sitcc (sep breakpoint sitcc args)
+        inciIf (Choice.toBool indentArgs) $
+          sitcc (sep breakpoint sitcc args)
 
 -- | Print a Haddock.
+--
+-- The author's own text is reused whenever it can be, so a @{- | … -}@
+-- comes back as a block comment and an empty @-- |@ survives; see
+-- 'haddockAsWritten' for when it cannot be. Otherwise the Haddock is
+-- rebuilt from its 'HsDocString'.
 p_hsDoc ::
   -- | Haddock style
   HaddockStyle ->
@@ -159,38 +193,161 @@
   -- | The 'LHsDoc' to render
   LHsDoc GhcPs ->
   R ()
-p_hsDoc hstyle needsNewline (L l str) = do
-  let isCommentSpan = \case
-        HaddockSpan _ _ -> True
-        CommentSpan _ -> True
+p_hsDoc hstyle needsNewline = p_hsDocWith hstyle needsNewline (Isn't #mayShareLine)
+
+-- | 'p_hsDoc' for a Haddock inside a construct that may legitimately be laid
+-- out on one line.
+--
+-- A Haddock that comes back out as @{- | … -}@ is self-delimiting, so it
+-- ends with a 'breakpoint' rather than a newline and can share the line:
+-- @data A = A {- | a number -} Int Bool@ stays as written. One rendered as
+-- @--@ lines still ends the line, since it owns the rest of it.
+p_hsDocInline :: HaddockStyle -> LHsDoc GhcPs -> R ()
+p_hsDocInline hstyle = p_hsDocWith hstyle (With #endNewline) (Is #mayShareLine)
+
+-- | The worker behind 'p_hsDoc' and 'p_hsDocInline'.
+p_hsDocWith ::
+  HaddockStyle ->
+  Choice "endNewline" ->
+  Choice "mayShareLine" ->
+  LHsDoc GhcPs ->
+  R ()
+p_hsDocWith hstyle needsNewline mayShareLine (L l str) = do
+  let goesAfterCommentOrHaddock = \case
+        LastEmittedHaddock _ -> True
+        LastEmittedComment _ -> True
         _ -> False
-  goesAfterComment <- maybe False isCommentSpan <$> getSpanMark
+  goesAfterComment <- goesAfterCommentOrHaddock <$> getLastEmitted
   -- Make sure the Haddock is separated by a newline from other comments.
   when goesAfterComment newline
-  let docStringLines = splitDocString $ hsDocString str
-  forM_ (zip docStringLines (True : repeat False)) $ \(x, isFirst) -> do
-    if isFirst
-      then case hstyle of
-        Pipe -> txt "-- |"
-        Caret -> txt "-- ^"
-        Asterisk n -> txt ("-- " <> T.replicate n "*")
-        Named name -> p_hsDocName name
-      else newline >> txt "--"
-    space
-    unless (T.null x) (txt x)
-  when (Choice.isTrue needsNewline) newline
+  -- Print what the author wrote when we still have it. Rebuilding the
+  -- comment from the doc string cannot preserve a @{- | … -}@ or an empty
+  -- @-- |@, and what it loses it loses from the AST too.
+  asWritten <- haddockAsWritten hstyle (L l str)
+  case asWritten of
+    Just written -> do
+      let lns = unComment written
+      sitcc . sequence_ . NE.intersperse newline . fmap txt $ lns
+    Nothing -> do
+      let docStringLines = splitDocString $ hsDocString str
+          docPrefix = case hstyle of
+            Pipe -> "-- |"
+            Caret -> "-- ^"
+            Asterisk n -> "-- " <> T.replicate n "*"
+            Named name -> hsDocNameText name
+      forM_ (zip docStringLines (True : repeat False)) $ \(x, isFirst) -> do
+        if isFirst
+          then txt docPrefix
+          else newline >> txt "--"
+        space
+        unless (T.null x) (txt x)
+  -- A Haddock rendered as @--@ lines owns the rest of its line and has to
+  -- end it. One rendered as @{- | … -}@ is self-delimiting, so a space will
+  -- do when the surrounding layout is single-line.
+  when (Choice.isTrue needsNewline) $
+    if Choice.isTrue mayShareLine && maybe False isMultilineComment asWritten
+      then breakpoint
+      else newline
   case l of
     UnhelpfulSpan _ ->
       -- It's often the case that the comment itself doesn't have a span
-      -- attached to it and instead its location can be obtained from
+      -- attached to it, and instead its location can be obtained from the
       -- nearest enclosing span.
-      getEnclosingSpan >>= mapM_ (setSpanMark . HaddockSpan hstyle)
-    RealSrcSpan spn _ -> setSpanMark (HaddockSpan hstyle spn)
+      getEnclosingSpan >>= mapM_ (setLastEmitted . LastEmittedHaddock)
+    RealSrcSpan spn _ -> setLastEmitted (LastEmittedHaddock spn)
 
--- | Print anchor of named doc section.
+-- | Lay the computation out on several lines if rendering the given
+-- fragment of the syntax tree will emit a Haddock as @--@ lines.
+--
+-- Such a Haddock takes whole lines: emitted inside a bracketed construct
+-- that was put on one line, it swallows the rest of that line, closing
+-- bracket and all. The author writes it in front of the construct, so its
+-- span is outside the construct's and 'switchLayout' cannot see it; what
+-- decides is where it will be /printed/, which is inside. Hence
+-- @data A = A deriving (Eq)@ documented on the @Eq@ came out as
+-- @deriving (-- \| B@, and a documented field of a one-line record as
+-- @{-- \| …@, which does not parse at all.
+--
+-- A Haddock that comes back out as @{- | … -}@ is self-delimiting and does
+-- not force anything, so @data A = A {- | a number -} Int Bool@ is left
+-- alone rather than being exploded over five lines.
+multiLineIfDocumented :: (Data a) => a -> R () -> R ()
+multiLineIfDocumented x m = do
+  breaks <- hasLineHaddocks x
+  if breaks then enterLayout MultiLine m else m
+
+-- | 'switchLayout', except that the layout is multi-line regardless of the
+-- spans when rendering the given fragment will emit a Haddock as @--@
+-- lines.
+--
+-- Use this rather than 'multiLineIfDocumented' around a 'switchLayout': the
+-- override has to be applied after the spans have had their say, or it is
+-- immediately discarded.
+switchLayoutDocumented ::
+  (Data a) =>
+  -- | Fragment that decides whether documentation will be printed
+  a ->
+  -- | Span that controls layout otherwise
+  [SrcSpan] ->
+  -- | Computation to run with changed layout
+  R () ->
+  R ()
+switchLayoutDocumented x spans' =
+  switchLayout spans' . multiLineIfDocumented x
+
+-- | Does rendering this fragment emit a Haddock as @--@ lines?
+--
+-- Every site this is asked about prints its Haddocks in 'Pipe' style, which
+-- is what decides whether the author's own text can be reused.
+hasLineHaddocks :: (Data a) => a -> R Bool
+hasLineHaddocks x = case listify (const True :: LHsDoc GhcPs -> Bool) x of
+  -- A doc string that is not reachable as an 'LHsDoc' cannot be inspected,
+  -- so assume the worst and break.
+  [] -> pure (containsHaddocks x)
+  docs -> or <$> traverse rendersAsLines docs
+  where
+    rendersAsLines doc =
+      maybe True (not . isMultilineComment) <$> haddockAsWritten Pipe doc
+
+-- | The author's own text for a Haddock, when it can be reused.
+--
+-- 'Nothing' means the Haddock has to be rebuilt from its 'HsDocString' as
+-- @--@ lines: either its text was not kept, or it is about to be rendered
+-- in a different style than it was written in. Ormolu moves a trailing
+-- @-- ^ X@ in front of what it documents and writes it as @-- | X@, and
+-- keeping the author's text there would leave a @^@ pointing at the wrong
+-- thing.
+haddockAsWritten :: HaddockStyle -> LHsDoc GhcPs -> R (Maybe Comment)
+haddockAsWritten hstyle (L l _) = do
+  asWritten <- maybe (pure Nothing) lookupHaddockText (srcSpanToRealSrcSpan l)
+  pure (mfilter (writtenAs hstyle . NE.head . unComment) asWritten)
+
+-- | Was the Haddock written in the style it is about to be rendered in?
+writtenAs :: HaddockStyle -> Text -> Bool
+writtenAs hstyle firstLine =
+  case T.stripPrefix "--" opener of
+    Just rest -> hasTrigger (T.stripStart rest)
+    Nothing -> maybe False (hasTrigger . T.stripStart) (T.stripPrefix "{-" opener)
+  where
+    opener = T.stripStart firstLine
+    hasTrigger t = case hstyle of
+      Pipe -> "|" `T.isPrefixOf` t
+      Caret -> "^" `T.isPrefixOf` t
+      Asterisk n ->
+        T.replicate n "*" `T.isPrefixOf` t
+          && not (T.replicate (n + 1) "*" `T.isPrefixOf` t)
+      Named name -> ("$" <> T.pack name) `T.isPrefixOf` t
+
+-- | Print the anchor of a named doc section. Unlike 'p_hsDoc' this is a
+-- bare anchor with no doc string attached, so there is no span to report.
 p_hsDocName :: String -> R ()
-p_hsDocName name = txt ("-- $" <> T.pack name)
+p_hsDocName name = do
+  txt (hsDocNameText name)
 
+-- | Render the anchor of a named doc section.
+hsDocNameText :: String -> Text
+hsDocNameText name = "-- $" <> T.pack name
+
 p_sourceText :: SourceText -> R ()
 p_sourceText = \case
   NoSourceText -> pure ()
@@ -201,3 +358,9 @@
   NoNamespaceSpecifier -> pure ()
   TypeNamespaceSpecifier _ -> txt "type" *> space
   DataNamespaceSpecifier _ -> txt "data" *> space
+
+p_hsMultAnn :: (mult -> R ()) -> HsMultAnnOf mult GhcPs -> R ()
+p_hsMultAnn p_mult = \case
+  HsUnannotated _ -> pure ()
+  HsLinearAnn _ -> txt "%1"
+  HsExplicitMult _ mult -> txt "%" *> p_mult mult
diff --git a/src/Ormolu/Printer/Meat/Declaration.hs b/src/Ormolu/Printer/Meat/Declaration.hs
--- a/src/Ormolu/Printer/Meat/Declaration.hs
+++ b/src/Ormolu/Printer/Meat/Declaration.hs
@@ -49,11 +49,12 @@
 p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R ()
 p_hsDecls = p_hsDecls' Disregard
 
--- | Like 'p_hsDecls' but respects user choices regarding grouping. If the
+-- | Like 'p_hsDecls', but respects user choices regarding grouping. If the
 -- user omits newlines between declarations, we also omit them in most
--- cases, except when said declarations have associated Haddocks.
+-- cases, except when the declarations in question have associated Haddocks.
 --
--- Does some normalization (compress subsequent newlines into a single one)
+-- Does some normalization (compresses consecutive newlines into a single
+-- one).
 p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()
 p_hsDeclsRespectGrouping = p_hsDecls' Respect
 
@@ -70,7 +71,7 @@
     renderGroup = NE.toList . fmap (located' $ dontUseBraces . p_hsDecl style)
     renderGroupWithPrev prev curr =
       -- We can omit a blank line when the user didn't add one, but we must
-      -- ensure we always add blank lines around documented declarations
+      -- ensure we always add blank lines around documented declarations.
       case grouping of
         Disregard ->
           breakpoint : renderGroup curr
@@ -98,8 +99,8 @@
   [NonEmpty (LHsDecl GhcPs)]
 groupDecls _ [] = []
 groupDecls isSig (l@(L _ DocNext) : xs) =
-  -- If the first element is a doc string for next element, just include it
-  -- in the next block:
+  -- If the first element is a doc string for the next element, just include
+  -- it in the next block:
   case groupDecls isSig xs of
     [] -> [l :| []]
     (x : xs') -> (l <| x) : xs'
@@ -165,7 +166,7 @@
   TyFamInstD _ x -> p_tyFamInstDecl style x
   DataFamInstD _ x -> p_dataFamInstDecl style x
 
--- | Determine if these declarations should be grouped together.
+-- | Determine whether these declarations should be grouped together.
 groupedDecls ::
   LHsDecl GhcPs ->
   LHsDecl GhcPs ->
@@ -193,14 +194,15 @@
     (KindSignature n, ClassDeclaration n') -> n == n'
     (KindSignature n, FamilyDeclaration n') -> n == n'
     (KindSignature n, TypeSynonym n') -> n == n'
-    -- Special case for TH splices, we look at locations
+    -- Special case for TH splices: we look at locations.
     (Splice, Splice) -> not (separatedByBlank id l_x l_y)
-    -- This looks only at Haddocks, normal comments are handled elsewhere
+    -- This looks only at Haddocks; normal comments are handled elsewhere.
     (DocNext, _) -> True
     (_, DocPrev) -> True
     _ -> False
 
--- | Detect declaration series that should not have blanks between them.
+-- | Detect a series of declarations that should not have blanks between
+-- them.
 declSeries ::
   LHsDecl GhcPs ->
   LHsDecl GhcPs ->
@@ -235,12 +237,12 @@
   WarningPragma n -> Just n
   _ -> Nothing
 
--- Declarations that do not refer to names
+-- Declarations that do not refer to names.
 
 pattern Splice :: HsDecl GhcPs
 pattern Splice <- SpliceD _ (SpliceDecl _ _ _)
 
--- Declarations referring to a single name
+-- Declarations referring to a single name.
 
 pattern
   InlinePragma,
@@ -256,7 +258,7 @@
   TypeSynonym ::
     RdrName -> HsDecl GhcPs
 pattern InlinePragma n <- SigD _ (InlineSig _ (L _ n) _)
-pattern SpecializePragma n <- SigD _ (SpecSig _ (L _ n) _ _)
+pattern SpecializePragma n <- SigD _ (isSpecSig -> Just n)
 pattern SCCPragma n <- SigD _ (SCCFunSig _ (L _ n) _)
 pattern AnnTypePragma n <- AnnD _ (HsAnnotation _ (TypeAnnProvenance (L _ n)) _)
 pattern AnnValuePragma n <- AnnD _ (HsAnnotation _ (ValueAnnProvenance (L _ n)) _)
@@ -267,8 +269,14 @@
 pattern FamilyDeclaration n <- TyClD _ (FamDecl _ (FamilyDecl _ _ _ (L _ n) _ _ _ _))
 pattern TypeSynonym n <- TyClD _ (SynDecl _ (L _ n) _ _ _)
 
--- Declarations which can refer to multiple names
+isSpecSig :: Sig GhcPs -> Maybe RdrName
+isSpecSig = \case
+  SpecSig _ (L _ n) _ _ -> Just n
+  SpecSigE _ _ (deconstructExprFromSpecSigE -> (L _ n, _, _)) _ -> Just n
+  _ -> Nothing
 
+-- Declarations that can refer to multiple names.
+
 pattern
   TypeSignature,
   DefaultSignature,
@@ -313,6 +321,7 @@
 
 patBindNames :: Pat GhcPs -> [RdrName]
 patBindNames (TuplePat _ ps _) = concatMap (patBindNames . unLoc) ps
+patBindNames (OrPat _ ps) = foldMap (patBindNames . unLoc) ps
 patBindNames (VarPat _ (L _ n)) = [n]
 patBindNames (WildPat _) = []
 patBindNames (LazyPat _ (L _ p)) = patBindNames p
diff --git a/src/Ormolu/Printer/Meat/Declaration/Class.hs b/src/Ormolu/Printer/Meat/Declaration/Class.hs
--- a/src/Ormolu/Printer/Meat/Declaration/Class.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/Class.hs
@@ -1,5 +1,8 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 
 -- | Rendering of type class declarations.
@@ -10,6 +13,8 @@
 
 import Control.Arrow
 import Control.Monad
+import Data.Choice (pattern Is)
+import Data.Choice qualified as Choice
 import Data.Foldable
 import Data.Function (on)
 import Data.List (sortBy)
@@ -60,8 +65,8 @@
       for_ ctx p_classContext
       switchLayout signatureSpans $
         p_infixDefHelper
-          (isInfix fixity)
-          True
+          (Choice.fromBool (isInfix fixity))
+          (Is #indentArgs)
           (p_rdrName name)
           (located' p_hsTyVarBndr <$> hsq_explicit)
       inci (p_classFundeps fdeps)
@@ -69,7 +74,7 @@
         breakpoint
         txt "where"
   unless (null allDecls) $ do
-    breakpoint -- Ensure whitespace is added after where clause.
+    breakpoint -- Ensure whitespace is added after the where clause.
     inci (p_hsDeclsRespectGrouping Associated allDecls)
 
 p_classContext :: LHsContext GhcPs -> R ()
diff --git a/src/Ormolu/Printer/Meat/Declaration/Data.hs b/src/Ormolu/Printer/Meat/Declaration/Data.hs
--- a/src/Ormolu/Printer/Meat/Declaration/Data.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/Data.hs
@@ -7,7 +7,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 
--- | Renedring of data type declarations.
+-- | Rendering of data type declarations.
 module Ormolu.Printer.Meat.Declaration.Data
   ( p_dataDecl,
   )
@@ -19,8 +19,6 @@
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe (isJust, isNothing, mapMaybe, maybeToList)
-import Data.Void
-import GHC.Data.Strict qualified as Strict
 import GHC.Hs
 import GHC.Types.Fixity
 import GHC.Types.ForeignCall
@@ -77,8 +75,8 @@
     forM_ dd_ctxt p_lhsContext
     switchLayout constructorSpans $
       p_infixDefHelper
-        (isInfix fixity)
-        True
+        (Choice.fromBool (isInfix fixity))
+        (Is #indentArgs)
         (p_rdrName name)
         (p_tyVar <$> tyVars)
     forM_ dd_kindSig $ \k -> do
@@ -112,21 +110,25 @@
               conDeclConsSpans = \case
                 ConDeclGADT {..} -> getLocA <$> con_names
                 ConDeclH98 {..} -> getLocA con_name :| []
-          if hasHaddocks dd_cons'
+          -- A constructor documented with @--@ lines cannot share a line
+          -- with anything. One documented with @{- | … -}@ can, so it is
+          -- laid out as though it were undocumented.
+          lineHaddocks <- consHaveLineHaddocks dd_cons'
+          if lineHaddocks
             then newline
             else
               if Choice.isTrue singleRecCon && compactLayoutAroundEquals
                 then space
                 else breakpoint
-          equals
+          txt "="
           space
           layout <- getLayout
           let s =
-                if layout == MultiLine || hasHaddocks dd_cons'
+                if layout == MultiLine || lineHaddocks
                   then newline >> txt "|" >> space
                   else space >> txt "|" >> space
               sitcc' =
-                if hasHaddocks dd_cons' || Choice.isFalse singleRecCon
+                if lineHaddocks || Choice.isFalse singleRecCon
                   then sitcc
                   else id
           sep s (sitcc' . located' (p_conDecl singleRecCon)) dd_cons'
@@ -136,88 +138,97 @@
 p_conDecl :: Choice "singleRecCon" -> ConDecl GhcPs -> R ()
 p_conDecl _ ConDeclGADT {..} = do
   mapM_ (p_hsDoc Pipe (With #endNewline)) con_doc
-  switchLayout conDeclSpn $ do
+  switchLayoutDocumented documented conDeclSpn $ do
     let c :| cs = con_names
     p_rdrName c
     unless (null cs) . inci $ do
       commaDel
       sep commaDel p_rdrName cs
-    inci $ do
-      let conTy = case con_g_args of
-            PrefixConGADT NoExtField xs ->
-              let go (HsScaled a b) t = addCLocA t b (HsFunTy NoExtField a b t)
-               in foldr go con_res_ty xs
-            RecConGADT _ r ->
-              addCLocA r con_res_ty $
-                HsFunTy
-                  NoExtField
-                  (HsUnrestrictedArrow noAnn)
-                  (la2la $ HsRecTy noAnn <$> r)
-                  con_res_ty
-          qualTy = case con_mb_cxt of
-            Nothing -> conTy
-            Just qs ->
-              addCLocA qs conTy $
-                HsQualTy NoExtField qs conTy
-          quantifiedTy :: LHsType GhcPs
-          quantifiedTy =
-            addCLocA con_bndrs qualTy $
-              hsOuterTyVarBndrsToHsType (unLoc con_bndrs) qualTy
-      space
-      txt "::"
-      if hasDocStrings (unLoc con_res_ty)
-        then newline
-        else breakpoint
-      located quantifiedTy p_hsType
+    space
+    txt "::"
+    breakpoint
+    inci . switchLayoutDocumented documented conSigSpans $ do
+      located con_outer_bndrs p_hsOuterTyVarBndrs
+      case unLoc con_outer_bndrs of
+        HsOuterImplicit {} -> pure ()
+        HsOuterExplicit {} -> breakpoint
+      forM_ con_inner_bndrs $ \tele -> do
+        p_hsForAllTelescope tele
+        breakpoint
+      forM_ con_mb_cxt $ \qs -> do
+        located qs p_hsContext
+        space
+        txt "=>"
+        breakpoint
+      switchLayoutDocumented documented conArgResSpans $ do
+        case con_g_args of
+          PrefixConGADT NoExtField xs ->
+            forM_ xs $ \x -> do
+              p_hsConDeclFieldWithDoc x
+              space
+              p_hsMultAnn (located' p_hsType) (cdf_multiplicity x)
+              space
+              txt "->"
+              breakpoint
+          RecConGADT _ x -> do
+            located x p_hsConDeclRecFields
+            space
+            txt "->"
+            breakpoint
+        located con_res_ty p_hsType
   where
+    -- Every part of the signature shares one layout decision, so any
+    -- Haddock in any of them puts the whole of it on several lines.
+    documented = (con_g_args, con_res_ty)
+
     conDeclSpn =
-      fmap getLocA (NE.toList con_names)
-        <> [getLocA con_bndrs]
+      fmap getLocA (NE.toList con_names) <> conSigSpans
+    conSigSpans =
+      [getLocA con_outer_bndrs]
         <> maybeToList (fmap getLocA con_mb_cxt)
-        <> conArgsSpans
-    conArgsSpans = case con_g_args of
-      PrefixConGADT NoExtField xs -> getLocA . hsScaledThing <$> xs
-      RecConGADT _ x -> [getLocA x]
+        <> conArgResSpans
+    conArgResSpans =
+      getLocA con_res_ty : case con_g_args of
+        PrefixConGADT NoExtField xs -> getLocA . cdf_type <$> xs
+        RecConGADT _ x -> [getLocA x]
 p_conDecl singleRecCon ConDeclH98 {..} =
   case con_args of
-    PrefixCon (_ :: [Void]) xs -> do
+    PrefixCon xs -> do
       renderConDoc
       renderContext
-      switchLayout conDeclSpn $ do
+      switchLayoutDocumented xs conDeclSpn $ do
         p_rdrName con_name
-        let args = hsScaledThing <$> xs
-            argsHaveDocs = conArgsHaveHaddocks args
-            delimiter = if argsHaveDocs then newline else breakpoint
-        unless (null xs) delimiter
+        unless (null xs) breakpoint
         inci . sitcc $
-          sep delimiter (sitcc . located' p_hsType) args
+          sep breakpoint (sitcc . p_hsConDeclFieldWithDoc) xs
     RecCon l -> do
       renderConDoc
       renderContext
       switchLayout conDeclSpn $ do
         p_rdrName con_name
         breakpoint
-        inciIf (Choice.isFalse singleRecCon) (located l p_conDeclFields)
-    InfixCon (HsScaled _ l) (HsScaled _ r) -> do
-      -- manually render these
-      let (lType, larg_doc) = splitDocTy l
-      let (rType, rarg_doc) = splitDocTy r
+        inciIf (Choice.isFalse singleRecCon) (located l p_hsConDeclRecFields)
+    InfixCon l r -> do
+      -- Render these manually.
+      let larg_doc = cdf_doc l
+          rarg_doc = cdf_doc r
 
-      -- the constructor haddock can go on top of the entire constructor
-      -- only if neither argument has haddocks
+      -- The constructor Haddock can go on top of the entire constructor
+      -- only if neither argument has Haddocks.
       let putConDocOnTop = isNothing larg_doc && isNothing rarg_doc
 
       when putConDocOnTop renderConDoc
       renderContext
       switchLayout conDeclSpn $ do
-        -- the left arg haddock can use pipe only if the infix constructor has docs
+        -- The left arg Haddock can use pipe style only if the infix
+        -- constructor has docs.
         if isJust con_doc
           then do
             mapM_ (p_hsDoc Pipe (With #endNewline)) larg_doc
-            located lType p_hsType
+            p_hsConDeclField l
             breakpoint
           else do
-            located lType p_hsType
+            p_hsConDeclField l
             case larg_doc of
               Just doc -> space >> p_hsDoc Caret (With #endNewline) doc
               Nothing -> breakpoint
@@ -227,7 +238,7 @@
           case rarg_doc of
             Just doc -> newline >> p_hsDoc Pipe (With #endNewline) doc
             Nothing -> breakpoint
-          located rType p_hsType
+          p_hsConDeclField r
   where
     renderConDoc = mapM_ (p_hsDoc Pipe (With #endNewline)) con_doc
     renderContext =
@@ -238,23 +249,16 @@
         forM_ con_mb_cxt p_lhsContext
 
     conNameWithContextSpn =
-      [ RealSrcSpan real Strict.Nothing
-      | EpaSpan (RealSrcSpan real _) <-
-          mapMaybe (matchAddEpAnn AnnForall) con_ext
-      ]
+      [getHasLoc $ acdh_forall con_ext]
         <> fmap getLocA con_ex_tvs
         <> maybeToList (fmap getLocA con_mb_cxt)
         <> [conNameSpn]
     conDeclSpn = conNameSpn : conArgsSpans
     conNameSpn = getLocA con_name
     conArgsSpans = case con_args of
-      PrefixCon (_ :: [Void]) xs -> getLocA . hsScaledThing <$> xs
+      PrefixCon xs -> getLocA . cdf_type <$> xs
       RecCon l -> [getLocA l]
-      InfixCon x y -> getLocA . hsScaledThing <$> [x, y]
-
-    splitDocTy = \case
-      L _ (HsDocTy _ ty doc) -> (ty, Just doc)
-      ty -> (ty, Nothing)
+      InfixCon x y -> getLocA . cdf_type <$> [x, y]
 
 p_lhsContext ::
   LHsContext GhcPs ->
@@ -275,16 +279,17 @@
 p_hsDerivingClause ::
   HsDerivingClause GhcPs ->
   R ()
-p_hsDerivingClause HsDerivingClause {..} = do
+p_hsDerivingClause HsDerivingClause {..} = multiLineIfDocumented deriv_clause_tys $ do
   txt "deriving"
-  let derivingWhat = located deriv_clause_tys $ \case
-        DctSingle NoExtField sigTy -> parens N $ located sigTy p_hsSigType
-        DctMulti NoExtField sigTys ->
-          parens N $
-            sep
-              commaDel
-              (sitcc . located' p_hsSigType)
-              sigTys
+  let derivingWhat = located deriv_clause_tys $ \tys ->
+        multiLineIfDocumented tys $ case tys of
+          DctSingle NoExtField sigTy -> parens N $ located sigTy p_hsSigType
+          DctMulti NoExtField sigTys ->
+            parens N $
+              sep
+                commaDel
+                (sitcc . located' p_hsSigType)
+                sigTys
   space
   case deriv_clause_strategy of
     Nothing -> do
@@ -315,24 +320,24 @@
 ----------------------------------------------------------------------------
 -- Helpers
 
+-- | Do any of these constructors print a Haddock as @--@ lines where it
+-- would share a line with the rest of the declaration?
+--
+-- Only the constructor's own Haddock and the docs on its prefix arguments
+-- count. A record constructor lays its fields out over several lines
+-- anyway, so documenting one of them says nothing about how the @=@ and the
+-- constructor name should be arranged.
+consHaveLineHaddocks :: [LConDecl GhcPs] -> R Bool
+consHaveLineHaddocks = fmap or . traverse (f . unLoc)
+  where
+    f ConDeclH98 {..} =
+      hasLineHaddocks $
+        maybeToList con_doc <> case con_args of
+          PrefixCon xs -> mapMaybe cdf_doc xs
+          _ -> []
+    f _ = pure False
+
 isInfix :: LexicalFixity -> Bool
 isInfix = \case
   Infix -> True
   Prefix -> False
-
-hasHaddocks :: [LConDecl GhcPs] -> Bool
-hasHaddocks = any (f . unLoc)
-  where
-    f ConDeclH98 {..} =
-      isJust con_doc || case con_args of
-        PrefixCon [] xs ->
-          conArgsHaveHaddocks (hsScaledThing <$> xs)
-        _ -> False
-    f _ = False
-
-conArgsHaveHaddocks :: [LBangType GhcPs] -> Bool
-conArgsHaveHaddocks xs =
-  let hasDocs = \case
-        HsDocTy {} -> True
-        _ -> False
-   in any (hasDocs . unLoc) xs
diff --git a/src/Ormolu/Printer/Meat/Declaration/Default.hs b/src/Ormolu/Printer/Meat/Declaration/Default.hs
--- a/src/Ormolu/Printer/Meat/Declaration/Default.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/Default.hs
@@ -5,13 +5,18 @@
   )
 where
 
+import GHC.Data.Maybe (whenIsJust)
 import GHC.Hs
 import Ormolu.Printer.Combinators
+import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Type
 
 p_defaultDecl :: DefaultDecl GhcPs -> R ()
-p_defaultDecl (DefaultDecl _ ts) = do
+p_defaultDecl (DefaultDecl _ mclass ts) = do
   txt "default"
+  whenIsJust mclass $ \c -> do
+    breakpoint
+    p_rdrName c
   breakpoint
   inci . parens N $
     sep commaDel (sitcc . located' p_hsType) ts
diff --git a/src/Ormolu/Printer/Meat/Declaration/Foreign.hs b/src/Ormolu/Printer/Meat/Declaration/Foreign.hs
--- a/src/Ormolu/Printer/Meat/Declaration/Foreign.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/Foreign.hs
@@ -9,10 +9,12 @@
 import Control.Monad
 import GHC.Hs
 import GHC.Types.ForeignCall
+import GHC.Types.SourceText
 import GHC.Types.SrcLoc
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Declaration.Signature
+import Ormolu.Printer.Meat.Declaration.StringLiteral
 
 p_foreignDecl :: ForeignDecl GhcPs -> R ()
 p_foreignDecl = \case
@@ -23,8 +25,8 @@
     p_foreignExport fd_fe
     p_foreignTypeSig fd
 
--- | Printer for the last part of an import\/export, which is function name
--- and type signature.
+-- | Printer for the last part of an import\/export, which is the function
+-- name and type signature.
 p_foreignTypeSig :: ForeignDecl GhcPs -> R ()
 p_foreignTypeSig fd = do
   breakpoint
@@ -43,21 +45,24 @@
 --
 -- > foreign import callingConvention [safety] [identifier]
 --
--- We need to check whether the safety has a good source, span, as it
+-- We need to check whether the safety has a good source span, as it
 -- defaults to 'PlaySafe' if you don't have anything in the source.
 --
--- We also layout the identifier using the 'SourceText', because printing
--- with the other two fields of 'CImport' is very complicated. See the
+-- We also lay out the identifier using the 'SourceText', because printing
+-- it from the other two fields of 'CImport' is very complicated. See the
 -- 'Outputable' instance of 'ForeignImport' for details.
 p_foreignImport :: ForeignImport GhcPs -> R ()
 p_foreignImport (CImport sourceText cCallConv safety _ _) = do
   txt "foreign import"
   space
   located cCallConv atom
-  -- Need to check for 'noLoc' for the 'safe' annotation
+  -- Need to check for 'noLoc' for the 'safe' annotation.
   when (isGoodSrcSpan $ getLocA safety) (space >> atom safety)
-  space
-  located sourceText p_sourceText
+  inci $ located sourceText $ \case
+    NoSourceText -> pure ()
+    SourceText lit -> do
+      breakpoint
+      p_stringLit lit
 
 p_foreignExport :: ForeignExport GhcPs -> R ()
 p_foreignExport (CExport sourceText (L loc (CExportStatic _ _ cCallConv))) = do
diff --git a/src/Ormolu/Printer/Meat/Declaration/Instance.hs b/src/Ormolu/Printer/Meat/Declaration/Instance.hs
--- a/src/Ormolu/Printer/Meat/Declaration/Instance.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/Instance.hs
@@ -89,7 +89,7 @@
         breakpoint
         txt "where"
   unless (null allDecls) . inci $ do
-    -- Ensure whitespace is added after where clause.
+    -- Ensure whitespace is added after the where clause.
     breakpoint
     dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls
 
diff --git a/src/Ormolu/Printer/Meat/Declaration/OpTree.hs b/src/Ormolu/Printer/Meat/Declaration/OpTree.hs
--- a/src/Ormolu/Printer/Meat/Declaration/OpTree.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/OpTree.hs
@@ -22,6 +22,7 @@
 import GHC.Types.Name (occNameString)
 import GHC.Types.Name.Reader (RdrName, rdrNameOcc)
 import GHC.Types.SrcLoc
+import Ormolu.Parser.CommentStream (LComment)
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common (p_rdrName)
 import Ormolu.Printer.Meat.Declaration.Value
@@ -46,20 +47,20 @@
 getOpNameStr :: RdrName -> String
 getOpNameStr = occNameString . rdrNameOcc
 
--- | Decide if the operands of an operator chain should be hanging.
+-- | Decide whether the operands of an operator chain should be hanging.
 opBranchPlacement ::
   (HasLoc l) =>
   -- | Placer function for nodes
   (ty -> Placement) ->
-  -- | first expression of the chain
+  -- | First expression of the chain
   OpTree (GenLocated l ty) op ->
-  -- | last expression of the chain
+  -- | Last expression of the chain
   OpTree (GenLocated l ty) op ->
   Placement
 opBranchPlacement placer firstExpr lastExpr
-  -- If the beginning of the first argument and the last argument starts on
-  -- the same line, and the second argument has a hanging form, use hanging
-  -- placement.
+  -- If the start of the first argument and the start of the last argument
+  -- are on the same line, and the last argument has a hanging form, use
+  -- hanging placement.
   | isOneLineSpan
       ( mkSrcSpan
           (srcSpanStart (opTreeLoc firstExpr))
@@ -69,7 +70,7 @@
       placer n
   | otherwise = Normal
 
--- | Decide whether to use braces or not based on the layout and placement
+-- | Decide whether or not to use braces based on the layout and placement
 -- of an expression in an infix operator application.
 opBranchBraceStyle :: Placement -> R (R () -> R ())
 opBranchBraceStyle placement =
@@ -112,32 +113,54 @@
       -- Whether we could place the operator in a trailing position,
       -- followed by a breakpoint before the RHS
       couldBeTrailing (prevExpr, opi) =
-        -- An operator with fixity InfixR 0, like seq, $, and $ variants,
-        -- is required
+        -- An operator with fixity InfixR 0, like seq, $, and the $ variants,
+        -- is required.
         isHardSplitterOp (opiFixityApproximation opi)
-          -- the LHS must be single-line
+          -- The LHS must be single-line.
           && isOneLineSpan (opTreeLoc prevExpr)
-          -- can only happen when a breakpoint would have been added anyway
+          -- This can only happen when a breakpoint would have been added
+          -- anyway.
           && placement == Normal
-          -- if the node just on the left of the operator (so the rightmost
-          -- node of the subtree prevExpr) is a do-block, then we cannot
-          -- place the operator in a trailing position (because it would be
-          -- read as being part of the do-block)
+          -- If the node just to the left of the operator (that is, the
+          -- rightmost node of the subtree prevExpr) is a do-block, then we
+          -- cannot place the operator in a trailing position, because it
+          -- would be read as being part of the do-block.
           && not (isDoBlock $ rightMostNode prevExpr)
-      -- If all operators at the current level match the conditions to be
-      -- trailing, then put them in a trailing position
-      isTrailing = all couldBeTrailing $ zip (NE.toList exprs) ops
+      -- A staircase of two or more trailing operators is only worthwhile when
+      -- the operand at the very end of the chain has a hanging form (a do
+      -- block, lambda, case, etc.): the trailing operator then introduces that
+      -- block. When such a chain ends in an ordinary expression (a variable,
+      -- literal, or plain application) the trailing layout only produces
+      -- ever-deepening indentation, so we fall back to the leading-operator
+      -- layout. A single hard splitter is exempt: it does not form a pyramid
+      -- and trailing is the idiomatic way to introduce its operand.
+      chainEndsInHangingForm =
+        case rightMostNode t of
+          OpNode (L _ n) -> exprPlacement n == Hanging
+          _ -> False
+      isSingleOperator = case ops of
+        [_] -> True
+        _ -> False
+  -- A comment written on its own line in front of an operator forces the
+  -- operator onto a line of its own. In trailing position that line starts
+  -- at the indentation of the statement, and @$@ at the start of a line in
+  -- a @do@ block is read as a new statement rather than as a continuation.
+  -- The leading layout indents instead, so it keeps the meaning.
+  opsAreCommented <-
+    or <$> traverse (fmap (not . null) . leadingComments . opiOp) ops
+  -- If all operators at the current level match the conditions to be
+  -- trailing, and the chain is either a single operator or ends in a
+  -- hanging form, then put the operators in a trailing position.
+  let isTrailing =
+        (isSingleOperator || chainEndsInHangingForm)
+          && not opsAreCommented
+          && all couldBeTrailing (zip (NE.toList exprs) ops)
   ub <- if isTrailing then return useBraces else opBranchBraceStyle placement
   let p_x = ub $ p_exprOpTree s firstExpr
       putOpsExprs prevExpr (opi : ops') (expr : exprs') = do
         let isLast = null exprs'
             ub' = if not isLast then ub else id
-            -- Distinguish holes used in infix notation.
-            -- eg. '1 _foo 2' and '1 `_foo` 2'
-            opWrapper = case unLoc (opiOp opi) of
-              HsUnboundVar _ _ -> backticks
-              _ -> id
-            p_op = located (opiOp opi) (opWrapper . p_hsExpr)
+            p_op = located (opiOp opi) p_hsExpr
             p_y = ub' $ p_exprOpTree N expr
         if isTrailing
           then do
@@ -165,11 +188,17 @@
     p_x
     putOpsExprs firstExpr ops otherExprs
 
+-- | The comments that will be printed in front of a located thing.
+leadingComments :: (HasLoc l) => GenLocated l a -> R [LComment]
+leadingComments (L l _) = case locA l of
+  RealSrcSpan spn _ -> getCommentsBefore spn
+  _ -> pure []
+
 -- | Convert a 'LHsCmdTop' containing an operator tree to the 'OpTree'
 -- intermediate representation.
 cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs)
 cmdOpTree = \case
-  (L _ (HsCmdTop _ (L _ (HsCmdArrForm _ op Infix _ [x, y])))) ->
+  (L _ (HsCmdTop _ (L _ (HsCmdArrForm _ op Infix [x, y])))) ->
     BinaryOpBranches (cmdOpTree x) op (cmdOpTree y)
   n -> OpNode n
 
@@ -204,14 +233,14 @@
     p_x
     putOpsExprs ops otherExprs
 
--- | Check if given expression has a hanging form. Added for symmetry with
--- exprPlacement and cmdTopPlacement, which are all used in p_xxxOpTree
--- functions with opBranchPlacement.
+-- | Check whether the given expression has a hanging form. Added for
+-- symmetry with 'exprPlacement' and 'cmdTopPlacement', all of which are used
+-- in the @p_xxxOpTree@ functions together with 'opBranchPlacement'.
 tyOpPlacement :: HsType GhcPs -> Placement
 tyOpPlacement = \case
   _ -> Normal
 
--- | Convert a LHsType containing an operator tree to the 'OpTree'
+-- | Convert an 'LHsType' containing an operator tree to the 'OpTree'
 -- intermediate representation.
 tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (LocatedN RdrName)
 tyOpTree (L _ (HsOpTy _ _ l op r)) =
diff --git a/src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs b/src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs
--- a/src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies #-}
 
--- | Rendering of Role annotation declarations.
+-- | Rendering of role annotation declarations.
 module Ormolu.Printer.Meat.Declaration.RoleAnnotation
   ( p_roleAnnot,
   )
diff --git a/src/Ormolu/Printer/Meat/Declaration/Rule.hs b/src/Ormolu/Printer/Meat/Declaration/Rule.hs
--- a/src/Ormolu/Printer/Meat/Declaration/Rule.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/Rule.hs
@@ -4,16 +4,16 @@
 
 module Ormolu.Printer.Meat.Declaration.Rule
   ( p_ruleDecls,
+    p_ruleBndrs,
   )
 where
 
-import Control.Monad (unless)
 import GHC.Hs
 import GHC.Types.Basic
 import GHC.Types.SourceText
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
-import Ormolu.Printer.Meat.Declaration.Signature
+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Signature
 import Ormolu.Printer.Meat.Declaration.Value
 import Ormolu.Printer.Meat.Type
 
@@ -22,32 +22,34 @@
   pragma "RULES" $ sep breakpoint (sitcc . located' p_ruleDecl) xs
 
 p_ruleDecl :: RuleDecl GhcPs -> R ()
-p_ruleDecl (HsRule _ ruleName activation tyvars ruleBndrs lhs rhs) = do
+p_ruleDecl (HsRule _ ruleName activation ruleBndrs lhs rhs) = do
   located ruleName p_ruleName
   space
   p_activation activation
   space
-  case tyvars of
-    Nothing -> return ()
-    Just xs -> do
-      p_forallBndrs ForAllInvis p_hsTyVarBndr xs
-      space
-  -- It appears that there is no way to tell if there was an empty forall
-  -- in the input or no forall at all. We do not want to add redundant
-  -- foralls, so let's just skip the empty ones.
-  unless (null ruleBndrs) $
-    p_forallBndrs ForAllInvis p_ruleBndr ruleBndrs
+  p_ruleBndrs ruleBndrs
   breakpoint
   inci $ do
     located lhs p_hsExpr
     space
-    equals
+    txt "="
     inci $ do
       breakpoint
       located rhs p_hsExpr
 
 p_ruleName :: RuleName -> R ()
 p_ruleName name = atom (HsString NoSourceText name :: HsLit GhcPs)
+
+p_ruleBndrs :: RuleBndrs GhcPs -> R ()
+p_ruleBndrs (RuleBndrs HsRuleBndrsAnn {..} tyvars ruleBndrs) = do
+  case tyvars of
+    Nothing -> return ()
+    Just xs -> do
+      p_forallBndrs ForAllInvis p_hsTyVarBndr xs
+      space
+  case rb_tmanns of
+    Nothing -> pure ()
+    Just _ -> p_forallBndrs ForAllInvis p_ruleBndr ruleBndrs
 
 p_ruleBndr :: RuleBndr GhcPs -> R ()
 p_ruleBndr = \case
diff --git a/src/Ormolu/Printer/Meat/Declaration/Signature.hs b/src/Ormolu/Printer/Meat/Declaration/Signature.hs
--- a/src/Ormolu/Printer/Meat/Declaration/Signature.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/Signature.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- | Type signature declarations.
 module Ormolu.Printer.Meat.Declaration.Signature
@@ -8,12 +9,15 @@
     p_typeAscription,
     p_activation,
     p_standaloneKindSig,
+    deconstructExprFromSpecSigE,
   )
 where
 
 import Control.Monad
+import Data.Maybe (maybeToList)
 import GHC.Data.BooleanFormula
 import GHC.Hs
+import GHC.Stack (HasCallStack)
 import GHC.Types.Basic
 import GHC.Types.Fixity
 import GHC.Types.Name.Reader
@@ -21,6 +25,8 @@
 import GHC.Types.SrcLoc
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
+import Ormolu.Printer.Meat.Declaration.Rule
+import Ormolu.Printer.Meat.Declaration.Value (p_hsExpr)
 import Ormolu.Printer.Meat.Type
 import Ormolu.Utils
 
@@ -31,7 +37,9 @@
   ClassOpSig _ def names sigType -> p_classOpSig def names sigType
   FixSig _ sig -> p_fixSig sig
   InlineSig _ name inlinePragma -> p_inlineSig name inlinePragma
-  SpecSig _ name ts inlinePragma -> p_specSig name ts inlinePragma
+  SpecSig _ name ts inlinePragma ->
+    p_specSig Nothing (noLocA $ HsVar NoExtField name) ts inlinePragma
+  SpecSigE _ ruleBndrs expr inlinePragma -> p_specSigE ruleBndrs expr inlinePragma
   SpecInstSig _ sigType -> p_specInstSig sigType
   MinimalSig _ booleanFormula -> p_minimalSig booleanFormula
   CompleteMatchSig _ cs ty -> p_completeSig cs ty
@@ -93,7 +101,7 @@
   FixitySig GhcPs ->
   R ()
 p_fixSig = \case
-  FixitySig namespace names (Fixity _ n dir) -> do
+  FixitySig namespace names (Fixity n dir) -> do
     txt $ case dir of
       InfixL -> "infixl"
       InfixR -> "infixr"
@@ -122,26 +130,71 @@
   p_rdrName name
 
 p_specSig ::
-  -- | Name
-  LocatedN RdrName ->
+  -- | Rule binders
+  Maybe (RuleBndrs GhcPs) ->
+  -- | Expression to specialize
+  LHsExpr GhcPs ->
   -- | The types to specialize to
   [LHsSigType GhcPs] ->
   -- | For specialize inline
   InlinePragma ->
   R ()
-p_specSig name ts InlinePragma {..} = pragmaBraces $ do
+p_specSig mRuleBndrs specExpr ts InlinePragma {..} = pragmaBraces $ do
   txt "SPECIALIZE"
   space
   p_inlineSpec inl_inline
   space
-  p_activation inl_act
-  space
-  p_rdrName name
-  space
-  txt "::"
-  breakpoint
-  inci $ sep commaDel (located' p_hsSigType) ts
+  case (inl_inline, inl_act) of
+    (NoInline _, NeverActive) -> return ()
+    _ -> p_activation inl_act
+  inci $ do
+    space
+    forM_ mRuleBndrs $ \ruleBndrs -> do
+      p_ruleBndrs ruleBndrs
+      space
+    located specExpr p_hsExpr
+    case ts of
+      [] -> pure ()
+      _ -> do
+        space
+        txt "::"
+        breakpoint
+        sep commaDel (located' p_hsSigType) ts
 
+p_specSigE ::
+  -- | Rule binders
+  RuleBndrs GhcPs ->
+  -- | Expression to specialize
+  LHsExpr GhcPs ->
+  -- | For specialize inline
+  InlinePragma ->
+  R ()
+p_specSigE ruleBndrs expr =
+  p_specSig (Just ruleBndrs) specExpr (maybeToList sigTy)
+  where
+    (_, specExpr, sigTy) = deconstructExprFromSpecSigE expr
+
+-- | The 'LHsExpr' in a 'SpecSigE' can only be of a very specific form,
+-- namely a variable applied to value/type-level arguments, optionally with a
+-- type signature.
+--
+-- https://github.com/ghc-proposals/ghc-proposals/blob/e2c683698323cec3e33625369ae2b5f585387c70/proposals/0493-specialise-expressions.rst#2proposed-change-specification
+deconstructExprFromSpecSigE ::
+  (HasCallStack) =>
+  LHsExpr GhcPs ->
+  (LocatedN RdrName, LHsExpr GhcPs, Maybe (LHsSigType GhcPs))
+deconstructExprFromSpecSigE = \case
+  L _ (ExprWithTySig _ e HsWC {hswc_body}) ->
+    (findVar e, e, Just hswc_body)
+  e -> (findVar e, e, Nothing)
+  where
+    findVar :: LHsExpr GhcPs -> LocatedN RdrName
+    findVar = \case
+      L _ (HsVar _ name) -> name
+      L _ (HsApp _ e _) -> findVar e
+      L _ (HsAppType _ e _) -> findVar e
+      _ -> error "unreachble"
+
 p_inlineSpec :: InlineSpec -> R ()
 p_inlineSpec = \case
   Inline _ -> txt "INLINE"
@@ -171,7 +224,7 @@
 
 p_minimalSig ::
   -- | Boolean formula
-  LBooleanFormula (LocatedN RdrName) ->
+  LBooleanFormula GhcPs ->
   R ()
 p_minimalSig =
   located' $ \booleanFormula ->
@@ -179,7 +232,7 @@
 
 p_booleanFormula ::
   -- | Boolean formula
-  BooleanFormula (LocatedN RdrName) ->
+  BooleanFormula GhcPs ->
   R ()
 p_booleanFormula = \case
   Var name -> p_rdrName name
diff --git a/src/Ormolu/Printer/Meat/Declaration/Signature.hs-boot b/src/Ormolu/Printer/Meat/Declaration/Signature.hs-boot
new file mode 100644
--- /dev/null
+++ b/src/Ormolu/Printer/Meat/Declaration/Signature.hs-boot
@@ -0,0 +1,14 @@
+module Ormolu.Printer.Meat.Declaration.Signature
+  ( p_sigDecl,
+    p_typeAscription,
+    p_activation,
+  )
+where
+
+import GHC.Hs
+import GHC.Types.Basic
+import Ormolu.Printer.Combinators
+
+p_sigDecl :: Sig GhcPs -> R ()
+p_typeAscription :: LHsSigType GhcPs -> R ()
+p_activation :: Activation -> R ()
diff --git a/src/Ormolu/Printer/Meat/Declaration/StringLiteral.hs b/src/Ormolu/Printer/Meat/Declaration/StringLiteral.hs
new file mode 100644
--- /dev/null
+++ b/src/Ormolu/Printer/Meat/Declaration/StringLiteral.hs
@@ -0,0 +1,174 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Ormolu.Printer.Meat.Declaration.StringLiteral (p_stringLit) where
+
+import Control.Applicative (Alternative (..))
+import Control.Category ((>>>))
+import Control.Monad ((>=>))
+import Data.Semigroup (Min (..))
+import Data.Text (Text)
+import Data.Text qualified as T
+import GHC.Data.FastString
+import GHC.Parser.CharClass (is_space)
+import Ormolu.Printer.Combinators
+import Ormolu.Utils
+
+-- | Print the source text of a string literal while indenting gaps and
+-- newlines correctly.
+p_stringLit :: FastString -> R ()
+p_stringLit src = case parseStringLiteral $ T.pack $ unpackFS src of
+  Nothing -> error $ "Internal Ormolu error: couldn't parse string literal: " <> show src
+  Just ParsedStringLiteral {..} -> sitcc do
+    txt startMarker
+    case stringLiteralKind of
+      RegularStringLiteral -> do
+        let singleLine =
+              txt $ intercalateMinimalStringGaps segments
+            multiLine =
+              sep breakpoint f (attachRelativePos segments)
+              where
+                f :: (RelativePos, Text) -> R ()
+                f (pos, s) = case pos of
+                  SinglePos -> txt s
+                  FirstPos -> txt s *> txt "\\"
+                  MiddlePos -> txt "\\" *> txt s *> txt "\\"
+                  LastPos -> txt "\\" *> txt s
+        vlayout singleLine multiLine
+      MultilineStringLiteral ->
+        sep newlineLiteral txt segments
+    txt endMarker
+
+-- | The start/end marker of the literal, whether it is a regular or a
+-- multiline literal, and the segments of the literal (separated by gaps for
+-- a regular literal, and separated by newlines for a multiline literal).
+data ParsedStringLiteral = ParsedStringLiteral
+  { startMarker, endMarker :: Text,
+    stringLiteralKind :: StringLiteralKind,
+    segments :: [Text]
+  }
+  deriving stock (Show, Eq)
+
+-- | A regular or a multiline string literal.
+data StringLiteralKind = RegularStringLiteral | MultilineStringLiteral
+  deriving stock (Show, Eq)
+
+-- | Turn a string literal (as it exists in the source) into a more
+-- structured form for printing. This should never return 'Nothing' for
+-- literals that the GHC parser accepted.
+parseStringLiteral :: Text -> Maybe ParsedStringLiteral
+parseStringLiteral = \s -> do
+  psl <-
+    (stripStartEndMarker MultilineStringLiteral "\"\"\"" s)
+      <|> (stripStartEndMarker RegularStringLiteral "\"" s)
+  let splitSegments = case stringLiteralKind psl of
+        RegularStringLiteral -> splitGaps
+        MultilineStringLiteral -> splitMultilineString
+  pure psl {segments = concatMap splitSegments $ segments psl}
+  where
+    -- Remove the given marker from the start and the end (at the end,
+    -- optionally also remove a #).
+    stripStartEndMarker ::
+      StringLiteralKind -> Text -> Text -> Maybe ParsedStringLiteral
+    stripStartEndMarker stringLiteralKind marker s = do
+      let startMarker = marker
+      suffix <- T.stripPrefix startMarker s
+      let markerWithHash = marker <> "#"
+      (endMarker, infix_) <-
+        ((markerWithHash,) <$> T.stripSuffix markerWithHash suffix)
+          <|> ((marker,) <$> T.stripSuffix marker suffix)
+      pure ParsedStringLiteral {segments = [infix_], ..}
+
+    -- Split a string on gaps (backslash-delimited whitespace).
+    --
+    -- > splitGaps "bar\\  \\fo\\&o" == ["bar", "fo\\&o"]
+    splitGaps :: Text -> [Text]
+    splitGaps s = go $ T.breakOnAll "\\" s
+      where
+        go [] = [s]
+        go ((pre, suf) : bs) = case T.uncons suf of
+          Just ('\\', suf')
+            | (gap, T.uncons -> Just ('\\', rest)) <- T.span is_space suf',
+              -- If there is a space after the backslash, this is definitely a
+              -- string gap. Continue parsing gaps after the next backslash.
+              not $ T.null gap ->
+                pre : splitGaps rest
+            | otherwise ->
+                -- Check whether @suf@ starts with an escape sequence
+                -- involving another backslash. If so, it cannot be the start
+                -- of a string gap, so we skip it.
+                let skipNextBackslash =
+                      any (`T.isPrefixOf` suf') escapesWithAnotherBackslash
+                 in go $ (if skipNextBackslash then drop 1 else id) bs
+          _ -> go bs
+
+        -- All escape sequences (without the initial backslash) with another
+        -- backslash. See
+        -- https://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6
+        escapesWithAnotherBackslash = ["\\", "^\\"]
+
+    -- See the MultilineStrings GHC proposal and 'lexMultilineString' from
+    -- "GHC.Parser.String" for reference.
+    --
+    -- https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0569-multiline-strings.rst#proposed-change-specification
+    splitMultilineString :: Text -> [Text]
+    splitMultilineString =
+      splitGaps
+        -- There is no reason to use gaps in multiline string literals just to
+        -- emulate multi-line strings, so we replace them with "\\ \\".
+        >>> intercalateMinimalStringGaps
+        >>> splitNewlines
+        >>> fmap expandLeadingTabs
+        >>> rmCommonWhitespacePrefixAndBlank
+
+    -- See the definition of newlines on
+    -- <https://www.haskell.org/onlinereport/haskell2010/haskellch10.html#x17-17800010.3>.
+    splitNewlines :: Text -> [Text]
+    splitNewlines = T.splitOn "\r\n" >=> T.split isNewlineish
+      where
+        isNewlineish c = c == '\n' || c == '\r' || c == '\f'
+
+    -- See GHC's 'lexMultilineString'.
+    expandLeadingTabs :: Text -> Text
+    expandLeadingTabs = T.concat . go 0
+      where
+        go :: Int -> Text -> [Text]
+        go col s = case T.breakOn "\t" s of
+          (pre, T.uncons -> Just (_, suf)) ->
+            let col' = col + T.length pre
+                fill = 8 - (col' `mod` 8)
+             in pre : T.replicate fill " " : go (col' + fill) suf
+          _ -> [s]
+
+    -- Don't touch the first line; remove common whitespace from all
+    -- remaining lines, and convert those consisting only of whitespace into
+    -- empty lines.
+    rmCommonWhitespacePrefixAndBlank :: [Text] -> [Text]
+    rmCommonWhitespacePrefixAndBlank = \case
+      [] -> []
+      hd : tl -> hd : tl'
+        where
+          (leadingSpaces, tl') = unzip $ countLeadingAndBlank <$> tl
+
+          commonWs :: Int
+          commonWs = maybe 0 getMin $ mconcat leadingSpaces
+
+          countLeadingAndBlank :: Text -> (Maybe (Min Int), Text)
+          countLeadingAndBlank l
+            | T.all is_space l = (Nothing, "")
+            | otherwise = (Just $ Min leadingSpace, T.drop commonWs l)
+            where
+              leadingSpace = T.length $ T.takeWhile is_space l
+
+-- | Add minimal string gaps between string literal chunks. Such string gaps
+-- /can/ be semantically meaningful (so we preserve them for simplicity); for
+-- example:
+--
+-- >>> "\65\ \0" == "\650"
+-- False
+intercalateMinimalStringGaps :: [Text] -> Text
+intercalateMinimalStringGaps = T.intercalate "\\ \\"
diff --git a/src/Ormolu/Printer/Meat/Declaration/Type.hs b/src/Ormolu/Printer/Meat/Declaration/Type.hs
--- a/src/Ormolu/Printer/Meat/Declaration/Type.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/Type.hs
@@ -1,4 +1,7 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 
 -- | Rendering of type synonym declarations.
@@ -7,6 +10,7 @@
   )
 where
 
+import Data.Choice (pattern Is, pattern Isn't)
 import GHC.Hs.Extension
 import GHC.Hs.Type
 import GHC.Parser.Annotation
@@ -32,13 +36,16 @@
   space
   switchLayout (getLocA name : map getLocA hsq_explicit) $
     p_infixDefHelper
-      (case fixity of Infix -> True; _ -> False)
-      True
+      ( case fixity of
+          Infix -> Is #infixStyle
+          _ -> Isn't #infixStyle
+      )
+      (Is #indentArgs)
       (p_rdrName name)
       (map (located' p_hsTyVarBndr) hsq_explicit)
   inci $ do
     space
-    equals
+    txt "="
     if hasDocStrings (unLoc t)
       then newline
       else breakpoint
diff --git a/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs b/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs
--- a/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs
@@ -1,5 +1,8 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 
 -- | Rendering of data\/type families.
@@ -10,6 +13,8 @@
 where
 
 import Control.Monad
+import Data.Choice (pattern Is)
+import Data.Choice qualified as Choice
 import Data.Maybe (isNothing)
 import GHC.Hs
 import GHC.Types.Fixity
@@ -33,8 +38,8 @@
     breakpoint
     switchLayout headerSpns $ do
       p_infixDefHelper
-        (isInfix fdFixity)
-        True
+        (Choice.fromBool (isInfix fdFixity))
+        (Is #indentArgs)
         (p_rdrName fdLName)
         (located' p_hsTyVarBndr <$> hsq_explicit)
     let resultSig = p_familyResultSigL fdResultSig
@@ -67,7 +72,7 @@
     breakpoint
     located k p_hsType
   TyVarSig NoExtField bndr -> Just $ do
-    equals
+    txt "="
     breakpoint
     located bndr p_hsTyVarBndr
 
@@ -95,13 +100,13 @@
     let famLhsSpn = getLocA feqn_tycon : fmap lhsTypeArgSrcSpan feqn_pats
     switchLayout famLhsSpn $
       p_infixDefHelper
-        (isInfix feqn_fixity)
-        True
+        (Choice.fromBool (isInfix feqn_fixity))
+        (Is #indentArgs)
         (p_rdrName feqn_tycon)
         (p_lhsTypeArg <$> feqn_pats)
     inci $ do
       space
-      equals
+      txt "="
       breakpoint
       located feqn_rhs p_hsType
 
diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs b/src/Ormolu/Printer/Meat/Declaration/Value.hs
--- a/src/Ormolu/Printer/Meat/Declaration/Value.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -9,7 +10,6 @@
     p_pat,
     p_hsExpr,
     p_hsUntypedSplice,
-    p_stringLit,
     IsApplicand (..),
     p_hsExpr',
     p_hsCmdTop,
@@ -20,24 +20,19 @@
 
 import Control.Monad
 import Data.Bool (bool)
-import Data.Coerce (coerce)
+import Data.Choice qualified as Choice
 import Data.Data hiding (Infix, Prefix)
 import Data.Function (on)
 import Data.Functor ((<&>))
 import Data.Generics.Schemes (everything)
-import Data.List (intersperse, sortBy)
+import Data.List (intersperse, sortBy, unsnoc)
 import Data.List.NonEmpty (NonEmpty (..), (<|))
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe
 import Data.Text (Text)
-import Data.Text qualified as Text
-import Data.Void
-import GHC.Data.Bag (bagToList)
-import GHC.Data.FastString
 import GHC.Data.Strict qualified as Strict
 import GHC.Hs
 import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))
-import GHC.Parser.CharClass (is_space)
 import GHC.Types.Basic
 import GHC.Types.Fixity
 import GHC.Types.Name.Reader
@@ -48,7 +43,8 @@
 import Ormolu.Printer.Meat.Common
 import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
 import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree
-import Ormolu.Printer.Meat.Declaration.Signature
+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Signature
+import Ormolu.Printer.Meat.Declaration.StringLiteral
 import Ormolu.Printer.Meat.Type
 import Ormolu.Printer.Operators
 import Ormolu.Utils
@@ -100,15 +96,15 @@
   MatchGroup GhcPs (LocatedA body) ->
   R ()
 p_matchGroup' placer render style mg@MG {..} = do
+  -- Since we are forcing braces on 'sepSemi' based on 'ob', we have to
+  -- restore the brace state inside the 'sepSemi'.
+  ub <- bool dontUseBraces useBraces <$> canUseBraces
   let ob = case style of
-        Case -> bracesIfEmpty
-        LambdaCase -> bracesIfEmpty
+        Case -> bracesIfNecessary
+        LambdaCase -> bracesIfNecessary
         _ -> dontUseBraces
         where
-          bracesIfEmpty = if isEmptyMatchGroup mg then useBraces else id
-  -- Since we are forcing braces on 'sepSemi' based on 'ob', we have to
-  -- restore the brace state inside the sepsemi.
-  ub <- bool dontUseBraces useBraces <$> canUseBraces
+          bracesIfNecessary = if isEmptyMatchGroup mg then useBraces else ub
   ob $ sepSemi (located' (ub . p_Match)) (unLoc mg_alts)
   where
     p_Match m@Match {..} =
@@ -117,30 +113,30 @@
         render
         (adjustMatchGroupStyle m style)
         (isInfixMatch m)
-        (HsNoMultAnn NoExtField)
+        (HsUnannotated EpPatBind)
         (matchStrictness m)
-        m_pats
+        -- We use the spans of the individual patterns.
+        (unLoc m_pats)
         m_grhss
 
--- | Function id obtained through pattern matching on 'FunBind' should not
--- be used to print the actual equations because the different ‘RdrNames’
--- used in the equations may have different “decorations” (such as backticks
--- and paretheses) associated with them. It is necessary to use per-equation
--- names obtained from 'm_ctxt' of 'Match'. This function replaces function
--- name inside of 'Function' accordingly.
+-- | The function id obtained through pattern matching on 'FunBind' should
+-- not be used to print the actual equations, because the different
+-- ‘RdrNames’ used in the equations may have different “decorations” (such as
+-- backticks and parentheses) associated with them. It is necessary to use
+-- the per-equation names obtained from the 'm_ctxt' of a 'Match'. This
+-- function replaces the function name inside 'Function' accordingly.
 adjustMatchGroupStyle ::
   Match GhcPs body ->
   MatchGroupStyle ->
   MatchGroupStyle
 adjustMatchGroupStyle m = \case
-  Function _ -> (Function . mc_fun . m_ctxt) m
+  Function _ | FunRhs {mc_fun = f} <- m_ctxt m -> Function f
   style -> style
 
 matchStrictness :: Match id body -> SrcStrictness
-matchStrictness match =
-  case m_ctxt match of
-    FunRhs {mc_strictness = s} -> s
-    _ -> NoSrcStrict
+matchStrictness = \case
+  Match {m_ctxt = FunRhs {mc_strictness = s}} -> s
+  _ -> NoSrcStrict
 
 p_match ::
   -- | Style of the group
@@ -179,23 +175,25 @@
   R ()
 p_match' placer render style isInfix multAnn strictness m_pats GRHSs {..} = do
   -- Normally, since patterns may be placed in a multi-line layout, it is
-  -- necessary to bump indentation for the pattern group so it's more
-  -- indented than function name. This in turn means that indentation for
+  -- necessary to bump indentation for the pattern group so that it's more
+  -- indented than the function name. This in turn means that indentation for
   -- the body should also be bumped. Normally this would mean that bodies
   -- would start with two indentation steps applied, which is ugly, so we
-  -- need to be a bit more clever here and bump indentation level only when
-  -- pattern group is multiline.
+  -- need to be a bit more clever here and bump the indentation level only
+  -- when the pattern group is multiline.
+  p_hsMultAnn (located' p_hsType) multAnn
   case multAnn of
-    HsNoMultAnn NoExtField -> pure ()
-    HsPct1Ann _ -> txt "%1" *> space
-    HsMultAnn _ ty -> do
-      txt "%"
-      located ty p_hsType
-      space
+    HsUnannotated {} -> pure ()
+    HsLinearAnn {} -> space
+    HsExplicitMult {} -> space
   case strictness of
     NoSrcStrict -> return ()
     SrcStrict -> txt "!"
     SrcLazy -> txt "~"
+  let isCase = \case
+        Case -> True
+        LambdaCase -> True
+        _ -> False
   indentBody <- case NE.nonEmpty m_pats of
     Nothing ->
       False <$ case style of
@@ -206,14 +204,19 @@
             Function name -> combineSrcSpans (getLocA name) patSpans
             _ -> patSpans
           patSpans = combineSrcSpans' (getLocA <$> ne_pats)
-          indentBody = not (isOneLineSpan combinedSpans)
+          containsOrPat = everything (||) $ \b -> case cast @_ @(Pat GhcPs) b of
+            Just OrPat {} -> True
+            _ -> False
+          indentBody =
+            not (isOneLineSpan combinedSpans)
+              && not (isCase style && containsOrPat ne_pats)
       switchLayout [combinedSpans] $ do
         let stdCase = sep breakpoint (located' p_pat) m_pats
         case style of
           Function name ->
             p_infixDefHelper
-              isInfix
-              indentBody
+              (Choice.fromBool isInfix)
+              (Choice.fromBool indentBody)
               (p_rdrName name)
               (located' p_pat <$> m_pats)
           PatternBind -> stdCase
@@ -236,21 +239,18 @@
               -- lines, we have to indent all but the first pattern.
               inci $ sep breakpoint (located' p_pat) tail_pats
       return indentBody
-  let -- Calculate position of end of patterns. This is useful when we decide
-      -- about putting certain constructions in hanging positions.
+  let -- Calculate the position of the end of the patterns. This is useful
+      -- when we decide whether to put certain constructions in hanging
+      -- positions.
       endOfPats = case NE.nonEmpty m_pats of
         Nothing -> case style of
           Function name -> Just (getLocA name)
           _ -> Nothing
         Just pats -> (Just . getLocA . NE.last) pats
-      isCase = \case
-        Case -> True
-        LambdaCase -> True
-        _ -> False
       hasGuards = withGuards grhssGRHSs
       grhssSpan =
         combineSrcSpans' $
-          getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs
+          getGRHSSpan . unLoc <$> grhssGRHSs
       patGrhssSpan =
         maybe
           grhssSpan
@@ -276,19 +276,26 @@
         sep
           breakpoint
           (located' (p_grhs' placement placer render groupStyle))
-          grhssGRHSs
+          (NE.toList grhssGRHSs)
+      localBindsWhereSpan = case grhssLocalBinds of
+        HsValBinds (EpAnn {anns = AnnList {al_rest}}) _ ->
+          locA al_rest
+        HsIPBinds (EpAnn {anns = AnnList {al_rest}}) _ ->
+          locA al_rest
+        EmptyLocalBinds _ -> noSrcSpan
       p_where = do
         unless (eqEmptyLocalBinds grhssLocalBinds) $ do
           breakpoint
-          txt "where"
+          located (L localBindsWhereSpan ()) $ \_ -> txt "where"
           breakpoint
           inci $ p_hsLocalBinds grhssLocalBinds
   inciIf indentBody $ do
     unless (length grhssGRHSs > 1) $
       case style of
         Function _ | hasGuards -> return ()
-        Function _ -> space >> inci equals
-        PatternBind -> space >> inci equals
+        Function _ -> space >> inci (txt "=")
+        PatternBind | hasGuards -> return ()
+        PatternBind -> space >> inci (txt "=")
         s | isCase s && hasGuards -> return ()
         _ -> space >> txt "->"
     switchLayout [patGrhssSpan] $
@@ -317,7 +324,7 @@
       sitcc (sep commaDel (sitcc . located' p_stmt) xs)
       space
       inci $ case style of
-        EqualSign -> equals
+        EqualSign -> txt "="
         RightArrow -> txt "->"
       -- If we have a sequence of guards and it is placed in the normal way,
       -- then we indent one level more for readability. Otherwise (all
@@ -345,7 +352,7 @@
 p_hsCmd' isApp s = \case
   HsCmdArrApp _ body input arrType rightToLeft -> do
     let (l, r) = if rightToLeft then (body, input) else (input, body)
-    located l p_hsExpr
+    located l $ p_hsExpr' NotApplicand s
     breakpoint
     inci $ do
       case (arrType, rightToLeft) of
@@ -355,27 +362,27 @@
         (HsHigherOrderApp, False) -> txt ">>-"
       placeHanging (exprPlacement (unLoc input)) $
         located r p_hsExpr
-  HsCmdArrForm _ form Prefix _ cmds -> banana s $ do
+  HsCmdArrForm _ form Prefix cmds -> banana s $ do
     located form p_hsExpr
     unless (null cmds) $ do
       breakpoint
       inci (sequence_ (intersperse breakpoint (located' (p_hsCmdTop N) <$> cmds)))
-  HsCmdArrForm _ form Infix _ [left, right] -> do
+  HsCmdArrForm _ form Infix [left, right] -> do
     modFixityMap <- askModuleFixityMap
     debug <- askDebug
     let opTree = BinaryOpBranches (cmdOpTree left) form (cmdOpTree right)
     p_cmdOpTree
       s
       (reassociateOpTree debug (getOpName . unLoc) modFixityMap opTree)
-  HsCmdArrForm _ _ Infix _ _ -> notImplemented "HsCmdArrForm"
+  HsCmdArrForm _ _ Infix _ -> notImplemented "HsCmdArrForm"
   HsCmdApp _ cmd expr -> do
     located cmd (p_hsCmd' Applicand s)
     breakpoint
     inci $ located expr p_hsExpr
-  HsCmdLam _ variant mgroup -> p_lam isApp variant cmdPlacement p_hsCmd mgroup
+  HsCmdLam _ variant mgroup -> p_lam isApp s variant cmdPlacement p_hsCmd mgroup
   HsCmdPar _ c -> parens N (located c p_hsCmd)
   HsCmdCase _ e mgroup ->
-    p_case isApp cmdPlacement p_hsCmd e mgroup
+    p_case isApp s cmdPlacement p_hsCmd e mgroup
   HsCmdIf anns _ if' then' else' ->
     p_if cmdPlacement p_hsCmd anns if' then' else'
   HsCmdLet _ localBinds c ->
@@ -400,29 +407,30 @@
   case getLocA l of
     UnhelpfulSpan _ -> f x
     RealSrcSpan currentSpn _ -> do
-      getSpanMark >>= \case
-        -- Spacing before comments will be handled by the code
-        -- that prints comments, so we just have to deal with
-        -- blank lines between statements here.
-        Just (StatementSpan lastSpn) ->
-          if srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1
-            then newline
-            else return ()
-        _ -> return ()
+      (lastEmittedSpan <$> getLastEmitted) >>= \case
+        -- We deal with blank lines between statements here. The last thing
+        -- emitted may be a statement (the usual case) or a comment: the
+        -- latter happens when the previous statement ended with a trailing
+        -- comment, in which case we still want to preserve a blank line that
+        -- followed that comment in the original input.
+        Just lastSpn ->
+          when (srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1) newline
+        Nothing -> return ()
       f x
-      -- In some cases the (f x) expression may insert a new mark. We want
-      -- to be careful not to override comment marks.
-      getSpanMark >>= \case
-        Just (HaddockSpan _ _) -> return ()
-        Just (CommentSpan _) -> return ()
-        _ -> setSpanMark (StatementSpan currentSpn)
+      -- In some cases the (f x) expression may record something else. We
+      -- want to be careful not to override comments.
+      getLastEmitted >>= \case
+        LastEmittedHaddock _ -> return ()
+        LastEmittedComment _ -> return ()
+        _ -> setLastEmitted (LastEmittedStatement currentSpn)
 
 p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
 p_stmt = p_stmt' N exprPlacement (p_hsExpr' NotApplicand)
 
 p_stmt' ::
-  ( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
-    Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
+  ( Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,
+    Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,
+    Anno body ~ SrcSpanAnnA
   ) =>
   BracketStyle ->
   -- | Placer
@@ -430,7 +438,7 @@
   -- | Render
   (BracketStyle -> body -> R ()) ->
   -- | Statement to render
-  Stmt GhcPs (LocatedA body) ->
+  Stmt GhcPs (XRec GhcPs body) ->
   R ()
 p_stmt' s placer render = \case
   LastStmt _ body _ _ -> located body (render s)
@@ -444,20 +452,19 @@
           | otherwise = Normal
     switchLayout [loc, l] $
       placeHanging placement (located f (render N))
-  ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer
   BodyStmt _ body _ _ -> located body (render s)
   LetStmt _ binds -> do
     txt "let"
     space
     sitcc $ p_hsLocalBinds binds
   ParStmt {} ->
-    -- 'ParStmt' should always be eliminated in 'gatherStmts' already, such
+    -- 'ParStmt' should always be eliminated in 'gatherStmts' already, so
     -- that it never occurs in 'p_stmt''. Consequently, handling it here
     -- would be redundant.
     notImplemented "ParStmt"
   TransStmt {..} ->
-    -- 'TransStmt' only needs to account for render printing itself, since
-    -- pretty printing of relevant statements (e.g., in 'trS_stmts') is
+    -- 'TransStmt' only needs to account for printing itself, since
+    -- pretty-printing of the relevant statements (e.g. in 'trS_stmts') is
     -- handled through 'gatherStmts'.
     case (trS_form, trS_by) of
       (ThenForm, Nothing) -> do
@@ -490,8 +497,9 @@
     sitcc . located recS_stmts $ sepSemi (withSpacing (p_stmt' s placer render))
 
 p_stmts ::
-  ( Anno (Stmt GhcPs (LocatedA body)) ~ SrcSpanAnnA,
-    Anno [LocatedA (Stmt GhcPs (LocatedA body))] ~ SrcSpanAnnL
+  ( Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,
+    Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,
+    Anno body ~ SrcSpanAnnA
   ) =>
   BracketStyle ->
   IsApplicand ->
@@ -500,7 +508,7 @@
   -- | Render
   (BracketStyle -> body -> R ()) ->
   -- | Statements to render
-  LocatedL [LocatedA (Stmt GhcPs (LocatedA body))] ->
+  XRec GhcPs [LStmt GhcPs (XRec GhcPs body)] ->
   R ()
 p_stmts s isApp placer render es = do
   breakpoint
@@ -509,7 +517,7 @@
         ub' $ withSpacing (p_stmt' s placer render) stmt
         where
           -- We need to set brace usage information for all but the last
-          -- statement (e.g.in the case of nested do blocks).
+          -- statement (e.g. in the case of nested do blocks).
           ub' = case relPos of
             FirstPos -> ub
             MiddlePos -> ub
@@ -520,15 +528,15 @@
 
 p_hsLocalBinds :: HsLocalBinds GhcPs -> R ()
 p_hsLocalBinds = \case
-  HsValBinds epAnn (ValBinds _ bag lsigs) -> pseudoLocated epAnn $ do
+  HsValBinds epAnn (ValBinds _ binds lsigs) -> pseudoLocated epAnn $ do
     -- When in a single-line layout, there is a chance that the inner
-    -- elements will also contain semicolons and they will confuse the
-    -- parser. so we request braces around every element except the last.
+    -- elements will also contain semicolons that will confuse the parser,
+    -- so we request braces around every element except the last.
     br <- layoutToBraces <$> getLayout
     let items =
           let injectLeft (L l x) = L l (Left x)
               injectRight (L l x) = L l (Right x)
-           in (injectLeft <$> bagToList bag) ++ (injectRight <$> lsigs)
+           in (injectLeft <$> binds) ++ (injectRight <$> lsigs)
         positionToBracing = \case
           SinglePos -> id
           FirstPos -> br
@@ -537,35 +545,35 @@
         p_item' (p, item) =
           positionToBracing p $
             withSpacing (either p_valDecl p_sigDecl) item
-        binds = sortBy (leftmost_smallest `on` getLocA) items
-    sitcc $ sepSemi p_item' (attachRelativePos binds)
+        items' = sortBy (leftmost_smallest `on` getLocA) items
+    sitcc $ sepSemi p_item' (attachRelativePos items')
   HsValBinds _ _ -> notImplemented "HsValBinds"
   HsIPBinds epAnn (IPBinds _ xs) -> pseudoLocated epAnn $ do
     let p_ipBind (IPBind _ (L _ name) expr) = do
           atom @HsIPName name
           space
-          equals
+          txt "="
           breakpoint
           useBraces $ inci $ located expr p_hsExpr
     sepSemi (located' p_ipBind) xs
   EmptyLocalBinds _ -> return ()
   where
-    -- HsLocalBinds is no longer wrapped in a Located (see call sites
-    -- of p_hsLocalBinds). Hence, we introduce a manual Located as we
-    -- depend on the layout being correctly set.
+    -- HsLocalBinds is no longer wrapped in a Located (see the call sites
+    -- of p_hsLocalBinds). Hence, we introduce a manual Located, as we
+    -- depend on the layout being set correctly.
     pseudoLocated = \case
       EpAnn {anns = AnnList {al_anchor}}
-        | -- excluding cases where there are no bindings
+        | -- Excluding cases where there are no bindings.
           not $ isZeroWidthSpan (locA al_anchor) ->
             located (L al_anchor ()) . const
       _ -> id
 
-p_ldotFieldOcc :: XRec GhcPs (DotFieldOcc GhcPs) -> R ()
-p_ldotFieldOcc =
-  located' $ p_rdrName . fmap (mkVarUnqual . field_label) . dfoLabel
+p_dotFieldOcc :: DotFieldOcc GhcPs -> R ()
+p_dotFieldOcc =
+  p_rdrName . fmap (mkVarUnqual . field_label) . dfoLabel
 
-p_ldotFieldOccs :: [XRec GhcPs (DotFieldOcc GhcPs)] -> R ()
-p_ldotFieldOccs = sep (txt ".") p_ldotFieldOcc
+p_dotFieldOccs :: NonEmpty (DotFieldOcc GhcPs) -> R ()
+p_dotFieldOccs = sep (txt ".") p_dotFieldOcc . NE.toList
 
 p_fieldOcc :: FieldOcc GhcPs -> R ()
 p_fieldOcc FieldOcc {..} = p_rdrName foLabel
@@ -579,7 +587,7 @@
   p_lhs hfbLHS
   unless hfbPun $ do
     space
-    equals
+    txt "="
     let placement =
           if onTheSameLine (getLocA hfbLHS) (getLocA hfbRHS)
             then exprPlacement (unLoc hfbRHS)
@@ -589,8 +597,9 @@
 p_hsExpr :: HsExpr GhcPs -> R ()
 p_hsExpr = p_hsExpr' NotApplicand N
 
--- | An applicand is the left-hand side in a function application, i.e. @f@ in
--- @f a@. We need to track this in order to add extra identation in cases like
+-- | An applicand is the left-hand side of a function application, i.e. @f@
+-- in @f a@. We need to track this in order to add extra indentation in cases
+-- like
 --
 -- > foo =
 -- >   do
@@ -603,12 +612,19 @@
   Applicand -> inci . inci
   NotApplicand -> inci
 
+-- | Adjust bracing as needed for certain cases, e.g. those involving case
+-- expressions and lambdas.
+adjustBracing :: IsApplicand -> BracketStyle -> R () -> R ()
+adjustBracing isApp s p = do
+  layout <- getLayout
+  case (s, layout, isApp) of
+    (S, SingleLine, NotApplicand) -> useBraces p
+    _ -> p
+
 p_hsExpr' :: IsApplicand -> BracketStyle -> HsExpr GhcPs -> R ()
 p_hsExpr' isApp s = \case
   HsVar _ name -> p_rdrName name
-  HsUnboundVar _ occ -> atom occ
-  HsRecSel _ fldOcc -> p_fieldOcc fldOcc
-  HsOverLabel _ sourceText _ -> do
+  HsOverLabel sourceText _ -> do
     txt "#"
     p_sourceText sourceText
   HsIPVar _ (HsIPName name) -> do
@@ -619,12 +635,13 @@
     case lit of
       HsString (SourceText stxt) _ -> p_stringLit stxt
       HsStringPrim (SourceText stxt) _ -> p_stringLit stxt
+      HsMultilineString (SourceText stxt) _ -> p_stringLit stxt
       r -> atom r
   HsLam _ variant mgroup ->
-    p_lam isApp variant exprPlacement p_hsExpr mgroup
+    p_lam isApp s variant exprPlacement p_hsExpr mgroup
   HsApp _ f x -> do
     let -- In order to format function applications with multiple parameters
-        -- nicer, traverse the AST to gather the function and all the
+        -- more nicely, traverse the AST to gather the function and all the
         -- parameters together.
         gatherArgs f' knownArgs =
           case f' of
@@ -645,8 +662,7 @@
             else Normal
     -- If the last argument is not hanging, just separate every argument as
     -- usual. If it is hanging, print the initial arguments and hang the
-    -- last one. Also, use braces around the every argument except the last
-    -- one.
+    -- last one. Also, use braces around every argument except the last one.
     case placement of
       Normal -> do
         ub <-
@@ -672,11 +688,6 @@
     breakpoint
     inci $ do
       txt "@"
-      -- Insert a space when the type is represented as a TH splice to avoid
-      -- gluing @ and $ together.
-      case unLoc (hswc_body a) of
-        HsSpliceTy {} -> space
-        _ -> return ()
       located (hswc_body a) p_hsType
   OpApp _ x op y -> do
     modFixityMap <- askModuleFixityMap
@@ -693,13 +704,11 @@
           _ -> False
     txt "-"
     -- If NegativeLiterals is enabled, we have to insert a space before
-    -- negated literals, as `- 1` and `-1` have differing AST.
+    -- negated literals, as `- 1` and `-1` have differing ASTs.
     when (negativeLiterals && isLiteral) space
     located e p_hsExpr
-  HsPar _ e -> do
-    csSpans <-
-      fmap (flip RealSrcSpan Strict.Nothing . getLoc) <$> getEnclosingComments
-    switchLayout (locA e : csSpans) $
+  HsPar _ e ->
+    switchLayoutWithEnclosingComments [locA e] $
       parens s (located e (dontUseBraces . p_hsExpr))
   SectionL _ x op -> do
     located x p_hsExpr
@@ -735,13 +744,14 @@
   ExplicitSum _ tag arity e ->
     p_unboxedSum N tag arity (located e p_hsExpr)
   HsCase _ e mgroup ->
-    p_case isApp exprPlacement p_hsExpr e mgroup
+    p_case isApp s exprPlacement p_hsExpr e mgroup
   HsIf anns if' then' else' ->
     p_if exprPlacement p_hsExpr anns if' then' else'
   HsMultiIf _ guards -> do
     txt "if"
     breakpoint
-    inciApplicand isApp $ sep newline (located' (p_grhs RightArrow)) guards
+    inciApplicand isApp $
+      sep breakpoint (located' (p_grhs RightArrow)) (NE.toList guards)
   HsLet _ localBinds e ->
     p_let p_hsExpr localBinds e
   HsDo _ doFlavor es -> do
@@ -772,25 +782,22 @@
   RecordUpd {..} -> do
     located rupd_expr p_hsExpr
     breakpoint
-    let p_updLbl =
-          located' $
-            p_rdrName . \case
-              (Unambiguous NoExtField n :: AmbiguousFieldOcc GhcPs) -> n
-              Ambiguous NoExtField n -> n
-        p_recFields p_lbl =
+    let p_recFields p_lbl =
           sep commaDel (sitcc . located' (p_hsFieldBind p_lbl))
+        p_fieldLabelStrings (FieldLabelStrings flss) =
+          p_dotFieldOccs $ unLoc <$> flss
     inci . braces N $ case rupd_flds of
       RegularRecUpdFields {..} ->
-        p_recFields p_updLbl recUpdFields
+        p_recFields (located' p_fieldOcc) recUpdFields
       OverloadedRecUpdFields {..} ->
-        p_recFields (located' (coerce p_ldotFieldOccs)) olRecUpdFields
+        p_recFields (located' p_fieldLabelStrings) olRecUpdFields
   HsGetField {..} -> do
     located gf_expr p_hsExpr
     txt "."
-    p_ldotFieldOcc gf_field
+    located gf_field p_dotFieldOcc
   HsProjection {..} -> parens N $ do
     txt "."
-    p_ldotFieldOccs (NE.toList proj_flds)
+    p_dotFieldOccs proj_flds
   ExprWithTySig _ x HsWC {hswc_body} -> sitcc $ do
     located x p_hsExpr
     space
@@ -825,8 +832,8 @@
     located expr p_hsExpr
     breakpoint'
     txt "||]"
-  HsUntypedBracket anns x -> p_hsQuote anns x
-  HsTypedSplice _ expr -> p_hsSpliceTH True expr DollarSplice
+  HsUntypedBracket _ x -> p_hsQuote x
+  HsTypedSplice _ (HsTypedSpliceExpr _ expr) -> p_hsSpliceTH True expr DollarSplice
   HsUntypedSplice _ untySplice -> p_hsUntypedSplice DollarSplice untySplice
   HsProc _ p e -> do
     txt "proc"
@@ -853,11 +860,38 @@
     txt "type"
     space
     located hswc_body p_hsType
+  HsHole holeKind -> case holeKind of
+    HoleVar name -> p_rdrName name
+    HoleError -> error "parse error"
+  -- similar to HsForAllTy
+  HsForAll _ tele e -> do
+    p_hsForAllTelescope tele
+    breakpoint
+    located e p_hsExpr
+  -- similar to HsQualTy
+  HsQual _ qs e -> do
+    located qs $ p_hsContext' p_hsExpr
+    space
+    txt "=>"
+    breakpoint
+    located e p_hsExpr
+  -- similar to HsFunTy
+  HsFunArr _ multAnn x y -> do
+    located x p_hsExpr
+    space
+    p_hsMultAnn (located' p_hsExpr) multAnn
+    space
+    txt "->"
+    breakpoint
+    case unLoc y of
+      HsFunArr {} -> p_hsExpr (unLoc y)
+      _ -> located y p_hsExpr
 
 -- | Print a list comprehension.
 --
--- BracketStyle should be N except in a do-block, which must be S or else it's a parse error.
-p_listComp :: BracketStyle -> GenLocated SrcSpanAnnL [ExprLStmt GhcPs] -> R ()
+-- The 'BracketStyle' should be 'N' except in a do-block, where it must be 'S'
+-- or else it's a parse error.
+p_listComp :: BracketStyle -> XRec GhcPs [ExprLStmt GhcPs] -> R ()
 p_listComp s es = sitcc (vlayout singleLine multiLine)
   where
     singleLine = do
@@ -874,21 +908,20 @@
     body = located es p_body
     p_body xs = do
       let (stmts, yield) =
-            -- TODO: use unsnoc when require GHC 9.8+
-            case xs of
-              [] -> error $ "list comprehension unexpectedly had no expressions"
-              _ -> (init xs, last xs)
+            case unsnoc xs of
+              Nothing -> error $ "list comprehension unexpectedly had no expressions"
+              Just (ys, y) -> (ys, y)
       sitcc $ located yield p_stmt
       breakpoint
       txt "|"
       space
       p_bodyParallels (gatherStmts stmts)
 
-    -- print the list of list comprehension sections, e.g.
+    -- Print the list of list comprehension sections, e.g.
     -- [ "| x <- xs, y <- ys, let z = x <> y", "| a <- f z" ]
     p_bodyParallels = sep (breakpoint >> txt "|" >> space) (sitcc . p_bodyParallelStmts)
 
-    -- print a list comprehension section within a pipe, e.g.
+    -- Print a list comprehension section within a pipe, e.g.
     -- [ "x <- xs", "y <- ys", "let z = x <> y" ]
     p_bodyParallelStmts = sep commaDel (located' (sitcc . p_stmt))
 
@@ -927,7 +960,7 @@
 -- @
 --
 -- The final expression is parsed out in p_body, and the rest is passed
--- to this function. This function takes the above tree as input and
+-- to this function. This function takes the tree above as input and
 -- normalizes it into:
 --
 -- @
@@ -944,17 +977,17 @@
 --
 -- Notes:
 --   * The number of elements in the outer list is the number of pipes in
---     the comprehension; i.e. 1 unless -XParallelListComp is enabled
+--     the comprehension, i.e. 1 unless -XParallelListComp is enabled.
 gatherStmts :: [ExprLStmt GhcPs] -> [[ExprLStmt GhcPs]]
 gatherStmts = \case
-  -- When -XParallelListComp is enabled + list comprehension has
-  -- multiple pipes, input will have exactly 1 element, and it
-  -- will be ParStmt.
+  -- When -XParallelListComp is enabled and the list comprehension has
+  -- multiple pipes, the input will have exactly 1 element, and it
+  -- will be a ParStmt.
   [L _ (ParStmt _ blocks _ _)] ->
     [ concatMap collectNonParStmts stmts
-    | ParStmtBlock _ stmts _ _ <- blocks
+    | ParStmtBlock _ stmts _ _ <- NE.toList blocks
     ]
-  -- Otherwise, list will not contain any ParStmt
+  -- Otherwise, the list will not contain any ParStmt.
   stmts ->
     [ concatMap collectNonParStmts stmts
     ]
@@ -979,7 +1012,7 @@
               located psb_def p_pat
           ImplicitBidirectional ->
             switchLayout pattern_def_spans $ do
-              equals
+              txt "="
               breakpoint
               located psb_def p_pat
           ExplicitBidirectional mgroup -> do
@@ -993,7 +1026,7 @@
             inci (p_matchGroup (Function psb_id) mgroup)
   txt "pattern"
   case psb_args of
-    PrefixCon [] xs -> do
+    PrefixCon xs -> do
       space
       p_rdrName psb_id
       inci $ do
@@ -1002,7 +1035,6 @@
           unless (null xs) breakpoint
           sitcc (sep breakpoint p_rdrName xs)
         rhs conSpans
-    PrefixCon (v : _) _ -> absurd v
     RecCon xs -> do
       space
       p_rdrName psb_id
@@ -1030,6 +1062,7 @@
     Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
   ) =>
   IsApplicand ->
+  BracketStyle ->
   -- | Placer
   (body -> Placement) ->
   -- | Render
@@ -1039,20 +1072,23 @@
   -- | Match group
   MatchGroup GhcPs (LocatedA body) ->
   R ()
-p_case isApp placer render e mgroup = do
+p_case isApp s placer render e mgroup = do
   txt "case"
   space
   located e p_hsExpr
   space
   txt "of"
   breakpoint
-  inciApplicand isApp (p_matchGroup' placer render Case mgroup)
+  adjustBracing isApp s $
+    inciApplicand isApp (p_matchGroup' placer render Case mgroup)
 
 p_lam ::
   ( Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,
     Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
   ) =>
   IsApplicand ->
+  -- | BracketStyle (S when inside a do block)
+  BracketStyle ->
   -- | Variant (@\\@ or @\\case@ or @\\cases@)
   HsLamVariant ->
   -- | Placer
@@ -1062,7 +1098,7 @@
   -- | Expression
   MatchGroup GhcPs (LocatedA body) ->
   R ()
-p_lam isApp variant placer render mgroup = do
+p_lam isApp s variant placer render mgroup = do
   let mCaseTxt = case variant of
         LamSingle -> Nothing
         LamCase -> Just "\\case"
@@ -1074,7 +1110,7 @@
     Just caseTxt -> do
       txt caseTxt
       breakpoint
-      inciApplicand isApp pMatchGroup
+      adjustBracing isApp s (inciApplicand isApp pMatchGroup)
 
 p_if ::
   -- | Placer
@@ -1095,7 +1131,12 @@
   space
   located if' p_hsExpr
   breakpoint
-  commentSpans <- fmap getLoc <$> getEnclosingComments
+  -- A comment between the @then@ or @else@ keyword and its branch means the
+  -- branch cannot hang; it has to start on its own line.
+  commentSpans <-
+    getEnclosingSpan >>= \case
+      Nothing -> pure []
+      Just enclosing -> fmap getLoc <$> getCommentsAnchoredWithin enclosing
   let (thenSpan, elseSpan) = (locA aiThen, locA aiElse)
         where
           AnnsIf {aiThen, aiElse} = anns
@@ -1139,40 +1180,43 @@
   sitcc (located e render)
 
 p_pat :: Pat GhcPs -> R ()
-p_pat = \case
+p_pat = p_pat' False
+
+p_pat' :: Bool -> Pat GhcPs -> R ()
+p_pat' inAsPat = \case
   WildPat _ -> txt "_"
   VarPat _ name -> p_rdrName name
   LazyPat _ pat -> do
     txt "~"
-    located pat p_pat
+    located pat (p_pat' inAsPat)
   AsPat _ name pat -> do
     p_rdrName name
     txt "@"
-    located pat p_pat
+    located pat (p_pat' True)
   ParPat _ pat ->
-    located pat (parens S . p_pat)
+    located pat (parens S . p_pat' inAsPat)
   BangPat _ pat -> do
     txt "!"
-    located pat p_pat
+    located pat (p_pat' inAsPat)
   ListPat _ pats ->
-    brackets S $ sep commaDel (located' p_pat) pats
+    brackets S $ sep commaDel (located' (p_pat' inAsPat)) pats
   TuplePat _ pats boxing -> do
     let parens' =
           case boxing of
             Boxed -> parens S
             Unboxed -> parensHash S
-    parens' $ sep commaDel (sitcc . located' p_pat) pats
+    parens' $ sep commaDel (sitcc . located' (p_pat' inAsPat)) pats
+  OrPat _ pats -> do
+    sepSemi' inAsPat (located' (p_pat' inAsPat)) (NE.toList pats)
   SumPat _ pat tag arity ->
-    p_unboxedSum S tag arity (located pat p_pat)
+    p_unboxedSum S tag arity (located pat (p_pat' inAsPat))
   ConPat _ pat details ->
     case details of
-      PrefixCon tys xs -> sitcc $ do
+      PrefixCon xs -> sitcc $ do
         p_rdrName pat
-        unless (null tys && null xs) breakpoint
-        inci . sitcc $
-          sep breakpoint (sitcc . either p_hsConPatTyArg (located' p_pat)) $
-            (Left <$> tys) <> (Right <$> xs)
-      RecCon (HsRecFields fields dotdot) -> do
+        unless (null xs) breakpoint
+        inci . sitcc $ sep breakpoint (sitcc . located' (p_pat' inAsPat)) xs
+      RecCon (HsRecFields _ fields dotdot) -> do
         p_rdrName pat
         breakpoint
         let f = \case
@@ -1184,18 +1228,18 @@
             Just (L _ (RecFieldsDotDot n)) -> (Just <$> take n fields) ++ [Nothing]
       InfixCon l r -> do
         switchLayout [getLocA l, getLocA r] $ do
-          located l p_pat
+          located l (p_pat' inAsPat)
           breakpoint
           inci $ do
             p_rdrName pat
             space
-            located r p_pat
+            located r (p_pat' inAsPat)
   ViewPat _ expr pat -> sitcc $ do
     located expr p_hsExpr
     space
     txt "->"
     breakpoint
-    inci (located pat p_pat)
+    inci (located pat (p_pat' inAsPat))
   SplicePat _ splice -> p_hsUntypedSplice DollarSplice splice
   LitPat _ p -> atom p
   NPat _ v (isJust -> isNegated) _ -> do
@@ -1212,7 +1256,7 @@
       space
       located k (atom . ol_val)
   SigPat _ pat HsPS {..} -> do
-    located pat p_pat
+    located pat (p_pat' inAsPat)
     p_typeAscription (lhsTypeToSigType hsps_body)
   EmbTyPat _ (HsTP _ ty) -> do
     txt "type"
@@ -1223,15 +1267,12 @@
 p_tyPat :: HsTyPat GhcPs -> R ()
 p_tyPat (HsTP _ ty) = txt "@" *> located ty p_hsType
 
-p_hsConPatTyArg :: HsConPatTyArg GhcPs -> R ()
-p_hsConPatTyArg (HsConPatTyArg _ patSigTy) = p_tyPat patSigTy
-
 p_pat_hsFieldBind :: HsRecField GhcPs (LPat GhcPs) -> R ()
 p_pat_hsFieldBind HsFieldBind {..} = do
   located hfbLHS p_fieldOcc
   unless hfbPun $ do
     space
-    equals
+    txt "="
     breakpoint
     inci (located hfbRHS p_pat)
 
@@ -1255,7 +1296,7 @@
   HsUntypedSpliceExpr _ expr -> p_hsSpliceTH False expr deco
   HsQuasiQuote _ quoterName str -> do
     txt "["
-    p_rdrName (noLocA quoterName)
+    p_rdrName quoterName
     txt "|"
     -- QuasiQuoters often rely on precise custom strings. We cannot do any
     -- formatting here without potentially breaking someone's code.
@@ -1279,12 +1320,12 @@
   where
     decoSymbol = if isTyped then "$$" else "$"
 
-p_hsQuote :: [AddEpAnn] -> HsQuote GhcPs -> R ()
-p_hsQuote anns = \case
-  ExpBr _ expr -> do
-    let name
-          | any (isJust . matchAddEpAnn AnnOpenEQ) anns = ""
-          | otherwise = "e"
+p_hsQuote :: HsQuote GhcPs -> R ()
+p_hsQuote = \case
+  ExpBr (bracketAnn, _) expr -> do
+    let name = case bracketAnn of
+          BracketNoE {} -> ""
+          BracketHasE {} -> "e"
     quote name (located expr p_hsExpr)
   PatBr _ pat -> located pat (quote "p" . p_pat)
   DecBrL _ decls -> quote "d" (handleStarIsType decls (p_hsDecls Free decls))
@@ -1305,10 +1346,10 @@
         breakpoint'
         txt "|]"
     -- With StarIsType, type and declaration brackets might end with a *,
-    -- so we have to insert a space in the end to prevent the (mis)parsing
+    -- so we have to insert a space at the end to prevent the (mis)parsing
     -- of an (*|) operator.
     -- The detection is a bit overcautious, as it adds the spaces as soon as
-    -- HsStarTy is anywhere in the type/declaration.
+    -- an HsStarTy appears anywhere in the type/declaration.
     handleStarIsType :: (Data a) => a -> R () -> R ()
     handleStarIsType a p
       | containsHsStarTy a = space *> p <* space
@@ -1318,47 +1359,6 @@
           Just HsStarTy {} -> True
           _ -> False
 
--- | Print the source text of a string literal while indenting gaps correctly.
-p_stringLit :: FastString -> R ()
-p_stringLit src =
-  let s = splitGaps (unpackFS src)
-      singleLine =
-        txt $ Text.pack (mconcat s)
-      multiLine =
-        sitcc $ sep breakpoint (txt . Text.pack) (backslashes s)
-   in vlayout singleLine multiLine
-  where
-    -- Split a string on gaps (backslash delimited whitespaces)
-    --
-    -- > splitGaps "bar\\  \\fo\\&o" == ["bar", "fo\\&o"]
-    splitGaps :: String -> [String]
-    splitGaps "" = []
-    splitGaps s =
-      let -- A backslash and a whitespace starts a "gap"
-          p (Just '\\', _, _) = True
-          p (_, '\\', Just c) | ghcSpace c = False
-          p _ = True
-       in case span p (zipPrevNext s) of
-            (l, r) ->
-              let -- drop the initial '\', any amount of 'ghcSpace', and another '\'
-                  r' = drop 1 . dropWhile ghcSpace . drop 1 $ map orig r
-               in map orig l : splitGaps r'
-    -- GHC's definition of whitespaces in strings
-    -- See: https://gitlab.haskell.org/ghc/ghc/blob/86753475/compiler/parser/Lexer.x#L1653
-    ghcSpace :: Char -> Bool
-    ghcSpace c = c <= '\x7f' && is_space c
-    -- Add backslashes to the inner side of the strings
-    --
-    -- > backslashes ["a", "b", "c"] == ["a\\", "\\b\\", "\\c"]
-    backslashes :: [String] -> [String]
-    backslashes (x : y : xs) = (x ++ "\\") : backslashes (('\\' : y) : xs)
-    backslashes xs = xs
-    -- Attaches previous and next items to each list element
-    zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]
-    zipPrevNext xs =
-      zip3 (Nothing : map Just xs) xs (map Just (drop 1 xs) ++ [Nothing])
-    orig (_, x, _) = x
-
 ----------------------------------------------------------------------------
 -- Helpers
 
@@ -1373,15 +1373,15 @@
 getGRHSSpan (GRHS _ guards body) =
   combineSrcSpans' $ getLocA body :| map getLocA guards
 
--- | Determine placement of a given block.
+-- | Determine the placement of a given block.
 blockPlacement ::
   (body -> Placement) ->
-  [LGRHS GhcPs (LocatedA body)] ->
+  NonEmpty (LGRHS GhcPs (LocatedA body)) ->
   Placement
-blockPlacement placer [L _ (GRHS _ _ (L _ x))] = placer x
+blockPlacement placer (L _ (GRHS _ _ (L _ x)) :| []) = placer x
 blockPlacement _ _ = Normal
 
--- | Determine placement of a given command.
+-- | Determine the placement of a given command.
 cmdPlacement :: HsCmd GhcPs -> Placement
 cmdPlacement = \case
   HsCmdLam {} -> Hanging
@@ -1389,17 +1389,17 @@
   HsCmdDo {} -> Hanging
   _ -> Normal
 
--- | Determine placement of a top level command.
+-- | Determine the placement of a top-level command.
 cmdTopPlacement :: HsCmdTop GhcPs -> Placement
 cmdTopPlacement (HsCmdTop _ (L _ x)) = cmdPlacement x
 
--- | Check if given expression has a hanging form.
+-- | Check whether the given expression has a hanging form.
 exprPlacement :: HsExpr GhcPs -> Placement
 exprPlacement = \case
-  -- Only hang lambdas with single line parameter lists
+  -- Only hang lambdas with single-line parameter lists.
   HsLam _ variant mg -> case variant of
     LamSingle -> case mg of
-      MG _ (L _ [L _ (Match _ _ (x : xs) _)])
+      MG _ (L _ [L _ (Match _ _ (L _ (x : xs)) _)])
         | isOneLineSpan (combineSrcSpans' $ fmap getLocA (x :| xs)) ->
             Hanging
       _ -> Normal
@@ -1414,7 +1414,7 @@
       _ -> Normal
   HsApp _ _ y -> exprPlacement (unLoc y)
   HsProc _ p _ ->
-    -- Indentation breaks if pattern is longer than one line and left
+    -- Indentation breaks if the pattern is longer than one line and left
     -- hanging. Consequently, only apply hanging when it is safe.
     if isOneLineSpan (getLocA p)
       then Hanging
@@ -1422,7 +1422,7 @@
   _ -> Normal
 
 -- | Return 'True' if any of the RHS expressions has guards.
-withGuards :: [LGRHS GhcPs body] -> Bool
+withGuards :: NonEmpty (LGRHS GhcPs body) -> Bool
 withGuards = any (checkOne . unLoc)
   where
     checkOne (GRHS _ [] _) = False
diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs-boot b/src/Ormolu/Printer/Meat/Declaration/Value.hs-boot
--- a/src/Ormolu/Printer/Meat/Declaration/Value.hs-boot
+++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs-boot
@@ -3,7 +3,6 @@
     p_pat,
     p_hsExpr,
     p_hsUntypedSplice,
-    p_stringLit,
     p_hsExpr',
     p_hsCmdTop,
     exprPlacement,
@@ -11,7 +10,6 @@
   )
 where
 
-import GHC.Data.FastString
 import GHC.Hs
 import Ormolu.Printer.Combinators
 
@@ -19,7 +17,6 @@
 p_pat :: Pat GhcPs -> R ()
 p_hsExpr :: HsExpr GhcPs -> R ()
 p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()
-p_stringLit :: FastString -> R ()
 
 data IsApplicand
 
diff --git a/src/Ormolu/Printer/Meat/ImportExport.hs b/src/Ormolu/Printer/Meat/ImportExport.hs
--- a/src/Ormolu/Printer/Meat/ImportExport.hs
+++ b/src/Ormolu/Printer/Meat/ImportExport.hs
@@ -8,6 +8,7 @@
 module Ormolu.Printer.Meat.ImportExport
   ( p_hsmodExports,
     p_hsmodImport,
+    enterMultilineLayoutIfContainsDocEntries,
   )
 where
 
@@ -25,12 +26,13 @@
 
 p_hsmodExports :: [LIE GhcPs] -> R ()
 p_hsmodExports xs =
-  parens N $ do
-    layout <- getLayout
-    sep
-      breakpoint
-      (\(p, l) -> sitcc (located (addDocSrcSpan l) (p_lie layout p)))
-      (attachRelativePos xs)
+  enterMultilineLayoutIfContainsDocEntries xs $
+    parens N $ do
+      layout <- getLayout
+      sep
+        breakpoint
+        (\(p, l) -> sitcc (located (addDocSrcSpan l) (p_lie layout p)))
+        (attachRelativePos xs)
   where
     -- In order to correctly set the layout when a doc comment is present.
     addDocSrcSpan lie@(L l ie) = case ieExportDoc ie of
@@ -46,6 +48,10 @@
   space
   when ideclSafe (txt "safe")
   space
+  case ideclLevelSpec of
+    LevelStylePre l -> p_declLevel l
+    _ -> return ()
+  space
   when
     (isImportDeclQualified ideclQualified && not useQualifiedPost)
     (txt "qualified")
@@ -56,6 +62,10 @@
   space
   inci $ do
     located ideclName atom
+    space
+    case ideclLevelSpec of
+      LevelStylePost l -> p_declLevel l
+      _ -> return ()
     when
       (isImportDeclQualified ideclQualified && useQualifiedPost)
       (space >> txt "qualified")
@@ -69,19 +79,24 @@
     space
     case ideclImportList of
       Nothing -> return ()
-      Just (hiding, L _ xs) -> do
+      Just (hiding, L listLoc xs) -> do
         case hiding of
           Exactly -> pure ()
           EverythingBut -> txt "hiding"
         breakpoint
         parens N $ do
           layout <- getLayout
+          when (null xs) $ locatedEmpty (locA listLoc)
           sep
             breakpoint
             (\(p, l) -> sitcc (located l (p_lie layout p)))
             (attachRelativePos xs)
-    newline
 
+p_declLevel :: ImportDeclLevel -> R ()
+p_declLevel = \case
+  ImportDeclSplice -> txt "splice"
+  ImportDeclQuote -> txt "quote"
+
 p_lie :: Layout -> RelativePos -> IE GhcPs -> R ()
 p_lie encLayout relativePos = \case
   IEVar mwarn l1 exportDoc -> do
@@ -159,3 +174,16 @@
   IEGroup {} -> Nothing
   IEDoc {} -> Nothing
   IEDocNamed {} -> Nothing
+
+enterMultilineLayoutIfContainsDocEntries :: [LIE GhcPs] -> R () -> R ()
+enterMultilineLayoutIfContainsDocEntries xs =
+  if any (isDocEntry . unLoc) xs
+    then enterLayout MultiLine
+    else id
+
+isDocEntry :: (IE pass) -> Bool
+isDocEntry = \case
+  IEDoc {} -> True
+  IEGroup {} -> True
+  IEDocNamed {} -> True
+  _ -> False
diff --git a/src/Ormolu/Printer/Meat/Module.hs b/src/Ormolu/Printer/Meat/Module.hs
--- a/src/Ormolu/Printer/Meat/Module.hs
+++ b/src/Ormolu/Printer/Meat/Module.hs
@@ -23,7 +23,7 @@
 import Ormolu.Printer.Meat.ImportExport
 import Ormolu.Printer.Meat.Pragma
 
--- | Render a module-like entity (either a regular module or a backpack
+-- | Render a module-like entity (either a regular module or a Backpack
 -- signature).
 p_hsModule ::
   -- | Stack header
@@ -37,35 +37,42 @@
   let XModulePs {..} = hsmodExt
       deprecSpan = maybe [] (pure . getLocA) hsmodDeprecMessage
       exportSpans = maybe [] (pure . getLocA) hsmodExports
-  switchLayout (deprecSpan <> exportSpans) $ do
-    forM_ mstackHeader $ \(L spn comment) -> do
-      spitCommentNow spn comment
+  switchLayout (deprecSpan <> exportSpans) $
+    enterMultilineLayoutIfContainsDocEntries (maybe [] unLoc hsmodExports) $ do
+      forM_ mstackHeader $ \(L spn comment) -> do
+        spitCommentNow SlotFloating spn comment
+        newline
       newline
-    newline
-    p_pragmas pragmas
-    newline
-    case hsmodName of
-      Nothing -> return ()
-      Just hsmodName' -> do
-        located hsmodName' $ \name -> do
-          forM_ hsmodHaddockModHeader (p_hsDoc Pipe (With #endNewline))
-          p_hsmodName name
-        breakpoint
-        forM_ hsmodDeprecMessage $ \w -> do
-          located' p_warningTxt w
+      p_pragmas pragmas
+      newline
+      case hsmodName of
+        Nothing -> return ()
+        Just hsmodName' -> do
+          located hsmodName' $ \name -> do
+            forM_ hsmodHaddockModHeader (p_hsDoc Pipe (With #endNewline))
+            p_hsmodName name
           breakpoint
-        case hsmodExports of
-          Nothing -> return ()
-          Just l -> do
-            encloseLocated l $ \exports -> do
-              inci (p_hsmodExports exports)
+          forM_ hsmodDeprecMessage $ \w -> do
+            located' p_warningTxt w
             breakpoint
-        txt "where"
+          case hsmodExports of
+            Nothing -> return ()
+            Just l -> do
+              located l $ \exports -> do
+                when (null exports) $ locatedEmpty (locA l)
+                inci (p_hsmodExports exports)
+              breakpoint
+          txt "where"
+          newline
+      newline
+      -- The newline goes here rather than at the end of 'p_hsmodImport' so
+      -- that a comment trailing an import is emitted while the printer is
+      -- still on the import's line.
+      forM_ hsmodImports $ \x -> do
+        located' p_hsmodImport x
         newline
-    newline
-    forM_ hsmodImports (located' p_hsmodImport)
-    newline
-    switchLayout (getLocA <$> hsmodDecls) $ do
-      p_hsDecls Free hsmodDecls
       newline
-      spitRemainingComments
+      switchLayout (getLocA <$> hsmodDecls) $ do
+        p_hsDecls Free hsmodDecls
+        newline
+        spitRemainingComments
diff --git a/src/Ormolu/Printer/Meat/Pragma.hs b/src/Ormolu/Printer/Meat/Pragma.hs
--- a/src/Ormolu/Printer/Meat/Pragma.hs
+++ b/src/Ormolu/Printer/Meat/Pragma.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 
 -- | Pretty-printing of language pragmas.
 module Ormolu.Printer.Meat.Pragma
@@ -55,9 +56,15 @@
 p_pragmas ps = do
   let prepare = L.sortOn snd . L.nub . concatMap analyze
       analyze = \case
+        -- @{-# LANGUAGE A, B #-}@ becomes one pragma per extension, but the
+        -- comment written above it was written once. It goes to the first
+        -- extension only; giving it to each of them printed it as many
+        -- times as there were extensions.
         (cs, PragmaLanguage xs) ->
-          let f x = (cs, (Language (classifyLanguagePragma x), x))
-           in f <$> xs
+          let f x = (Language (classifyLanguagePragma x), x)
+           in case xs of
+                [] -> []
+                (y : ys) -> (cs, f y) : ((mempty,) . f <$> ys)
         (cs, PragmaOptionsGHC x) -> [(cs, (OptionsGHC, x))]
         (cs, PragmaOptionsHaddock x) -> [(cs, (OptionsHaddock, x))]
   forM_ (prepare ps) $ \(cs, (pragmaTy, x)) ->
@@ -66,7 +73,7 @@
 p_pragma :: [LComment] -> PragmaTy -> Text -> R ()
 p_pragma comments ty x = do
   forM_ comments $ \(L l comment) -> do
-    spitCommentNow l comment
+    spitCommentNow SlotPragma l comment
     newline
   txt "{-# "
   txt $ case ty of
diff --git a/src/Ormolu/Printer/Meat/Type.hs b/src/Ormolu/Printer/Meat/Type.hs
--- a/src/Ormolu/Printer/Meat/Type.hs
+++ b/src/Ormolu/Printer/Meat/Type.hs
@@ -10,18 +10,22 @@
   ( p_hsType,
     hasDocStrings,
     p_hsContext,
+    p_hsContext',
     p_hsTyVarBndr,
     ForAllVisibility (..),
     p_forallBndrs,
-    p_conDeclFields,
+    p_hsConDeclRecFields,
+    p_hsConDeclField,
+    p_hsConDeclFieldWithDoc,
     p_lhsTypeArg,
     p_hsSigType,
-    hsOuterTyVarBndrsToHsType,
+    p_hsForAllTelescope,
+    p_hsOuterTyVarBndrs,
     lhsTypeToSigType,
   )
 where
 
-import Data.Choice (pattern With)
+import Control.Monad
 import GHC.Data.Strict qualified as Strict
 import GHC.Hs hiding (isPromoted)
 import GHC.Types.SourceText
@@ -30,7 +34,8 @@
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree (p_tyOpTree, tyOpTree)
-import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsUntypedSplice, p_stringLit)
+import Ormolu.Printer.Meat.Declaration.StringLiteral
+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsUntypedSplice)
 import Ormolu.Printer.Operators
 import Ormolu.Utils
 
@@ -40,9 +45,7 @@
 p_hsType' :: Bool -> HsType GhcPs -> R ()
 p_hsType' multilineArgs = \case
   HsForAllTy _ tele t -> do
-    case tele of
-      HsForAllInvis _ bndrs -> p_forallBndrs ForAllInvis p_hsTyVarBndr bndrs
-      HsForAllVis _ bndrs -> p_forallBndrs ForAllVis p_hsTyVarBndr bndrs
+    p_hsForAllTelescope tele
     interArgBreak
     located t p_hsType
   HsQualTy _ qs t -> do
@@ -65,7 +68,7 @@
     p_rdrName n
   HsAppTy _ f x -> do
     let -- In order to format type applications with multiple parameters
-        -- nicer, traverse the AST to gather the function and all the
+        -- more nicely, traverse the AST to gather the function and all the
         -- parameters together.
         gatherArgs f' knownArgs =
           case f' of
@@ -86,20 +89,15 @@
     inci $ do
       txt "@"
       located kd p_hsType
-  HsFunTy _ arrow x y@(L _ y') -> do
+  HsFunTy _ multAnn x y -> do
     located x p_hsType
     space
-    case arrow of
-      HsUnrestrictedArrow _ -> txt "->"
-      HsLinearArrow _ -> txt "%1 ->"
-      HsExplicitMult _ mult -> do
-        txt "%"
-        p_hsTypeR (unLoc mult)
-        space
-        txt "->"
+    p_hsMultAnn (located' p_hsTypeR) multAnn
+    space
+    txt "->"
     interArgBreak
-    case y' of
-      HsFunTy {} -> p_hsTypeR y'
+    case unLoc y of
+      HsFunTy {} -> p_hsTypeR (unLoc y)
       _ -> located y p_hsTypeR
   HsListTy _ t ->
     located t (brackets N . p_hsType)
@@ -118,10 +116,8 @@
     let opTree = BinaryOpBranches (tyOpTree x) op (tyOpTree y)
     p_tyOpTree
       (reassociateOpTree debug (Just . unLoc) modFixityMap opTree)
-  HsParTy _ t -> do
-    csSpans <-
-      fmap (flip RealSrcSpan Strict.Nothing . getLoc) <$> getEnclosingComments
-    switchLayout (locA t : csSpans) $
+  HsParTy _ t ->
+    switchLayoutWithEnclosingComments [locA t] $
       parens N (located t p_hsType)
   HsIParamTy _ n t -> sitcc $ do
     located n atom
@@ -138,20 +134,8 @@
     inci (located k p_hsType)
   HsSpliceTy _ splice -> p_hsUntypedSplice DollarSplice splice
   HsDocTy _ t str -> do
-    p_hsDoc Pipe (With #endNewline) str
-    located t p_hsType
-  HsBangTy _ (HsSrcBang _ u s) t -> do
-    case u of
-      SrcUnpack -> txt "{-# UNPACK #-}" >> space
-      SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space
-      NoSrcUnpack -> return ()
-    case s of
-      SrcLazy -> txt "~"
-      SrcStrict -> txt "!"
-      NoSrcStrict -> return ()
+    p_hsDocInline Pipe str
     located t p_hsType
-  HsRecTy _ fields ->
-    p_conDeclFields fields
   HsExplicitListTy _ p xs -> do
     case p of
       IsPromoted -> txt "'"
@@ -163,11 +147,15 @@
         (IsPromoted, L _ t : _) | startsWithSingleQuote t -> space
         _ -> return ()
       sep commaDel (sitcc . located' p_hsType) xs
-  HsExplicitTupleTy _ xs -> do
-    txt "'"
+  HsExplicitTupleTy _ p xs -> do
+    case p of
+      IsPromoted -> txt "'"
+      NotPromoted -> return ()
     parens N $ do
-      case xs of
-        L _ t : _ | startsWithSingleQuote t -> space
+      -- If this tuple is promoted and the first element starts with a single
+      -- quote, we need to put a space in between or it fails to parse.
+      case (p, xs) of
+        (IsPromoted, L _ t : _) | startsWithSingleQuote t -> space
         _ -> return ()
       sep commaDel (located' p_hsType) xs
   HsTyLit _ t ->
@@ -175,7 +163,20 @@
       HsStrTy (SourceText s) _ -> p_stringLit s
       a -> atom a
   HsWildCardTy _ -> txt "_"
-  XHsType t -> atom t
+  XHsType ext -> case ext of
+    HsCoreTy t -> atom @HsCoreTy t
+    HsBangTy _ (HsSrcBang _ u s) t -> do
+      case u of
+        SrcUnpack -> txt "{-# UNPACK #-}" >> space
+        SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space
+        NoSrcUnpack -> return ()
+      case s of
+        SrcLazy -> txt "~"
+        SrcStrict -> txt "!"
+        NoSrcStrict -> return ()
+      located t p_hsType
+    HsRecTy _ fields ->
+      p_hsConDeclRecFields fields
   where
     startsWithSingleQuote = \case
       HsAppTy _ (L _ f) _ -> startsWithSingleQuote f
@@ -190,7 +191,7 @@
         else breakpoint
     p_hsTypeR = p_hsType' multilineArgs
 
--- | Return 'True' if at least one argument in 'HsType' has a doc string
+-- | Return 'True' if at least one argument in the 'HsType' has a doc string
 -- attached to it.
 hasDocStrings :: HsType GhcPs -> Bool
 hasDocStrings = \case
@@ -201,10 +202,13 @@
   _ -> False
 
 p_hsContext :: HsContext GhcPs -> R ()
-p_hsContext = \case
+p_hsContext = p_hsContext' p_hsType
+
+p_hsContext' :: (HasLoc (Anno a)) => (a -> R ()) -> [XRec GhcPs a] -> R ()
+p_hsContext' f = \case
   [] -> txt "()"
-  [x] -> located x p_hsType
-  xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs
+  [x] -> located x f
+  xs -> parens N $ sep commaDel (sitcc . located' f) xs
 
 class IsTyVarBndrFlag flag where
   isInferred :: flag -> Bool
@@ -226,18 +230,24 @@
     HsBndrInvisible _ -> txt "@"
 
 p_hsTyVarBndr :: (IsTyVarBndrFlag flag) => HsTyVarBndr flag GhcPs -> R ()
-p_hsTyVarBndr = \case
-  UserTyVar _ flag x -> do
-    p_tyVarBndrFlag flag
-    (if isInferred flag then braces N else id) $ p_rdrName x
-  KindedTyVar _ flag l k -> do
-    p_tyVarBndrFlag flag
-    (if isInferred flag then braces else parens) N $ do
-      located l atom
-      space
-      txt "::"
-      breakpoint
-      inci (located k p_hsType)
+p_hsTyVarBndr HsTvb {..} = do
+  p_tyVarBndrFlag tvb_flag
+  let wrap
+        | isInferred tvb_flag = braces N
+        | otherwise = case tvb_kind of
+            HsBndrKind {} -> parens N
+            HsBndrNoKind {} -> id
+  wrap $ do
+    case tvb_var of
+      HsBndrVar _ x -> p_rdrName x
+      HsBndrWildCard _ -> txt "_"
+    case tvb_kind of
+      HsBndrKind _ k -> do
+        space
+        txt "::"
+        breakpoint
+        inci (located k p_hsType)
+      HsBndrNoKind _ -> pure ()
 
 data ForAllVisibility = ForAllInvis | ForAllVis
 
@@ -260,48 +270,79 @@
         ForAllInvis -> txt "."
         ForAllVis -> space >> txt "->"
 
-p_conDeclFields :: [LConDeclField GhcPs] -> R ()
-p_conDeclFields xs =
-  braces N $ sep commaDel (sitcc . located' p_conDeclField) xs
+p_hsConDeclRecFields :: [LHsConDeclRecField GhcPs] -> R ()
+p_hsConDeclRecFields xs =
+  multiLineIfDocumented xs . braces N $ do
+    when (null xs) $
+      getEnclosingSpan >>= mapM_ (locatedEmpty . flip RealSrcSpan Strict.Nothing)
+    sep commaDel (sitcc . located' p_hsConDeclRecField) xs
 
-p_conDeclField :: ConDeclField GhcPs -> R ()
-p_conDeclField ConDeclField {..} = do
-  mapM_ (p_hsDoc Pipe (With #endNewline)) cd_fld_doc
+p_hsConDeclRecField :: HsConDeclRecField GhcPs -> R ()
+p_hsConDeclRecField HsConDeclRecField {..} = do
+  mapM_ (p_hsDocInline Pipe) (cdf_doc cdrf_spec)
   sitcc $
     sep
       commaDel
       (located' (p_rdrName . foLabel))
-      cd_fld_names
+      cdrf_names
   space
+  p_hsMultAnn (located' p_hsType) (cdf_multiplicity cdrf_spec)
+  space
   txt "::"
   breakpoint
-  sitcc . inci $ p_hsType (unLoc cd_fld_type)
+  sitcc . inci $ p_hsConDeclField cdrf_spec
 
+-- | This does not print 'cdf_doc' and 'cdf_multiplicity', as there is no
+-- single strategy for where to print them (see call sites).
+p_hsConDeclField :: HsConDeclField GhcPs -> R ()
+p_hsConDeclField CDF {..} = do
+  case cdf_unpack of
+    SrcUnpack -> txt "{-# UNPACK #-}" *> space
+    SrcNoUnpack -> txt "{-# NOUNPACK #-}" *> space
+    NoSrcUnpack -> pure ()
+  located cdf_type $ \ty -> do
+    case cdf_bang of
+      SrcLazy -> txt "~"
+      SrcStrict -> txt "!"
+      NoSrcStrict -> pure ()
+    p_hsType ty
+
+p_hsConDeclFieldWithDoc :: HsConDeclField GhcPs -> R ()
+p_hsConDeclFieldWithDoc cdf = do
+  mapM_ (p_hsDocInline Pipe) (cdf_doc cdf)
+  p_hsConDeclField cdf
+
 p_lhsTypeArg :: LHsTypeArg GhcPs -> R ()
 p_lhsTypeArg = \case
   HsValArg NoExtField ty -> located ty p_hsType
-  -- first argument is the SrcSpan of the @,
-  -- but the @ always has to be directly before the type argument
+  -- The first argument is the SrcSpan of the @, but the @ always has to be
+  -- directly before the type argument.
   HsTypeArg _ ty -> txt "@" *> located ty p_hsType
   -- NOTE(amesgen) is this unreachable or just not implemented?
   HsArgPar _ -> notImplemented "HsArgPar"
 
 p_hsSigType :: HsSigType GhcPs -> R ()
-p_hsSigType HsSig {..} =
-  p_hsType $ hsOuterTyVarBndrsToHsType sig_bndrs sig_body
+p_hsSigType HsSig {..} = do
+  p_hsOuterTyVarBndrs sig_bndrs
+  case sig_bndrs of
+    HsOuterImplicit {} -> pure ()
+    HsOuterExplicit {} -> breakpoint
+  located sig_body p_hsType
 
-----------------------------------------------------------------------------
--- Conversion functions
+p_hsForAllTelescope :: HsForAllTelescope GhcPs -> R ()
+p_hsForAllTelescope = \case
+  HsForAllInvis _ bndrs -> p_forallBndrs ForAllInvis p_hsTyVarBndr bndrs
+  HsForAllVis _ bndrs -> p_forallBndrs ForAllVis p_hsTyVarBndr bndrs
 
--- could be generalized to also handle () instead of Specificity
-hsOuterTyVarBndrsToHsType ::
+p_hsOuterTyVarBndrs ::
   HsOuterTyVarBndrs Specificity GhcPs ->
-  LHsType GhcPs ->
-  HsType GhcPs
-hsOuterTyVarBndrsToHsType obndrs ty = case obndrs of
-  HsOuterImplicit NoExtField -> unLoc ty
-  HsOuterExplicit _ bndrs ->
-    HsForAllTy NoExtField (mkHsForAllInvisTele noAnn bndrs) ty
+  R ()
+p_hsOuterTyVarBndrs = \case
+  HsOuterImplicit _ -> pure ()
+  HsOuterExplicit _ bndrs -> p_hsForAllTelescope $ mkHsForAllInvisTele noAnn bndrs
+
+----------------------------------------------------------------------------
+-- Conversion functions
 
 lhsTypeToSigType :: LHsType GhcPs -> LHsSigType GhcPs
 lhsTypeToSigType ty =
diff --git a/src/Ormolu/Printer/Operators.hs b/src/Ormolu/Printer/Operators.hs
--- a/src/Ormolu/Printer/Operators.hs
+++ b/src/Ormolu/Printer/Operators.hs
@@ -24,8 +24,8 @@
 import Ormolu.Utils
 
 -- | Intermediate representation of operator trees, where a branching is not
--- just a binary branching (with a left node, right node, and operator like
--- in the GHC's AST), but rather a n-ary branching, with n + 1 nodes and n
+-- just a binary branching (with a left node, a right node, and an operator,
+-- as in the GHC AST), but rather an n-ary branching, with n + 1 nodes and n
 -- operators (n >= 1).
 --
 -- This representation allows us to put all the operators with the same
@@ -49,7 +49,7 @@
   { -- | The actual operator
     opiOp :: op,
     -- | Its name, if available. We use 'Maybe RdrName' here instead of
-    -- 'RdrName' because the name-fetching function received by
+    -- 'RdrName' because the name-fetching function passed to
     -- 'reassociateOpTree' returns a 'Maybe'
     opiName :: Maybe RdrName,
     -- | Information about the fixity direction and precedence level of the
@@ -83,13 +83,14 @@
         (Just n1, Just n2) -> n1 == n2
         _ -> False
 
--- | Return combined 'SrcSpan's of all elements in this 'OpTree'.
+-- | Return the combined 'SrcSpan's of all elements in this 'OpTree'.
 opTreeLoc :: (HasLoc l) => OpTree (GenLocated l a) b -> SrcSpan
 opTreeLoc (OpNode n) = getHasLoc n
 opTreeLoc (OpBranches exprs _) =
   combineSrcSpans' . fmap opTreeLoc $ exprs
 
--- | Re-associate an 'OpTree' taking into account precedence of operators.
+-- | Re-associate an 'OpTree' taking into account the precedence of
+-- operators.
 -- Users are expected to first construct an initial 'OpTree', then
 -- re-associate it using this function before printing.
 reassociateOpTree ::
@@ -134,7 +135,7 @@
           Nothing -> defaultFixityApproximation
           Just rdrName -> inferFixity debug rdrName modFixityMap
 
--- | Given a 'OpTree' of any shape, produce a flat 'OpTree', where every
+-- | Given an 'OpTree' of any shape, produce a flat 'OpTree' where every
 -- node and operator is directly connected to the root.
 makeFlatOpTree :: OpTree ty op -> OpTree ty op
 makeFlatOpTree (OpNode n) = OpNode n
@@ -151,9 +152,9 @@
     interleave [] ys = ys
     interleave xs [] = xs
 
--- | Starting from a flat 'OpTree' (i.e. a n-ary tree of depth 1,
--- without regard for operator fixities), build an 'OpTree' with proper
--- sub-trees (according to the fixity info carried by the nodes).
+-- | Starting from a flat 'OpTree' (i.e. an n-ary tree of depth 1, without
+-- regard for operator fixities), build an 'OpTree' with proper sub-trees
+-- (according to the fixity info carried by the nodes).
 --
 -- We have two complementary ways to build the proper sub-trees:
 --
@@ -182,12 +183,11 @@
 --   will become
 --     [[ex0 op0 ex1 op1 ex2] op2 ex3 op3 [ex4 op4 ex5] op5 ex6 op6 ex7]
 --
--- We will also recursively apply the same logic on every sub-tree built
--- during the process. The two principles are not overlapping and thus are
--- required, because we are comparing precedence level ranges. In the case
--- where we can't find a non-empty set {min,max}Ops with one logic or the
--- other, we finally try to split the tree on “hard splitters” if there is
--- any.
+-- We also recursively apply the same logic to every sub-tree built during
+-- the process. The two principles do not overlap, and both are required,
+-- because we are comparing precedence level ranges. In the case where we
+-- cannot find a non-empty set {min,max}Ops with one approach or the other,
+-- we finally try to split the tree on “hard splitters”, if there are any.
 reassociateFlatOpTree ::
   -- | Flat 'OpTree', with fixity info wrapped around each operator
   OpTree ty (OpInfo op) ->
@@ -203,9 +203,9 @@
       indices -> splitTree noptExprs noptOps indices
   where
     indicesOfHardSplitter =
-      fmap fst $
-        filter (isHardSplitterOp . opiFixityApproximation . snd) $
-          zip [0 ..] noptOps
+      fmap fst
+        $ filter (isHardSplitterOp . opiFixityApproximation . snd)
+        $ zip [0 ..] noptOps
     indexOfMinMaxPrecOps [] = (Nothing, Nothing)
     indexOfMinMaxPrecOps (oo : oos) = go oos 1 oo (Just [0]) oo (Just [0])
       where
@@ -276,10 +276,10 @@
           OpTree ty (OpInfo op)
         go [] _ _ _ subExprs subOps resExprs resOps =
           -- No expr left to process.
-          -- because we are in a "splitting" logic, there is at least one
+          -- Because we are in a "splitting" logic, there is at least one
           -- expr in the subExprs bag, so we build a subtree (if necessary)
-          -- with sub-bags, add the node/subtree to the result bag, and then
-          -- emit the result tree
+          -- from the sub-bags, add the node/subtree to the result bag, and
+          -- then emit the result tree.
           let resExpr = buildFromSub (NE.fromList subExprs) subOps
            in OpBranches (NE.reverse (resExpr :| resExprs)) (reverse resOps)
         go (x : xs) (o : os) (idx : idxs) i subExprs subOps resExprs resOps
@@ -287,13 +287,13 @@
               -- The op we are looking at is one on which we need to split.
               -- So we build a subtree from the sub-bags and the current
               -- expr, append it to the result exprs, and continue with
-              -- cleared sub-bags
+              -- cleared sub-bags.
               let resExpr = buildFromSub (x :| subExprs) subOps
                in go xs os idxs (i + 1) [] [] (resExpr : resExprs) (o : resOps)
         go (x : xs) ops idxs i subExprs subOps resExprs resOps =
           -- Either there is no op left, or the op we are looking at is not
           -- one on which we need to split. So we just add both the current
-          -- expr and current op (if there is any) to the sub-bags
+          -- expr and the current op (if there is any) to the sub-bags.
           let (ops', subOps') = moveOneIfPossible ops subOps
            in go xs ops' idxs (i + 1) (x : subExprs) subOps' resExprs resOps
 
@@ -324,11 +324,11 @@
           -- result tree
           OpTree ty (OpInfo op)
         go [] _ _ _ subExprs subOps resExprs resOps =
-          -- no expr left to process
-          -- because we are in a "grouping" logic, the subExprs bag might be
-          -- empty. If it is not, we build a subtree (if necessary) with
+          -- No expr left to process.
+          -- Because we are in a "grouping" logic, the subExprs bag might be
+          -- empty. If it is not, we build a subtree (if necessary) from the
           -- sub-bags and add the resulting node/subtree to the result bag.
-          -- In any case, we then emit the result tree
+          -- In any case, we then emit the result tree.
           let resExprs' = case NE.nonEmpty subExprs of
                 Nothing -> NE.fromList resExprs
                 Just subExprs' -> buildFromSub subExprs' subOps :| resExprs
@@ -350,8 +350,8 @@
         go (x : xs) ops idxs i [] subOps resExprs resOps =
           -- Either there is no op left, or the op we are looking at is not
           -- one on which we need to split, but the sub-bags are empty. So
-          -- we just add both the current expr and current op (if there is
-          -- any) to the result bags
+          -- we just add both the current expr and the current op (if there
+          -- is any) to the result bags.
           let (ops', resOps') = moveOneIfPossible ops resOps
            in go xs ops' idxs (i + 1) [] subOps (x : resExprs) resOps'
 
@@ -364,9 +364,9 @@
       x :| [] -> x
       _ -> OpBranches (NE.reverse subExprs) (reverse subOps)
 
--- | Indicate if an operator has @'InfixR' 0@ fixity. We special-case this
--- class of operators because they often have, like ('$'), a specific
--- “separator” use-case, and we sometimes format them differently than other
+-- | Indicate whether an operator has @'InfixR' 0@ fixity. We special-case
+-- this class of operators because, like ('$'), they often have a specific
+-- “separator” use case, and we sometimes format them differently from other
 -- operators.
 isHardSplitterOp :: FixityApproximation -> Bool
 isHardSplitterOp = (== FixityApproximation (Just InfixR) 0 0)
diff --git a/src/Ormolu/Printer/SpanStream.hs b/src/Ormolu/Printer/SpanStream.hs
deleted file mode 100644
--- a/src/Ormolu/Printer/SpanStream.hs
+++ /dev/null
@@ -1,49 +0,0 @@
--- | Build span stream from AST.
-module Ormolu.Printer.SpanStream
-  ( SpanStream (..),
-    mkSpanStream,
-  )
-where
-
-import Data.Data (Data)
-import Data.Foldable (toList)
-import Data.Generics (everything, ext1Q, ext2Q)
-import Data.List (sortOn)
-import Data.Maybe (maybeToList)
-import Data.Sequence (Seq)
-import Data.Sequence qualified as Seq
-import Data.Typeable (cast)
-import GHC.Parser.Annotation
-import GHC.Types.SrcLoc
-
--- | A stream of 'RealSrcSpan's in ascending order. This allows us to tell
--- e.g. whether there is another \"located\" element of AST between current
--- element and comment we're considering for printing.
-newtype SpanStream = SpanStream [RealSrcSpan]
-  deriving (Eq, Show, Data, Semigroup, Monoid)
-
--- | Create 'SpanStream' from a data structure containing \"located\"
--- elements.
-mkSpanStream ::
-  (Data a) =>
-  -- | Data structure to inspect (AST)
-  a ->
-  SpanStream
-mkSpanStream a =
-  SpanStream
-    . sortOn realSrcSpanStart
-    . toList
-    $ everything mappend (const mempty `ext2Q` queryLocated `ext1Q` queryEpAnn) a
-  where
-    queryLocated ::
-      (Data e0) =>
-      GenLocated e0 e1 ->
-      Seq RealSrcSpan
-    queryLocated (L mspn _) =
-      maybe mempty srcSpanToRealSrcSpanSeq (cast mspn :: Maybe SrcSpan)
-
-    queryEpAnn :: EpAnn ann -> Seq RealSrcSpan
-    queryEpAnn = srcSpanToRealSrcSpanSeq . locA
-
-    srcSpanToRealSrcSpanSeq =
-      Seq.fromList . maybeToList . srcSpanToRealSrcSpan
diff --git a/src/Ormolu/Processing/Common.hs b/src/Ormolu/Processing/Common.hs
--- a/src/Ormolu/Processing/Common.hs
+++ b/src/Ormolu/Processing/Common.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 
--- | Common definitions for pre- and post- processing.
+-- | Common definitions for pre- and post-processing.
 module Ormolu.Processing.Common
   ( removeIndentation,
     reindent,
@@ -40,7 +40,7 @@
     (_, nonPrefix) = splitAt regionPrefixLength ls
     middle = take (length nonPrefix - regionSuffixLength) nonPrefix
 
--- | Convert a set of line indices into disjoint 'RegionDelta's
+-- | Convert a set of line indices into disjoint 'RegionDeltas'.
 intSetToRegions ::
   -- | Total number of lines
   Int ->
diff --git a/src/Ormolu/Processing/Preprocess.hs b/src/Ormolu/Processing/Preprocess.hs
--- a/src/Ormolu/Processing/Preprocess.hs
+++ b/src/Ormolu/Processing/Preprocess.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -12,6 +13,8 @@
 import Data.Array as A
 import Data.Bifunctor (bimap)
 import Data.Char (isSpace)
+import Data.Choice (Choice)
+import Data.Choice qualified as Choice
 import Data.Function ((&))
 import Data.IntMap (IntMap)
 import Data.IntMap.Strict qualified as IntMap
@@ -29,13 +32,14 @@
 -- and subregions to be formatted.
 preprocess ::
   -- | Whether CPP is enabled
-  Bool ->
+  Choice "cppEnabled" ->
   RegionDeltas ->
   Text ->
   [Either Text RegionDeltas]
 preprocess cppEnabled region rawInput = rawSnippetsAndRegionsToFormat
   where
-    (linesNotToFormat', replacementLines) = linesNotToFormat cppEnabled region rawInput
+    (linesNotToFormat', replacementLines) =
+      linesNotToFormat cppEnabled region rawInput
     regionsToFormat =
       intSetToRegions rawLineLength $
         IntSet.fromAscList [1 .. rawLineLength] IntSet.\\ linesNotToFormat'
@@ -57,8 +61,8 @@
         & dropWhile isBlankRawSnippet
         & L.dropWhileEnd isBlankRawSnippet
     -- For every formattable region, we want to ensure that it is separated by
-    -- a blank line from preceding/succeeding raw snippets if it starts/ends
-    -- with a blank line.
+    -- a blank line from the preceding/succeeding raw snippets if it
+    -- starts/ends with a blank line.
     -- Empty formattable regions are replaced by a blank line instead.
     -- Extraneous raw snippets at the start/end are dropped afterwards.
     patchSeparatingBlankLines = \case
@@ -85,13 +89,13 @@
     interleave [] bs = bs
     interleave (a : as) bs = a : interleave bs as
 
-    xs !!? i = if A.bounds rawLines `A.inRange` i then Just $ xs A.! i else Nothing
+    xs !!? i = if A.bounds xs `A.inRange` i then Just $ xs A.! i else Nothing
 
 -- | All lines we are not supposed to format, and a set of replacements
 -- for specific lines.
 linesNotToFormat ::
   -- | Whether CPP is enabled
-  Bool ->
+  Choice "cppEnabled" ->
   RegionDeltas ->
   Text ->
   (IntSet, IntMap Text)
@@ -100,13 +104,16 @@
   where
     unconsidered =
       IntSet.fromAscList $
-        [1 .. regionPrefixLength] <> [totalLines - regionSuffixLength + 1 .. totalLines]
+        [1 .. regionPrefixLength]
+          <> [totalLines - regionSuffixLength + 1 .. totalLines]
     totalLines = length (T.lines input)
     regionLines = linesInRegion region input
     (magicDisabled, lineUpdates) = magicDisabledLines regionLines
     otherDisabled = mconcat allLines regionLines
       where
-        allLines = [shebangLines, linePragmaLines] <> [cppLines | cppEnabled]
+        allLines =
+          [shebangLines, linePragmaLines]
+            <> [cppLines | Choice.isTrue cppEnabled]
 
 -- | Ormolu state.
 data OrmoluState
@@ -158,11 +165,11 @@
 ormoluDisable :: Text
 ormoluDisable = "ORMOLU_DISABLE"
 
--- | Creates a magic comment with the given inner text.
+-- | Create a magic comment with the given inner text.
 magicComment :: Text -> Text
 magicComment t = "{- " <> t <> " -}"
 
--- | Construct a function for whitespace-insensitive matching of string.
+-- | Construct a function for whitespace-insensitive matching of a string.
 isMagicComment ::
   -- | What to expect
   Text ->
diff --git a/src/Ormolu/Terminal.hs b/src/Ormolu/Terminal.hs
--- a/src/Ormolu/Terminal.hs
+++ b/src/Ormolu/Terminal.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
--- | An abstraction for colorful output in terminal.
+-- | An abstraction for colorful output in the terminal.
 module Ormolu.Terminal
   ( -- * The 'Term' abstraction
     Term,
@@ -56,7 +56,7 @@
 data ColorMode = Never | Always | Auto
   deriving (Eq, Show)
 
--- | Run 'Term' monad.
+-- | Run the 'Term' monad.
 runTerm ::
   Term ->
   -- | Color mode
diff --git a/src/Ormolu/Utils.hs b/src/Ormolu/Utils.hs
--- a/src/Ormolu/Utils.hs
+++ b/src/Ormolu/Utils.hs
@@ -8,17 +8,19 @@
     combineSrcSpans',
     notImplemented,
     showOutputable,
+    containsHaddocks,
     splitDocString,
     incSpanLine,
     separatedByBlank,
     separatedByBlankNE,
     onTheSameLine,
-    matchAddEpAnn,
     textToStringBuffer,
     ghcModuleNameToCabal,
   )
 where
 
+import Data.Data (Data)
+import Data.Generics.Schemes (listify)
 import Data.List (dropWhileEnd)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
@@ -48,7 +50,7 @@
   | LastPos
   deriving (Eq, Show)
 
--- | Attach 'RelativePos'es to elements of a given list.
+-- | Attach 'RelativePos'es to the elements of the given list.
 attachRelativePos :: [a] -> [(RelativePos, a)]
 attachRelativePos = \case
   [] -> []
@@ -67,10 +69,20 @@
 notImplemented :: String -> a
 notImplemented msg = error $ "not implemented yet: " ++ msg
 
--- | Pretty-print an 'GHC.Outputable' thing.
+-- | Pretty-print a 'GHC.Outputable' thing.
 showOutputable :: (Outputable o) => o -> String
 showOutputable = showSDoc baseDynFlags . ppr
 
+-- | Does this fragment of the syntax tree carry a Haddock anywhere inside
+-- it?
+--
+-- Unlike the span of a Haddock, which sits wherever the author wrote it,
+-- this answers the question the printer actually has: will rendering this
+-- fragment emit documentation?
+containsHaddocks :: (Data a) => a -> Bool
+containsHaddocks =
+  not . null . listify (const True :: HsDocString -> Bool)
+
 -- | Split and normalize a doc string. The result is a list of lines that
 -- make up the comment.
 splitDocString :: HsDocString -> [Text]
@@ -86,8 +98,8 @@
         . fmap (T.stripEnd . T.pack)
         . lines
         $ renderHsDocString docStr
-    -- We cannot have the first character to be a dollar because in that
-    -- case it'll be a parse error (apparently collides with named docs
+    -- We cannot let the first character be a dollar, because in that case
+    -- it would be a parse error (apparently it collides with the named docs
     -- syntax @-- $name@ somehow).
     escapeLeadingDollar txt =
       case T.uncons txt of
@@ -108,7 +120,7 @@
                 then dropSpace <$> xs
                 else xs
 
--- | Increment line number in a 'SrcSpan'.
+-- | Increment the line number in a 'SrcSpan'.
 incSpanLine :: Int -> SrcSpan -> SrcSpan
 incSpanLine i = \case
   RealSrcSpan s _ ->
@@ -134,25 +146,19 @@
 separatedByBlankNE :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool
 separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b)
 
--- | Return 'True' if one span ends on the same line the second one starts.
+-- | Return 'True' if one span ends on the same line where the second one
+-- starts.
 onTheSameLine :: SrcSpan -> SrcSpan -> Bool
 onTheSameLine a b =
   isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))
 
--- | Check whether the given 'AnnKeywordId' or its Unicode variant is in an
--- 'AddEpAnn', and return the 'EpaLocation' if so.
-matchAddEpAnn :: AnnKeywordId -> AddEpAnn -> Maybe EpaLocation
-matchAddEpAnn annId (AddEpAnn annId' loc)
-  | annId == annId' || unicodeAnn annId == annId' = Just loc
-  | otherwise = Nothing
-
 -- | Convert 'Text' to a 'StringBuffer' by making a copy.
 textToStringBuffer :: Text -> StringBuffer
 textToStringBuffer txt = unsafePerformIO $ do
   buf <- mallocPlainForeignPtrBytes (len + 3)
   withForeignPtr buf $ \ptr -> do
     TFFI.unsafeCopyToPtr txt ptr
-    -- last three bytes have to be zero for easier decoding
+    -- The last three bytes have to be zero for easier decoding.
     pokeElemOff ptr len 0
     pokeElemOff ptr (len + 1) 0
     pokeElemOff ptr (len + 2) 0
diff --git a/src/Ormolu/Utils/Cabal.hs b/src/Ormolu/Utils/Cabal.hs
--- a/src/Ormolu/Utils/Cabal.hs
+++ b/src/Ormolu/Utils/Cabal.hs
@@ -14,7 +14,6 @@
 import Control.Exception
 import Control.Monad.IO.Class
 import Data.ByteString qualified as B
-import Data.IORef
 import Data.Map.Lazy (Map)
 import Data.Map.Lazy qualified as M
 import Data.Maybe (maybeToList)
@@ -29,7 +28,7 @@
 import Ormolu.Config
 import Ormolu.Exception
 import Ormolu.Fixity
-import Ormolu.Utils.IO (findClosestFileSatisfying, withIORefCache)
+import Ormolu.Utils.IO (Cache, findClosestFileSatisfying, newCache, withCache)
 import System.Directory
 import System.FilePath
 import System.IO.Unsafe (unsafePerformIO)
@@ -101,8 +100,8 @@
   deriving (Show)
 
 -- | Cache ref that stores 'CachedCabalFile' per Cabal file.
-cacheRef :: IORef (Map FilePath CachedCabalFile)
-cacheRef = unsafePerformIO $ newIORef M.empty
+cacheRef :: Cache FilePath CachedCabalFile
+cacheRef = unsafePerformIO newCache
 {-# NOINLINE cacheRef #-}
 
 -- | Parse 'CabalInfo' from a @.cabal@ file at the given 'FilePath'.
@@ -118,7 +117,7 @@
 parseCabalInfo cabalFileAsGiven sourceFileAsGiven = liftIO $ do
   cabalFile <- makeAbsolute cabalFileAsGiven
   sourceFileAbs <- makeAbsolute sourceFileAsGiven
-  CachedCabalFile {..} <- withIORefCache cacheRef cabalFile $ do
+  CachedCabalFile {..} <- withCache cacheRef cabalFile $ do
     cabalFileBs <- B.readFile cabalFile
     genericPackageDescription <-
       whenLeft (snd . runParseResult $ parseGenericPackageDescription cabalFileBs) $
@@ -190,17 +189,17 @@
     extractFromLibrary Library {..} =
       extractFromBuildInfo (ModuleName.toFilePath <$> exposedModules) libBuildInfo
     extractFromExecutable Executable {..} =
-      extractFromBuildInfo [modulePath] buildInfo
+      extractFromBuildInfo [getSymbolicPath modulePath] buildInfo
     extractFromTestSuite TestSuite {..} =
       extractFromBuildInfo mainPath testBuildInfo
       where
         mainPath = case testInterface of
-          TestSuiteExeV10 _ p -> [p]
+          TestSuiteExeV10 _ p -> [getSymbolicPath p]
           TestSuiteLibV09 _ p -> [ModuleName.toFilePath p]
           TestSuiteUnsupported {} -> []
     extractFromBenchmark Benchmark {..} =
       extractFromBuildInfo mainPath benchmarkBuildInfo
       where
         mainPath = case benchmarkInterface of
-          BenchmarkExeV10 _ p -> [p]
+          BenchmarkExeV10 _ p -> [getSymbolicPath p]
           BenchmarkUnsupported {} -> []
diff --git a/src/Ormolu/Utils/Fixity.hs b/src/Ormolu/Utils/Fixity.hs
--- a/src/Ormolu/Utils/Fixity.hs
+++ b/src/Ormolu/Utils/Fixity.hs
@@ -10,10 +10,7 @@
 import Control.Exception (throwIO)
 import Control.Monad.IO.Class
 import Data.Bifunctor (first)
-import Data.IORef
 import Data.List.NonEmpty (NonEmpty)
-import Data.Map.Strict (Map)
-import Data.Map.Strict qualified as Map
 import Data.Text qualified as T
 import Data.Text.IO.Utf8 qualified as T.Utf8
 import Distribution.ModuleName (ModuleName)
@@ -21,15 +18,15 @@
 import Ormolu.Exception
 import Ormolu.Fixity
 import Ormolu.Fixity.Parser
-import Ormolu.Utils.IO (findClosestFileSatisfying, withIORefCache)
+import Ormolu.Utils.IO (Cache, findClosestFileSatisfying, newCache, withCache)
 import System.Directory
 import System.IO.Unsafe (unsafePerformIO)
 import Text.Megaparsec (errorBundlePretty)
 
 -- | Attempt to locate and parse an @.ormolu@ file. If it does not exist,
--- default fixity map and module reexports are returned. This function
--- maintains a cache of fixity overrides and module re-exports where cabal
--- file paths act as keys.
+-- the default fixity map and module re-exports are returned. This function
+-- maintains a cache of fixity overrides and module re-exports keyed by
+-- @.ormolu@ file path.
 getDotOrmoluForSourceFile ::
   (MonadIO m) =>
   -- | 'CabalInfo' already obtained for this source file
@@ -37,7 +34,7 @@
   m (FixityOverrides, ModuleReexports)
 getDotOrmoluForSourceFile sourceFile =
   liftIO (findDotOrmoluFile sourceFile) >>= \case
-    Just dotOrmoluFile -> liftIO $ withIORefCache cacheRef dotOrmoluFile $ do
+    Just dotOrmoluFile -> liftIO $ withCache cacheRef dotOrmoluFile $ do
       dotOrmoluRelative <- makeRelativeToCurrentDirectory dotOrmoluFile
       contents <- T.Utf8.readFile dotOrmoluFile
       case parseDotOrmolu dotOrmoluRelative contents of
@@ -58,8 +55,8 @@
   x == ".ormolu"
 
 -- | Cache ref that maps names of @.ormolu@ files to their contents.
-cacheRef :: IORef (Map FilePath (FixityOverrides, ModuleReexports))
-cacheRef = unsafePerformIO (newIORef Map.empty)
+cacheRef :: Cache FilePath (FixityOverrides, ModuleReexports)
+cacheRef = unsafePerformIO newCache
 {-# NOINLINE cacheRef #-}
 
 -- | A wrapper around 'parseFixityDeclaration' for parsing individual fixity
@@ -72,8 +69,8 @@
 parseFixityDeclarationStr =
   first errorBundlePretty . parseFixityDeclaration . T.pack
 
--- | A wrapper around 'parseModuleReexportDeclaration' for parsing
--- a individual module reexport.
+-- | A wrapper around 'parseModuleReexportDeclaration' for parsing an
+-- individual module re-export.
 parseModuleReexportDeclarationStr ::
   -- | Input to parse
   String ->
diff --git a/src/Ormolu/Utils/IO.hs b/src/Ormolu/Utils/IO.hs
--- a/src/Ormolu/Utils/IO.hs
+++ b/src/Ormolu/Utils/IO.hs
@@ -3,7 +3,9 @@
 
 module Ormolu.Utils.IO
   ( findClosestFileSatisfying,
-    withIORefCache,
+    Cache,
+    newCache,
+    withCache,
   )
 where
 
@@ -14,7 +16,7 @@
 import Data.Map.Lazy qualified as M
 import System.Directory
 import System.FilePath
-import System.IO.Error (isDoesNotExistError)
+import System.IO.Error (isDoesNotExistError, isPermissionError)
 
 -- | Find the path to the closest file higher in the file hierarchy that
 -- satisfies a given predicate.
@@ -28,34 +30,52 @@
   m (Maybe FilePath)
 findClosestFileSatisfying isRightFile rootOfSearch = liftIO $ do
   parentDir <- takeDirectory <$> makeAbsolute rootOfSearch
-  dirEntries <-
-    listDirectory parentDir `catch` \case
-      (isDoesNotExistError -> True) -> pure []
+  maybeDirEntries <-
+    (Just <$> listDirectory parentDir) `catch` \case
+      -- The directory does not exist. This is expected: the search may start
+      -- from a path that does not exist yet (e.g. a file about to be created),
+      -- whose absolute form still lies below existing parent directories.
+      -- Treat it as empty and keep searching upwards.
+      (isDoesNotExistError -> True) -> pure (Just [])
+      -- We lack the permissions to read the directory, e.g. when running in a
+      -- sandbox that restricts access to parent directories. Abort the search:
+      -- we almost certainly cannot read any parent directory either.
+      (isPermissionError -> True) -> pure Nothing
       e -> throwIO e
-  let searchAtParentDirLevel = \case
-        [] -> pure Nothing
-        x : xs ->
-          if isRightFile x
-            then
-              doesFileExist (parentDir </> x) >>= \case
-                True -> pure (Just x)
-                False -> searchAtParentDirLevel xs
-            else searchAtParentDirLevel xs
-  searchAtParentDirLevel dirEntries >>= \case
-    Just foundFile -> pure . Just $ parentDir </> foundFile
-    Nothing ->
-      if isDrive parentDir
-        then pure Nothing
-        else findClosestFileSatisfying isRightFile parentDir
+  case maybeDirEntries of
+    Nothing -> pure Nothing
+    Just entries -> do
+      let searchAtParentDirLevel = \case
+            [] -> pure Nothing
+            x : xs ->
+              if isRightFile x
+                then
+                  doesFileExist (parentDir </> x) >>= \case
+                    True -> pure (Just x)
+                    False -> searchAtParentDirLevel xs
+                else searchAtParentDirLevel xs
+      searchAtParentDirLevel entries >>= \case
+        Just foundFile -> pure . Just $ parentDir </> foundFile
+        Nothing ->
+          if isDrive parentDir
+            then pure Nothing
+            else findClosestFileSatisfying isRightFile parentDir
 
+newtype Cache k v = Cache (IORef (Map k v))
+
+newCache :: (Ord k) => IO (Cache k v)
+newCache = do
+  var <- newIORef mempty
+  pure (Cache var)
+
 -- | Execute an 'IO' action but only if the given key is not found in the
--- 'IORef' cache.
-withIORefCache :: (Ord k) => IORef (Map k v) -> k -> IO v -> IO v
-withIORefCache cacheRef k action = do
-  cache <- readIORef cacheRef
+-- cache.
+withCache :: (Ord k) => Cache k v -> k -> IO v -> IO v
+withCache (Cache cacheVar) k action = do
+  cache <- readIORef cacheVar
   case M.lookup k cache of
     Just v -> pure v
     Nothing -> do
       v <- action
-      modifyIORef' cacheRef (M.insert k v)
+      atomicModifyIORef cacheVar ((,()) . M.insert k v)
       pure v
diff --git a/tests/Ormolu/CabalInfoSpec.hs b/tests/Ormolu/CabalInfoSpec.hs
--- a/tests/Ormolu/CabalInfoSpec.hs
+++ b/tests/Ormolu/CabalInfoSpec.hs
@@ -36,7 +36,7 @@
       mentioned `shouldBe` True
       unPackageName ciPackageName `shouldBe` "ormolu"
       ciDynOpts `shouldBe` [DynOption "-XGHC2021"]
-      Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "MemoTrie", "ansi-terminal", "array", "base", "binary", "bytestring", "choice", "containers", "deepseq", "directory", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "text"]
+      Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "MemoTrie", "ansi-terminal", "array", "base", "binary", "bytestring", "choice", "containers", "directory", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "text"]
       ciCabalFilePath `shouldSatisfy` isAbsolute
       makeRelativeToCurrentDirectory ciCabalFilePath `shouldReturn` "ormolu.cabal"
     it "extracts correct cabal info from ormolu.cabal for tests/Ormolu/PrinterSpec.hs" $ do
diff --git a/tests/Ormolu/Comments/AnchorSpec.hs b/tests/Ormolu/Comments/AnchorSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Ormolu/Comments/AnchorSpec.hs
@@ -0,0 +1,140 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Tests for the containment tree and the positional attachment rules.
+module Ormolu.Comments.AnchorSpec (spec) where
+
+import Data.List.NonEmpty (NonEmpty (..))
+import GHC.Data.FastString (fsLit)
+import GHC.Types.SrcLoc
+import Ormolu.Comments.Anchor
+import Ormolu.Comments.Tree
+import Ormolu.Parser.CommentStream
+import Test.Hspec
+
+spec :: Spec
+spec = do
+  describe "mkSpanForest" $ do
+    it "nests spans by containment" $
+      mkSpanForest [spn 1 1 9 9, spn 2 1 3 9, spn 2 3 2 8]
+        `shouldBe` [ SpanTree
+                       (spn 1 1 9 9)
+                       [SpanTree (spn 2 1 3 9) [SpanTree (spn 2 3 2 8) []]]
+                   ]
+    it "keeps siblings in ascending order" $
+      fmap stSpan (mkSpanForest [spn 5 1 5 9, spn 1 1 1 9, spn 3 1 3 9])
+        `shouldBe` [spn 1 1 1 9, spn 3 1 3 9, spn 5 1 5 9]
+    it "treats a repeated span as one element" $
+      -- Several AST nodes routinely share a span; the comment can only be
+      -- owned once.
+      countNodes (mkSpanForest [spn 1 1 9 9, spn 1 1 9 9, spn 1 1 9 9])
+        `shouldBe` 1
+    it "drops spans that overlap without being contained" $
+      countNodes (mkSpanForest [spn 1 1 5 9, spn 3 1 7 9]) `shouldBe` 1
+    it "keeps zero-width spans" $
+      -- The printer enters a zero-width span at each end of an empty list,
+      -- deliberately, so that a comment written inside the brackets has
+      -- something to attach to.
+      mkSpanForest [spn 1 1 1 1, spn 2 1 2 9]
+        `shouldBe` [SpanTree (spn 1 1 1 1) [], SpanTree (spn 2 1 2 9) []]
+
+  describe "anchorFor" $ do
+    let forest = mkSpanForest [block, stmt1, stmt2]
+        block = spn 1 1 5 10
+        stmt1 = spn 2 3 2 9
+        stmt2 = spn 4 3 4 9
+
+    it "puts a comment between two elements before the later one" $
+      anchorFor forest (ownLine 3 3 3 12) `shouldBe` AnchorBefore stmt2
+    it "attaches a comment that trails code to the element it trails" $
+      anchorFor forest (trailing 2 12 2 20) `shouldBe` AnchorTrailing stmt1
+    it "does not treat a comment as trailing when no code precedes it" $
+      -- Same line as the end of stmt1, but alone on its line, so it belongs
+      -- to what comes after.
+      anchorFor forest (ownLine 2 12 2 20) `shouldBe` AnchorBefore stmt2
+    it "attaches a comment after the last element to that element" $
+      anchorFor forest (ownLine 5 3 5 9) `shouldBe` AnchorTrailing stmt2
+    it "gives a comment inside a childless element to that element" $
+      anchorFor (mkSpanForest [spn 1 1 3 3]) (ownLine 2 3 2 9)
+        `shouldBe` AnchorInside (spn 1 1 3 3)
+    it "leaves a comment outside everything to the module" $
+      -- Not trailing the last top-level element: there is nothing it could
+      -- trail without being rendered before syntax that preceded it.
+      anchorFor forest (ownLine 9 1 9 9) `shouldBe` AnchorModule
+    it "leaves a comment to the module when there are no elements at all" $
+      anchorFor [] (ownLine 1 1 1 9) `shouldBe` AnchorModule
+
+    -- @f x = -- c@ re-parsed: the comment now falls inside the right-hand
+    -- side, which opened on that line and has nothing of its own before the
+    -- comment. Without looking one level up it would move onto its own
+    -- line, and formatting would not be idempotent.
+    it "attaches a comment inside an element that opened on its line to the code before it" $
+      let rhs = spn 2 11 3 9
+          body = spn 3 3 3 9
+       in anchorFor
+            (mkSpanForest [block, stmt1, rhs, body])
+            (trailing 2 14 2 20)
+            `shouldBe` AnchorTrailing stmt1
+    it "still lets an element starting on the comment's line lead it" $
+      -- The @{-a-}@ of @x = ({-a-} b, c)@ belongs to @b@, not to the @x@
+      -- one level up.
+      let tuple = spn 2 11 2 30
+          b = spn 2 18 2 19
+       in anchorFor
+            (mkSpanForest [block, stmt1, tuple, b])
+            (trailing 2 12 2 17)
+            `shouldBe` AnchorBefore b
+    it "does not carry a comment out of a list of items" $
+      -- @xs ++ [ -- why?@: the comment introduces the items, so carrying it
+      -- up to trail @xs@ would drag it out of the brackets.
+      let list = spn 2 11 4 9
+          itemA = spn 3 3 3 9
+          itemB = spn 4 3 4 9
+       in anchorFor
+            (mkSpanForest [block, stmt1, list, itemA, itemB])
+            (trailing 2 14 2 20)
+            `shouldBe` AnchorBefore itemA
+    it "does not carry a block comment up a level" $
+      -- A block comment renders where it stands, so trailing an element one
+      -- level up would push it ahead of the tokens that opened the element
+      -- it was written inside.
+      let rhs = spn 2 11 3 9
+          body = spn 3 3 3 9
+       in anchorFor
+            (mkSpanForest [block, stmt1, rhs, body])
+            (blockTrailing 2 14 2 20)
+            `shouldBe` AnchorBefore body
+
+    it "does not depend on the order the elements are given in" $
+      -- This is the whole point: reordering imports or reassociating an
+      -- operator tree must not change who owns a comment.
+      anchorFor (mkSpanForest [stmt2, block, stmt1]) (ownLine 3 3 3 12)
+        `shouldBe` AnchorBefore stmt2
+
+  describe "attachComments" $
+    it "attaches every comment exactly once" $ do
+      let comments = [ownLine 3 3 3 12, trailing 4 12 4 20]
+          anchors = attachComments comments [spn 1 1 5 10, spn 2 3 2 9, spn 4 3 4 9]
+      length anchors `shouldBe` 2
+      fmap snd anchors
+        `shouldBe` [AnchorBefore (spn 4 3 4 9), AnchorTrailing (spn 4 3 4 9)]
+
+----------------------------------------------------------------------------
+-- Helpers
+
+spn :: Int -> Int -> Int -> Int -> RealSrcSpan
+spn l1 c1 l2 c2 =
+  mkRealSrcSpan
+    (mkRealSrcLoc (fsLit "<test>") l1 c1)
+    (mkRealSrcLoc (fsLit "<test>") l2 c2)
+
+-- | A comment with code in front of it on the same line.
+trailing :: Int -> Int -> Int -> Int -> LComment
+trailing l1 c1 l2 c2 = L (spn l1 c1 l2 c2) (Comment True ("-- x" :| []))
+
+-- | A block comment with code in front of it on the same line.
+blockTrailing :: Int -> Int -> Int -> Int -> LComment
+blockTrailing l1 c1 l2 c2 = L (spn l1 c1 l2 c2) (Comment True ("{- x -}" :| []))
+
+-- | A comment that is alone on its line.
+ownLine :: Int -> Int -> Int -> Int -> LComment
+ownLine l1 c1 l2 c2 = L (spn l1 c1 l2 c2) (Comment False ("-- x" :| []))
diff --git a/tests/Ormolu/Fixity/ParserSpec.hs b/tests/Ormolu/Fixity/ParserSpec.hs
--- a/tests/Ormolu/Fixity/ParserSpec.hs
+++ b/tests/Ormolu/Fixity/ParserSpec.hs
@@ -35,6 +35,18 @@
         `shouldParse` ( exampleFixityOverrides,
                         ModuleReexports Map.empty
                       )
+    it "accepts fractional operator precedences" $
+      parseDotOrmolu
+        ""
+        ( T.unlines
+            [ "infixr 3 >~<",
+              "infixr 3.3 |~|",
+              "infixr 3.7 <~>"
+            ]
+        )
+        `shouldParse` ( fractionalFixityOverrides,
+                        ModuleReexports Map.empty
+                      )
     it "combines conflicting fixity declarations correctly" $
       parseDotOrmolu
         ""
@@ -202,7 +214,7 @@
                 elabel "module name"
               ]
           )
-    it "fails with correct parse error (typo: export intead exports)" $
+    it "fails with correct parse error (typo: export instead exports)" $
       parseModuleReexportDeclaration "module Control.Lens export Control.Lens.Lens"
         `shouldFailWith` err
           20
@@ -228,6 +240,16 @@
           ("=<<", FixityInfo InfixR 1),
           (">>", FixityInfo InfixL 1),
           (">>=", FixityInfo InfixL 1)
+        ]
+    )
+
+fractionalFixityOverrides :: FixityOverrides
+fractionalFixityOverrides =
+  FixityOverrides
+    ( Map.fromList
+        [ (">~<", FixityInfo InfixR 3),
+          ("|~|", FixityInfo InfixR 3.3),
+          ("<~>", FixityInfo InfixR 3.7)
         ]
     )
 
diff --git a/tests/Ormolu/Fixity/PrinterSpec.hs b/tests/Ormolu/Fixity/PrinterSpec.hs
--- a/tests/Ormolu/Fixity/PrinterSpec.hs
+++ b/tests/Ormolu/Fixity/PrinterSpec.hs
@@ -37,7 +37,12 @@
               InfixR,
               InfixN
             ]
-        fiPrecedence <- chooseInt (0, 9)
+        precedenceWholePart <- fromIntegral <$> chooseInt (0, 9)
+        precedenceFractionalPart <-
+          if precedenceWholePart < 9.0
+            then (* 0.1) . fromIntegral <$> chooseInt (0, 1)
+            else return 0
+        let fiPrecedence = precedenceWholePart + precedenceFractionalPart
         return FixityInfo {..}
 
 instance Arbitrary ModuleReexports where
diff --git a/tests/Ormolu/FixitySpec.hs b/tests/Ormolu/FixitySpec.hs
--- a/tests/Ormolu/FixitySpec.hs
+++ b/tests/Ormolu/FixitySpec.hs
@@ -201,44 +201,32 @@
       ["esqueleto"]
       [package_ "bob" $ import_ "Database.Esqueleto.Experimental"]
       [(unqual "++.", defaultFixityApproximation)]
-  it "default module re-exports: Control.Lens brings into scope Control.Lens.Lens" $
+  it "re-exports baked into the database: Control.Lens brings <+~ into scope" $
     checkFixities
       ["lens"]
-      ( applyModuleReexports
-          defaultModuleReexports
-          [import_ "Control.Lens"]
-      )
+      [import_ "Control.Lens"]
       [(unqual "<+~", FixityApproximation (Just InfixR) 4 4)]
-  it "default module re-exports: Control.Lens qualified brings into scope Control.Lens.Lens" $
+  it "re-exports baked into the database: Control.Lens qualified" $
     checkFixities
       ["lens"]
-      ( applyModuleReexports
-          defaultModuleReexports
-          [import_ "Control.Lens" & qualified_]
-      )
+      [import_ "Control.Lens" & qualified_]
       [ (unqual "<+~", defaultFixityApproximation),
-        (qual "Control.Lens.Lens" "<+~", defaultFixityApproximation),
         (qual "Control.Lens" "<+~", FixityApproximation (Just InfixR) 4 4)
       ]
-  it "default module re-exports: Control.Lens qualified as brings into scope Control.Lens.Lens" $
+  it "re-exports baked into the database: Control.Lens qualified as" $
     checkFixities
       ["lens"]
-      ( applyModuleReexports
-          defaultModuleReexports
-          [import_ "Control.Lens" & qualified_ & as_ "L"]
-      )
+      [import_ "Control.Lens" & qualified_ & as_ "L"]
       [ (unqual "<+~", defaultFixityApproximation),
-        (qual "Control.Lens.Lens" "<+~", defaultFixityApproximation),
         (qual "Control.Lens" "<+~", defaultFixityApproximation),
         (qual "L" "<+~", FixityApproximation (Just InfixR) 4 4)
       ]
   it "re-export chains: exported module can itself re-export another module" $ do
     let reexports =
           ModuleReexports $
-            Map.insert
+            Map.singleton
               "Foo"
               ((Nothing, "Control.Lens") :| [])
-              (unModuleReexports defaultModuleReexports)
     checkFixities
       ["lens"]
       ( applyModuleReexports
@@ -297,7 +285,7 @@
       fimportList = Nothing
     }
 
--- | Adds an alias for an import.
+-- | Add an alias for an import.
 as_ :: ModuleName -> FixityImport -> FixityImport
 as_ moduleName fixityImport =
   fixityImport
diff --git a/tests/Ormolu/PrinterSpec.hs b/tests/Ormolu/PrinterSpec.hs
--- a/tests/Ormolu/PrinterSpec.hs
+++ b/tests/Ormolu/PrinterSpec.hs
@@ -6,14 +6,12 @@
 import Control.Exception
 import Control.Monad
 import Data.List (isSuffixOf)
-import Data.Map qualified as Map
 import Data.Maybe (isJust)
-import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.IO.Utf8 qualified as T.Utf8
 import Ormolu
-import Ormolu.Fixity
+import Ormolu.TestConfig
 import Path
 import Path.IO
 import System.Environment (lookupEnv)
@@ -25,42 +23,20 @@
   es <- runIO locateExamples
   forM_ es checkExample
 
--- | Fixity overrides that are to be used with the test examples.
-testsuiteOverrides :: FixityOverrides
-testsuiteOverrides =
-  FixityOverrides
-    ( Map.fromList
-        [ (".=", FixityInfo InfixR 8),
-          ("#", FixityInfo InfixR 5)
-        ]
-    )
-
 -- | Check a single given example.
 checkExample :: Path Rel File -> Spec
 checkExample srcPath' = it (fromRelFile srcPath' ++ " works") . withNiceExceptions $ do
   let srcPath = examplesDir </> srcPath'
       inputPath = fromRelFile srcPath
-      config =
-        defaultConfig
-          { cfgSourceType = detectSourceType inputPath,
-            cfgFixityOverrides = testsuiteOverrides,
-            cfgDependencies =
-              Set.fromList
-                [ "base",
-                  "esqueleto",
-                  "hspec",
-                  "lens",
-                  "servant"
-                ]
-          }
+      config = exampleConfig inputPath
   expectedOutputPath <- deriveOutput srcPath
-  -- 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 the original snippet. (This happens in
+  -- 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 its AST
+  -- is the same as the AST of the original snippet. (This happens in
   -- 'ormoluFile' automatically.)
   formatted0 <- ormoluFile config inputPath
-  -- 3. Check the output against expected output. Thus all tests should
-  -- include two files: input and expected output.
+  -- 3. Check the output against the expected output. Thus all tests should
+  -- include two files: the input and the expected output.
   whenShouldRegenerateOutput $
     T.Utf8.writeFile (fromRelFile expectedOutputPath) formatted0
   expected <- T.Utf8.readFile $ fromRelFile expectedOutputPath
@@ -70,20 +46,20 @@
   formatted1 <- ormolu config "<formatted>" formatted0
   shouldMatch True formatted1 formatted0
 
--- | Build list of examples for testing.
+-- | Build a list of examples for testing.
 locateExamples :: IO [Path Rel File]
 locateExamples =
   filter isInput . snd <$> listDirRecurRel examplesDir
 
--- | Does given path look like input path (as opposed to expected output
--- path)?
+-- | Does the given path look like an input path (as opposed to an expected
+-- output path)?
 isInput :: Path Rel File -> Bool
 isInput path =
   let s = fromRelFile path
       (s', exts) = F.splitExtensions s
    in exts `elem` [".hs", ".hsig"] && not ("-out" `isSuffixOf` s')
 
--- | For given path of input file return expected name of output.
+-- | For the given input file path, return the expected output name.
 deriveOutput :: Path Rel File -> IO (Path Rel File)
 deriveOutput path =
   parseRelFile $
@@ -111,7 +87,7 @@
 examplesDir :: Path Rel Dir
 examplesDir = $(mkRelDir "data/examples")
 
--- | Inside this wrapper 'OrmoluException' will be caught and displayed
+-- | Inside this wrapper, 'OrmoluException' will be caught and displayed
 -- nicely using 'displayException'.
 withNiceExceptions ::
   -- | Action that may throw the exception
diff --git a/tests/Ormolu/TestConfig.hs b/tests/Ormolu/TestConfig.hs
new file mode 100644
--- /dev/null
+++ b/tests/Ormolu/TestConfig.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | The 'Config' that all corpora of test inputs are formatted with.
+--
+-- Fixity information affects the shape of operator trees, and therefore
+-- both the layout and which AST element claims a comment, so every spec
+-- that formats an input file has to agree on it.
+module Ormolu.TestConfig
+  ( exampleConfig,
+  )
+where
+
+import Data.Map qualified as Map
+import Data.Set qualified as Set
+import Ormolu
+import Ormolu.Fixity
+
+-- | The configuration to use for a test input at the given path.
+exampleConfig :: FilePath -> Config RegionIndices
+exampleConfig inputPath =
+  defaultConfig
+    { cfgSourceType = detectSourceType inputPath,
+      cfgFixityOverrides = testsuiteOverrides,
+      cfgDependencies =
+        Set.fromList
+          [ "base",
+            "esqueleto",
+            "hspec",
+            "lens",
+            "megaparsec",
+            "optics",
+            "relude",
+            "rio",
+            "servant"
+          ]
+    }
+
+-- | Fixity overrides that are to be used with the test inputs.
+testsuiteOverrides :: FixityOverrides
+testsuiteOverrides =
+  FixityOverrides
+    ( Map.fromList
+        [ (".=", FixityInfo InfixR 8),
+          ("#", FixityInfo InfixR 5),
+          (">~<", FixityInfo InfixR 3),
+          ("|~|", FixityInfo InfixR 3.3),
+          ("<~>", FixityInfo InfixR 3.7)
+        ]
+    )