diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,6 +1,193 @@
+## Fourmolu 0.21.0.0
+
+* Import lines separated by comments without blank lines are now considered one import group
+
+### Upstream changes:
+
+#### 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.
+
+## Fourmolu 0.20.1.0
+
+### Upstream changes:
+
+#### 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).
+
+## Fourmolu 0.20.0.0
+
+Now installable with GHCup! See README for details.
+
+* Improve `import-grouping` configuration
+
+    * Add the `scope` option for import grouping ([#525](https://github.com/fourmolu/fourmolu/pull/525)).
+
+    * Deprecate the `match` option for import grouping in favor of `glob` and `scope` ([#525](https://github.com/fourmolu/fourmolu/pull/525)).
+
+    * Add the `import-list` option for import grouping ([#522](https://github.com/fourmolu/fourmolu/pull/522)).
+
+* Add a `record-style` to configure the placement of record braces. ([#467](https://github.com/fourmolu/fourmolu/issues/467))
+
+* Fix applying `indent-wheres` configuration to pattern synonyms with explicit bidirectional `where` clauses ([#486](https://github.com/fourmolu/fourmolu/issues/486))
+
+### Upstream changes:
+
+#### 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).
+
 ## Fourmolu 0.19.0.1
 
-* Fixed a performance regression introduced in 0.8.0.0. [Issue
+### Upstream changes:
+
+#### Ormolu 0.8.0.2
+
+* Fix a performance regression introduced in 0.8.0.0. [Issue
   1176](https://github.com/tweag/ormolu/issues/1176).
 
 ## Fourmolu 0.19.0.0
@@ -429,7 +616,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.
@@ -722,7 +909,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
@@ -735,7 +922,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).
 
@@ -745,7 +932,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).
 
 ## Fourmolu 0.3.0.0
@@ -780,7 +967,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
@@ -809,26 +996,26 @@
 * 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).
 
 ## Fourmolu 0.1.0.0
@@ -841,24 +1028,24 @@
 
 #### 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).
 
@@ -866,17 +1053,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`.
@@ -907,7 +1094,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
@@ -928,7 +1115,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
@@ -946,15 +1133,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.
@@ -966,7 +1153,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
@@ -984,20 +1171,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
@@ -1017,7 +1204,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/LICENSE.md b/LICENSE.md
--- a/LICENSE.md
+++ b/LICENSE.md
@@ -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
@@ -26,20 +26,18 @@
 
 We share all bar one of Ormolu's goals:
 
-* 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`](https://hackage.haskell.org/package/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.
-* That 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.
+* 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.
 * ~~Implementing one “true” formatting style which admits no configuration.~~ We allow configuration of various parameters, via CLI options or config files. We encourage any contributions which add further flexibility.
 
@@ -49,13 +47,24 @@
 
 ## Installation
 
-To install the latest release from Hackage, simply install with Cabal or Stack:
+### (Recommended) Install with GHCup
 
-```console
-$ cabal install fourmolu
-$ stack install fourmolu
+```bash
+ghcup config add-release-channel 3rdparty
+ghcup install fourmolu latest
 ```
 
+### Install with Cabal/Stack
+
+```bash
+cabal install fourmolu
+stack install fourmolu
+```
+
+### Install with [dotslash](https://dotslash-cli.com/docs/)
+
+Copy the configuration in the GitHub release notes.
+
 ## Building from source
 
 ```console
@@ -67,13 +76,13 @@
 
 ## Usage
 
-The following will print the formatted output to the standard output.
+The following prints the formatted output to the standard output:
 
 ```console
 $ fourmolu Module.hs
 ```
 
-Add `-i` (or `--mode inplace`) to replace the contents of the input file with the formatted output.
+Add `-i` (or `--mode inplace`) to replace the contents of the input file with the formatted output:
 
 ```console
 $ fourmolu -i Module.hs
@@ -93,7 +102,7 @@
 $ git ls-files -z '*.hs' | xargs -P 12 -0 fourmolu --mode inplace
 ```
 
-To check if files are already formatted (useful on CI):
+To check whether files are already formatted (useful on CI):
 
 ```console
 $ fourmolu --mode check src
@@ -115,19 +124,20 @@
 
 Fourmolu can be integrated with your editor via the [Haskell Language Server](https://haskell-language-server.readthedocs.io/en/latest/index.html). Just set `haskell.formattingProvider` to `fourmolu` ([instructions](https://haskell-language-server.readthedocs.io/en/latest/configuration.html#language-specific-server-options)).
 
-### GitHub actions
+### GitHub Actions
 
-[`run-fourmolu`](https://github.com/haskell-actions/run-fourmolu) is the recommended way to ensure that a project is formatted with Fourmolu.
+[`run-fourmolu`](https://github.com/haskell-actions/run-fourmolu) is the recommended way to ensure that a project stays formatted with Fourmolu.
 
 ### Language extensions, dependencies, and fixities
 
 Fourmolu 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 the `fixities` configuration option in `fourmolu.yaml`. When the input comes from
-stdin, one can pass `--stdin-input-file` which will give Fourmolu the location
-that should be used as the starting point for searching for `.cabal` 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 the `fixities` configuration option in
+`fourmolu.yaml`. When the input comes from stdin, you
+can pass `--stdin-input-file` to tell Fourmolu which location to use as the
+starting point when searching for `.cabal` files.
 
 Here is an example of the `fixities` configuration:
 
@@ -145,21 +155,20 @@
   - infixr 3.7 <~>
 ```
 
-It uses exactly the same syntax as usual Haskell fixity declarations to make
-it easier for Haskellers to edit and maintain. Since Ormolu 0.7.8.0
-fractional precedences are supported for more precise control over
-formatting of complex operator chains.
+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.
 
 `fourmolu.yaml` can also contain instructions about
-module re-exports that Fourmolu should be aware of. This might be desirable
-because at the moment Fourmolu 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 Fourmolu. (You are welcome to open PRs to make Fourmolu aware of more
-re-exports by default.) However, when the fixity of an operator is not
-inferred correctly, making Fourmolu aware of a re-export may come in handy.
-Here is an example:
+module re-exports that Fourmolu should be aware of. This can be useful because
+Fourmolu 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 Fourmolu. (You are welcome to open PRs upstream to Ormolu to make Fourmolu
+aware of more re-exports by default.) However, when the fixity of an operator
+is not inferred correctly, making Fourmolu aware of a re-export may help. Here
+is an example:
 
 ```yaml
 reexports:
@@ -194,22 +203,22 @@
 {- FOURMOLU_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
-`{- FOURMOLU_DISABLE -}` at the very top. Note that for Fourmolu to work the
-fragments where Fourmolu 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 `{- FOURMOLU_DISABLE -}` at the very top. Note that the fragments
+where Fourmolu 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.
 
 `{- ORMOLU_DISABLE -}` and `{- ORMOLU_ENABLE -}`, respectively, can be used to the same effect,
 and the two styles of magic comments can be mixed.
 
 ### Regions
 
-One can ask Fourmolu 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 Fourmolu 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.
 
@@ -228,6 +237,7 @@
 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)
@@ -235,10 +245,10 @@
 
 ### Using as a library
 
-The `fourmolu` 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.10.2.0. Rely on other modules at your own risk.
+The `fourmolu` 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
 
@@ -253,25 +263,26 @@
   specify the correct fixities in a `fourmolu.yaml` 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 `fourmolu.yaml` file.
+  If either of these applies, make sure to specify the re-exports correctly
+  in a `fourmolu.yaml` 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](https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp) section in the design notes for a
+  correctly, so Fourmolu 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.
 * Various minor idempotence issues, most of them are related to comments or column limits.
 
diff --git a/app/Main.hs b/app/Main.hs
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -220,7 +220,7 @@
           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
@@ -284,7 +284,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)
@@ -468,7 +468,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)
@@ -492,7 +492,6 @@
     <*> pure defaultPrinterOpts -- unused; overwritten in resolveConfig
     <*> (fmap Set.fromList . many . strOption . mconcat)
       [ long "local-modules",
-        short 'm',
         metavar "LOCAL_MODULES",
         help "Modules Fourmolu should consider as local by the current Cabal package"
       ]
diff --git a/data/examples/declaration/data/comment-in-empty-record-four-out.hs b/data/examples/declaration/data/comment-in-empty-record-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/comment-in-empty-record-four-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-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-four-out.hs b/data/examples/declaration/data/haddock-before-deriving-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/haddock-before-deriving-four-out.hs
@@ -0,0 +1,5 @@
+data A = A
+    deriving
+        ( -- | B
+          Eq
+        )
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-four-out.hs b/data/examples/declaration/data/haddock-before-record-braces-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/haddock-before-record-braces-four-out.hs
@@ -0,0 +1,6 @@
+module Example where
+
+data Hello = Hello
+    { hello :: String
+    -- ^ hello world
+    }
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-four-out.hs b/data/examples/declaration/data/linear-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/linear-four-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-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-four-out.hs b/data/examples/declaration/data/record-empty-haddock-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/record-empty-haddock-four-out.hs
@@ -0,0 +1,5 @@
+data A = A
+    { -- \|
+      --
+      a :: Int
+    }
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-four-out.hs b/data/examples/declaration/data/record-four-out.hs
--- a/data/examples/declaration/data/record-four-out.hs
+++ b/data/examples/declaration/data/record-four-out.hs
@@ -11,7 +11,7 @@
     , fooGag
       , fooGog ::
         NonEmpty
-            ( Indentity
+            ( Identity
                 Bool
             )
     -- ^ GagGog
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-four-out.hs b/data/examples/declaration/data/required-type-arguments-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/required-type-arguments-four-out.hs
@@ -0,0 +1,25 @@
+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-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-four-out.hs b/data/examples/declaration/data/unpack-field-comment-0-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-0-four-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-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-four-out.hs b/data/examples/declaration/data/unpack-field-comment-1-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-1-four-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-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-four-out.hs b/data/examples/declaration/data/unpack-field-comment-2-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-2-four-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-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-four-out.hs b/data/examples/declaration/data/unpack-field-comment-3-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/data/unpack-field-comment-3-four-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-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/foreign/foreign-import-multiline-four-out.hs b/data/examples/declaration/foreign/foreign-import-multiline-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/foreign/foreign-import-multiline-four-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-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-four-out.hs b/data/examples/declaration/rewrite-rule/prelude2-four-out.hs
--- a/data/examples/declaration/rewrite-rule/prelude2-four-out.hs
+++ b/data/examples/declaration/rewrite-rule/prelude2-four-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-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-four-out.hs b/data/examples/declaration/rewrite-rule/prelude4-four-out.hs
--- a/data/examples/declaration/rewrite-rule/prelude4-four-out.hs
+++ b/data/examples/declaration/rewrite-rule/prelude4-four-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/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/specialize/specialize-2-four-out.hs b/data/examples/declaration/signature/specialize/specialize-2-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/signature/specialize/specialize-2-four-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-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-four-out.hs b/data/examples/declaration/signature/specialize/specialize-3-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/signature/specialize/specialize-3-four-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-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-four-out.hs b/data/examples/declaration/type-families/closed-type-family/multi-line-four-out.hs
--- a/data/examples/declaration/type-families/closed-type-family/multi-line-four-out.hs
+++ b/data/examples/declaration/type-families/closed-type-family/multi-line-four-out.hs
@@ -23,6 +23,5 @@
     F a = String
 
 type family F a where
-    F a -- foo
-        =
+    F a = -- foo
         a
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-four-out.hs b/data/examples/declaration/type-synonyms/multi-line-four-out.hs
--- a/data/examples/declaration/type-synonyms/multi-line-four-out.hs
+++ b/data/examples/declaration/type-synonyms/multi-line-four-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-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/value/function/arrow/proc-do-complex-four-out.hs b/data/examples/declaration/value/function/arrow/proc-do-complex-four-out.hs
--- a/data/examples/declaration/value/function/arrow/proc-do-complex-four-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-do-complex-four-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
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-lambdas-four-out.hs b/data/examples/declaration/value/function/arrow/proc-lambdas-four-out.hs
--- a/data/examples/declaration/value/function/arrow/proc-lambdas-four-out.hs
+++ b/data/examples/declaration/value/function/arrow/proc-lambdas-four-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/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-four-out.hs b/data/examples/declaration/value/function/awkward-comment-0-four-out.hs
--- a/data/examples/declaration/value/function/awkward-comment-0-four-out.hs
+++ b/data/examples/declaration/value/function/awkward-comment-0-four-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-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-four-out.hs b/data/examples/declaration/value/function/awkward-comment-1-four-out.hs
--- a/data/examples/declaration/value/function/awkward-comment-1-four-out.hs
+++ b/data/examples/declaration/value/function/awkward-comment-1-four-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/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-four-out.hs b/data/examples/declaration/value/function/case-comment-after-pattern-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-comment-after-pattern-four-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-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-four-out.hs b/data/examples/declaration/value/function/case-comment-between-alt-and-where-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-comment-between-alt-and-where-four-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-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-four-out.hs b/data/examples/declaration/value/function/case-multi-line-four-out.hs
--- a/data/examples/declaration/value/function/case-multi-line-four-out.hs
+++ b/data/examples/declaration/value/function/case-multi-line-four-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-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-four-out.hs b/data/examples/declaration/value/function/case-single-line-with-braces-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-single-line-with-braces-four-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-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-four-out.hs b/data/examples/declaration/value/function/case-with-comment-before-where-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/case-with-comment-before-where-four-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-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-four-out.hs b/data/examples/declaration/value/function/do-multiline-with-case-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-multiline-with-case-four-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-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-four-out.hs b/data/examples/declaration/value/function/do-single-line-case-guards-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-case-guards-four-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-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-four-out.hs b/data/examples/declaration/value/function/do-single-line-lambda-case-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-lambda-case-four-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-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-four-out.hs b/data/examples/declaration/value/function/do-single-line-multiple-cases-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-multiple-cases-four-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-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-four-out.hs b/data/examples/declaration/value/function/do-single-line-nested-case-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-nested-case-four-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-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-four-out.hs b/data/examples/declaration/value/function/do-single-line-with-case-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/do-single-line-with-case-four-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-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-four-out.hs b/data/examples/declaration/value/function/guards-four-out.hs
--- a/data/examples/declaration/value/function/guards-four-out.hs
+++ b/data/examples/declaration/value/function/guards-four-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-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-four-out.hs b/data/examples/declaration/value/function/infix/dollar-chains-1-four-out.hs
--- a/data/examples/declaration/value/function/infix/dollar-chains-1-four-out.hs
+++ b/data/examples/declaration/value/function/infix/dollar-chains-1-four-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-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-four-out.hs b/data/examples/declaration/value/function/infix/dollar-chains-3-four-out.hs
--- a/data/examples/declaration/value/function/infix/dollar-chains-3-four-out.hs
+++ b/data/examples/declaration/value/function/infix/dollar-chains-3-four-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-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-four-out.hs b/data/examples/declaration/value/function/infix/dollar-chains-4-four-out.hs
--- a/data/examples/declaration/value/function/infix/dollar-chains-4-four-out.hs
+++ b/data/examples/declaration/value/function/infix/dollar-chains-4-four-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/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/lenses-four-out.hs b/data/examples/declaration/value/function/infix/lenses-four-out.hs
--- a/data/examples/declaration/value/function/infix/lenses-four-out.hs
+++ b/data/examples/declaration/value/function/infix/lenses-four-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/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-four-out.hs b/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-1-four-out.hs
--- a/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-1-four-out.hs
+++ b/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-1-four-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-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-four-out.hs b/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-2-four-out.hs
--- a/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-2-four-out.hs
+++ b/data/examples/declaration/value/function/infix/op-chain-r-eq-dollar-2-four-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-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-four-out.hs b/data/examples/declaration/value/function/infix/op-chain-r-s-dollar-four-out.hs
--- a/data/examples/declaration/value/function/infix/op-chain-r-s-dollar-four-out.hs
+++ b/data/examples/declaration/value/function/infix/op-chain-r-s-dollar-four-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/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-four-out.hs b/data/examples/declaration/value/function/infix/qualified-ops-four-out.hs
--- a/data/examples/declaration/value/function/infix/qualified-ops-four-out.hs
+++ b/data/examples/declaration/value/function/infix/qualified-ops-four-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/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-four-out.hs b/data/examples/declaration/value/function/lambda-comment-after-arrow-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/lambda-comment-after-arrow-four-out.hs
@@ -0,0 +1,2 @@
+f = \a -> -- foo
+    a
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-four-out.hs b/data/examples/declaration/value/function/linear-bindings-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/linear-bindings-four-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-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/multiline-strings-9-four-out.hs b/data/examples/declaration/value/function/multiline-strings-9-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/multiline-strings-9-four-out.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE MultilineStrings #-}
+
+multilineBlank =
+    """
+    1
+
+
+
+
+    6
+    """
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-four-out.hs b/data/examples/declaration/value/function/newline-single-line-body-four-out.hs
--- a/data/examples/declaration/value/function/newline-single-line-body-four-out.hs
+++ b/data/examples/declaration/value/function/newline-single-line-body-four-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/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-four-out.hs b/data/examples/declaration/value/function/operator-comments-3-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/operator-comments-3-four-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-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-four-out.hs b/data/examples/declaration/value/function/operator-comments-4-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/operator-comments-4-four-out.hs
@@ -0,0 +1,4 @@
+foo = do
+    bar
+        -- txt
+        $ baz
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-four-out.hs b/data/examples/declaration/value/function/pattern/or-patterns-four-out.hs
--- a/data/examples/declaration/value/function/pattern/or-patterns-four-out.hs
+++ b/data/examples/declaration/value/function/pattern/or-patterns-four-out.hs
@@ -20,7 +20,8 @@
 sane e = case e of
     1
     2
-    3 -> a
+    3 ->
+        a
     4
     5
     6 -> b
@@ -33,3 +34,10 @@
     (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-out.hs b/data/examples/declaration/value/function/pattern/or-patterns-out.hs
--- a/data/examples/declaration/value/function/pattern/or-patterns-out.hs
+++ b/data/examples/declaration/value/function/pattern/or-patterns-out.hs
@@ -21,7 +21,8 @@
 sane e = case e of
   1
   2
-  3 -> a
+  3 ->
+    a
   4
   5
   6 -> b
@@ -34,3 +35,10 @@
   (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
--- a/data/examples/declaration/value/function/pattern/or-patterns.hs
+++ b/data/examples/declaration/value/function/pattern/or-patterns.hs
@@ -20,7 +20,8 @@
 sane e = case e of
   1
   2
-  3 -> a
+  3 ->
+    a
   4
   5;6 -> b
   7;8 -> c
@@ -31,3 +32,8 @@
   (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-four-out.hs b/data/examples/declaration/value/function/record/wildcard-comments-0-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/record/wildcard-comments-0-four-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-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-four-out.hs b/data/examples/declaration/value/function/record/wildcard-comments-1-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/declaration/value/function/record/wildcard-comments-1-four-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-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/strings-four-out.hs b/data/examples/declaration/value/function/strings-four-out.hs
--- a/data/examples/declaration/value/function/strings-four-out.hs
+++ b/data/examples/declaration/value/function/strings-four-out.hs
@@ -8,3 +8,5 @@
     \baz"
 
 weirdGap = "\65\ \0"
+
+weirdEscape = "\^\ "
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
@@ -10,3 +10,5 @@
   \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
@@ -7,3 +7,5 @@
     \baz"
 
 weirdGap = "\65\ \0"
+
+weirdEscape = "\^\ "
diff --git a/data/examples/declaration/value/pattern-synonyms/explicitely-bidirectional-four-out.hs b/data/examples/declaration/value/pattern-synonyms/explicitely-bidirectional-four-out.hs
--- a/data/examples/declaration/value/pattern-synonyms/explicitely-bidirectional-four-out.hs
+++ b/data/examples/declaration/value/pattern-synonyms/explicitely-bidirectional-four-out.hs
@@ -3,19 +3,19 @@
 pattern P a <- C a where P a = C a
 
 pattern HeadC x <- x : xs
-    where
-        HeadC x = [x]
+  where
+    HeadC x = [x]
 
 pattern HeadC' x <-
     x : xs
-    where
-        HeadC' x = [x]
+  where
+    HeadC' x = [x]
 
 pattern Simple <- "Simple"
-    where
-        Simple = "Complicated"
+  where
+    Simple = "Complicated"
 
 pattern a :< b <-
     (a, b)
-    where
-        a :< b = (a, b)
+  where
+    a :< b = (a, b)
diff --git a/data/examples/fixity/megaparsec-alternative-four-out.hs b/data/examples/fixity/megaparsec-alternative-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/megaparsec-alternative-four-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-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-four-out.hs b/data/examples/fixity/optics-mixed-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/optics-mixed-four-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-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-four-out.hs b/data/examples/fixity/relude-default-operator-chain-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/relude-default-operator-chain-four-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-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-four-out.hs b/data/examples/fixity/relude-default-operator-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/relude-default-operator-four-out.hs
@@ -0,0 +1,7 @@
+module ReludeExample where
+
+import Relude
+
+config =
+    lookupOptionalSetting environment ?:
+        defaultConfigurationValue
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-four-out.hs b/data/examples/fixity/rio-ampersand-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/rio-ampersand-four-out.hs
@@ -0,0 +1,7 @@
+module RioExample where
+
+import RIO
+
+message =
+    greetingText <> userNameText
+        & Text.strip
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-four-out.hs b/data/examples/fixity/rio-deepseq-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/fixity/rio-deepseq-four-out.hs
@@ -0,0 +1,7 @@
+module RioDeepseqExample where
+
+import RIO
+
+result =
+    forceEvaluationOfBigStructure `deepseq`
+        continueWithNextStep
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-four-out.hs b/data/examples/import/comment-before-merged-import-lists-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-before-merged-import-lists-four-out.hs
@@ -0,0 +1,7 @@
+-- their own formatters.
+import Test.Hspec.Core.Formatters.V1.Monad (
+    FormatM,
+    Formatter (..),
+ )
+
+import Test.Hspec.Core.Formatters.V1.Monad (Item (..), interpretWith)
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-four-out.hs b/data/examples/import/comment-before-merged-imports-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-before-merged-imports-four-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-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-four-out.hs b/data/examples/import/comment-between-merged-imports-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-between-merged-imports-four-out.hs
@@ -0,0 +1,6 @@
+import HscMain (newHscEnv)
+-- Implementations of the various modes
+import LoadIface (showIface)
+
+-- Imports for --abi-hash
+import LoadIface (loadUserInterface)
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-four-out.hs b/data/examples/import/comment-inside-empty-import-list-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-inside-empty-import-list-four-out.hs
@@ -0,0 +1,6 @@
+import Package1
+import Package2
+import Package3 (
+
+    -- , import1
+ )
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-four-out.hs b/data/examples/import/comment-inside-sorted-import-list-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/comment-inside-sorted-import-list-four-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-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-four-out.hs b/data/examples/import/comments-per-import-four-out.hs
--- a/data/examples/import/comments-per-import-four-out.hs
+++ b/data/examples/import/comments-per-import-four-out.hs
@@ -1,4 +1,3 @@
--- (1)
 import Bar -- (2)
 import Baz -- (3)
-import Foo
+import Foo -- (1)
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-four-out.hs b/data/examples/import/data-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/data-four-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-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-four-out.hs b/data/examples/import/explicit-imports-with-comments-four-out.hs
--- a/data/examples/import/explicit-imports-with-comments-four-out.hs
+++ b/data/examples/import/explicit-imports-with-comments-four-out.hs
@@ -1,7 +1,5 @@
 import qualified MegaModule as M (
-    -- (1)
-    -- (2)
     Either, -- (3)
-    (<<<),
-    (>>>),
+    (<<<), -- (2)
+    (>>>), -- (1)
  )
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-four-out.hs b/data/examples/import/explicit-level-imports-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/explicit-level-imports-four-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-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-four-out.hs b/data/examples/import/explicit-level-imports-qualified-post-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/explicit-level-imports-qualified-post-four-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-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-four-out.hs b/data/examples/import/implicit-prelude-package-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/implicit-prelude-package-four-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-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-four-out.hs b/data/examples/import/merging-0-four-out.hs
--- a/data/examples/import/merging-0-four-out.hs
+++ b/data/examples/import/merging-0-four-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-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-four-out.hs b/data/examples/import/merging-1-four-out.hs
--- a/data/examples/import/merging-1-four-out.hs
+++ b/data/examples/import/merging-1-four-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-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-four-out.hs b/data/examples/import/merging-2-four-out.hs
--- a/data/examples/import/merging-2-four-out.hs
+++ b/data/examples/import/merging-2-four-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/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-four-out.hs b/data/examples/import/no-implicit-prelude-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/no-implicit-prelude-four-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-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-four-out.hs b/data/examples/import/no-implicit-prelude-package-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/import/no-implicit-prelude-package-four-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-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-four-out.hs b/data/examples/import/simple-four-out.hs
--- a/data/examples/import/simple-four-out.hs
+++ b/data/examples/import/simple-four-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/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-four-out.hs b/data/examples/module-header/block-haddock-in-export-list-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/module-header/block-haddock-in-export-list-four-out.hs
@@ -0,0 +1,4 @@
+module Foo (
+    -- | asdf
+    foo,
+) where
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-four-out.hs b/data/examples/module-header/empty-haddock-four-out.hs
--- a/data/examples/module-header/empty-haddock-four-out.hs
+++ b/data/examples/module-header/empty-haddock-four-out.hs
@@ -1,1 +1,3 @@
+-- \|
+--
 module Test 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-four-out.hs b/data/examples/other/block-comment-before-argument-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/block-comment-before-argument-four-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-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-four-out.hs b/data/examples/other/block-comment-before-element-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/block-comment-before-element-four-out.hs
@@ -0,0 +1,6 @@
+eeExtensions =
+    catMaybes
+        [ {- 0x00 -} sniExt
+        , {- 0x0a -} groupExt
+        , {- 0x10 -} alpnExt
+        ]
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-four-out.hs b/data/examples/other/comment-around-quasiquote-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-around-quasiquote-four-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-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-four-out.hs b/data/examples/other/comment-block-section-heading-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-block-section-heading-four-out.hs
@@ -0,0 +1,3 @@
+{- ***
+   aaa
+-}
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-four-out.hs b/data/examples/other/comment-in-empty-list-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-in-empty-list-four-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-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-four-out.hs b/data/examples/other/comment-opening-a-list-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-opening-a-list-four-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-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-four-out.hs b/data/examples/other/comment-trailing-blank-line-do-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-do-four-out.hs
@@ -0,0 +1,4 @@
+doBlock = do
+    a --
+
+    b
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-four-out.hs b/data/examples/other/comment-trailing-blank-line-let-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-let-four-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-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-four-out.hs b/data/examples/other/comment-trailing-blank-line-variants-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-variants-four-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-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-four-out.hs b/data/examples/other/comment-trailing-blank-line-where-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-blank-line-where-four-out.hs
@@ -0,0 +1,5 @@
+whereBlock = foo
+  where
+    a = a --
+
+    b = b
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-four-out.hs b/data/examples/other/comment-trailing-no-blank-line-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trailing-no-blank-line-four-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-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-four-out.hs b/data/examples/other/comment-trigger-escaping-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/comment-trigger-escaping-four-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-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-four-out.hs b/data/examples/other/comment-two-blocks-four-out.hs
--- a/data/examples/other/comment-two-blocks-four-out.hs
+++ b/data/examples/other/comment-two-blocks-four-out.hs
@@ -2,7 +2,8 @@
 newNames =
     let (*) = flip (,)
      in [ "Control" * "Monad"
-    -- Foo
 
-    -- Bar
+        -- Foo
+
+        -- Bar
         ]
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-four-out.hs b/data/examples/other/empty-forall-four-out.hs
--- a/data/examples/other/empty-forall-four-out.hs
+++ b/data/examples/other/empty-forall-four-out.hs
@@ -12,7 +12,7 @@
     forall. T x = x
 
 {-# RULES
-"r"
+"r" forall.
     r a =
         ()
     #-}
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-four-out.hs b/data/examples/other/empty-haddock-four-out.hs
--- a/data/examples/other/empty-haddock-four-out.hs
+++ b/data/examples/other/empty-haddock-four-out.hs
@@ -1,9 +1,13 @@
+-- \|
 module Test (
+    -- \|
     test,
 )
 where
 
+-- \|
 test ::
+    -- \|
     test
 
-data T = T
+data T = T {- \^ -}
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-four-out.hs b/data/examples/other/invalid-haddock-weird-four-out.hs
--- a/data/examples/other/invalid-haddock-weird-four-out.hs
+++ b/data/examples/other/invalid-haddock-weird-four-out.hs
@@ -1,5 +1,3 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-foo = foo
-
--- \|# ${
+foo = foo -- \|# ${
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-four-out.hs b/data/examples/other/pragma-below-header-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/pragma-below-header-four-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-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-four-out.hs b/data/examples/other/pragma-comment-multi-extension-four-out.hs
new file mode 100644
--- /dev/null
+++ b/data/examples/other/pragma-comment-multi-extension-four-out.hs
@@ -0,0 +1,5 @@
+-- comment
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Foo where
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/data/fourmolu/haddock-style/output-auto-module=auto.hs b/data/fourmolu/haddock-style/output-auto-module=auto.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/haddock-style/output-auto-module=auto.hs
@@ -0,0 +1,38 @@
+-- | This is a test multiline
+-- module haddock
+module Foo where
+
+-- | This is a singleline function haddock
+single1 :: Int
+
+{- | This is a singleline function haddock -}
+single2 :: Int
+
+-- | This is a multiline
+-- function haddock
+multi1 :: Int
+
+{- |
+This is a multiline
+function haddock
+-}
+multi2 :: Int
+
+{- | This is a multiline haddock
+     with indentation
+-}
+multi_indentation :: Int
+
+-- | This is a haddock
+--
+-- with two consecutive newlines
+--
+--
+-- https://github.com/fourmolu/fourmolu/issues/172
+foo :: Int
+foo = 42
+
+-- | This is a haddock containing another haddock
+--
+-- > {-# LANGUAGE ScopedTypeVariables #-}
+haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-auto-module=multi_line.hs b/data/fourmolu/haddock-style/output-auto-module=multi_line.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/haddock-style/output-auto-module=multi_line.hs
@@ -0,0 +1,39 @@
+{- | This is a test multiline
+module haddock
+-}
+module Foo where
+
+-- | This is a singleline function haddock
+single1 :: Int
+
+{- | This is a singleline function haddock -}
+single2 :: Int
+
+-- | This is a multiline
+-- function haddock
+multi1 :: Int
+
+{- |
+This is a multiline
+function haddock
+-}
+multi2 :: Int
+
+{- | This is a multiline haddock
+     with indentation
+-}
+multi_indentation :: Int
+
+-- | This is a haddock
+--
+-- with two consecutive newlines
+--
+--
+-- https://github.com/fourmolu/fourmolu/issues/172
+foo :: Int
+foo = 42
+
+-- | This is a haddock containing another haddock
+--
+-- > {-# LANGUAGE ScopedTypeVariables #-}
+haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-auto-module=multi_line_compact.hs b/data/fourmolu/haddock-style/output-auto-module=multi_line_compact.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/haddock-style/output-auto-module=multi_line_compact.hs
@@ -0,0 +1,39 @@
+{-| This is a test multiline
+module haddock
+-}
+module Foo where
+
+-- | This is a singleline function haddock
+single1 :: Int
+
+{- | This is a singleline function haddock -}
+single2 :: Int
+
+-- | This is a multiline
+-- function haddock
+multi1 :: Int
+
+{- |
+This is a multiline
+function haddock
+-}
+multi2 :: Int
+
+{- | This is a multiline haddock
+     with indentation
+-}
+multi_indentation :: Int
+
+-- | This is a haddock
+--
+-- with two consecutive newlines
+--
+--
+-- https://github.com/fourmolu/fourmolu/issues/172
+foo :: Int
+foo = 42
+
+-- | This is a haddock containing another haddock
+--
+-- > {-# LANGUAGE ScopedTypeVariables #-}
+haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-auto-module=single_line.hs b/data/fourmolu/haddock-style/output-auto-module=single_line.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/haddock-style/output-auto-module=single_line.hs
@@ -0,0 +1,38 @@
+-- | This is a test multiline
+-- module haddock
+module Foo where
+
+-- | This is a singleline function haddock
+single1 :: Int
+
+{- | This is a singleline function haddock -}
+single2 :: Int
+
+-- | This is a multiline
+-- function haddock
+multi1 :: Int
+
+{- |
+This is a multiline
+function haddock
+-}
+multi2 :: Int
+
+{- | This is a multiline haddock
+     with indentation
+-}
+multi_indentation :: Int
+
+-- | This is a haddock
+--
+-- with two consecutive newlines
+--
+--
+-- https://github.com/fourmolu/fourmolu/issues/172
+foo :: Int
+foo = 42
+
+-- | This is a haddock containing another haddock
+--
+-- > {-# LANGUAGE ScopedTypeVariables #-}
+haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-auto.hs b/data/fourmolu/haddock-style/output-auto.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/haddock-style/output-auto.hs
@@ -0,0 +1,38 @@
+-- | This is a test multiline
+-- module haddock
+module Foo where
+
+-- | This is a singleline function haddock
+single1 :: Int
+
+{- | This is a singleline function haddock -}
+single2 :: Int
+
+-- | This is a multiline
+-- function haddock
+multi1 :: Int
+
+{- |
+This is a multiline
+function haddock
+-}
+multi2 :: Int
+
+{- | This is a multiline haddock
+     with indentation
+-}
+multi_indentation :: Int
+
+-- | This is a haddock
+--
+-- with two consecutive newlines
+--
+--
+-- https://github.com/fourmolu/fourmolu/issues/172
+foo :: Int
+foo = 42
+
+-- | This is a haddock containing another haddock
+--
+-- > {-# LANGUAGE ScopedTypeVariables #-}
+haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-multi_line-module=auto.hs b/data/fourmolu/haddock-style/output-multi_line-module=auto.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/haddock-style/output-multi_line-module=auto.hs
@@ -0,0 +1,41 @@
+-- | This is a test multiline
+-- module haddock
+module Foo where
+
+-- | This is a singleline function haddock
+single1 :: Int
+
+-- | This is a singleline function haddock
+single2 :: Int
+
+{- | This is a multiline
+function haddock
+-}
+multi1 :: Int
+
+{- |
+This is a multiline
+function haddock
+-}
+multi2 :: Int
+
+{- | This is a multiline haddock
+     with indentation
+-}
+multi_indentation :: Int
+
+{- | This is a haddock
+
+with two consecutive newlines
+
+
+https://github.com/fourmolu/fourmolu/issues/172
+-}
+foo :: Int
+foo = 42
+
+{- | This is a haddock containing another haddock
+
+> {-# LANGUAGE ScopedTypeVariables #-}
+-}
+haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-multi_line-module=multi_line.hs b/data/fourmolu/haddock-style/output-multi_line-module=multi_line.hs
--- a/data/fourmolu/haddock-style/output-multi_line-module=multi_line.hs
+++ b/data/fourmolu/haddock-style/output-multi_line-module=multi_line.hs
@@ -37,6 +37,6 @@
 
 {- | This is a haddock containing another haddock
 
-> {\-# LANGUAGE ScopedTypeVariables #-\}
+> {-# LANGUAGE ScopedTypeVariables #-}
 -}
 haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-multi_line-module=multi_line_compact.hs b/data/fourmolu/haddock-style/output-multi_line-module=multi_line_compact.hs
--- a/data/fourmolu/haddock-style/output-multi_line-module=multi_line_compact.hs
+++ b/data/fourmolu/haddock-style/output-multi_line-module=multi_line_compact.hs
@@ -37,6 +37,6 @@
 
 {- | This is a haddock containing another haddock
 
-> {\-# LANGUAGE ScopedTypeVariables #-\}
+> {-# LANGUAGE ScopedTypeVariables #-}
 -}
 haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-multi_line-module=single_line.hs b/data/fourmolu/haddock-style/output-multi_line-module=single_line.hs
--- a/data/fourmolu/haddock-style/output-multi_line-module=single_line.hs
+++ b/data/fourmolu/haddock-style/output-multi_line-module=single_line.hs
@@ -36,6 +36,6 @@
 
 {- | This is a haddock containing another haddock
 
-> {\-# LANGUAGE ScopedTypeVariables #-\}
+> {-# LANGUAGE ScopedTypeVariables #-}
 -}
 haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-multi_line.hs b/data/fourmolu/haddock-style/output-multi_line.hs
--- a/data/fourmolu/haddock-style/output-multi_line.hs
+++ b/data/fourmolu/haddock-style/output-multi_line.hs
@@ -37,6 +37,6 @@
 
 {- | This is a haddock containing another haddock
 
-> {\-# LANGUAGE ScopedTypeVariables #-\}
+> {-# LANGUAGE ScopedTypeVariables #-}
 -}
 haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-multi_line_compact-module=auto.hs b/data/fourmolu/haddock-style/output-multi_line_compact-module=auto.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/haddock-style/output-multi_line_compact-module=auto.hs
@@ -0,0 +1,41 @@
+-- | This is a test multiline
+-- module haddock
+module Foo where
+
+-- | This is a singleline function haddock
+single1 :: Int
+
+-- | This is a singleline function haddock
+single2 :: Int
+
+{-| This is a multiline
+function haddock
+-}
+multi1 :: Int
+
+{-|
+This is a multiline
+function haddock
+-}
+multi2 :: Int
+
+{-| This is a multiline haddock
+     with indentation
+-}
+multi_indentation :: Int
+
+{-| This is a haddock
+
+with two consecutive newlines
+
+
+https://github.com/fourmolu/fourmolu/issues/172
+-}
+foo :: Int
+foo = 42
+
+{-| This is a haddock containing another haddock
+
+> {-# LANGUAGE ScopedTypeVariables #-}
+-}
+haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-multi_line_compact-module=multi_line.hs b/data/fourmolu/haddock-style/output-multi_line_compact-module=multi_line.hs
--- a/data/fourmolu/haddock-style/output-multi_line_compact-module=multi_line.hs
+++ b/data/fourmolu/haddock-style/output-multi_line_compact-module=multi_line.hs
@@ -37,6 +37,6 @@
 
 {-| This is a haddock containing another haddock
 
-> {\-# LANGUAGE ScopedTypeVariables #-\}
+> {-# LANGUAGE ScopedTypeVariables #-}
 -}
 haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-multi_line_compact-module=multi_line_compact.hs b/data/fourmolu/haddock-style/output-multi_line_compact-module=multi_line_compact.hs
--- a/data/fourmolu/haddock-style/output-multi_line_compact-module=multi_line_compact.hs
+++ b/data/fourmolu/haddock-style/output-multi_line_compact-module=multi_line_compact.hs
@@ -37,6 +37,6 @@
 
 {-| This is a haddock containing another haddock
 
-> {\-# LANGUAGE ScopedTypeVariables #-\}
+> {-# LANGUAGE ScopedTypeVariables #-}
 -}
 haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-multi_line_compact-module=single_line.hs b/data/fourmolu/haddock-style/output-multi_line_compact-module=single_line.hs
--- a/data/fourmolu/haddock-style/output-multi_line_compact-module=single_line.hs
+++ b/data/fourmolu/haddock-style/output-multi_line_compact-module=single_line.hs
@@ -36,6 +36,6 @@
 
 {-| This is a haddock containing another haddock
 
-> {\-# LANGUAGE ScopedTypeVariables #-\}
+> {-# LANGUAGE ScopedTypeVariables #-}
 -}
 haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-multi_line_compact.hs b/data/fourmolu/haddock-style/output-multi_line_compact.hs
--- a/data/fourmolu/haddock-style/output-multi_line_compact.hs
+++ b/data/fourmolu/haddock-style/output-multi_line_compact.hs
@@ -37,6 +37,6 @@
 
 {-| This is a haddock containing another haddock
 
-> {\-# LANGUAGE ScopedTypeVariables #-\}
+> {-# LANGUAGE ScopedTypeVariables #-}
 -}
 haddock_in_haddock :: Int
diff --git a/data/fourmolu/haddock-style/output-single_line-module=auto.hs b/data/fourmolu/haddock-style/output-single_line-module=auto.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/haddock-style/output-single_line-module=auto.hs
@@ -0,0 +1,36 @@
+-- | This is a test multiline
+-- module haddock
+module Foo where
+
+-- | This is a singleline function haddock
+single1 :: Int
+
+-- | This is a singleline function haddock
+single2 :: Int
+
+-- | This is a multiline
+-- function haddock
+multi1 :: Int
+
+-- |
+-- This is a multiline
+-- function haddock
+multi2 :: Int
+
+-- | This is a multiline haddock
+--      with indentation
+multi_indentation :: Int
+
+-- | This is a haddock
+--
+-- with two consecutive newlines
+--
+--
+-- https://github.com/fourmolu/fourmolu/issues/172
+foo :: Int
+foo = 42
+
+-- | This is a haddock containing another haddock
+--
+-- > {-# LANGUAGE ScopedTypeVariables #-}
+haddock_in_haddock :: Int
diff --git a/data/fourmolu/import-grouping/input.hs b/data/fourmolu/import-grouping/input.hs
--- a/data/fourmolu/import-grouping/input.hs
+++ b/data/fourmolu/import-grouping/input.hs
@@ -1,13 +1,20 @@
 module Main where
 
+import Data.Either
 import Data.Text (Text)
 import Data.Maybe (maybe)
 
 import qualified Data.Text
 import Control.Monad (Monad (..))
+import Data.Functor
 
 import qualified System.IO as SIO
 import SomeInternal.Module1 (anotherDefinition, someDefinition)
 import qualified SomeInternal.Module2 as Mod2
 import Text.Printf (printf)
 import qualified SomeModule
+import SomeInternal.Module2
+
+import Foo
+-- some comment
+import Foo.Bar
diff --git a/data/fourmolu/import-grouping/output-by_qualified.hs b/data/fourmolu/import-grouping/output-by_qualified.hs
--- a/data/fourmolu/import-grouping/output-by_qualified.hs
+++ b/data/fourmolu/import-grouping/output-by_qualified.hs
@@ -1,9 +1,15 @@
 module Main where
 
 import Control.Monad (Monad (..))
+import Data.Either
+import Data.Functor
 import Data.Maybe (maybe)
 import Data.Text (Text)
+import Foo
+-- some comment
+import Foo.Bar
 import SomeInternal.Module1 (anotherDefinition, someDefinition)
+import SomeInternal.Module2
 import Text.Printf (printf)
 
 import qualified Data.Text
diff --git a/data/fourmolu/import-grouping/output-by_scope.hs b/data/fourmolu/import-grouping/output-by_scope.hs
--- a/data/fourmolu/import-grouping/output-by_scope.hs
+++ b/data/fourmolu/import-grouping/output-by_scope.hs
@@ -1,12 +1,18 @@
 module Main where
 
 import Control.Monad (Monad (..))
+import Data.Either
+import Data.Functor
 import Data.Maybe (maybe)
 import Data.Text (Text)
 import qualified Data.Text
+import Foo
+-- some comment
+import Foo.Bar
 import qualified SomeModule
 import qualified System.IO as SIO
 import Text.Printf (printf)
 
 import SomeInternal.Module1 (anotherDefinition, someDefinition)
+import SomeInternal.Module2
 import qualified SomeInternal.Module2 as Mod2
diff --git a/data/fourmolu/import-grouping/output-by_scope_then_qualified.hs b/data/fourmolu/import-grouping/output-by_scope_then_qualified.hs
--- a/data/fourmolu/import-grouping/output-by_scope_then_qualified.hs
+++ b/data/fourmolu/import-grouping/output-by_scope_then_qualified.hs
@@ -1,8 +1,13 @@
 module Main where
 
 import Control.Monad (Monad (..))
+import Data.Either
+import Data.Functor
 import Data.Maybe (maybe)
 import Data.Text (Text)
+import Foo
+-- some comment
+import Foo.Bar
 import Text.Printf (printf)
 
 import qualified Data.Text
@@ -10,5 +15,6 @@
 import qualified System.IO as SIO
 
 import SomeInternal.Module1 (anotherDefinition, someDefinition)
+import SomeInternal.Module2
 
 import qualified SomeInternal.Module2 as Mod2
diff --git a/data/fourmolu/import-grouping/output-custom.hs b/data/fourmolu/import-grouping/output-custom.hs
--- a/data/fourmolu/import-grouping/output-custom.hs
+++ b/data/fourmolu/import-grouping/output-custom.hs
@@ -1,5 +1,12 @@
 module Main where
 
+import Data.Either
+import Data.Functor
+import Foo
+-- some comment
+import Foo.Bar
+import SomeInternal.Module2
+
 import Data.Text (Text)
 import qualified Data.Text
 
diff --git a/data/fourmolu/import-grouping/output-preserve.hs b/data/fourmolu/import-grouping/output-preserve.hs
--- a/data/fourmolu/import-grouping/output-preserve.hs
+++ b/data/fourmolu/import-grouping/output-preserve.hs
@@ -1,13 +1,20 @@
 module Main where
 
+import Data.Either
 import Data.Maybe (maybe)
 import Data.Text (Text)
 
 import Control.Monad (Monad (..))
+import Data.Functor
 import qualified Data.Text
 
 import SomeInternal.Module1 (anotherDefinition, someDefinition)
+import SomeInternal.Module2
 import qualified SomeInternal.Module2 as Mod2
 import qualified SomeModule
 import qualified System.IO as SIO
 import Text.Printf (printf)
+
+import Foo
+-- some comment
+import Foo.Bar
diff --git a/data/fourmolu/import-grouping/output-single.hs b/data/fourmolu/import-grouping/output-single.hs
--- a/data/fourmolu/import-grouping/output-single.hs
+++ b/data/fourmolu/import-grouping/output-single.hs
@@ -1,10 +1,16 @@
 module Main where
 
 import Control.Monad (Monad (..))
+import Data.Either
+import Data.Functor
 import Data.Maybe (maybe)
 import Data.Text (Text)
 import qualified Data.Text
+import Foo
+-- some comment
+import Foo.Bar
 import SomeInternal.Module1 (anotherDefinition, someDefinition)
+import SomeInternal.Module2
 import qualified SomeInternal.Module2 as Mod2
 import qualified SomeModule
 import qualified System.IO as SIO
diff --git a/data/fourmolu/indentation/input.hs b/data/fourmolu/indentation/input.hs
--- a/data/fourmolu/indentation/input.hs
+++ b/data/fourmolu/indentation/input.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 module Foo (
   asdf,
   bar,
@@ -21,3 +23,7 @@
 
 class Foo a where
   foo :: a -> Int
+
+pattern HeadC x <- x : xs
+  where
+    HeadC x = [x]
diff --git a/data/fourmolu/indentation/output-2-indent_wheres.hs b/data/fourmolu/indentation/output-2-indent_wheres.hs
--- a/data/fourmolu/indentation/output-2-indent_wheres.hs
+++ b/data/fourmolu/indentation/output-2-indent_wheres.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 module Foo (
   asdf,
   bar,
@@ -21,3 +23,7 @@
 
 class Foo a where
   foo :: a -> Int
+
+pattern HeadC x <- x : xs
+  where
+    HeadC x = [x]
diff --git a/data/fourmolu/indentation/output-2.hs b/data/fourmolu/indentation/output-2.hs
--- a/data/fourmolu/indentation/output-2.hs
+++ b/data/fourmolu/indentation/output-2.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 module Foo (
   asdf,
   bar,
@@ -21,3 +23,7 @@
 
 class Foo a where
   foo :: a -> Int
+
+pattern HeadC x <- x : xs
+ where
+  HeadC x = [x]
diff --git a/data/fourmolu/indentation/output-3-indent_wheres.hs b/data/fourmolu/indentation/output-3-indent_wheres.hs
--- a/data/fourmolu/indentation/output-3-indent_wheres.hs
+++ b/data/fourmolu/indentation/output-3-indent_wheres.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 module Foo (
    asdf,
    bar,
@@ -21,3 +23,7 @@
 
 class Foo a where
    foo :: a -> Int
+
+pattern HeadC x <- x : xs
+   where
+      HeadC x = [x]
diff --git a/data/fourmolu/indentation/output-3.hs b/data/fourmolu/indentation/output-3.hs
--- a/data/fourmolu/indentation/output-3.hs
+++ b/data/fourmolu/indentation/output-3.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 module Foo (
    asdf,
    bar,
@@ -21,3 +23,7 @@
 
 class Foo a where
    foo :: a -> Int
+
+pattern HeadC x <- x : xs
+  where
+   HeadC x = [x]
diff --git a/data/fourmolu/indentation/output-4-indent_wheres.hs b/data/fourmolu/indentation/output-4-indent_wheres.hs
--- a/data/fourmolu/indentation/output-4-indent_wheres.hs
+++ b/data/fourmolu/indentation/output-4-indent_wheres.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 module Foo (
     asdf,
     bar,
@@ -21,3 +23,7 @@
 
 class Foo a where
     foo :: a -> Int
+
+pattern HeadC x <- x : xs
+    where
+        HeadC x = [x]
diff --git a/data/fourmolu/indentation/output-4.hs b/data/fourmolu/indentation/output-4.hs
--- a/data/fourmolu/indentation/output-4.hs
+++ b/data/fourmolu/indentation/output-4.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 module Foo (
     asdf,
     bar,
@@ -21,3 +23,7 @@
 
 class Foo a where
     foo :: a -> Int
+
+pattern HeadC x <- x : xs
+  where
+    HeadC x = [x]
diff --git a/data/fourmolu/record-style/input.hs b/data/fourmolu/record-style/input.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/record-style/input.hs
@@ -0,0 +1,24 @@
+data Foo = Foo
+  { a :: Int
+  , b :: Int
+  , c :: Int
+  }
+
+-- Test nesting
+data Client = PremiumClient { name :: String,
+    address :: String, aFieldWithAnUnneccessarilyLongFieldName :: String }
+  -- And some comment here as well
+  | NotSoPremiumClient { name :: String,
+    address :: String, aFieldWithAnUnneccessarilyLongFieldName :: String }
+
+x :: Foo -> [Int]
+x Foo{ a = possiblyLongName,
+    b = anotherLongName,
+    c = longNameAsWell
+    } = [possiblyLongName, anotherLongName, longNameAsWell]
+
+y :: Int -> Int -> Int -> Foo
+y possiblyLongName anotherLongName longNameAsWell = Foo{ a = possiblyLongName,
+    b = anotherLongName,
+    c = longNameAsWell
+  }
diff --git a/data/fourmolu/record-style/output-aligned-leading.hs b/data/fourmolu/record-style/output-aligned-leading.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/record-style/output-aligned-leading.hs
@@ -0,0 +1,35 @@
+data Foo = Foo
+    { a :: Int
+    , b :: Int
+    , c :: Int
+    }
+
+-- Test nesting
+data Client
+    = PremiumClient
+        { name :: String
+        , address :: String
+        , aFieldWithAnUnneccessarilyLongFieldName :: String
+        }
+    | -- And some comment here as well
+      NotSoPremiumClient
+        { name :: String
+        , address :: String
+        , aFieldWithAnUnneccessarilyLongFieldName :: String
+        }
+
+x :: Foo -> [Int]
+x
+    Foo
+        { a = possiblyLongName
+        , b = anotherLongName
+        , c = longNameAsWell
+        } = [possiblyLongName, anotherLongName, longNameAsWell]
+
+y :: Int -> Int -> Int -> Foo
+y possiblyLongName anotherLongName longNameAsWell =
+    Foo
+        { a = possiblyLongName
+        , b = anotherLongName
+        , c = longNameAsWell
+        }
diff --git a/data/fourmolu/record-style/output-aligned-trailing.hs b/data/fourmolu/record-style/output-aligned-trailing.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/record-style/output-aligned-trailing.hs
@@ -0,0 +1,35 @@
+data Foo = Foo
+    { a :: Int,
+      b :: Int,
+      c :: Int
+    }
+
+-- Test nesting
+data Client
+    = PremiumClient
+        { name :: String,
+          address :: String,
+          aFieldWithAnUnneccessarilyLongFieldName :: String
+        }
+    | -- And some comment here as well
+      NotSoPremiumClient
+        { name :: String,
+          address :: String,
+          aFieldWithAnUnneccessarilyLongFieldName :: String
+        }
+
+x :: Foo -> [Int]
+x
+    Foo
+        { a = possiblyLongName,
+          b = anotherLongName,
+          c = longNameAsWell
+        } = [possiblyLongName, anotherLongName, longNameAsWell]
+
+y :: Int -> Int -> Int -> Foo
+y possiblyLongName anotherLongName longNameAsWell =
+    Foo
+        { a = possiblyLongName,
+          b = anotherLongName,
+          c = longNameAsWell
+        }
diff --git a/data/fourmolu/record-style/output-knr-leading.hs b/data/fourmolu/record-style/output-knr-leading.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/record-style/output-knr-leading.hs
@@ -0,0 +1,35 @@
+data Foo = Foo {
+    a :: Int
+    , b :: Int
+    , c :: Int
+    }
+
+-- Test nesting
+data Client
+    = PremiumClient {
+        name :: String
+        , address :: String
+        , aFieldWithAnUnneccessarilyLongFieldName :: String
+        }
+    | -- And some comment here as well
+      NotSoPremiumClient {
+        name :: String
+        , address :: String
+        , aFieldWithAnUnneccessarilyLongFieldName :: String
+        }
+
+x :: Foo -> [Int]
+x
+    Foo {
+        a = possiblyLongName
+        , b = anotherLongName
+        , c = longNameAsWell
+        } = [possiblyLongName, anotherLongName, longNameAsWell]
+
+y :: Int -> Int -> Int -> Foo
+y possiblyLongName anotherLongName longNameAsWell =
+    Foo {
+        a = possiblyLongName
+        , b = anotherLongName
+        , c = longNameAsWell
+        }
diff --git a/data/fourmolu/record-style/output-knr-trailing.hs b/data/fourmolu/record-style/output-knr-trailing.hs
new file mode 100644
--- /dev/null
+++ b/data/fourmolu/record-style/output-knr-trailing.hs
@@ -0,0 +1,35 @@
+data Foo = Foo {
+    a :: Int,
+    b :: Int,
+    c :: Int
+}
+
+-- Test nesting
+data Client
+    = PremiumClient {
+        name :: String,
+        address :: String,
+        aFieldWithAnUnneccessarilyLongFieldName :: String
+    }
+    | -- And some comment here as well
+      NotSoPremiumClient {
+        name :: String,
+        address :: String,
+        aFieldWithAnUnneccessarilyLongFieldName :: String
+    }
+
+x :: Foo -> [Int]
+x
+    Foo {
+        a = possiblyLongName,
+        b = anotherLongName,
+        c = longNameAsWell
+    } = [possiblyLongName, anotherLongName, longNameAsWell]
+
+y :: Int -> Int -> Int -> Foo
+y possiblyLongName anotherLongName longNameAsWell =
+    Foo {
+        a = possiblyLongName,
+        b = anotherLongName,
+        c = longNameAsWell
+    }
diff --git a/data/fourmolu/sort-deriving-clauses/input.hs b/data/fourmolu/sort-deriving-clauses/input.hs
--- a/data/fourmolu/sort-deriving-clauses/input.hs
+++ b/data/fourmolu/sort-deriving-clauses/input.hs
@@ -7,6 +7,6 @@
   deriving (ToJSON)
 
 data B 
-  -- A comment that will end up in an odd place
+  -- A comment that will stay above Show
   deriving stock (Show)
   deriving (Eq)
diff --git a/data/fourmolu/sort-deriving-clauses/output-False.hs b/data/fourmolu/sort-deriving-clauses/output-False.hs
--- a/data/fourmolu/sort-deriving-clauses/output-False.hs
+++ b/data/fourmolu/sort-deriving-clauses/output-False.hs
@@ -7,6 +7,6 @@
     deriving (ToJSON)
 
 data B
-    -- A comment that will end up in an odd place
+    -- A comment that will stay above Show
     deriving stock (Show)
     deriving (Eq)
diff --git a/data/fourmolu/sort-deriving-clauses/output-True.hs b/data/fourmolu/sort-deriving-clauses/output-True.hs
--- a/data/fourmolu/sort-deriving-clauses/output-True.hs
+++ b/data/fourmolu/sort-deriving-clauses/output-True.hs
@@ -7,7 +7,6 @@
     deriving newtype (Num)
 
 data B
-    -- A comment that will end up in an odd place
-
     deriving (Eq)
+    -- A comment that will stay above Show
     deriving stock (Show)
diff --git a/data/fourmolu/trailing-section-operators/output-True.hs b/data/fourmolu/trailing-section-operators/output-True.hs
--- a/data/fourmolu/trailing-section-operators/output-True.hs
+++ b/data/fourmolu/trailing-section-operators/output-True.hs
@@ -3,11 +3,11 @@
 someShortFunction $ someShortFunction $ \x -> do
     putStrLn x
 
-someLongFunction $
-    someLongFunction $
-        someLongFunction $
-            someLongFunction $
-                someLongFunction x
+someLongFunction
+    $ someLongFunction
+    $ someLongFunction
+    $ someLongFunction
+    $ someLongFunction x
 
 someLongFunction $
     someLongFunction $
diff --git a/data/fourmolu/unicode-syntax/output-always.hs b/data/fourmolu/unicode-syntax/output-always.hs
--- a/data/fourmolu/unicode-syntax/output-always.hs
+++ b/data/fourmolu/unicode-syntax/output-always.hs
@@ -55,8 +55,8 @@
 deconstruct (MkT1 x) = x
 
 pattern HeadC x ← x : xs
-    where
-        HeadC x = [x]
+  where
+    HeadC x = [x]
 
 pattern Point ∷ Int → Int → (Int, Int)
 pattern Point{x, y} = (x, y)
diff --git a/data/fourmolu/unicode-syntax/output-detect.hs b/data/fourmolu/unicode-syntax/output-detect.hs
--- a/data/fourmolu/unicode-syntax/output-detect.hs
+++ b/data/fourmolu/unicode-syntax/output-detect.hs
@@ -55,8 +55,8 @@
 deconstruct (MkT1 x) = x
 
 pattern HeadC x ← x : xs
-    where
-        HeadC x = [x]
+  where
+    HeadC x = [x]
 
 pattern Point ∷ Int → Int → (Int, Int)
 pattern Point{x, y} = (x, y)
diff --git a/data/fourmolu/unicode-syntax/output-never.hs b/data/fourmolu/unicode-syntax/output-never.hs
--- a/data/fourmolu/unicode-syntax/output-never.hs
+++ b/data/fourmolu/unicode-syntax/output-never.hs
@@ -55,8 +55,8 @@
 deconstruct (MkT1 x) = x
 
 pattern HeadC x <- x : xs
-    where
-        HeadC x = [x]
+  where
+    HeadC x = [x]
 
 pattern Point :: Int -> Int -> (Int, Int)
 pattern Point{x, y} = (x, y)
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/fixity-tests/test-1-no-extra-info-expected.hs b/fixity-tests/test-1-no-extra-info-expected.hs
--- a/fixity-tests/test-1-no-extra-info-expected.hs
+++ b/fixity-tests/test-1-no-extra-info-expected.hs
@@ -1,12 +1,12 @@
 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
+      # []
diff --git a/fixity-tests/test-1-with-fixity-info-expected.hs b/fixity-tests/test-1-with-fixity-info-expected.hs
--- a/fixity-tests/test-1-with-fixity-info-expected.hs
+++ b/fixity-tests/test-1-with-fixity-info-expected.hs
@@ -1,9 +1,9 @@
 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
+      # []
diff --git a/fourmolu.cabal b/fourmolu.cabal
--- a/fourmolu.cabal
+++ b/fourmolu.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.4
 name: fourmolu
-version: 0.19.0.1
+version: 0.21.0.0
 license: BSD-3-Clause
 license-file: LICENSE.md
 maintainer:
@@ -8,9 +8,9 @@
     George Thomas <georgefsthomas@gmail.com>
     Brandon Chinn <brandonchinn178@gmail.com>
 tested-with:
-  ghc ==9.8.4
-  ghc ==9.10.1
-  ghc ==9.12.1
+  ghc ==9.10.3
+  ghc ==9.12.4
+  ghc ==9.14.1
 
 homepage: https://github.com/fourmolu/fourmolu
 bug-reports: https://github.com/fourmolu/fourmolu/issues
@@ -44,6 +44,9 @@
 library
   exposed-modules:
     Ormolu
+    Ormolu.Comments.Anchor
+    Ormolu.Comments.Invariants
+    Ormolu.Comments.Tree
     Ormolu.Config
     Ormolu.Diff.ParseResult
     Ormolu.Diff.Text
@@ -60,6 +63,7 @@
     Ormolu.Parser.Result
     Ormolu.Printer
     Ormolu.Printer.Combinators
+    Ormolu.Printer.CommentPlacement
     Ormolu.Printer.Comments
     Ormolu.Printer.Internal
     Ormolu.Printer.Meat.Common
@@ -84,8 +88,8 @@
     Ormolu.Printer.Meat.Module
     Ormolu.Printer.Meat.Pragma
     Ormolu.Printer.Meat.Type
+    Ormolu.Printer.Meat.Type.Function
     Ormolu.Printer.Operators
-    Ormolu.Printer.SpanStream
     Ormolu.Processing.Common
     Ormolu.Processing.Cpp
     Ormolu.Processing.Preprocess
@@ -100,8 +104,8 @@
   other-modules: GHC.DynFlags
   default-language: GHC2021
   build-depends:
-    Cabal-syntax >=3.14 && <3.15,
-    Diff >=0.4 && <2,
+    Cabal-syntax >=3.16 && <3.17,
+    Diff >=0.4 && <2.0 || >=2.0.1 && <2.1,
     MemoTrie >=0.6 && <0.7,
     ansi-terminal >=0.10 && <1.2,
     array >=0.5 && <0.6,
@@ -109,11 +113,11 @@
     binary >=0.8 && <0.9,
     bytestring >=0.2 && <0.13,
     choice >=0.2.4.1 && <0.3,
-    containers >=0.5 && <0.8,
+    containers >=0.5 && <0.9,
     directory ^>=1.3,
     file-embed >=0.0.15 && <0.1,
     filepath >=1.2 && <1.6,
-    ghc-lib-parser >=9.12 && <9.13,
+    ghc-lib-parser >=9.14 && <9.15,
     megaparsec >=9,
     mtl >=2 && <3,
     syb >=0.7 && <0.8,
@@ -140,6 +144,8 @@
       -Wredundant-constraints
       -Wpartial-fields
       -Wunused-packages
+      -haddock
+      -Winvalid-haddock
   else
     ghc-options:
       -O2
@@ -152,13 +158,13 @@
   autogen-modules: Paths_fourmolu
   default-language: GHC2021
   build-depends:
-    Cabal-syntax >=3.14 && <3.15,
+    Cabal-syntax >=3.16 && <3.17,
     base >=4.12 && <5,
-    containers >=0.5 && <0.8,
+    containers >=0.5 && <0.9,
     directory ^>=1.3,
     filepath >=1.2 && <1.6,
-    ghc-lib-parser >=9.12 && <9.13,
-    optparse-applicative >=0.14 && <0.19,
+    ghc-lib-parser >=9.14 && <9.15,
+    optparse-applicative >=0.14 && <0.20,
     text >=2.1 && <3,
     th-env >=0.1.1 && <0.2,
     unliftio >=0.2.10 && <0.3,
@@ -186,6 +192,8 @@
       -Wpartial-fields
       -Wunused-packages
       -Wwarn=unused-packages
+      -haddock
+      -Winvalid-haddock
   else
     ghc-options:
       -O2
@@ -198,6 +206,7 @@
   hs-source-dirs: tests
   other-modules:
     Ormolu.CabalInfoSpec
+    Ormolu.Comments.AnchorSpec
     Ormolu.Diff.TextSpec
     Ormolu.Fixity.ParserSpec
     Ormolu.Fixity.PrinterSpec
@@ -207,17 +216,18 @@
     Ormolu.Parser.ParseFailureSpec
     Ormolu.Parser.PragmaSpec
     Ormolu.PrinterSpec
+    Ormolu.TestConfig
 
   default-language: GHC2021
   build-depends:
-    Cabal-syntax >=3.14 && <3.15,
+    Cabal-syntax >=3.16 && <3.17,
     QuickCheck >=2.14,
     base >=4.14 && <5,
     choice >=0.2.4.1 && <0.3,
-    containers >=0.5 && <0.8,
+    containers >=0.5 && <0.9,
     directory ^>=1.3,
     filepath >=1.2 && <1.6,
-    ghc-lib-parser >=9.12 && <9.13,
+    ghc-lib-parser >=9.14 && <9.15,
     hspec >=2 && <3,
     hspec-megaparsec >=2.2,
     megaparsec >=9,
@@ -252,6 +262,8 @@
       -Wredundant-constraints
       -Wpartial-fields
       -Wunused-packages
+      -haddock
+      -Winvalid-haddock
   else
     ghc-options:
       -O2
diff --git a/fourmolu.yaml b/fourmolu.yaml
--- a/fourmolu.yaml
+++ b/fourmolu.yaml
@@ -5,12 +5,13 @@
 column-limit: none
 function-arrows: trailing
 comma-style: trailing
+record-style: aligned
 import-export-style: trailing
 import-grouping: legacy
 indent-wheres: true
 record-brace-space: true
 newlines-between-decls: 1
-haddock-style: single-line
+haddock-style: auto
 haddock-style-module: null
 haddock-location-signature: auto
 let-style: inline
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,
@@ -47,6 +47,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
@@ -55,9 +56,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
@@ -73,12 +76,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
@@ -113,15 +116,44 @@
         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 $ cfgPrinterOpts cfgWithIndices
+  -- 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
+          (cfgPrinterOpts cfgWithIndices)
+          (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
@@ -144,7 +176,11 @@
     -- 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 $ cfgPrinterOpts cfgWithIndices
+      let reformattedText =
+            printSnippets
+              (cfgPrinterOpts cfgWithIndices)
+              (Choice.fromBool (cfgDebug cfg))
+              result1
        in case diffText formattedText reformattedText path of
             Nothing -> return ()
             Just diff -> throwIO (OrmoluNonIdempotentOutput diff)
@@ -181,11 +217,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
@@ -35,6 +35,7 @@
     fillMissingPrinterOpts,
     resolvePrinterOpts,
     CommaStyle (..),
+    RecordStyle (..),
     FunctionArrowsStyle (..),
     HaddockPrintStyle (..),
     HaddockPrintStyleModule (..),
@@ -43,12 +44,13 @@
     ImportGrouping (..),
     ImportGroup (..),
     ImportGroupRule (..),
-    ImportModuleMatcher (..),
     ImportRulePriority (..),
     matchAllRulePriority,
     matchLocalRulePriority,
     defaultImportRulePriority,
+    ImportListMatcher (..),
     QualifiedImportMatcher (..),
+    ImportScopeMatcher (..),
     LetStyle (..),
     InStyle (..),
     IfStyle (..),
@@ -111,7 +113,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),
@@ -119,9 +122,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/Config/Gen.hs b/src/Ormolu/Config/Gen.hs
--- a/src/Ormolu/Config/Gen.hs
+++ b/src/Ormolu/Config/Gen.hs
@@ -1,5 +1,5 @@
 {- FOURMOLU_DISABLE -}
-{- ***** DO NOT EDIT: This module is autogenerated ***** -}
+{- DO NOT EDIT: This module is autogenerated -}
 
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
@@ -9,6 +9,7 @@
 module Ormolu.Config.Gen
   ( PrinterOpts (..)
   , CommaStyle (..)
+  , RecordStyle (..)
   , FunctionArrowsStyle (..)
   , HaddockPrintStyle (..)
   , HaddockPrintStyleModule (..)
@@ -54,6 +55,8 @@
       poFunctionArrows :: f FunctionArrowsStyle
     , -- | How to place commas in multi-line lists, records, etc.
       poCommaStyle :: f CommaStyle
+    , -- | How to place braces in records
+      poRecordStyle :: f RecordStyle
     , -- | Styling of import/export lists
       poImportExportStyle :: f ImportExportStyle
     , -- | Rules for grouping import declarations
@@ -102,6 +105,7 @@
     , poColumnLimit = Nothing
     , poFunctionArrows = Nothing
     , poCommaStyle = Nothing
+    , poRecordStyle = Nothing
     , poImportExportStyle = Nothing
     , poImportGrouping = Nothing
     , poIndentWheres = Nothing
@@ -130,6 +134,7 @@
     , poColumnLimit = pure NoLimit
     , poFunctionArrows = pure TrailingArrows
     , poCommaStyle = pure Leading
+    , poRecordStyle = pure RecordStyleAligned
     , poImportExportStyle = pure ImportExportDiffFriendly
     , poImportGrouping = pure ImportGroupLegacy
     , poIndentWheres = pure False
@@ -165,6 +170,7 @@
     , poColumnLimit = maybe (poColumnLimit p2) pure (poColumnLimit p1)
     , poFunctionArrows = maybe (poFunctionArrows p2) pure (poFunctionArrows p1)
     , poCommaStyle = maybe (poCommaStyle p2) pure (poCommaStyle p1)
+    , poRecordStyle = maybe (poRecordStyle p2) pure (poRecordStyle p1)
     , poImportExportStyle = maybe (poImportExportStyle p2) pure (poImportExportStyle p1)
     , poImportGrouping = maybe (poImportGrouping p2) pure (poImportGrouping p1)
     , poIndentWheres = maybe (poIndentWheres p2) pure (poIndentWheres p1)
@@ -209,6 +215,10 @@
       "How to place commas in multi-line lists, records, etc. (choices: \"leading\" or \"trailing\") (default: leading)"
       "OPTION"
     <*> f
+      "record-style"
+      "How to place braces in records (choices: \"aligned\" or \"knr\") (default: aligned)"
+      "OPTION"
+    <*> f
       "import-export-style"
       "Styling of import/export lists (choices: \"leading\", \"trailing\", or \"diff-friendly\") (default: diff-friendly)"
       "OPTION"
@@ -230,7 +240,7 @@
       "INT"
     <*> f
       "haddock-style"
-      "How to print Haddock comments (choices: \"single-line\", \"multi-line\", or \"multi-line-compact\") (default: multi-line)"
+      "How to print Haddock comments (choices: \"single-line\", \"multi-line\", \"multi-line-compact\", or \"auto\") (default: multi-line)"
       "OPTION"
     <*> f
       "haddock-style-module"
@@ -295,6 +305,7 @@
     <*> f "column-limit"
     <*> f "function-arrows"
     <*> f "comma-style"
+    <*> f "record-style"
     <*> f "import-export-style"
     <*> f "import-grouping"
     <*> f "indent-wheres"
@@ -348,6 +359,11 @@
   | Trailing
   deriving (Eq, Show, Enum, Bounded)
 
+data RecordStyle
+  = RecordStyleAligned
+  | RecordStyleKnr
+  deriving (Eq, Show, Enum, Bounded)
+
 data FunctionArrowsStyle
   = TrailingArrows
   | LeadingArrows
@@ -358,6 +374,7 @@
   = HaddockSingleLine
   | HaddockMultiLine
   | HaddockMultiLineCompact
+  | HaddockAuto
   deriving (Eq, Show, Enum, Bounded)
 
 data HaddockPrintStyleModule
@@ -450,6 +467,28 @@
     Leading -> "leading"
     Trailing -> "trailing"
 
+instance Aeson.FromJSON RecordStyle where
+  parseJSON =
+    Aeson.withText "RecordStyle" $ \s ->
+      either Aeson.parseFail pure $
+        parsePrinterOptType (Text.unpack s)
+
+instance PrinterOptsFieldType RecordStyle where
+  parsePrinterOptType s =
+    case s of
+      "aligned" -> Right RecordStyleAligned
+      "knr" -> Right RecordStyleKnr
+      _ ->
+        Left . unlines $
+          [ "unknown value: " <> show s
+          , "Valid values are: \"aligned\" or \"knr\""
+          ]
+
+instance RenderPrinterOpt RecordStyle where
+  renderPrinterOpt = \case
+    RecordStyleAligned -> "aligned"
+    RecordStyleKnr -> "knr"
+
 instance Aeson.FromJSON FunctionArrowsStyle where
   parseJSON =
     Aeson.withText "FunctionArrowsStyle" $ \s ->
@@ -486,10 +525,11 @@
       "single-line" -> Right HaddockSingleLine
       "multi-line" -> Right HaddockMultiLine
       "multi-line-compact" -> Right HaddockMultiLineCompact
+      "auto" -> Right HaddockAuto
       _ ->
         Left . unlines $
           [ "unknown value: " <> show s
-          , "Valid values are: \"single-line\", \"multi-line\", or \"multi-line-compact\""
+          , "Valid values are: \"single-line\", \"multi-line\", \"multi-line-compact\", or \"auto\""
           ]
 
 instance RenderPrinterOpt HaddockPrintStyle where
@@ -497,6 +537,7 @@
     HaddockSingleLine -> "single-line"
     HaddockMultiLine -> "multi-line"
     HaddockMultiLineCompact -> "multi-line-compact"
+    HaddockAuto -> "auto"
 
 instance Aeson.FromJSON HaddockPrintStyleModule where
   parseJSON =
@@ -777,6 +818,9 @@
     , "# How to place commas in multi-line lists, records, etc. (choices: leading or trailing)"
     , "comma-style: leading"
     , ""
+    , "# How to place braces in records (choices: aligned or knr)"
+    , "record-style: aligned"
+    , ""
     , "# Styling of import/export lists (choices: leading, trailing, or diff-friendly)"
     , "import-export-style: diff-friendly"
     , ""
@@ -792,7 +836,7 @@
     , "# Number of spaces between top-level declarations"
     , "newlines-between-decls: 1"
     , ""
-    , "# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)"
+    , "# How to print Haddock comments (choices: single-line, multi-line, multi-line-compact, or auto)"
     , "haddock-style: multi-line"
     , ""
     , "# How to print module docstring"
diff --git a/src/Ormolu/Config/Types.hs b/src/Ormolu/Config/Types.hs
--- a/src/Ormolu/Config/Types.hs
+++ b/src/Ormolu/Config/Types.hs
@@ -1,20 +1,22 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module Ormolu.Config.Types
   ( ImportGroup (..),
     ImportGroupRule (..),
-    ImportModuleMatcher (..),
     ImportRulePriority (..),
     matchAllRulePriority,
     matchLocalRulePriority,
     defaultImportRulePriority,
+    ImportListMatcher (..),
     QualifiedImportMatcher (..),
+    ImportScopeMatcher (..),
   )
 where
 
-import Control.Applicative (Alternative (..), asum)
-import Data.Aeson ((.!=), (.:), (.:?))
+import Control.Applicative (Alternative (..))
+import Data.Aeson ((.!=), (.:?))
 import Data.Aeson qualified as Aeson
 import Data.Aeson.Types qualified as Aeson
 import Data.List.NonEmpty (NonEmpty)
@@ -34,28 +36,47 @@
       <*> Aeson.parseField o "rules"
 
 data ImportGroupRule = ImportGroupRule
-  { igrModuleMatcher :: !ImportModuleMatcher,
+  { igrGlob :: !Glob,
+    igrImportListMatcher :: !ImportListMatcher,
     igrQualifiedMatcher :: !QualifiedImportMatcher,
+    igrScopeMatcher :: !ImportScopeMatcher,
     igrPriority :: !ImportRulePriority
   }
   deriving (Eq, Show)
 
 instance Aeson.FromJSON ImportGroupRule where
   parseJSON = Aeson.withObject "rule" $ \o -> do
-    let parseModuleMatcher = Aeson.parseJSON (Aeson.Object o)
-        failUnknownModuleMatcher = Aeson.parseFail "Unknown or invalid module matcher"
-        attemptParseModuleMatcher = parseModuleMatcher <|> failUnknownModuleMatcher
-    igrModuleMatcher <- attemptParseModuleMatcher
+    legacyMatch <- o .:? "match"
+    (defaultPriority, defaultScope) <- case legacyMatch of
+      Just "all" -> pure (matchAllRulePriority, pure MatchAllModules)
+      Just "local-modules" -> pure (matchLocalRulePriority, pure MatchLocalModules)
+      Just other -> Aeson.parseFail $ "Unknown legacy match value: " <> other
+      Nothing -> pure (defaultImportRulePriority, empty)
 
-    qualified <- o .:? "qualified"
-    igrQualifiedMatcher <- case qualified of
-      Just True -> pure MatchQualifiedOnly
-      Just False -> pure MatchUnqualifiedOnly
-      Nothing -> pure MatchBothQualifiedAndUnqualified
+    igrGlob <- mkGlob <$> o .:? "glob" .!= "**"
 
-    let defaultPriority
-          | MatchAllModules <- igrModuleMatcher = matchAllRulePriority
-          | otherwise = defaultImportRulePriority
+    igrImportListMatcher <-
+      o .:? "import-list" .!= "any" >>= \case
+        "any" -> pure MatchAnyImportDeclaration
+        "explicit" -> pure MatchExplicitImportList
+        "hiding" -> pure MatchHidingImportClause
+        "none" -> pure MatchWholeModuleImport
+        other -> Aeson.parseFail $ "Unknown import list matcher: " <> other
+
+    igrQualifiedMatcher <-
+      o .:? "qualified" >>= \case
+        Just True -> pure MatchQualifiedOnly
+        Just False -> pure MatchUnqualifiedOnly
+        Nothing -> pure MatchBothQualifiedAndUnqualified
+
+    igrScopeMatcher <-
+      o .:? "scope" >>= \case
+        Just "any" -> pure MatchAllModules
+        Just "local" -> pure MatchLocalModules
+        Just "external" -> pure MatchExternalModules
+        Nothing -> defaultScope <|> pure MatchAllModules
+        Just other -> Aeson.parseFail ("Unknown scope matcher: " <> other)
+
     igrPriority <- o .:? "priority" .!= defaultPriority
 
     pure ImportGroupRule {..}
@@ -75,35 +96,21 @@
 defaultImportRulePriority :: ImportRulePriority
 defaultImportRulePriority = ImportRulePriority 50
 
+data ImportListMatcher
+  = MatchExplicitImportList
+  | MatchHidingImportClause
+  | MatchWholeModuleImport
+  | MatchAnyImportDeclaration
+  deriving (Eq, Show)
+
 data QualifiedImportMatcher
   = MatchQualifiedOnly
   | MatchUnqualifiedOnly
   | MatchBothQualifiedAndUnqualified
   deriving (Eq, Show)
 
-data ImportModuleMatcher
-  = MatchAllModules
+data ImportScopeMatcher
+  = MatchExternalModules
   | MatchLocalModules
-  | MatchGlob !Glob
+  | MatchAllModules
   deriving (Eq, Show)
-
-instance Aeson.FromJSON ImportModuleMatcher where
-  parseJSON v =
-    asum
-      [ parseMatchModuleMatcher v,
-        parseGlobModuleMatcher v
-      ]
-    where
-      parseMatchModuleMatcher :: Aeson.Value -> Aeson.Parser ImportModuleMatcher
-      parseMatchModuleMatcher = Aeson.withObject "ImportModuleMatcher" $ \o -> do
-        c <- Aeson.parseField @String o "match"
-        case c of
-          "all" -> pure MatchAllModules
-          "local-modules" -> pure MatchLocalModules
-          other -> Aeson.parseFail $ "Unknown matcher: " <> other
-
-      parseGlobModuleMatcher :: Aeson.Value -> Aeson.Parser ImportModuleMatcher
-      parseGlobModuleMatcher = Aeson.withObject "ImportModuleMatcher" $ \o -> do
-        rawGlob <- o .: "glob"
-        let glob = mkGlob rawGlob
-        pure (MatchGlob glob)
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
@@ -2,6 +2,8 @@
 {-# LANGUAGE DeepSubsumption #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -9,15 +11,17 @@
 module Ormolu.Diff.ParseResult
   ( ParseResultDiff (..),
     diffParseResult,
+    diffCommentStream,
   )
 where
 
 import Data.ByteString (ByteString)
 import Data.Char (isSpace)
+import Data.Choice (pattern Without)
 import Data.Foldable
 import Data.Function
 import Data.Generics
-import Data.List (sortOn)
+import Data.List (sort, sortOn)
 import Data.Text qualified as T
 import GHC.Data.FastString (FastString)
 import GHC.Hs
@@ -25,6 +29,7 @@
 import GHC.Types.SrcLoc
 import Ormolu.Config.Gen (ImportGrouping (ImportGroupSingle))
 import Ormolu.Imports (normalizeImports)
+import Ormolu.Imports.Grouping (GroupImportsOpts (..))
 import Ormolu.Parser.CommentStream
 import Ormolu.Parser.Result
 import Ormolu.Utils
@@ -46,7 +51,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 ->
@@ -62,15 +72,50 @@
     } =
     diffCommentStream cstream0 cstream1
       <> diffHsModule
-        hs0 {hsmodImports = concat . normalizeImports False mempty ImportGroupSingle $ hsmodImports hs0}
-        hs1 {hsmodImports = concat . normalizeImports False mempty ImportGroupSingle $ hsmodImports hs1}
+        hs0 {hsmodImports = concat $ normalizeImports' hs0}
+        hs1 {hsmodImports = concat $ normalizeImports' hs1}
+    where
+      -- The exact parameters here don't matter, it just needs to be consistent
+      normalizeImports' hsmod =
+        normalizeImports
+          GroupImportsOpts
+            { grouping = ImportGroupSingle,
+              respectful = False,
+              allComments = listify (const True) hsmod
+            }
+          mempty
+          (Without #implicitPrelude)
+          (hsmodImports hsmod)
 
+-- | 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 certain semantically
 -- irrelevant features like exact print annotations.
@@ -106,11 +151,13 @@
                   `extQ` considerEqual @EpLayout
                   `extQ` considerEqual @AnnSig
                   `extQ` considerEqual @HsRuleAnn
-                  `extQ` considerEqual @EpLinearArrow
+                  `extQ` considerEqual @EpLinear
                   `extQ` considerEqual @AnnSynDecl
                   `extQ` considerEqual @IsUnicodeSyntax
                   -- 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
@@ -170,14 +217,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` (map (T.dropWhile isSpace) . splitDocString True))
+    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
@@ -53,7 +53,7 @@
   Binary.runGet Binary.get $
     BL.fromStrict $(embedFile "extract-hackage-info/hackage-info.bin")
 
--- | 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
@@ -74,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
 
@@ -125,10 +125,10 @@
 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 :: Double,
-    -- | Maximum precedence level found in the (maybe conflicting)
+    -- | Maximum precedence level found in the (possibly conflicting)
     -- definitions for the operator (inclusive)
     faMaxPrecedence :: Double
   }
@@ -146,8 +146,8 @@
     faMaxPrecedence <- Binary.getDoublele
     pure FixityApproximation {..}
 
--- | Gives the ability to merge two (maybe conflicting) definitions for an
--- operator, keeping the higher level of compatible information from both.
+-- | 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} =
@@ -190,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))
   }
@@ -198,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/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,6 +13,8 @@
 
 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)
@@ -27,31 +29,46 @@
 import GHC.Types.PkgQual
 import GHC.Types.SourceText
 import GHC.Types.SrcLoc
-import Ormolu.Config (ImportGrouping)
-import Ormolu.Imports.Grouping (Import (..), groupImports, prepareExistingGroups)
+import Ormolu.Imports.Grouping
+  ( GroupImportsOpts,
+    Import (..),
+    ImportList (..),
+    groupImports,
+    prepareExistingGroups,
+  )
 import Ormolu.Utils (notImplemented, showOutputable)
-#if !MIN_VERSION_base(4,20,0)
-import Data.List (foldl')
-#endif
 
 -- | Sort, group and normalize imports.
 --
 -- Assumes input list is sorted by source location. Output list is not necessarily
 -- sorted by source location, so this function should be called at most once on a
 -- given input list.
-normalizeImports :: Bool -> Set Cabal.ModuleName -> ImportGrouping -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]
-normalizeImports respectful localModules importGrouping =
+normalizeImports ::
+  GroupImportsOpts ->
+  Set Cabal.ModuleName ->
+  Choice "implicitPrelude" ->
+  [LImportDecl GhcPs] ->
+  [[LImportDecl GhcPs]]
+normalizeImports groupImportsOpts localModules implicitPrelude =
   map (fmap snd)
     . concatMap
-      ( groupImports importGrouping localModules toImport
+      ( groupImports groupImportsOpts localModules toImport
           . M.toAscList
           . M.fromListWith combineImports
-          . fmap (\x -> (importId x, g x))
+          . fmap (\x -> (importId implicitPrelude x, g x))
       )
-    . prepareExistingGroups importGrouping respectful
+    . prepareExistingGroups groupImportsOpts
   where
     toImport :: (ImportId, x) -> Import
-    toImport (ImportId {..}, _) = Import {importName = importIdName, importQualified}
+    toImport (ImportId {..}, _) =
+      Import
+        { importName = importIdName,
+          importList = case importHiding of
+            Just (ImportListInterpretationOrd Exactly) -> Just ImportList
+            Just (ImportListInterpretationOrd EverythingBut) -> Just HidingList
+            Nothing -> Nothing,
+          importQualified
+        }
 
     g :: LImportDecl GhcPs -> LImportDecl GhcPs
     g (L l ImportDecl {..}) =
@@ -68,20 +85,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,
@@ -90,10 +128,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
@@ -124,8 +175,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,
@@ -137,11 +188,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]
@@ -221,7 +278,7 @@
 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 = (comparing fst <> (compareRdrName `on` unLoc . snd)) `on` classify
   where
@@ -231,6 +288,7 @@
       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/Imports/Grouping.hs b/src/Ormolu/Imports/Grouping.hs
--- a/src/Ormolu/Imports/Grouping.hs
+++ b/src/Ormolu/Imports/Grouping.hs
@@ -1,8 +1,12 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoFieldSelectors #-}
 
 module Ormolu.Imports.Grouping
   ( Import (..),
+    ImportList (..),
+    GroupImportsOpts (..),
     prepareExistingGroups,
     groupImports,
   )
@@ -14,23 +18,32 @@
 import Data.List (groupBy, minimumBy, sortOn)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty
+import Data.Map qualified as Map
+import Data.Maybe (fromMaybe)
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Distribution.ModuleName qualified as Cabal
-import GHC.Hs (GhcPs, getLocA)
+import GHC.Hs (GhcPs, LEpaComment, epaLocationRealSrcSpan, getLocA)
+import GHC.Types.SrcLoc (getLoc, srcSpanEndLine, srcSpanStartLine, srcSpanToRealSrcSpan)
 import Language.Haskell.Syntax (LImportDecl, ModuleName, moduleNameString)
-import Ormolu.Config (ImportGroup (..), ImportGroupRule (..), ImportGrouping (..), ImportModuleMatcher (..))
+import Ormolu.Config (ImportGroup (..), ImportGroupRule (..), ImportGrouping (..))
 import Ormolu.Config qualified as Config
-import Ormolu.Utils (ghcModuleNameToCabal, groupBy', separatedByBlank)
-import Ormolu.Utils.Glob (matchesGlob)
+import Ormolu.Utils (ghcModuleNameToCabal, groupBy')
+import Ormolu.Utils.Glob (matchAllGlob, matchesGlob)
 
 newtype ImportGroups = ImportGroups (NonEmpty ImportGroup)
 
 data Import = Import
   { importName :: ModuleName,
+    importList :: Maybe ImportList,
     importQualified :: Bool
   }
 
+data ImportList
+  = ImportList
+  | HidingList
+  deriving (Eq)
+
 importGroupSingleStrategy :: ImportGroups
 importGroupSingleStrategy =
   ImportGroups $
@@ -94,16 +107,20 @@
 matchAllImportRule :: ImportGroupRule
 matchAllImportRule =
   ImportGroupRule
-    { igrModuleMatcher = MatchAllModules,
+    { igrGlob = matchAllGlob,
+      igrImportListMatcher = Config.MatchAnyImportDeclaration,
       igrQualifiedMatcher = Config.MatchBothQualifiedAndUnqualified,
+      igrScopeMatcher = Config.MatchAllModules,
       igrPriority = Config.matchAllRulePriority
     }
 
 matchLocalModulesRule :: ImportGroupRule
 matchLocalModulesRule =
   ImportGroupRule
-    { igrModuleMatcher = MatchLocalModules,
+    { igrGlob = matchAllGlob,
+      igrImportListMatcher = Config.MatchAnyImportDeclaration,
       igrQualifiedMatcher = Config.MatchBothQualifiedAndUnqualified,
+      igrScopeMatcher = Config.MatchLocalModules,
       igrPriority = Config.matchLocalRulePriority
     }
 
@@ -122,31 +139,78 @@
     }
 
 matchesRule :: Set Cabal.ModuleName -> Import -> ImportGroupRule -> Bool
-matchesRule localMods Import {..} ImportGroupRule {..} = matchesModules && matchesQualified
+matchesRule localMods Import {..} ImportGroupRule {..} =
+  and
+    [ matchingGlob,
+      matchingImportList,
+      matchingQualified,
+      matchingScope
+    ]
   where
-    matchesModules = case igrModuleMatcher of
-      MatchAllModules -> True
-      MatchLocalModules -> ghcModuleNameToCabal importName `Set.member` localMods
-      MatchGlob gl -> moduleNameString importName `matchesGlob` gl
-    matchesQualified = case igrQualifiedMatcher of
+    matchingGlob = moduleNameString importName `matchesGlob` igrGlob
+    matchingImportList = case igrImportListMatcher of
+      Config.MatchExplicitImportList -> importList == Just ImportList
+      Config.MatchHidingImportClause -> importList == Just HidingList
+      Config.MatchWholeModuleImport -> importList == Nothing
+      Config.MatchAnyImportDeclaration -> True
+    matchingQualified = case igrQualifiedMatcher of
       Config.MatchQualifiedOnly -> importQualified
       Config.MatchUnqualifiedOnly -> not importQualified
       Config.MatchBothQualifiedAndUnqualified -> True
+    matchingScope =
+      let isLocalModule = ghcModuleNameToCabal importName `Set.member` localMods
+       in case igrScopeMatcher of
+            Config.MatchAllModules -> True
+            Config.MatchExternalModules -> not isLocalModule
+            Config.MatchLocalModules -> isLocalModule
 
-prepareExistingGroups :: ImportGrouping -> Bool -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]
-prepareExistingGroups ig respectful =
-  case ig of
+data GroupImportsOpts = GroupImportsOpts
+  { grouping :: ImportGrouping,
+    respectful :: Bool,
+    -- | All comments in the HsModule.
+    --
+    -- Can't retrieve comments from 'R', since 'R' runs the first time without
+    -- comments.
+    allComments :: [LEpaComment]
+  }
+
+prepareExistingGroups :: GroupImportsOpts -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]
+prepareExistingGroups opts =
+  case opts.grouping of
     ImportGroupPreserve -> preserveGroups
-    ImportGroupLegacy | respectful -> preserveGroups
+    ImportGroupLegacy | opts.respectful -> preserveGroups
     _ -> flattenGroups
   where
-    preserveGroups = map toList . groupBy' (\x y -> not $ separatedByBlank getLocA x y)
+    preserveGroups = map toList . groupBy' (\x y -> not $ separatedByBlank' x y)
     flattenGroups = pure
 
-groupImports :: forall x. ImportGrouping -> Set Cabal.ModuleName -> (x -> Import) -> [x] -> [[x]]
-groupImports ig localModules fToImport = regroup . fmap (breakTies . matchRules)
+    -- separatedByBlank only checks if the span lines are more than 1 apart.
+    -- If there's a comment between two imports with no blank lines, we should
+    -- still consider it one import group.
+    separatedByBlank' a b =
+      fromMaybe False $ do
+        endA <- srcSpanEndLine <$> srcSpanToRealSrcSpan (getLocA a)
+        startB <- srcSpanStartLine <$> srcSpanToRealSrcSpan (getLocA b)
+        pure . any (not . hasComment) $ [endA + 1 .. startB - 1]
+
+    -- Maps startLine -> endLine
+    commentLineIntervals =
+      Map.fromList
+        [ (srcSpanStartLine spn, srcSpanEndLine spn)
+        | comment <- opts.allComments,
+          let spn = epaLocationRealSrcSpan $ getLoc comment
+        ]
+    hasComment lineNum =
+      (not . Map.null)
+        -- Find any comment where: startLine <= lineNum <= endLine
+        . Map.filter (>= lineNum)
+        . Map.takeWhileAntitone (<= lineNum)
+        $ commentLineIntervals
+
+groupImports :: forall x. GroupImportsOpts -> Set Cabal.ModuleName -> (x -> Import) -> [x] -> [[x]]
+groupImports opts localModules fToImport = regroup . fmap (breakTies . matchRules)
   where
-    ImportGroups igs = groupsFromConfig ig
+    ImportGroups igs = groupsFromConfig opts.grouping
 
     indexedGroupRules :: [(Int, [ImportGroupRule])]
     indexedGroupRules = zip [0 ..] (toList . igRules <$> toList igs)
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 #-}
@@ -18,6 +19,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.Functor.Identity (Identity (..))
 import Data.Generics hiding (orElse)
@@ -30,7 +33,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)
@@ -45,6 +48,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.Config.Gen (SingleConstraintParens (..))
@@ -91,8 +95,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 ->
@@ -144,20 +152,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 config -> hsModule)) ->
+        GHC.POk pstate (L _ (normalizeModule implicitPrelude config -> 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
@@ -166,6 +177,7 @@
                         prStackHeader = stackHeader,
                         prPragmas = pragmas,
                         prCommentStream = comments,
+                        prHaddockText = haddockText,
                         prExtensions = GHC.extensionFlags dynFlags,
                         prModuleFixityMap = modFixityMap,
                         prIndent = indent,
@@ -175,11 +187,16 @@
 
 -- | Normalize a 'HsModule' by sorting its export lists, dropping
 -- blank comments, etc.
-normalizeModule :: Config RegionDeltas -> HsModule GhcPs -> HsModule GhcPs
-normalizeModule Config {..} hsmod =
+normalizeModule ::
+  Choice "implicitPrelude" ->
+  Config RegionDeltas ->
+  HsModule GhcPs ->
+  HsModule GhcPs
+normalizeModule _ Config {..} hsmod =
   everywhere
     ( mkT dropBlankTypeHaddocks
         `extT` dropBlankDataDeclHaddocks
+        `extT` dropBlankConDeclFieldHaddocks
         `extT` patchContext
         `extT` patchExprContext
     )
@@ -209,6 +226,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, ..}
@@ -217,7 +241,7 @@
       a -> a
 
     -- For constraint contexts (both in types and in expressions), normalize
-    -- parenthesis as decided in https://github.com/tweag/ormolu/issues/264.
+    -- parentheses as decided in https://github.com/tweag/ormolu/issues/264.
     patchContext :: LHsContext GhcPs -> LHsContext GhcPs
     patchContext = fmap $ \case
       [x@(L _ (HsParTy _ inner))]
@@ -246,7 +270,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
@@ -264,11 +288,11 @@
     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
@@ -317,10 +341,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 ->
@@ -332,8 +360,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
@@ -355,7 +383,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,16 +1,20 @@
--- | 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.Set (Set)
 import Data.Text (Text)
 import Distribution.ModuleName (ModuleName)
 import GHC.Data.EnumSet (EnumSet)
 import GHC.Hs (GhcPs, HsModule)
 import GHC.LanguageExtensions.Type
+import GHC.Types.SrcLoc (getLoc)
 import Ormolu.Config (SourceType)
 import Ormolu.Fixity (ModuleFixityMap)
 import Ormolu.Parser.CommentStream
@@ -23,7 +27,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,
@@ -31,12 +35,29 @@
     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,
     -- | Local modules
     prLocalModules :: Set ModuleName
   }
+
+-- | 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,48 +1,111 @@
+{-# 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,
     PrinterOpts (..),
   )
 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.Config
+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 ::
+  PrinterOptsTotal ->
   -- | Whether to print out debug information during printing
-  Bool ->
+  Choice "debug" ->
   -- | Result of parsing
   [SourceSnippet] ->
-  PrinterOptsTotal ->
   -- | Resulting rendition
   Text
-printSnippets debug snippets printerOpts = T.concat . fmap printSnippet $ snippets
+printSnippets printerOpts debug = T.concat . fmap fst . printSnippetsWithPlacements printerOpts 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 ::
+  PrinterOptsTotal ->
+  -- | 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 printerOpts debug = fmap (renderSnippet printerOpts debug)
+
+-- | Render one snippet. A snippet that could not be parsed is passed
+-- through as it was.
+renderSnippet ::
+  PrinterOptsTotal ->
+  Choice "debug" ->
+  SourceSnippet ->
+  (Text, [CommentPlacement])
+renderSnippet printerOpts debug = \case
+  ParsedSnippet r -> render printerOpts 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 ::
+  PrinterOptsTotal ->
+  Choice "debug" ->
+  ParseResult ->
+  (Text, [CommentPlacement])
+render printerOpts 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
-            printerOpts
-            prLocalModules
-            prSourceType
-            prExtensions
-            prModuleFixityMap
-            debug
-      RawSnippet r -> r
+    renderWith anchorMap =
+      let (rendered, placements, visited) =
+            runR
+              ( p_hsModule
+                  prStackHeader
+                  prPragmas
+                  prParsedSource
+              )
+              anchorMap
+              printerOpts
+              prLocalModules
+              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
@@ -24,6 +24,7 @@
     newline,
     declNewline,
     multilineCommentNewline,
+    newlineLiteral,
     inci,
     inciBy,
     inciIf,
@@ -32,11 +33,13 @@
     askModuleFixityMap,
     askDebug,
     located,
-    encloseLocated,
+    locatedEmpty,
     located',
     switchLayout,
+    switchLayoutWithEnclosingComments,
     switchLayoutNoLimit,
     spansLayout,
+    enterLayout,
     Layout (..),
     vlayout,
     getLayout,
@@ -48,6 +51,7 @@
     -- ** Formatting lists
     sep,
     sepSemi,
+    sepSemi',
     canUseBraces,
     useBraces,
     dontUseBraces,
@@ -58,6 +62,7 @@
     backticks,
     banana,
     braces,
+    recordBraces,
     brackets,
     parens,
     parensHash,
@@ -68,7 +73,6 @@
     comma,
     commaDel,
     commaDelImportExport,
-    equals,
     token'Larrowtail,
     token'Rarrowtail,
     token'darrow,
@@ -86,12 +90,15 @@
     token'lolly,
 
     -- ** Stateful markers
-    SpanMark (..),
-    spanMarkSpan,
+    LastEmitted (..),
+    lastEmittedSpan,
     HaddockStyle (..),
-    setSpanMark,
-    getSpanMark,
+    setLastEmitted,
+    getLastEmitted,
 
+    -- ** Haddocks
+    lookupHaddockText,
+
     -- ** Placement
     Placement (..),
     placeHanging,
@@ -100,6 +107,7 @@
 
 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.LanguageExtensions.Type
@@ -108,6 +116,7 @@
 import Ormolu.Config
 import Ormolu.Printer.Comments
 import Ormolu.Printer.Internal
+import Ormolu.Utils (combineSrcSpans')
 
 ----------------------------------------------------------------------------
 -- Basic
@@ -122,7 +131,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.
@@ -130,59 +139,67 @@
   (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 r = do
-  layout <- spansLayout spans
-  enterLayout layout r
+switchLayout spans' m = do
+  csSpans <- commentSpansIn (combineSrcSpans' <$> NE.nonEmpty spans')
+  layout <- spansLayout (spans' <> csSpans)
+  enterLayout layout m
 
 -- | Same as 'switchLayout', except disregards the column limit.
 --
@@ -191,7 +208,57 @@
 switchLayoutNoLimit :: [SrcSpan] -> R () -> R ()
 switchLayoutNoLimit spans = enterLayout (spansLayoutWithLimit NoLimit spans)
 
--- | 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)
+  layout <- spansLayout (spans' <> csSpans)
+  enterLayout layout 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] -> R Layout
 spansLayout spans = do
   colLimit <- getPrinterOpt poColumnLimit
@@ -213,14 +280,14 @@
            in spanLineLength > fromIntegral maxLineLength
         _ -> False
 
--- | 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
@@ -230,7 +297,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 () ->
@@ -241,9 +308,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")
@@ -256,7 +323,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
@@ -272,12 +357,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
@@ -285,30 +373,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 token'oparenbar token'cparenbar
 
--- | Surround given entity by curly braces @{@ and  @}@.
+-- | Surround the given entity with curly braces @{@ and @}@.
 braces :: BracketStyle -> R () -> R ()
 braces = brackets_ False (txt "{") (txt "}")
 
--- | Surround given entity by square brackets @[@ and @]@.
+-- | Surround the given entity with square brackets @[@ and @]@.
 brackets :: BracketStyle -> R () -> R ()
 brackets = brackets_ False (txt "[") (txt "]")
 
--- | Surround given entity by parentheses @(@ and @)@.
+-- | Surround the given entity with parentheses @(@ and @)@.
 parens :: BracketStyle -> R () -> R ()
 parens = brackets_ False (txt "(") (txt ")")
 
--- | Surround given entity by @(# @ and @ #)@.
+-- | Surround the given entity with @(# @ and @ #)@.
 parensHash :: BracketStyle -> R () -> R ()
 parensHash = brackets_ True (txt "(#") (txt "#)")
 
@@ -369,6 +458,31 @@
       newline
       inciIf (style == S) close
 
+-- With leading commas align the close brace with commas
+-- otherwise move the close brace back to the left
+recordBraces :: R () -> R ()
+recordBraces m = do
+  commaStyle <- getPrinterOpt poCommaStyle
+  recordBraces_ (commaStyle == Trailing) m
+
+recordBraces_ :: Bool -> R () -> R ()
+recordBraces_ moveBraceBack m = do
+  style <- getPrinterOpt poRecordStyle
+  case style of
+    RecordStyleAligned -> braces N m
+    RecordStyleKnr ->
+      vlayout
+        (txt "{" >> m >> txt "}")
+        ( do
+            txt "{"
+            newline
+            sitcc m
+            newline
+            if moveBraceBack
+              then inciByFrac (-1) (txt "}")
+              else txt "}"
+        )
+
 ----------------------------------------------------------------------------
 -- Literals
 
@@ -394,10 +508,6 @@
   Leading -> breakpoint' >> comma >> space
   Trailing -> comma >> breakpoint
 
--- | Print @=@. Do not use @'txt' "="@.
-equals :: R ()
-equals = interferingTxt "="
-
 ----------------------------------------------------------------------------
 -- Token literals
 -- The names of the following literals are from GHC's
@@ -477,13 +587,13 @@
 -- 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.
@@ -14,12 +14,12 @@
     -- * Internal functions
     txt,
     txtStripIndent,
-    interferingTxt,
     atom,
     space,
     newline,
     declNewline,
     multilineCommentNewline,
+    newlineLiteral,
     askSourceType,
     askModuleFixityMap,
     askDebug,
@@ -43,22 +43,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,
   )
@@ -70,11 +75,9 @@
 import Data.Bool (bool)
 import Data.Char (isSpace)
 import Data.Choice (Choice)
-import Data.Choice qualified as Choice
-import Data.Coerce
-import Data.Functor ((<&>))
 import Data.Functor.Identity (runIdentity)
 import Data.List (find)
+import Data.Map.Strict qualified as M
 import Data.Maybe (listToMaybe)
 import Data.Set (Set)
 import Data.Text (Text)
@@ -87,17 +90,18 @@
 import GHC.LanguageExtensions.Type
 import GHC.Types.SrcLoc
 import GHC.Utils.Outputable (Outputable)
+import Ormolu.Comments.Anchor (AnchorMap, commentsAnchoredWithin, commentsBefore)
 import Ormolu.Config
 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)
 
@@ -109,7 +113,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,
@@ -122,7 +126,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'.
@@ -133,22 +139,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
@@ -164,17 +174,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)
 
@@ -182,10 +192,8 @@
 runR ::
   -- | Monad to run
   R () ->
-  -- | Span stream
-  SpanStream ->
-  -- | Comment stream
-  CommentStream ->
+  -- | Comments, attached to the elements they belong to
+  AnchorMap ->
   PrinterOptsTotal ->
   Set ModuleName ->
   -- | Whether the source is a signature or a regular module
@@ -194,12 +202,20 @@
   EnumSet Extension ->
   -- | Module fixity map
   ModuleFixityMap ->
-  -- | Resulting rendition
-  Bool ->
-  Text
-runR (R m) sstream cstream printerOpts localModules 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 printerOpts localModules 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,
@@ -211,19 +227,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 = []
         }
 
 ----------------------------------------------------------------------------
@@ -234,12 +252,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.
@@ -268,17 +281,9 @@
   let (leadingSpaces, s') = T.span isSpace s
   txt $ T.drop indent leadingSpaces <> s'
 
--- | 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 ->
@@ -295,8 +300,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 ->
@@ -333,12 +336,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
@@ -377,18 +380,25 @@
         scRequestedDelimiter = AfterNewline
       }
 
--- | 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
@@ -438,6 +448,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)
@@ -449,7 +472,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)
 
 -- | Like 'inci', but indents by exactly the given number of steps.
 inciBy :: Int -> R () -> R ()
@@ -498,16 +521,16 @@
   let step = truncate $ fromIntegral indentStep * x
   inciBy step m
 
--- | 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 = inciByFrac 1
 
--- | 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
@@ -528,7 +551,7 @@
     Leading -> id x
     Trailing -> sitcc x
 
--- | 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
@@ -537,7 +560,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 ->
@@ -550,7 +573,7 @@
     SingleLine -> sline
     MultiLine -> mline
 
--- | Get current 'Layout'.
+-- | Get the current 'Layout'.
 getLayout :: R Layout
 getLayout = R (asks rcLayout)
 
@@ -564,10 +587,10 @@
 ----------------------------------------------------------------------------
 -- 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 ->
@@ -580,52 +603,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) ->
@@ -633,7 +638,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
@@ -649,23 +654,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
@@ -676,19 +702,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,32 +14,45 @@
     p_qualName,
     p_infixDefHelper,
     p_hsDoc,
-    p_hsDoc',
+    p_hsDocInline,
+    p_hsDocWith,
+    multiLineIfDocumented,
+    switchLayoutDocumented,
+    hasLineHaddocks,
+    p_hsDocName,
     p_sourceText,
     p_namespaceSpec,
+    p_hsMultAnn,
     p_arrow,
+    getIsFourmoluMultiHaddockPrintStyle,
   )
 where
 
 import Control.Monad
-import Data.Choice (Choice)
+import Data.Choice (Choice, pattern Is, pattern Isn't)
 import Data.Choice qualified as Choice
-import Data.Foldable (traverse_)
+import Data.Data (Data)
+import Data.Generics.Schemes (listify)
+import Data.List.NonEmpty qualified as NE
+import Data.Maybe (isJust)
+import Data.Text (Text)
 import Data.Text qualified as T
 import GHC.Data.FastString
+import GHC.Hs (ConDecl (..), LConDecl)
 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)
 import GHC.Types.Name.Reader
 import GHC.Types.SourceText
 import GHC.Types.SrcLoc
-import Language.Haskell.Syntax (HsArrowOf (..))
 import Language.Haskell.Syntax.Module.Name
 import Ormolu.Config
+import Ormolu.Parser.CommentStream (Comment, isMultilineComment, unComment)
 import Ormolu.Printer.Combinators
 import Ormolu.Utils
 
@@ -48,7 +63,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
@@ -73,6 +89,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 ()
@@ -87,13 +107,18 @@
         NameAnnRArrow {nann_mopen = Just _} -> parens N
         -- special case for unboxed unit tuples
         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
@@ -106,7 +131,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
@@ -123,19 +148,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
@@ -148,16 +174,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 ->
@@ -168,69 +200,168 @@
   R ()
 p_hsDoc hstyle needsNewline lstr = do
   poHStyle <- getPrinterOpt poHaddockStyle
-  p_hsDoc' poHStyle hstyle needsNewline lstr
+  p_hsDocWith poHStyle hstyle needsNewline (Isn't #mayShareLine) lstr
 
--- | Print a Haddock.
-p_hsDoc' ::
+-- | '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 -> Choice "endNewline" -> LHsDoc GhcPs -> R ()
+p_hsDocInline hstyle needsNewline lstr = do
+  poHStyle <- getPrinterOpt poHaddockStyle
+  p_hsDocWith poHStyle hstyle needsNewline (Is #mayShareLine) lstr
+
+-- | The worker behind 'p_hsDoc' and 'p_hsDocInline'.
+p_hsDocWith ::
   -- | 'haddock-style' configuration option
   HaddockPrintStyle ->
-  -- | Haddock style
   HaddockStyle ->
-  -- | Finish the doc string with a newline
   Choice "endNewline" ->
-  -- | The 'LHsDoc' to render
+  Choice "mayShareLine" ->
   LHsDoc GhcPs ->
   R ()
-p_hsDoc' poHStyle hstyle needsNewline (L l str) = do
-  let isCommentSpan = \case
-        HaddockSpan _ _ -> True
-        CommentSpan _ -> True
+p_hsDocWith poHStyle hstyle needsNewline mayShareLine ldoc = 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 shouldEscapeCommentBraces =
-        case poHStyle of
-          HaddockSingleLine -> False
-          HaddockMultiLine -> True
-          HaddockMultiLineCompact -> True
-  let docStringLines = splitDocString shouldEscapeCommentBraces $ hsDocString str
-
-  if poHStyle == HaddockSingleLine || length docStringLines <= 1
-    then do
+  poHStyle' <- resolveHaddockPrintStyle poHStyle hstyle ldoc
+  case poHStyle' of
+    HaddockPrint_AsWritten written -> do
+      let lns = unComment written
+      sitcc . sequence_ . NE.intersperse newline . fmap txt $ lns
+    HaddockPrint_Single -> do
       txt $ "-- " <> haddockDelim
       space
       sep (newline >> txt "--" >> space) txt docStringLines
-    else do
-      txt . T.concat $
-        [ "{-",
-          case (hstyle, poHStyle) of
-            (Pipe, HaddockMultiLineCompact) -> ""
-            _ -> " ",
-          haddockDelim
-        ]
+    HaddockPrint_Multi delimSpace -> do
+      txt $ "{-" <> delimSpace <> haddockDelim
       space
       sep multilineCommentNewline txtStripIndent docStringLines
       newline
       txt "-}"
-
-  when (Choice.isTrue needsNewline) newline
-  traverse_ (setSpanMark . HaddockSpan hstyle) =<< getSrcSpan l
+  -- 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 && isMultilineHaddockPrintStyle poHStyle'
+      then breakpoint
+      else newline
+  case getLoc ldoc 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 the
+      -- nearest enclosing span.
+      getEnclosingSpan >>= mapM_ (setLastEmitted . LastEmittedHaddock)
+    RealSrcSpan spn _ -> setLastEmitted (LastEmittedHaddock spn)
   where
+    docStringLines = getDocStringLines ldoc
     haddockDelim =
       case hstyle of
         Pipe -> "|"
         Caret -> "^"
         Asterisk n -> T.replicate n "*"
         Named name -> "$" <> T.pack name
-    getSrcSpan = \case
-      -- 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
-      -- nearest enclosing span.
-      UnhelpfulSpan _ -> getEnclosingSpan
-      RealSrcSpan spn _ -> pure $ Just spn
 
+-- | 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 = do
+      poHStyle <- getPrinterOpt poHaddockStyle
+      not . isMultilineHaddockPrintStyle <$> resolveHaddockPrintStyle poHStyle 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 = 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 ()
@@ -242,12 +373,74 @@
   TypeNamespaceSpecifier _ -> txt "type" *> space
   DataNamespaceSpecifier _ -> txt "data" *> space
 
-p_arrow :: (mult -> R ()) -> HsArrowOf mult GhcPs -> R ()
+p_hsMultAnn :: (mult -> R ()) -> HsMultAnnOf mult GhcPs -> R ()
+p_hsMultAnn p_mult = \case
+  HsUnannotated _ -> pure ()
+  HsLinearAnn _ -> txt "%1"
+  HsExplicitMult _ mult -> txt "%" *> p_mult mult
+
+-- | Like 'p_hsMultAnn', except specifically for arrows, taking -XUnicodeSyntax
+--   into account.
+p_arrow :: (mult -> R ()) -> HsMultAnnOf mult GhcPs -> R ()
 p_arrow p_mult = \case
-  HsUnrestrictedArrow _ -> token'rarrow
-  HsLinearArrow _ -> token'lolly
+  HsUnannotated _ -> token'rarrow
+  HsLinearAnn _ -> token'lolly
   HsExplicitMult _ mult -> do
     txt "%"
     p_mult mult
     space
     token'rarrow
+
+{----- Fourmolu: HaddockPrintStyle -----}
+
+data HaddockPrintStyleResolved
+  = HaddockPrint_AsWritten Comment
+  | HaddockPrint_Single
+  | HaddockPrint_Multi Text
+
+resolveHaddockPrintStyle :: HaddockPrintStyle -> HaddockStyle -> LHsDoc GhcPs -> R HaddockPrintStyleResolved
+resolveHaddockPrintStyle poHStyle hstyle ldoc =
+  case poHStyle of
+    HaddockSingleLine -> pure HaddockPrint_Single
+    HaddockMultiLine -> resolveMulti " "
+    HaddockMultiLineCompact -> resolveMulti $ case hstyle of Pipe -> ""; _ -> " "
+    HaddockAuto -> do
+      -- 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.
+      --
+      -- If we can't figure out what the author wrote, fallback to single-line haddocks
+      asWritten <- haddockAsWritten hstyle ldoc
+      pure $ maybe HaddockPrint_Single HaddockPrint_AsWritten asWritten
+  where
+    resolveMulti delimSpace =
+      pure $
+        if length (getDocStringLines ldoc) <= 1
+          then HaddockPrint_Single
+          else HaddockPrint_Multi delimSpace
+
+isMultilineHaddockPrintStyle :: HaddockPrintStyleResolved -> Bool
+isMultilineHaddockPrintStyle = \case
+  HaddockPrint_AsWritten written -> isMultilineComment written
+  HaddockPrint_Single -> False
+  HaddockPrint_Multi _ -> True
+
+getDocStringLines :: LHsDoc GhcPs -> [Text]
+getDocStringLines = splitDocString . hsDocString . unLoc
+
+-- Hack to workaround upstream bug
+-- https://github.com/tweag/ormolu/issues/1225
+getIsFourmoluMultiHaddockPrintStyle :: LConDecl GhcPs -> R Bool
+getIsFourmoluMultiHaddockPrintStyle (L _ decl) = do
+  poHStyle <- getPrinterOpt poHaddockStyle
+  pure $ isJust doc && isMulti poHStyle
+  where
+    doc =
+      case decl of
+        ConDeclGADT {con_doc} -> con_doc
+        ConDeclH98 {con_doc} -> con_doc
+    isMulti = \case
+      HaddockSingleLine -> False
+      HaddockMultiLine -> True
+      HaddockMultiLineCompact -> True
+      HaddockAuto -> False
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 ->
           declNewline : 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,7 +269,13 @@
 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,
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)
@@ -61,8 +66,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)
@@ -70,7 +75,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
@@ -3,11 +3,14 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
--- | Renedring of data type declarations.
+-- | Rendering of data type declarations.
 module Ormolu.Printer.Meat.Declaration.Data
   ( p_dataDecl,
   )
@@ -19,9 +22,8 @@
 import Data.List (sortOn)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
-import Data.Maybe (isJust, isNothing, maybeToList)
+import Data.Maybe (isJust, isNothing, mapMaybe, maybeToList)
 import Data.Text qualified as Text
-import Data.Void
 import GHC.Hs
 import GHC.Types.Fixity
 import GHC.Types.ForeignCall
@@ -79,8 +81,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
@@ -114,21 +116,26 @@
               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
+          fourmoluSitccFix <- getIsFourmoluMultiHaddockPrintStyle first_dd_cons
           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 || fourmoluSitccFix
                   then sitcc
                   else id
           sep s (sitcc' . located' (p_conDecl singleRecCon)) dd_cons'
@@ -154,85 +161,69 @@
   deriving (Eq, Ord)
 
 p_conDecl :: Choice "singleRecCon" -> ConDecl GhcPs -> R ()
-p_conDecl _ ConDeclGADT {..} = do
+p_conDecl _ decl@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
-      p_hsTypeAnnotation quantifiedTy
+    inci $ p_hsFun decl
   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
+        recordStyle <- getPrinterOpt poRecordStyle
+        if recordStyle == RecordStyleKnr then space else breakpoint
+        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
@@ -242,7 +233,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 =
@@ -262,13 +253,9 @@
     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 ->
@@ -289,26 +276,27 @@
 p_hsDerivingClause ::
   HsDerivingClause GhcPs ->
   R ()
-p_hsDerivingClause HsDerivingClause {..} = do
+p_hsDerivingClause HsDerivingClause {..} = multiLineIfDocumented deriv_clause_tys $ do
   singleDerivingParens <- getPrinterOpt poSingleDerivingParens
 
   txt "deriving"
-  let derivingWhat = located deriv_clause_tys $ \case
-        DctSingle NoExtField sigTy
-          | DerivingAlways <- singleDerivingParens -> parens N $ located sigTy p_hsSigType
-          | otherwise -> located sigTy p_hsSigType
-        DctMulti NoExtField sigTys
-          | [sigTy] <- sigTys,
-            DerivingNever <- singleDerivingParens ->
-              located sigTy p_hsSigType
-          | otherwise -> do
-              sortDerivedClasses <- getPrinterOpt poSortDerivedClasses
-              let sort = if sortDerivedClasses then sortOn showOutputable else id
-              parens N $
-                sep
-                  commaDel
-                  (sitcc . located' p_hsSigType)
-                  (sort sigTys)
+  let derivingWhat = located deriv_clause_tys $ \tys ->
+        multiLineIfDocumented tys $ case tys of
+          DctSingle NoExtField sigTy
+            | DerivingAlways <- singleDerivingParens -> parens N $ located sigTy p_hsSigType
+            | otherwise -> located sigTy p_hsSigType
+          DctMulti NoExtField sigTys
+            | [sigTy] <- sigTys,
+              DerivingNever <- singleDerivingParens ->
+                located sigTy p_hsSigType
+            | otherwise -> do
+                sortDerivedClasses <- getPrinterOpt poSortDerivedClasses
+                let sort = if sortDerivedClasses then sortOn showOutputable else id
+                parens N $
+                  sep
+                    commaDel
+                    (sitcc . located' p_hsSigType)
+                    (sort sigTys)
   space
   case deriv_clause_strategy of
     Nothing -> do
@@ -337,26 +325,125 @@
           located sigTy p_hsSigType
 
 ----------------------------------------------------------------------------
+-- FunRepr ConDeclGADT
+
+-- | ConDecl, except should only be called with the ConDeclGADT constructor.
+type ConDeclGADT = ConDecl
+
+-- | FunRepr ConDeclGADT renders a GADT constructor type annotation, which looks
+-- similar to a function type, except the arguments of the function have two
+-- additional capabilities:
+--   * They can specify UNPACK/strictness
+--   * It can be a single argument with a record fields syntax
+instance FunRepr (ConDeclGADT GhcPs) where
+  parseFunRepr = \case
+    L _ ConDeclGADT {..} ->
+      fst
+        . addSig
+        . addOuter con_outer_bndrs
+        . addInner con_inner_bndrs
+        . addCtx con_mb_cxt
+        . addArgs con_g_args
+        $ mkRet con_res_ty
+    _ -> error "parseFunRepr @ConDeclGADT unexpectedly called on non-GADT constructor"
+    where
+      addSig (next, loc) = (ParsedFunSig {sig = (), next}, loc)
+      addOuter (L ann bndrs) =
+        case bndrs :: HsOuterSigTyVarBndrs GhcPs of
+          HsOuterImplicit {} -> id
+          HsOuterExplicit _ bndrs' -> \(next, loc) ->
+            let loc' = combineSrcSpans loc (getHasLoc ann)
+                fun =
+                  ParsedFunForall
+                    { tele = L (l2l loc') $ mkHsForAllInvisTele noAnn bndrs',
+                      next
+                    }
+             in (fun, loc')
+      addInner =
+        let go tele (next, loc) =
+              let loc' =
+                    combineSrcSpans loc $
+                      case tele of
+                        HsForAllVis x _ -> getHasLoc x
+                        HsForAllInvis x _ -> getHasLoc x
+                  fun = ParsedFunForall {tele = L (l2l loc') tele, next}
+               in (fun, loc')
+         in foldr (\tele acc -> go tele . acc) id
+      addCtx = \case
+        Nothing -> id
+        Just ctxs -> \(next, loc) ->
+          let loc' = combineSrcSpans loc (getHasLoc ctxs)
+              fun = ParsedFunQuals {ctxs = [L (l2l loc') ctxs], next}
+           in (fun, loc')
+      addArgs details =
+        case details :: HsConDeclGADTDetails GhcPs of
+          PrefixConGADT _ fields ->
+            let go field (next, loc) =
+                  let loc' = combineSrcSpans loc (getHasLoc field.cdf_type)
+                      fun =
+                        ParsedFunArg
+                          { span = l2l loc',
+                            arg = L noAnn (Left field),
+                            doc = field.cdf_doc,
+                            multAnn = field.cdf_multiplicity,
+                            next
+                          }
+                   in (fun, loc')
+             in foldr (\field acc -> go field . acc) id fields
+          RecConGADT _ fields -> \(next, loc) ->
+            let loc' = combineSrcSpans (getHasLoc fields) loc
+                fun =
+                  ParsedFunArg
+                    { span = l2l loc',
+                      arg = la2la $ Right <$> fields,
+                      doc = Nothing,
+                      multAnn = HsUnannotated (EpArrow noAnn),
+                      next
+                    }
+             in (fun, loc')
+      mkRet ty =
+        let fun =
+              case ty of
+                L _ (HsDocTy _ ret doc) -> ParsedFunReturn {ret, doc = Just doc}
+                ret -> ParsedFunReturn {ret, doc = Nothing}
+         in (fun, getHasLoc ty)
+
+  type FunReprCtx (ConDeclGADT GhcPs) = HsType GhcPs
+  renderFunReprCtx = p_hsType
+
+  -- Invariant: Exactly one of the following must be true:
+  --   * There's exactly one 'Right' arg
+  --   * There are zero or more 'Left' args
+  type FunReprArg (ConDeclGADT GhcPs) = Either (HsConDeclField GhcPs) [LocatedA (HsConDeclRecField GhcPs)]
+  renderFunReprArg = either p_hsConDeclField p_hsConDeclRecFields
+
+  type FunReprMult (ConDeclGADT GhcPs) = HsType GhcPs
+  renderFunReprMult = p_hsType
+
+  type FunReprRet (ConDeclGADT GhcPs) = HsType GhcPs
+  renderFunReprRet = p_hsType
+
+----------------------------------------------------------------------------
 -- 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/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
@@ -23,6 +23,7 @@
 import GHC.Types.Name.Reader (RdrName, rdrNameOcc)
 import GHC.Types.SrcLoc
 import Ormolu.Config (poIndentation, poTrailingSectionOperators)
+import Ormolu.Parser.CommentStream (LComment)
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common (p_rdrName)
 import Ormolu.Printer.Meat.Declaration.Value
@@ -47,20 +48,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))
@@ -70,7 +71,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 =
@@ -117,33 +118,55 @@
       couldBeTrailing (prevExpr, opi) =
         -- Enabled by config
         trailingSectionOperators
-          -- 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
   indent <- getPrinterOpt poIndentation
   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
@@ -181,6 +204,12 @@
     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)
@@ -220,14 +249,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,18 +9,24 @@
     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
 import GHC.Types.SourceText
+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
 
@@ -30,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
@@ -116,26 +125,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
-  token'dcolon
-  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
+        token'dcolon
+        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"
@@ -165,7 +219,7 @@
 
 p_minimalSig ::
   -- | Boolean formula
-  LBooleanFormula (LocatedN RdrName) ->
+  LBooleanFormula GhcPs ->
   R ()
 p_minimalSig =
   located' $ \booleanFormula ->
@@ -173,7 +227,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
--- a/src/Ormolu/Printer/Meat/Declaration/StringLiteral.hs
+++ b/src/Ormolu/Printer/Meat/Declaration/StringLiteral.hs
@@ -18,8 +18,8 @@
 import Ormolu.Printer.Combinators
 import Ormolu.Utils
 
--- | Print the source text of a string literal while indenting gaps and newlines
--- correctly.
+-- | 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
@@ -40,12 +40,12 @@
                   LastPos -> txt "\\" *> txt s
         vlayout singleLine multiLine
       MultilineStringLiteral ->
-        sep breakpoint' txt segments
+        sep newlineLiteral txt segments
     txt endMarker
 
--- | The start/end marker of the literal, whether it is a regular or a multiline
--- literal, and the segments of the literals (separated by gaps for a regular
--- literal, and separated by newlines for a multiline literal).
+-- | 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,
@@ -57,9 +57,9 @@
 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.
+-- | 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 <-
@@ -83,7 +83,7 @@
           <|> ((marker,) <$> T.stripSuffix marker suffix)
       pure ParsedStringLiteral {segments = [infix_], ..}
 
-    -- Split a string on gaps (backslash delimited whitespaces).
+    -- Split a string on gaps (backslash-delimited whitespace).
     --
     -- > splitGaps "bar\\  \\fo\\&o" == ["bar", "fo\\&o"]
     splitGaps :: Text -> [Text]
@@ -91,21 +91,34 @@
       where
         go [] = [s]
         go ((pre, suf) : bs) = case T.uncons suf of
-          Just ('\\', T.uncons -> Just (c, s'))
-            | is_space c,
-              let rest = T.drop 1 $ T.dropWhile (/= '\\') s' ->
+          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 -> go $ (if c == '\\' then drop 1 else id) bs
+            | 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
 
-    -- See the the MultilineStrings GHC proposal and 'lexMultilineString' from
+        -- 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 with multiline string literals just to
+        -- There is no reason to use gaps in multiline string literals just to
         -- emulate multi-line strings, so we replace them with "\\ \\".
         >>> intercalateMinimalStringGaps
         >>> splitNewlines
@@ -131,8 +144,8 @@
              in pre : T.replicate fill " " : go (col' + fill) suf
           _ -> [s]
 
-    -- Don't touch the first line, and remove common whitespace from all
-    -- remaining lines as well as convert those consisting only of whitespace to
+    -- 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
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
@@ -65,7 +70,7 @@
   KindSig NoExtField k -> Just $ do
     p_hsTypeAnnotation k
   TyVarSig NoExtField bndr -> Just $ do
-    equals
+    txt "="
     breakpoint
     located bndr p_hsTyVarBndr
 
@@ -93,13 +98,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,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -21,6 +22,7 @@
 
 import Control.Monad
 import Data.Bool (bool)
+import Data.Choice qualified as Choice
 import Data.Data hiding (Infix, Prefix)
 import Data.Function (on)
 import Data.Functor ((<&>))
@@ -31,7 +33,6 @@
 import Data.Maybe
 import Data.Text (Text)
 import Data.Text qualified as Text
-import Data.Void
 import GHC.Data.Strict qualified as Strict
 import GHC.Hs
 import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))
@@ -47,7 +48,7 @@
 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
@@ -100,15 +101,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,31 +118,30 @@
         render
         (adjustMatchGroupStyle m style)
         (isInfixMatch m)
-        (HsNoMultAnn NoExtField)
+        (HsUnannotated EpPatBind)
         (matchStrictness m)
         -- 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
@@ -180,23 +180,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
@@ -207,14 +209,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)
       switchLayoutNoLimit [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
@@ -237,21 +244,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
@@ -277,20 +281,28 @@
         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
           indentWhere <- getPrinterOpt poIndentWheres
-          bool (inciByFrac (-1 / 2)) id indentWhere $ txt "where"
+          bool (inciByFrac (-1 / 2)) id indentWhere $ do
+            located (L localBindsWhereSpan ()) $ \_ -> txt "where"
           breakpoint
           inciIf indentWhere $ 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 >> token'rarrow
     switchLayout [patGrhssSpan] $
@@ -319,7 +331,7 @@
       sitccIfTrailing (sep commaDel (sitcc . located' p_stmt) xs)
       space
       inci $ case style of
-        EqualSign -> equals
+        EqualSign -> txt "="
         RightArrow -> token'rarrow
       -- 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
@@ -375,10 +387,10 @@
     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 $ sitcc $ 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 (letToken, _) localBinds c ->
@@ -403,22 +415,22 @@
   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)
@@ -451,13 +463,13 @@
   BodyStmt _ body _ _ -> located body (render s)
   LetStmt epAnnLet binds -> p_let' True epAnnLet binds Nothing
   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
@@ -510,7 +522,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
@@ -523,8 +535,8 @@
 p_hsLocalBinds = \case
   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)
@@ -545,18 +557,18 @@
     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
@@ -565,8 +577,8 @@
 p_dotFieldOcc =
   p_rdrName . fmap (mkVarUnqual . field_label) . dfoLabel
 
-p_dotFieldOccs :: [DotFieldOcc GhcPs] -> R ()
-p_dotFieldOccs = sep (txt ".") p_dotFieldOcc
+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
@@ -580,7 +592,7 @@
   p_lhs hfbLHS
   unless hfbPun $ do
     space
-    equals
+    txt "="
     let placement =
           if onTheSameLine (getLocA hfbLHS) (getLocA hfbRHS)
             then exprPlacement (unLoc hfbRHS)
@@ -590,8 +602,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
@@ -604,10 +617,18 @@
   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
   HsOverLabel sourceText _ -> do
     txt "#"
     p_sourceText sourceText
@@ -622,10 +643,10 @@
       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 +666,7 @@
         MultiLine -> 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
         let indentArg =
@@ -701,13 +721,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 (sitcc $ located e (dontUseBraces . p_hsExpr))
   SectionL _ x op -> do
     located x p_hsExpr
@@ -743,13 +761,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 breakpoint (located' (p_grhs RightArrow)) guards
+    inciApplicand isApp $
+      sep breakpoint (located' (p_grhs RightArrow)) (NE.toList guards)
   HsLet (letToken, _) localBinds e ->
     p_let (s == S) p_hsExpr letToken localBinds e
   HsDo _ doFlavor es -> do
@@ -775,7 +794,7 @@
         dotdot = case rec_dotdot of
           Just {} -> [txt ".."]
           Nothing -> []
-    inci . braces N $
+    inci . recordBraces $
       sep commaDel sitcc (fields <> dotdot)
   RecordUpd {..} -> do
     located rupd_expr p_hsExpr
@@ -784,7 +803,7 @@
           sep commaDel (sitcc . located' (p_hsFieldBind p_lbl))
         p_fieldLabelStrings (FieldLabelStrings flss) =
           p_dotFieldOccs $ unLoc <$> flss
-    inci . braces N $ case rupd_flds of
+    inci . recordBraces $ case rupd_flds of
       RegularRecUpdFields {..} ->
         p_recFields (located' p_fieldOcc) recUpdFields
       OverloadedRecUpdFields {..} ->
@@ -795,7 +814,7 @@
     located gf_field p_dotFieldOcc
   HsProjection {..} -> parens N $ do
     txt "."
-    p_dotFieldOccs (NE.toList proj_flds)
+    p_dotFieldOccs proj_flds
   ExprWithTySig _ x HsWC {hswc_body} -> sitcc $ do
     located x p_hsExpr
     inci $ p_hsTypeAnnotation (hsSigTypeToType <$> hswc_body)
@@ -828,7 +847,7 @@
     breakpoint'
     txt "||]"
   HsUntypedBracket _ x -> p_hsQuote x
-  HsTypedSplice _ expr -> p_hsSpliceTH True expr DollarSplice
+  HsTypedSplice _ (HsTypedSpliceExpr _ expr) -> p_hsSpliceTH True expr DollarSplice
   HsUntypedSplice _ untySplice -> p_hsUntypedSplice DollarSplice untySplice
   HsProc _ p e -> do
     txt "proc"
@@ -855,6 +874,9 @@
     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
   expr@HsForAll {} ->
     p_hsFun expr
@@ -867,7 +889,8 @@
 
 -- | Print a list comprehension.
 --
--- BracketStyle should be N except in a do-block, which must be S or else it's a parse error.
+-- 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
@@ -894,11 +917,11 @@
       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) (sitccIfTrailing . 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))
 
@@ -937,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:
 --
 -- @
@@ -954,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
     ]
@@ -989,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
@@ -998,12 +1021,17 @@
               breakpoint
               located psb_def p_pat
             breakpoint
-            txt "where"
+            indentWhere <- getPrinterOpt poIndentWheres
+            let (inciWhere, inciBody) =
+                  if indentWhere
+                    then (id, inci)
+                    else (inciByFrac (-1 / 2), id)
+            inciWhere $ txt "where"
             breakpoint
-            inci (p_matchGroup (Function psb_id) mgroup)
+            inciBody $ 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
@@ -1012,7 +1040,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
@@ -1020,7 +1047,7 @@
         let conSpans = getLocA . recordPatSynPatVar <$> xs
         switchLayout conSpans $ do
           unless (null xs) breakpointPreRecordBrace
-          braces N $
+          recordBraces $
             sep commaDel (p_rdrName . recordPatSynPatVar) xs
         rhs conSpans
     InfixCon l r -> do
@@ -1040,6 +1067,7 @@
     Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA
   ) =>
   IsApplicand ->
+  BracketStyle ->
   -- | Placer
   (body -> Placement) ->
   -- | Render
@@ -1049,20 +1077,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
@@ -1072,7 +1103,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"
@@ -1084,7 +1115,7 @@
     Just caseTxt -> do
       txt caseTxt
       breakpoint
-      inciApplicand isApp pMatchGroup
+      adjustBracing isApp s (inciApplicand isApp pMatchGroup)
 
 p_if ::
   -- | Placer
@@ -1106,7 +1137,12 @@
   txt "if"
   space
   located if' p_hsExpr
-  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
@@ -1243,65 +1279,66 @@
         _ -> Nothing
 
 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 . sitcc . p_pat)
+    located pat (parens S . sitcc . 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
-  OrPat _ pats ->
-    sepSemi (located' p_pat) (NE.toList 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)
+        unless (null xs) breakpoint
+        inci . sitcc $ sep breakpoint (sitcc . located' (p_pat' inAsPat)) xs
       RecCon (HsRecFields _ fields dotdot) -> do
         p_rdrName pat
         breakpointPreRecordBrace
         let f = \case
               Nothing -> txt ".."
               Just x -> located x p_pat_hsFieldBind
-        inci . braces N . sep commaDel f $
+        inci . recordBraces . sep commaDel f $
           case dotdot of
             Nothing -> Just <$> fields
             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
     token'rarrow
     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
@@ -1318,7 +1355,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"
@@ -1329,15 +1366,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)
 
@@ -1361,7 +1395,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.
@@ -1413,10 +1447,10 @@
         breakpoint'
         endQuote
     -- 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
@@ -1428,21 +1462,31 @@
 
 -- | Function types in expressions, e.g. with -XRequiredTypeArguments
 instance FunRepr (HsExpr GhcPs) where
-  renderFunItem = p_hsExpr
   parseFunRepr = \case
     -- `forall a. _`
     L ann (HsForAll _ tele expr) ->
-      ParsedFunForall (L ann tele) (parseFunRepr expr)
+      ParsedFunForall
+        { tele = L ann tele,
+          next = parseFunRepr expr
+        }
     -- `HasCallStack => _`
     expr@(L _ HsQual {}) ->
       let (ctxs, rest) = getContexts expr
-       in ParsedFunQuals ctxs (parseFunRepr rest)
+       in ParsedFunQuals
+            { ctxs,
+              next = parseFunRepr rest
+            }
     -- `Int -> _`
-    expr@(L _ HsFunArr {}) ->
-      let (args, ret) = getArgsAndReturn expr
-       in ParsedFunArgs args (parseFunRepr ret)
+    L ann (HsFunArr _ multAnn arg r) ->
+      ParsedFunArg
+        { span = ann,
+          arg,
+          doc = Nothing,
+          multAnn,
+          next = parseFunRepr r
+        }
     -- `_ -> Int`
-    expr -> ParsedFunReturn (expr, Nothing)
+    ret -> ParsedFunReturn {ret, doc = Nothing}
     where
       getContexts =
         let go ctxs = \case
@@ -1451,14 +1495,12 @@
               expr ->
                 (reverse ctxs, expr)
          in go []
-      getArgsAndReturn =
-        let go args = \case
-              L ann (HsFunArr _ arrow l r) ->
-                go (L ann (l, Nothing, arrow) : args) r
-              expr ->
-                (reverse args, expr)
-         in go []
 
+  renderFunReprArg = p_hsExpr
+  renderFunReprCtx = p_hsExpr
+  renderFunReprMult = p_hsExpr
+  renderFunReprRet = p_hsExpr
+
 ----------------------------------------------------------------------------
 -- Helpers
 
@@ -1473,15 +1515,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
@@ -1489,14 +1531,14 @@
   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 _ _ (L _ (x : xs)) _)])
@@ -1514,7 +1556,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
@@ -1522,7 +1564,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
@@ -1531,10 +1573,12 @@
 -- | For use before record braces. Collapse to empty if not 'poRecordBraceSpace'.
 breakpointPreRecordBrace :: R ()
 breakpointPreRecordBrace = do
+  recordStyle <- getPrinterOpt poRecordStyle
   useSpace <- getPrinterOpt poRecordBraceSpace
-  if useSpace
-    then breakpoint
-    else breakpoint'
+  if
+    | recordStyle == RecordStyleKnr -> space
+    | useSpace -> breakpoint
+    | otherwise -> breakpoint'
 
 -- | For nested lists/tuples, pad with whitespace so that we always indent correctly,
 -- rather than sometimes indenting by 2 regardless of 'poIndentation'.
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
 
@@ -15,7 +16,6 @@
 import Data.Choice (pattern Without)
 import Data.Foldable (for_, traverse_)
 import Data.List (inits)
-import Data.Text qualified as T
 import GHC.Hs
 import GHC.LanguageExtensions.Type
 import GHC.Types.PkgQual
@@ -28,12 +28,13 @@
 
 p_hsmodExports :: [LIE GhcPs] -> R ()
 p_hsmodExports xs =
-  parens' False $ do
-    layout <- getLayout
-    sep
-      breakpoint
-      (\(isAllPrevDoc, p, l) -> sitcc (located (addDocSrcSpan l) (p_lie layout isAllPrevDoc p)))
-      (withAllPrevDoc $ attachRelativePos xs)
+  enterMultilineLayoutIfContainsDocEntries xs $
+    parens' False $ do
+      layout <- getLayout
+      sep
+        breakpoint
+        (\(isAllPrevDoc, p, l) -> sitcc (located (addDocSrcSpan l) (p_lie layout isAllPrevDoc p)))
+        (withAllPrevDoc $ 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
@@ -49,6 +50,10 @@
   space
   when ideclSafe (txt "safe")
   space
+  case ideclLevelSpec of
+    LevelStylePre l -> p_declLevel l
+    _ -> return ()
+  space
   when
     (isImportDeclQualified ideclQualified && not useQualifiedPost)
     (txt "qualified")
@@ -59,6 +64,10 @@
   space
   inci $ do
     located ideclName atom
+    space
+    case ideclLevelSpec of
+      LevelStylePost l -> p_declLevel l
+      _ -> return ()
     when
       (isImportDeclQualified ideclQualified && useQualifiedPost)
       (space >> txt "qualified")
@@ -72,19 +81,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"
         breakIfNotDiffFriendly
         parens' True $ do
           layout <- getLayout
+          when (null xs) $ locatedEmpty (locA listLoc)
           sep
             breakpoint
             (\(p, l) -> sitcc (located l (p_lie layout False p)))
             (attachRelativePos xs)
-    newline
 
+p_declLevel :: ImportDeclLevel -> R ()
+p_declLevel = \case
+  ImportDeclSplice -> txt "splice"
+  ImportDeclQuote -> txt "quote"
+
 p_lie :: Layout -> Bool -> RelativePos -> IE GhcPs -> R ()
 p_lie encLayout isAllPrevDoc relativePos = \case
   IEVar mwarn l1 exportDoc -> do
@@ -131,7 +145,7 @@
   IEDoc NoExtField str ->
     indentDoc $
       p_hsDoc Pipe (Without #endNewline) str
-  IEDocNamed NoExtField str -> indentDoc $ txt $ "-- $" <> T.pack str
+  IEDocNamed NoExtField str -> indentDoc $ p_hsDocName str
   where
     -- Add a comma to a import-export list element
     withComma m =
@@ -182,6 +196,19 @@
   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
@@ -11,11 +11,15 @@
 where
 
 import Control.Monad
-import Data.Choice (pattern With)
+import Data.Choice (pattern Isn't, pattern With)
+import Data.Choice qualified as Choice
+import Data.Generics.Schemes (listify)
 import GHC.Hs hiding (comment)
+import GHC.LanguageExtensions (Extension (ImplicitPrelude))
 import GHC.Types.SrcLoc
 import Ormolu.Config
 import Ormolu.Imports (normalizeImports)
+import Ormolu.Imports.Grouping (GroupImportsOpts (..))
 import Ormolu.Parser.CommentStream
 import Ormolu.Parser.Pragma
 import Ormolu.Printer.Combinators
@@ -26,7 +30,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
@@ -40,27 +44,47 @@
   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
-    mapM_ (p_hsModuleHeader hsmod) hsmodName
-    newline
-    respectful <- getPrinterOpt poRespectful
-    localModules <- getLocalModules
-    importGrouping <- getPrinterOpt poImportGrouping
-    forM_ (normalizeImports respectful localModules importGrouping hsmodImports) $ \importGroup -> do
-      forM_ importGroup (located' p_hsmodImport)
+      p_pragmas pragmas
       newline
-    declNewline
-    switchLayout (getLocA <$> hsmodDecls) $ do
-      preserveSpacing <- getPrinterOpt poRespectful
-      (if preserveSpacing then p_hsDeclsRespectGrouping else p_hsDecls) Free hsmodDecls
+      mapM_ (p_hsModuleHeader hsmod) hsmodName
       newline
-      spitRemainingComments
+      importGroups <- normalizeImportsR hsmodImports
+      forM_ importGroups $ \importGroup -> do
+        -- 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_ importGroup $ \x -> do
+          located' p_hsmodImport x
+          newline
+        newline
+      declNewline
+      switchLayout (getLocA <$> hsmodDecls) $ do
+        preserveSpacing <- getPrinterOpt poRespectful
+        (if preserveSpacing then p_hsDeclsRespectGrouping else p_hsDecls) Free hsmodDecls
+        newline
+        spitRemainingComments
+  where
+    normalizeImportsR imports = do
+      implicitPrelude <- Choice.fromBool <$> isExtensionEnabled ImplicitPrelude
+      respectful <- getPrinterOpt poRespectful
+      localModules <- getLocalModules
+      importGrouping <- getPrinterOpt poImportGrouping
+      pure $
+        normalizeImports
+          GroupImportsOpts
+            { grouping = importGrouping,
+              respectful,
+              allComments = listify (const True) hsmod
+            }
+          localModules
+          implicitPrelude
+          imports
 
 p_hsModuleHeader :: HsModule GhcPs -> LocatedA ModuleName -> R ()
 p_hsModuleHeader HsModule {hsmodExt = XModulePs {..}, ..} moduleName = do
@@ -69,7 +93,7 @@
       getPrinterOpt poHaddockStyleModule >>= \case
         PrintStyleInherit -> getPrinterOpt poHaddockStyle
         PrintStyleOverride style -> pure style
-    forM_ hsmodHaddockModHeader (p_hsDoc' poHStyle Pipe (With #endNewline))
+    forM_ hsmodHaddockModHeader (p_hsDocWith poHStyle Pipe (With #endNewline) (Isn't #mayShareLine))
     p_hsmodName name
 
   forM_ hsmodDeprecMessage $ \w -> do
@@ -94,7 +118,8 @@
     Nothing -> return ()
     Just l -> do
       breakpointBeforeExportList
-      encloseLocated l $ \exports -> do
+      located l $ \exports -> do
+        when (null exports) $ locatedEmpty (locA l)
         inci (p_hsmodExports exports)
 
   breakpointBeforeWhere
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
@@ -1,10 +1,12 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 -- | Rendering of types.
 module Ormolu.Printer.Meat.Type
@@ -16,42 +18,40 @@
     p_hsTyVarBndr,
     ForAllVisibility (..),
     p_forallBndrs,
-    p_conDeclFields,
+    p_hsConDeclRecFields,
+    p_hsConDeclField,
+    p_hsConDeclFieldWithDoc,
     p_lhsTypeArg,
     p_hsSigType,
-    FunRepr (..),
-    ParsedFunRepr (..),
-    p_hsFun,
-    hsOuterTyVarBndrsToHsType,
     hsSigTypeToType,
     lhsTypeToSigType,
+
+    -- * Re-exports from Ormolu.Printer.Meat.Type.Function
+    FunRepr (..),
+    ParsedFunRepr,
+    ParsedFunRepr' (..),
+    p_hsFun,
   )
 where
 
 import Control.Monad
-import Control.Monad.Cont qualified as Cont
-import Control.Monad.State qualified as State
-import Control.Monad.Trans qualified as Trans
-import Data.Choice (Choice, pattern Is, pattern Isn't, pattern With, pattern Without)
-import Data.Choice qualified as Choice
-import Data.Foldable (traverse_)
-import Data.Functor ((<&>))
-import Data.List (sortOn)
-import Data.Maybe (isJust)
+import Data.Choice (pattern Is, pattern With, pattern Without)
+import Data.Maybe (fromMaybe)
 import GHC.Data.Strict qualified as Strict
 import GHC.Hs hiding (isPromoted)
 import GHC.Types.SourceText
 import GHC.Types.SrcLoc
 import GHC.Types.Var
-import GHC.Utils.Outputable (Outputable)
 import Ormolu.Config
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree (p_tyOpTree, tyOpTree)
 import Ormolu.Printer.Meat.Declaration.StringLiteral
 import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsUntypedSplice)
+import Ormolu.Printer.Meat.Type.Function
 import Ormolu.Printer.Operators
 import Ormolu.Utils
+import Prelude hiding (span)
 
 p_hsType :: HsType GhcPs -> R ()
 p_hsType = \case
@@ -70,7 +70,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
@@ -110,10 +110,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 (sitcc $ located t p_hsType)
   HsIParamTy _ n t -> sitcc $ do
     located n atom
@@ -137,31 +135,8 @@
     --       String
     --       -- | Age
     --       Int
-    usePipe <-
-      getPrinterOpt poFunctionArrows <&> \case
-        TrailingArrows -> True
-        LeadingArrows -> False
-        LeadingArgsArrows -> False
-    if usePipe
-      then do
-        p_hsDoc Pipe (With #endNewline) str
-        located t p_hsType
-      else do
-        located t p_hsType
-        newline
-        p_hsDoc Caret (Without #endNewline) str
-  HsBangTy _ (HsBang u s) t -> do
-    case u of
-      SrcUnpack -> txt "{-# UNPACK #-}" >> space
-      SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space
-      NoSrcUnpack -> return ()
-    case s of
-      SrcLazy -> txt "~"
-      SrcStrict -> txt "!"
-      NoSrcStrict -> return ()
-    located t p_hsType
-  HsRecTy _ fields ->
-    p_conDeclFields fields
+    withHaddocks (Is #end) (Just str) $ do
+      located t p_hsType
   HsExplicitListTy _ p xs -> do
     case p of
       IsPromoted -> txt "'"
@@ -189,7 +164,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
@@ -200,9 +188,14 @@
       _ -> False
 
 p_hsTypeAnnotation :: LHsType GhcPs -> R ()
-p_hsTypeAnnotation = p_hsFunParsed . ParsedFunSig . parseFunRepr
+p_hsTypeAnnotation ty =
+  p_hsFunParsed @(HsType GhcPs) $
+    ParsedFunSig
+      { sig = (),
+        next = parseFunRepr ty
+      }
 
--- | 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
@@ -215,106 +208,55 @@
 p_hsContext :: HsContext GhcPs -> R ()
 p_hsContext = p_hsContext' p_hsType
 
-p_hsContext' ::
-  (Outputable (GenLocated (Anno a) a), HasLoc (Anno a)) =>
-  (a -> R ()) ->
-  [XRec GhcPs a] ->
-  R ()
-p_hsContext' f = \case
-  [] -> txt "()"
-  [x] -> located x f
-  xs -> do
-    shouldSort <- getPrinterOpt poSortConstraints
-    let sort = if shouldSort then sortOn showOutputable else id
-    parens N $ sep commaDel (sitcc . located' f) (sort xs)
-
-class IsTyVarBndrFlag flag where
-  isInferred :: flag -> Bool
-  p_tyVarBndrFlag :: flag -> R ()
-  p_tyVarBndrFlag _ = pure ()
-
-instance IsTyVarBndrFlag () where
-  isInferred () = False
-
-instance IsTyVarBndrFlag Specificity where
-  isInferred = \case
-    InferredSpec -> True
-    SpecifiedSpec -> False
-
-instance IsTyVarBndrFlag (HsBndrVis GhcPs) where
-  isInferred _ = False
-  p_tyVarBndrFlag = \case
-    HsBndrRequired NoExtField -> pure ()
-    HsBndrInvisible _ -> txt "@"
-
-p_hsTyVarBndr :: (IsTyVarBndrFlag flag) => HsTyVarBndr flag GhcPs -> R ()
-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 -> inci $ p_hsTypeAnnotation k
-      HsBndrNoKind _ -> pure ()
-
-data ForAllVisibility = ForAllInvis | ForAllVis
-
--- | Render several @forall@-ed variables.
-p_forallBndrs ::
-  (HasLoc l) =>
-  ForAllVisibility ->
-  (a -> R ()) ->
-  [GenLocated l a] ->
-  R ()
-p_forallBndrs vis p tyvars = do
-  p_forallBndrsStart p tyvars
-  p_forallBndrsEnd (Without #extraSpace) vis
-
-p_forallBndrsStart :: (HasLoc l) => (a -> R ()) -> [GenLocated l a] -> R ()
-p_forallBndrsStart _ [] = token'forall
-p_forallBndrsStart p tyvars = do
-  switchLayout (locA <$> tyvars) $ do
-    token'forall
-    breakpoint
-    inci $ do
-      sitcc $ sep breakpoint (sitcc . located' p) tyvars
-
-p_forallBndrsEnd :: Choice "extraSpace" -> ForAllVisibility -> R ()
-p_forallBndrsEnd extraSpace = \case
-  ForAllInvis -> txt dot >> space
-  ForAllVis -> space >> token'rarrow
-  where
-    dot = if Choice.isTrue extraSpace then " ." else "."
-
-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 . recordBraces $ 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
-  commaStyle <- getPrinterOpt poCommaStyle
-  when (commaStyle == Trailing) $
-    mapM_ (p_hsDoc Pipe (With #endNewline)) cd_fld_doc
+p_hsConDeclRecField :: HsConDeclRecField GhcPs -> R ()
+p_hsConDeclRecField field@HsConDeclRecField {..} = withFieldHaddocks $ do
   sitcc $
     sep
       commaDel
       (located' (p_rdrName . foLabel))
-      cd_fld_names
-  inci $ p_hsTypeAnnotation cd_fld_type
-  when (commaStyle == Leading) $
-    mapM_ (inciByFrac (-1) . (newline >>) . p_hsDoc Caret (Without #endNewline)) cd_fld_doc
+      cdrf_names
+  inci $ p_hsFun field
+  where
+    withFieldHaddocks action = do
+      commaStyle <- getPrinterOpt poCommaStyle
+      let doc = cdf_doc cdrf_spec
+      when (commaStyle == Trailing) $
+        mapM_ (p_hsDocInline Pipe (With #endNewline)) doc
+      action
+      when (commaStyle == Leading) $
+        mapM_ (inciByFrac (-1) . (newline >>) . p_hsDocInline Caret (Without #endNewline)) doc
 
+-- | 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 = withHaddocks (Is #end) cdf.cdf_doc $ do
+  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"
@@ -322,54 +264,37 @@
 p_hsSigType :: HsSigType GhcPs -> R ()
 p_hsSigType = p_hsType . hsSigTypeToType
 
-----------------------------------------------------------------------------
--- Rendering function types
-
--- | The parsed representation of a function
-data ParsedFunRepr a
-  = ParsedFunSig (ParsedFunRepr a)
-  | ParsedFunForall
-      (LocatedA (HsForAllTelescope GhcPs))
-      (ParsedFunRepr a)
-  | ParsedFunQuals
-      [LocatedA (LocatedC [LocatedA a])]
-      (ParsedFunRepr a)
-  | -- | The argument, its optional docstring, and the arrow going to the next arg/return
-    ParsedFunArgs
-      [ LocatedA
-          ( LocatedA a,
-            Maybe (LHsDoc GhcPs),
-            HsArrowOf (LocatedA a) GhcPs
-          )
-      ]
-      (ParsedFunRepr a)
-  | ParsedFunReturn
-      ( LocatedA a,
-        Maybe (LHsDoc GhcPs)
-      )
-
-class (Anno a ~ SrcSpanAnnA, Outputable a) => FunRepr a where
-  renderFunItem :: a -> R ()
-
-  parseFunRepr :: LocatedA a -> ParsedFunRepr a
-
 instance FunRepr (HsType GhcPs) where
-  renderFunItem = p_hsType
   parseFunRepr = \case
     -- `forall a. _`
     L ann (HsForAllTy _ tele ty) ->
-      ParsedFunForall (L ann tele) (parseFunRepr ty)
+      ParsedFunForall
+        { tele = L ann tele,
+          next = parseFunRepr ty
+        }
     -- `HasCallStack => _`
     ty@(L _ HsQualTy {}) ->
       let (ctxs, rest) = getContexts ty
-       in ParsedFunQuals ctxs (parseFunRepr rest)
+       in ParsedFunQuals
+            { ctxs,
+              next = parseFunRepr rest
+            }
     -- `Int -> _`
-    ty@(L _ HsFunTy {}) ->
-      let (args, ret) = getArgsAndReturn ty
-       in ParsedFunArgs args (parseFunRepr ret)
+    L ann (HsFunTy _ multAnn l r) ->
+      let (arg, doc) =
+            case l of
+              L _ (HsDocTy _ x doc_) -> (x, Just doc_)
+              _ -> (l, Nothing)
+       in ParsedFunArg
+            { span = ann,
+              arg,
+              doc,
+              multAnn,
+              next = parseFunRepr r
+            }
     -- `_ -> Int`
-    L _ (HsDocTy _ ty doc) -> ParsedFunReturn (ty, Just doc)
-    ty -> ParsedFunReturn (ty, Nothing)
+    L _ (HsDocTy _ ret doc) -> ParsedFunReturn {ret, doc = Just doc}
+    ret -> ParsedFunReturn {ret, doc = Nothing}
     where
       getContexts =
         let go ctxs = \case
@@ -378,203 +303,106 @@
               ty ->
                 (reverse ctxs, ty)
          in go []
-      getArgsAndReturn =
-        let go args = \case
-              L ann (HsFunTy _ arrow (L _ (HsDocTy _ l doc)) r) ->
-                go (L ann (l, Just doc, arrow) : args) r
-              L ann (HsFunTy _ arrow l r) ->
-                go (L ann (l, Nothing, arrow) : args) r
-              ty ->
-                (reverse args, ty)
-         in go []
 
--- | For implementing function-arrows and related configuration, we'll collect
--- all the components of the function type first, then render as a block instead
--- of rendering each part independently, which will let us track local state
--- within a function type.
---
--- This function should be passed the first function-related construct we find;
--- see FunRepr for more details.
-p_hsFun :: (FunRepr a) => a -> R ()
-p_hsFun = p_hsFunParsed . parseFunRepr . L (noAnn @SrcSpanAnnA)
-
-p_hsFunParsed :: (FunRepr a) => ParsedFunRepr a -> R ()
-p_hsFunParsed fun = do
-  arrowsStyle <- getPrinterOpt poFunctionArrows
-  p_hsFunParsed' arrowsStyle fun
-
-type PrintHsFun x = State.StateT PrintHsFunState (Cont.ContT () R) x
-
-type PrintHsFunState =
-  ( Maybe (R ()), -- The leading delimiter to output at the next line
-    Choice "forceMultiline"
-  )
-
-p_hsFunParsed' ::
-  (FunRepr a) =>
-  FunctionArrowsStyle ->
-  ParsedFunRepr a ->
-  R ()
-p_hsFunParsed' arrowsStyle fun0 = Cont.evalContT . (`State.evalStateT` initialState) . go $ fun0
-  where
-    go = \case
-      ParsedFunSig fun' -> do
-        -- Should only happen at the very beginning, if at all
-        p_parsedFunSig
-        setMultilineContext fun'
-        go fun'
-      ParsedFunForall tele fun' -> do
-        p_parsedFunForall tele
-        setMultilineContext fun'
-        go fun'
-      ParsedFunQuals ctxs fun' -> do
-        p_parsedFunQuals ctxs
-        setMultilineContext fun'
-        go fun'
-      ParsedFunArgs args fun' -> do
-        p_parsedFunArgs args
-        go fun'
-      ParsedFunReturn ret -> do
-        p_parsedFunReturn ret
-
-    liftR = Trans.lift . Trans.lift
-    initialState = (Nothing, Without #forceMultiline)
-
-    withApplyLeadingDelim f = do
-      (leadingDelim, _) <- State.get
-      a <- f leadingDelim
-      State.modify $ \(_, x) -> (Nothing, x)
-      pure a
-    applyLeadingDelim = withApplyLeadingDelim (traverse_ liftR)
-
-    setLeadingDelim delim =
-      State.modify $ \(_, x) -> (Just delim, x)
-
-    getIsMultiline = do
-      (_, forceMultiline) <- State.get
-      layout <- liftR getLayout
-      pure $ Choice.toBool forceMultiline || layout == MultiLine
-
-    setMultilineContext fun =
-      State.modify $ \(x, _) -> (x, Choice.fromBool $ hasDocs fun)
-
-    -- Make everything afterwards occur within a located block, with the
-    -- magic of ContT. `item <- setLocated litem; ...` is equivalent to
-    -- `located litem $ \item -> ...`.
-    setLocated :: (HasLoc ann) => GenLocated ann x -> PrintHsFun x
-    setLocated litem = Trans.lift $ Cont.ContT (located litem)
-
-    p_parsedFunSig = do
-      if isTrailing (Isn't #argDelim)
-        then liftR $ do
-          space >> token'dcolon
-          if hasDocs fun0 then newline else breakpoint
-        else do
-          liftR breakpoint
-          setLeadingDelim (token'dcolon >> space)
-
-    p_parsedFunForall x@(L _ tele) = do
-      void $ setLocated x
-      applyLeadingDelim
-      vis <-
-        case tele of
-          HsForAllInvis _ bndrs -> do
-            liftR $ p_forallBndrsStart p_hsTyVarBndr bndrs
-            pure ForAllInvis
-          HsForAllVis _ bndrs -> do
-            liftR $ p_forallBndrsStart p_hsTyVarBndr bndrs
-            pure ForAllVis
-      isMultiline <- getIsMultiline
-      if isTrailing (Isn't #argDelim) || not isMultiline
-        then do
-          liftR $ p_forallBndrsEnd (Without #extraSpace) vis
-          interArgBreak
-        else do
-          interArgBreak
-          let extraSpace = if isMultiline then With #extraSpace else Without #extraSpace
-          setLeadingDelim (p_forallBndrsEnd extraSpace vis)
-
-    p_parsedFunQuals ctxs = do
-      -- we only want to set located on the first context
-      case ctxs of
-        ctx : _ -> void $ setLocated ctx
-        _ -> pure ()
-
-      forM_ ctxs $ \(L _ lctx) -> do
-        applyLeadingDelim
-        liftR $ located lctx (p_hsContext' renderFunItem)
-        if isTrailing (Isn't #argDelim)
-          then do
-            liftR $ space >> token'darrow
-            interArgBreak
-          else do
-            interArgBreak
-            setLeadingDelim (token'darrow >> space)
-
-    p_parsedFunArgs args = do
-      -- we only want to set located on the first arg
-      case args of
-        arg : _ -> void $ setLocated arg
-        _ -> pure ()
+  renderFunReprCtx = p_hsType
+  renderFunReprArg = p_hsType
+  renderFunReprMult = p_hsType
+  renderFunReprRet = p_hsType
 
-      forM_ args $ \(L _ (larg, doc, arrow)) -> do
-        let renderArrow = p_arrow (located' renderFunItem) arrow
-        withHaddocks (Isn't #end) doc $ do
-          withApplyLeadingDelim $ \applyLeadingDelim' ->
-            liftR . located larg $ \arg -> do
-              traverse_ id applyLeadingDelim'
-              renderFunItem arg
-          if isTrailing (Is #argDelim)
-            then do
-              liftR $ space >> renderArrow
-              interArgBreak
-            else do
-              interArgBreak
-              setLeadingDelim (renderArrow >> space)
+----------------------------------------------------------------------------
+-- FunRepr HsConDeclRecField
 
-    p_parsedFunReturn (ret, doc) = do
-      void $ setLocated ret
-      withHaddocks (Is #end) doc $ do
-        applyLeadingDelim
-        liftR $ located ret renderFunItem
+-- | FunRepr HsConDeclRecField renders a record field type annotation. If the
+-- record field has a function type, we want to render it as a function
+-- respecting `function-arrows`. For the most part, it behaves like HsTypeSig;
+-- however, record fields can have additional syntax not in normal function
+-- types, like specifying the multiplicity for the `::` or specifying
+-- UNPACK/strictness, so we need to handle this specially.
+instance FunRepr (HsConDeclRecField GhcPs) where
+  parseFunRepr (L _ HsConDeclRecField {..}) =
+    ParsedFunSig
+      { sig = cdrf_spec.cdf_multiplicity,
+        next = toRecFieldRepr False $ parseFunRepr cdrf_spec.cdf_type
+      }
+    where
+      toRecFieldRepr :: Bool -> ParsedFunRepr (HsType GhcPs) -> ParsedFunRepr (HsConDeclRecField GhcPs)
+      toRecFieldRepr seenArg = \case
+        ParsedFunSig {} -> error "parseFunRepr @HsType unexpectedly returned ParsedFunSig"
+        ParsedFunForall {..} ->
+          ParsedFunForall
+            { tele,
+              next = toRecFieldRepr seenArg next
+            }
+        ParsedFunQuals {..} ->
+          ParsedFunQuals
+            { ctxs,
+              next = toRecFieldRepr seenArg next
+            }
+        ParsedFunArg {..} ->
+          ParsedFunArg
+            { span,
+              arg =
+                let mUnpack =
+                      if not seenArg
+                        then Just cdrf_spec.cdf_unpack
+                        else Nothing
+                 in L (getLoc arg) (mUnpack, arg),
+              doc,
+              multAnn,
+              next = toRecFieldRepr True next
+            }
+        ParsedFunReturn {..} ->
+          ParsedFunReturn
+            { ret =
+                let mAnn =
+                      if not seenArg
+                        then Just (cdrf_spec.cdf_unpack, cdrf_spec.cdf_bang)
+                        else Nothing
+                 in L (getLoc ret) (mAnn, ret),
+              doc
+            }
 
-    withHaddocks isEnd doc m = do
-      isLeadingHaddock <-
-        liftR $
-          getPrinterOpt poHaddockLocSignature <&> \case
-            HaddockLocSigAuto ->
-              if isTrailing (Is #argDelim) then With #pipe else Without #pipe
-            HaddockLocSigLeading ->
-              With #pipe
-            HaddockLocSigTrailing ->
-              Without #pipe
+  type FunReprSig (HsConDeclRecField GhcPs) = HsMultAnnOf (LocatedA (HsType GhcPs)) GhcPs
+  renderFunReprSig multAnn = do
+    space
+    p_hsMultAnn (located' p_hsType) multAnn
+    space
+    token'dcolon
 
-      if Choice.isTrue isLeadingHaddock
-        then do
-          traverse (liftR . p_hsDoc Pipe (With #endNewline)) doc *> m
-        else do
-          let (pre, endNewline) =
-                if Choice.isTrue isEnd
-                  then (when (isJust doc) (liftR newline), Without #endNewline)
-                  else (pure (), With #endNewline)
-          m <* pre <* traverse (liftR . p_hsDoc Caret endNewline) doc
+  type FunReprCtx (HsConDeclRecField GhcPs) = HsType GhcPs
+  renderFunReprCtx = p_hsType
 
-    interArgBreak = do
-      isMultiline <- getIsMultiline
-      liftR $ if isMultiline then newline else breakpoint
+  -- Invariant: SrcUnpackedness should only be set for the first arg
+  type FunReprArg (HsConDeclRecField GhcPs) = (Maybe SrcUnpackedness, LocatedA (HsType GhcPs))
+  renderFunReprArg (mUnpacked, ty) =
+    p_hsConDeclField
+      CDF
+        { cdf_ext = error "unused",
+          cdf_unpack = fromMaybe NoSrcUnpack mUnpacked,
+          cdf_bang = NoSrcStrict,
+          cdf_multiplicity = error "unused",
+          cdf_type = ty,
+          cdf_doc = error "unused"
+        }
 
-    hasDocs = \case
-      ParsedFunSig fun -> hasDocs fun
-      ParsedFunForall _ fun -> hasDocs fun
-      ParsedFunQuals _ fun -> hasDocs fun
-      ParsedFunArgs args fun -> or [isJust doc | L _ (_, doc, _) <- args] || hasDocs fun
-      ParsedFunReturn (_, doc) -> isJust doc
+  type FunReprMult (HsConDeclRecField GhcPs) = HsType GhcPs
+  renderFunReprMult = p_hsType
 
-    isTrailing isArgDelim =
-      case arrowsStyle of
-        TrailingArrows -> True
-        LeadingArgsArrows -> not $ Choice.isTrue isArgDelim
-        LeadingArrows -> False
+  -- Invariant: SrcUnpackedness/SrcStrictness should only be set if there are
+  -- no args
+  type FunReprRet (HsConDeclRecField GhcPs) = (Maybe (SrcUnpackedness, SrcStrictness), LocatedA (HsType GhcPs))
+  renderFunReprRet (mAnn, ty) =
+    p_hsConDeclField
+      CDF
+        { cdf_ext = error "unused",
+          cdf_unpack = unpack,
+          cdf_bang = strictness,
+          cdf_multiplicity = error "unused",
+          cdf_type = ty,
+          cdf_doc = error "unused"
+        }
+    where
+      (unpack, strictness) = fromMaybe (NoSrcUnpack, NoSrcStrict) mAnn
 
 ----------------------------------------------------------------------------
 -- Conversion functions
diff --git a/src/Ormolu/Printer/Meat/Type/Function.hs b/src/Ormolu/Printer/Meat/Type/Function.hs
new file mode 100644
--- /dev/null
+++ b/src/Ormolu/Printer/Meat/Type/Function.hs
@@ -0,0 +1,493 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE NoFieldSelectors #-}
+{-# OPTIONS_GHC -Wno-partial-fields #-}
+
+-- | A Fourmolu-specific module for rendering function-like type signatures.
+module Ormolu.Printer.Meat.Type.Function
+  ( -- * PrintHsFun
+    PrintHsFun,
+    MonadR,
+
+    -- * ParsedFunRepr
+    ParsedFunRepr,
+    ParsedFunRepr' (..),
+    FunRepr (..),
+    p_hsFun,
+    p_hsFunParsed,
+
+    -- * forall
+    ForAllVisibility (..),
+    p_forallBndrs,
+
+    -- * TyVarBndr
+    p_hsTyVarBndr,
+
+    -- * Contexts
+    p_hsContext',
+
+    -- * Haddocks
+    withHaddocks,
+  )
+where
+
+import Control.Monad (forM_, void, when)
+import Control.Monad.Cont qualified as Cont
+import Control.Monad.State qualified as State
+import Control.Monad.Trans qualified as Trans
+import Data.Choice (Choice, pattern Is, pattern Isn't, pattern With, pattern Without)
+import Data.Choice qualified as Choice
+import Data.Foldable (traverse_)
+import Data.Functor ((<&>))
+import Data.List (sortOn)
+import Data.Maybe (isJust)
+import GHC.Hs
+import GHC.Types.SrcLoc (GenLocated (..))
+import GHC.Types.Var (Specificity (..))
+import GHC.Utils.Outputable (Outputable)
+import Ormolu.Config
+import Ormolu.Printer.Combinators
+import Ormolu.Printer.Meat.Common (p_arrow, p_hsDocInline, p_rdrName)
+import Ormolu.Utils (showOutputable)
+import Prelude hiding (span)
+
+{----- PrintHsFun -----}
+
+newtype PrintHsFun a = PrintHsFun (State.StateT PrintHsFunState (Cont.ContT () R) a)
+  deriving newtype (Functor, Applicative, Monad)
+
+data PrintHsFunState = PrintHsFunState
+  { -- | The leading delimiter to output at the next line
+    leadingDelim :: Maybe (R ()),
+    forceMultiline :: Bool,
+    -- | Whether we're currently printing args
+    inArgList :: Bool
+  }
+
+runPrintHsFun :: PrintHsFun () -> R ()
+runPrintHsFun (PrintHsFun m) = Cont.evalContT . (`State.evalStateT` initialState) $ m
+  where
+    initialState =
+      PrintHsFunState
+        { leadingDelim = Nothing,
+          forceMultiline = False,
+          inArgList = False
+        }
+
+class (Monad m) => MonadR m where
+  liftR :: R a -> m a
+
+instance MonadR R where
+  liftR = id
+
+instance MonadR PrintHsFun where
+  liftR = PrintHsFun . Trans.lift . Trans.lift
+
+withApplyLeadingDelim :: (Maybe (R ()) -> PrintHsFun a) -> PrintHsFun a
+withApplyLeadingDelim f = do
+  state <- PrintHsFun State.get
+  a <- f state.leadingDelim
+  PrintHsFun . State.put $ state {leadingDelim = Nothing}
+  pure a
+
+applyLeadingDelim :: PrintHsFun ()
+applyLeadingDelim = withApplyLeadingDelim (traverse_ liftR)
+
+setLeadingDelim :: R () -> PrintHsFun ()
+setLeadingDelim delim =
+  PrintHsFun . State.modify $ \state -> state {leadingDelim = Just delim}
+
+getIsMultiline :: PrintHsFun Bool
+getIsMultiline = do
+  state <- PrintHsFun State.get
+  layout <- liftR getLayout
+  pure $ state.forceMultiline || layout == MultiLine
+
+setMultilineContext :: ParsedFunRepr' sig ctx arg mult ret -> PrintHsFun ()
+setMultilineContext fun =
+  PrintHsFun . State.modify $ \state -> state {forceMultiline = hasDocs fun}
+
+getIsTrailing :: (MonadR m) => m (Choice "argDelim" -> Bool)
+getIsTrailing = do
+  arrowsStyle <- liftR $ getPrinterOpt poFunctionArrows
+  pure $ \isArgDelim ->
+    case arrowsStyle of
+      TrailingArrows -> True
+      LeadingArgsArrows -> not $ Choice.isTrue isArgDelim
+      LeadingArrows -> False
+
+getInArgList :: PrintHsFun Bool
+getInArgList = PrintHsFun . State.gets $ (.inArgList)
+
+setInArgList :: Bool -> PrintHsFun ()
+setInArgList x = PrintHsFun . State.modify $ \state -> state {inArgList = x}
+
+-- Make everything afterwards occur within a located block, with the
+-- magic of ContT. `item <- setLocated litem; ...` is equivalent to
+-- `located litem $ \item -> ...`.
+setLocated :: (HasLoc ann) => GenLocated ann x -> PrintHsFun x
+setLocated litem = PrintHsFun . Trans.lift $ Cont.ContT (located litem)
+
+setLocated_ :: (HasLoc ann) => GenLocated ann x -> PrintHsFun ()
+setLocated_ = void . setLocated
+
+{----- ParsedFunRepr -----}
+
+type ParsedFunRepr a =
+  ParsedFunRepr'
+    (FunReprSig a)
+    (FunReprCtx a)
+    (FunReprArg a)
+    (FunReprMult a)
+    (FunReprRet a)
+
+-- | The parsed representation of a function
+data ParsedFunRepr' sig ctx arg mult ret
+  = -- | The "::" delimiter. Invariant: must be first.
+    ParsedFunSig
+      { sig :: sig,
+        next :: ParsedFunRepr' sig ctx arg mult ret
+      }
+  | -- | The "forall a b." or "forall a b ->" construct.
+    ParsedFunForall
+      { tele :: LocatedA (HsForAllTelescope GhcPs),
+        next :: ParsedFunRepr' sig ctx arg mult ret
+      }
+  | -- | The "(A, B) =>" construct.
+    ParsedFunQuals
+      { ctxs :: [LocatedA (LocatedC [LocatedA ctx])],
+        next :: ParsedFunRepr' sig ctx arg mult ret
+      }
+  | ParsedFunArg
+      { span :: SrcSpanAnnA,
+        arg :: LocatedA arg,
+        doc :: Maybe (LHsDoc GhcPs),
+        multAnn :: HsMultAnnOf (LocatedA mult) GhcPs,
+        next :: ParsedFunRepr' sig ctx arg mult ret
+      }
+  | ParsedFunReturn
+      { ret :: LocatedA ret,
+        doc :: Maybe (LHsDoc GhcPs)
+      }
+
+class
+  ( Anno (FunReprCtx a) ~ SrcSpanAnnA,
+    Outputable (FunReprCtx a)
+  ) =>
+  FunRepr a
+  where
+  parseFunRepr :: LocatedA a -> ParsedFunRepr a
+
+  type FunReprSig a
+  type FunReprSig a = ()
+  renderFunReprSig :: FunReprSig a -> R ()
+  default renderFunReprSig :: (FunReprSig a ~ ()) => FunReprSig a -> R ()
+  renderFunReprSig () = space *> token'dcolon
+
+  type FunReprCtx a
+  type FunReprCtx a = a
+  renderFunReprCtx :: FunReprCtx a -> R ()
+
+  type FunReprArg a
+  type FunReprArg a = a
+  renderFunReprArg :: FunReprArg a -> R ()
+
+  type FunReprMult a
+  type FunReprMult a = a
+  renderFunReprMult :: FunReprMult a -> R ()
+
+  type FunReprRet a
+  type FunReprRet a = a
+  renderFunReprRet :: FunReprRet a -> R ()
+
+-- | Some functions rely on HsType having a FunRepr instance, but the instance
+-- can't be implemented here, since p_hsType is implemented in Type.hs, which
+-- would cause a circular dependency. So we'll add it as an explicit constraint
+-- and the call-site should bring the FunRepr instance for HsType in scope.
+type FunReprHsType =
+  ( FunRepr (HsType GhcPs),
+    FunReprSig (HsType GhcPs) ~ (),
+    FunReprCtx (HsType GhcPs) ~ HsType GhcPs,
+    FunReprArg (HsType GhcPs) ~ HsType GhcPs,
+    FunReprMult (HsType GhcPs) ~ HsType GhcPs,
+    FunReprRet (HsType GhcPs) ~ HsType GhcPs
+  )
+
+hasDocs :: ParsedFunRepr' ig ctx arg mult ret -> Bool
+hasDocs = \case
+  ParsedFunSig {next} -> hasDocs next
+  ParsedFunForall {next} -> hasDocs next
+  ParsedFunQuals {next} -> hasDocs next
+  ParsedFunArg {doc, next} -> isJust doc || hasDocs next
+  ParsedFunReturn {doc} -> isJust doc
+
+{----- Rendering ParsedFunRepr -----}
+
+-- | For implementing function-arrows and related configuration, we'll collect
+-- all the components of the function type first, then render as a block instead
+-- of rendering each part independently, which will let us track local state
+-- within a function type.
+--
+-- This function should be passed the first function-related construct we find;
+-- see FunRepr for more details.
+p_hsFun :: forall a. (FunRepr a, FunReprHsType) => a -> R ()
+p_hsFun = p_hsFunParsed @a . parseFunRepr . L (noAnn @SrcSpanAnnA)
+
+p_hsFunParsed :: forall a. (FunRepr a, FunReprHsType) => ParsedFunRepr a -> R ()
+p_hsFunParsed = runPrintHsFun . p_hsFunParsed' @a
+
+p_hsFunParsed' :: forall a. (FunRepr a, FunReprHsType) => ParsedFunRepr a -> PrintHsFun ()
+p_hsFunParsed' = \case
+  ParsedFunSig {sig, next} -> do
+    -- Should only happen at the very beginning, if at all
+    p_parsedFunSig @a sig next
+    setMultilineContext next
+    p_hsFunParsed' @a next
+  ParsedFunForall {tele, next} -> do
+    p_parsedFunForall tele
+    setMultilineContext next
+    p_hsFunParsed' @a next
+  ParsedFunQuals {ctxs, next} -> do
+    p_parsedFunQuals @a ctxs
+    setMultilineContext next
+    p_hsFunParsed' @a next
+  ParsedFunArg {span, arg, doc, multAnn, next} -> do
+    p_parsedFunArg @a span arg doc multAnn
+    case next of
+      ParsedFunArg {} -> pure ()
+      _ -> do
+        -- Don't reset multiline context within args; all args should be on
+        -- one line together, or all on separate lines
+        setMultilineContext next
+        -- Reset inArgList, needed if there are multiple arg lists in one
+        -- function type (e.g. `a -> Show a => b -> c`)
+        setInArgList False
+    p_hsFunParsed' @a next
+  ParsedFunReturn {ret, doc} -> do
+    p_parsedFunReturn @a ret doc
+
+p_parsedFunSig :: forall a. (FunRepr a) => FunReprSig a -> ParsedFunRepr a -> PrintHsFun ()
+p_parsedFunSig sig fun = do
+  isTrailing <- getIsTrailing
+  if isTrailing (Isn't #argDelim)
+    then liftR $ do
+      renderFunReprSig @a sig
+      if hasDocs fun then newline else breakpoint
+    else do
+      liftR breakpoint
+      setLeadingDelim (token'dcolon >> space)
+
+p_parsedFunForall :: (FunReprHsType) => LocatedA (HsForAllTelescope GhcPs) -> PrintHsFun ()
+p_parsedFunForall x@(L _ tele) = do
+  setLocated_ x
+  applyLeadingDelim
+  vis <-
+    case tele of
+      HsForAllInvis _ bndrs -> do
+        liftR $ p_forallBndrsStart p_hsTyVarBndr bndrs
+        pure ForAllInvis
+      HsForAllVis _ bndrs -> do
+        liftR $ p_forallBndrsStart p_hsTyVarBndr bndrs
+        pure ForAllVis
+
+  isTrailing <- getIsTrailing
+  isMultiline <- getIsMultiline
+  if isTrailing (Isn't #argDelim) || not isMultiline
+    then do
+      liftR $ p_forallBndrsEnd (Without #extraSpace) vis
+      interArgBreak
+    else do
+      interArgBreak
+      let extraSpace = if isMultiline then With #extraSpace else Without #extraSpace
+      setLeadingDelim (p_forallBndrsEnd extraSpace vis)
+
+p_parsedFunQuals :: forall a. (FunRepr a) => [LocatedA (LocatedC [LocatedA (FunReprCtx a)])] -> PrintHsFun ()
+p_parsedFunQuals ctxs = do
+  isTrailing <- getIsTrailing
+  -- we only want to set located on the first context
+  case ctxs of
+    ctx : _ -> setLocated_ ctx
+    _ -> pure ()
+
+  forM_ ctxs $ \(L _ lctx) -> do
+    applyLeadingDelim
+    liftR $ located lctx (p_hsContext' (renderFunReprCtx @a))
+    if isTrailing (Isn't #argDelim)
+      then do
+        liftR $ space >> token'darrow
+        interArgBreak
+      else do
+        interArgBreak
+        setLeadingDelim (token'darrow >> space)
+
+p_parsedFunArg ::
+  forall a.
+  (FunRepr a) =>
+  SrcSpanAnnA ->
+  LocatedA (FunReprArg a) ->
+  Maybe (LHsDoc GhcPs) ->
+  HsMultAnnOf (LocatedA (FunReprMult a)) GhcPs ->
+  PrintHsFun ()
+p_parsedFunArg span item doc multAnn = do
+  isTrailing <- getIsTrailing
+
+  -- We only want to set located on the first arg
+  inArgList <- getInArgList
+  when (not inArgList) $ do
+    setLocated_ (L span item)
+    setInArgList True
+
+  let renderArrow = p_arrow (located' (renderFunReprMult @a)) multAnn
+  withHaddocks (Isn't #end) doc $ do
+    withApplyLeadingDelim $ \applyLeadingDelim' ->
+      liftR . located item $ \arg -> do
+        traverse_ id applyLeadingDelim'
+        renderFunReprArg @a arg
+    if isTrailing (Is #argDelim)
+      then do
+        liftR $ space >> renderArrow
+        interArgBreak
+      else do
+        interArgBreak
+        setLeadingDelim (renderArrow >> space)
+
+p_parsedFunReturn ::
+  forall a.
+  (FunRepr a) =>
+  LocatedA (FunReprRet a) ->
+  Maybe (LHsDoc GhcPs) ->
+  PrintHsFun ()
+p_parsedFunReturn item doc = do
+  setLocated_ item
+  withHaddocks (Is #end) doc $ do
+    applyLeadingDelim
+    liftR $ located item (renderFunReprRet @a)
+
+{----- forall -----}
+
+data ForAllVisibility = ForAllInvis | ForAllVis
+
+-- | Render several @forall@-ed variables.
+p_forallBndrs ::
+  (HasLoc l) =>
+  ForAllVisibility ->
+  (a -> R ()) ->
+  [GenLocated l a] ->
+  R ()
+p_forallBndrs vis p tyvars = do
+  p_forallBndrsStart p tyvars
+  p_forallBndrsEnd (Without #extraSpace) vis
+
+p_forallBndrsStart :: (HasLoc l) => (a -> R ()) -> [GenLocated l a] -> R ()
+p_forallBndrsStart _ [] = token'forall
+p_forallBndrsStart p tyvars = do
+  switchLayout (locA <$> tyvars) $ do
+    token'forall
+    breakpoint
+    inci $ do
+      sitcc $ sep breakpoint (sitcc . located' p) tyvars
+
+p_forallBndrsEnd :: Choice "extraSpace" -> ForAllVisibility -> R ()
+p_forallBndrsEnd extraSpace = \case
+  ForAllInvis -> txt dot >> space
+  ForAllVis -> space >> token'rarrow
+  where
+    dot = if Choice.isTrue extraSpace then " ." else "."
+
+{----- HsTyVarBndr -----}
+
+class IsTyVarBndrFlag flag where
+  isInferred :: flag -> Bool
+  p_tyVarBndrFlag :: flag -> R ()
+  p_tyVarBndrFlag _ = pure ()
+
+instance IsTyVarBndrFlag () where
+  isInferred () = False
+
+instance IsTyVarBndrFlag Specificity where
+  isInferred = \case
+    InferredSpec -> True
+    SpecifiedSpec -> False
+
+instance IsTyVarBndrFlag (HsBndrVis GhcPs) where
+  isInferred _ = False
+  p_tyVarBndrFlag = \case
+    HsBndrRequired NoExtField -> pure ()
+    HsBndrInvisible _ -> txt "@"
+
+p_hsTyVarBndr ::
+  (IsTyVarBndrFlag flag, FunReprHsType) =>
+  HsTyVarBndr flag GhcPs -> R ()
+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 -> inci $ do
+        p_hsFunParsed @(HsType GhcPs) $
+          ParsedFunSig
+            { sig = (),
+              next = parseFunRepr k
+            }
+      HsBndrNoKind _ -> pure ()
+
+{----- Contexts -----}
+
+p_hsContext' ::
+  (Outputable (GenLocated (Anno a) a), HasLoc (Anno a)) =>
+  (a -> R ()) ->
+  [XRec GhcPs a] ->
+  R ()
+p_hsContext' f = \case
+  [] -> txt "()"
+  [x] -> located x f
+  xs -> do
+    shouldSort <- getPrinterOpt poSortConstraints
+    let sort = if shouldSort then sortOn showOutputable else id
+    parens N $ sep commaDel (sitcc . located' f) (sort xs)
+
+{----- Helpers -----}
+
+withHaddocks :: (MonadR m) => Choice "end" -> Maybe (LHsDoc GhcPs) -> m a -> m a
+withHaddocks isEnd doc m = do
+  isTrailing <- getIsTrailing
+  isLeadingHaddock <-
+    liftR $
+      getPrinterOpt poHaddockLocSignature <&> \case
+        HaddockLocSigAuto ->
+          if isTrailing (Is #argDelim) then With #pipe else Without #pipe
+        HaddockLocSigLeading ->
+          With #pipe
+        HaddockLocSigTrailing ->
+          Without #pipe
+
+  if Choice.isTrue isLeadingHaddock
+    then do
+      traverse (liftR . p_hsDocInline Pipe (With #endNewline)) doc *> m
+    else do
+      let (pre, endNewline) =
+            if Choice.isTrue isEnd
+              then (when (isJust doc) (liftR newline), Without #endNewline)
+              else (pure (), With #endNewline)
+      m <* pre <* traverse (liftR . p_hsDocInline Caret endNewline) doc
+
+interArgBreak :: PrintHsFun ()
+interArgBreak = do
+  isMultiline <- getIsMultiline
+  liftR $ if isMultiline then newline else breakpoint
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
@@ -91,7 +95,7 @@
 -- 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
@@ -166,7 +173,7 @@
   | Just rest <- isMagicComment "FOURMOLU_DISABLE" s = Just $ "{- FOURMOLU_DISABLE -}" <> rest
   | otherwise = Nothing
 
--- | 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, Enum, Bounded)
 
--- | 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,6 +8,7 @@
     combineSrcSpans',
     notImplemented,
     showOutputable,
+    containsHaddocks,
     splitDocString,
     incSpanLine,
     separatedByBlank,
@@ -19,6 +20,8 @@
   )
 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 +51,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,27 +70,37 @@
 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 :: Bool -> HsDocString -> [Text]
-splitDocString shouldEscapeCommentBraces docStr =
+splitDocString :: HsDocString -> [Text]
+splitDocString docStr =
   case r of
     [] -> [""]
     _ -> r
   where
     r =
-      fmap (escapeLeadingDollar . escapeCommentBraces)
+      fmap escapeLeadingDollar
         . dropPaddingSpace'
         . dropWhileEnd T.null
         . 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
@@ -117,12 +130,8 @@
            in if leadingSpace x
                 then dropSpace <$> xs
                 else xs
-    escapeCommentBraces =
-      if shouldEscapeCommentBraces
-        then T.replace "{-" "{\\-" . T.replace "-}" "-\\}"
-        else id
 
--- | Increment line number in a 'SrcSpan'.
+-- | Increment the line number in a 'SrcSpan'.
 incSpanLine :: Int -> SrcSpan -> SrcSpan
 incSpanLine i = \case
   RealSrcSpan s _ ->
@@ -148,7 +157,8 @@
 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))
@@ -169,7 +179,7 @@
   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/Fixity.hs b/src/Ormolu/Utils/Fixity.hs
--- a/src/Ormolu/Utils/Fixity.hs
+++ b/src/Ormolu/Utils/Fixity.hs
@@ -24,9 +24,9 @@
 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
@@ -69,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/Glob.hs b/src/Ormolu/Utils/Glob.hs
--- a/src/Ormolu/Utils/Glob.hs
+++ b/src/Ormolu/Utils/Glob.hs
@@ -1,6 +1,7 @@
 module Ormolu.Utils.Glob
   ( Glob,
     mkGlob,
+    matchAllGlob,
     matchesGlob,
   )
 where
@@ -31,6 +32,9 @@
       t ->
         let (m, t') = break (== '*') t
          in MatchExactly m : parsePart t'
+
+matchAllGlob :: Glob
+matchAllGlob = Glob [DoubleWildcard]
 
 matchesGlob :: String -> Glob -> Bool
 matchesGlob s (Glob ps) = s `matchesGlobParts` ps
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
@@ -16,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.
@@ -30,25 +30,36 @@
   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))
 
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/Config/PrinterOptsSpec.hs b/tests/Ormolu/Config/PrinterOptsSpec.hs
--- a/tests/Ormolu/Config/PrinterOptsSpec.hs
+++ b/tests/Ormolu/Config/PrinterOptsSpec.hs
@@ -13,6 +13,7 @@
 import Control.Monad (forM_, when)
 import Data.Algorithm.DiffContext qualified as Diff
 import Data.Char (isSpace)
+import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Maybe (isJust)
 import Data.Set qualified as S
@@ -26,7 +27,7 @@
 import Ormolu.Config
 import Ormolu.Exception (OrmoluException, printOrmoluException)
 import Ormolu.Terminal (runTerm)
-import Ormolu.Utils.Glob (mkGlob)
+import Ormolu.Utils.Glob (matchAllGlob, mkGlob)
 import Path
   ( File,
     Path,
@@ -111,6 +112,24 @@
           checkIdempotence = True
         },
       TestGroup
+        { label = "record-style",
+          isMulti = False,
+          testCases = liftA2 (,) allOptions allOptions,
+          updateConfig = \(recordStyle, commaStyle) opts ->
+            opts
+              { poRecordStyle = pure recordStyle,
+                -- Test record style in combination with comma style
+                poCommaStyle = pure commaStyle,
+                -- Makes the indentation more visible
+                poIndentation = pure 4
+              },
+          showTestCase = \(recordStyle, commaStyle) ->
+            [ renderPrinterOpt recordStyle,
+              renderPrinterOpt commaStyle
+            ],
+          checkIdempotence = True
+        },
+      TestGroup
         { label = "import-export",
           isMulti = True,
           testCases = allOptions,
@@ -130,62 +149,7 @@
               ImportGroupByQualified,
               ImportGroupByScope,
               ImportGroupByScopeThenQualified,
-              ImportGroupCustom . NonEmpty.fromList $
-                [ ImportGroup
-                    { igName = Nothing,
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchGlob (mkGlob "Data.Text"),
-                                igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
-                                igrPriority = defaultImportRulePriority
-                              }
-                          ]
-                    },
-                  ImportGroup
-                    { igName = Nothing,
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchAllModules,
-                                igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
-                                igrPriority = ImportRulePriority 100
-                              }
-                          ]
-                    },
-                  ImportGroup
-                    { igName = Nothing,
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchGlob (mkGlob "SomeInternal.**"),
-                                igrQualifiedMatcher = MatchQualifiedOnly,
-                                igrPriority = defaultImportRulePriority
-                              },
-                            ImportGroupRule
-                              { igrModuleMatcher = MatchGlob (mkGlob "Unknown.**"),
-                                igrQualifiedMatcher = MatchUnqualifiedOnly,
-                                igrPriority = defaultImportRulePriority
-                              }
-                          ]
-                    },
-                  ImportGroup
-                    { igName = Nothing,
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchLocalModules,
-                                igrQualifiedMatcher = MatchUnqualifiedOnly,
-                                igrPriority = defaultImportRulePriority
-                              },
-                            ImportGroupRule
-                              { igrModuleMatcher = MatchAllModules,
-                                igrQualifiedMatcher = MatchQualifiedOnly,
-                                igrPriority = defaultImportRulePriority
-                              }
-                          ]
-                    }
-                ]
+              ImportGroupCustom importGroupCustomRules
             ],
           updateConfig = \igs opts ->
             opts
@@ -446,7 +410,7 @@
         Nothing ->
           expectationFailure "Output does not exist. Try running with ORMOLU_REGENERATE_EXAMPLES=1"
         Just expected ->
-          when (actual /= expected) $
+          when (actual /= expected) $ do
             expectationFailure . T.unpack $
               getDiff ("actual", actual) ("expected", expected)
 
@@ -496,9 +460,9 @@
 
 getDiff :: (String, Text) -> (String, Text) -> Text
 getDiff (s1Name, s1) (s2Name, s2) =
-  T.pack . Doc.render $
-    Diff.prettyContextDiff (Doc.text s1Name) (Doc.text s2Name) (Doc.text . T.unpack . Diff.unnumber) $
-      Diff.getContextDiff (Just 2) (T.lines s1) (T.lines s2)
+  T.pack . Doc.render
+    $ Diff.prettyContextDiff (Doc.text s1Name) (Doc.text s2Name) (Doc.text . T.unpack . Diff.unnumber)
+    $ Diff.getContextDiff (Just 2) (T.lines s1) (T.lines s2)
 
 renderOrmoluException :: OrmoluException -> IO String
 renderOrmoluException e =
@@ -525,3 +489,58 @@
 spanEnd f xs =
   let xs' = reverse xs
    in (reverse $ dropWhile f xs', reverse $ takeWhile f xs')
+
+importGroupCustomRules :: NonEmpty ImportGroup
+importGroupCustomRules =
+  NonEmpty.fromList
+    [ defaultImportGroup . NonEmpty.fromList $
+        [ defaultImportGroupRule
+            { igrImportListMatcher = MatchWholeModuleImport,
+              igrQualifiedMatcher = MatchUnqualifiedOnly
+            }
+        ],
+      defaultImportGroup . NonEmpty.fromList $
+        [ defaultImportGroupRule {igrGlob = mkGlob "Data.Text"}
+        ],
+      defaultImportGroup . NonEmpty.fromList $
+        [ defaultImportGroupRule
+            { igrPriority = ImportRulePriority 100
+            }
+        ],
+      defaultImportGroup . NonEmpty.fromList $
+        [ defaultImportGroupRule
+            { igrGlob = mkGlob "SomeInternal.**",
+              igrQualifiedMatcher = MatchQualifiedOnly
+            },
+          defaultImportGroupRule
+            { igrGlob = mkGlob "Unknown.**",
+              igrQualifiedMatcher = MatchUnqualifiedOnly
+            }
+        ],
+      defaultImportGroup . NonEmpty.fromList $
+        [ defaultImportGroupRule
+            { igrQualifiedMatcher = MatchUnqualifiedOnly,
+              igrScopeMatcher = MatchLocalModules
+            },
+          defaultImportGroupRule
+            { igrQualifiedMatcher = MatchQualifiedOnly
+            }
+        ]
+    ]
+  where
+    defaultImportGroup :: NonEmpty ImportGroupRule -> ImportGroup
+    defaultImportGroup rules =
+      ImportGroup
+        { igName = Nothing,
+          igRules = rules
+        }
+
+    defaultImportGroupRule :: ImportGroupRule
+    defaultImportGroupRule =
+      ImportGroupRule
+        { igrGlob = matchAllGlob,
+          igrImportListMatcher = MatchAnyImportDeclaration,
+          igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
+          igrScopeMatcher = MatchAllModules,
+          igrPriority = defaultImportRulePriority
+        }
diff --git a/tests/Ormolu/ConfigSpec.hs b/tests/Ormolu/ConfigSpec.hs
--- a/tests/Ormolu/ConfigSpec.hs
+++ b/tests/Ormolu/ConfigSpec.hs
@@ -3,14 +3,16 @@
 -- | Tests for Fourmolu file configuration.
 module Ormolu.ConfigSpec (spec) where
 
+import Control.Monad ((>=>))
 import Data.ByteString.Char8 qualified as Char8
 import Data.List (isInfixOf)
+import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Map qualified as Map
 import Data.Yaml qualified as Yaml
-import Ormolu.Config (FourmoluConfig (..), ImportGroup (..), ImportGroupRule (..), ImportGrouping (..), ImportModuleMatcher (..), ImportRulePriority (ImportRulePriority), PrinterOpts (..), QualifiedImportMatcher (MatchBothQualifiedAndUnqualified, MatchQualifiedOnly, MatchUnqualifiedOnly), defaultImportRulePriority, matchAllRulePriority, resolvePrinterOpts)
+import Ormolu.Config
 import Ormolu.Fixity (ModuleReexports (..))
-import Ormolu.Utils.Glob (mkGlob)
+import Ormolu.Utils.Glob (matchAllGlob, mkGlob)
 import Test.Hspec
 
 spec :: Spec
@@ -71,165 +73,84 @@
             [ "import-grouping:",
               "  - name: Some name",
               "    rules:",
-              "      - match: all"
+              "      - {}"
             ]
         let actualStrategy = poImportGrouping (cfgFilePrinterOpts config)
             expectedRules =
               NonEmpty.fromList
                 [ ImportGroup
                     { igName = Just "Some name",
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchAllModules,
-                                igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
-                                igrPriority = matchAllRulePriority
-                              }
-                          ]
-                    }
-                ]
-        actualStrategy `shouldBe` Just (ImportGroupCustom expectedRules)
-      it "enables the 'qualified' rule option" $ do
-        config <-
-          Yaml.decodeThrow . Char8.pack . unlines $
-            [ "import-grouping:",
-              "  - rules:",
-              "      - glob: \"**\"",
-              "        qualified: yes"
-            ]
-        let actualStrategy = poImportGrouping (cfgFilePrinterOpts config)
-            expectedRules =
-              NonEmpty.fromList
-                [ ImportGroup
-                    { igName = Nothing,
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchGlob (mkGlob "**"),
-                                igrQualifiedMatcher = MatchQualifiedOnly,
-                                igrPriority = defaultImportRulePriority
-                              }
-                          ]
-                    }
-                ]
-        actualStrategy `shouldBe` Just (ImportGroupCustom expectedRules)
-      it "disables the 'qualified' rule option" $ do
-        config <-
-          Yaml.decodeThrow . Char8.pack . unlines $
-            [ "import-grouping:",
-              "  - rules:",
-              "      - glob: \"**\"",
-              "        qualified: no"
-            ]
-        let actualStrategy = poImportGrouping (cfgFilePrinterOpts config)
-            expectedRules =
-              NonEmpty.fromList
-                [ ImportGroup
-                    { igName = Nothing,
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchGlob (mkGlob "**"),
-                                igrQualifiedMatcher = MatchUnqualifiedOnly,
-                                igrPriority = defaultImportRulePriority
-                              }
-                          ]
-                    }
-                ]
-        actualStrategy `shouldBe` Just (ImportGroupCustom expectedRules)
-      it "decodes the 'priority' rule option" $ do
-        config <-
-          Yaml.decodeThrow . Char8.pack . unlines $
-            [ "import-grouping:",
-              "  - rules:",
-              "      - match: all",
-              "        priority: 55"
-            ]
-        let actualStrategy = poImportGrouping (cfgFilePrinterOpts config)
-            expectedRules =
-              NonEmpty.fromList
-                [ ImportGroup
-                    { igName = Nothing,
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchAllModules,
-                                igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
-                                igrPriority = ImportRulePriority 55
-                              }
-                          ]
-                    }
-                ]
-        actualStrategy `shouldBe` Just (ImportGroupCustom expectedRules)
-      it "parses a 'glob' rule" $ do
-        config <-
-          Yaml.decodeThrow . Char8.pack . unlines $
-            [ "import-grouping:",
-              "  - rules:",
-              "      - glob: Data.Text.**"
-            ]
-        let actualStrategy = poImportGrouping (cfgFilePrinterOpts config)
-            expectedRules =
-              NonEmpty.fromList
-                [ ImportGroup
-                    { igName = Nothing,
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchGlob (mkGlob "Data.Text.**"),
-                                igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
-                                igrPriority = defaultImportRulePriority
-                              }
-                          ]
-                    }
-                ]
-        actualStrategy `shouldBe` Just (ImportGroupCustom expectedRules)
-      it "parses a 'match' rule for local modules" $ do
-        config <-
-          Yaml.decodeThrow . Char8.pack . unlines $
-            [ "import-grouping:",
-              "  - rules:",
-              "      - match: local-modules"
-            ]
-        let actualStrategy = poImportGrouping (cfgFilePrinterOpts config)
-            expectedRules =
-              NonEmpty.fromList
-                [ ImportGroup
-                    { igName = Nothing,
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchLocalModules,
-                                igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
-                                igrPriority = defaultImportRulePriority
-                              }
-                          ]
-                    }
-                ]
-        actualStrategy `shouldBe` Just (ImportGroupCustom expectedRules)
-      it "parses a 'match' rule for all modules" $ do
-        config <-
-          Yaml.decodeThrow . Char8.pack . unlines $
-            [ "import-grouping:",
-              "  - rules:",
-              "      - match: all"
-            ]
-        let actualStrategy = poImportGrouping (cfgFilePrinterOpts config)
-            expectedRules =
-              NonEmpty.fromList
-                [ ImportGroup
-                    { igName = Nothing,
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchAllModules,
-                                igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
-                                igrPriority = matchAllRulePriority
-                              }
-                          ]
+                      igRules = NonEmpty.fromList [defaultImportGroupRule]
                     }
                 ]
         actualStrategy `shouldBe` Just (ImportGroupCustom expectedRules)
+
+      let checkRule :: (HasCallStack) => String -> String -> ImportGroupRule -> SpecWith ()
+          checkRule desc yamlRuleConfig expectedRuleConfig =
+            it ("parses " ++ desc) $ do
+              let yamlConfig =
+                    unlines
+                      [ "import-grouping:",
+                        "  - rules:",
+                        "      - " ++ yamlRuleConfig
+                      ]
+
+                  downCustomRules (ImportGroupCustom customRules) = Just customRules
+                  downCustomRules _ = Nothing
+                  downSingleton (a :| []) = Just a
+                  downSingleton _ = Nothing
+                  accessTestedRule = downCustomRules >=> downSingleton >=> downSingleton . igRules
+
+              config <- Yaml.decodeThrow (Char8.pack yamlConfig)
+
+              let actualStrategy = poImportGrouping (cfgFilePrinterOpts config)
+              case actualStrategy >>= accessTestedRule of
+                Nothing -> expectationFailure "A single tested rule change was expected"
+                Just actualRule -> actualRule `shouldBe` expectedRuleConfig
+
+          checkRuleAttribute :: (HasCallStack) => String -> String -> (ImportGroupRule -> ImportGroupRule) -> SpecWith ()
+          checkRuleAttribute desc yamlRuleConfig applyExpectedChange = do
+            let baseArbitraryYamlConfig = "glob: \"**\""
+                yamlConfig = "{ " ++ baseArbitraryYamlConfig ++ ", " ++ yamlRuleConfig ++ "}"
+
+                baseArbitraryConfig = defaultImportGroupRule {igrGlob = matchAllGlob}
+                expectedRuleConfig = applyExpectedChange baseArbitraryConfig
+            checkRule
+              ("rules with the " ++ desc ++ " rule option")
+              yamlConfig
+              expectedRuleConfig
+
+      checkRule "the 'glob' rule" "glob: Data.Text.**" defaultImportGroupRule {igrGlob = mkGlob "Data.Text.**"}
+      checkRule "the default 'glob' rule (match all modules)" "{}" defaultImportGroupRule {igrGlob = mkGlob "**"}
+
+      checkRuleAttribute "'any' import list" "import-list: any" $ \config -> config {igrImportListMatcher = MatchAnyImportDeclaration}
+      checkRuleAttribute "'explicit' import list" "import-list: explicit" $ \config -> config {igrImportListMatcher = MatchExplicitImportList}
+      checkRuleAttribute "'hiding' import list" "import-list: hiding" $ \config -> config {igrImportListMatcher = MatchHidingImportClause}
+      checkRuleAttribute "'none' import list" "import-list: none" $ \config -> config {igrImportListMatcher = MatchWholeModuleImport}
+      checkRuleAttribute "default import list" "" $ \config -> config {igrImportListMatcher = MatchAnyImportDeclaration}
+
+      checkRuleAttribute "'qualified: yes'" "qualified: yes" $ \config -> config {igrQualifiedMatcher = MatchQualifiedOnly}
+      checkRuleAttribute "'qualified: no'" "qualified: no" $ \config -> config {igrQualifiedMatcher = MatchUnqualifiedOnly}
+      checkRuleAttribute "default 'qualified' (match any)" "" $ \config -> config {igrQualifiedMatcher = MatchBothQualifiedAndUnqualified}
+
+      checkRuleAttribute "'scope: any'" "scope: any" $ \config -> config {igrScopeMatcher = MatchAllModules}
+      checkRuleAttribute "'scope: local'" "scope: local" $ \config -> config {igrScopeMatcher = MatchLocalModules}
+      checkRuleAttribute "'scope: external'" "scope: external" $ \config -> config {igrScopeMatcher = MatchExternalModules}
+      checkRuleAttribute "default 'scope' (match all)" "" $ \config -> config {igrScopeMatcher = MatchAllModules}
+
+      checkRuleAttribute "'priority' (55 priority example)" "priority: 55" $ \config -> config {igrPriority = ImportRulePriority 55}
+      checkRuleAttribute "'priority' (80 priority example)" "priority: 80" $ \config -> config {igrPriority = ImportRulePriority 80}
+      checkRuleAttribute "default 'priority' (50)" "" $ \config -> config {igrPriority = ImportRulePriority 50}
+
+      checkRule
+        "the legacy 'match' rule for all modules (with a 100 priority)"
+        "match: all"
+        defaultImportGroupRule {igrGlob = mkGlob "**", igrScopeMatcher = MatchAllModules, igrPriority = ImportRulePriority 100}
+      checkRule
+        "the legacy 'match' rule for local modules"
+        "match: local-modules"
+        defaultImportGroupRule {igrGlob = mkGlob "**", igrScopeMatcher = MatchLocalModules, igrPriority = ImportRulePriority 60}
+
       it "parses multiple group configurations and rules in their order of appearance in the configuration" $ do
         config <-
           Yaml.decodeThrow . Char8.pack . unlines $
@@ -240,7 +161,6 @@
               "  - name: The rest",
               "    rules:",
               "      - match: all",
-              "        priority: 100",
               "  - name: My internals and monads unqualified",
               "    rules:",
               "      - match: local-modules",
@@ -262,68 +182,31 @@
               NonEmpty.fromList
                 [ ImportGroup
                     { igName = Just "Text modules",
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchGlob (mkGlob "Data.Text"),
-                                igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
-                                igrPriority = defaultImportRulePriority
-                              }
-                          ]
+                      igRules = NonEmpty.fromList [defaultImportGroupRule {igrGlob = mkGlob "Data.Text"}]
                     },
                   ImportGroup
                     { igName = Just "The rest",
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchAllModules,
-                                igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
-                                igrPriority = ImportRulePriority 100
-                              }
-                          ]
+                      igRules = NonEmpty.fromList [defaultImportGroupRule {igrGlob = matchAllGlob, igrPriority = ImportRulePriority 100}]
                     },
                   ImportGroup
                     { igName = Just "My internals and monads unqualified",
                       igRules =
                         NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchLocalModules,
-                                igrQualifiedMatcher = MatchUnqualifiedOnly,
-                                igrPriority = defaultImportRulePriority
-                              },
-                            ImportGroupRule
-                              { igrModuleMatcher = MatchGlob (mkGlob "Control.Monad"),
-                                igrQualifiedMatcher = MatchUnqualifiedOnly,
-                                igrPriority = defaultImportRulePriority
-                              }
+                          [ defaultImportGroupRule {igrQualifiedMatcher = MatchUnqualifiedOnly, igrScopeMatcher = MatchLocalModules, igrPriority = ImportRulePriority 60},
+                            defaultImportGroupRule {igrGlob = mkGlob "Control.Monad", igrQualifiedMatcher = MatchUnqualifiedOnly}
                           ]
                     },
                   ImportGroup
                     { igName = Just "My internals and monads qualified",
                       igRules =
                         NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchLocalModules,
-                                igrQualifiedMatcher = MatchQualifiedOnly,
-                                igrPriority = defaultImportRulePriority
-                              },
-                            ImportGroupRule
-                              { igrModuleMatcher = MatchGlob (mkGlob "Control.Monad"),
-                                igrQualifiedMatcher = MatchQualifiedOnly,
-                                igrPriority = defaultImportRulePriority
-                              }
+                          [ defaultImportGroupRule {igrQualifiedMatcher = MatchQualifiedOnly, igrScopeMatcher = MatchLocalModules, igrPriority = ImportRulePriority 60},
+                            defaultImportGroupRule {igrGlob = mkGlob "Control.Monad", igrQualifiedMatcher = MatchQualifiedOnly}
                           ]
                     },
                   ImportGroup
                     { igName = Just "Specific monads",
-                      igRules =
-                        NonEmpty.fromList
-                          [ ImportGroupRule
-                              { igrModuleMatcher = MatchGlob (mkGlob "Control.Monad.**"),
-                                igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
-                                igrPriority = defaultImportRulePriority
-                              }
-                          ]
+                      igRules = NonEmpty.fromList [defaultImportGroupRule {igrGlob = mkGlob "Control.Monad.**"}]
                     }
                 ]
         actualStrategy `shouldBe` Just (ImportGroupCustom expectedRules)
@@ -332,9 +215,19 @@
               Yaml.decodeEither' @FourmoluConfig . Char8.pack . unlines $
                 [ "import-grouping:",
                   "  - rules:",
-                  "      - some-unknown-rule-type: whatever"
+                  "      - match: whatever"
                 ]
             isAnUnknownModuleMatcher e = case e of
-              Left (Yaml.AesonException msg) -> "Unknown or invalid module matcher" `isInfixOf` msg
+              Left (Yaml.AesonException msg) -> "Unknown legacy match value" `isInfixOf` msg
               _ -> False
         decodeResult `shouldSatisfy` isAnUnknownModuleMatcher
+
+defaultImportGroupRule :: ImportGroupRule
+defaultImportGroupRule =
+  ImportGroupRule
+    { igrGlob = matchAllGlob,
+      igrImportListMatcher = MatchAnyImportDeclaration,
+      igrQualifiedMatcher = MatchBothQualifiedAndUnqualified,
+      igrScopeMatcher = MatchAllModules,
+      igrPriority = defaultImportRulePriority
+    }
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
@@ -214,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
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/Integration/Utils.hs b/tests/Ormolu/Integration/Utils.hs
--- a/tests/Ormolu/Integration/Utils.hs
+++ b/tests/Ormolu/Integration/Utils.hs
@@ -10,15 +10,16 @@
 where
 
 import Control.Monad (when)
-import System.Directory (findExecutable)
+import System.Directory (findExecutable, makeAbsolute)
 import System.Environment (getEnvironment)
 import System.Exit (ExitCode (..))
 import System.Process (CreateProcess (..), readCreateProcessWithExitCode)
 import System.Process qualified as Process
 
 -- | Find a `fourmolu` executable on PATH.
+-- Needs to be absolute to work around https://github.com/haskell/cabal/issues/11598
 getFourmoluExe :: IO FilePath
-getFourmoluExe = findExecutable "fourmolu" >>= maybe (fail "Could not find fourmolu executable") return
+getFourmoluExe = findExecutable "fourmolu" >>= maybe (fail "Could not find fourmolu executable") makeAbsolute
 
 -- | Like 'System.Process.readProcess', except without specifying stdin and
 -- with better failure messages.
diff --git a/tests/Ormolu/PrinterSpec.hs b/tests/Ormolu/PrinterSpec.hs
--- a/tests/Ormolu/PrinterSpec.hs
+++ b/tests/Ormolu/PrinterSpec.hs
@@ -7,16 +7,14 @@
 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 Data.Yaml qualified as Yaml
 import Ormolu
 import Ormolu.Config
-import Ormolu.Fixity
+import Ormolu.TestConfig
 import Path
 import Path.IO
 import System.Environment (lookupEnv)
@@ -35,46 +33,20 @@
       <$> [(ormoluPrinterOpts, "ormolu", "-out"), (defaultPrinterOpts, "fourmolu", "-four-out")]
       <*> es
 
--- | Fixity overrides that are to be used with the test examples.
-testsuiteOverrides :: FixityOverrides
-testsuiteOverrides =
-  FixityOverrides
-    ( Map.fromList
-        [ (".=", FixityInfo InfixR 8),
-          ("#", FixityInfo InfixR 5),
-          (">~<", FixityInfo InfixR 3),
-          ("|~|", FixityInfo InfixR 3.3),
-          ("<~>", FixityInfo InfixR 3.7)
-        ]
-    )
-
 -- | Check a single given example.
 checkExample :: (PrinterOptsTotal, String, String) -> Path Rel File -> Spec
 checkExample (printerOpts, label, suffix) srcPath' = it (fromRelFile srcPath' ++ " works (" ++ label ++ ")") . withNiceExceptions $ do
   let srcPath = examplesDir </> srcPath'
       inputPath = fromRelFile srcPath
-      config =
-        defaultConfig
-          { cfgPrinterOpts = printerOpts,
-            cfgSourceType = detectSourceType inputPath,
-            cfgFixityOverrides = testsuiteOverrides,
-            cfgDependencies =
-              Set.fromList
-                [ "base",
-                  "esqueleto",
-                  "hspec",
-                  "lens",
-                  "servant"
-                ]
-          }
+      config = (exampleConfig inputPath) {cfgPrinterOpts = printerOpts}
   expectedOutputPath <- deriveOutput srcPath suffix
-  -- 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
@@ -84,20 +56,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 -> String -> IO (Path Rel File)
 deriveOutput path suffix =
   parseRelFile $
@@ -125,7 +97,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)
+        ]
+    )