diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,90 @@
+## 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:
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
@@ -22,24 +22,22 @@
 * [Contributing](#contributing)
 * [License](#license)
 
-Fourmolu is a formatter for Haskell source code. It is a fork of [Ormolu](https://github.com/mrkkrp/ormolu), with upstream improvements continually merged.
+Fourmolu is a formatter for Haskell source code. It is a fork of [Ormolu](https://github.com/tweag/ormolu), with upstream improvements continually merged.
 
 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.
 
@@ -78,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
@@ -104,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
@@ -126,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:
 
@@ -156,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:
@@ -205,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.
 
@@ -239,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)
@@ -246,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
 
@@ -264,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/mrkkrp/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)
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/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/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/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/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
@@ -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
@@ -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-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/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/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/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/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
--- a/data/examples/import/data-four-out.hs
+++ b/data/examples/import/data-four-out.hs
@@ -1,3 +1,7 @@
 module Bar (data P, T (data P), data f) where
 
-import N (T (data P), data P, data f)
+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
--- a/data/examples/import/data-out.hs
+++ b/data/examples/import/data-out.hs
@@ -1,3 +1,7 @@
 module Bar (data P, T (data P), data f) where
 
-import N (T (data P), data P, data f)
+import N
+  ( T (data P),
+    data P,
+    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
--- a/data/examples/import/explicit-level-imports-four-out.hs
+++ b/data/examples/import/explicit-level-imports-four-out.hs
@@ -9,5 +9,8 @@
 import Data.ByteString.Lazy quote (d)
 import splice Data.Text (a, b, c)
 import PyF ()
-import splice PyF (fmt, tmf)
+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
--- a/data/examples/import/explicit-level-imports-out.hs
+++ b/data/examples/import/explicit-level-imports-out.hs
@@ -9,5 +9,8 @@
 import Data.ByteString.Lazy quote (d)
 import splice Data.Text (a, b, c)
 import PyF ()
-import splice PyF (fmt, tmf)
+import splice PyF
+  ( fmt,
+    tmf,
+  )
 import quote PyF (abc)
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/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-out.hs b/data/examples/module-header/block-haddock-in-export-list-out.hs
--- a/data/examples/module-header/block-haddock-in-export-list-out.hs
+++ b/data/examples/module-header/block-haddock-in-export-list-out.hs
@@ -1,5 +1,5 @@
 module Foo
-  ( -- | asdf
+  ( {- | 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-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-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_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-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
@@ -14,3 +14,7 @@
 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
@@ -5,6 +5,9 @@
 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)
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
@@ -6,6 +6,9 @@
 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)
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
@@ -5,6 +5,9 @@
 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
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
@@ -2,6 +2,9 @@
 
 import Data.Either
 import Data.Functor
+import Foo
+-- some comment
+import Foo.Bar
 import SomeInternal.Module2
 
 import Data.Text (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
@@ -14,3 +14,7 @@
 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
@@ -6,6 +6,9 @@
 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
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/fourmolu.cabal b/fourmolu.cabal
--- a/fourmolu.cabal
+++ b/fourmolu.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.4
 name: fourmolu
-version: 0.20.1.0
+version: 0.21.0.0
 license: BSD-3-Clause
 license-file: LICENSE.md
 maintainer:
@@ -8,8 +8,8 @@
     George Thomas <georgefsthomas@gmail.com>
     Brandon Chinn <brandonchinn178@gmail.com>
 tested-with:
-  ghc ==9.10.2
-  ghc ==9.12.2
+  ghc ==9.10.3
+  ghc ==9.12.4
   ghc ==9.14.1
 
 homepage: https://github.com/fourmolu/fourmolu
@@ -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
@@ -86,7 +90,6 @@
     Ormolu.Printer.Meat.Type
     Ormolu.Printer.Meat.Type.Function
     Ormolu.Printer.Operators
-    Ormolu.Printer.SpanStream
     Ormolu.Processing.Common
     Ormolu.Processing.Cpp
     Ormolu.Processing.Preprocess
@@ -102,7 +105,7 @@
   default-language: GHC2021
   build-depends:
     Cabal-syntax >=3.16 && <3.17,
-    Diff >=0.4 && <2,
+    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,
@@ -141,6 +144,8 @@
       -Wredundant-constraints
       -Wpartial-fields
       -Wunused-packages
+      -haddock
+      -Winvalid-haddock
   else
     ghc-options:
       -O2
@@ -187,6 +192,8 @@
       -Wpartial-fields
       -Wunused-packages
       -Wwarn=unused-packages
+      -haddock
+      -Winvalid-haddock
   else
     ghc-options:
       -O2
@@ -199,6 +206,7 @@
   hs-source-dirs: tests
   other-modules:
     Ormolu.CabalInfoSpec
+    Ormolu.Comments.AnchorSpec
     Ormolu.Diff.TextSpec
     Ormolu.Fixity.ParserSpec
     Ormolu.Fixity.PrinterSpec
@@ -208,6 +216,7 @@
     Ormolu.Parser.ParseFailureSpec
     Ormolu.Parser.PragmaSpec
     Ormolu.PrinterSpec
+    Ormolu.TestConfig
 
   default-language: GHC2021
   build-depends:
@@ -253,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
@@ -11,7 +11,7 @@
 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/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,
@@ -56,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
@@ -74,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
@@ -114,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 (Choice.fromBool (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
@@ -145,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 (Choice.fromBool (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)
@@ -182,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
@@ -113,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),
@@ -121,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 #-}
@@ -240,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"
@@ -374,6 +374,7 @@
   = HaddockSingleLine
   | HaddockMultiLine
   | HaddockMultiLineCompact
+  | HaddockAuto
   deriving (Eq, Show, Enum, Bounded)
 
 data HaddockPrintStyleModule
@@ -524,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
@@ -535,6 +537,7 @@
     HaddockSingleLine -> "single-line"
     HaddockMultiLine -> "multi-line"
     HaddockMultiLineCompact -> "multi-line-compact"
+    HaddockAuto -> "auto"
 
 instance Aeson.FromJSON HaddockPrintStyleModule where
   parseJSON =
@@ -833,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/Diff/ParseResult.hs b/src/Ormolu/Diff/ParseResult.hs
--- a/src/Ormolu/Diff/ParseResult.hs
+++ b/src/Ormolu/Diff/ParseResult.hs
@@ -11,6 +11,7 @@
 module Ormolu.Diff.ParseResult
   ( ParseResultDiff (..),
     diffParseResult,
+    diffCommentStream,
   )
 where
 
@@ -20,7 +21,7 @@
 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
@@ -28,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
@@ -49,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 ->
@@ -65,23 +72,50 @@
     } =
     diffCommentStream cstream0 cstream1
       <> diffHsModule
-        hs0 {hsmodImports = concat . normalizeImports' $ hsmodImports hs0}
-        hs1 {hsmodImports = concat . normalizeImports' $ 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' =
+      normalizeImports' hsmod =
         normalizeImports
-          (Without #implicitPrelude)
-          False
+          GroupImportsOpts
+            { grouping = ImportGroupSingle,
+              respectful = False,
+              allComments = listify (const True) hsmod
+            }
           mempty
-          ImportGroupSingle
+          (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.
@@ -190,8 +224,30 @@
         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))
+    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
@@ -256,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} =
diff --git a/src/Ormolu/Imports.hs b/src/Ormolu/Imports.hs
--- a/src/Ormolu/Imports.hs
+++ b/src/Ormolu/Imports.hs
@@ -29,8 +29,13 @@
 import GHC.Types.PkgQual
 import GHC.Types.SourceText
 import GHC.Types.SrcLoc
-import Ormolu.Config (ImportGrouping)
-import Ormolu.Imports.Grouping (Import (..), ImportList (..), groupImports, prepareExistingGroups)
+import Ormolu.Imports.Grouping
+  ( GroupImportsOpts,
+    Import (..),
+    ImportList (..),
+    groupImports,
+    prepareExistingGroups,
+  )
 import Ormolu.Utils (notImplemented, showOutputable)
 
 -- | Sort, group and normalize imports.
@@ -39,21 +44,20 @@
 -- sorted by source location, so this function should be called at most once on a
 -- given input list.
 normalizeImports ::
-  Choice "implicitPrelude" ->
-  Bool ->
+  GroupImportsOpts ->
   Set Cabal.ModuleName ->
-  ImportGrouping ->
+  Choice "implicitPrelude" ->
   [LImportDecl GhcPs] ->
   [[LImportDecl GhcPs]]
-normalizeImports implicitPrelude respectful localModules importGrouping =
+normalizeImports groupImportsOpts localModules implicitPrelude =
   map (fmap snd)
     . concatMap
-      ( groupImports importGrouping localModules toImport
+      ( groupImports groupImportsOpts localModules toImport
           . M.toAscList
           . M.fromListWith combineImports
           . fmap (\x -> (importId implicitPrelude x, g x))
       )
-    . prepareExistingGroups importGrouping respectful
+    . prepareExistingGroups groupImportsOpts
   where
     toImport :: (ImportId, x) -> Import
     toImport (ImportId {..}, _) =
@@ -81,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,
@@ -253,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
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,9 +1,12 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoFieldSelectors #-}
 
 module Ormolu.Imports.Grouping
   ( Import (..),
     ImportList (..),
+    GroupImportsOpts (..),
     prepareExistingGroups,
     groupImports,
   )
@@ -15,14 +18,17 @@
 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 (..))
 import Ormolu.Config qualified as Config
-import Ormolu.Utils (ghcModuleNameToCabal, groupBy', separatedByBlank)
+import Ormolu.Utils (ghcModuleNameToCabal, groupBy')
 import Ormolu.Utils.Glob (matchAllGlob, matchesGlob)
 
 newtype ImportGroups = ImportGroups (NonEmpty ImportGroup)
@@ -158,20 +164,53 @@
             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
@@ -152,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
@@ -174,6 +177,7 @@
                         prStackHeader = stackHeader,
                         prPragmas = pragmas,
                         prCommentStream = comments,
+                        prHaddockText = haddockText,
                         prExtensions = GHC.extensionFlags dynFlags,
                         prModuleFixityMap = modFixityMap,
                         prIndent = indent,
@@ -184,13 +188,15 @@
 -- | Normalize a 'HsModule' by sorting its export lists, dropping
 -- blank comments, etc.
 normalizeModule ::
+  Choice "implicitPrelude" ->
   Config RegionDeltas ->
   HsModule GhcPs ->
   HsModule GhcPs
-normalizeModule Config {..} hsmod =
+normalizeModule _ Config {..} hsmod =
   everywhere
     ( mkT dropBlankTypeHaddocks
         `extT` dropBlankDataDeclHaddocks
+        `extT` dropBlankConDeclFieldHaddocks
         `extT` patchContext
         `extT` patchExprContext
     )
@@ -220,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, ..}
@@ -228,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))]
@@ -257,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
@@ -275,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
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
@@ -3,8 +3,14 @@
 {-# 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
@@ -12,39 +18,94 @@
 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
   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
@@ -33,9 +33,10 @@
     askModuleFixityMap,
     askDebug,
     located,
-    encloseLocated,
+    locatedEmpty,
     located',
     switchLayout,
+    switchLayoutWithEnclosingComments,
     switchLayoutNoLimit,
     spansLayout,
     enterLayout,
@@ -72,7 +73,6 @@
     comma,
     commaDel,
     commaDelImportExport,
-    equals,
     token'Larrowtail,
     token'Rarrowtail,
     token'darrow,
@@ -90,12 +90,15 @@
     token'lolly,
 
     -- ** Stateful markers
-    SpanMark (..),
-    spanMarkSpan,
+    LastEmitted (..),
+    lastEmittedSpan,
     HaddockStyle (..),
-    setSpanMark,
-    getSpanMark,
+    setLastEmitted,
+    getLastEmitted,
 
+    -- ** Haddocks
+    lookupHaddockText,
+
     -- ** Placement
     Placement (..),
     placeHanging,
@@ -104,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
@@ -112,6 +116,7 @@
 import Ormolu.Config
 import Ormolu.Printer.Comments
 import Ormolu.Printer.Internal
+import Ormolu.Utils (combineSrcSpans')
 
 ----------------------------------------------------------------------------
 -- Basic
@@ -126,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.
@@ -134,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.
 --
@@ -195,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
@@ -217,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
@@ -234,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 () ->
@@ -245,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")
@@ -262,8 +325,8 @@
   R ()
 sepSemi = sepSemi' False
 
--- | A version of 'sepSemi' that allows to control whether semicolons should
--- be inserted in multi-line layout.
+-- | 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")
@@ -302,7 +365,7 @@
 ----------------------------------------------------------------------------
 -- Wrapping
 
--- | 'BracketStyle' controlling how closing bracket is rendered.
+-- | 'BracketStyle' controlling how the closing bracket is rendered.
 data BracketStyle
   = -- | Normal
     N
@@ -310,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 "#)")
 
@@ -444,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
@@ -527,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,7 +14,6 @@
     -- * Internal functions
     txt,
     txtStripIndent,
-    interferingTxt,
     atom,
     space,
     newline,
@@ -44,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,
   )
@@ -71,10 +75,9 @@
 import Data.Bool (bool)
 import Data.Char (isSpace)
 import Data.Choice (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 :: !(Choice "debug")
+    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
@@ -196,11 +204,18 @@
   ModuleFixityMap ->
   -- | Whether to print out debug information during printing
   Choice "debug" ->
-  -- | Resulting rendition
-  Text
-runR (R m) sstream cstream printerOpts localModules sourceType extensions moduleFixityMap debug =
-  TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc
+  -- | 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,
@@ -212,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 = []
         }
 
 ----------------------------------------------------------------------------
@@ -235,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.
@@ -269,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 ->
@@ -296,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 ->
@@ -334,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
@@ -378,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
@@ -439,9 +448,9 @@
             _ -> AfterNewline
         }
 
--- | Insert a newline literal without modifying the internal state of the
--- parser. This is to be used exceptionally, e.g. for printing multiline
--- string literals.
+-- | 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
@@ -512,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
@@ -542,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
@@ -551,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 ->
@@ -564,7 +573,7 @@
     SingleLine -> sline
     MultiLine -> mline
 
--- | Get current 'Layout'.
+-- | Get the current 'Layout'.
 getLayout :: R Layout
 getLayout = R (asks rcLayout)
 
@@ -578,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 ->
@@ -594,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) ->
@@ -647,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
@@ -663,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
@@ -690,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,20 +14,31 @@
     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)
@@ -39,6 +52,7 @@
 import GHC.Types.SrcLoc
 import Language.Haskell.Syntax.Module.Name
 import Ormolu.Config
+import Ormolu.Parser.CommentStream (Comment, isMultilineComment, unComment)
 import Ormolu.Printer.Combinators
 import Ormolu.Utils
 
@@ -49,7 +63,8 @@
   | -- | Top-level declarations
     Free
 
--- | Outputs the name of the module-like entity, preceded 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
@@ -92,6 +107,11 @@
         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
@@ -111,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
@@ -128,7 +148,8 @@
   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
   Choice "infixStyle" ->
@@ -164,6 +185,11 @@
           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 ->
@@ -174,64 +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 docStringLines = splitDocString $ 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 ()
@@ -260,3 +390,57 @@
     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,
@@ -273,7 +275,7 @@
   SpecSigE _ _ (deconstructExprFromSpecSigE -> (L _ n, _, _)) _ -> Just n
   _ -> Nothing
 
--- Declarations which can refer to multiple names
+-- 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
@@ -75,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
@@ -10,7 +10,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
--- | Renedring of data type declarations.
+-- | Rendering of data type declarations.
 module Ormolu.Printer.Meat.Declaration.Data
   ( p_dataDecl,
   )
@@ -22,7 +22,7 @@
 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 GHC.Hs
 import GHC.Types.Fixity
@@ -116,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'
@@ -158,7 +163,7 @@
 p_conDecl :: Choice "singleRecCon" -> ConDecl GhcPs -> R ()
 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
@@ -166,6 +171,10 @@
       sep commaDel p_rdrName cs
     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) <> conSigSpans
     conSigSpans =
@@ -181,13 +190,11 @@
     PrefixCon xs -> do
       renderConDoc
       renderContext
-      switchLayout conDeclSpn $ do
+      switchLayoutDocumented xs conDeclSpn $ do
         p_rdrName con_name
-        let argsHaveDocs = conArgsHaveHaddocks xs
-            delimiter = if argsHaveDocs then newline else breakpoint
-        unless (null xs) delimiter
+        unless (null xs) breakpoint
         inci . sitcc $
-          sep delimiter (sitcc . p_hsConDeclFieldWithDoc) xs
+          sep breakpoint (sitcc . p_hsConDeclFieldWithDoc) xs
     RecCon l -> do
       renderConDoc
       renderContext
@@ -197,18 +204,19 @@
         if recordStyle == RecordStyleKnr then space else breakpoint
         inciIf (Choice.isFalse singleRecCon) (located l p_hsConDeclRecFields)
     InfixCon l r -> do
-      -- manually render these
+      -- 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
@@ -268,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
@@ -417,19 +426,24 @@
 ----------------------------------------------------------------------------
 -- Helpers
 
+-- | Do any of these constructors print a Haddock as @--@ lines where it
+-- would share a line with the rest of the declaration?
+--
+-- Only the constructor's own Haddock and the docs on its prefix arguments
+-- count. A record constructor lays its fields out over several lines
+-- anyway, so documenting one of them says nothing about how the @=@ and the
+-- constructor name should be arranged.
+consHaveLineHaddocks :: [LConDecl GhcPs] -> R Bool
+consHaveLineHaddocks = fmap or . traverse (f . unLoc)
+  where
+    f ConDeclH98 {..} =
+      hasLineHaddocks $
+        maybeToList con_doc <> case con_args of
+          PrefixCon xs -> mapMaybe cdf_doc xs
+          _ -> []
+    f _ = pure False
+
 isInfix :: LexicalFixity -> Bool
 isInfix = \case
   Infix -> True
   Prefix -> False
-
-hasHaddocks :: [LConDecl GhcPs] -> Bool
-hasHaddocks = any (f . unLoc)
-  where
-    f ConDeclH98 {..} =
-      isJust con_doc || case con_args of
-        PrefixCon xs -> conArgsHaveHaddocks xs
-        _ -> False
-    f _ = False
-
-conArgsHaveHaddocks :: [HsConDeclField GhcPs] -> Bool
-conArgsHaveHaddocks = any (isJust . cdf_doc)
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
@@ -25,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
@@ -45,18 +45,18 @@
 --
 -- > 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)
   inci $ located sourceText $ \case
     NoSourceText -> pure ()
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,17 +118,18 @@
       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)
       -- 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
@@ -144,11 +146,19 @@
       isSingleOperator = case ops of
         [_] -> True
         _ -> False
-      -- 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.
-      isTrailing =
+  -- 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
@@ -194,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)
@@ -233,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
@@ -32,7 +32,7 @@
   inci $ do
     located lhs p_hsExpr
     space
-    equals
+    txt "="
     inci $ do
       breakpoint
       located rhs p_hsExpr
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
@@ -169,9 +169,9 @@
   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.
+-- | 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 ::
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
@@ -43,9 +43,9 @@
         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]
@@ -93,14 +93,14 @@
         go ((pre, suf) : bs) = case T.uncons suf of
           Just ('\\', suf')
             | (gap, T.uncons -> Just ('\\', rest)) <- T.span is_space suf',
-              -- If there is a space after the backslash, this definitely is a
+              -- If there is a space after the backslash, this is definitely a
               -- string gap. Continue parsing gaps after the next backslash.
               not $ T.null gap ->
                 pre : splitGaps rest
             | otherwise ->
-                -- Check whether @suf@ starts with an escape sequence involving
-                -- another backslash. If so, it can not be the start of a string
-                -- gap, so we skip it.
+                -- 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
@@ -111,14 +111,14 @@
         -- https://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6
         escapesWithAnotherBackslash = ["\\", "^\\"]
 
-    -- See the the MultilineStrings GHC proposal and 'lexMultilineString' from
+    -- 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
@@ -144,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
@@ -45,7 +45,7 @@
       (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
@@ -70,7 +70,7 @@
   KindSig NoExtField k -> Just $ do
     p_hsTypeAnnotation k
   TyVarSig NoExtField bndr -> Just $ do
-    equals
+    txt "="
     breakpoint
     located bndr p_hsTyVarBndr
 
@@ -104,7 +104,7 @@
         (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
@@ -102,7 +102,7 @@
   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.
+  -- restore the brace state inside the 'sepSemi'.
   ub <- bool dontUseBraces useBraces <$> canUseBraces
   let ob = case style of
         Case -> bracesIfNecessary
@@ -124,12 +124,12 @@
         (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 parentheses) associated with them. It is necessary to use per-equation
--- names obtained from 'm_ctxt' of 'Match'. This function replaces function
--- name inside of 'Function' accordingly.
+-- | 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 ->
@@ -180,12 +180,12 @@
   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
     HsUnannotated {} -> pure ()
@@ -244,8 +244,9 @@
               -- 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)
@@ -299,9 +300,9 @@
     unless (length grhssGRHSs > 1) $
       case style of
         Function _ | hasGuards -> return ()
-        Function _ -> space >> inci equals
+        Function _ -> space >> inci (txt "=")
         PatternBind | hasGuards -> return ()
-        PatternBind -> space >> inci equals
+        PatternBind -> space >> inci (txt "=")
         s | isCase s && hasGuards -> return ()
         _ -> space >> token'rarrow
     switchLayout [patGrhssSpan] $
@@ -330,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
@@ -414,23 +415,22 @@
   case getLocA l of
     UnhelpfulSpan _ -> f x
     RealSrcSpan currentSpn _ -> do
-      getSpanMark >>= \case
-        -- We deal with blank lines between statements here. The last mark
-        -- may be a 'StatementSpan' (the usual case) or a comment span: the
+      (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 lastMark ->
-          let lastSpn = spanMarkSpan lastMark
-           in when (srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1) newline
+        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)
@@ -463,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
@@ -522,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
@@ -535,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)
@@ -557,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
@@ -592,7 +592,7 @@
   p_lhs hfbLHS
   unless hfbPun $ do
     space
-    equals
+    txt "="
     let placement =
           if onTheSameLine (getLocA hfbLHS) (getLocA hfbRHS)
             then exprPlacement (unLoc hfbRHS)
@@ -602,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 indentation 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
@@ -616,7 +617,7 @@
   Applicand -> inci . inci
   NotApplicand -> inci
 
--- | Adjust bracing as needed for certain cases e.g. involving case
+-- | 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
@@ -645,7 +646,7 @@
     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
@@ -665,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 =
@@ -721,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
@@ -891,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
@@ -918,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))
 
@@ -961,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:
 --
 -- @
@@ -978,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 _ _ <- NE.toList blocks
     ]
-  -- Otherwise, list will not contain any ParStmt
+  -- Otherwise, the list will not contain any ParStmt.
   stmts ->
     [ concatMap collectNonParStmts stmts
     ]
@@ -1013,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
@@ -1138,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
@@ -1367,7 +1371,7 @@
   located hfbLHS p_fieldOcc
   unless hfbPun $ do
     space
-    equals
+    txt "="
     breakpoint
     inci (located hfbRHS p_pat)
 
@@ -1443,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
@@ -1511,7 +1515,7 @@
 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) ->
   NonEmpty (LGRHS GhcPs (LocatedA body)) ->
@@ -1519,7 +1523,7 @@
 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
@@ -1527,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)) _)])
@@ -1552,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
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
@@ -16,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
@@ -82,18 +81,18 @@
     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
@@ -146,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 =
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,13 +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
@@ -28,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
@@ -45,7 +47,7 @@
   switchLayout (deprecSpan <> exportSpans) $
     enterMultilineLayoutIfContainsDocEntries (maybe [] unLoc hsmodExports) $ do
       forM_ mstackHeader $ \(L spn comment) -> do
-        spitCommentNow spn comment
+        spitCommentNow SlotFloating spn comment
         newline
       newline
       p_pragmas pragmas
@@ -54,7 +56,12 @@
       newline
       importGroups <- normalizeImportsR hsmodImports
       forM_ importGroups $ \importGroup -> do
-        forM_ importGroup (located' p_hsmodImport)
+        -- 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
@@ -70,10 +77,13 @@
       importGrouping <- getPrinterOpt poImportGrouping
       pure $
         normalizeImports
-          implicitPrelude
-          respectful
+          GroupImportsOpts
+            { grouping = importGrouping,
+              respectful,
+              allComments = listify (const True) hsmod
+            }
           localModules
-          importGrouping
+          implicitPrelude
           imports
 
 p_hsModuleHeader :: HsModule GhcPs -> LocatedA ModuleName -> R ()
@@ -83,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
@@ -108,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
@@ -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
@@ -197,7 +195,7 @@
         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
@@ -212,7 +210,10 @@
 
 p_hsConDeclRecFields :: [LHsConDeclRecField GhcPs] -> R ()
 p_hsConDeclRecFields xs =
-  recordBraces $ sep commaDel (sitcc . located' p_hsConDeclRecField) xs
+  multiLineIfDocumented xs . recordBraces $ do
+    when (null xs) $
+      getEnclosingSpan >>= mapM_ (locatedEmpty . flip RealSrcSpan Strict.Nothing)
+    sep commaDel (sitcc . located' p_hsConDeclRecField) xs
 
 p_hsConDeclRecField :: HsConDeclRecField GhcPs -> R ()
 p_hsConDeclRecField field@HsConDeclRecField {..} = withFieldHaddocks $ do
@@ -227,13 +228,13 @@
       commaStyle <- getPrinterOpt poCommaStyle
       let doc = cdf_doc cdrf_spec
       when (commaStyle == Trailing) $
-        mapM_ (p_hsDoc Pipe (With #endNewline)) doc
+        mapM_ (p_hsDocInline Pipe (With #endNewline)) doc
       action
       when (commaStyle == Leading) $
-        mapM_ (inciByFrac (-1) . (newline >>) . p_hsDoc Caret (Without #endNewline)) doc
+        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).
+-- | 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
@@ -254,8 +255,8 @@
 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"
diff --git a/src/Ormolu/Printer/Meat/Type/Function.hs b/src/Ormolu/Printer/Meat/Type/Function.hs
--- a/src/Ormolu/Printer/Meat/Type/Function.hs
+++ b/src/Ormolu/Printer/Meat/Type/Function.hs
@@ -56,7 +56,7 @@
 import GHC.Utils.Outputable (Outputable)
 import Ormolu.Config
 import Ormolu.Printer.Combinators
-import Ormolu.Printer.Meat.Common (p_arrow, p_hsDoc, p_rdrName)
+import Ormolu.Printer.Meat.Common (p_arrow, p_hsDocInline, p_rdrName)
 import Ormolu.Utils (showOutputable)
 import Prelude hiding (span)
 
@@ -479,13 +479,13 @@
 
   if Choice.isTrue isLeadingHaddock
     then do
-      traverse (liftR . p_hsDoc Pipe (With #endNewline)) doc *> m
+      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_hsDoc Caret endNewline) doc
+      m <* pre <* traverse (liftR . p_hsDocInline Caret endNewline) doc
 
 interArgBreak :: PrintHsFun ()
 interArgBreak = do
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) ->
@@ -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
@@ -61,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
@@ -173,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,10 +70,20 @@
 notImplemented :: String -> a
 notImplemented msg = error $ "not implemented yet: " ++ msg
 
--- | Pretty-print an 'GHC.Outputable' thing.
+-- | Pretty-print a 'GHC.Outputable' thing.
 showOutputable :: (Outputable o) => o -> String
 showOutputable = showSDoc baseDynFlags . ppr
 
+-- | Does this fragment of the syntax tree carry a Haddock anywhere inside
+-- it?
+--
+-- Unlike the span of a Haddock, which sits wherever the author wrote it,
+-- this answers the question the printer actually has: will rendering this
+-- fragment emit documentation?
+containsHaddocks :: (Data a) => a -> Bool
+containsHaddocks =
+  not . null . listify (const True :: HsDocString -> Bool)
+
 -- | Split and normalize a doc string. The result is a list of lines that
 -- make up the comment.
 splitDocString :: HsDocString -> [Text]
@@ -86,8 +99,8 @@
         . fmap (T.stripEnd . T.pack)
         . lines
         $ renderHsDocString docStr
-    -- We cannot have the first character to be a dollar because in that
-    -- case it'll be a parse error (apparently collides with named docs
+    -- We cannot let the first character be a dollar, because in that case
+    -- it would be a parse error (apparently it collides with the named docs
     -- syntax @-- $name@ somehow).
     escapeLeadingDollar txt =
       case T.uncons txt of
@@ -118,7 +131,7 @@
                 then dropSpace <$> xs
                 else xs
 
--- | Increment line number in a 'SrcSpan'.
+-- | Increment the line number in a 'SrcSpan'.
 incSpanLine :: Int -> SrcSpan -> SrcSpan
 incSpanLine i = \case
   RealSrcSpan s _ ->
@@ -144,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))
@@ -165,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/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/FixitySpec.hs b/tests/Ormolu/FixitySpec.hs
--- a/tests/Ormolu/FixitySpec.hs
+++ b/tests/Ormolu/FixitySpec.hs
@@ -285,7 +285,7 @@
       fimportList = Nothing
     }
 
--- | Adds an alias for an import.
+-- | Add an alias for an import.
 as_ :: ModuleName -> FixityImport -> FixityImport
 as_ moduleName fixityImport =
   fixityImport
diff --git a/tests/Ormolu/PrinterSpec.hs b/tests/Ormolu/PrinterSpec.hs
--- a/tests/Ormolu/PrinterSpec.hs
+++ b/tests/Ormolu/PrinterSpec.hs
@@ -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,50 +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",
-                  "megaparsec",
-                  "optics",
-                  "relude",
-                  "rio",
-                  "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
@@ -88,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 $
@@ -129,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)
+        ]
+    )