tilia 0.1.2.0 → 0.1.3.0

raw patch · 132 files changed

+3877/−1875 lines, 132 filesdep ~Cabal-syntaxPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Cabal-syntax

API changes (from Hackage documentation)

Files

• CHANGELOG.md +174/−0
• HACKING.md +185/−0
• bench/Main.hs +16/−6
• bench/Tilia/Bench/Cases.hs +3/−3
• bench/Tilia/Bench/Fixity.hs +1/−2
• bench/Tilia/Bench/Record.hs +5/−7
• bench/bench.record +92/−92
• corpora/hackage/hackage.manifest +109/−109
• corpora/vendored/declaration/class/empty-context-out.hs +10/−0
• corpora/vendored/declaration/class/empty-context.hs +10/−0
• corpora/vendored/declaration/data/empty-context-out.hs +13/−0
• corpora/vendored/declaration/data/empty-context.hs +13/−0
• corpora/vendored/declaration/value/typed-quote-written-across-lines-out.hs +25/−0
• corpora/vendored/declaration/value/typed-quote-written-across-lines.hs +18/−0
• corpora/vendored/import/sorting-the-prelude-under-rebindable-syntax-out.hs +11/−0
• corpora/vendored/import/sorting-the-prelude-under-rebindable-syntax.hs +11/−0
• corpora/vendored/other/comment-before-closing-quote-out.hs +3/−3
• corpora/vendored/other/comment-inside-a-language-pragma-out.hs +16/−0
• corpora/vendored/other/comment-inside-a-language-pragma.hs +15/−0
• corpora/vendored/other/cpp/conditional-from-a-where-clause-indented-with-a-tab-out.hs +21/−0
• corpora/vendored/other/cpp/conditional-from-a-where-clause-indented-with-a-tab.hs +21/−0
• corpora/vendored/other/cpp/macro-among-statements-out.hs +27/−0
• corpora/vendored/other/cpp/macro-among-statements.hs +27/−0
• corpora/vendored/other/cpp/macro-between-equations-out.hs +12/−0
• corpora/vendored/other/cpp/macro-between-equations.hs +12/−0
• corpora/vendored/other/cpp/macro-indented-with-a-tab-out.hs +22/−0
• corpora/vendored/other/cpp/macro-indented-with-a-tab.hs +20/−0
• corpora/vendored/other/cpp/preprocessor-turned-on-by-a-flag-out.hs +10/−0
• corpora/vendored/other/cpp/preprocessor-turned-on-by-a-flag.hs +9/−0
• corpora/vendored/other/edition-named-by-the-module-out.hs +10/−0
• corpora/vendored/other/edition-named-by-the-module.hs +9/−0
• corpora/vendored/other/editions-in-written-order-out.hs +8/−0
• corpora/vendored/other/editions-in-written-order.hs +7/−0
• corpora/vendored/other/extension-taken-back-from-the-edition-out.hs +1/−1
• corpora/vendored/other/extension-turned-off-above-one-implying-it-out.hs +9/−0
• corpora/vendored/other/extension-turned-off-above-one-implying-it.hs +8/−0
• corpora/vendored/other/extension-turned-off-and-on-again-out.hs +10/−0
• corpora/vendored/other/extension-turned-off-and-on-again.hs +9/−0
• corpora/vendored/other/extension-turned-on-under-an-option-turning-it-off-out.hs +11/−0
• corpora/vendored/other/extension-turned-on-under-an-option-turning-it-off.hs +10/−0
• corpora/vendored/other/extensions-turned-on-by-flags-out.hs +15/−0
• corpora/vendored/other/extensions-turned-on-by-flags.hs +14/−0
• corpora/vendored/other/old-options-pragma-in-written-order-out.hs +13/−0
• corpora/vendored/other/old-options-pragma-in-written-order.hs +12/−0
• corpora/vendored/other/options-in-written-order-out.hs +4/−2
• corpora/vendored/other/options-in-written-order.hs +3/−2
• corpora/vendored/other/pragma-below-the-module-line-out.hs +8/−0
• corpora/vendored/other/pragma-below-the-module-line.hs +7/−0
• corpora/vendored/other/prelude-asked-for-above-rebindable-syntax-out.hs +12/−0
• corpora/vendored/other/prelude-asked-for-above-rebindable-syntax.hs +11/−0
• corpora/vendored/other/splices-the-author-grouped-out.hs +14/−0
• corpora/vendored/other/splices-the-author-grouped.hs +14/−0
• corpora/vendored/other/string-literals-as-written-out.hs +41/−0
• corpora/vendored/other/string-literals-as-written.hs +37/−0
• src/Tilia/Cabal/Package.hs +126/−80
• src/Tilia/Cabal/Plan.hs +87/−72
• src/Tilia/Cabal/Project.hs +19/−11
• src/Tilia/Cabal/Target.hs +29/−59
• src/Tilia/Comments.hs +27/−36
• src/Tilia/Comments/Attach.hs +0/−1
• src/Tilia/Cpp.hs +2/−3
• src/Tilia/Cpp/Directives.hs +29/−35
• src/Tilia/Cpp/Macros.hs +2/−0
• src/Tilia/Cpp/Merge.hs +11/−14
• src/Tilia/Cpp/Place.hs +48/−34
• src/Tilia/Diff.hs +2/−1
• src/Tilia/Doc.hs +1/−6
• src/Tilia/Doc/Body.hs +2/−1
• src/Tilia/Doc/Combinators.hs +7/−18
• src/Tilia/Doc/Internal.hs +3/−3
• src/Tilia/Equivalence.hs +76/−8
• src/Tilia/Fixity.hs +33/−54
• src/Tilia/Fixity/Archive.hs +11/−9
• src/Tilia/Fixity/Cabal.hs +25/−75
• src/Tilia/Fixity/Cache.hs +5/−9
• src/Tilia/Fixity/Debug.hs +7/−13
• src/Tilia/Fixity/HiFile.hs +3/−2
• src/Tilia/Fixity/Interface.hs +44/−54
• src/Tilia/Fixity/PackageDb.hs +3/−17
• src/Tilia/Fixity/Plan.hs +60/−61
• src/Tilia/Format.hs +24/−16
• src/Tilia/Ignore.hs +28/−22
• src/Tilia/Imports.hs +0/−1
• src/Tilia/Parser.hs +34/−40
• src/Tilia/Pragma.hs +242/−48
• src/Tilia/Pragma/Ghc.hs +91/−0
• src/Tilia/Render/Class.hs +7/−11
• src/Tilia/Render/Context.hs +10/−17
• src/Tilia/Render/Data.hs +5/−7
• src/Tilia/Render/Declaration.hs +18/−36
• src/Tilia/Render/Expression.hs +47/−54
• src/Tilia/Render/Haddock.hs +15/−22
• src/Tilia/Render/Header.hs +57/−63
• src/Tilia/Render/Literal.hs +22/−5
• src/Tilia/Render/Pattern.hs +13/−20
• src/Tilia/Render/Pragma.hs +3/−2
• src/Tilia/Render/Signature.hs +7/−12
• src/Tilia/Render/Type.hs +13/−14
• src/Tilia/Run.hs +17/−19
• src/Tilia/Source.hs +2/−0
• src/Tilia/Source/Lines.hs +37/−0
• src/Tilia/Span.hs +0/−6
• src/Tilia/Span/Ghc.hs +9/−1
• src/Tilia/Utils.hs +95/−20
• tests/Tilia/Cabal/PackageSpec.hs +78/−14
• tests/Tilia/Cabal/ProjectSpec.hs +11/−25
• tests/Tilia/Cabal/TargetSpec.hs +86/−10
• tests/Tilia/CommentsSpec.hs +13/−5
• tests/Tilia/Corpus.hs +66/−165
• tests/Tilia/Corpus/Manifest.hs +11/−20
• tests/Tilia/CorpusSpec.hs +28/−9
• tests/Tilia/Cpp/PropertiesSpec.hs +1/−6
• tests/Tilia/CppSpec.hs +35/−9
• tests/Tilia/Doc/InternalSpec.hs +1/−13
• tests/Tilia/Doc/PropertiesSpec.hs +0/−15
• tests/Tilia/EditorSpec.hs +29/−50
• tests/Tilia/EquivalenceSpec.hs +77/−0
• tests/Tilia/Fixity/CabalSpec.hs +92/−14
• tests/Tilia/Fixity/CacheSpec.hs +9/−1
• tests/Tilia/Fixity/DebugSpec.hs +28/−9
• tests/Tilia/Fixity/DependenciesSpec.hs +2/−17
• tests/Tilia/Fixity/HiFileSpec.hs +4/−2
• tests/Tilia/Fixity/InterfaceSpec.hs +31/−8
• tests/Tilia/Fixity/PlanSpec.hs +145/−61
• tests/Tilia/FixitySpec.hs +21/−1
• tests/Tilia/IgnoreSpec.hs +16/−13
• tests/Tilia/PragmaSpec.hs +210/−21
• tests/Tilia/RunSpec.hs +9/−4
• tests/Tilia/SpanSpec.hs +33/−0
• tests/Tilia/TestConfig.hs +5/−7
• tests/Tilia/TestUtils.hs +150/−19
• tilia.cabal +20/−18

@@ -1,3 +1,177 @@+## Tilia 0.1.3.0++* An empty context comes out as written in a class or a data declaration,+  as in `class () => C a`, and before a constructor, as in+  `forall a. () => C a`, rather than being dropped, as it was already kept+  in a signature and in a GADT constructor.+  [Issue 299](https://github.com/mrkkrp/tilia/issues/299).+* Extensions turned on or off with flags in an `OPTIONS_GHC` pragma, or in+  the older `OPTIONS` pragma, such as `-cpp`, `-XLambdaCase`,+  `-fglasgow-exts` and `-fbang-patterns`, are taken into account, so a+  module that needs them is parsed as GHC parses it.+  [Issue 280](https://github.com/mrkkrp/tilia/issues/280).+* An `OPTIONS` pragma in the header is sorted with the `OPTIONS_GHC`+  pragmas, keeping the order the two are written in among each other, rather+  than being left where it was written.+  [PR 319](https://github.com/mrkkrp/tilia/pull/319).+* An extension that turns another off, as `RebindableSyntax` turns off+  `ImplicitPrelude`, does so where it is turned on, as with GHC, so under+  `RebindableSyntax` the Prelude is not taken to be imported, and an import+  of it sorts among the others, as under `NoImplicitPrelude`.+  [PR 319](https://github.com/mrkkrp/tilia/pull/319).+* The pragmas of a header keep the order they are written in where sorting+  them would leave other extensions in force, as with `NoMonoLocalBinds`+  written above `TypeFamilies`, which turns `MonoLocalBinds` back on, or+  with an option turning off an extension a later `LANGUAGE` pragma turns+  on; and editions, of which GHC takes the last, keep their order among+  each other. [PR 319](https://github.com/mrkkrp/tilia/pull/319).+* An options pragma written twice in a row is kept twice rather than+  written once, since a flag such as `-fplugin-opt` counts each time it is+  given. [PR 322](https://github.com/mrkkrp/tilia/pull/322).+* A pragma written below the `module` line, which GHC does not read, stays+  where it is written rather than being moved above the line, where it+  takes effect, and the module is parsed without what it names, as GHC+  parses it. [Issue 288](https://github.com/mrkkrp/tilia/issues/288).+* `--check-ast` reads the pragmas of the header as GHC reads them, and+  reports a module whose formatting would change the order of the flags of+  its options, its `OPTIONS_HADDOCK` pragmas, or how GHC's own flag reader+  takes them to switch extensions, the edition or the Safe Haskell mode.+  [PR 322](https://github.com/mrkkrp/tilia/pull/322).+* An edition of the language a module names in its header, as in+  `{-# LANGUAGE GHC2024 #-}` or with `-XGHC2024`, takes the place of the+  `default-language` of its component, as with GHC, and what+  `default-extensions` and the module's pragmas switch is switched on top+  of it. [Issue 321](https://github.com/mrkkrp/tilia/issues/321).+* An extension turned off after one that implies it, as `NoExplicitForAll`+  after `RankNTypes`, stays off when the module is parsed, as with GHC,+  rather than being turned back on.+  [PR 323](https://github.com/mrkkrp/tilia/pull/323).+* The `LANGUAGE` pragmas of a header are sorted by name after the+  editions, rather than with the names that turn an extension off, and then+  `ImplicitPrelude` and `CUSKs`, after the rest; where sorting them would+  change what is in force, they keep the order they are written in, as+  before. [PR 323](https://github.com/mrkkrp/tilia/pull/323).+* A `LANGUAGE` pragma holding a comment, as in `, PolyKinds -- for T` on+  one of its lines, is read past the comment, as GHC reads it, and kept as+  written, rather than taking the name and the comment together for a name+  and putting the comment before the `#-}` of a pragma of its own, which GHC+  could not read. [Issue 324](https://github.com/mrkkrp/tilia/issues/324).+* `--debug-fixity` says that the imports disagree about a constructor+  written among types, as a promoted constructor is, where a run declines+  the module over it, rather than showing its fixity settled.+  [Issue 304](https://github.com/mrkkrp/tilia/issues/304).+* `.tiliaignore` files and the cache are read and written as UTF-8 whatever+  the locale, so under `LANG=C` a `.tiliaignore` holding a character+  outside ASCII no longer makes `check` and `inplace` crash, nor+  `for-editor` format what it ignores, and what the cache holds about an+  operator or a path with such a character is no longer worked out again on+  every run. The cache starts anew, so the first run after upgrading works+  everything out again. [Issue 290](https://github.com/mrkkrp/tilia/issues/290).+* Where the plan gives no hash to check a dependency's tarball against, a+  tarball that is not gzip, or is cut short, leaves its package unread, so+  that a module needing its fixities is declined, rather than ending the+  run. [Issue 303](https://github.com/mrkkrp/tilia/issues/303).+* The body of a typed Template Haskell quote written over several lines, as+  in `[|| … ||]`, is indented under its opening bracket together with its+  closing one, as that of an untyped quote is, rather than coming out at+  the column of the brackets.+  [Issue 300](https://github.com/mrkkrp/tilia/issues/300).+* A name an as-pattern binds at the top level, as `plus` in+  `plus@_ = (+)`, is taken for the module's own, rather than a module using+  it being declined where an import could not be read; a name bound inside+  the function of a view pattern, on the other hand, is not.+  [Issue 301](https://github.com/mrkkrp/tilia/issues/301).+* A module that re-exports the members of a type without the type, such as+  the methods of a class named by an operator, is no longer taken to declare+  the type's fixity, and a name a decoded interface file re-exports takes+  the fixity it has in the namespace it is exported in, as a type or as a+  term, rather than in both.+  [Issue 302](https://github.com/mrkkrp/tilia/issues/302).+* A conditional that begins among the bindings of a `where` clause and goes+  on into the declarations after it stays whole where the bindings are+  indented with a tab, as it already did where they are indented with+  spaces, rather than coming out in two.+  [Issue 297](https://github.com/mrkkrp/tilia/issues/297).+* A line that holds nothing but a use of a function-like macro and is+  indented with a tab is taken to be at the column the tab moves it to, as+  GHC takes it, rather than at the count of characters before it. One at the+  column of the code under it is put back as written, rather than the module+  being declined where the use does not read as code, and one further in is+  read as code that carries on the line above, rather than put back at the+  level of the code under it.+  [PR 333](https://github.com/mrkkrp/tilia/pull/333).+* A sub-library is looked for in the build plan under `lib:` and its name,+  as the plan writes it, rather than as the main library, so a package+  whose only library is a named one no longer makes the first run under a+  plan `cabal` solved ask it to solve again, and a sub-library the plan+  leaves out no longer counts as planned where the main library is.+  [Issue 296](https://github.com/mrkkrp/tilia/issues/296).+* A source directory that two packages name through different paths, as+  `shared` in one and `../a/shared` in the other, is taken to be one+  directory, so `check` and `inplace` format each module in it once, rather+  than once under each path.+  [Issue 295](https://github.com/mrkkrp/tilia/issues/295).+* A module that no `.cabal` file above it names, as one in a directory+  outside every package that packages of the project share through `..`,+  takes what a package of the project that names it puts in force, rather+  than failing for want of a `.cabal` file, and the fixities it declares+  are known to the modules importing it, rather than their being declined.+  [Issue 295](https://github.com/mrkkrp/tilia/issues/295).+* A character literal holding a double quote, as in `'"'`, is read as one,+  rather than as the start of a string, so a `{-# LINE #-}` written in a+  string after it no longer has the module declined, and one written in the+  code after it is no longer missed.+  [Issue 292](https://github.com/mrkkrp/tilia/issues/292).+* A line that holds nothing but a use of a function-like macro is put back+  at the indentation of the code under it, as it is written, rather than a+  step further in wherever what is around it begins on a line above. One+  among the statements of a `do` block, or between the equations of a+  function, no longer comes out carrying on the line above it.+  [Issue 279](https://github.com/mrkkrp/tilia/issues/279).+* A file whose formatting throws an exception is reported as failing, with+  the exception, rather than the exception ending the run with "thread+  blocked indefinitely in an MVar operation" and leaving every other file+  unwritten and unreported.+  [Issue 291](https://github.com/mrkkrp/tilia/issues/291).+* A dependency whose source is still missing after a download is no+  longer downloaded again on every run, nor is `cabal` asked twice where it+  keeps sources, which formatting on save paid for each time: what a+  download does not bring in is remembered under the plan, as it already+  was where the plan did not cover a component.+  [Issue 289](https://github.com/mrkkrp/tilia/issues/289).+* An entry of the `packages` field of a `cabal.project` that begins with+  dots or a slash, as `../lib`, `/abs/lib` or `.hidden`, is looked for where+  it points, as `cabal` looks for it, rather than under the project with the+  dots and the slash taken off, where it was usually not found and passed+  over. [Issue 294](https://github.com/mrkkrp/tilia/issues/294).+* A string literal comes out as written wherever it is: its gaps line up+  under its opening quote in a pattern and in a `WARNING` or `DEPRECATED`+  message, as they already did in an expression, a rule's name is no longer+  escaped again, as `"f/∘"` was into `"f/\8728"`, and an `SCC` label+  written without quotes no longer gains them.+  [PR 344](https://github.com/mrkkrp/tilia/pull/344).+* Top-level splices written one after another stay together across a+  comment or a preprocessor line between them, as standalone `deriving`+  declarations already did, rather than having blank lines put between+  them. [PR 344](https://github.com/mrkkrp/tilia/pull/344).+* An interrupt arriving while a package or a file is read stops the run,+  rather than being taken for that read failing.+  [PR 344](https://github.com/mrkkrp/tilia/pull/344).+* A run reads the build plan once where nothing is missing, and the sources+  of each dependency and the `.cabal` file of each package of the project+  once rather than once per component.+  [PR 344](https://github.com/mrkkrp/tilia/pull/344).+* A package declaring `cabal-version: 3.14`, `3.16` or `3.18` can be+  formatted, as `.cabal` files are read with Cabal-syntax 3.18 whichever+  compiler builds Tilia, where the release binaries, built with GHC 9.10.3+  and so Cabal-syntax 3.12, said its `.cabal` file did not parse. The+  release binaries are now built with GHC 9.14.1.+  [PR 345](https://github.com/mrkkrp/tilia/pull/345).+* The `.cabal` file of a dependency is read with Cabal-syntax, as the+  project's own are, rather than line by line, so a line of its description+  that begins with the name of a field is no longer taken for that field.+  [PR 345](https://github.com/mrkkrp/tilia/pull/345).+ ## Tilia 0.1.2.0  * A comment written beside the `..` of an item of an import or export list,

@@ -0,0 +1,185 @@+# Hacking++Enter the development shell by either running `direnv allow` or `nix+develop`. Once in the shell, the development is ordinary Cabal:++```console+$ cabal build+$ cabal test+```++All tests are in one test suite and there are a fair number of them. On my+machine the full test suite passes in 140 seconds, but it may be different+for you, so isolating a subset of the test suite may be helpful:++```console+$ cabal test --test-options='--match "Tilia.Fixity"'+```++The test suite will perform downloads the first time you run it and so it+will be a bit slower on that run. It needs various corpora, such as Hackage+packages and GHC's own test suite, which are not checked into this+repository.++The Hackage corpus is exercised in order to ensure that every module+formats, that its AST is preserved, and that formatting it is idempotent.+The results are recorded in `corpora/hackage/hackage.manifest`. Next to it,+`hackage.report` explains the failing cases. The manifest and the report can+be updated like this:++```console+$ TILIA_CORPUS_ACCEPT=1 cabal test+```++Finally, Tilia formats itself, so make sure to run this command before you+open a PR:++```console+$ nix run .#format+```++## Benchmarks++The benchmarks format a fixed sample of the Hackage corpus, check what most+of its modules are printed as the way `--check-ast` does, and format a few+modules made to stress one part of the formatter each. They also work out+fixities the ways a run does: they read every module of a dozen packages of+the corpus out of their tarballs, as a run with a cold cache does, read the+same out of a cache, as a warm run does, and decode the interfaces of a few+packages the compiler ships with. They take about 45 seconds:++```console+$ cabal bench+```++What each benchmark allocates and the instructions it retires are the same+from one run to the next to a hundredth of a percent, however busy the+machine is, so they are kept in `bench/bench.record` and checked like the+corpus is. The run fails where a benchmark allocates or retires 0.5% more+or less than the record says, or where all the benchmarks of a stage+together do 0.05% more or less. Update the record like this, and review the+change to it like any other:++```console+$ TILIA_BENCH_ACCEPT=1 cabal bench+```++What is allocated depends on the compiler, so the record is made with the+base compiler, and CI checks it there. The instructions depend on the+processor as well, so they are checked only on the processor the record+names, where Linux lets a process count them; elsewhere the run says so and+checks the rest. What decoding the interfaces costs depends on what they+hold, which can differ between builds of one compiler, so the record keeps a+digest of their names and sizes, and decoding is checked only where it+matches; the bytes alone differ between two builds in fingerprints that cost+nothing to decode. The benchmarks run with `-A1g -O1g -C1000`, in about 1.2+GiB, so that few collections fall inside one, and no major one or context+switch: the collector's own instructions depend on where in the work it+runs, which any change to what is allocated moves, and a major collection or+a context switch makes the counts depend on the rest of the heap and on the+clock. The benchmarks of one module or package run on their own with+`--match`, and updating the record then changes only their lines:++```console+$ cabal bench --benchmark-options='--match QuickCheck'+```++To compare two versions on another processor, save what one measures and+compare the other with it, which shows the instructions and the time of+all the benchmarks together and the benchmarks that moved most:++```console+$ cabal bench --benchmark-options='--save /tmp/before'+$ cabal bench --benchmark-options='--baseline /tmp/before'+```++Time is not recorded: on a quiet machine the time of all the benchmarks+together moves by about 1% from one run to the next, and the time of one of+them by up to 13%, even with `--runs 3`, which measures each three times and+takes the fastest. On a busy machine it moves by far more.++## Adding a GHC version++Tilia is built and tested with every compiler in the `compilers` list in+`flake.nix`. To add a major version of GHC:++1. Add it to `compilers` in `flake.nix`, where the list goes from the oldest+   version to the newest. If `haskell.nix` does not know the compiler yet,+   update it first with `nix flake update haskellNix`. This also gives the+   compiler a development shell, such as `nix develop .#ghc9161`.+2. Add it to the `build` matrix in `.github/workflows/ci.yaml` and number+   the shards again, so that with `n` entries each takes its own `i/n`. The+   test groups named in `compilerBound` in `tests/Main.hs` run on every+   entry, and the rest of the suite is split between them.+3. Add it to `tested-with` in `tilia.cabal`, and widen the bounds for the+   new versions of boot libraries. Bump `index-state` in `cabal.project` if+   the plan needs newer releases from Hackage.+4. Generate the table of names that the series writes into interface files+   as keys, with the new compiler:++   ```console+   $ ./generate-known-keys.py --ghc /path/to/ghc-9.16.1/bin/ghc+   ```++   This writes `src/Tilia/Fixity/KnownKeys/GhcNNN.hs`, which goes into+   `exposed-modules` in `tilia.cabal`.+5. Teach `Tilia.Fixity.HiFile` to read the interface files of the series: a+   new `Series` constructor, its version in `hiFile`, its table in+   `keyedNames`, its `primops` in `primopFixities`, and whatever the series+   changed in the layout that `hiFile`, `payload`, `pointer`, and `fixity`+   read. GHC's `GHC.Iface.Binary` and `GHC.Unit.Module.ModIface`, compared+   between the two series, show what changed. Tilia passes interface it+   cannot decode to `ghc --show-iface`, which works but costs a process per+   interface. The tests fail until every interface of the project's+   dependencies decodes and agrees with `ghc --show-iface` where the two are+   compared:++   ```console+   $ nix develop .#ghc9161 -c cabal test --test-options='--match "Tilia.Fixity"'+   ```++6. Update `CHANGELOG.md`.++`baseCompiler` in `flake.nix` names the base compiler, the newest of+`compilers`: it builds the release binaries, runs weeder, the self-format+checks and the benchmarks, and provides the default development shell. When+it changes, update `GHC_VERSION` in `.github/workflows/release.yaml` to+match, as well as the `restore-keys` of the `format` job and the compiler+of the `bench` job in `ci.yaml`, and record the benchmarks again with the+new base compiler.++## Switching `ghc-lib-parser`++To switch to another version of `ghc-lib-parser`:++1. Change the bounds on `ghc-lib-parser` in the stanza of that name in+   `tilia.cabal`, and bump `index-state` in `cabal.project` past its+   release. If `haskell.nix`'s index of Hackage does not reach that+   far, update the `haskellNix` input as well.+2. Fix what the new API breaks. Warnings are errors in this project, so a+   constructor that the new syntax tree adds and the printer does not handle+   shows up as an incomplete match. Add new syntax examples in+   `corpora/vendored/`.+3. Point `ghcTestSuite` in `tests/Tilia/Corpus.hs` at the test suite of the+   GHC release the parser comes from: its `corpusName` and the+   `ghc-X.Y.Z-release` tag it is fetched from. Then revise `ghcUnreadable`,+   the files GHC's own parser rejects, and `ghcDeclined`, the files Tilia is+   right to refuse, against that test suite.+4. Regenerate `tests/Tilia/BootFixities.hs`, the fixities the tests take the+   boot packages to export, with the compiler of the same release, after+   checking that `PACKAGES` in the script still names its boot packages:++   ```console+   $ ./generate-boot-fixities.py --ghc /path/to/ghc-9.16.1/bin/ghc+   ```++5. Record the Hackage corpus again with `TILIA_CORPUS_ACCEPT=1 cabal test`+   and review every change to `hackage.manifest` and `hackage.report`: a+   module that changes its outcome or its digest is now parsed differently.+6. The cache keeps summaries of local modules by the version of+   `ghc-lib-parser` that read them, but what it learned about dependencies+   is kept regardless of it. If the new parser reads the sources of+   dependencies differently, bump `formatVersion` in `Tilia.Fixity.Cache`.+7. Record the benchmarks again with `TILIA_BENCH_ACCEPT=1 cabal bench`,+   since parsing takes a share of what they cost.+8. Update `CHANGELOG.md`.

@@ -1,6 +1,5 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}  -- | Measure what formatting a fixed sample of modules costs, and compare -- what it allocates and the instructions it retires with the record kept@@ -9,7 +8,8 @@  import Control.Applicative ((<|>)) import Control.Exception (SomeException, try)-import Control.Monad (join, mfilter, unless)+import Control.Monad (join, mfilter, unless, when)+import Data.ByteString qualified as BS import Data.Containers.ListUtils (nubOrd) import Data.Foldable (for_) import Data.Int (Int64)@@ -20,6 +20,7 @@ import Data.Ord (Down (..)) import Data.Text (Text) import Data.Text qualified as T+import Data.Text.Encoding qualified as T import Data.Text.IO qualified as T import Data.Traversable (for) import Data.Version (showVersion)@@ -42,7 +43,6 @@     strOption,     value,   )-import System.Environment (lookupEnv) import System.Exit (die, exitFailure) import System.IO (BufferMode (..), hSetBuffering, stdout) import System.Info (fullCompilerVersion)@@ -53,6 +53,8 @@ import Tilia.Bench.Measure import Tilia.Bench.Record import Tilia.Corpus (hackagePackages, obtain)+import Tilia.TestUtils (switchedOn)+import Tilia.Utils (writeUtf8File)  -- | How the benchmarks were asked to run. data Options = Options@@ -79,7 +81,7 @@ main = do   hSetBuffering stdout LineBuffering   options <- execParser optionsInfo-  accepting <- (== Just "1") <$> lookupEnv "TILIA_BENCH_ACCEPT"+  accepting <- switchedOn "TILIA_BENCH_ACCEPT"   examples <- obtain hackagePackages >>= either (die . T.unpack) pure   sampled <- corpusSubjects examples >>= either (die . T.unpack) pure   let matching name = maybe True (`T.isInfixOf` name) (optMatch options)@@ -108,6 +110,10 @@   ended <- withFixityBenchmarks $ \(resolving, interfaces) -> do     let record = comparable processor interfaces written         decoding = recordInterfaces written == interfaces+        reheaded =+          recordCompiler written /= compiler+            || recordProcessor written /= fromMaybe "none" processor+            || not decoding         checked (stage, _) = decoding || stage /= stageName Decode     others <- for [b | b <- resolving, matching (benchmarkName b)] $ \b -> do       (_, m) <- measureIO counter (optRuns options) (benchmarkRun b) id@@ -121,6 +127,10 @@     for_ baseline (summarize measured)     if accepting       then do+        when (partial && reheaded) $+          die+            "Only some benchmarks were run, on another compiler, processor\n\+            \or set of interfaces than the record's: accept them all at once."         let entryOf k m =               steadied (Map.lookup k (recordEntries record)) $                 Entry@@ -428,7 +438,7 @@ -- | Save what was measured. writeBaseline :: FilePath -> [(Key, Measurement)] -> IO () writeBaseline path measured =-  T.writeFile path . T.unlines $+  writeUtf8File path . T.unlines $     [ T.unwords         [ stage,           T.pack (show (measuredTime m)),@@ -441,7 +451,7 @@ -- | Read what 'writeBaseline' saved. readBaseline :: FilePath -> IO Baseline readBaseline path = do-  text <- T.readFile path+  text <- T.decodeUtf8Lenient <$> BS.readFile path   pure $     Map.fromList       [ ((stage, T.unwords rest), (t, readMaybe (T.unpack retired)))

@@ -20,11 +20,11 @@ import Data.Text qualified as T import Data.Text.Encoding (decodeUtf8') import Data.Traversable (for)-import GHC.LanguageExtensions.Type (Extension) import Tilia.Corpus (Example (..)) import Tilia.Cpp (usesCpp) import Tilia.Format (rewritten) import Tilia.Parser (parseModule)+import Tilia.Pragma (Defaults) import Tilia.TestConfig (formatCppExample, printExample) import Tilia.TestUtils (effectiveExtensionsFor, parserConfigFor) @@ -203,7 +203,7 @@  -- | A module to format, and to check what that printed where it is -- checked.-subjectOf :: Maybe [Extension] -> Bool -> Text -> Text -> Subject+subjectOf :: Maybe Defaults -> Bool -> Text -> Text -> Subject subjectOf package isChecked name source =   Subject     { subjectName = name,@@ -224,7 +224,7 @@  -- | What formatting a module prints, as the corpus does it, or 'Nothing' -- where it is declined.-formatted :: Maybe [Extension] -> FilePath -> Text -> Maybe Text+formatted :: Maybe Defaults -> FilePath -> Text -> Maybe Text formatted package path source   | usesCpp (effectiveExtensionsFor package source) source =       either (const Nothing) Just (formatCppExample package path source)

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}@@ -209,7 +208,7 @@       cache <- cacheUnder (dir </> "cache")       interfaces <- interfacesOf decoded       let reading kept modules = do-            packageReader <- newPackageReader (plannedCompiler plan)+            packageReader <- newPackageReader (plannedCompiler plan) []             resolver <- newResolverWith [FromSource] kept [] tarballs packageReader plan             pure $ do               answers <- traverse (askModule resolver) modules

@@ -1,6 +1,5 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}  -- | What the benchmarks cost when they were last recorded, kept in the -- repository so that a change to it shows in review like any other.@@ -12,15 +11,14 @@   ) where -import Control.Exception (SomeException, try) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe) import Data.Text (Text) import Data.Text qualified as T-import Data.Text.IO qualified as T import Data.Word (Word64) import Text.Read (readMaybe)+import Tilia.Utils (readUtf8File, writeUtf8File)  -- | The bytes each benchmark allocated and the instructions it retired, by -- stage and module.@@ -50,9 +48,9 @@ -- before it is regenerated each say they are not in it. readRecord :: FilePath -> IO Record readRecord path =-  try (T.readFile path) >>= \case-    Left (_ :: SomeException) -> pure (Record "" "none" "" Map.empty)-    Right text ->+  readUtf8File path >>= \case+    Nothing -> pure (Record "" "none" "" Map.empty)+    Just text ->       pure         Record           { recordCompiler = field "compiler " text,@@ -72,7 +70,7 @@ -- shows what changed rather than what moved. writeRecord :: FilePath -> Record -> IO () writeRecord path record =-  T.writeFile path . T.unlines $+  writeUtf8File path . T.unlines $     [ "# What each benchmark costs, as far as that does not depend on how",       "# busy the machine is. `cabal bench` checks it, and",       "# `TILIA_BENCH_ACCEPT=1 cabal bench` writes it again.",

@@ -24,98 +24,98 @@ #               they were not counted. # benchmark     The module or the package it measures that on. -compiler ghc 9.10.3+compiler ghc 9.14.1 processor AMD Ryzen AI 9 HX 370 w/ Radeon 890M-interfaces 1c28e35fa2432d89+interfaces 78bbcc544104eadc  # stage      allocated  instructions  benchmark-check        272354648     575981358  Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs-check        411823456     855523727  ShellCheck-0.11.0/src/ShellCheck/Analytics.hs-check        260497296     461063479  aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs-check        196550504     511610069  blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs-check         63623696     127394098  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs-check         84949968     171830970  distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs-check        127362696     266504214  esqueleto-3.6.0.3/test/PostgreSQL/Test.hs-check        506858784     923788756  haxl-2.5.1.1/Haxl/Core/Monad.hs-check        215914784     451467945  idris-1.3.4/src/Idris/Elab/Term.hs-check        333601000     572292120  lifted-base-0.2.3.12/Control/Exception/Lifted.hs-check         60171824     128139113  megaparsec-9.8.1/Text/Megaparsec/Internal.hs-check         81898560     173856514  optparse-applicative-0.19.0.0/tests/test.hs-check         51558504      90521497  pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs-check        160564576     336134147  pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs-check        217005264     438646778  pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs-check        177263168     360271324  purescript-0.15.15/src/Language/PureScript/Errors.hs-check         86199456     182395610  purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs-check         76944368     174894002  recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs-check         90285488     193297667  servant-server-0.20.3.0/src/Servant/Server/Internal.hs-check         99785848     200988911  swagger2-2.9.1/src/Data/Swagger/Internal.hs-check        104406992     193276384  text-2.1.4/tests/Tests/Properties/Folds.hs-check         62082528     128971807  time-1.16.0.1/test/main/Test/Format/ParseTime.hs-check         69973984     137412179  tls-2.4.3/Network/TLS/Extension.hs-check        322427128     758963691  unpacked-containers-0/src/Map/Internal.hs-check        438419048     846475201  vector-0.13.2.0/src/Data/Vector/Generic.hs-check         70657680     148642078  xmonad-0.18.1/src/XMonad/Operations.hs-decode        25613816      43571594  base-4.20.2.0-decode         5830408       7145065  bytestring-0.12.2.0-decode         9126328      11777525  containers-0.7-decode        42252744      55499725  ghc-internal-9.1003.0-decode        11189560      15486875  template-haskell-2.22.0.0-decode         6097120       6605095  text-2.1.3-format       587068744    1136108572  Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs-format      4060865072    8041341103  QuickCheck-2.18.0.0/src/Test/QuickCheck/Arbitrary.hs-format       907373856    1723990920  ShellCheck-0.11.0/src/ShellCheck/Analytics.hs-format       330450600     571670315  aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs-format       175030840     326850369  blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs-format       125920744     239525469  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs-format       182428296     345883719  distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs-format       313363824     590647912  esqueleto-3.6.0.3/test/PostgreSQL/Test.hs-format       773029152    1543414928  haxl-2.5.1.1/Haxl/Core/Monad.hs-format       505953528     965039048  idris-1.3.4/src/Idris/Elab/Term.hs-format      1340529160    2711040392  lens-5.3.6/src/Control/Lens/Wrapped.hs-format       403596632     737287954  lifted-base-0.2.3.12/Control/Exception/Lifted.hs-format       115350240     221131009  megaparsec-9.8.1/Text/Megaparsec/Internal.hs-format       152138968     278467498  optparse-applicative-0.19.0.0/tests/test.hs-format        54554184      96700081  pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs-format       377676272     719453674  pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs-format       466875216     881809887  pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs-format       375024840     709592247  purescript-0.15.15/src/Language/PureScript/Errors.hs-format       157667592     293149746  purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs-format       129432696     233813267  recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs-format       173127584     323770122  servant-server-0.20.3.0/src/Servant/Server/Internal.hs-format       175020056     327970368  swagger2-2.9.1/src/Data/Swagger/Internal.hs-format       716528888    1507106872  synthetic/comments-format       107796160     237491710  synthetic/conditionals-format        77608272     114637794  synthetic/imports-format        99934472     207607344  synthetic/nesting-format       839857072    1653646287  text-2.1.4/src/Data/Text/Internal/Fusion/CaseMapping.hs-format       223534696     391051730  text-2.1.4/tests/Tests/Properties/Folds.hs-format       139006432     258193642  time-1.16.0.1/test/main/Test/Format/ParseTime.hs-format       139928120     263889581  tls-2.4.3/Network/TLS/Extension.hs-format      1012993016    1985300102  unordered-containers-0.2.21/Data/HashMap/Internal.hs-format       509562512     951647762  unpacked-containers-0/src/Map/Internal.hs-format       551911832    1043593184  vector-0.13.2.0/src/Data/Vector/Generic.hs-format       139491808     261133367  xmonad-0.18.1/src/XMonad/Operations.hs-recall         5154088      11631440  aeson-2.3.1.0-recall         2222200       5118396  conduit-1.3.6.1-recall         1709976       3278498  free-5.2-recall        11088696      34739875  lens-5.3.6-recall         1793600       3797411  megaparsec-9.8.1-recall         2129136       4316346  mtl-2.3.2-recall         1289808       2773580  optics-0.4.2.1-recall         1532472       3627916  pandoc-types-1.23.1.2-recall         2301760       4717796  semigroupoids-6.0.2-recall         3293336       6712858  servant-0.20.3.0-recall         5188496       9120737  text-2.1.4-recall         4061800       8698087  vector-0.13.2.0-resolve     1810656152    3180580388  aeson-2.3.1.0-resolve      435325168     738034252  conduit-1.3.6.1-resolve      471290256     797760851  free-5.2-resolve     2974846416    5176070738  lens-5.3.6-resolve      210109008     366801169  megaparsec-9.8.1-resolve      225682064     388972813  mtl-2.3.2-resolve       64290384     128790701  optics-0.4.2.1-resolve       77403992     142729351  pandoc-types-1.23.1.2-resolve      133167224     239714598  semigroupoids-6.0.2-resolve      213362072     390356497  servant-0.20.3.0-resolve     1159785776    1994326073  text-2.1.4-resolve     2408709680    4066724655  vector-0.13.2.0+check        262394328     561065716  Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs+check        397446832     830954176  ShellCheck-0.11.0/src/ShellCheck/Analytics.hs+check        241124648     438396589  aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs+check        189604912     503938397  blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs+check         61103592     123879818  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs+check         80904096     166165901  distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs+check        122830480     257529681  esqueleto-3.6.0.3/test/PostgreSQL/Test.hs+check        494049016     907759201  haxl-2.5.1.1/Haxl/Core/Monad.hs+check        208630016     437290005  idris-1.3.4/src/Idris/Elab/Term.hs+check        316305056     548835398  lifted-base-0.2.3.12/Control/Exception/Lifted.hs+check         58863640     126561712  megaparsec-9.8.1/Text/Megaparsec/Internal.hs+check         78865104     169281790  optparse-applicative-0.19.0.0/tests/test.hs+check         49898856      88299550  pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs+check        155279368     326828232  pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs+check        208221512     425543616  pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs+check        171071104     351249427  purescript-0.15.15/src/Language/PureScript/Errors.hs+check         83717864     177741049  purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs+check         75851168     173224739  recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs+check         87866232     190347605  servant-server-0.20.3.0/src/Servant/Server/Internal.hs+check         96614904     199151954  swagger2-2.9.1/src/Data/Swagger/Internal.hs+check        100392680     186829756  text-2.1.4/tests/Tests/Properties/Folds.hs+check         59225512     125146433  time-1.16.0.1/test/main/Test/Format/ParseTime.hs+check         65691176     132601013  tls-2.4.3/Network/TLS/Extension.hs+check        316686328     745977417  unpacked-containers-0/src/Map/Internal.hs+check        429238096     834183400  vector-0.13.2.0/src/Data/Vector/Generic.hs+check         68487400     145286254  xmonad-0.18.1/src/XMonad/Operations.hs+decode        25986560      42986706  base-4.22.0.0+decode         6162184       7405780  bytestring-0.12.2.0+decode         9617160      11823599  containers-0.8+decode        60341752      75721656  ghc-internal-9.1401.0+decode         5048664       9492955  template-haskell-2.24.0.0+decode         6427528       6910066  text-2.1.3+format       556566968    1040003316  Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs+format      3948115280    7939983547  QuickCheck-2.18.0.0/src/Test/QuickCheck/Arbitrary.hs+format       863564728    1573781326  ShellCheck-0.11.0/src/ShellCheck/Analytics.hs+format       303951416     534115111  aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs+format       164705632     309258425  blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs+format       114058024     212152157  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs+format       170229520     316697956  distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs+format       297570528     541006283  esqueleto-3.6.0.3/test/PostgreSQL/Test.hs+format       759077968    1520521231  haxl-2.5.1.1/Haxl/Core/Monad.hs+format       483356504     878928957  idris-1.3.4/src/Idris/Elab/Term.hs+format      1320092680    2678994116  lens-5.3.6/src/Control/Lens/Wrapped.hs+format       372668480     696092011  lifted-base-0.2.3.12/Control/Exception/Lifted.hs+format       110834768     209454593  megaparsec-9.8.1/Text/Megaparsec/Internal.hs+format       143959296     262866520  optparse-applicative-0.19.0.0/tests/test.hs+format        52995496      94413105  pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs+format       361638296     659596851  pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs+format       443949808     814179116  pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs+format       357025320     656146525  purescript-0.15.15/src/Language/PureScript/Errors.hs+format       150005992     275935657  purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs+format       122875928     216641468  recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs+format       164938072     301655910  servant-server-0.20.3.0/src/Servant/Server/Internal.hs+format       167528512     311088065  swagger2-2.9.1/src/Data/Swagger/Internal.hs+format       648895256    1363324909  synthetic/comments+format       105358360     225585007  synthetic/conditionals+format        76791456     114759701  synthetic/imports+format        97076928     207279778  synthetic/nesting+format       793484632    1508895855  text-2.1.4/src/Data/Text/Internal/Fusion/CaseMapping.hs+format       216925176     379840605  text-2.1.4/tests/Tests/Properties/Folds.hs+format       125519664     227671534  time-1.16.0.1/test/main/Test/Format/ParseTime.hs+format       128974056     241642635  tls-2.4.3/Network/TLS/Extension.hs+format       985060280    1912068703  unordered-containers-0.2.21/Data/HashMap/Internal.hs+format       486293072     872473350  unpacked-containers-0/src/Map/Internal.hs+format       533965872    1009710097  vector-0.13.2.0/src/Data/Vector/Generic.hs+format       132689048     241971753  xmonad-0.18.1/src/XMonad/Operations.hs+recall         5011864       9048673  aeson-2.3.1.0+recall         2205328       4115511  conduit-1.3.6.1+recall         1748312       2942852  free-5.2+recall        10404000      22672143  lens-5.3.6+recall         1825680       3287510  megaparsec-9.8.1+recall         2160552       3802105  mtl-2.3.2+recall         1351496       2492548  optics-0.4.2.1+recall         1559568       3026727  pandoc-types-1.23.1.2+recall         2337880       4125023  semigroupoids-6.0.2+recall         3239392       5595514  servant-0.20.3.0+recall         5102944       8218446  text-2.1.4+recall         3946288       7016254  vector-0.13.2.0+resolve     1711586824    2939731779  aeson-2.3.1.0+resolve      414482984     677964413  conduit-1.3.6.1+resolve      453525440     735173130  free-5.2+resolve     2764810360    4739854108  lens-5.3.6+resolve      199884528     326934357  megaparsec-9.8.1+resolve      209198760     338204339  mtl-2.3.2+resolve       63227560      99404301  optics-0.4.2.1+resolve       71461520     116712703  pandoc-types-1.23.1.2+resolve      124101824     202496534  semigroupoids-6.0.2+resolve      198377800     321014101  servant-0.20.3.0+resolve     1090795072    1819001479  text-2.1.4+resolve     2271139808    3767375431  vector-0.13.2.0

@@ -482,7 +482,7 @@ formatted       da3fb75adccf  QuickCheck-2.18.0.0/tests/DiscardRatio.hs formatted       5408e5e13bd3  QuickCheck-2.18.0.0/tests/GCoArbitraryExample.hs formatted       8dd012261272  QuickCheck-2.18.0.0/tests/GShrinkExample.hs-formatted       3f82e6fd307d  QuickCheck-2.18.0.0/tests/Generators.hs+formatted       5f4c2707cfc6  QuickCheck-2.18.0.0/tests/Generators.hs formatted       057887c409bc  QuickCheck-2.18.0.0/tests/Misc.hs formatted       414efdc48918  QuickCheck-2.18.0.0/tests/MonadFix.hs formatted       85ad2d1decbe  QuickCheck-2.18.0.0/tests/Monoids.hs@@ -516,7 +516,7 @@ formatted       a381122da904  ShellCheck-0.11.0/src/ShellCheck/Formatter/Quiet.hs formatted       ede5712d5ab7  ShellCheck-0.11.0/src/ShellCheck/Formatter/TTY.hs formatted       a601aea10041  ShellCheck-0.11.0/src/ShellCheck/Interface.hs-formatted       fd032d879733  ShellCheck-0.11.0/src/ShellCheck/Parser.hs+formatted       2cfa8339411e  ShellCheck-0.11.0/src/ShellCheck/Parser.hs formatted       41e45f4ec82e  ShellCheck-0.11.0/src/ShellCheck/Prelude.hs formatted       0b6a2ca650ea  ShellCheck-0.11.0/src/ShellCheck/Regex.hs formatted       d7f66e7f3a00  ShellCheck-0.11.0/test/shellcheck.hs@@ -561,30 +561,30 @@ formatted       8e47a331bfb8  aeson-2.3.1.0/src/Data/Aeson/TH.hs formatted       12a0132d4a2c  aeson-2.3.1.0/src/Data/Aeson/Text.hs formatted       d929af4e0687  aeson-2.3.1.0/src/Data/Aeson/Types.hs-formatted       e11d9a90b593  aeson-2.3.1.0/src/Data/Aeson/Types/Class.hs+formatted       769fcc14bce2  aeson-2.3.1.0/src/Data/Aeson/Types/Class.hs formatted       fc043ebfc291  aeson-2.3.1.0/src/Data/Aeson/Types/FromJSON.hs formatted       af543197c845  aeson-2.3.1.0/src/Data/Aeson/Types/Generic.hs formatted       a7b6903cad74  aeson-2.3.1.0/src/Data/Aeson/Types/Internal.hs formatted       e372019c3433  aeson-2.3.1.0/src/Data/Aeson/Types/ToJSON.hs formatted       1916009e9352  aeson-2.3.1.0/tests/CastFloat.hs-formatted       bad3a5065737  aeson-2.3.1.0/tests/DataFamilies/Encoders.hs-formatted       0d864147e795  aeson-2.3.1.0/tests/DataFamilies/Instances.hs+formatted       83937f2ef82e  aeson-2.3.1.0/tests/DataFamilies/Encoders.hs+formatted       204116ceb7db  aeson-2.3.1.0/tests/DataFamilies/Instances.hs formatted       91fe7aa4d3dc  aeson-2.3.1.0/tests/DataFamilies/Properties.hs-formatted       4d002c77704c  aeson-2.3.1.0/tests/DataFamilies/Types.hs+formatted       7f146994b15a  aeson-2.3.1.0/tests/DataFamilies/Types.hs formatted       07fde92bf8d1  aeson-2.3.1.0/tests/DoubleToScientific.hs-formatted       659a9357b588  aeson-2.3.1.0/tests/Encoders.hs-formatted       30150da5a855  aeson-2.3.1.0/tests/ErrorMessages.hs+formatted       5377988ba287  aeson-2.3.1.0/tests/Encoders.hs+formatted       5ad9153a88b6  aeson-2.3.1.0/tests/ErrorMessages.hs formatted       72fb423455c1  aeson-2.3.1.0/tests/Functions.hs-formatted       45b065b98a94  aeson-2.3.1.0/tests/Instances.hs+formatted       a9d868843992  aeson-2.3.1.0/tests/Instances.hs formatted       38b7096d53c4  aeson-2.3.1.0/tests/JSONTestSuite.hs formatted       82f27586e194  aeson-2.3.1.0/tests/Options.hs-formatted       269fd896fd74  aeson-2.3.1.0/tests/PropUtils.hs+formatted       44fab88974f6  aeson-2.3.1.0/tests/PropUtils.hs formatted       5c7e1bcf3dd6  aeson-2.3.1.0/tests/Properties.hs formatted       7d368ad15e82  aeson-2.3.1.0/tests/PropertyGeneric.hs-formatted       109d7fb52b5b  aeson-2.3.1.0/tests/PropertyKeys.hs-formatted       0d9df9d04cba  aeson-2.3.1.0/tests/PropertyQC.hs-formatted       a2e378d49eb8  aeson-2.3.1.0/tests/PropertyRTFunctors.hs-formatted       d54279308532  aeson-2.3.1.0/tests/PropertyRoundTrip.hs+formatted       6e8696681818  aeson-2.3.1.0/tests/PropertyKeys.hs+formatted       fbd08dc6e050  aeson-2.3.1.0/tests/PropertyQC.hs+formatted       8225a2de1b48  aeson-2.3.1.0/tests/PropertyRTFunctors.hs+formatted       ec45061f33d0  aeson-2.3.1.0/tests/PropertyRoundTrip.hs formatted       5c1372b7a444  aeson-2.3.1.0/tests/PropertyTH.hs formatted       5b4efaf27bc6  aeson-2.3.1.0/tests/RFC8785.hs formatted       378b97660503  aeson-2.3.1.0/tests/Regression/Issue1138.hs@@ -592,16 +592,16 @@ formatted       f000e9c51f1a  aeson-2.3.1.0/tests/Regression/Issue571.hs formatted       650ac09bee0a  aeson-2.3.1.0/tests/Regression/Issue687.hs formatted       e5c541d1465a  aeson-2.3.1.0/tests/Regression/Issue967.hs-formatted       f696f5d31388  aeson-2.3.1.0/tests/SerializationFormatSpec.hs+formatted       dc258c7824a4  aeson-2.3.1.0/tests/SerializationFormatSpec.hs formatted       8eaa36c16021  aeson-2.3.1.0/tests/Tests.hs-formatted       c88e88732cfd  aeson-2.3.1.0/tests/Types.hs-formatted       7731424b43b3  aeson-2.3.1.0/tests/UnitTests.hs+formatted       67cf480b391c  aeson-2.3.1.0/tests/Types.hs+formatted       27539a7f2ac7  aeson-2.3.1.0/tests/UnitTests.hs formatted       f18689008d86  aeson-2.3.1.0/tests/UnitTests/FromJSONKey.hs formatted       8fa12a214cda  aeson-2.3.1.0/tests/UnitTests/Hashable.hs formatted       2e6e13a2b307  aeson-2.3.1.0/tests/UnitTests/KeyMapInsertWith.hs formatted       fc462ed61e50  aeson-2.3.1.0/tests/UnitTests/MonadFix.hs formatted       657449faeb93  aeson-2.3.1.0/tests/UnitTests/NoThunks.hs-formatted       31a111ec64d8  aeson-2.3.1.0/tests/UnitTests/NullaryConstructors.hs+formatted       860ac1653916  aeson-2.3.1.0/tests/UnitTests/NullaryConstructors.hs formatted       91f9a9590048  aeson-2.3.1.0/tests/UnitTests/OmitNothingFieldsNote.hs formatted       11d14533f820  aeson-2.3.1.0/tests/UnitTests/OptionalFields.hs formatted       699f022c0cb2  aeson-2.3.1.0/tests/UnitTests/OptionalFields/Common.hs@@ -617,7 +617,7 @@ formatted       1aaa3e2316a9  ansi-terminal-1.1.5/win/System/Console/ANSI/Windows/Foreign.hs formatted       e763680dce5b  ansi-terminal-1.1.5/win/System/Console/ANSI/Windows/Win32/Types.hs formatted       9e25d9947df5  async-2.2.6/Control/Concurrent/Async.hs-partly-checked  652d49b16c08  async-2.2.6/Control/Concurrent/Async/Internal.hs+partly-checked  f088ecc2c2e1  async-2.2.6/Control/Concurrent/Async/Internal.hs formatted       68777666410b  async-2.2.6/Control/Concurrent/Async/Warden.hs formatted       a0f5a7bd29cb  async-2.2.6/Control/Concurrent/Stream.hs formatted       e865ae48f11b  async-2.2.6/Setup.hs@@ -681,16 +681,16 @@ formatted       316b8d029dee  aws-0.25.3/Aws/Core.hs formatted       526f7494fea1  aws-0.25.3/Aws/DynamoDb.hs formatted       11c5a36e6111  aws-0.25.3/Aws/DynamoDb/Commands.hs-formatted       fdedda6a01bc  aws-0.25.3/Aws/DynamoDb/Commands/BatchGetItem.hs-formatted       284a9d6d25fa  aws-0.25.3/Aws/DynamoDb/Commands/BatchWriteItem.hs-formatted       37d0f09919b9  aws-0.25.3/Aws/DynamoDb/Commands/DeleteItem.hs+formatted       f3cc0daec291  aws-0.25.3/Aws/DynamoDb/Commands/BatchGetItem.hs+formatted       d547ef2d0b43  aws-0.25.3/Aws/DynamoDb/Commands/BatchWriteItem.hs+formatted       677a7cdf1061  aws-0.25.3/Aws/DynamoDb/Commands/DeleteItem.hs formatted       6e48f7806e5d  aws-0.25.3/Aws/DynamoDb/Commands/GetItem.hs-formatted       413574967b43  aws-0.25.3/Aws/DynamoDb/Commands/PutItem.hs+formatted       27bb9f414054  aws-0.25.3/Aws/DynamoDb/Commands/PutItem.hs formatted       706f861f1b54  aws-0.25.3/Aws/DynamoDb/Commands/Query.hs formatted       76d3cbe6ea1b  aws-0.25.3/Aws/DynamoDb/Commands/Scan.hs formatted       c6547f406402  aws-0.25.3/Aws/DynamoDb/Commands/Table.hs-formatted       1159130413aa  aws-0.25.3/Aws/DynamoDb/Commands/UpdateItem.hs-formatted       5527efbba0d1  aws-0.25.3/Aws/DynamoDb/Core.hs+formatted       66dd03e705d8  aws-0.25.3/Aws/DynamoDb/Commands/UpdateItem.hs+formatted       0779dd9e102b  aws-0.25.3/Aws/DynamoDb/Core.hs formatted       7da30757579d  aws-0.25.3/Aws/Ec2/InstanceMetadata.hs formatted       64524ea72e53  aws-0.25.3/Aws/Iam.hs formatted       749eee8b56a6  aws-0.25.3/Aws/Iam/Commands.hs@@ -1462,36 +1462,36 @@ formatted       52caf5793d73  brittany-0.14.0.2/data/Test99.hs formatted       7a5d0ee67b99  brittany-0.14.0.2/source/executable/Main.hs formatted       f006bb65ddb6  brittany-0.14.0.2/source/library/Language/Haskell/Brittany.hs-formatted       effc7ab14a00  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal.hs-formatted       62f91f308c2e  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Backend.hs+formatted       7ddd24db972c  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal.hs+formatted       efd6c420ed12  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Backend.hs formatted       b114e1735e96  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/BackendUtils.hs formatted       4db6008c162f  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Config.hs-formatted       47cac5b50849  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Config/Types.hs+formatted       442f38348553  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Config/Types.hs formatted       3479d640d39c  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs-formatted       3a7e4e0507b6  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs+formatted       0bd9379faeaf  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs formatted       5d4339023e83  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/LayouterBasics.hs formatted       e6236562836a  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs-formatted       4259510f3316  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Decl.hs+formatted       35d642ea03c9  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Decl.hs formatted       85310fee66ef  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs formatted       63ac93aa854f  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot formatted       f730e71a6728  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/IE.hs formatted       4647ea64ed39  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Import.hs formatted       455e49f342e4  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Module.hs formatted       94a22988945f  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs-formatted       d46ed5a9675b  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs+formatted       9219767aabaf  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs formatted       08c3e5d27dd4  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot formatted       757402eae174  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Type.hs formatted       8d7327e29615  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Obfuscation.hs formatted       0dc2352f4480  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/ParseModule.hs formatted       069a6d78e89a  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Prelude.hs formatted       1a8db66fd521  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/PreludeUtils.hs-formatted       a12759ae906d  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs+formatted       a2109c56e3eb  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs formatted       c6217dd1471b  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Columns.hs formatted       f558625f25b7  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Floating.hs formatted       7d95cc82a77f  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Indent.hs formatted       f6a84d0ce013  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Par.hs-formatted       9bb018400ea8  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Types.hs-formatted       203fcf60dae6  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Utils.hs+formatted       5ea5611a32d7  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Types.hs+formatted       ad92bdb716e5  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Utils.hs formatted       20badc0ca0c8  brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Main.hs formatted       e425ebfb8e97  brittany-0.14.0.2/source/test-suite/Main.hs formatted       e865ae48f11b  capability-0.5.0.1/Setup.hs@@ -1567,9 +1567,9 @@ formatted       f70f6155e62a  conduit-1.3.6.1/benchmarks/unfused.hs formatted       20fad0c5aecd  conduit-1.3.6.1/src/Conduit.hs formatted       bf88ceabad43  conduit-1.3.6.1/src/Data/Conduit.hs-formatted       1a953cd53139  conduit-1.3.6.1/src/Data/Conduit/Combinators.hs+formatted       df07505ba4ab  conduit-1.3.6.1/src/Data/Conduit/Combinators.hs formatted       f520242138c3  conduit-1.3.6.1/src/Data/Conduit/Combinators/Stream.hs-formatted       7d754c7349cf  conduit-1.3.6.1/src/Data/Conduit/Combinators/Unqualified.hs+formatted       438fcb6d4096  conduit-1.3.6.1/src/Data/Conduit/Combinators/Unqualified.hs formatted       8e861a915c2f  conduit-1.3.6.1/src/Data/Conduit/Internal.hs formatted       c35f5a66accc  conduit-1.3.6.1/src/Data/Conduit/Internal/Conduit.hs formatted       bbfd28e5b98b  conduit-1.3.6.1/src/Data/Conduit/Internal/Fusion.hs@@ -1908,17 +1908,17 @@ formatted       95434fcb6957  exceptions-0.10.12/src/Control/Monad/Catch/Pure.hs formatted       da6b7265725b  exceptions-0.10.12/tests/Control/Monad/Catch/Tests.hs formatted       bba664ba2b8b  exceptions-0.10.12/tests/Tests.hs-formatted       421394df9111  fay-0.24.2.0/Setup.hs+formatted       9ecbe8994d9e  fay-0.24.2.0/Setup.hs formatted       ec9eeba0c6a1  fay-0.24.2.0/examples/CodeWorld.hs formatted       7cf91d63601f  fay-0.24.2.0/examples/CodeWorldMain.hs-formatted       d34203032896  fay-0.24.2.0/examples/Cont.hs+formatted       2791ee0a9bd2  fay-0.24.2.0/examples/Cont.hs formatted       b5088332842e  fay-0.24.2.0/examples/D3TreeSample.hs formatted       45fa087c720a  fay-0.24.2.0/examples/FayFromJs.hs formatted       d4be2511948d  fay-0.24.2.0/examples/Separated.hs formatted       73cbc6340843  fay-0.24.2.0/examples/X.hs formatted       89a1e9058dc3  fay-0.24.2.0/examples/Y.hs formatted       55d7b8cf115f  fay-0.24.2.0/examples/alert.hs-formatted       3563971c6bdb  fay-0.24.2.0/examples/calc.hs+formatted       e0b177e5a9f3  fay-0.24.2.0/examples/calc.hs formatted       2d60fb67f2de  fay-0.24.2.0/examples/canvaswater.hs formatted       97df12f5dfa2  fay-0.24.2.0/examples/console.hs formatted       7608e18ca01c  fay-0.24.2.0/examples/data.hs@@ -1934,38 +1934,38 @@ formatted       7085b02d6471  fay-0.24.2.0/examples/ref.hs formatted       55fe2b9f624f  fay-0.24.2.0/examples/showExamples.hs formatted       884b6fbdaadc  fay-0.24.2.0/examples/tailrecursive.hs-formatted       c2d5e370d7e2  fay-0.24.2.0/src/Fay.hs-formatted       9a042d6a7ba9  fay-0.24.2.0/src/Fay/Compiler.hs-formatted       727b9da5eeda  fay-0.24.2.0/src/Fay/Compiler/Decl.hs+formatted       d57685ee2836  fay-0.24.2.0/src/Fay.hs+formatted       8e1eda45f5a1  fay-0.24.2.0/src/Fay/Compiler.hs+formatted       5c71e55e06ee  fay-0.24.2.0/src/Fay/Compiler/Decl.hs formatted       d4575500ee48  fay-0.24.2.0/src/Fay/Compiler/Defaults.hs formatted       891834d5aec2  fay-0.24.2.0/src/Fay/Compiler/Desugar.hs formatted       570ca805808c  fay-0.24.2.0/src/Fay/Compiler/Desugar/Name.hs formatted       fe53147a7e33  fay-0.24.2.0/src/Fay/Compiler/Desugar/Types.hs-formatted       de04ffc1e73c  fay-0.24.2.0/src/Fay/Compiler/Exp.hs-formatted       cfc0f0f46b43  fay-0.24.2.0/src/Fay/Compiler/FFI.hs+formatted       85a69bad988d  fay-0.24.2.0/src/Fay/Compiler/Exp.hs+formatted       c6dd7b9e3183  fay-0.24.2.0/src/Fay/Compiler/FFI.hs formatted       69fd6dd80a66  fay-0.24.2.0/src/Fay/Compiler/GADT.hs-formatted       bcb9d437929e  fay-0.24.2.0/src/Fay/Compiler/Import.hs-formatted       766c34ce53b0  fay-0.24.2.0/src/Fay/Compiler/InitialPass.hs-formatted       d9d683411028  fay-0.24.2.0/src/Fay/Compiler/Misc.hs-formatted       bce0992d570d  fay-0.24.2.0/src/Fay/Compiler/ModuleT.hs-formatted       2fdd19da261b  fay-0.24.2.0/src/Fay/Compiler/Optimizer.hs-formatted       ac32749d90ec  fay-0.24.2.0/src/Fay/Compiler/Packages.hs+formatted       7ffae636dbe4  fay-0.24.2.0/src/Fay/Compiler/Import.hs+formatted       95cf95ae99fe  fay-0.24.2.0/src/Fay/Compiler/InitialPass.hs+formatted       9df7da80e8c4  fay-0.24.2.0/src/Fay/Compiler/Misc.hs+formatted       e526d58c2637  fay-0.24.2.0/src/Fay/Compiler/ModuleT.hs+formatted       984b0a80a55e  fay-0.24.2.0/src/Fay/Compiler/Optimizer.hs+formatted       ce1e364e00bb  fay-0.24.2.0/src/Fay/Compiler/Packages.hs formatted       1798f425b036  fay-0.24.2.0/src/Fay/Compiler/Parse.hs-formatted       46f343ccba7b  fay-0.24.2.0/src/Fay/Compiler/Pattern.hs+formatted       dba17f522647  fay-0.24.2.0/src/Fay/Compiler/Pattern.hs formatted       7cca783f3fcd  fay-0.24.2.0/src/Fay/Compiler/Prelude.hs-formatted       0fe3943a05fb  fay-0.24.2.0/src/Fay/Compiler/PrimOp.hs-formatted       d7dcfe1aa9ca  fay-0.24.2.0/src/Fay/Compiler/Print.hs+formatted       0705dae72c12  fay-0.24.2.0/src/Fay/Compiler/PrimOp.hs+formatted       bec107e6f3d3  fay-0.24.2.0/src/Fay/Compiler/Print.hs formatted       da23ccb55970  fay-0.24.2.0/src/Fay/Compiler/QName.hs formatted       9fe2fbd3e360  fay-0.24.2.0/src/Fay/Compiler/State.hs formatted       fb1831a445cc  fay-0.24.2.0/src/Fay/Compiler/Typecheck.hs formatted       631cbd5cb454  fay-0.24.2.0/src/Fay/Config.hs-formatted       15cd1e849d0e  fay-0.24.2.0/src/Fay/Convert.hs+formatted       5e21cc38a1e1  fay-0.24.2.0/src/Fay/Convert.hs formatted       80d46083d774  fay-0.24.2.0/src/Fay/Exts.hs-formatted       7ec6f093e0ca  fay-0.24.2.0/src/Fay/Exts/NoAnnotation.hs+formatted       23a0a09bf5e1  fay-0.24.2.0/src/Fay/Exts/NoAnnotation.hs formatted       bd1f234d96c0  fay-0.24.2.0/src/Fay/Exts/Scoped.hs-formatted       f7856f337bee  fay-0.24.2.0/src/Fay/FFI.hs+formatted       d29776a761a7  fay-0.24.2.0/src/Fay/FFI.hs formatted       b21a6a7c7e2f  fay-0.24.2.0/src/Fay/Runtime.hs-formatted       0ac5069cbf76  fay-0.24.2.0/src/Fay/Types.hs+formatted       21ff228b349a  fay-0.24.2.0/src/Fay/Types.hs formatted       6654772d79a6  fay-0.24.2.0/src/Fay/Types/CompileError.hs formatted       4f7fdfee2a8f  fay-0.24.2.0/src/Fay/Types/CompileResult.hs formatted       cea8d04284a4  fay-0.24.2.0/src/Fay/Types/FFI.hs@@ -1973,33 +1973,33 @@ formatted       1165cbb859cc  fay-0.24.2.0/src/Fay/Types/ModulePath.hs formatted       ed80698a7cd1  fay-0.24.2.0/src/Fay/Types/Printer.hs formatted       6593766b1d2e  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names.hs-formatted       379279fca760  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Annotated.hs-formatted       effa30f29551  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Exports.hs-formatted       633d0ead4b0e  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/GetBound.hs-formatted       74e293075d13  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/GlobalSymbolTable.hs+formatted       c40577bbbe78  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Annotated.hs+formatted       2156e3053cf3  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Exports.hs+formatted       2c712ca7ff92  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/GetBound.hs+formatted       6f5ea387dca8  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/GlobalSymbolTable.hs formatted       13662130820d  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/GlobalSymbolTable.hs-boot-formatted       3346bfa56c31  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Imports.hs+formatted       ea2e30c7db82  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Imports.hs formatted       bda66c725ce4  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/LocalSymbolTable.hs-formatted       c6c4acea37c3  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/ModuleSymbols.hs-formatted       76ce45f69410  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Open/Base.hs+formatted       2dcb549aaa00  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/ModuleSymbols.hs+formatted       81d92815fef2  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Open/Base.hs formatted       b12db8ba5ce9  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Open/Derived.hs-formatted       325536c28de7  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Open/Instances.hs-formatted       deb2b656a1ad  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/RecordWildcards.hs-formatted       80dec7fda3fb  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Recursive.hs-formatted       006f3c334ab0  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/ScopeUtils.hs-formatted       3dd4a51f2cc5  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/SyntaxUtils.hs-formatted       954e31fc5bf8  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Types.hs+formatted       d7517cafa993  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Open/Instances.hs+formatted       864c19ccab50  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/RecordWildcards.hs+formatted       36ca15cae788  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Recursive.hs+formatted       35f308030af1  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/ScopeUtils.hs+formatted       7d8238517a1b  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/SyntaxUtils.hs+formatted       cd1075fe28e2  fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Types.hs formatted       a185a50b6e6a  fay-0.24.2.0/src/main/Main.hs formatted       b9c869a29067  fay-0.24.2.0/src/tests/Test/CommandLine.hs formatted       68c640b352e9  fay-0.24.2.0/src/tests/Test/Compile.hs formatted       6fdbf9951c76  fay-0.24.2.0/src/tests/Test/Convert.hs formatted       89d594b07db0  fay-0.24.2.0/src/tests/Test/Desugar.hs formatted       a3937c4d8bef  fay-0.24.2.0/src/tests/Test/Util.hs-formatted       63cce78f9492  fay-0.24.2.0/src/tests/Tests.hs+formatted       198e7e859e4a  fay-0.24.2.0/src/tests/Tests.hs formatted       8114602da4c3  fay-0.24.2.0/tests/AllBaseModules.hs formatted       e78d25c5a73d  fay-0.24.2.0/tests/AutomaticList.hs formatted       779c72fbdb74  fay-0.24.2.0/tests/Bool.hs-formatted       ad89dd2cf37b  fay-0.24.2.0/tests/CPP.hs+formatted       d5c6ec08c4a5  fay-0.24.2.0/tests/CPP.hs formatted       61e542a01350  fay-0.24.2.0/tests/Char.hs formatted       7badee2f20a7  fay-0.24.2.0/tests/Compile/CPPMultiLineStrings.hs formatted       a5ace073f2a3  fay-0.24.2.0/tests/Compile/CPPTypecheck.hs@@ -2378,12 +2378,12 @@ formatted       4d201ce15d28  haxl-2.5.1.1/Haxl/DataSource/ConcurrentIO.hs formatted       cf38b55569d1  haxl-2.5.1.1/Haxl/Prelude.hs formatted       0bf115c25c25  haxl-2.5.1.1/Setup.hs-formatted       5897e1a72e86  haxl-2.5.1.1/tests/AdoTests.hs+formatted       b30d01a22e96  haxl-2.5.1.1/tests/AdoTests.hs formatted       7392cb2bf8df  haxl-2.5.1.1/tests/AllTests.hs formatted       29963bfcd43e  haxl-2.5.1.1/tests/BadDataSource.hs-formatted       9869a85f8734  haxl-2.5.1.1/tests/BatchTests.hs+formatted       3930b8064973  haxl-2.5.1.1/tests/BatchTests.hs formatted       a75656cc58b4  haxl-2.5.1.1/tests/Bench.hs-formatted       6b4d75212e14  haxl-2.5.1.1/tests/CoreTests.hs+formatted       c77a8f206311  haxl-2.5.1.1/tests/CoreTests.hs formatted       46378c08a2d4  haxl-2.5.1.1/tests/DataCacheTest.hs formatted       8120f9ee1106  haxl-2.5.1.1/tests/DataSourceDispatchTests.hs formatted       04f8f254da6b  haxl-2.5.1.1/tests/ExampleDataSource.hs@@ -2396,11 +2396,11 @@ formatted       08f288ec8741  haxl-2.5.1.1/tests/MonadBench.hs formatted       be417b8bc52f  haxl-2.5.1.1/tests/OutgoneFetchesTests.hs formatted       f760bff6e190  haxl-2.5.1.1/tests/ParallelTests.hs-formatted       c757b6a749ba  haxl-2.5.1.1/tests/ProfileTests.hs+formatted       bdcd901d6365  haxl-2.5.1.1/tests/ProfileTests.hs formatted       478999c2d1bd  haxl-2.5.1.1/tests/SleepDataSource.hs formatted       23f293b1253d  haxl-2.5.1.1/tests/StatsTests.hs formatted       0deec7d41cb2  haxl-2.5.1.1/tests/TestBadDataSource.hs-formatted       6270eac19e14  haxl-2.5.1.1/tests/TestExampleDataSource.hs+formatted       8c99d9ddfade  haxl-2.5.1.1/tests/TestExampleDataSource.hs formatted       33f33c2b6767  haxl-2.5.1.1/tests/TestMain.hs formatted       c0a01d1bb863  haxl-2.5.1.1/tests/TestTypes.hs formatted       0cdf14515138  haxl-2.5.1.1/tests/TestUtils.hs@@ -2413,21 +2413,21 @@ formatted       7855a4bfe6fc  hedgehog-1.7/src/Hedgehog/Internal/Discovery.hs formatted       15b153c4095e  hedgehog-1.7/src/Hedgehog/Internal/Distributive.hs formatted       db3d79ebed8e  hedgehog-1.7/src/Hedgehog/Internal/Exception.hs-formatted       94960f681457  hedgehog-1.7/src/Hedgehog/Internal/Gen.hs+formatted       93bc9212bbae  hedgehog-1.7/src/Hedgehog/Internal/Gen.hs formatted       82bd44e46c74  hedgehog-1.7/src/Hedgehog/Internal/HTraversable.hs formatted       0b6e930c617c  hedgehog-1.7/src/Hedgehog/Internal/Opaque.hs formatted       0c41d0d4f087  hedgehog-1.7/src/Hedgehog/Internal/Prelude.hs-formatted       a48f67a8e4b7  hedgehog-1.7/src/Hedgehog/Internal/Property.hs+formatted       099ade9775e8  hedgehog-1.7/src/Hedgehog/Internal/Property.hs formatted       144a39866885  hedgehog-1.7/src/Hedgehog/Internal/Queue.hs formatted       9d14d12ad0b0  hedgehog-1.7/src/Hedgehog/Internal/Range.hs formatted       e83fa4c27743  hedgehog-1.7/src/Hedgehog/Internal/Region.hs-formatted       ffa4ddc6361c  hedgehog-1.7/src/Hedgehog/Internal/Report.hs-formatted       1c86cc2eaef4  hedgehog-1.7/src/Hedgehog/Internal/Runner.hs+formatted       1f1c1a46ba31  hedgehog-1.7/src/Hedgehog/Internal/Report.hs+formatted       12a45329d79f  hedgehog-1.7/src/Hedgehog/Internal/Runner.hs formatted       fb3eda304e9f  hedgehog-1.7/src/Hedgehog/Internal/Seed.hs formatted       8b91f20c13a8  hedgehog-1.7/src/Hedgehog/Internal/Show.hs formatted       c446e4f9c366  hedgehog-1.7/src/Hedgehog/Internal/Shrink.hs formatted       c083b8dff0b7  hedgehog-1.7/src/Hedgehog/Internal/Source.hs-formatted       ea48c5d7dba1  hedgehog-1.7/src/Hedgehog/Internal/State.hs+formatted       e74cdd8b92d6  hedgehog-1.7/src/Hedgehog/Internal/State.hs formatted       8c1393826b50  hedgehog-1.7/src/Hedgehog/Internal/TH.hs formatted       79e0eb255f0f  hedgehog-1.7/src/Hedgehog/Internal/Tree.hs formatted       42e8fad71904  hedgehog-1.7/src/Hedgehog/Internal/Tripping.hs@@ -2488,7 +2488,7 @@ formatted       367217908354  hledger-1.52.1/bench/bench.hs formatted       770ce114d693  hledger-1.52.1/test/unittest.hs formatted       e865ae48f11b  hlint-3.10/Setup.hs-formatted       0b9c394414b3  hlint-3.10/data/HLint_QuickCheck.hs+formatted       df385b8f4253  hlint-3.10/data/HLint_QuickCheck.hs declined        -             hlint-3.10/data/HLint_TypeCheck.hs formatted       7f62e2698706  hlint-3.10/data/Test.hs formatted       a3cf0d266650  hlint-3.10/src/Apply.hs@@ -2539,7 +2539,7 @@ formatted       3308ee100b88  hlint-3.10/src/Hint/Type.hs formatted       c433ccccd5d9  hlint-3.10/src/Hint/Unsafe.hs formatted       48cd04ad2e02  hlint-3.10/src/HsColour.hs-formatted       dd9801a47942  hlint-3.10/src/Idea.hs+formatted       12f5c15a3edb  hlint-3.10/src/Idea.hs formatted       576b754ba5d4  hlint-3.10/src/Language/Haskell/HLint.hs formatted       7b8846cb4591  hlint-3.10/src/Main.hs formatted       fcdf50a5835c  hlint-3.10/src/Parallel.hs@@ -2624,7 +2624,7 @@ formatted       2665482bea3b  hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/V1Spec.hs formatted       fdce61371e6b  hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/V2Spec.hs formatted       177347d407e1  hspec-core-2.11.17/test/Test/Hspec/Core/HooksSpec.hs-formatted       ad736b09b724  hspec-core-2.11.17/test/Test/Hspec/Core/QuickCheck/UtilSpec.hs+formatted       4f036cf5daaf  hspec-core-2.11.17/test/Test/Hspec/Core/QuickCheck/UtilSpec.hs formatted       775321ce08bf  hspec-core-2.11.17/test/Test/Hspec/Core/Runner/EvalSpec.hs formatted       7eadb8336461  hspec-core-2.11.17/test/Test/Hspec/Core/Runner/JobQueueSpec.hs formatted       0d283fd19887  hspec-core-2.11.17/test/Test/Hspec/Core/Runner/PrintSlowSpecItemsSpec.hs@@ -2636,8 +2636,8 @@ formatted       ad44f3bb30b2  hspec-core-2.11.17/test/Test/Hspec/Core/TreeSpec.hs formatted       9b07f9624b8d  hspec-core-2.11.17/test/Test/Hspec/Core/UtilSpec.hs formatted       e13927dd80dc  hspec-core-2.11.17/vendor/Data/Algorithm/Diff.hs-partly-checked  03ba27ab9fd5  hspec-core-2.11.17/vendor/async-2.2.5/Control/Concurrent/Async.hs-formatted       bea44982097a  hspec-core-2.11.17/vendor/stm-2.5.0.1/Control/Concurrent/STM/TMVar.hs+partly-checked  c9eef62258f8  hspec-core-2.11.17/vendor/async-2.2.5/Control/Concurrent/Async.hs+formatted       220d41b7fb0c  hspec-core-2.11.17/vendor/stm-2.5.0.1/Control/Concurrent/STM/TMVar.hs formatted       b3d4964504e7  http-client-0.7.19/Data/KeyedPool.hs formatted       3e436f1b2afb  http-client-0.7.19/Network/HTTP/Client.hs formatted       547642efe2cc  http-client-0.7.19/Network/HTTP/Client/Body.hs@@ -2811,7 +2811,7 @@ formatted       72999d5c814e  intero-0.1.40/src/GhciTypes.hs declined        -             intero-0.1.40/src/InteractiveUI.hs formatted       d3b894941b5e  intero-0.1.40/src/Intero/Compat.hs-partly-checked  650cf9fb288c  intero-0.1.40/src/Main.hs+partly-checked  c4c4f282d93d  intero-0.1.40/src/Main.hs formatted       13b22f1a2f96  intero-0.1.40/src/test/Main.hs formatted       4fe73bbfe233  leksah-0.16.2.2/data/leksah-welcome/src/Main.hs formatted       1cefb44a49bc  leksah-0.16.2.2/data/leksah-welcome/test/Main.hs@@ -2871,7 +2871,7 @@ formatted       3df2a9c1d21f  leksah-0.16.2.2/src/IDE/SymbolNavigation.hs formatted       265b135c829e  leksah-0.16.2.2/src/IDE/TextEditor.hs formatted       fc7e53f0e945  leksah-0.16.2.2/src/IDE/TextEditor/Class.hs-formatted       1c4c5952013a  leksah-0.16.2.2/src/IDE/TextEditor/CodeMirror.hs+formatted       9467271dc7ec  leksah-0.16.2.2/src/IDE/TextEditor/CodeMirror.hs formatted       ead97fbc797b  leksah-0.16.2.2/src/IDE/TextEditor/GtkSourceView.hs formatted       02fedce6ee7f  leksah-0.16.2.2/src/IDE/TextEditor/Yi.hs formatted       74ead3c637fd  leksah-0.16.2.2/src/IDE/TextEditor/Yi/Config.hs@@ -2889,11 +2889,11 @@ formatted       67948814999e  lens-5.3.6/benchmarks/unsafe.hs formatted       6b5d9407288a  lens-5.3.6/examples/Aeson.hs formatted       fcea15eace15  lens-5.3.6/examples/Plates.hs-formatted       42c84063ca40  lens-5.3.6/examples/Pong.hs+formatted       6016ef723b2e  lens-5.3.6/examples/Pong.hs formatted       1e7ca6c2bac4  lens-5.3.6/examples/Turtle.hs formatted       e865ae48f11b  lens-5.3.6/lens-properties/Setup.hs formatted       03d5b652be06  lens-5.3.6/lens-properties/src/Control/Lens/Properties.hs-formatted       078f1b9b6754  lens-5.3.6/src/Control/Exception/Lens.hs+formatted       fb677a8ca744  lens-5.3.6/src/Control/Exception/Lens.hs formatted       4fb8b462c692  lens-5.3.6/src/Control/Lens.hs formatted       dab5fde53fc2  lens-5.3.6/src/Control/Lens/At.hs formatted       1a555e9740b2  lens-5.3.6/src/Control/Lens/Combinators.hs@@ -2979,7 +2979,7 @@ formatted       5a4f7cf6359b  lens-5.3.6/src/System/FilePath/Lens.hs formatted       18c87dbc74ee  lens-5.3.6/src/System/IO/Error/Lens.hs formatted       aa93fbb09ce5  lens-5.3.6/tests/BigRecord.hs-formatted       4bb6e1258874  lens-5.3.6/tests/T1024.hs+formatted       22c453e7b965  lens-5.3.6/tests/T1024.hs formatted       783da428b966  lens-5.3.6/tests/T799.hs formatted       735c78d5ee02  lens-5.3.6/tests/T917.hs formatted       1d3a1a7a064d  lens-5.3.6/tests/T972.hs@@ -2988,8 +2988,8 @@ declined        -             lens-5.3.6/tests/properties.hs formatted       4bd3d2baa141  lens-5.3.6/tests/templates.hs formatted       2a47884feb32  lifted-base-0.2.3.12/Control/Concurrent/Chan/Lifted.hs-formatted       ed858547b569  lifted-base-0.2.3.12/Control/Concurrent/Lifted.hs-formatted       9e73627aa56a  lifted-base-0.2.3.12/Control/Concurrent/MVar/Lifted.hs+formatted       2878fb30d603  lifted-base-0.2.3.12/Control/Concurrent/Lifted.hs+formatted       5ca1cae42a21  lifted-base-0.2.3.12/Control/Concurrent/MVar/Lifted.hs formatted       7896c1c8db7e  lifted-base-0.2.3.12/Control/Concurrent/QSem/Lifted.hs formatted       0e92e2e3c452  lifted-base-0.2.3.12/Control/Concurrent/QSemN/Lifted.hs formatted       5cc7e142b7a9  lifted-base-0.2.3.12/Control/Concurrent/SampleVar/Lifted.hs@@ -3745,7 +3745,7 @@ formatted       9390668ca723  purescript-0.15.15/src/Language/PureScript/Ide/Reexports.hs formatted       40ae0185eda5  purescript-0.15.15/src/Language/PureScript/Ide/SourceFile.hs formatted       4badb68aba43  purescript-0.15.15/src/Language/PureScript/Ide/State.hs-formatted       97156b72015a  purescript-0.15.15/src/Language/PureScript/Ide/Types.hs+formatted       64c31342d1b6  purescript-0.15.15/src/Language/PureScript/Ide/Types.hs formatted       a2547b22a5bd  purescript-0.15.15/src/Language/PureScript/Ide/Usage.hs formatted       c5c7f0134f7c  purescript-0.15.15/src/Language/PureScript/Ide/Util.hs formatted       a54bd99f9377  purescript-0.15.15/src/Language/PureScript/Interactive.hs@@ -4342,7 +4342,7 @@ formatted       7d15eaae39ff  stack-9.9.9/src/Stack/Dot.hs formatted       e3fe02818737  stack-9.9.9/src/Stack/Exec.hs formatted       69a1b5e114c2  stack-9.9.9/src/Stack/Fetch.hs-formatted       967c0ee2eef6  stack-9.9.9/src/Stack/GhcPkg.hs+formatted       7245d6806bca  stack-9.9.9/src/Stack/GhcPkg.hs formatted       8e7700c60073  stack-9.9.9/src/Stack/Init.hs formatted       9f228f8da7ce  stack-9.9.9/src/Stack/New.hs formatted       a4120f7039a7  stack-9.9.9/src/Stack/Package.hs@@ -4358,7 +4358,7 @@ formatted       cd2bb0d685de  stack-9.9.9/src/Stack/Types/FlagName.hs formatted       d8f8b074a086  stack-9.9.9/src/Stack/Types/GhcPkgId.hs formatted       bd4be7dcc823  stack-9.9.9/src/Stack/Types/Internal.hs-formatted       6f80f79fae7e  stack-9.9.9/src/Stack/Types/PackageIdentifier.hs+formatted       863509c942b8  stack-9.9.9/src/Stack/Types/PackageIdentifier.hs formatted       88a4f8bd73e5  stack-9.9.9/src/Stack/Types/PackageName.hs formatted       cf90354db024  stack-9.9.9/src/Stack/Types/StackT.hs formatted       c698b30fdbaf  stack-9.9.9/src/Stack/Types/Version.hs@@ -4602,7 +4602,7 @@ formatted       7635d57189ea  text-2.1.4/src/Data/Text/Internal/PrimCompat.hs formatted       634f3b2cbbde  text-2.1.4/src/Data/Text/Internal/Private.hs formatted       a41bd3d7edab  text-2.1.4/src/Data/Text/Internal/Read.hs-formatted       ec56c867ca01  text-2.1.4/src/Data/Text/Internal/Reverse.hs+formatted       7297075f77b5  text-2.1.4/src/Data/Text/Internal/Reverse.hs formatted       9ddb417cbaa3  text-2.1.4/src/Data/Text/Internal/Search.hs formatted       67bf06cca611  text-2.1.4/src/Data/Text/Internal/StrictBuilder.hs formatted       ed455e9ee12d  text-2.1.4/src/Data/Text/Internal/Transformation.hs@@ -4638,7 +4638,7 @@ formatted       13a8cbedafd1  text-2.1.4/tests/Tests/Properties/Transcoding.hs formatted       139bbe092e98  text-2.1.4/tests/Tests/Properties/Validate.hs formatted       75f4b0d7a5f3  text-2.1.4/tests/Tests/QuickCheckUtils.hs-formatted       c6e25a3408e0  text-2.1.4/tests/Tests/RebindableSyntaxTest.hs+formatted       360188e62bc0  text-2.1.4/tests/Tests/RebindableSyntaxTest.hs formatted       939e997260ba  text-2.1.4/tests/Tests/Regressions.hs formatted       b7037d3f07cc  text-2.1.4/tests/Tests/ShareEmpty.hs formatted       f4e9f36f6be9  text-2.1.4/tests/Tests/SlowFunctions.hs@@ -4658,7 +4658,7 @@ formatted       0f617301ba5b  time-1.16.0.1/lib/Data/Time/Calendar/CalendarDiffDays.hs formatted       e210a7d3456b  time-1.16.0.1/lib/Data/Time/Calendar/Days.hs formatted       03412f0b8356  time-1.16.0.1/lib/Data/Time/Calendar/Easter.hs-formatted       f8d4d6f009e4  time-1.16.0.1/lib/Data/Time/Calendar/Gregorian.hs+formatted       c8f966093a51  time-1.16.0.1/lib/Data/Time/Calendar/Gregorian.hs formatted       be538512fc07  time-1.16.0.1/lib/Data/Time/Calendar/Julian.hs formatted       625e7b428153  time-1.16.0.1/lib/Data/Time/Calendar/JulianYearDay.hs formatted       9ba18c758e02  time-1.16.0.1/lib/Data/Time/Calendar/Month.hs@@ -4681,23 +4681,23 @@ formatted       acaedfdab698  time-1.16.0.1/lib/Data/Time/Clock/Internal/UniversalTime.hs formatted       cf441f809fdf  time-1.16.0.1/lib/Data/Time/Clock/POSIX.hs formatted       6dd6034d73b4  time-1.16.0.1/lib/Data/Time/Clock/System.hs-formatted       7cdd69049dcf  time-1.16.0.1/lib/Data/Time/Clock/TAI.hs+formatted       bcae28d3d831  time-1.16.0.1/lib/Data/Time/Clock/TAI.hs formatted       b600a5b5c744  time-1.16.0.1/lib/Data/Time/Format.hs formatted       6c005f66f0be  time-1.16.0.1/lib/Data/Time/Format/Format/Class.hs-formatted       47f1688c0787  time-1.16.0.1/lib/Data/Time/Format/Format/Instances.hs-formatted       3764319de19b  time-1.16.0.1/lib/Data/Time/Format/ISO8601.hs+formatted       200179c37154  time-1.16.0.1/lib/Data/Time/Format/Format/Instances.hs+formatted       14f4a5f4a56e  time-1.16.0.1/lib/Data/Time/Format/ISO8601.hs formatted       76aa49c9292b  time-1.16.0.1/lib/Data/Time/Format/Internal.hs formatted       b7ae7592bcb6  time-1.16.0.1/lib/Data/Time/Format/Locale.hs-formatted       2cd514758801  time-1.16.0.1/lib/Data/Time/Format/Parse.hs+formatted       b7301f512161  time-1.16.0.1/lib/Data/Time/Format/Parse.hs formatted       05a7f0bf5554  time-1.16.0.1/lib/Data/Time/Format/Parse/Class.hs-formatted       cb2ccd8c40fd  time-1.16.0.1/lib/Data/Time/Format/Parse/Instances.hs+formatted       b579af300eaa  time-1.16.0.1/lib/Data/Time/Format/Parse/Instances.hs formatted       4489a4cdab49  time-1.16.0.1/lib/Data/Time/LocalTime.hs formatted       93986a8450d1  time-1.16.0.1/lib/Data/Time/LocalTime/Internal/CalendarDiffTime.hs formatted       94f381fe1ad1  time-1.16.0.1/lib/Data/Time/LocalTime/Internal/Foreign.hs-formatted       ca98c37fb34c  time-1.16.0.1/lib/Data/Time/LocalTime/Internal/LocalTime.hs+formatted       4c9ff2a8a8a0  time-1.16.0.1/lib/Data/Time/LocalTime/Internal/LocalTime.hs formatted       9200ebaf067a  time-1.16.0.1/lib/Data/Time/LocalTime/Internal/TimeOfDay.hs formatted       74496e557585  time-1.16.0.1/lib/Data/Time/LocalTime/Internal/TimeZone.hs-formatted       343d16749a70  time-1.16.0.1/lib/Data/Time/LocalTime/Internal/ZonedTime.hs+formatted       a8370b544557  time-1.16.0.1/lib/Data/Time/LocalTime/Internal/ZonedTime.hs formatted       c365d1aa63cd  time-1.16.0.1/test/ForeignCalls.hs formatted       fc8234c946fb  time-1.16.0.1/test/ShowDefaultTZAbbreviations.hs formatted       b51274826033  time-1.16.0.1/test/ShowTime.hs@@ -4934,7 +4934,7 @@ formatted       771e81db1b05  unordered-containers-0.2.21/benchmarks/Util/String.hs formatted       2b26017dfa9e  unordered-containers-0.2.21/tests/Main.hs formatted       27005a00112e  unordered-containers-0.2.21/tests/Properties.hs-formatted       b06c5b9e0c6c  unordered-containers-0.2.21/tests/Properties/HashMapLazy.hs+formatted       88e44fdb6cbd  unordered-containers-0.2.21/tests/Properties/HashMapLazy.hs formatted       f2a904c3a89a  unordered-containers-0.2.21/tests/Properties/HashMapStrict.hs formatted       2212e9831f16  unordered-containers-0.2.21/tests/Properties/HashSet.hs formatted       3584a01b2cdd  unordered-containers-0.2.21/tests/Properties/List.hs@@ -4968,7 +4968,7 @@ formatted       d63508f44841  uuid-types-1.0.6.1/src/Data/UUID/Types/Internal/Builder.hs formatted       ed86f094a194  uuid-types-1.0.6.1/tests/TestUUID.hs formatted       e865ae48f11b  vector-0.13.2.0/Setup.hs-formatted       cb65eb293bd5  vector-0.13.2.0/benchlib/Bench/Vector/Algo/AwShCC.hs+formatted       968ccc63cf5c  vector-0.13.2.0/benchlib/Bench/Vector/Algo/AwShCC.hs formatted       8a7c35b680c0  vector-0.13.2.0/benchlib/Bench/Vector/Algo/FindIndexR.hs formatted       7536358d3c8c  vector-0.13.2.0/benchlib/Bench/Vector/Algo/HybCC.hs formatted       31caf6daa18c  vector-0.13.2.0/benchlib/Bench/Vector/Algo/Leaffix.hs

@@ -0,0 +1,10 @@+module Report.Pretty where++class () => Pretty a where+  pretty :: a -> String++class (Show a) => Loud a where+  loud :: a -> String++width :: () => Int+width = 80

@@ -0,0 +1,10 @@+module Report.Pretty where++class () => Pretty a where+  pretty :: a -> String++class (Show a) => Loud a where+  loud :: a -> String++width :: () => Int+width = 80

@@ -0,0 +1,13 @@+{-# LANGUAGE DatatypeContexts #-}+{-# LANGUAGE GADTs #-}++module Report.Cells where++data () => Cell a = Cell a++newtype () => Width = Width Int++data Some = forall a. () => Some a++data Shown where+  Shown :: () => Int -> Shown

@@ -0,0 +1,13 @@+{-# LANGUAGE DatatypeContexts #-}+{-# LANGUAGE GADTs #-}++module Report.Cells where++data () => Cell a = Cell a++newtype () => Width = Width Int++data Some = forall a. () => Some a++data Shown where+  Shown :: () => Int -> Shown

@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell #-}++-- The body of a typed quote is indented under its bracket, as that of an+-- untyped one is.+untyped :: (Quote m) => m Exp+untyped =+  [|+    let x = 1+     in x + x+    |]++typed :: (Quote m) => Code m Int+typed =+  [||+    let x = 1+     in x + x+    ||]++explicit :: (Quote m) => Code m Int+explicit =+  [e||+    case lookup key table of+      Just x -> x+      Nothing -> 0+    ||]

@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}++-- The body of a typed quote is indented under its bracket, as that of an+-- untyped one is.+untyped :: Quote m => m Exp+untyped =+  [| let x = 1+     in x + x |]++typed :: Quote m => Code m Int+typed =+  [|| let x = 1+      in x + x ||]++explicit :: Quote m => Code m Int+explicit = [e|| case lookup key table of+  Just x -> x+  Nothing -> 0 ||]

@@ -0,0 +1,11 @@+{-# LANGUAGE RebindableSyntax #-}++module Weather.Forecast where++import Control.Monad (when)+import Data.List (foldl')+import Prelude (Double, (+))+import Weather.Reading (Reading)++warmer :: Double -> Double+warmer = (+ 1)

@@ -0,0 +1,11 @@+{-# LANGUAGE RebindableSyntax #-}++module Weather.Forecast where++import Weather.Reading (Reading)+import Prelude (Double, (+))+import Data.List (foldl')+import Control.Monad (when)++warmer :: Double -> Double+warmer = (+ 1)

@@ -10,9 +10,9 @@  typed =   [||-  width * height-  -- in pixels-  ||]+    width * height+    -- in pixels+    ||]  declarations =   [d|

@@ -0,0 +1,16 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE+    ScopedTypeVariables+  , LambdaCase -- for classify+  , {- and for nothing else -} BangPatterns+  #-}+{-# LANGUAGE TupleSections #-}++module Kiln.Commented where++-- GHC skips the comments inside the pragma and reads the names around+-- them, and a comment there stays where it is written.+classify :: Int -> String+classify = \case+  0 -> "zero"+  _ -> "other"

@@ -0,0 +1,15 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE+    ScopedTypeVariables+  , LambdaCase -- for classify+  , {- and for nothing else -} BangPatterns+  #-}+{-# LANGUAGE DataKinds #-}+module Kiln.Commented where++-- GHC skips the comments inside the pragma and reads the names around+-- them, and a comment there stays where it is written.+classify :: Int -> String+classify = \case+  0 -> "zero"+  _ -> "other"

@@ -0,0 +1,21 @@+{-# LANGUAGE CPP #-}++-- A conditional that begins among bindings indented with a tab and goes on+-- into the declarations after it stays one conditional, as it does where+-- they are indented with spaces.+module T where++f :: Int -> Int+f x = y+  where+    y = x + 1+#if defined(EXTRA)+    z = 2++g :: Int+g = 1+#else++g :: Int+g = 2+#endif

@@ -0,0 +1,21 @@+{-# LANGUAGE CPP #-}++-- A conditional that begins among bindings indented with a tab and goes on+-- into the declarations after it stays one conditional, as it does where+-- they are indented with spaces.+module T where++f :: Int -> Int+f x = y+  where+	y = x + 1+#if defined(EXTRA)+	z = 2++g :: Int+g = 1+#else++g :: Int+g = 2+#endif

@@ -0,0 +1,27 @@+{-# LANGUAGE CPP #-}++-- A use standing for a statement stays at the column of the statements+-- around it.+module Solver.Trail where++#ifdef ENABLE_TRACE+#define TRACING(x) x+#else+#define TRACING(x)+#endif++step :: Int -> IO ()+step n = do+  print n+  TRACING(print n)+  print (n + 1)++steps :: [Int] -> IO ()+steps ns = do+  let total = sum ns+  TRACING(print total)+  forM_ ns $ \n -> do+    step n+    TRACING(print n)+    step (n + 1)+  pure ()

@@ -0,0 +1,27 @@+{-# LANGUAGE CPP #-}++-- A use standing for a statement stays at the column of the statements+-- around it.+module Solver.Trail where++#ifdef ENABLE_TRACE+#define TRACING(x) x+#else+#define TRACING(x)+#endif++step :: Int -> IO ()+step n = do+    print n+    TRACING(print n)+    print (n + 1)++steps :: [Int] -> IO ()+steps ns = do+    let total = sum ns+    TRACING(print total)+    forM_ ns $ \n -> do+        step n+        TRACING(print n)+        step (n + 1)+    pure ()

@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++-- A use standing for an equation stays at the margin between the equations+-- around it.+module Table.Lookup where++#define ENTRY(k, v) lookupEntry k = v++lookupEntry :: Int -> String+lookupEntry 0 = "zero"+ENTRY(1, "one")+lookupEntry _ = "many"

@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++-- A use standing for an equation stays at the margin between the equations+-- around it.+module Table.Lookup where++#define ENTRY(k, v) lookupEntry k = v++lookupEntry :: Int -> String+lookupEntry 0 = "zero"+ENTRY(1, "one")+lookupEntry _ = "many"

@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}++-- A use indented with a tab is at the column the tab moves it to: one at+-- the column of the code under it is a line of its own, and one further in+-- carries on the line above.+module Steps where++#define ARG(x) (x)+#define STEP(x) print (x)++g :: Int -> Maybe Int+g x = do+  y <-+    Just+      ARG+      (x)+  pure y++h :: Int -> IO ()+h x = do+  STEP(x ++ "";)+  pure ()

@@ -0,0 +1,20 @@+{-# LANGUAGE CPP #-}++-- A use indented with a tab is at the column the tab moves it to: one at+-- the column of the code under it is a line of its own, and one further in+-- carries on the line above.+module Steps where++#define ARG(x) (x)+#define STEP(x) print (x)++g :: Int -> Maybe Int+g x = do+ y <- Just+	ARG(x)+ pure y++h :: Int -> IO ()+h x = do+	STEP(x ++ "";)+        pure ()

@@ -0,0 +1,10 @@+{-# OPTIONS -cpp #-}++module Version where++#if __GLASGOW_HASKELL__ >= 900+f :: Int+#else+f :: Integer+#endif+f = 1

@@ -0,0 +1,9 @@+{-# OPTIONS -cpp #-}+module Version where++#if __GLASGOW_HASKELL__ >= 900+f :: Int+#else+f :: Integer+#endif+f = 1

@@ -0,0 +1,10 @@+{-# LANGUAGE GHC2024 #-}++module Kiln.Edition where++-- GHC compiles a module under the edition it names, so LambdaCase, which+-- GHC2024 turns on, is on.+firing :: Int -> Int+firing = \case+  0 -> 1+  n -> n

@@ -0,0 +1,9 @@+{-# LANGUAGE GHC2024 #-}+module Kiln.Edition where++-- GHC compiles a module under the edition it names, so LambdaCase, which+-- GHC2024 turns on, is on.+firing :: Int -> Int+firing = \case+  0 -> 1+  n -> n

@@ -0,0 +1,8 @@+{-# LANGUAGE Haskell2010 #-}+{-# LANGUAGE GHC2021 #-}++module Kiln.Edition where++-- GHC compiles a module under the edition named last.+fire :: Int+fire = 1

@@ -0,0 +1,7 @@+{-# LANGUAGE Haskell2010 #-}+{-# LANGUAGE GHC2021 #-}+module Kiln.Edition where++-- GHC compiles a module under the edition named last.+fire :: Int+fire = 1

@@ -1,5 +1,5 @@-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoStarIsType #-}+{-# LANGUAGE TypeOperators #-}  module M (type (*)) where 

@@ -0,0 +1,9 @@+{-# LANGUAGE NoExplicitForAll #-}+{-# LANGUAGE RankNTypes #-}++module Kiln.Rank where++-- RankNTypes turns ExplicitForAll back on, so with it named last, a forall+-- can be written.+apply :: (forall a. a -> a) -> (Int, Bool)+apply f = (f 1, f True)

@@ -0,0 +1,8 @@+{-# LANGUAGE NoExplicitForAll #-}+{-# LANGUAGE RankNTypes #-}+module Kiln.Rank where++-- RankNTypes turns ExplicitForAll back on, so with it named last, a forall+-- can be written.+apply :: (forall a. a -> a) -> (Int, Bool)+apply f = (f 1, f True)

@@ -0,0 +1,10 @@+{-# LANGUAGE NoLambdaCase #-}+{-# LANGUAGE LambdaCase #-}++module Kiln.Again where++-- The name written last decides, so LambdaCase is on.+firing :: Int -> Int+firing = \case+  0 -> 1+  n -> n

@@ -0,0 +1,9 @@+{-# LANGUAGE NoLambdaCase #-}+{-# LANGUAGE LambdaCase #-}+module Kiln.Again where++-- The name written last decides, so LambdaCase is on.+firing :: Int -> Int+firing = \case+  0 -> 1+  n -> n

@@ -0,0 +1,11 @@+{-# OPTIONS_GHC -XNoLambdaCase #-}+{-# LANGUAGE LambdaCase #-}++module Kiln.Case where++-- GHC reads the flags of the options pragmas and the names of the language+-- pragmas in the order they are written, so LambdaCase, named last, is on.+firing :: Int -> Int+firing = \case+  0 -> 1+  n -> n

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -XNoLambdaCase #-}+{-# LANGUAGE LambdaCase #-}+module Kiln.Case where++-- GHC reads the flags of the options pragmas and the names of the language+-- pragmas in the order they are written, so LambdaCase, named last, is on.+firing :: Int -> Int+firing = \case+  0 -> 1+  n -> n

@@ -0,0 +1,15 @@+{-# OPTIONS_GHC -XLambdaCase -fbang-patterns #-}+{-# OPTIONS_GHC -fglasgow-exts #-}++module Flags where++classify :: Int -> String+classify = \case+  0 -> "zero"+  _ -> "other"++strict :: Int -> Int+strict !n = n++both :: (forall a. a -> a) -> (Int, Bool)+both f = (f 1, f True)

@@ -0,0 +1,14 @@+{-# OPTIONS_GHC -XLambdaCase -fbang-patterns #-}+{-# OPTIONS_GHC -fglasgow-exts #-}+module Flags where++classify :: Int -> String+classify = \case+  0 -> "zero"+  _ -> "other"++strict :: Int -> Int+strict !n = n++both :: (forall a. a -> a) -> (Int, Bool)+both f = (f 1, f True)

@@ -0,0 +1,13 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# OPTIONS -Wno-name-shadowing #-}++module Kiln.Fire where++-- GHC reads OPTIONS as it reads OPTIONS_GHC, so the two keep the order they+-- are written in among each other.+fire :: Int+fire = 1

@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS -Wno-name-shadowing #-}+module Kiln.Fire where++-- GHC reads OPTIONS as it reads OPTIONS_GHC, so the two keep the order they+-- are written in among each other.+fire :: Int+fire = 1

@@ -3,13 +3,15 @@ {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Wno-unused-imports #-} {-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fplugin=GHC.TypeLits.Normalise #-} {-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-}  module Kiln.Glaze where  -- GHC reads the flags of the options pragmas in the order they are written,--- a later one overriding an earlier one, so they keep that order, and only a--- pragma written twice in a row is written once.+-- a later one overriding an earlier one, so they keep that order, and a+-- pragma written twice in a row stays twice, since some flags count each+-- time they are given. glaze :: Int glaze = 1

@@ -10,7 +10,8 @@ module Kiln.Glaze where  -- GHC reads the flags of the options pragmas in the order they are written,--- a later one overriding an earlier one, so they keep that order, and only a--- pragma written twice in a row is written once.+-- a later one overriding an earlier one, so they keep that order, and a+-- pragma written twice in a row stays twice, since some flags count each+-- time they are given. glaze :: Int glaze = 1

@@ -0,0 +1,8 @@+module Kiln.Size where++{-# LANGUAGE OverloadedStrings #-}++-- GHC reads pragmas above the module line alone, so OverloadedStrings is+-- off, and the pragma stays where it is written.+size :: Int+size = length "abc"

@@ -0,0 +1,7 @@+module Kiln.Size where+{-# LANGUAGE OverloadedStrings #-}++-- GHC reads pragmas above the module line alone, so OverloadedStrings is+-- off, and the pragma stays where it is written.+size :: Int+size = length "abc"

@@ -0,0 +1,12 @@+{-# LANGUAGE ImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-}++module Kiln.Rebound where++-- RebindableSyntax turns ImplicitPrelude off, so with it named last, the+-- Prelude is not imported, and this map is the only one in scope.+map :: ()+map = ()++glaze :: ()+glaze = map

@@ -0,0 +1,11 @@+{-# LANGUAGE ImplicitPrelude #-}+{-# LANGUAGE RebindableSyntax #-}+module Kiln.Rebound where++-- RebindableSyntax turns ImplicitPrelude off, so with it named last, the+-- Prelude is not imported, and this map is the only one in scope.+map :: ()+map = ()++glaze :: ()+glaze = map

@@ -0,0 +1,14 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}++module Store.Lenses where++makeLenses ''Config+-- A note written against the run it stands in, and staying inside it.+makeLenses ''Options++makeLenses ''State+#if defined(PRISMS)+makePrisms ''Event+#endif+makeLenses ''Event

@@ -0,0 +1,14 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}++module Store.Lenses where++makeLenses ''Config+-- A note written against the run it stands in, and staying inside it.+makeLenses ''Options++makeLenses ''State+#if defined(PRISMS)+makePrisms ''Event+#endif+makeLenses ''Event

@@ -0,0 +1,41 @@+-- A string comes out as written wherever it is, in a pattern, a pragma or+-- a rule's name: its gaps line up under its opening quote, and nothing is+-- escaped or quoted that was not.+module Text.Written where++isLong :: String -> Bool+isLong+  "a very long string \+  \that goes on" = True+isLong _ = False++{-# DEPRECATED+  old+  "use the new one, \+  \which is better"+  #-}+old :: Int+old = 1++{-# WARNING new ["one", "two"] #-}+new :: Int+new = 2++{-# RULES "f/∘" forall x. f (g x) = h x #-}++f :: Int -> Int+f = id+{-# SCC f "f_label" #-}++g :: Int -> Int+g = id+{-# SCC g #-}++h :: Int -> Int+h = id++x :: Int+x = {-# SCC foo #-} 1++y :: Int+y = {-# SCC "bar" #-} 2

@@ -0,0 +1,37 @@+-- A string comes out as written wherever it is, in a pattern, a pragma or+-- a rule's name: its gaps line up under its opening quote, and nothing is+-- escaped or quoted that was not.+module Text.Written where++isLong :: String -> Bool+isLong "a very long string \+       \that goes on" = True+isLong _ = False++{-# DEPRECATED old "use the new one, \+                   \which is better" #-}+old :: Int+old = 1++{-# WARNING new ["one", "two"] #-}+new :: Int+new = 2++{-# RULES "f/∘" forall x. f (g x) = h x #-}++f :: Int -> Int+f = id+{-# SCC f "f_label" #-}++g :: Int -> Int+g = id+{-# SCC g #-}++h :: Int -> Int+h = id++x :: Int+x = {-# SCC foo #-} 1++y :: Int+y = {-# SCC "bar" #-} 2

@@ -1,23 +1,23 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}  -- | Information coming from @.cabal@ files. module Tilia.Cabal.Package   ( PackageProblem (..),     describePackageProblem,     readPackageDescription,+    parsePackageDescription,     declaredModules,+    packageSourceDirs,+    packageExtensions,     PackageReader,     newPackageReader,     ComponentSection (..),     BranchSections,-    libraryBranches,-    executableBranches,-    suiteBranches,-    benchmarkBranches,+    Kind (..),+    packageOf,+    packageComponents,     addedSources,     sourceExtensions,     isDeclaredModule,@@ -27,14 +27,17 @@ where  import Control.Concurrent.MVar (modifyMVar, newMVar)+import Control.Monad ((<=<)) import Data.ByteString qualified as BS+import Data.Either (rights)+import Data.Foldable (toList) import Data.Generics.Schemes (listify) import Data.IORef-import Data.List (sortOn)+import Data.List (nub, sortOn) import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, mapMaybe) import Data.Ord (Down (..)) import Data.Set (Set) import Data.Set qualified as Set@@ -53,20 +56,20 @@     Executable (..),     GenericPackageDescription (..),     Library (..),+    PackageDescription (..),     PackageFlag (..),     TestSuite (..),     TestSuiteInterface (..),+    pkgName,+    unPackageName,+    unUnqualComponentName,   ) import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)-import Distribution.Parsec (showPError, simpleParsec)+import Distribution.Parsec (PErrorWithSource (..), showPError, simpleParsec) import Distribution.System (buildArch, buildOS) import Distribution.Types.BuildInfo (usedExtensions)-import Distribution.Types.CondTree (mapTreeConstrs, simplifyCondTree)-#if MIN_VERSION_Cabal_syntax(3, 14, 0)+import Distribution.Types.CondTree (simplifyCondTree) import Distribution.Utils.Path (SymbolicPathX, getSymbolicPath)-#else-import Distribution.Utils.Path (getSymbolicPath)-#endif import Distribution.Version (Version, withinRange) import GHC.Driver.Session qualified as GHC import GHC.LanguageExtensions.Type (Extension)@@ -82,10 +85,10 @@     takeExtension,     (</>),   )-import Tilia.Cabal.Project (cabalFilesIn)-import Tilia.Pragma (applyExtensionName, lookupEdition)+import Tilia.Cabal.Project (cabalFilesIn, startingDirectory)+import Tilia.Pragma (Defaults, defaultsOf, lookupEdition, nameSwitch) import Tilia.Process (readProgramOutput)-import Tilia.Utils (attempted, quietly)+import Tilia.Utils (attempted, pathUnder, quietly, tshow)  -- | Why a file's extensions could not be settled. data PackageProblem@@ -113,15 +116,18 @@     T.pack file <> " names no component whose hs-source-dirs holds it"  -- | What we retain from reading a .cabal file.-type PackageReader = FilePath -> IO (Either PackageProblem [Extension])+type PackageReader = FilePath -> IO (Either PackageProblem Defaults)  -- | A 'PackageReader' that remembers what it has already worked out. newPackageReader ::   -- | The compiler's version, where the build plan names it, which spares   -- asking the compiler.   Maybe Version ->+  -- | The @.cabal@ files of the project, which a module no @.cabal@ file+  -- above it claims is looked for in.+  [FilePath] ->   IO PackageReader-newPackageReader planned = do+newPackageReader planned project = do   covering <- newIORef Map.empty   described <- newIORef Map.empty   known <- newMVar (Just <$> planned)@@ -130,26 +136,25 @@         Nothing -> do           version <- compilerVersion           pure (Just version, version)+      elsewhere file problem = do+        found <- traverse (componentBranchesOf compiler described) project+        pure $ case claiming file (concat (rights found)) of+          Just c -> Right (componentExtensions c)+          Nothing -> Left problem   pure $ \path -> quietly (Left NoPackageFile) $ do     file <- canonicalizePath path     from <- startingDirectory file     findCabalFile covering from >>= \case-      Nothing -> pure (Left NoPackageFile)+      Nothing -> elsewhere file NoPackageFile       Just cabalFile ->         componentBranchesOf compiler described cabalFile >>= \case           Left problem -> pure (Left problem)           Right components             | equalFilePath file (takeDirectory cabalFile </> setupScript) ->-                pure (Right (GHC.languageExtensions Nothing))-            | otherwise -> pure $ case claiming file components of-                Just c -> Right (componentExtensions c)-                Nothing -> Left (FileUnclaimed cabalFile)---- | Where to start looking for a @.cabal@ file.-startingDirectory :: FilePath -> IO FilePath-startingDirectory path = do-  isDirectory <- quietly False (doesDirectoryExist path)-  pure (if isDirectory then path else takeDirectory path)+                pure (Right (defaultsOf (GHC.languageExtensions Nothing) []))+            | Just c <- claiming file components ->+                pure (Right (componentExtensions c))+            | otherwise -> elsewhere file (FileUnclaimed cabalFile)  -- | One branch of a component, with everything in force in it already -- worked out.@@ -162,8 +167,8 @@     -- | Its entry points, relative to its source directories in the same     -- way but with their extensions.     componentEntries :: Set FilePath,-    -- | The extensions it puts in force.-    componentExtensions :: [Extension]+    -- | What it puts in force.+    componentExtensions :: Defaults   }  -- | Which branch holds the file, of those whose directories cover it.@@ -175,11 +180,14 @@   where     covered = not . null . covering     named c = any (declares c) (covering c)-    declares c d =-      isDeclaredModule (componentModules c) (componentEntries c) (under d)-    under d = joinPath (drop (length (splitDirectories d)) (splitDirectories file))-    nearness = maximum . fmap length . covering-    covering c = [d | d <- componentDirs c, d `covers` file]+    declares c (_, under) =+      isDeclaredModule (componentModules c) (componentEntries c) (joinPath under)+    nearness = maximum . fmap (length . fst) . covering+    covering c =+      [ (d, under)+      | d <- componentDirs c,+        Just under@(_ : _) <- [pathUnder d file]+      ]  -- | Is a file, named relative to a source directory, one of the modules or -- entry points declared there?@@ -194,14 +202,6 @@   takeExtension path `elem` sourceExtensions     && (Set.member path entries || Set.member (dropExtension path) modules) --- | Whether a file is somewhere under a directory.-covers :: FilePath -> FilePath -> Bool-covers directory file = go (splitDirectories directory) (splitDirectories file)-  where-    go [] (_ : _) = True-    go (d : ds) (f : fs) = equalFilePath d f && go ds fs-    go _ _ = False- -- | The nearest @.cabal@ file at or above a directory. findCabalFile ::   -- | What is known already, by directory: the file covering it, or@@ -263,13 +263,21 @@ readPackageDescription cabalFile =   attempted (BS.readFile cabalFile) >>= \case     Left why -> pure (Left (PackageUnreadable cabalFile why))-    Right bytes ->-      pure $ case snd (runParseResult (parseGenericPackageDescription bytes)) of-        Left (_, complaints) ->-          Left (PackageMalformed cabalFile (fmap said (NE.toList complaints)))-        Right description -> Right description+    Right bytes -> pure (parsePackageDescription cabalFile bytes)++-- | Parse what a @.cabal@ file holds, or say why it cannot be.+parsePackageDescription ::+  -- | Where it comes from, named in what goes wrong.+  FilePath ->+  BS.ByteString ->+  Either PackageProblem GenericPackageDescription+parsePackageDescription cabalFile bytes =+  case snd (runParseResult (parseGenericPackageDescription bytes)) of+    Left (_, complaints) ->+      Left (PackageMalformed cabalFile (fmap said (NE.toList complaints)))+    Right description -> Right description   where-    said = T.pack . showPError cabalFile+    said = T.pack . showPError cabalFile . perror  -- | The value a build of a package on this platform gives each variable its -- conditions ask about.@@ -339,14 +347,32 @@ -- | Every branch of every component of a package, in the order declared. packageBranches :: GenericPackageDescription -> [BranchSections] packageBranches described =+  [b | (_, _, branches) <- packageComponents described, b <- branches]++-- | The kinds of component a @.cabal@ file can declare, and the setup+-- script beside it.+data Kind = Lib | Exe | Test | Bench | Setup+  deriving (Eq, Ord, Show)++-- | Every component of a package, in the order declared: its kind, its+-- name, which for the main library is the package's own, and its branches.+packageComponents :: GenericPackageDescription -> [(Kind, Text, [BranchSections])]+packageComponents described =   concat-    [ foldMap libraryBranches (condLibrary described),-      concatMap (libraryBranches . snd) (condSubLibraries described),-      concatMap (executableBranches . snd) (condExecutables described),-      concatMap (suiteBranches . snd) (condTestSuites described),-      concatMap (benchmarkBranches . snd) (condBenchmarks described)+    [ [(Lib, packageOf described, libraryBranches t) | t <- toList (condLibrary described)],+      [(Lib, nameOf n, libraryBranches t) | (n, t) <- condSubLibraries described],+      [(Exe, nameOf n, executableBranches t) | (n, t) <- condExecutables described],+      [(Test, nameOf n, suiteBranches t) | (n, t) <- condTestSuites described],+      [(Bench, nameOf n, benchmarkBranches t) | (n, t) <- condBenchmarks described]     ]+  where+    nameOf = T.pack . unUnqualComponentName +-- | The name of a package.+packageOf :: GenericPackageDescription -> Text+packageOf =+  T.pack . unPackageName . pkgName . package . packageDescription+ -- | Every module any branch of a package declares, with where it would be -- written relative to the package, without an extension. declaredModules :: GenericPackageDescription -> [(Text, FilePath)]@@ -357,6 +383,31 @@     (sub, name) <- sectionModules section   ] +-- | Every directory any branch of a package names for its files, and then+-- the package's own.+packageSourceDirs :: GenericPackageDescription -> [FilePath]+packageSourceDirs described = nub (named <> ["."])+  where+    named =+      [ getSymbolicPath d+      | branch <- packageBranches described,+        d <- hsSourceDirs (sectionInfo (ownSection branch))+      ]++-- | What any branch of a package puts in force, all together: every edition+-- it names and every extension it turns on or off, in order.+packageExtensions :: GenericPackageDescription -> Defaults+packageExtensions described =+  defaultsOf+    baseline+    (mapMaybe extensionSwitch (concatMap usedExtensions infos))+  where+    infos =+      [sectionInfo (ownSection branch) | branch <- packageBranches described]+    baseline = case mapMaybe (ghcLanguage <=< defaultLanguage) infos of+      [] -> GHC.languageExtensions (Just GHC.Haskell98)+      editions -> nub (concatMap (GHC.languageExtensions . Just) editions)+ -- | What one branch of a component declares. data ComponentSection = ComponentSection   { -- | Its build settings.@@ -388,17 +439,17 @@   }  -- | Every branch of a library.-libraryBranches :: CondTree ConfVar c Library -> [BranchSections]+libraryBranches :: CondTree ConfVar Library -> [BranchSections] libraryBranches = branchesOf $ \l ->   declaring (libBuildInfo l) (exposedModules l <> signatures l) []  -- | Every branch of an executable.-executableBranches :: CondTree ConfVar c Executable -> [BranchSections]+executableBranches :: CondTree ConfVar Executable -> [BranchSections] executableBranches = branchesOf $ \e ->   declaring (buildInfo e) [] [entryPoint (modulePath e)]  -- | Every branch of a test suite.-suiteBranches :: CondTree ConfVar c TestSuite -> [BranchSections]+suiteBranches :: CondTree ConfVar TestSuite -> [BranchSections] suiteBranches = branchesOf $ \s ->   case testInterface s of     TestSuiteExeV10 _ path -> declaring (testBuildInfo s) [] [entryPoint path]@@ -406,7 +457,7 @@     _ -> declaring (testBuildInfo s) [] []  -- | Every branch of a benchmark.-benchmarkBranches :: CondTree ConfVar c Benchmark -> [BranchSections]+benchmarkBranches :: CondTree ConfVar Benchmark -> [BranchSections] benchmarkBranches = branchesOf $ \b ->   case benchmarkInterface b of     BenchmarkExeV10 _ path -> declaring (benchmarkBuildInfo b) [] [entryPoint path]@@ -416,13 +467,12 @@ branchesOf ::   (Semigroup a) =>   (a -> ComponentSection) ->-  CondTree ConfVar c a ->+  CondTree ConfVar a ->   [BranchSections] branchesOf f root = go mempty root   where     built valueOf =-      sectionInfo . f . snd $-        simplifyCondTree valueOf (mapTreeConstrs (const ()) root)+      sectionInfo (f (simplifyCondTree valueOf root))     go inherited node =       let own = f (condTreeData node)        in BranchSections inherited own built@@ -480,16 +530,8 @@   | otherwise = a </> b  -- | The path of an entry point.------ Cabal 3.14 made a component's entry point a symbolic path; before that--- it was already the plain path we want.-#if MIN_VERSION_Cabal_syntax(3, 14, 0) entryPoint :: SymbolicPathX allowAbsolute from to -> FilePath entryPoint = normalise . getSymbolicPath-#else-entryPoint :: FilePath -> FilePath-entryPoint = normalise-#endif  -- | The setup script of a package, beside its @.cabal@ file. --@@ -504,18 +546,22 @@   [] -> ["."]   ds -> ds --- | The extensions a component puts in force, before any module's pragmas.-extensionsInForce :: BuildInfo -> [Extension]+-- | What a component puts in force, before any module's pragmas.+extensionsInForce :: BuildInfo -> Defaults extensionsInForce bi =-  foldl apply (GHC.languageExtensions edition) (usedExtensions bi)+  defaultsOf+    (GHC.languageExtensions edition)+    (mapMaybe extensionSwitch (usedExtensions bi))   where     edition = ghcLanguage (fromMaybe Cabal.Haskell98 (defaultLanguage bi))-    apply acc = \case-      Cabal.EnableExtension e -> applyExtensionName acc (named e)-      Cabal.DisableExtension e -> applyExtensionName acc ("No" <> named e)-      _ -> acc-    named = T.pack . show +-- | GHC's reading of an extension Cabal turns on or off, where GHC knows it.+extensionSwitch :: Cabal.Extension -> Maybe (GHC.OnOff Extension)+extensionSwitch = \case+  Cabal.EnableExtension e -> nameSwitch (tshow e)+  Cabal.DisableExtension e -> nameSwitch ("No" <> tshow e)+  _ -> Nothing+ -- | GHC's name for a language edition, when it has one. ghcLanguage :: Cabal.Language -> Maybe GHC.Language-ghcLanguage = lookupEdition . T.pack . show+ghcLanguage = lookupEdition . tshow

@@ -25,7 +25,6 @@     -- * Readiness     Readiness (..),     PlanComponent (..),-    spellPlanComponent,     plannedComponents,     planPathFor,     checkReadiness,@@ -51,7 +50,8 @@     (.:?),   ) import Data.Aeson.Types (parseMaybe)-import Data.Choice (Choice, isTrue)+import Data.Choice (Choice, isFalse)+import Data.Containers.ListUtils (nubOrdOn) import Data.Foldable (toList, traverse_) import Data.List qualified import Data.List.NonEmpty (NonEmpty ((:|)))@@ -66,6 +66,9 @@ import Data.Text.Encoding qualified as T import Data.Text.Read qualified as T import Data.Time (UTCTime, getCurrentTime)+import Distribution.Package (pkgName, pkgVersion, unPackageName)+import Distribution.PackageDescription (package, packageDescription)+import Distribution.Pretty (prettyShow) import Distribution.Version (Version, mkVersion) import GHC.IO.Handle (hDuplicate) import System.Directory@@ -91,12 +94,13 @@     std_out,     waitForProcess,   )+import Tilia.Cabal.Package (readPackageDescription) import Tilia.Cabal.Project (cabalFilesIn) import Tilia.Cpp.Macros (Macros (..)) import Tilia.Fixity.Cache import Tilia.Fixity.PackageDb import Tilia.Process (readProgramOutput)-import Tilia.Utils (quietly, readFileText, sha256Of)+import Tilia.Utils (quietly, sha256Of)  ---------------------------------------------------------------------------- -- The plan@@ -250,7 +254,8 @@                 )             (_, Just "local") -> LocalPackage (maybe "" T.unpack (join sourcePath))             (_, Just "source-repo") -> SourceRepo-            -- Anything else is treated as already present.+            -- Anything else, a local or remote tarball among them, is+            -- treated as already present.             _ -> PreExisting         } @@ -320,15 +325,12 @@         | e <- Data.List.sort entries,           (ppName p <> "-") `T.isPrefixOf` T.pack e         ]-    isThePackage p dir = quietly False $ do-      contents <- readFileText (dir </> T.unpack (ppName p) <> ".cabal")-      pure (maybe False (describes p) contents)-    describes p text =-      any (names "name:" (ppName p)) (T.lines text)-        && any (names "version:" (ppVersion p)) (T.lines text)-    names field value line = case T.stripPrefix field (T.toLower (T.strip line)) of-      Just rest -> T.strip rest == T.toLower value-      Nothing -> False+    isThePackage p dir =+      either (const False) (describes p . package . packageDescription)+        <$> readPackageDescription (dir </> T.unpack (ppName p) <> ".cabal")+    describes p identifier =+      T.pack (unPackageName (pkgName identifier)) == ppName p+        && T.pack (prettyShow (pkgVersion identifier)) == ppVersion p  -- | The version macros a plan settles. macrosOf :: BuildPlan -> Macros@@ -453,12 +455,8 @@     PlanStale [FilePath]   | -- | The plan says nothing about components the run is about to format.     PlanNarrow [Text]-  | -- | The plan is there, and some packages have neither been downloaded-    -- nor built. The names are listed so that a caller can say what it is-    -- waiting for.-    ---    -- Built counts as having them: their interfaces provide everything the-    -- source tarball would.+  | -- | The plan is there, and the packages named have neither been+    -- downloaded nor built.     SourcesMissing [Text]   deriving (Eq, Show) @@ -467,30 +465,40 @@ planPathFor projectDir = projectDir </> "dist-newstyle" </> "cache" </> "plan.json"  -- | Check what is missing.------ One read of the plan and one @stat@ per package, so this is fast enough--- to run before every format. checkReadiness :: Choice "useCache" -> [PlanComponent] -> FilePath -> IO Readiness checkReadiness caching wanted projectDir =-  readBuildPlan (planPathFor projectDir) >>= \case-    Left _ -> pure PlanMissing-    Right plan -> do-      solved <- cachedSolveTime =<< openCache caching =<< tokenForBuildPlan plan-      newer <- filesNewerThanPlan plan projectDir solved-      let covered = plannedComponents plan-          missing = [spellPlanComponent c | c <- wanted, c `notElem` covered]-      case (newer, missing) of-        (_ : _, _) -> pure (PlanStale newer)-        ([], _ : _) -> pure (PlanNarrow missing)-        ([], []) ->-          sourcesShortOf caching plan >>= \case-            [] -> pure Ready-            ps -> pure (SourcesMissing (fmap ppName ps))+  readinessOf caching wanted projectDir =<< readBuildPlan (planPathFor projectDir) +-- | 'checkReadiness', given the plan as read.+readinessOf ::+  -- | Whether to use the cache.+  Choice "useCache" ->+  -- | The components the run is about to format.+  [PlanComponent] ->+  -- | The project whose plan it is.+  FilePath ->+  -- | Its plan, or why it could not be read.+  Either Text BuildPlan ->+  IO Readiness+readinessOf caching wanted projectDir = \case+  Left _ -> pure PlanMissing+  Right plan -> do+    cache <- openCache caching =<< tokenForBuildPlan plan+    solved <- cachedSolveTime cache+    newer <- filesNewerThanPlan plan projectDir solved+    let covered = plannedComponents plan+        missing = [spellPlanComponent c | c <- wanted, c `notElem` covered]+    case (newer, missing) of+      (_ : _, _) -> pure (PlanStale newer)+      ([], _ : _) -> pure (PlanNarrow missing)+      ([], []) ->+        sourcesShortOf cache plan >>= \case+          [] -> pure Ready+          ps -> pure (SourcesMissing (fmap ppName ps))+ -- | The packages the plan expects to fetch whose sources are not here.-sourcesShortOf :: Choice "useCache" -> BuildPlan -> IO [PlanPackage]-sourcesShortOf caching plan = do-  cache <- openCache caching =<< tokenForBuildPlan plan+sourcesShortOf :: Cache -> BuildPlan -> IO [PlanPackage]+sourcesShortOf cache plan = do   tarballs <- filter (isFetchable . fst) <$> plannedTarballs cache plan   absent <- fmap fst <$> filterM (fmap not . doesFileExist . snd) tarballs   if null absent@@ -593,7 +601,7 @@   IO (Either Text ()) prepareWith caching downloading cabal futility wanted projectDir = \case   Ready -> pure (Right ())-  SourcesMissing _ -> fetch+  SourcesMissing short -> fetch short   PlanMissing -> solveThenFetch   PlanStale _ -> solveThenFetch   PlanNarrow _ ->@@ -606,24 +614,24 @@       cabal (args <> wholeProject) >>= \case         Right () -> pure (Right ())         Left _ -> cabal args-    fetch-      | isTrue downloading = tryWholeProject ["build", ":all", "--only-download"]-      | otherwise = pure (Right ())-    fetchWhatIsShort =-      readBuildPlan (planPathFor projectDir) >>= \case-        Left _ -> pure (Right ())-        Right plan -> do-          short <- fmap ppName <$> sourcesShortOf caching plan+    fetch short+      | isFalse downloading = pure (Right ())+      | otherwise = do           refused <- fetchWasFutileFor futility-          if null short || all (`elem` refused) short+          if all (`elem` refused) short             then pure (Right ())             else-              fetch >>= \case+              tryWholeProject ["build", ":all", "--only-download"] >>= \case                 Left err -> pure (Left err)-                Right () -> do-                  left <- sourcesShortOf caching plan-                  rememberFutileFetch futility (fmap ppName left)-                  pure (Right ())+                Right () ->+                  withPlan ((Right () <$) . rememberFutileFetch futility)+    fetchWhatIsShort = withPlan fetch+    withPlan use =+      readBuildPlan (planPathFor projectDir) >>= \case+        Left _ -> pure (Right ())+        Right plan -> do+          cache <- openCache caching =<< tokenForBuildPlan plan+          use . fmap ppName =<< sourcesShortOf cache plan     solveThenFetch = do       started <- getCurrentTime       tryWholeProject ["build", ":all", "--dry-run"] >>= \case@@ -631,7 +639,7 @@         Right () -> do           rememberSolveTime futility started           checkReadiness caching wanted projectDir >>= \case-            SourcesMissing _ -> fetch+            SourcesMissing short -> fetch short             PlanNarrow _ -> rememberFutileSolve futility >> fetchWhatIsShort             _ -> pure (Right ()) @@ -669,8 +677,9 @@   -- | The build plan to use.   BuildPlan ->   IO ()-fetchUninstalled caching projectDir plan =-  sourcesShortOf caching plan >>= \case+fetchUninstalled caching projectDir plan = do+  cache <- openCache caching =<< tokenForBuildPlan plan+  sourcesShortOf cache plan >>= \case     [] -> pure ()     short ->       void . runCabal projectDir $@@ -691,31 +700,37 @@   FilePath ->   IO (Either Text BuildPlan) loadPlan caching downloading wanted projectDir = do-  readiness <- checkReadiness caching wanted projectDir-  prepareWith-    caching-    downloading-    (runCabal projectDir)-    (futilityFor caching projectDir)-    wanted-    projectDir-    readiness-    >>= \case-      Left err -> pure (Left err)-      _ -> readBuildPlan (planPathFor projectDir)+  written <- readBuildPlan (planPathFor projectDir)+  readiness <- readinessOf caching wanted projectDir written+  case (readiness, written) of+    (Ready, Right plan) -> pure (Right plan)+    _ ->+      prepareWith+        caching+        downloading+        (runCabal projectDir)+        (futilityFor caching projectDir)+        wanted+        projectDir+        readiness+        >>= \case+          Left err -> pure (Left err)+          _ -> readBuildPlan (planPathFor projectDir)  -- | Every planned package whose source could be in the package cache, with -- where that would be: under the package cache @cabal@ last named, unless--- a tarball it downloads is not there, when @cabal@ is asked again.+-- a tarball it downloads is not there and a fetch has not already failed+-- to bring it in, when @cabal@ is asked again. plannedTarballs :: Cache -> BuildPlan -> IO [(PlanPackage, FilePath)] plannedTarballs cache plan =   cachedPackageCache cache >>= \case     Just remembered -> do       tarballs <- under remembered+      refused <- cachedFutileFetch cache       absent <-         filterM           (fmap not . doesFileExist . snd)-          (filter (isFetchable . fst) tarballs)+          [t | t@(p, _) <- tarballs, isFetchable p, ppName p `notElem` refused]       if null absent then pure tarballs else asked     Nothing -> asked   where@@ -727,7 +742,7 @@       repos <- quietly [] (Data.List.sort <$> listDirectory cacheRoot)       traverse         (\p -> (,) p <$> tarballFor cacheRoot repos p)-        [p | p <- bpPackages plan, not (isLocal p)]+        (nubOrdOn (\p -> (ppName p, ppVersion p)) [p | p <- bpPackages plan, not (isLocal p)])     isLocal p = case ppSource p of       LocalPackage _ -> True       CheckedOut _ -> True

@@ -7,6 +7,7 @@     Marker (..),     markerFile,     findProjectRoot,+    startingDirectory,     cabalFilesIn,   ) where@@ -49,30 +50,37 @@ -- | Walk upwards from a file or directory looking for a project. findProjectRoot :: FilePath -> IO (Maybe ProjectRoot) findProjectRoot start = quietly Nothing $ do-  from <- startingDirectory+  from <- startingDirectory =<< canonicalizePath start   found <- traverse markersIn (from : ancestorsOf from)   pure (listToMaybe (concatMap fst found <> concatMap snd found))   where-    startingDirectory = do-      absolute <- canonicalizePath start-      isDirectory <- doesDirectoryExist absolute-      pure (if isDirectory then absolute else takeDirectory absolute)-     ancestorsOf directory =       let parent = takeDirectory directory        in if parent == directory then [] else parent : ancestorsOf parent      markersIn directory = quietly ([], []) $ do       entries <- listDirectory directory-      packages <- cabalFilesIn directory+      packages <- cabalFilesAmong directory entries       pure         ( [ProjectRoot directory ProjectFile | "cabal.project" `elem` entries],           [ProjectRoot directory (PackageFile (takeFileName p)) | p <- take 1 packages]         ) +-- | Where a walk upwards from a path starts: the path itself if it names a+-- directory, else the directory holding it.+startingDirectory :: FilePath -> IO FilePath+startingDirectory path = do+  isDirectory <- quietly False (doesDirectoryExist path)+  pure (if isDirectory then path else takeDirectory path)+ -- | The @.cabal@ files sitting directly in a directory, in order. cabalFilesIn :: FilePath -> IO [FilePath]-cabalFilesIn directory = quietly [] $ do-  entries <- listDirectory directory-  let named = sort (filter (".cabal" `isSuffixOf`) entries)-  filterM doesFileExist (fmap (directory </>) named)+cabalFilesIn directory =+  quietly [] (cabalFilesAmong directory =<< listDirectory directory)++-- | The @.cabal@ files among a directory's entries, in order.+cabalFilesAmong :: FilePath -> [FilePath] -> IO [FilePath]+cabalFilesAmong directory entries =+  filterM+    doesFileExist+    (fmap (directory </>) (sort (filter (".cabal" `isSuffixOf`) entries)))

@@ -9,11 +9,12 @@     parseTarget,     Component (..),     Wanted (..),-    TargetProblem (..),+    TargetProblem,     describeTargetProblem,     componentsOfTarget,     componentInPlan,     filesOfComponents,+    packageFilesOf,   ) where @@ -31,14 +32,8 @@ import Data.Text.Encoding qualified as T import Distribution.Fields.Field (Field (..), FieldLine (..), Name (..)) import Distribution.Fields.Parser (readFields)-import Distribution.PackageDescription-  ( GenericPackageDescription (..),-    PackageDescription (..),-    unPackageName,-    unUnqualComponentName,-  )-import Distribution.Types.PackageId (PackageIdentifier (..))-import System.Directory (doesFileExist, listDirectory)+import Distribution.PackageDescription (GenericPackageDescription (..))+import System.Directory (canonicalizePath, doesFileExist, listDirectory) import System.FilePath   ( dropTrailingPathSeparator,     normalise,@@ -47,22 +42,21 @@   ) import Tilia.Cabal.Package   ( ComponentSection (..),+    Kind (..),     PackageProblem,     addedSources,-    benchmarkBranches,     describePackageProblem,-    executableBranches,     isDeclaredModule,     joined,-    libraryBranches,+    packageComponents,+    packageOf,     readPackageDescription,     setupScript,-    suiteBranches,   ) import Tilia.Cabal.Plan (PlanComponent (..)) import Tilia.Cabal.Project (Marker (..), ProjectRoot (..), cabalFilesIn, markerFile)-import Tilia.Ignore (belowRoot, ignoreFilesAbove, isIgnored)-import Tilia.Utils (fieldWords, quietly)+import Tilia.Ignore (withoutIgnored)+import Tilia.Utils (fieldWords, quietly, tshow)  -- | Which components a run was asked for. data Target@@ -74,11 +68,6 @@     Qualified (Maybe Text) Kind Text   deriving (Eq, Show) --- | The kinds of component a @.cabal@ file can declare, and the setup--- script beside it.-data Kind = Lib | Exe | Test | Bench | Setup-  deriving (Eq, Ord, Show)- -- | Read a target as it was written on the command line. parseTarget :: String -> Either Text Target parseTarget written = case T.splitOn ":" (T.strip (T.pack written)) of@@ -91,7 +80,7 @@   where     unrecognised =       "unrecognised target "-        <> T.pack (show written)+        <> tshow written         <> ": expected all, a package or component name, or one of\            \ lib:, exe:, test:, bench: followed by a name"     kindNamed = \case@@ -120,7 +109,7 @@     componentPackage :: Text,     -- | Which kind it is.     componentKind :: Kind,-    -- | Its name, which for a library is the package's own.+    -- | Its name, which for the main library is the package's own.     componentName :: Text,     -- | The directory its @.cabal@ file sits in.     componentRoot :: FilePath,@@ -203,8 +192,9 @@  -- | How a build plan names this component, if it has an entry of its own. ----- A plan writes a library as @lib@ and everything else as its kind and--- name, which is not quite how a target is written: see 'spellComponent'.+-- A plan writes the main library as @lib@ and everything else, sub-libraries+-- among them, as its kind and name, which is not quite how a target is+-- written: see 'spellComponent'. -- A setup script has an entry only when the build type is @Custom@, so a -- plan is never expected to say anything about it. componentInPlan :: Component -> Maybe PlanComponent@@ -215,7 +205,7 @@       PlanComponent         { pcPackage = componentPackage c,           pcName = case kind of-            Lib -> "lib"+            Lib | componentName c == componentPackage c -> "lib"             _ -> spellKind kind <> ":" <> componentName c         } @@ -240,22 +230,17 @@ -- the ones the project's @.tiliaignore@ files exclude. filesOfComponents :: ProjectRoot -> [Component] -> IO [FilePath] filesOfComponents root components = do-  candidates <- concat <$> traverse present (Map.toList directories)-  let inProject =-        [ (path, below)-        | path <- candidates,-          Just below <- [belowRoot (prPath root) path]+  directories <-+    Map.fromListWith (<>)+      <$> sequence+        [ (,wanted) <$> quietly d (canonicalizePath d)+        | c <- components,+          (written, wanted) <- Map.toList (componentSources c),+          let d = joined (componentRoot c) written         ]-  ignoreFiles <- ignoreFilesAbove (prPath root) (fmap snd inProject)-  let excluded = Set.fromList [path | (path, below) <- inProject, isIgnored ignoreFiles below]-  pure (sort (filter (`Set.notMember` excluded) candidates))+  candidates <- concat <$> traverse present (Map.toList directories)+  sort <$> withoutIgnored (prPath root) candidates   where-    directories =-      Map.unionsWith-        (<>)-        [ Map.mapKeys (joined (asDirectory (componentRoot c))) (componentSources c)-        | c <- components-        ]     present (directory, wanted) = do       entries <- quietly [] (listDirectory directory)       filterM@@ -302,11 +287,11 @@ packageToCabalFile root entry = do   paths <-     packageGlobToCabalFiles-      root-      (fmap T.unpack (T.split (== '/') (T.dropWhile (== '.') stripped)))+      (if "/" `T.isPrefixOf` written then "/" else root)+      (fmap T.unpack (T.split (== '/') written))   concat <$> traverse asPackage paths   where-    stripped = T.dropWhile (== '/') (T.strip entry)+    written = T.strip entry     asPackage path       | ".cabal" `isSuffixOf` path = do           there <- quietly False (doesFileExist path)@@ -358,11 +343,6 @@              | hasSetup              ] --- | The name of a package.-packageOf :: GenericPackageDescription -> Text-packageOf =-  T.pack . unPackageName . pkgName . Distribution.PackageDescription.package . packageDescription- -- | The directories a branch's declarations may be found in under one -- source directory. sourcesIn :: FilePath -> ComponentSection -> Map FilePath Wanted@@ -376,21 +356,11 @@ -- | The components of a parsed @.cabal@ file, in the order declared. declaredComponents :: FilePath -> GenericPackageDescription -> [Component] declaredComponents root described =-  concat-    [ foldMap-        (pure . made Lib package . libraryBranches)-        (condLibrary described),-      [made Lib (nameOf n) (libraryBranches t) | (n, t) <- condSubLibraries described],-      [made Exe (nameOf n) (executableBranches t) | (n, t) <- condExecutables described],-      [made Test (nameOf n) (suiteBranches t) | (n, t) <- condTestSuites described],-      [made Bench (nameOf n) (benchmarkBranches t) | (n, t) <- condBenchmarks described]-    ]+  [made kind name branches | (kind, name, branches) <- packageComponents described]   where-    package = packageOf described-    nameOf = T.pack . unUnqualComponentName     made kind name branches =       Component-        { componentPackage = package,+        { componentPackage = packageOf described,           componentKind = kind,           componentName = name,           componentRoot = root,

@@ -39,7 +39,17 @@ import Data.Text qualified as T import GHC.Parser.Lexer qualified as GHC import GHC.Types.SrcLoc qualified as GHC-import Tilia.Source.Lines (Lines, blankAt, directiveOnLine, lineAt, lineTexts)+import Tilia.Pragma (withoutSkippedComments)+import Tilia.Source.Lines+  ( Lines,+    blankAt,+    columnOf,+    contentColumn,+    directiveOnLine,+    lineAt,+    lineTexts,+    offsetOf,+  ) import Tilia.Span (Span (..), covers) import Tilia.Span.Ghc (spanOfReal) @@ -86,7 +96,8 @@  -- | What was on the line above a comment. data Above-  = -- | The comment begins on the first line of the file.+  = -- | Nothing: the comment begins on the first line of the file, or the+    -- line above is not in this configuration.     TopOfFile   | -- | An empty line.     BlankLine@@ -141,21 +152,20 @@       Nothing -> TopOfFile       Just l         | T.all isSpace l -> BlankLine-        | otherwise -> ContentAt (contentStart l)+        | otherwise -> ContentAt (contentColumn l)     before' = maybe T.empty (T.stripEnd . T.take startColumn) openingLine     codeBeforeStopsAt = do       l <- openingLine       if T.null before' then Nothing else Just (columnOf l (T.length before'))     nextLine =       listToMaybe-        [ (n, contentStart l)+        [ (n, contentColumn l)         | (n, Just l) <-             takeWhile               (isJust . snd)               [(n, lineAt n ls) | n <- [spanEndLine spn + 1 ..]],           not (T.all isSpace l || isJust (directiveOnLine l))         ]-    contentStart l = columnOf l (T.length (T.takeWhile isSpace l))     followed = case lineAt (spanEndLine spn) ls of       Just l -> not (T.all isSpace (T.drop (offsetOf l (spanEndColumn spn)) l))       Nothing -> False@@ -374,7 +384,7 @@                 spanStartColumn =                   if n == spanStartLine s                     then spanStartColumn s-                    else columnOf l (T.length (T.takeWhile isSpace l)),+                    else contentColumn l,                 spanEndLine = n,                 spanEndColumn =                   if n == spanEndLine s@@ -453,47 +463,28 @@   { -- | The name, upper-cased as GHC expects it, e.g. @LANGUAGE@.     pragmaName :: Text,     -- | Everything between the name and the closing @#-}@, with the-    -- surrounding whitespace removed but nothing else touched.-    pragmaBody :: Text+    -- surrounding whitespace removed, on one line, and without the comments+    -- GHC skips in a @LANGUAGE@ pragma.+    pragmaBody :: Text,+    -- | Whether it holds such a comment.+    pragmaCommented :: Bool   }   deriving (Eq, Show)  -- | Recognise a pragma. commentPragma :: Comment -> Maybe Pragma commentPragma c = do-  inner <- T.stripSuffix "#-}" =<< T.stripPrefix "{-#" oneLine-  let (name, body) = T.break isSpace (T.stripStart inner)+  inner <- T.stripSuffix "#-}" =<< T.stripPrefix "{-#" (T.strip written)+  let uncommented = withoutSkippedComments inner+      (name, body) = T.break isSpace (T.stripStart uncommented)   if T.null name     then Nothing     else       Just         Pragma           { pragmaName = T.toUpper name,-            pragmaBody = T.strip body+            pragmaBody = T.strip (T.unwords (fmap T.strip (T.lines body))),+            pragmaCommented = uncommented /= inner           }   where-    oneLine = T.unwords (fmap T.strip (NE.toList (commentBody c)))---- | How many characters of a line come before the compiler's column.------ A column is not a character offset. The lexer counts a tab as advancing to--- the next multiple of eight, so a line with a tab in it has more columns--- than it has characters, and cutting the text at a column would cut in the--- wrong place. In a file indented with tabs that is every line.-offsetOf :: Text -> Int -> Int-offsetOf line column = T.length (T.take (walk 0 1) line)-  where-    walk i c-      | c >= column = i-      | i >= T.length line = i + (column - c)-      | otherwise = walk (i + 1) (afterChar (T.index line i) c)---- | The compiler's column for the character at this offset.-columnOf :: Text -> Int -> Int-columnOf line offset = T.foldl' (flip afterChar) 1 (T.take offset line)---- | Where the column moves to once this character has been read.-afterChar :: Char -> Int -> Int-afterChar ch c-  | ch == '\t' = ((c - 1) `div` 8 + 1) * 8 + 1-  | otherwise = c + 1+    written = T.intercalate "\n" (NE.toList (commentBody c))

@@ -9,7 +9,6 @@   ( attachComments,     attachScopedComments,     Margin (..),-    noMargin,   ) where 

@@ -67,7 +67,7 @@ import Tilia.Source   ( Lines,     Written (..),-    blankAt,+    blankAcross,     comments,     dropping,     linesOf,@@ -317,7 +317,7 @@         upTo           0           ( go (concatMap (`nestedIn` 0) gss)-              : [ if holdsNothing r && all holdsNothing (take 1 (gsBranches gs))+              : [ if blankAcross r written && all (`blankAcross` written) (take 1 (gsBranches gs))                     then 0                     else go (nestedIn gs i <> concatMap (`nestedIn` 0) others)                 | (k, gs) <- zip [0 :: Int ..] gss,@@ -332,7 +332,6 @@                       )                 ]           )-    holdsNothing (from, to) = all (`blankAt` written) [from .. to]     upTo acc = \case       _ | acc > limit -> acc       [] -> acc

@@ -9,7 +9,7 @@     withoutRuledOut,     withoutOpaque,     CppError (..),-    Malformation (..),+    Malformation,     describeCppError,      -- * Splitting@@ -25,7 +25,6 @@     ruledOutBranch,     unconditionalErrors,     Assignment,-    resolved,      -- * The directives themselves     Directive (..),@@ -46,7 +45,6 @@   ) where -import Data.Char (isAlphaNum, isSpace) import Data.List (sortOn, tails) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map@@ -55,13 +53,17 @@ import Data.Text (Text) import Data.Text qualified as T import GHC.LanguageExtensions.Type (Extension (..))-import Tilia.Cpp.Macros (Macros, guardHolds, impliedBy)+import Tilia.Cpp.Macros (Macros, guardHolds, impliedBy, isNameChar) import Tilia.Doc.Internal (Conditional (..)) import Tilia.Parser (ParseError, describeParseError) import Tilia.Source.Lines-  ( conditionalKeywords,+  ( Written (..),+    blankAcross,+    conditionalKeywords,+    contentColumn,     continuesGroup,     directiveOnLine,+    linesOf,     opaqueKeywords,     opensGroup,   )@@ -71,6 +73,7 @@     spanEndLine,     spanStartLine,   )+import Tilia.Utils (tshow)  ---------------------------------------------------------------------------- -- Reading a module@@ -165,23 +168,23 @@ describeCppError :: CppError -> Text describeCppError = \case   MalformedConditional n k m ->-    "the #" <> k <> " at line " <> T.pack (show n) <> case m of+    "the #" <> k <> " at line " <> tshow n <> case m of       NeverClosed -> " is never closed"       NothingOpen -> " has no conditional to belong to"       AfterElse -> " comes after the #else of its conditional"   TooManyConfigurations -> "too many configurations to format"   ConfigurationNotParsed c e -> describeParseError e <> inConfiguration c   DirectiveInQuotedText n k ->-    "the #" <> k <> " at line " <> T.pack (show n) <> " is inside a quasi-quote or a multi-line string"+    "the #" <> k <> " at line " <> tshow n <> " is inside a quasi-quote or a multi-line string"   MacroInQuotedText n t ->-    t <> " at line " <> T.pack (show n) <> " is inside a quasi-quote or a multi-line string"+    t <> " at line " <> tshow n <> " is inside a quasi-quote or a multi-line string"   RuledOutBranch n ->     "the branch at line "-      <> T.pack (show n)+      <> tshow n       <> " is ruled out by a conditional around it that asks the same question"   AbortingAlternative n ->     "the alternative that the #error at line "-      <> T.pack (show n)+      <> tshow n       <> " aborts cannot be formatted without parsing it"  -- | Which configuration, in words. Empty where there is only one.@@ -261,17 +264,16 @@ branchLeaves :: Text -> Either CppError [Text] branchLeaves source = do   forest <- readConditionals source-  traverse-    resolved-    ( filter-        (null . unconditionalErrors)-        ( distinct-            [ configurationOf forest a source-            | a <- branchAssignments forest,-              possible forest (completed forest a)-            ]-        )-    )+  pure+    [ withoutOpaque leaf+    | leaf <-+        distinct+          [ configurationOf forest a source+          | a <- branchAssignments forest,+            possible forest (completed forest a)+          ],+      null (unconditionalErrors leaf)+    ]   where     distinct = Map.elems . Map.fromList . fmap (\t -> (t, t)) @@ -366,16 +368,14 @@   forest <- scanConditionals source   listToMaybe (go Map.empty forest)   where-    written = zip [1 ..] (T.lines source)-    holdsSomething (from, to) =-      any (\(n, l) -> from <= n && n <= to && not (T.all isSpace l)) written+    written = linesOf (Written source)     go asked forest =       concat         [ [ opening           | Just j <- [Map.lookup (gsGuards gs) asked],             (i, opening, r) <- zip3 [0 :: Int ..] (gsOwnLines gs) (gsBranches gs),             i /= j,-            holdsSomething r+            not (blankAcross r written)           ]             <> concat               [ go (Map.insert (gsGuards gs) i asked) nested@@ -408,13 +408,13 @@             let answers = completed forest a,             possible forest answers           ]-  traverse (\a -> (,) <$> reading before left a <*> reading after right a) choices+  pure [(reading before left a, reading after right a) | a <- choices]   where     reading source forest assignment =       let selected = configurationOf forest assignment source        in if null (unconditionalErrors selected)-            then Just <$> resolved selected-            else Right Nothing+            then Just (withoutOpaque selected)+            else Nothing  -- | An unconditional @#error@ means this configuration has no Haskell -- program to parse. Conditional errors are only considered after choosing a@@ -433,11 +433,6 @@ -- | Which branch every question was answered with to reach a configuration. type Assignment = Map [Guard] Int --- | A module with every conditional answered, and its other directives--- taken out, or why its conditionals do not make sense.-resolved :: Text -> Either CppError Text-resolved source = withoutOpaque source <$ readConditionals source- ---------------------------------------------------------------------------- -- The directives themselves @@ -646,7 +641,7 @@     written = directives source     inDirective n = any (\d -> dLine d <= n && n <= dLastLine d) written     code (n, l) = not (T.null (T.strip l) || inDirective n || uses l)-    indentation = T.length . T.takeWhile isSpace+    indentation l = contentColumn l - 1     closing = maybe False ((`elem` ("})]" :: String)) . fst) . T.uncons . T.stripStart     uses l = Set.member name defined && enclosed arguments       where@@ -672,4 +667,3 @@           '(' -> k + 1           ')' -> k - 1           _ -> k-    isNameChar c = isAlphaNum c || c == '_'

@@ -7,6 +7,7 @@   ( Macros (..),     guardHolds,     impliedBy,+    isNameChar,   ) where @@ -329,5 +330,6 @@ isNameStart :: Char -> Bool isNameStart c = isAsciiLower c || isAsciiUpper c || c == '_' +-- | Can a character be part of a preprocessor name? isNameChar :: Char -> Bool isNameChar c = isNameStart c || isDigit c

@@ -43,7 +43,7 @@     unwrap,     wrap,   )-import Tilia.Source (Lines, lineAt)+import Tilia.Source (Lines, lineAt, offsetOf) import Tilia.Span (Span (..), covers, endOf, meets, startOf, zeroWidth)  -- | A conditional other than the one asked about that answering a question@@ -81,7 +81,7 @@       | s : others <- spines,         all (agreeAll varied layout s) others =           d-      | Just xs <- traverse only spines = alongside layout xs+      | Just xs <- traverse sole spines = alongside layout xs       | otherwise = factored middle layout spines       where         spines = fmap (spineAt layout) ds@@ -124,9 +124,6 @@       inside <- sole [i | (i, s) <- zip [0 :: Int ..] spans, all (covers s) spans]       openedAgainst inside layout =<< listToMaybe (drop inside xs)       where-        sole [i] = Just i-        sole _ = Nothing-         openedAgainst inside l d = case unwrap d of           Just (w, x) -> wrap w <$> openedAgainst inside (layoutInside l w) x           Nothing -> case spineAt l d of@@ -246,7 +243,7 @@     middle _ [] = mempty     middle layout ss@(s : rest)       | all (alike layout s) rest = mconcat s-      | Just xs <- traverse only ss = go layout xs+      | Just xs <- traverse sole ss = go layout xs       | Just (c, tails) <- commaLed layout ss = c <> middle layout tails       | otherwise =           minimumBy@@ -433,8 +430,11 @@       Just (from, to) -> any (\(a, b) -> from < a && b < to) (concatMap printedFrom ds)       Nothing -> False -    only [d] = Just d-    only _ = Nothing+-- | The one element of a list that has one.+sole :: [a] -> Maybe a+sole = \case+  [x] -> Just x+  _ -> Nothing  -- | Would these two documents print the same, laid out like this? agree :: Varied -> Layout -> Doc -> Doc -> Bool@@ -548,12 +548,9 @@   [] -> Just base   [(_, only)] -> Just only   many -> case (spineAt layout base, [(v, spineAt layout d) | (v, d) <- many]) of-    ([b], ss) | Just xs <- traverse (\(v, s) -> (,) v <$> single s) ss -> descend b xs+    ([b], ss) | Just xs <- traverse (\(v, s) -> (,) v <$> sole s) ss -> descend b xs     (bs, ss) -> spliced bs ss   where-    single [d] = Just d-    single _ = Nothing-     descend b xs = do       own@(_, i) <- unwrap b       others <- traverse (traverse unwrap) xs@@ -579,7 +576,7 @@     cluster _ [c] = Just c     cluster bs cs       | to - from == 1,-        Just xs <- traverse (\c -> (,) (chVaried c) <$> single (chWith c)) cs,+        Just xs <- traverse (\c -> (,) (chVaried c) <$> sole (chWith c)) cs,         (b : _) <- drop from bs =           ( \d ->               Change@@ -769,7 +766,7 @@       Just s ->         maybe           False-          (T.all isSpace . T.take (spanStartColumn s - 1))+          (\l -> T.all isSpace (T.take (offsetOf l (spanStartColumn s)) l))           (lineAt (spanStartLine s) written)       Nothing -> False 

@@ -13,6 +13,7 @@   ) where +import Control.Applicative ((<|>)) import Control.Monad (foldM) import Data.List (sortOn, unsnoc) import Data.Map.Strict (Map)@@ -61,7 +62,7 @@     wrap,   ) import Tilia.Source (Lines, Written (..), blankAt, lineAt, linesOf)-import Tilia.Span (Span (..), mkSpan)+import Tilia.Span (Span (..), mkSpan, startPoint)  -- | What the configurations of a module had besides their code. data CommentSummary = CommentSummary@@ -330,24 +331,23 @@     hulls =       Map.filter         ((> 1) . length)-        (Map.fromListWith (<>) [(startPoint' s, [s]) | d <- ds, s <- outermost d])+        (Map.fromListWith (<>) [(startPoint s, [s]) | d <- ds, s <- outermost d])     rewrite seen = \case       DLocated s x-        | Set.notMember (startPoint' s) seen,-          Just ss <- Map.lookup (startPoint' s) hulls ->-            DLocated (foldr (<>) s ss) (rewrite (Set.insert (startPoint' s) seen) x)-        | otherwise -> DLocated s (rewrite (Set.insert (startPoint' s) seen) x)+        | Set.notMember (startPoint s) seen,+          Just ss <- Map.lookup (startPoint s) hulls ->+            DLocated (foldr (<>) s ss) (rewrite (Set.insert (startPoint s) seen) x)+        | otherwise -> DLocated s (rewrite (Set.insert (startPoint s) seen) x)       d@DCppChoice{} -> d       d -> mapChildren (rewrite seen) d     outermost = go Set.empty       where         go seen = \case           DLocated s x-            | Set.member (startPoint' s) seen -> go seen x-            | otherwise -> s : go (Set.insert (startPoint' s) seen) x+            | Set.member (startPoint s) seen -> go seen x+            | otherwise -> s : go (Set.insert (startPoint s) seen) x           DCppChoice{} -> []           d -> foldChildren (go seen) d-    startPoint' s = (spanStartLine s, spanStartColumn s)  -- | Give one alternative of a choice its anchors. anchoredIn ::@@ -462,62 +462,65 @@   Int ->   -- | What to put there.   Doc ->-  -- | How to put it among the lines of something that begins above it, at-  -- that thing's own indentation.+  -- | How to put it before code printed further in, which carries on a line+  -- above.   (Doc -> Doc) ->   Doc ->   Doc-placeAt present written n body continuing = among [] body+placeAt present written n body continuing = among []   where-    within ctx b d = case d of-      DNest 0 x -> DNest 0 (within ctx b x)-      DNest k x -> DNest k (within ctx body x)-      DAlign x -> DAlign (within ctx body x)-      DGroup l x -> DGroup l (within ctx b x)-      DVariant x y -> DVariant (within ctx b x) (within ctx b y)+    within ctx d = case d of+      DNest k x -> DNest k (within ctx x)+      DAlign x -> DAlign (within ctx x)+      DGroup l x -> DGroup l (within ctx x)+      DVariant x y -> DVariant (within ctx x) (within ctx y)       DLocated s x-        | spanStartLine s > n -> among ctx b d-        | DCppChoice{} <- x -> DLocated s (within ctx b x)-        | otherwise -> DLocated s (within ctx (continuing body) x)-      DFence s x -> DFence s (within ctx b x)+        | spanStartLine s > n -> among ctx d+        | otherwise -> DLocated s (within ctx x)+      DFence s x -> DFence s (within ctx x)       DCppChoice cs bs e         | present ctx -> d         | otherwise -> case alternativeAt n cs of             Everywhere ->               DCppChoice                 cs-                [(g, among (ctx <> [(cs, k)]) b x) | (k, (g, x)) <- zip [0 ..] bs]-                (among (ctx <> [(cs, length bs)]) b e)+                [(g, among (ctx <> [(cs, k)]) x) | (k, (g, x)) <- zip [0 ..] bs]+                (among (ctx <> [(cs, length bs)]) e)             Only k               | k < length bs ->                   DCppChoice                     cs-                    (replaced k (among (ctx <> [(cs, k)]) b (maybe mempty snd (listToMaybe (drop k bs)))) bs)+                    (replaced k (among (ctx <> [(cs, k)]) (maybe mempty snd (listToMaybe (drop k bs)))) bs)                     e-              | otherwise -> DCppChoice cs bs (among (ctx <> [(cs, k)]) b e)+              | otherwise -> DCppChoice cs bs (among (ctx <> [(cs, k)]) e)             Nowhere -> d-      _ -> among ctx b d+      _ -> among ctx d -    among ctx b d+    among ctx d       | present ctx = d       | otherwise = case break startsAfter (spine d) of           (before, after)             | Just (earlier, holder, spacing) <- lastBounded before,               maybe False (>= n) (endOf holder) ->-                mconcat (earlier <> [within ctx b holder] <> spacing <> after)+                mconcat (earlier <> [within ctx holder] <> spacing <> after)             | (later, holder : rest) <- break holds after ->-                mconcat (before <> later <> [within ctx b holder] <> rest)+                mconcat (before <> later <> [within ctx holder] <> rest)             | Just (printed, anchor, spacing) <- lastBounded before,               Just from <- endOf anchor,               Just ls <- written ->                 if any (`blankAt` ls) [from .. n - 1] || not (all onlySpacing spacing)-                  then mconcat (before <> [includeWhen (blankAt (n - 1) ls) blankLine, b] <> after)-                  else mconcat (printed <> [anchor, b] <> spacing <> after)+                  then mconcat (before <> [includeWhen (blankAt (n - 1) ls) blankLine, putBefore after] <> after)+                  else mconcat (printed <> [anchor, putBefore (spacing <> after)] <> spacing <> after)             | next : rest <- after,               any (not . onlySpacing) (takeWhile unbounded (reverse before)) ->-                mconcat (before <> [within ctx b next] <> rest)-            | otherwise -> mconcat (before <> [b] <> after)+                mconcat (before <> [within ctx next] <> rest)+            | otherwise -> mconcat (before <> [putBefore after] <> after) +    putBefore following =+      if maybe False (> 0) (firstNesting (mconcat following))+        then continuing body+        else body+     holds = \case       DLocated s _ -> spanStartLine s < n && n <= spanEndLine s       _ -> False@@ -576,6 +579,17 @@         from < n,         n < to       ]++-- | How many steps further in than itself a document prints its first+-- text, if it prints any.+firstNesting :: Doc -> Maybe Int+firstNesting = \case+  DText _ -> Just 0+  DCat a b -> firstNesting a <|> firstNesting b+  DNest k x -> (+ k) <$> firstNesting x+  DVariant _ x -> firstNesting x+  DCppChoice _ bs e -> foldr ((<|>) . firstNesting . snd) (firstNesting e) bs+  d -> firstNesting . snd =<< unwrap d  -- | The lines a document was printed from, first and last. boundsOf :: Doc -> Maybe (Int, Int)

@@ -19,6 +19,7 @@ import Data.Text (Text) import Data.Text qualified as T import Tilia.Palette (Color (..), Palette, paint)+import Tilia.Utils (tshow)  -- | What a line of the comparison does. data Mark = Context | Removed | Added@@ -98,7 +99,7 @@           <> " @@"       where         span' which n = case slice range of-          (l : _) -> T.pack (show (which l)) <> "," <> T.pack (show n)+          (l : _) -> tshow (which l) <> "," <> tshow n           [] -> "0,0"      line (Line mark _ _ text) = case mark of

@@ -5,12 +5,7 @@   ) where -import Data.Text (Text) import Tilia.Doc.Internal   ( Doc,-    render,+    printDoc,   )---- | Render a document to source text.-printDoc :: Doc -> Text-printDoc = render

@@ -1,4 +1,5 @@--- | Something that can appear as the body of an enclosing construct.+-- | The bodies of enclosing constructs, and how each joins what comes+-- before it. module Tilia.Doc.Body   ( Body (..),     attachBody,

@@ -16,6 +16,7 @@     LineStart (..),     TrailingWhitespace (..),     verbatimBreak,+    verbatimLines,     verbatim,     emptyAnchor,     insideBrackets,@@ -49,7 +50,6 @@      -- * Wrapping     ClosingIndent (..),-    bracket,     parens,     parensWith,     brackets,@@ -127,12 +127,13 @@ verbatimBreak :: LineStart -> TrailingWhitespace -> Doc verbatimBreak = DVerbatimBreak +-- | Lines of text reproduced, each break between them a 'verbatimBreak'.+verbatimLines :: LineStart -> TrailingWhitespace -> [Text] -> Doc+verbatimLines start trailing = sepBy (verbatimBreak start trailing) . fmap txt+ -- | Text reproduced exactly, line breaks and all. verbatim :: Text -> Doc-verbatim =-  sepBy (verbatimBreak AtMargin KeepWhitespace)-    . fmap txt-    . T.splitOn "\n"+verbatim = verbatimLines AtMargin KeepWhitespace . T.splitOn "\n"  -- | An empty anchor so that comments can attach to it in situations when -- nothing more substantial is present but the position is such that it@@ -269,18 +270,6 @@ ---------------------------------------------------------------------------- -- Wrapping --- | Surround with the given opening and closing documents, adding nothing--- of its own.-enclose ::-  -- | Opening bracket.-  Doc ->-  -- | Closing bracket.-  Doc ->-  -- | Body.-  Doc ->-  Doc-enclose open close body = open <> body <> close- -- | Where the closing bracket of a broken bracket pair goes. data ClosingIndent   = -- | Back out to the level the opening bracket is on.@@ -399,7 +388,7 @@  -- | Surround with backticks. backticks :: Doc -> Doc-backticks = enclose (txt "`") (txt "`")+backticks d = txt "`" <> d <> txt "`"  ---------------------------------------------------------------------------- -- Punctuation

@@ -25,7 +25,7 @@     TrailingWhitespace (..),      -- * Rendering-    render,+    printDoc,   ) where @@ -403,8 +403,8 @@     }  -- | Turn a document into text.-render :: Doc -> Text-render doc = finish (go env doc emptyOut)+printDoc :: Doc -> Text+printDoc doc = finish (go env doc emptyOut)   where     env =       Env

@@ -1,12 +1,8 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}  -- | Whether formatting changed what a module says. module Tilia.Equivalence@@ -67,8 +63,9 @@     triggerEscaped,   ) import Tilia.Imports (normalizeImports)-import Tilia.Parser (ParsedModule (..))-import Tilia.Pragma (languageNames)+import Tilia.Parser (ParsedModule (..), writtenInHeader)+import Tilia.Pragma (languageNames, pragmaFlags)+import Tilia.Pragma.Ghc (InForce (..), inForceAfter) import Tilia.Source (comments, sourceLines) import Tilia.Span (Span (..)) import Tilia.Span.Ghc (spanOf, spansOf)@@ -380,7 +377,7 @@       HsDocStringNext -> "pointer"       HsDocStringPrevious -> "pointer"       HsDocStringNamed n -> "named " <> T.pack n-      HsDocStringGroup n -> "group " <> T.pack (show n)+      HsDocStringGroup n -> "group " <> tshow n  -- | What a doc string says, with the whitespace thrown away. docWords :: HsDocString -> [ByteString]@@ -428,7 +425,8 @@ -- Ordinary comments are compared as they will be printed, in order: the -- text is normalised on the way in, so a comment that came out unchanged -- reads back identically, and one that was mangled or moved past its--- neighbor does not.+-- neighbor does not, unless it trails a line and moved past comments on+-- lines of their own written below it. -- -- Except in the header, where the order says nothing. The pragmas are -- sorted and so are the imports, and a comment written against either@@ -440,6 +438,10 @@ -- legitimately rewrite one—a @-- ^ x@ that moves in front of what it -- documents has to become @-- | x@—so the text is not expected to survive, -- but the comment is.+--+-- The pragmas of the header are also read as GHC reads them: the flags of+-- the options have to come out in the same order, and what GHC's own flag+-- reader puts in force after all of them has to stay the same. commentDifference ::   -- | The module as written.   ParsedModule ->@@ -449,6 +451,23 @@ commentDifference parsedBefore parsedAfter   | not (Set.null lost) = Just ("lost the pragma " <> pragmaList lost)   | not (Set.null gained) = Just ("invented the pragma " <> pragmaList gained)+  | optionsBefore /= optionsAfter =+      Just+        ( "changed the flags of the options pragmas from "+            <> flagList optionsBefore+            <> " to "+            <> flagList optionsAfter+        )+  | haddockBefore /= haddockAfter =+      Just+        ( "changed the OPTIONS_HADDOCK pragmas from "+            <> flagList haddockBefore+            <> " to "+            <> flagList haddockAfter+        )+  | flagsBefore /= flagsAfter,+    Just why <- inForceDifference (inForceAfter flagsBefore) (inForceAfter flagsAfter) =+      Just why   | docsBefore /= docsAfter =       Just $         "the module's "@@ -477,6 +496,16 @@       Just lastLine -> (<= lastLine) . spanStartLine . commentSpan      lost = pragmasOf before `Set.difference` pragmasOf after+    headerBefore = headerPragmas parsedBefore+    headerAfter = headerPragmas parsedAfter+    flagsBefore = concatMap flagsOf headerBefore+    flagsAfter = concatMap flagsOf headerAfter+    flagsOf p = pragmaFlags (pragmaName p) (pragmaBody p)+    optionsBefore = filter (not . T.isPrefixOf "-X") flagsBefore+    optionsAfter = filter (not . T.isPrefixOf "-X") flagsAfter+    haddockBefore = [pragmaBody p | p <- headerBefore, pragmaName p == "OPTIONS_HADDOCK"]+    haddockAfter = [pragmaBody p | p <- headerAfter, pragmaName p == "OPTIONS_HADDOCK"]+    flagList flags = "`" <> T.unwords flags <> "`"     gained = pragmasOf after `Set.difference` pragmasOf before     docsBefore = length (documentation before)     docsAfter = length (documentation after)@@ -513,6 +542,45 @@       T.intercalate ", "         . fmap (\(n, b) -> "{-# " <> n <> " " <> b <> " #-}")         . Set.toList++-- | The pragmas of a module's header, which are all the pragmas GHC reads,+-- in the order they are written.+headerPragmas :: ParsedModule -> [Pragma]+headerPragmas m =+  mapMaybe commentPragma (takeWhile written (comments (pmSource m)))+  where+    written = writtenInHeader (pmHeaderEnd m) . commentSpan++-- | How what the flags of a module's header settle changed, if it did.+inForceDifference :: InForce -> InForce -> Maybe Text+inForceDifference before after+  | inForceEdition before /= inForceEdition after =+      Just+        ( "changed the edition in force from "+            <> edition before+            <> " to "+            <> edition after+        )+  | inForceSafety before /= inForceSafety after =+      Just+        ( "changed the Safe Haskell mode from "+            <> tshow (inForceSafety before)+            <> " to "+            <> tshow (inForceSafety after)+        )+  | null switched = Nothing+  | otherwise =+      Just+        ( "changed how the header switches "+            <> T.intercalate ", " (fmap tshow switched)+        )+  where+    switched =+      [ e+      | e <- Map.keys (inForceSwitches before <> inForceSwitches after),+        Map.lookup e (inForceSwitches before) /= Map.lookup e (inForceSwitches after)+      ]+    edition = maybe "the default" tshow . inForceEdition  -- | A comment's lines, as they are compared. bodyKey :: Comment -> NonEmpty Text

@@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}  -- | Working out the fixity of the operators a module uses. module Tilia.Fixity@@ -12,10 +11,11 @@     defaultFixity,     spellFixity,     readPrecedence,+    opName,+    qualifierOf,      -- * Module declarations     declaredFixities,-    declaredNames,     moduleName,      -- * Module exports@@ -33,7 +33,6 @@     decides,     Namespace (..),     Fixities,-    inBothNamespaces,     Certain (..),     ModuleChain (..),     spellModuleChain,@@ -51,6 +50,7 @@     Unknown (..),     operatorsUsed,     unknownOperators,+    disagreement,     capturedUses,     operatorSpelling,     spellUnreadIn,@@ -73,7 +73,6 @@ import Data.Char (isUpper) import Data.Choice (Choice, isTrue) import Data.Foldable (toList)-import Data.Generics.Schemes (listify) import Data.List (nub, sortOn, tails) import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty) import Data.List.NonEmpty qualified as NE@@ -95,7 +94,7 @@ import Tilia.Palette (Color (Place), Palette, paint) import Tilia.Span (Span, covers) import Tilia.Span.Ghc (spanOf)-import Tilia.Utils (collected, spellList)+import Tilia.Utils (collected, spellList, tshow)  ---------------------------------------------------------------------------- -- Fixities@@ -136,7 +135,7 @@ -- | A fixity, written the way it would be declared. spellFixity :: Fixity -> Text spellFixity (Fixity direction precedence) =-  which direction <> " " <> T.pack (show precedence)+  which direction <> " " <> tshow precedence   where     which = \case       LeftAssoc -> "infixl"@@ -192,20 +191,13 @@             : [opName (unLoc (fdLName (unLoc f))) | f <- tcdATs]       _ -> []     terms = \case-      ValD _ b -> boundNames b+      ValD _ b -> fmap opName (collectHsBindBinders CollNoDictBinders b)       SigD _ sig -> signedNames sig       ForD _ f -> [opName (unLoc (fd_name f))]       TyClD _ d@DataDecl{} -> fmap snd (membersOf d)-      TyClD _ ClassDecl{tcdSigs} -> concatMap (classMethods . unLoc) tcdSigs+      TyClD _ ClassDecl{tcdSigs} -> concatMap (signedNames . unLoc) tcdSigs       _ -> [] --- | The methods a class signature declares.-classMethods :: Sig GhcPs -> [OpName]-classMethods = \case-  TypeSig _ ns _ -> fmap (opName . unLoc) ns-  ClassOpSig _ _ ns _ -> fmap (opName . unLoc) ns-  _ -> []- -- | The members of the type or class a declaration declares, by -- namespace: a data type's constructors and record fields, a class's -- methods and associated families.@@ -217,7 +209,7 @@   DataDecl{tcdDataDefn} ->     fmap (InTerms,) (concatMap (fromCon . unLoc) (consOf (dd_cons tcdDataDefn)))   ClassDecl{tcdSigs, tcdATs} ->-    fmap (InTerms,) (concatMap (classMethods . unLoc) tcdSigs)+    fmap (InTerms,) (concatMap (signedNames . unLoc) tcdSigs)       <> [(InTypes, opName (unLoc (fdLName (unLoc f)))) | f <- tcdATs]   _ -> []   where@@ -273,19 +265,6 @@   where     (types, terms) = declaredNamespaces hsModule --- | The names a binding brings into being.-boundNames :: HsBind GhcPs -> [OpName]-boundNames = \case-  FunBind _ n _ -> [opName (unLoc n)]-  PatBind _ p _ _ -> [opName n | VarPat _ (L _ n) <- listify isVarPat p]-  PatSynBind _ (PSB _ n _ _ _) -> [opName (unLoc n)]-  _ -> []-  where-    isVarPat :: Pat GhcPs -> Bool-    isVarPat = \case-      VarPat{} -> True-      _ -> False- -- | The module's own name, if it declares one. moduleName :: HsModule GhcPs -> Maybe Text moduleName = fmap (T.pack . moduleNameString . unLoc) . hsmodName@@ -366,8 +345,7 @@ data Import = Import   { -- | The module being imported.     importModule :: Text,-    -- | Whether unqualified names are brought into scope. An import that is-    -- @qualified@ brings none.+    -- | Whether it is @qualified@, bringing no unqualified names in.     importQualified :: Bool,     -- | The name qualified uses go through: the alias if there is one,     -- otherwise the module's own name.@@ -544,15 +522,6 @@ -- | The fixities a module offers. type Fixities = Map (Namespace, OpName) Fixity --- | Take fixities that say nothing about namespaces to govern both.-inBothNamespaces :: Map OpName Fixity -> Fixities-inBothNamespaces declared =-  Map.fromList-    [ ((namespace, op), fixity)-    | (op, fixity) <- Map.toList declared,-      namespace <- [InTypes, InTerms]-    ]- -- | What a module certainly brings into scope for a module that imports -- it whole. data Certain = Certain@@ -871,7 +840,7 @@     inTypes =       [n | HsOpTy _ _ _ (L _ n) _ <- gatheredTypes found]     named namespace n =-      (namespace, (qualifierOf n, OpName (T.pack (occNameString (rdrNameOcc n)))))+      (namespace, (qualifierOf n, opName n))  -- | The uses of an operator in an expression that a local binding captures, -- by where the operator is written, with the fixity the binding's group@@ -958,15 +927,28 @@ unknownOperators scope found =   Map.toList (Map.fromList (mapMaybe unsettled (concatMap operatorsUsed found)))   where-    unsettled (namespace, (qualifier, op)) =-      case fixityInScope scope namespace qualifier op of-        Just (answering, _) ->-          ((qualifier, op),) . Ambiguous-            <$> Map.lookup (qualifier, op) (reachAmbiguous (reachIn answering scope))-        Nothing -> case nonEmpty (unreadThatMightDeclare scope namespace qualifier op) of-          Just missing -> Just ((qualifier, op), NotRead missing)-          Nothing -> Nothing+    unsettled (namespace, use@(qualifier, op)) =+      (use,) <$> case lookupFixity scope namespace qualifier op of+        Resolved _ _ -> Ambiguous <$> disagreement scope namespace qualifier op+        Unresolved missing -> Just (NotRead missing) +-- | What the imports in scope bring a use in with, where they disagree, in+-- the namespace that answers for it.+disagreement ::+  -- | The scope.+  Scope ->+  -- | The namespace the operator is written in.+  Namespace ->+  -- | The qualifier written at the use site, if any.+  Maybe Text ->+  -- | Operator being resolved.+  OpName ->+  -- | The module each import names and the fixity it brings.+  Maybe (NonEmpty (Text, Fixity))+disagreement scope namespace qualifier op = do+  (answering, _) <- fixityInScope scope namespace qualifier op+  Map.lookup (qualifier, op) (reachAmbiguous (reachIn answering scope))+ -- | An operator as a use site writes it, qualifier and all. operatorSpelling :: Maybe Text -> OpName -> Text operatorSpelling qualifier (OpName op) = maybe "" (<> ".") qualifier <> op@@ -1008,11 +990,8 @@ ---------------------------------------------------------------------------- -- Module summaries --- | Summary of a module: raw facts (per CPP configuration) about a module--- we read from source. This is built for both local modules and dependency--- modules when they come from tarballs. This is an optimization--- mechanism—we create a summary once and then share it during a run. For--- local modules it is also persisted in the cache on disk.+-- | What one CPP configuration of a module read from source says, whether+-- the module is the project's own or comes out of a tarball. data ModuleSummary = ModuleSummary   { -- | The name it gives itself, if it gives one.     summaryName :: Maybe Text,

@@ -25,14 +25,17 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as T+import Distribution.PackageDescription (GenericPackageDescription) import GHC.Generics (Generic)-import Tilia.Fixity.Cabal (cabalFileAtTop, entryPosixPath, sourceDirs)+import Tilia.Cabal.Package (packageSourceDirs)+import Tilia.Fixity.Cabal (entryPosixPath, ownCabalFile) import Tilia.Utils (quietly)  -- | What a tarball holds that a module could be read out of. data Archive = Archive-  { -- | The package's @.cabal@ file, the first one at the top.-    archiveCabal :: Maybe Text,+  { -- | What the package's @.cabal@ file describes, the first one at the top+    -- that parses.+    archiveCabal :: Maybe GenericPackageDescription,     -- | Every file that could hold a module, by where it sits, in the order     -- the tarball has them.     archiveFiles :: [(FilePath, BS.ByteString)]@@ -49,10 +52,9 @@   where     sweep cabal found = \case       Tar.Next entry rest-        | Tar.NormalFile content _ <- Tar.entryContent entry,-          cabalFileAtTop (entryPosixPath entry),-          Nothing <- cabal ->-            sweep (Just (T.decodeUtf8Lenient (BL.toStrict content))) found rest+        | Nothing <- cabal,+          Just own <- ownCabalFile entry ->+            sweep (Just own) found rest         | Tar.NormalFile content _ <- Tar.entryContent entry,           any (`isSuffixOf` entryPosixPath entry) moduleEndings ->             sweep cabal ((entryPosixPath entry, BL.toStrict content) : found) rest@@ -63,7 +65,7 @@ moduleIn :: Text -> Archive -> Maybe InArchive moduleIn modName archive = listToMaybe (mapMaybe pick moduleEndings)   where-    dirs = maybe [] sourceDirs (archiveCabal archive)+    dirs = maybe [] packageSourceDirs (archiveCabal archive)     pick ending =       inArchive ending . T.decodeUtf8Lenient . snd         <$> listToMaybe (under sfx matching <> matching)@@ -73,7 +75,7 @@     under sfx matching = [f | d <- dirs, f <- matching, inDir sfx d (fst f)]     inDir sfx d path       | d == "." = takeWhile (/= '/') path <> sfx == path-      | otherwise = ("/" <> T.unpack d <> sfx) `isSuffixOf` path+      | otherwise = ("/" <> d <> sfx) `isSuffixOf` path  -- | Where a module's file is under the directory that holds it, without an -- extension.

@@ -1,33 +1,28 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} --- | Reading a package's modules out of its @.cabal@ file.+-- | Reading a package's description out of its source tarball. module Tilia.Fixity.Cabal   ( packageModules,     cabalFileInArchive,+    ownCabalFile,     cabalFileAtTop,     entryPosixPath,-    containedModules,-    sourceDirs,-    declaredExtensions,   ) where  import Codec.Archive.Tar qualified as Tar import Codec.Archive.Tar.Entry qualified as Tar import Codec.Compression.GZip qualified as GZip+import Control.Applicative ((<|>))+import Control.DeepSeq (force)+import Control.Exception (evaluate) import Data.ByteString.Lazy qualified as BL-import Data.Char (isSpace) import Data.List (isSuffixOf)-import Data.List qualified-import Data.Maybe (mapMaybe) import Data.Text (Text)-import Data.Text qualified as T-import Data.Text.Encoding qualified as T-import GHC.Driver.Session qualified as GHC-import GHC.LanguageExtensions.Type (Extension)-import Tilia.Pragma (applyExtensionName, lookupEdition)-import Tilia.Utils (fieldWords, quietly)+import Distribution.PackageDescription (GenericPackageDescription)+import Tilia.Cabal.Package (declaredModules, parsePackageDescription)+import Tilia.Utils (quietly)  -- | The modules a package holds, read from the @.cabal@ file in its -- source tarball.@@ -36,22 +31,32 @@ packageModules :: FilePath -> IO (Maybe [Text]) packageModules tarball = quietly Nothing $ do   bytes <- BL.readFile tarball-  pure (containedModules <$> cabalFileInArchive (Tar.read (GZip.decompress bytes)))+  evaluate . force $+    fmap fst . declaredModules+      <$> cabalFileInArchive (Tar.read (GZip.decompress bytes))  -- | The first @.cabal@ file at the top level of an archive. -- -- Stops as soon as it finds one. The archive is decompressed lazily, so a -- @.cabal@ near the front costs a fraction of the whole file.-cabalFileInArchive :: Tar.Entries e -> Maybe Text+cabalFileInArchive :: Tar.Entries e -> Maybe GenericPackageDescription cabalFileInArchive = \case-  Tar.Next entry rest-    | cabalFileAtTop (entryPosixPath entry),-      Tar.NormalFile content _ <- Tar.entryContent entry ->-        Just (T.decodeUtf8Lenient (BL.toStrict content))-    | otherwise -> cabalFileInArchive rest+  Tar.Next entry rest -> ownCabalFile entry <|> cabalFileInArchive rest   Tar.Done -> Nothing   Tar.Fail _ -> Nothing +-- | What an archive's entry describes if it is the package's own @.cabal@+-- file and parses.+ownCabalFile :: Tar.Entry -> Maybe GenericPackageDescription+ownCabalFile entry+  | cabalFileAtTop path,+    Tar.NormalFile content _ <- Tar.entryContent entry =+      either (const Nothing) Just $+        parsePackageDescription path (BL.toStrict content)+  | otherwise = Nothing+  where+    path = entryPosixPath entry+ -- | Where an entry sits in its archive, written the way a tar file writes -- it. entryPosixPath :: Tar.Entry -> FilePath@@ -62,58 +67,3 @@ cabalFileAtTop path = ".cabal" `isSuffixOf` path && depth path == 2   where     depth = (1 +) . length . filter (== '/')---- | Every module a package holds, whether it exposes it or not.-containedModules :: Text -> [Text]-containedModules t =-  modulesUnder "exposed-modules" t <> modulesUnder "other-modules" t-  where-    modulesUnder field =-      concatMap moduleNames . fieldsNamed field . T.lines-      where-        moduleNames = filter looksLikeModule . fieldWords-        looksLikeModule m = case T.uncons m of-          Just (c, _) -> c `elem` ['A' .. 'Z']-          Nothing -> False---- | Every directory a @.cabal@ file's modules could be under.-sourceDirs :: Text -> [Text]-sourceDirs contents = Data.List.nub (named <> ["."])-  where-    named = concatMap fieldWords (fieldsNamed "hs-source-dirs" (T.lines contents))---- | The extensions a package puts in force, read from its @.cabal@ file.-declaredExtensions :: Text -> [Extension]-declaredExtensions contents =-  foldl applyExtensionName baseline named-  where-    ls = T.lines contents-    baseline =-      case mapMaybe lookupEdition (fieldsNamed "default-language" ls) of-        [] -> GHC.languageExtensions (Just GHC.Haskell98)-        editions ->-          Data.List.nub (concatMap (GHC.languageExtensions . Just) editions)-    named =-      concatMap fieldWords $-        fieldsNamed "extensions" ls <> fieldsNamed "default-extensions" ls---- | The values of every field with the given name, wherever it appears and--- however deeply it is nested.-fieldsNamed :: Text -> [Text] -> [Text]-fieldsNamed name = go . filter (not . commented)-  where-    commented = T.isPrefixOf "--" . T.stripStart-    go = \case-      [] -> []-      (l : ls)-        | Just value <- fieldValue l ->-            let (continued, rest) = span (deeperThan (indentOf l)) ls-             in T.unwords (value : fmap T.strip continued) : go rest-        | otherwise -> go ls-    fieldValue l =-      let (key, rest) = T.break (== ':') l-       in if T.toLower (T.strip key) == name && not (T.null rest)-            then Just (T.strip (T.drop 1 rest))-            else Nothing-    deeperThan n l = T.null (T.strip l) || indentOf l > n-    indentOf = T.length . T.takeWhile isSpace

@@ -39,14 +39,12 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T-import Data.Text.IO qualified as T import Data.Time (UTCTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.Format.ISO8601 (iso8601ParseM, iso8601Show) import System.Directory   ( XdgDirectory (XdgCache),     createDirectoryIfMissing,-    doesFileExist,     getModificationTime,     getXdgDirectory,     renameFile,@@ -54,7 +52,7 @@ import System.FilePath (takeDirectory, (</>)) import Tilia.Fixity import Tilia.Fixity.PackageDb (Installed (..), InstalledPackage (..))-import Tilia.Utils (quietly)+import Tilia.Utils (quietly, readUtf8File, tshow, writeUtf8File)  -- | Where cached answers are kept together with a token unique to this -- build plan and environment, or nowhere, in which case nothing is@@ -75,7 +73,7 @@  -- | Bumped whenever cache format changes. formatVersion :: FilePath-formatVersion = "v2"+formatVersion = "v3"  -- | Open, creating the directory if need be. --@@ -471,7 +469,7 @@   [ op,     renderNamespace namespace,     renderDirection direction,-    T.pack (show precedence)+    tshow precedence   ]   where     renderDirection = \case@@ -591,9 +589,7 @@ readIfPresent :: Maybe FilePath -> (Text -> a) -> IO (Maybe a) readIfPresent place parse = case place of   Nothing -> pure Nothing-  Just path -> quietly Nothing $ do-    there <- doesFileExist path-    if there then Just . parse <$> T.readFile path else pure Nothing+  Just path -> fmap parse <$> readUtf8File path  -- | Write via a temporary file and a rename, making the directory if need -- be.@@ -603,5 +599,5 @@   Just path -> quietly () $ do     createDirectoryIfMissing True (takeDirectory path)     let temporary = path <> ".tmp"-    T.writeFile temporary contents+    writeUtf8File temporary contents     renameFile temporary path

@@ -4,9 +4,7 @@  -- | An account of how a module's fixities were determined. module Tilia.Fixity.Debug-  ( FixityNotes (..),-    ImportNote (..),-    OperatorNote (..),+  ( FixityNotes,     fixityNotes,     renderFixityNotes,   )@@ -30,12 +28,11 @@     Provenance (..),     Resolution (..),     Scope (..),+    disagreement,     lookupFixity,     moduleImports,     operatorSpelling,     operatorsUsed,-    reachAmbiguous,-    reachIn,     reachUnqualified,     spellDisagreement,     spellFixity,@@ -44,7 +41,7 @@   ) import Tilia.Palette (Color (Operator, Place), Palette, paint) import Tilia.Parser (ParsedModule (..))-import Tilia.Utils (indent, lineWidth, wrapTo)+import Tilia.Utils (indent, tshow, wrappedUnder)  -- | Everything that decided one module's fixities. data FixityNotes = FixityNotes@@ -153,8 +150,7 @@       OperatorNote         { noteSpelling = operatorSpelling qualifier op,           noteResolution = lookupFixity scope namespace qualifier op,-          noteDisagreement =-            Map.lookup (qualifier, op) (reachAmbiguous (reachIn namespace scope))+          noteDisagreement = disagreement scope namespace qualifier op         }  -- | Set out all the 'FixityNotes' per file.@@ -180,9 +176,7 @@       | otherwise = heading what : concatMap (entry . render) items     heading what = indent 2 <> "· " <> what -    entry line = case wrapTo (lineWidth - 8) line of-      [] -> []-      (opening : rest) -> (indent 3 <> "· " <> opening) : fmap (indent 4 <>) rest+    entry = wrappedUnder 4 (indent 3 <> "· ")      fromImport i =       named (noteModule i)@@ -223,7 +217,7 @@       DeclaredHere -> "declared in this module"       DeclaredIn m -> "declared in " <> named m       BuiltIn -> "built into the language"-      ReportDefault -> "the Report's default, nothing in scope declaring it"+      ReportDefault -> "the Report's default"      ambiguously o = case noteDisagreement o of       Nothing -> ""@@ -235,4 +229,4 @@      operators = \case       1 -> "1 operator"-      n -> T.pack (show n) <> " operators"+      n -> tshow n <> " operators"

@@ -35,6 +35,7 @@ import Tilia.Fixity.KnownKeys.Ghc910 qualified as Ghc910 import Tilia.Fixity.KnownKeys.Ghc912 qualified as Ghc912 import Tilia.Fixity.KnownKeys.Ghc914 qualified as Ghc914+import Tilia.Utils (tshow)  -- | What an interface file says about the operators its module offers. data HiFile = HiFile@@ -88,7 +89,7 @@ hiFile :: Get HiFile hiFile = do   magic <- word32be-  unless (magic == 0x1face64) (failure ("not a 64-bit interface file: " <> T.pack (show magic)))+  unless (magic == 0x1face64) (failure ("not a 64-bit interface file: " <> tshow magic))   version <- string   series <- case take 3 version of     "910" -> pure Series910@@ -200,7 +201,7 @@       2 -> pure InTypes       3 -> pure InTypes       4 -> InTerms <$ uleb-      b -> failure ("unknown namespace " <> T.pack (show b))+      b -> failure ("unknown namespace " <> tshow b)   s <- uleb   pure (namespace, s) 

@@ -12,12 +12,11 @@ where  import Control.DeepSeq (NFData)-import Control.Monad ((<=<)) import Data.ByteString qualified as BS import Data.Char (isUpper) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map-import Data.Maybe (isNothing, mapMaybe, maybeToList)+import Data.Maybe (isNothing, mapMaybe) import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text)@@ -26,15 +25,16 @@ import Tilia.Fixity import Tilia.Fixity.HiFile (HiExport (..), HiFile (..), HiName (..), decodeHiFile) import Tilia.Process (readProgramOutput)-import Tilia.Utils (quietly)+import Tilia.Utils (blocksOf, indented, quietly)  -- | What an interface says about the operators a module offers. data Interface = Interface   { -- | The fixities the module declares itself for the names it exports,     -- by the namespace each governs.     interfaceDeclares :: Fixities,-    -- | The names it reexports, each with the source module.-    interfaceReexports :: [(Text, OpName)],+    -- | The names it reexports, each with the source module and the+    -- namespace it is exported in.+    interfaceReexports :: [(Text, Namespace, OpName)],     -- | The members it exports with each name, which is what @T(..)@ in an     -- import list stands for.     interfaceMembers :: Map OpName (Set OpName),@@ -58,8 +58,8 @@   IO (Maybe Interface) readInterface modName path =   quietly Nothing $-    (fromHiFile modName <=< decodeHiFile) <$> BS.readFile path >>= \case-      Right interface -> pure (Just interface)+    decodeHiFile <$> BS.readFile path >>= \case+      Right hi -> pure (either (const Nothing) Just (fromHiFile modName hi))       Left _ ->         readProgramOutput "ghc" ["--show-iface", path] >>= \case           Nothing -> pure Nothing@@ -79,8 +79,8 @@                   Set.member (namespace, op) exportedHere                 ],             interfaceReexports =-              [ (m, op)-              | (Just m, _, op) <- concatMap mentioned hiExports,+              [ (m, namespace, op)+              | HiName m namespace op <- concatMap exportedNames hiExports,                 m /= hiModule               ],             interfaceMembers = Map.map (Set.map snd) members,@@ -92,7 +92,7 @@                   }           }   where-    exported = concatMap exportedNames hiExports+    exported = mapMaybe known (concatMap exportedNames hiExports)     exportedHere =       Set.fromList [(namespace, op) | (_, namespace, op) <- exported]     members =@@ -104,11 +104,8 @@           let kids = filter (/= parent) (mapMaybe known ns)         ]     exportedNames = \case-      Avail n -> maybeToList (known n)-      AvailTC _ ns -> mapMaybe known ns-    mentioned = \case-      Avail n -> maybeToList (known n)-      AvailTC p ns -> maybeToList (known p) <> mapMaybe known ns+      Avail n -> [n]+      AvailTC _ ns -> ns     known = \case       HiName m namespace op -> Just (Just m, namespace, op)       BuiltInSyntax namespace op -> Just (Nothing, namespace, op)@@ -128,7 +125,11 @@                     fixities                     (foldMap ownExports (sectionsNamed "exports:"))                 ),-            interfaceReexports = concatMap reexports (sectionsNamed "exports:"),+            interfaceReexports =+              [ (m, namespace, op)+              | (m, op) <- concatMap reexports (sectionsNamed "exports:"),+                namespace <- [InTypes, InTerms]+              ],             interfaceMembers =               Map.unionsWith Set.union (fmap membersIn (sectionsNamed "exports:")),             interfaceExports = Nothing@@ -137,26 +138,27 @@     holdsModule l = case T.words l of       ("interface" : m : _) -> m == modName       _ -> False-    sectionsNamed name =-      [ T.replace "|{" "{" body-      | (heading, body) <- sections out,-        heading == name-      ]+    sectionsNamed name = [body | (heading, body) <- sections out, heading == name]     fixities = Map.fromList (concatMap declared (sectionsNamed "fixities"))     declared = mapMaybe fixityEntry . T.splitOn ","     ownExports section =       Set.fromList-        [ OpName name-        | (parent, kids) <- exportEntries section,-          name <- parent : kids,-          isNothing (moduleOf name)-        ]-    reexports = concatMap reexportsIn . T.words+        [OpName name | name <- exportedIn section, isNothing (moduleOf name)]+    reexports section =+      [ (m, OpName name)+      | Just (m, name) <- fmap moduleOf (exportedIn section),+        not (T.null name)+      ]+    exportedIn section =+      [ name+      | (parent, parentExported, kids) <- exportEntries section,+        name <- [parent | parentExported] <> kids+      ]     membersIn section =       Map.fromListWith         Set.union         [ (nameOnly parent, Set.fromList (fmap nameOnly kids))-        | (parent, kids@(_ : _)) <- exportEntries section+        | (parent, _, kids@(_ : _)) <- exportEntries section         ]  -- | The names an interface declares as types.@@ -170,8 +172,6 @@       keyword `elem` (["data", "type", "newtype", "class"] :: [Text]),       name <- take 1 (dropWhile (`elem` (["family", "role", "instance"] :: [Text])) rest)     ]-  where-    indented l = maybe False (== ' ') (fst <$> T.uncons l)  -- | Sort declared fixities into the namespaces they govern. namespaced :: Set OpName -> Map OpName Fixity -> Fixities@@ -184,17 +184,11 @@  -- | Split the output into sections. sections :: Text -> [(Text, Text)]-sections = go . T.lines-  where-    go = \case-      [] -> []-      (l : ls)-        | indented l -> go ls-        | otherwise ->-            let (body, rest) = span indented ls-                (heading, opening) = T.breakOn " " l-             in (heading, T.unwords (opening : body)) : go rest-    indented l = maybe False (== ' ') (fst <$> T.uncons l)+sections out =+  [ (heading, T.unwords (opening : body))+  | (l, body) <- blocksOf (T.lines out),+    let (heading, opening) = T.breakOn " " l+  ]  -- | One entry of a @fixities@ line: @infixl 9 !@ and the like. fixityEntry :: Text -> Maybe (OpName, Fixity)@@ -210,8 +204,10 @@   _ -> Nothing  -- | Split an exports section into its entries, keeping the members an entry--- wears in braces with the name they belong to.-exportEntries :: Text -> [(Text, [Text])]+-- wears in braces with the name they belong to, and whether that name is+-- exported itself, which a bar before the braces, as in @T|{...}@, says it+-- is not.+exportEntries :: Text -> [(Text, Bool, [Text])] exportEntries = go   where     go text = case T.uncons (T.dropWhile (== ' ') text) of@@ -222,22 +218,16 @@          in case T.uncons rest of               Just ('{', inside) ->                 let (kids, after) = T.break (== '}') inside-                 in (bare name, T.words kids) : go (T.drop 1 after)-              _ -> (bare name, []) : go rest+                    entry = case T.unsnoc (bare name) of+                      Just (parent, '|') -> (parent, False, T.words kids)+                      _ -> (bare name, True, T.words kids)+                 in entry : go (T.drop 1 after)+              _ -> (bare name, True, []) : go rest     bare = T.dropWhileEnd (== ',')  -- | An exported name without the module that declared it. nameOnly :: Text -> OpName nameOnly t = OpName (maybe t snd (moduleOf t))---- | The names an export entry reexports, with the module that declared--- each.-reexportsIn :: Text -> [(Text, OpName)]-reexportsIn = mapMaybe qualified . T.split (`elem` ("{}," :: String))-  where-    qualified name = case moduleOf name of-      Just (m, n) | not (T.null n) -> Just (m, OpName n)-      _ -> Nothing  -- | Split a name into the module that declared it and the name itself. moduleOf :: Text -> Maybe (Text, Text)

@@ -13,7 +13,6 @@ where  import Control.Monad (filterM)-import Data.Char (isSpace) import Data.List (nub) import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe)@@ -22,7 +21,7 @@ import System.Directory (doesDirectoryExist, findExecutable) import System.FilePath ((</>)) import Tilia.Process (readProgramOutput)-import Tilia.Utils (fieldWords, quietly)+import Tilia.Utils (blocksOf, fieldWords, looksLikeModule, quietly)  -- | An installed package. data InstalledPackage = InstalledPackage@@ -137,9 +136,6 @@       (m : rest) | looksLikeModule m -> m : go rest       (_ : rest) -> go rest       [] -> []-    looksLikeModule m = case T.uncons m of-      Just (c, _) -> c `elem` ['A' .. 'Z'] && not (T.any (== ':') m)-      Nothing -> False  -- | The modules an @exposed-modules@ field names that another package -- holds, each with its name there.@@ -154,19 +150,9 @@  -- | Split a record into its fields. parseFields :: Text -> Map.Map Text Text-parseFields = Map.fromList . mapMaybe field . groups . T.lines+parseFields = Map.fromList . mapMaybe field . blocksOf . T.lines   where-    groups = \case-      [] -> []-      (l : ls)-        | isContinuation l -> groups ls-        | otherwise ->-            let (continued, rest) = span isContinuation ls-             in (l : continued) : groups rest-    isContinuation l = not (T.null l) && isSpace (T.head l)--    field [] = Nothing-    field (l : rest) = case T.breakOn ":" l of+    field (l, rest) = case T.breakOn ":" l of       (key, value)         | not (T.null value) ->             Just (T.strip key, T.unwords (T.drop 1 value : fmap T.strip rest))

@@ -20,15 +20,13 @@ where  import Control.Applicative ((<|>))-import Control.Concurrent (getNumCapabilities)+import Control.Concurrent (MVar, getNumCapabilities) import Control.Concurrent.QSem (newQSem, signalQSem, waitQSem) import Control.DeepSeq (force) import Control.Exception (bracket_, evaluate) import Control.Monad (filterM, join)-import Crypto.Hash.SHA256 qualified as SHA256-import Data.ByteString.Base16 qualified as B16-import Data.ByteString.Lazy qualified as BL import Data.Choice (Choice, fromBool, pattern Do)+import Data.Containers.ListUtils (nubOrd) import Data.Foldable (toList) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as NE@@ -39,28 +37,33 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T-import Data.Text.Encoding qualified as T import GHC.Hs (HsModule) import GHC.Hs.Extension (GhcPs) import GHC.LanguageExtensions.Type (Extension (ImplicitPrelude)) import System.Directory (doesFileExist) import System.FilePath ((</>))-import Tilia.Cabal.Package (PackageReader, declaredModules, newPackageReader, readPackageDescription)+import Tilia.Cabal.Package+  ( PackageReader,+    declaredModules,+    newPackageReader,+    packageExtensions,+    readPackageDescription,+  ) import Tilia.Cabal.Plan import Tilia.Cabal.Project (cabalFilesIn) import Tilia.Cpp.Directives (branchLeaves, withoutRuledOut) import Tilia.Cpp.Macros (Macros (..)) import Tilia.Fixity import Tilia.Fixity.Archive (Archive (..), InArchive (..), moduleEndings, moduleIn, pathOfModule, readArchive, writtenForHsc)-import Tilia.Fixity.Cabal (declaredExtensions, packageModules)+import Tilia.Fixity.Cabal (packageModules) import Tilia.Fixity.Cache import Tilia.Fixity.HiFile (HiFile, primopFixities) import Tilia.Fixity.Interface import Tilia.Fixity.PackageDb-import Tilia.Memo (memoized, newFlights, newMemo)+import Tilia.Memo (Flights, memoized, newFlights, newMemo) import Tilia.Parser-import Tilia.Pragma (effectiveExtensions)-import Tilia.Utils (byteOrderMark, inParallel, quietly, readFileText, sha256Of)+import Tilia.Pragma (Defaults, effectiveExtensions)+import Tilia.Utils (byteOrderMark, inParallel, quietly, readUtf8File, sha256Of, sha256OfFile, tshow)  ---------------------------------------------------------------------------- -- Resolving@@ -93,7 +96,7 @@   BuildPlan ->   IO Resolver newResolver plan = do-  packageReader <- newPackageReader (plannedCompiler plan)+  packageReader <- newPackageReader (plannedCompiler plan) []   newResolverVia (Do #useCache) [FromInterface, FromSource] packageReader plan  -- | 'newResolver', restricted to the routes given.@@ -140,17 +143,13 @@   answersRead <- newMemo   extensionsRead <- newMemo   archivesRead <- newMemo-  interfacesRead <- newMemo   reading <- newQSem =<< getNumCapabilities-  let interfaceOf modName =-        memoized flights interfacesRead Nothing modName $-          case Map.lookup modName primopFixities of-            Just declared -> pure (Just (asInterface declared))-            Nothing -> case Map.lookup modName interfaces of-              Nothing -> pure Nothing-              Just (_, path) ->-                bracket_ (waitQSem reading) (signalQSem reading) $-                  readInterface modName path+  interfaceOf <- interfaceMemo flights $ \modName ->+    case Map.lookup modName interfaces of+      Nothing -> pure Nothing+      Just (_, path) ->+        bracket_ (waitQSem reading) (signalQSem reading) $+          readInterface modName path   let workings =         Workings           { wkRoutes = routes,@@ -184,7 +183,7 @@                     configurationsOf (macrosOf plan) extensions modName text                 stamp =                   digestOf . T.intercalate "\n" $-                    [T.pack (show extensions), macrosRead, text]+                    [tshow extensions, macrosRead, text]             case digestOf . T.pack <$> Map.lookup modName local of               Nothing -> summarized               Just key ->@@ -193,19 +192,35 @@                     (cachedSummaries cache key stamp)                     (storeSummaries cache key stamp)                     (Just <$> summarized)-      macrosRead = T.pack (show (macrosOf plan))+      macrosRead = tshow (macrosOf plan)       extensionsOf modName         | Just path <- Map.lookup modName local =             either (const Nothing) Just <$> packageReader path         | Just (package, tarball) <- Map.lookup modName index =             memoized flights extensionsRead Nothing package $-              fmap declaredExtensions . (archiveCabal =<<) <$> archiveOf tarball+              fmap packageExtensions . (archiveCabal =<<) <$> archiveOf tarball         | otherwise = pure Nothing       archiveOf tarball =         memoized flights archivesRead Nothing (T.pack tarball) (readArchive tarball)       moduleInArchive tarball modName = (moduleIn modName =<<) <$> archiveOf tarball   pure Resolver{askModule = reach Set.empty} +-- | A module's interface, read once, with the primops' fixities standing+-- in for that of @GHC.Prim@, which has no file.+interfaceMemo ::+  -- | Who is working out what, across the resolver's tables.+  MVar Flights ->+  -- | How to read a module's interface.+  (Text -> IO (Maybe Interface)) ->+  IO (Text -> IO (Maybe Interface))+interfaceMemo flights read' = do+  interfacesRead <- newMemo+  pure $ \modName ->+    memoized flights interfacesRead Nothing modName $+      case Map.lookup modName primopFixities of+        Just declared -> pure (Just (asInterface declared))+        Nothing -> read' modName+ -- | A 'Resolver' that reads every module out of the interface given for it, -- for a program that has compiled the project and holds its interfaces. newResolverFrom ::@@ -214,15 +229,9 @@   IO Resolver newResolverFrom given = do   flights <- newFlights-  interfacesRead <- newMemo   answersRead <- newMemo-  let interfaceOf modName =-        memoized flights interfacesRead Nothing modName $-          case Map.lookup modName primopFixities of-            Just declared -> pure (Just (asInterface declared))-            Nothing ->-              (either (const Nothing) Just . fromHiFile modName =<<)-                <$> given modName+  interfaceOf <- interfaceMemo flights $ \modName ->+    (either (const Nothing) Just . fromHiFile modName =<<) <$> given modName   pure     Resolver       { askModule = \modName ->@@ -329,7 +338,7 @@       writtenForHsc path =         pure mempty     | Just path <- Map.lookup modName wkLocal =-        readFileText path >>= \case+        readUtf8File path >>= \case           Nothing -> pure unreadable           Just source ->             fromSummaries (wkReach visiting') modName@@ -407,11 +416,8 @@     one (p, tarball) = do       let key = cacheKey p       let exposed = Map.lookup (ppName p, ppVersion p) byNameVersion-      held <- fromCabalFile cache key tarball p-      let modules = case (exposed, held) of-            (Nothing, Nothing) -> []-            (a, b) -> concat (catMaybes [a, b])-      pure [(m, (key, tarball)) | m <- modules]+      held <- fromCabalFile cache tarball p+      pure [(m, (key, tarball)) | m <- concat (catMaybes [exposed, held])]  -- | Where each installed module's compiled interface is. interfaceIndex :: [InstalledPackage] -> Map Text (Text, FilePath)@@ -458,23 +464,23 @@       declarers <-         inParallel           asked-          (distinct (fmap fst (interfaceReexports iface)))+          (distinct [m | (m, _, _) <- interfaceReexports iface])       let declarer m = join (lookup m declarers)       pure         Established           { establishedFixities =-              Map.union (interfaceDeclares iface) . Map.unions $-                [ Map.filterWithKey-                    (\(_, o) _ -> o == op)-                    (interfaceDeclares declared)-                | (m, op) <- interfaceReexports iface,-                  Just declared <- [declarer m]+              Map.union (interfaceDeclares iface) . Map.fromList $+                [ ((namespace, op), fixity)+                | (m, namespace, op) <- interfaceReexports iface,+                  Just declared <- [declarer m],+                  Just fixity <-+                    [Map.lookup (namespace, op) (interfaceDeclares declared)]                 ],             establishedUnsettled =               Map.fromListWith                 Set.union-                [ ([m], Set.fromList [(InTypes, op), (InTerms, op)])-                | (m, op) <- interfaceReexports iface,+                [ ([m], Set.singleton (namespace, op))+                | (m, namespace, op) <- interfaceReexports iface,                   Nothing <- [declarer m]                 ],             establishedUntold = Set.empty,@@ -491,9 +497,6 @@ fromCabalFile ::   -- | Where to remember the answer.   Cache ->-  -- | What to file it under. Carries the hash the tarball was verified-  -- against, so a changed tarball misses rather than matching stale data.-  Text ->   -- | The tarball to read the @.cabal@ file out of.   FilePath ->   -- | The package it belongs to, consulted for the hash to verify against.@@ -501,11 +504,13 @@   -- | The modules it holds, or 'Nothing' if the tarball is absent, fails   -- verification, or holds no @.cabal@ file.   IO (Maybe [Text])-fromCabalFile cache key tarball p =+fromCabalFile cache tarball p =   recalled (cachedModules cache key) (storeModules cache key) $     verified p tarball >>= \case       False -> pure Nothing       True -> packageModules tarball+  where+    key = cacheKey p  -- | Does the tarball hash to what the plan says it should? verified :: PlanPackage -> FilePath -> IO Bool@@ -516,12 +521,6 @@       actual <- sha256OfFile tarball       pure (actual == T.toLower expected) --- | The SHA-256 of a file, as lower-case hex.-sha256OfFile :: FilePath -> IO Text-sha256OfFile path = do-  bytes <- BL.readFile path-  pure (T.decodeUtf8Lenient (B16.encode (SHA256.hashlazy bytes)))- -- | Read what a module exports out of a tarball, following re-exports. fromSource ::   -- | What a tarball holds for a module.@@ -622,7 +621,7 @@ -- | Where each module that lives in a directory rather than an archive is. localModules :: BuildPlan -> IO (Map Text FilePath) localModules plan =-  Map.unions <$> traverse forPackage (concatMap directoryOf (bpPackages plan))+  Map.unions <$> traverse forPackage (nubOrd (concatMap directoryOf (bpPackages plan)))   where     directoryOf p = case ppSource p of       LocalPackage dir -> [dir]@@ -919,8 +918,8 @@ configurationsOf ::   -- | What the plan settles about the questions its conditionals ask.   Macros ->-  -- | What extensions the module's package puts in force.-  [Extension] ->+  -- | What the module's package puts in force.+  Defaults ->   -- | The module's name, for the parser to put in its errors.   Text ->   -- | Its text.@@ -937,6 +936,6 @@     named = T.unpack modName  -- | Does this module see the Prelude without importing it?-hasImplicitPrelude :: [Extension] -> Text -> Choice "implicitPrelude"+hasImplicitPrelude :: Defaults -> Text -> Choice "implicitPrelude" hasImplicitPrelude extensions source =   fromBool (ImplicitPrelude `elem` effectiveExtensions extensions source)

@@ -34,6 +34,7 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Version (Version, versionBranch)+import GHC.Driver.Session (OnOff (..)) import GHC.LanguageExtensions.Type (Extension (ImplicitPrelude)) import Tilia.Cabal.Package   ( PackageProblem (..),@@ -51,6 +52,7 @@     versionMacros,   ) import Tilia.Cabal.Project (ProjectRoot (..), findProjectRoot)+import Tilia.Cabal.Target (packageFilesOf) import Tilia.Cpp   ( CppError (..),     correspondingBranches,@@ -90,7 +92,7 @@     pmGathered,     pmModule,   )-import Tilia.Pragma (effectiveExtensions, movesPositions)+import Tilia.Pragma (defaultsOf, effectiveExtensions, movesPositions) import Tilia.Render (RenderConfig (..), defaultRenderConfig, renderModule) import Tilia.Utils (collected, spellList, tshow) @@ -117,6 +119,8 @@     NotEquivalent FilePath Text   | -- | Formatting is not idempotent.     NotIdempotent FilePath Text+  | -- | Formatting the file threw an exception, shown.+    Threw FilePath Text  -- | Say what went wrong. describeFormatError :: Palette -> FormatError -> Text@@ -132,7 +136,10 @@       <> describePackageProblem problem   NotParsed e -> "cannot parse " <> located (describeParseError e)   PositionPragmas path ->-    "will not format " <> file path <> ": it uses {-# LINE #-} pragmas, and no reformatting can leave those true"+    "will not format "+      <> file path+      <> ": it uses {-# LINE #-} or {-# COLUMN #-} pragmas, and no"+      <> " reformatting can leave those true"   CppUnsupported path why ->     "will not format " <> file path <> ": " <> describeCppError why   Unreadable path why -> "cannot read " <> file path <> ": " <> why@@ -140,6 +147,8 @@     "formatting " <> file path <> " changed the program: " <> why   NotIdempotent path why ->     "formatting " <> file path <> " is not idempotent: " <> why+  Threw path why ->+    "formatting " <> file path <> " threw an exception: " <> why   UnknownFixity path unknown ->     "will not format "       <> file path@@ -180,6 +189,7 @@   Unreadable{} -> 16   NotEquivalent{} -> 17   NotIdempotent{} -> 18+  Threw{} -> 19   CppUnsupported _ why -> case why of     MalformedConditional{} -> 9     TooManyConfigurations -> 10@@ -200,14 +210,11 @@   Unreadable{} -> False   NotEquivalent{} -> False   NotIdempotent{} -> False+  Threw{} -> False   NoProject{} -> False   NoBuildPlan{} -> False  -- | What a run works out once and then uses for every file.------ Finding the project, solving its build plan and building a resolver cost--- about as much as formatting a small file, and none of it depends on which--- file is being formatted. data Session = Session   { -- | The project.     sessionRoot :: ProjectRoot,@@ -222,9 +229,8 @@     sessionCheckAst :: Choice "checkAst",     -- | Whether to check idempotence.     sessionCheckIdempotence :: Choice "checkIdempotence",-    -- | An account of how each file's fixities were determined. 'Nothing'-    -- when this information was not requested, which is what keeps an-    -- ordinary run from doing any of the work.+    -- | An account of how each file's fixities were determined, or 'Nothing'+    -- where none was asked for.     sessionFixityNotes :: Maybe (IORef (Map FilePath FixityNotes))   } @@ -267,7 +273,8 @@           then [FromInterface, FromSource] <$ liftIO (fetchUninstalled caching root plan)           else pure [FromInterface]       pure (plan, routes)-  packageReader <- liftIO (newPackageReader (plannedCompiler plan))+  packages <- liftIO (packageFilesOf project)+  packageReader <- liftIO (newPackageReader (plannedCompiler plan) packages)   resolver <- liftIO (newResolverVia caching routes packageReader plan)   notes <-     if isTrue debugFixity@@ -288,7 +295,9 @@ -- otherwise works out with Cabal, the package database, and the sources of -- dependencies. data Compiled = Compiled-  { -- | The extensions the component puts in force.+  { -- | The extensions the component puts in force, which an edition a+    -- module names adds to, as which of them its own edition brought is not+    -- known.     compiledExtensions :: [Extension],     -- | The version of the compiler.     compiledWith :: Version,@@ -322,7 +331,8 @@           versionMacros             (Just (numbers compiledWith))             (fmap numbers compiledPackages),-        sessionPackage = \_ -> pure (Right compiledExtensions),+        sessionPackage =+          \_ -> pure (Right (defaultsOf [] (On <$> compiledExtensions))),         sessionCheckAst = checkAst,         sessionCheckIdempotence = checkIdempotence,         sessionFixityNotes = Nothing@@ -330,10 +340,8 @@   where     numbers = fmap toInteger . versionBranch --- | What the run made of every file's operators, by file.------ Empty unless the session was asked to keep an account of it. Nothing here--- is rendered; 'Tilia.Fixity.Debug.renderFixityNotes' does that.+-- | What the run made of every file's operators, by file, empty unless the+-- session keeps an account of it. fixityNotesOf :: Session -> IO (Map FilePath FixityNotes) fixityNotesOf session = case sessionFixityNotes session of   Nothing -> pure Map.empty

@@ -7,11 +7,11 @@     parseIgnoreFile,     isIgnored,     isIgnoredInProject,-    ignoreFilesAbove,-    belowRoot,+    withoutIgnored,   ) where +import Data.ByteString qualified as BS import Data.Char   ( isAlpha,     isAlphaNum,@@ -25,17 +25,17 @@     isSymbol,     isUpper,   )-import Data.List (inits, isPrefixOf, isSuffixOf, stripPrefix, tails)+import Data.List (inits, isPrefixOf, isSuffixOf, tails) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe) import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T-import Data.Text.IO qualified as T+import Data.Text.Encoding qualified as T import System.Directory (canonicalizePath, doesFileExist)-import System.FilePath (joinPath, normalise, splitDirectories, (</>))-import Tilia.Utils (quietly)+import System.FilePath (joinPath, (</>))+import Tilia.Utils (pathUnder, quietly)  -- | The patterns of one ignore file, in the order they are written. newtype IgnoreFile = IgnoreFile [Pattern]@@ -257,12 +257,26 @@   IO Bool isIgnoredInProject root path = quietly False $ do   file <- canonicalizePath path-  case belowRoot root file of-    Nothing -> pure False-    Just below -> do-      ignoreFiles <- ignoreFilesAbove root [below]-      pure (isIgnored ignoreFiles below)+  null <$> withoutIgnored root [file] +-- | The files the @.tiliaignore@ files of a project do not ignore, in the+-- order given.+withoutIgnored ::+  -- | The project root, canonical.+  FilePath ->+  -- | The files, canonical.+  [FilePath] ->+  IO [FilePath]+withoutIgnored root files = do+  ignoreFiles <- ignoreFilesAbove root (Map.elems below)+  pure+    [ file+    | file <- files,+      maybe True (not . isIgnored ignoreFiles) (Map.lookup file below)+    ]+  where+    below = Map.fromList [(file, b) | file <- files, Just b <- [pathUnder root file]]+ -- | The @.tiliaignore@ files in the project root and in every directory -- between it and the given files, each by its directory's segments relative -- to the root.@@ -276,15 +290,7 @@       let file = joinPath (root : directory) </> ".tiliaignore"       exists <- doesFileExist file       if exists-        then (\t -> [(directory, parseIgnoreFile t)]) <$> T.readFile file+        then do+          bytes <- BS.readFile file+          pure [(directory, parseIgnoreFile (T.decodeUtf8Lenient bytes))]         else pure []---- | A path's segments relative to the project root, if it is under it.-belowRoot ::-  -- | The project root.-  FilePath ->-  -- | The path.-  FilePath ->-  Maybe [FilePath]-belowRoot root path =-  stripPrefix (splitDirectories root) (splitDirectories (normalise path))

@@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-}  -- | Putting a module's imports in order.

@@ -5,6 +5,7 @@ -- | Turning source text into a syntax tree and a comment stream. module Tilia.Parser   ( ParsedModule (..),+    writtenInHeader,     parseModule,     parseConfiguration,     readAlike,@@ -19,16 +20,15 @@ import Data.Foldable (toList) import Data.IntMap.Strict (IntMap) import Data.IntMap.Strict qualified as IntMap-import Data.List (isSuffixOf, nub, sortOn)-import Data.Maybe (listToMaybe, mapMaybe)+import Data.List (isSuffixOf, sortOn)+import Data.Maybe (catMaybes, listToMaybe) import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as T import GHC.Data.EnumSet qualified as EnumSet import GHC.Data.FastString (mkFastString) import GHC.Data.StringBuffer qualified as GHC-import GHC.Driver.Session qualified as GHC-import GHC.Hs (HsModule (..))+import GHC.Hs (AnnsModule (..), EpAnn (anns), HsModule (..), XModulePs (..)) import GHC.Hs.Extension (GhcPs) import GHC.LanguageExtensions.Type (Extension) import GHC.Parser qualified as GHC@@ -39,7 +39,7 @@ import GHC.Utils.Error qualified as GHC import GHC.Utils.Outputable qualified as GHC import Tilia.Gathered (Gathered (..), gathered)-import Tilia.Pragma (effectiveExtensions)+import Tilia.Pragma (Defaults, effectiveExtensions) import Tilia.Source (Lines, Source, SourceType (..), Written (..), lineTexts, linesOf, sourceOf) import Tilia.Span (Span (..), startPoint) import Tilia.Span.Ghc (spanOf)@@ -59,8 +59,8 @@     -- The lexer skips a @#!@ line, which puts it in no annotation and no     -- node, so nothing downstream could put it back.     pmPrologue :: [Text],-    -- | Where the file header stops and the module proper begins, if the-    -- module has anything after its header.+    -- | Where the file header stops: at the @module@ line, or where a+    -- module without one begins, if it has anything but a header.     --     -- GHC reads pragmas from the header and nowhere else, so this is the     -- line that decides whether a @{-# … #-}@ is a pragma at all. One@@ -69,11 +69,18 @@     pmHeaderEnd :: Maybe Span   } +-- | Was something that begins here written in the header, before what+-- 'pmHeaderEnd' marks?+writtenInHeader :: Maybe Span -> Span -> Bool+writtenInHeader headerEnd s =+  maybe True ((startPoint s <) . startPoint) headerEnd+ -- | Parse a module. parseModule ::   -- | Parser config.   ParserConfig ->-  -- | Path, used only in positions reported back.+  -- | Path, reported back in positions, whose extension tells a signature+  -- from a module.   FilePath ->   -- | The source.   Text ->@@ -84,7 +91,8 @@ -- | Parse one configuration of a module. parseConfiguration ::   ParserConfig ->-  -- | Path, used only in positions reported back.+  -- | Path, reported back in positions, whose extension tells a signature+  -- from a module.   FilePath ->   -- | The lines of the module as written, except for the lines that do not   -- belong to this configuration.@@ -138,8 +146,9 @@         . GHC.diagnosticMessage GHC.NoDiagnosticOpts         . GHC.errMsgDiagnostic --- | Return each line a token other than a comment begins on, and whether--- the leftmost such token on the line begins an item of the top level.+-- | Return each line a token other than a comment begins on, down to the+-- first item of the top level after the imports, and whether the leftmost+-- such token on the line begins an item of the top level. -- 'Nothing' if the module has no imports, writes its top level in explicit -- braces, or does not lex. importLayout ::@@ -223,41 +232,22 @@ stateFor :: ParserConfig -> FilePath -> Text -> GHC.PState stateFor config path source =   GHC.initParserState-    (parserOpts config')+    (parserOpts (effectiveExtensions (pcDefaults config) source))     (GHC.stringBufferFromByteString (T.encodeUtf8 source))     (GHC.mkRealSrcLoc (mkFastString path) 1 1)-  where-    config' =-      config-        { pcExtensions = withImplied (effectiveExtensions (pcExtensions config) source)-        }  -- | Would the parser read these two texts with the same extensions? readAlike :: ParserConfig -> Text -> Text -> Bool readAlike config a b = bits a == bits b   where-    bits t =-      GHC.pExtsBitmap-        ( parserOpts-            config-              { pcExtensions = withImplied (effectiveExtensions (pcExtensions config) t)-              }-        )---- | Close a set of extensions under what they imply.-withImplied :: [Extension] -> [Extension]-withImplied = settle . nub-  where-    settle es =-      let es' = nub (es <> concatMap implied es)-       in if length es' == length es then es else settle es'-    implied e = [to | (from, GHC.On to) <- GHC.impliedXFlags, from == e]+    bits =+      GHC.pExtsBitmap . parserOpts . effectiveExtensions (pcDefaults config)  -- | Options to parse with.-parserOpts :: ParserConfig -> GHC.ParserOpts-parserOpts ParserConfig{pcExtensions} =+parserOpts :: [Extension] -> GHC.ParserOpts+parserOpts extensions =   GHC.mkParserOpts-    (EnumSet.fromList pcExtensions)+    (EnumSet.fromList extensions)     quietDiagnostics     False -- safe imports     True -- keep Haddock tokens@@ -290,8 +280,12 @@ -- | The start of the first thing that is not part of the header. headerEndOf :: HsModule GhcPs -> Maybe Span headerEndOf hsModule =-  listToMaybe . sortOn startPoint $-    mapMaybe spanOf (hsmodImports hsModule) <> mapMaybe spanOf (hsmodDecls hsModule)+  listToMaybe . sortOn startPoint . catMaybes $+    [spanOf (am_mod moduleAnns), spanOf (am_sig moduleAnns)]+      <> fmap spanOf (hsmodImports hsModule)+      <> fmap spanOf (hsmodDecls hsModule)+  where+    moduleAnns = anns (hsmodAnn (hsmodExt hsModule))  -- | Why a module did not parse. data ParseError = ParseError@@ -308,8 +302,8 @@  -- | Parser configuration. newtype ParserConfig = ParserConfig-  { -- | Extensions to enable before parsing.-    pcExtensions :: [Extension]+  { -- | What the component of the module puts in force before its pragmas.+    pcDefaults :: Defaults   }  -- | What a file's name says it holds.

@@ -1,22 +1,38 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}  -- | Pragma-related helpers. module Tilia.Pragma   ( movesPositions,+    Defaults,+    defaultsOf,     effectiveExtensions,     lookupExtension,     lookupEdition,-    applyExtensionName,+    nameSwitch,+    flagSwitches,+    optionFlags,+    pragmaFlags,     languageNames,+    withoutSkippedComments,+    sameInForce,   ) where +import Control.Monad ((<=<))+import Data.Char (isAlphaNum, isSpace) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe, maybeToList)+import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T+import GHC.Data.FastString (fsLit) import GHC.Driver.Session qualified as GHC import GHC.LanguageExtensions.Type (Extension (..))+import GHC.Parser.Header (toArgs)+import GHC.Types.SrcLoc (mkRealSrcLoc, unLoc)+import Tilia.Utils (tshow)  -- | Recognize @{-# LINE #-}@ and @{-# COLUMN #-}@ pragmas. movesPositions :: Text -> Bool@@ -25,43 +41,152 @@     positional body =       T.toUpper (T.takeWhile (/= ' ') body) `elem` ["LINE", "COLUMN"] +-- | What a component puts in force before the pragmas of a module: its+-- @default-language@ and its @default-extensions@.+data Defaults = Defaults+  { -- | What it turns on and off on top of its edition, in order, and on top+    -- of an edition the module names in its place.+    defaultsSwitches :: [GHC.OnOff Extension],+    -- | What its edition and those switches put in force, worked out once.+    defaultsInForce :: [Extension]+  }+  deriving (Eq, Show)++-- | What a component puts in force, given the extensions of its edition and+-- what it switches on top of them, in order.+defaultsOf :: [Extension] -> [GHC.OnOff Extension] -> Defaults+defaultsOf edition switches = Defaults switches (foldl' switch edition switches)+ -- | The extensions actually in force in a module.+--+-- As with GHC, the edition the header names last takes the place of the+-- component's, wherever it is named, and what the component and then the+-- header switch is switched on top of it. effectiveExtensions ::-  -- | What the package the module belongs to puts in force, which is its-  -- @default-language@ and @default-extensions@ already resolved into a-  -- set.-  [Extension] ->-  -- | The module's source, read here for its @LANGUAGE@ pragmas alone.+  -- | What the component the module belongs to puts in force.+  Defaults ->+  -- | The module's source, read here for the @LANGUAGE@, @OPTIONS_GHC@ and+  -- @OPTIONS@ pragmas of its header alone.   Text ->   [Extension]-effectiveExtensions package =-  foldl' applyExtensionName package . concatMap pragmaNames . pragmaBodies+effectiveExtensions defaults source =+  foldl' switch inForce (concat switches)   where-    pragmaNames body =-      let (keyword, names) = T.break (== ' ') body-       in if T.toUpper keyword == "LANGUAGE"-            then languageNames names-            else []+    (editions, switches) = unzip (fmap ofPragma (headerPragmaBodies source))+    ofPragma body =+      let (keyword, rest) = T.break (== ' ') body+       in editionsAndSwitches (T.toUpper keyword) rest+    inForce = case concat editions of+      [] -> defaultsInForce defaults+      named ->+        foldl'+          switch+          (GHC.languageExtensions (Just (last named)))+          (defaultsSwitches defaults) --- | Turn on the extension a name spells, or off where the name puts @No@ in--- front of one, leaving the set as it is for a name that spells neither.-applyExtensionName :: [Extension] -> Text -> [Extension]-applyExtensionName acc name =-  case T.stripPrefix "No" name >>= lookupExtension of-    Just off -> filter (/= off) acc-    Nothing -> case lookupExtension name of-      Just on | on `notElem` acc -> acc <> [on]-      _ -> acc+-- | Do two orders of the same pragmas, each given by its name and body,+-- leave the same extensions on?+--+-- Where none of them turns an extension off, every order turns on the same.+sameInForce :: [(Text, Text)] -> [(Text, Text)] -> Bool+sameInForce a b = not (turnsOff a) || inForce a == inForce b+  where+    turnsOff = foldl' (switchWith (const id) (\_ _ -> True)) False . switches+    inForce = foldl' (switchWith Set.insert Set.delete) Set.empty . switches+    switches = concatMap (uncurry switchesOf) +-- | What a pragma of this name and body turns on and off.+switchesOf :: Text -> Text -> [GHC.OnOff Extension]+switchesOf name = snd . editionsAndSwitches name++-- | The editions a pragma of this name and body names, and what it turns on+-- and off.+editionsAndSwitches :: Text -> Text -> ([GHC.Language], [GHC.OnOff Extension])+editionsAndSwitches name body =+  ( mapMaybe (lookupEdition <=< T.stripPrefix "-X") flags,+    concatMap flagSwitches flags+  )+  where+    flags = pragmaFlags name body++-- | The flags a pragma of this name and body gives GHC: each name of a+-- @LANGUAGE@ pragma after @-X@, and the flags of an options pragma.+pragmaFlags :: Text -> Text -> [Text]+pragmaFlags name body = case name of+  "LANGUAGE" -> ["-X" <> n | n <- languageNames body]+  "OPTIONS_GHC" -> optionFlags body+  "OPTIONS" -> optionFlags body+  _ -> []++-- | The flags of the body of an options pragma, split as GHC splits them.+optionFlags :: Text -> [Text]+optionFlags body =+  either (const (T.words body)) (fmap (T.pack . unLoc)) $+    toArgs (mkRealSrcLoc (fsLit "") 1 1) (T.unpack body)++-- | The extension a name turns on, or off where it puts @No@ in front of one.+nameSwitch :: Text -> Maybe (GHC.OnOff Extension)+nameSwitch name = case T.stripPrefix "No" name >>= lookupExtension of+  Just off -> Just (GHC.Off off)+  Nothing -> GHC.On <$> lookupExtension name++-- | What a flag of an @OPTIONS_GHC@ or @OPTIONS@ pragma turns on and off.+flagSwitches :: Text -> [GHC.OnOff Extension]+flagSwitches flag+  | Just name <- T.stripPrefix "-X" flag = maybeToList (nameSwitch name)+  | flag == "-cpp" = [GHC.On Cpp]+  | flag == "-fglasgow-exts" = GHC.On <$> GHC.glasgowExtsFlags+  | flag == "-fno-glasgow-exts" = GHC.Off <$> GHC.glasgowExtsFlags+  | Just name <- T.stripPrefix "-fno-" flag = GHC.Off <$> oldFlag name+  | Just name <- T.stripPrefix "-f" flag = GHC.On <$> oldFlag name+  | otherwise = []+  where+    oldFlag name = maybeToList (Map.lookup name extensionsByOldFlag)++-- | Turn an extension on or off in a list kept in the order extensions were+-- turned on in.+switch :: [Extension] -> GHC.OnOff Extension -> [Extension]+switch = switchWith turnOn (filter . (/=))+  where+    turnOn e acc = if e `elem` acc then acc else acc <> [e]++-- | Turn an extension on, and then what it implies, or turn it off alone, as+-- GHC does.+switchWith ::+  -- | How to turn one extension on.+  (Extension -> a -> a) ->+  -- | How to turn one extension off.+  (Extension -> a -> a) ->+  -- | What is on so far.+  a ->+  -- | What to turn on or off.+  GHC.OnOff Extension ->+  a+switchWith on off acc = \case+  GHC.On e ->+    foldl' (switchWith on off) (on e acc) (Map.findWithDefault [] e impliedBy)+  GHC.Off e -> off e acc++-- | What GHC turns on or off besides when it turns an extension on.+impliedBy :: Map Extension [GHC.OnOff Extension]+impliedBy =+  Map.fromListWith+    (flip (<>))+    [(from, [implied]) | (from, implied) <- GHC.impliedXFlags]+ -- | The extensions a @LANGUAGE@ pragma names, as written. languageNames :: Text -> [Text] languageNames = filter (not . T.null) . fmap T.strip . T.splitOn ","  -- | Parse the name of an edition of the language, such as @GHC2021@. lookupEdition :: Text -> Maybe GHC.Language-lookupEdition name =-  lookup name [(T.pack (show e), e) | e <- [minBound .. maxBound]]+lookupEdition name = Map.lookup name editionsByName +-- | Every edition of the language this compiler knows, by its name.+editionsByName :: Map Text GHC.Language+editionsByName =+  Map.fromList [(tshow e, e) | e <- [minBound .. maxBound]]+ -- | Parse an extension name. lookupExtension :: Text -> Maybe Extension lookupExtension name = Map.lookup name extensionsByName@@ -69,46 +194,115 @@ -- | Every extension this compiler knows, by the name one writes in a -- pragma. extensionsByName :: Map Text Extension-extensionsByName =-  Map.fromList-    [(T.pack (GHC.flagSpecName f), GHC.flagSpecFlag f) | f <- GHC.xFlags]+extensionsByName = byFlagName GHC.xFlags +-- | Every extension an old @-f@ flag such as @-fbang-patterns@ turns on, by+-- the flag without its @-f@.+extensionsByOldFlag :: Map Text Extension+extensionsByOldFlag = byFlagName GHC.fLangFlags++-- | Extensions by the names of the flags that turn them on.+byFlagName :: [GHC.FlagSpec Extension] -> Map Text Extension+byFlagName flags =+  Map.fromList [(T.pack (GHC.flagSpecName f), GHC.flagSpecFlag f) | f <- flags]+ -- | What every @{-# … #-}@ in a module has between its braces, each on one -- line. pragmaBodies :: Text -> [Text]-pragmaBodies = go+pragmaBodies = scanPragmas past   where-    go = step . T.dropWhile (\c -> c /= '{' && c /= '-' && c /= '"')+    past go t = case T.uncons t of+      Just ('"', after) -> go (skipString after)+      Just ('\'', after) -> go (skipCharacter after)+      _ -> go (skipCode t) -    step t+    skipString = inString . T.dropWhile (\c -> c /= '"' && c /= '\\')++    inString t+      | T.null t = t+      | Just after <- T.stripPrefix "\\" t = skipString (T.drop 1 after)+      | Just after <- T.stripPrefix "\"" t = after+      | otherwise = skipString (T.drop 1 t)++    skipCharacter t = case T.unpack (T.take 2 t) of+      ['\\', _] -> T.drop 1 (T.dropWhile (/= '\'') (T.drop 2 t))+      [c, '\''] | c /= '\'' -> T.drop 2 t+      _ -> t++    skipCode t =+      let (plain, rest) = T.break opens (T.drop 1 t)+          before = maybe (T.head t) snd (T.unsnoc plain)+       in if "'" `T.isPrefixOf` rest && inName before then skipCode rest else rest+    opens c = c == '{' || c == '-' || c == '"' || c == '\''+    inName c = isAlphaNum c || c == '_' || c == '\''++-- | What the @{-# … #-}@ of a module's header have between their braces, each+-- on one line: those above the first thing that is neither a comment, a+-- directive nor a pragma, which are all GHC reads.+headerPragmaBodies :: Text -> [Text]+headerPragmaBodies = scanPragmas past+  where+    past go t = case T.uncons t of+      Just (c, _)+        | isSpace c -> go (T.stripStart t)+        | c == '#' -> go (T.dropWhile (/= '\n') t)+      _ -> []++-- | The bodies of the pragmas of a module, each on one line, carrying on past+-- what is neither a comment nor a pragma as the given function does.+scanPragmas :: ((Text -> [Text]) -> Text -> [Text]) -> Text -> [Text]+scanPragmas past = go+  where+    go t       | T.null t = []       | Just body <- T.stripPrefix "{-#" t = case T.breakOn "#-}" body of           (_, after) | T.null after -> []-          (inner, after) -> T.unwords (T.words inner) : go (T.drop 3 after)+          (inner, after) ->+            T.unwords (T.words (withoutSkippedComments inner))+              : go (T.drop 3 after)       | Just after <- T.stripPrefix "{-" t = go (skipBlock (1 :: Int) after)       | opensLineComment t = go (T.dropWhile (/= '\n') t)-      | Just after <- T.stripPrefix "\"" t = go (skipString after)-      | otherwise = go (T.drop 1 t)+      | otherwise = past go t -    opensLineComment t = case T.stripPrefix "--" t of-      Nothing -> False-      Just rest -> maybe True (not . symbolic . fst) (T.uncons rest)+-- | What a pragma holds between its @{-#@ and its @#-}@, without the+-- comments GHC skips in it: those of a @LANGUAGE@ pragma, which then comes+-- out on one line.+withoutSkippedComments :: Text -> Text+withoutSkippedComments inner+  | T.any (\c -> c == '-' || c == '{') inner,+    T.toUpper keyword == "LANGUAGE" =+      T.unwords (T.words (withoutComments inner))+  | otherwise = inner+  where+    keyword = T.takeWhile (not . isSpace) (T.stripStart inner) -    symbolic c = c `elem` ("!#$%&*+./<=>?@\\^|-~:" :: String)+-- | A text without its comments, each of which leaves a space behind.+withoutComments :: Text -> Text+withoutComments t+  | T.null t = t+  | Just after <- T.stripPrefix "{-" t =+      " " <> withoutComments (skipBlock (1 :: Int) after)+  | opensLineComment t = withoutComments (T.dropWhile (/= '\n') t)+  | otherwise =+      let (plain, rest) = T.break (\c -> c == '{' || c == '-') (T.drop 1 t)+       in T.take 1 t <> plain <> withoutComments rest -    skipBlock 0 t = t-    skipBlock n t0 = inBlock n (T.dropWhile (\c -> c /= '{' && c /= '-') t0)+-- | Does a line comment begin here?+opensLineComment :: Text -> Bool+opensLineComment t = case T.stripPrefix "--" t of+  Nothing -> False+  Just rest ->+    maybe True (not . symbolic . fst) (T.uncons (T.dropWhile (== '-') rest))+  where+    symbolic c = c `elem` ("!#$%&*+./<=>?@\\^|-~:" :: String) -    inBlock n t+-- | What follows the end of a block comment this deep in comments.+skipBlock :: Int -> Text -> Text+skipBlock 0 t = t+skipBlock n t0 = inBlock (T.dropWhile (\c -> c /= '{' && c /= '-') t0)+  where+    inBlock t       | T.null t = t       | Just after <- T.stripPrefix "{-" t = skipBlock (n + 1) after       | Just after <- T.stripPrefix "-}" t = skipBlock (n - 1) after       | otherwise = skipBlock n (T.drop 1 t)--    skipString = inString . T.dropWhile (\c -> c /= '"' && c /= '\\')--    inString t-      | T.null t = t-      | Just after <- T.stripPrefix "\\" t = skipString (T.drop 1 after)-      | Just after <- T.stripPrefix "\"" t = after-      | otherwise = skipString (T.drop 1 t)

@@ -0,0 +1,91 @@+{-# LANGUAGE LambdaCase #-}+{-# OPTIONS_GHC -Wno-missing-fields #-}++-- | What GHC's own reader of flags makes of the flags of a header.+module Tilia.Pragma.Ghc+  ( InForce (..),+    inForceAfter,+    readFlags,+  )+where++import Data.List (isPrefixOf)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Driver.CmdLine (Flag (..), processArgs)+import GHC.Driver.Session qualified as GHC+import GHC.LanguageExtensions.Type (Extension)+import GHC.Platform (genericPlatform)+import GHC.Settings+import GHC.Settings.Config (cProjectVersion)+import GHC.Types.SafeHaskell (SafeHaskellMode)+import GHC.Types.SrcLoc (noLoc)+import GHC.Unit.Types (stringToUnitId)+import GHC.Utils.Fingerprint (fingerprint0)+import Tilia.Pragma (flagSwitches)++-- | What the flags of a header settle, whatever was in force before them.+data InForce = InForce+  { -- | Whether the flags, with what they imply, last turn each extension+    -- they switch on or off.+    inForceSwitches :: Map Extension Bool,+    -- | The edition named last, if one is.+    inForceEdition :: Maybe GHC.Language,+    -- | The Safe Haskell mode.+    inForceSafety :: SafeHaskellMode+  }++-- | What GHC's flag reader makes of these flags, read in order.+inForceAfter :: [Text] -> InForce+inForceAfter flags =+  InForce+    { inForceSwitches = Map.fromList (fmap switched (reverse (GHC.extensions dflags))),+      inForceEdition = GHC.language dflags,+      inForceSafety = GHC.safeHaskell dflags+    }+  where+    dflags = readFlags flags+    switched = \case+      GHC.On e -> (e, True)+      GHC.Off e -> (e, False)++-- | What GHC's flag reader makes of these flags, read in order from its+-- defaults, of the flags that can switch an extension, the edition or the+-- Safe Haskell mode.+readFlags :: [Text] -> GHC.DynFlags+readFlags flags = snd (GHC.runCmdLineP reading defaults)+  where+    reading = processArgs named (fmap noLoc args) (\_ -> pure [])+    named = mapMaybe ((`Map.lookup` switchingFlags) . drop 1) args+    args = fmap T.unpack flags++-- | The flags of GHC's that can switch an extension, the edition or the Safe+-- Haskell mode, by name: the @-X@ ones and the rest of those 'flagSwitches'+-- reads.+switchingFlags :: Map String (Flag (GHC.CmdLineP GHC.DynFlags))+switchingFlags =+  Map.fromList+    [(flagName f, f) | f <- GHC.flagsDynamic, switching (flagName f)]+  where+    switching name =+      "X" `isPrefixOf` name || not (null (flagSwitches (T.pack ('-' : name))))++-- | What GHC puts in force before it reads any flag.+defaults :: GHC.DynFlags+defaults = GHC.defaultDynFlags settings++-- | Enough of a compiler's settings for its flag reader, which runs no tool.+settings :: Settings+settings =+  Settings+    { sGhcNameVersion = GhcNameVersion "ghc" cProjectVersion,+      sFileSettings = FileSettings{},+      sTargetPlatform = genericPlatform,+      sToolSettings = ToolSettings{toolSettings_opt_P_fingerprint = fingerprint0},+      sPlatformMisc = PlatformMisc{},+      sUnitSettings = UnitSettings (stringToUnitId "base"),+      sRawSettings = []+    }

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}@@ -19,15 +18,13 @@  import Data.Choice (fromBool, pattern Do) import Data.Foldable (fold)-import Data.Function (on)-import Data.List (sortBy) import Data.Maybe (isNothing) import GHC.Builtin.Types (cTupleTyConName, isCTupleTyConName) import GHC.Core.Coercion.Axiom (Role (..)) import GHC.Hs import GHC.Types.Fixity (LexicalFixity (..)) import GHC.Types.Name.Reader (RdrName (..))-import GHC.Types.SrcLoc (GenLocated (..), leftmost_smallest, unLoc)+import GHC.Types.SrcLoc (GenLocated (..), unLoc) import Tilia.Doc.Combinators import Tilia.Render.Context import Tilia.Render.Data (dataDecl)@@ -87,7 +84,7 @@     body =       includeUnless         (null members)-        (breakOrSpace <> indent (knotDeclsGrouped (ctxKnot ctx) ctx Associated members))+        (breakOrSpace <> indent (knotDeclsGrouped (ctxKnot ctx) ctx members))      members =       inSourceOrder@@ -112,6 +109,7 @@     <> space     <> indent (commaSep (fmap (align . at_ ctx (funDep ctx)) fdeps)) +-- | One functional dependency of a class, as in @a b -> c@. funDep :: Ctx -> FunDep GhcPs -> Doc funDep ctx (FunDep _ before after) =   hsep (fmap (name ctx) before)@@ -146,7 +144,7 @@      body =       includeUnless (null members) . indent $-        breakOrSpace <> knotDeclsGrouped (ctxKnot ctx) ctx Associated members+        breakOrSpace <> knotDeclsGrouped (ctxKnot ctx) ctx members      members =       inSourceOrder@@ -258,6 +256,8 @@               includeUnless (null given) $                 hardBreak <> indent (vsep (fmap (at_ ctx (tyFamInstEqn ctx)) given)) +-- | What the head of a family says of its result, a kind or a variable+-- naming it, if anything. familyResultSig :: Ctx -> LFamilyResultSig GhcPs -> Maybe Doc familyResultSig ctx (L _ sig) = case sig of   NoSig NoExtField -> Nothing@@ -266,6 +266,7 @@   TyVarSig NoExtField bndr ->     Just (txt "=" <> breakOrSpace <> at ctx bndr (tyVarBndr ctx)) +-- | The injectivity annotation of a type family, as in @| r -> a@. injectivityAnn :: Ctx -> InjectivityAnn GhcPs -> Doc injectivityAnn ctx (InjectivityAnn _ from to) =   txt "|"@@ -312,8 +313,3 @@       Nominal -> txt "nominal"       Representational -> txt "representational"       Phantom -> txt "phantom"---- | Merge several lists of declarations back into the order they were--- written in.-inSourceOrder :: [[LHsDecl GhcPs]] -> [LHsDecl GhcPs]-inSourceOrder = sortBy (leftmost_smallest `on` getLocA) . concat

@@ -43,17 +43,14 @@   ) where -import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text)-import Data.Text qualified as T import GHC.Hs hiding (Fixity) import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))-import GHC.Types.Name.Occurrence (occNameString)-import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc)+import GHC.Types.Name.Reader (RdrName (..)) import GHC.Types.SrcLoc (GenLocated (..)) import GHC.Types.SrcLoc qualified as GHC import Tilia.Comments (Comment (..), CommentStyle (..), carriesOn, commentTrailing)@@ -61,10 +58,11 @@ import Tilia.Fixity   ( Fixity,     Namespace (..),-    OpName (..),     Resolution (..),     Scope,     lookupFixity,+    opName,+    qualifierOf,   ) import Tilia.Render.Layout (Bracing (..)) import Tilia.Source@@ -114,10 +112,10 @@     -- | Signature declarations, needed by @let@ and @where@ bodies.     knotSig :: Ctx -> Sig GhcPs -> Doc,     -- | A run of declarations, needed by Template Haskell brackets.-    knotDecls :: Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc,+    knotDecls :: Ctx -> [LHsDecl GhcPs] -> Doc,     -- | A run of declarations that keeps the author's blank lines, needed     -- by class and instance bodies.-    knotDeclsGrouped :: Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc+    knotDeclsGrouped :: Ctx -> [LHsDecl GhcPs] -> Doc   }  -- | Whether a family or data declaration stands on its own or inside a@@ -186,14 +184,9 @@ operatorFixity :: Ctx -> Namespace -> RdrName -> Maybe Fixity operatorFixity ctx namespace name = do   scope <- ctxScope ctx-  case lookupFixity scope namespace qualifier op of+  case lookupFixity scope namespace (qualifierOf name) (opName name) of     Resolved fixity _ -> Just fixity     Unresolved _ -> Nothing-  where-    op = OpName (T.pack (occNameString (rdrNameOcc name)))-    qualifier = case name of-      Qual m _ -> Just (T.pack (moduleNameString m))-      _ -> Nothing  ---------------------------------------------------------------------------- -- What lies between two spans@@ -392,11 +385,11 @@ ---------------------------------------------------------------------------- -- Haddocks --- | The author's own text for the Haddock at this position, if we kept it.-writtenHaddock :: Ctx -> Maybe Span -> Maybe (NonEmpty Text)+-- | The Haddock the author wrote at this position, if we kept it.+writtenHaddock :: Ctx -> Maybe Span -> Maybe Comment writtenHaddock ctx ms = do   s <- ms-  c <- Map.lookup (spanStartLine s, spanStartColumn s) (ctxHaddocks ctx)+  c <- Map.lookup (startPoint s) (ctxHaddocks ctx)   case commentStyle c of-    DocComment -> Just (commentBody c)+    DocComment -> Just c     _ -> Nothing

@@ -205,10 +205,10 @@     argsAndResult = arguments <> resultType      -- GHC keeps a GADT's result type without the brackets it was written-    -- with, and there is one shape that does not survive losing them. A-    -- kind signature needs them back: @MkT :: Int -> T :: Star@ reads as a-    -- second signature on the constructor rather than as a kind on its-    -- result, and does not parse at all.+    -- with, and three shapes need them back: a kind signature, as+    -- @MkT :: Int -> T :: Star@ does not parse, and a @forall@ or a context+    -- making up the whole signature, which would be read as the+    -- constructor's own.     resultType = case unLoc con_res_ty of       HsKindSig{} -> parens (hsType ctx con_res_ty)       HsForAllTy{} | standsAlone -> parens (hsType ctx con_res_ty)@@ -361,6 +361,4 @@       )     <> indent (space <> txt "=" <> separator <> hsType ctx rhs)   where-    separator-      | typeIsDocumented (unLoc rhs) = hardBreak-      | otherwise = breakOrSpace+    separator = typeBreak (typeIsDocumented (unLoc rhs))

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}@@ -36,16 +35,17 @@ import Tilia.Render.Signature import Tilia.Render.Type import Tilia.Source (SourceType (..))-import Tilia.Span import Tilia.Span.Ghc --- | A run of declarations, with blank lines wherever we think they belong.-decls :: Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc-decls = declRun Disregard+-- | A run of declarations standing on their own, with blank lines wherever+-- we think they belong.+decls :: Ctx -> [LHsDecl GhcPs] -> Doc+decls ctx = declRun Disregard ctx Free --- | A run of declarations that keeps the author's grouping.-declsKeepingGroups :: Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc-declsKeepingGroups = declRun Respect+-- | A run of declarations in a class or an instance, which keeps the+-- author's grouping.+declsKeepingGroups :: Ctx -> [LHsDecl GhcPs] -> Doc+declsKeepingGroups ctx = declRun Respect ctx Associated  -- | Whether the author's own blank lines are consulted. data Grouping@@ -119,7 +119,7 @@       _ -> False     belongs previous current =       (not isSignatureFile && isSignatureSeries ctx previous current)-        || isDerivingSeries ctx previous current+        || isSeries ctx previous current         || relatedDecls d current         || relatedDecls previous current @@ -131,12 +131,15 @@     not (commentPrintedBetween ctx (spanOf x) (spanOf y))   _ -> False --- | Two standalone @deriving@ declarations the author ran together.-isDerivingSeries :: Ctx -> LHsDecl GhcPs -> LHsDecl GhcPs -> Bool-isDerivingSeries ctx x@(L _ a) y@(L _ b) = case (a, b) of-  (DerivD{}, DerivD{}) ->-    not (separatedByBlank ctx (spanOf x) (spanOf y))+-- | Two standalone @deriving@ declarations, or two splices, the author ran+-- together.+isSeries :: Ctx -> LHsDecl GhcPs -> LHsDecl GhcPs -> Bool+isSeries ctx x@(L _ a) y@(L _ b) = case (a, b) of+  (DerivD{}, DerivD{}) -> ranTogether+  (SpliceD{}, SpliceD{}) -> ranTogether   _ -> False+  where+    ranTogether = not (separatedByBlank ctx (spanOf x) (spanOf y))  -- | The kinds of declaration that grouping distinguishes. data Kind@@ -151,7 +154,6 @@   | FamilyDeclaration   | TypeSynonym   | PragmaDeclaration-  | TopLevelSplice   | DocumentsNext   | DocumentsPrevious   | Unremarkable@@ -169,7 +171,7 @@   SigD _ sig     | Just n <- specialisedName sig -> (PragmaDeclaration, [n])   ValD _ (FunBind _ (L _ n) _) -> (FunctionBody, [n])-  ValD _ (PatBind _ p _ _) -> (FunctionBody, boundNames p)+  ValD _ (PatBind _ p _ _) -> (FunctionBody, collectPatBinders CollNoDictBinders p)   ValD _ (PatSynBind _ (PSB _ (L _ n) _ _ _)) -> (PatternDefinition, [n])   AnnD _ (HsAnnotation _ (ValueAnnProvenance (L _ n)) _) -> (PragmaDeclaration, [n])   AnnD _ (HsAnnotation _ (TypeAnnProvenance (L _ n)) _) -> (PragmaDeclaration, [n])@@ -180,36 +182,16 @@   TyClD _ (SynDecl _ (L _ n) _ _ _) -> (TypeSynonym, [n])   TyClD _ (FamDecl _ (FamilyDecl _ _ _ (L _ n) _ _ _ _)) -> (FamilyDeclaration, [n])   KindSigD _ (StandaloneKindSig _ (L _ n) _) -> (KindSignature, [n])-  SpliceD _ (SpliceDecl _ _ _) -> (TopLevelSplice, [])   DocD _ (DocCommentNext _) -> (DocumentsNext, [])   DocD _ (DocCommentPrev _) -> (DocumentsPrevious, [])   _ -> (Unremarkable, []) --- | The names a pattern binding brings into scope.-boundNames :: LPat GhcPs -> [RdrName]-boundNames (L _ p) = case p of-  VarPat _ (L _ n) -> [n]-  AsPat _ (L _ n) inner -> n : boundNames inner-  NPlusKPat _ (L _ n) _ _ _ _ -> [n]-  LazyPat _ inner -> boundNames inner-  BangPat _ inner -> boundNames inner-  ParPat _ inner -> boundNames inner-  SigPat _ inner _ -> boundNames inner-  ViewPat _ _ inner -> boundNames inner-  SumPat _ inner _ _ -> boundNames inner-  TuplePat _ ps _ -> concatMap boundNames ps-  ListPat _ ps -> concatMap boundNames ps-  OrPat _ ps -> concatMap boundNames (NE.toList ps)-  ConPat _ _ details -> concatMap boundNames (hsConPatArgs details)-  _ -> []- -- | Should these two declarations be printed with no blank line between -- them? relatedDecls :: LHsDecl GhcPs -> LHsDecl GhcPs -> Bool relatedDecls a b = case (kindA, kindB) of   (DocumentsNext, _) -> True   (_, DocumentsPrevious) -> True-  (TopLevelSplice, TopLevelSplice) -> not (blankBetween (spanOf a) (spanOf b))   pair | pair `elem` relatedKinds -> shareAName namesA namesB   _ -> False   where

@@ -1,11 +1,9 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}  -- | Expressions, and the equations and blocks built out of them.@@ -19,9 +17,8 @@  import Control.Applicative ((<|>)) import Data.Choice (Choice, fromBool, isTrue, pattern Is, pattern Isn't)-import Data.Function (on) import Data.Generics.Schemes (listify)-import Data.List (sortBy, unsnoc)+import Data.List (unsnoc) import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import Data.Map.Strict qualified as Map@@ -34,11 +31,9 @@ import GHC.Types.Fixity (LexicalFixity (..)) import GHC.Types.Name.Occurrence (isVarOcc, occNameString) import GHC.Types.Name.Reader (RdrName (..), mkVarUnqual, rdrNameOcc)-import GHC.Types.SourceText import GHC.Types.SrcLoc   ( GenLocated (..),     isZeroWidthSpan,-    leftmost_smallest,     noSrcSpan,     unLoc,   )@@ -51,7 +46,7 @@   ) import Tilia.Render.Context import Tilia.Render.Layout-import Tilia.Render.Literal (stringLiteral)+import Tilia.Render.Literal (hsLit, writtenString) import Tilia.Render.Name import Tilia.Render.Operator import Tilia.Render.Pattern@@ -74,11 +69,7 @@   HsOverLabel src _ -> txt "#" <> sourceText src   HsIPVar _ (HsIPName n) -> txt "?" <> outputable n   HsOverLit _ v -> outputable (ol_val v)-  HsLit _ lit -> case lit of-    HsString (SourceText s) _ -> stringLiteral s-    HsStringPrim (SourceText s) _ -> stringLiteral s-    HsMultilineString (SourceText s) _ -> stringLiteral s-    other -> outputable other+  HsLit _ lit -> hsLit lit   HsLam _ variant' mg -> lambda ctx site variant' (ExprBody ctx) mg   HsApp _ f x -> application ctx site f x   HsAppType at' e a ->@@ -169,12 +160,7 @@         <> joinedBy "::"         <> indent (hsSigType ctx hswc_body)   ArithSeq _ _ range -> arithSeq ctx here (closingFor site) range-  HsTypedBracket (bracketAnn, _) e ->-    txt opener-      <> breakOrNothing-      <> insideBrackets here (hsExpr ctx e)-      <> breakOrNothing-      <> txt "||]"+  HsTypedBracket (bracketAnn, _) e -> quoted here opener "||]" (hsExpr ctx e)     where       opener = case bracketAnn of         BracketNoE{} -> "[||"@@ -191,7 +177,7 @@   HsPragE _ prag x -> case prag of     HsPragSCC _ n ->       txt "{-# SCC "-        <> outputable n+        <> writtenString n         <> txt " #-}"         <> breakOrSpace         <> nest (if siteInBlock site then 1 else 0) (hsExpr ctx x)@@ -507,17 +493,7 @@         <> breakOrSpace         <> indent (hsExpr ctx trS_using)   RecStmt{..} ->-    txt "rec"-      <> space-      <> align-        ( at ctx recS_stmts $ \xs ->-            items (siteBracing site) $-              keepBlanks-                (separatedByBlank ctx)-                [ (spanOf s, at_ ctx (stmtBody ctx site mkBody) s)-                | s <- xs-                ]-        )+    txt "rec" <> space <> align (stmtBlock ctx site mkBody recS_stmts)  -- | The statements of a block, with the break that introduces them. statements ::@@ -532,7 +508,21 @@   XRec GhcPs [LStmt GhcPs (XRec GhcPs body)] ->   Doc statements ctx site mkBody es =-  breakOrSpace <> underSite site (at ctx es block)+  breakOrSpace <> underSite site (stmtBlock ctx site mkBody es)++-- | The statements of a block, each laid out as an item of it.+stmtBlock ::+  ( Body b,+    Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,+    Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,+    Anno body ~ SrcSpanAnnA+  ) =>+  Ctx ->+  Site ->+  BodyOf body b ->+  XRec GhcPs [LStmt GhcPs (XRec GhcPs body)] ->+  Doc+stmtBlock ctx site mkBody es = at ctx es block   where     block xs =       items (siteBracing site) $@@ -699,10 +689,7 @@         | (position, item) <- positioned sorted         ]     where-      sorted =-        sortBy-          (leftmost_smallest `on` getLocA)-          (fmap (fmap Left) binds <> fmap (fmap Right) sigs)+      sorted = inSourceOrder [fmap (fmap Left) binds, fmap (fmap Right) sigs]       rendered position item =         blockItem position NoBrace $ \b ->           at_ ctx (either (valDecl ctx b) (knotSig (ctxKnot ctx) ctx)) item@@ -889,11 +876,7 @@   | isCaseStyle style, null (unLoc mg_alts) = txt "{}"   | otherwise = items blockBracing (fmap rendered (positioned (unLoc mg_alts)))   where-    blockBracing = case style of-      CaseStyle -> ifEmpty-      LambdaCaseStyle -> ifEmpty-      _ -> NoBrace-    ifEmpty = if null (unLoc mg_alts) then MayBrace else bracing+    blockBracing = if isCaseStyle style then bracing else NoBrace     rendered (position, m) =       blockItem position bracing (\b -> at_ ctx (renderMatch b) m)     renderMatch b m@Match{..} =@@ -1008,13 +991,10 @@       _ -> True      separator-      | length grhssGRHSs > 1 = mempty+      | hasGuards = mempty       | otherwise = case style of-          FunctionStyle _ | hasGuards -> mempty           FunctionStyle _ -> space <> indent (txt "=")-          PatternBindStyle | hasGuards -> mempty           PatternBindStyle -> space <> indent (txt "=")-          s | isCaseStyle s && hasGuards -> mempty           _ -> space <> txt "->"      body = sepBy breakOrSpace (fmap alternative (NE.toList grhssGRHSs))@@ -1196,24 +1176,19 @@ -- | A Template Haskell quotation. quotation :: Ctx -> Maybe Span -> HsQuote GhcPs -> Doc quotation ctx here = \case-  ExpBr (bracketAnn, _) e -> quoted (flavour bracketAnn) (hsExpr ctx e)+  ExpBr (bracketAnn, _) e -> quotedAs (flavour bracketAnn) (hsExpr ctx e)     where       flavour = \case         BracketNoE{} -> ""         BracketHasE{} -> "e"-  PatBr _ p -> quoted "p" (hsPat ctx p)+  PatBr _ p -> quotedAs "p" (hsPat ctx p)   DecBrL _ decls ->-    quoted "d" (starGuard decls (knotDecls (ctxKnot ctx) ctx Free decls))+    quotedAs "d" (starGuard decls (knotDecls (ctxKnot ctx) ctx decls))   DecBrG _ _ -> error "Tilia: DecBrG is produced by the renamer"-  TypBr _ ty -> quoted "t" (starGuard ty (hsType ctx ty))+  TypBr _ ty -> quotedAs "t" (starGuard ty (hsType ctx ty))   VarBr _ isSingle n -> txt (if isSingle then "'" else "''") <> name ctx n   where-    quoted flavour body =-      txt "["-        <> txt flavour-        <> txt "|"-        <> breakOrNothing-        <> indent (insideBrackets here body <> breakOrNothing <> txt "|]")+    quotedAs flavour = quoted here ("[" <> flavour <> "|") "|]"     starGuard x body       | risky = space <> body <> space       | otherwise = body@@ -1228,6 +1203,22 @@       ClosedTypeFamily Nothing -> True       _ -> False +-- | The body of a quotation between its brackets, indented where it breaks.+quoted ::+  -- | Where the quotation is written.+  Maybe Span ->+  -- | The opening bracket.+  Text ->+  -- | The closing bracket.+  Text ->+  -- | The body.+  Doc ->+  Doc+quoted here opener closer body =+  txt opener+    <> breakOrNothing+    <> indent (insideBrackets here body <> breakOrNothing <> txt closer)+ -- | An item of a block: the last one keeps the block's bracing, and any -- other may brace itself when the block is flat. blockItem :: Position -> Bracing -> (Bracing -> Doc) -> Doc@@ -1306,6 +1297,8 @@   HsCmdLam{} -> Hanging   _ -> Normal +-- | Does this command at the top of an arrow form absorb the line break+-- that introduces it? cmdTopHangs :: HsCmdTop GhcPs -> Placement cmdTopHangs (HsCmdTop _ c) = cmdHangs (unLoc c) 

@@ -18,14 +18,13 @@ 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 import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text) import Data.Text qualified as T import GHC.Hs import GHC.Types.SrcLoc (GenLocated (..), getLoc, unLoc)-import Tilia.Comments (afterOpener, triggerOn)+import Tilia.Comments (Comment (..), afterOpener, bracketed, singleLine, triggerOn) import Tilia.Doc.Combinators import Tilia.Gathered (Gathered (..)) import Tilia.Render.Context@@ -75,13 +74,11 @@ docBody :: Ctx -> DocStyle -> LHsDoc GhcPs -> (Doc, Bool) docBody ctx style doc@(L l str) =   case reusableText ctx style doc of-    Just written ->+    Just c ->       ( maybe id located (spanOfSrcSpan l)           $ align-          $ sepBy-            (verbatimBreak AtIndent TrimWhitespace)-            (fmap txt (NE.toList written)),-        selfClosing written+          $ verbatimLines AtIndent TrimWhitespace (NE.toList (commentBody c)),+        selfClosing c       )     Nothing       | null written' -> (writtenAt emptyBlock, True)@@ -95,7 +92,7 @@         <> mconcat (replicate trailingBlanks (hardBreak <> txt "--"))     trailingBlanks = case writtenHaddock ctx (spanOfSrcSpan l) of       Nothing -> 0-      Just ls -> length (takeWhile isBlankLine (reverse (NE.toList ls)))+      Just c -> length (takeWhile isBlankLine (reverse (NE.toList (commentBody c))))     isBlankLine t = T.null (T.strip (fromMaybe t (T.stripPrefix "--" (T.strip t))))     line' isFirst t =       (if isFirst then txt (opener style) else txt "--")@@ -105,7 +102,7 @@       align $         txt (blockOpener style)           <> space-          <> sepBy (verbatimBreak AtIndent TrimWhitespace) (fmap txt written')+          <> verbatimLines AtIndent TrimWhitespace written'           <> space           <> txt "-}"     asBlock = writtenAsBlock ctx doc@@ -131,7 +128,7 @@ -- | Did the author write this Haddock as a block comment? writtenAsBlock :: Ctx -> LHsDoc GhcPs -> Bool writtenAsBlock ctx doc =-  maybe False isBlockForm (writtenHaddock ctx (spanOfSrcSpan (getLoc doc)))+  maybe False bracketed (writtenHaddock ctx (spanOfSrcSpan (getLoc doc)))  -- | The anchor of a named documentation chunk. docSectionName :: String -> Text@@ -143,11 +140,11 @@ -- the one it was written in, since the text carries the style in its first -- characters, nor when it holds nothing but the spaces the end of a line -- loses.-reusableText :: Ctx -> DocStyle -> LHsDoc GhcPs -> Maybe (NonEmpty Text)+reusableText :: Ctx -> DocStyle -> LHsDoc GhcPs -> Maybe Comment reusableText ctx style doc = do-  written <- writtenHaddock ctx (spanOfSrcSpan (getLoc doc))-  if openedInStyle style (NE.head written) && not onlySpaces-    then Just written+  c <- writtenHaddock ctx (spanOfSrcSpan (getLoc doc))+  if openedInStyle style (NE.head (commentBody c)) && not onlySpaces+    then Just c     else Nothing   where     onlySpaces = not (null text) && all isSpace text && '\n' `notElem` text@@ -169,13 +166,9 @@   Section n -> T.replicate n "*"   Chunk n -> "$" <> T.pack n --- | Was the reused text a block comment?-isBlockForm :: NonEmpty Text -> Bool-isBlockForm written = "{-" `T.isPrefixOf` T.stripStart (NE.head written)---- | May code follow the reused text on the line it ends?-selfClosing :: NonEmpty Text -> Bool-selfClosing written = isBlockForm written && null (NE.tail written)+-- | May code follow a Haddock on the line it ends?+selfClosing :: Comment -> Bool+selfClosing c = bracketed c && singleLine c  -- | Lay the document out on several lines if printing this fragment will -- emit a Haddock that takes whole lines.@@ -194,7 +187,7 @@   docs -> any takesWholeLines docs   where     takesWholeLines doc = case reusableText ctx Pipe doc of-      Just written -> not (selfClosing written)+      Just c -> not (selfClosing c)       Nothing -> not (null (docLines (writtenAsBlock ctx doc) (unLoc doc)))  -- | The spans of every Haddock in a module.

@@ -14,8 +14,9 @@ import Control.Applicative ((<|>)) import Data.Function (on) import Data.List (sortOn)+import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE-import Data.Maybe (isJust)+import Data.Maybe (isJust, isNothing) import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T@@ -25,7 +26,8 @@ import GHC.Types.SrcLoc (GenLocated (..), unLoc) import Tilia.Comments (Comment (..), Pragma (..), commentPragma) import Tilia.Doc.Combinators-import Tilia.Pragma (languageNames, lookupEdition)+import Tilia.Parser (writtenInHeader)+import Tilia.Pragma (languageNames, lookupEdition, sameInForce) import Tilia.Render.Context import Tilia.Render.Declaration (decls) import Tilia.Render.Haddock@@ -42,42 +44,29 @@     hpSpan :: Span,     -- | How many preprocessor directives the header has above it.     hpRun :: Int,-    -- | @LANGUAGE@, @OPTIONS_GHC@ or @OPTIONS_HADDOCK@.+    -- | @LANGUAGE@, @OPTIONS_GHC@, @OPTIONS@ or @OPTIONS_HADDOCK@.     hpName :: Text,     -- | One extension, or the whole of an options string.-    hpBody :: Text+    hpBody :: Text,+    -- | The lines it was written on, where it is a language pragma holding a+    -- comment, which it keeps as written.+    hpWritten :: Maybe (NonEmpty Text)   }   deriving (Eq, Show)  -- | Where a pragma sorts among the others. ----- The derived ordering is the whole of the policy: language pragmas first,--- then @OPTIONS_GHC@, then @OPTIONS_HADDOCK@; and within the language--- pragmas, by the class of extension.+-- The derived ordering is the policy wherever it leaves the same extensions+-- in force: the editions first, in the order they are written, then the+-- other language pragmas, by name, then @OPTIONS_GHC@ and @OPTIONS@, then+-- @OPTIONS_HADDOCK@. data PragmaOrder-  = LanguageOrder ExtensionClass+  = EditionOrder+  | LanguageOrder   | OptionsGhcOrder   | OptionsHaddockOrder   deriving (Eq, Ord, Show) --- | Which group an extension sorts into.------ Sorting the extensions alphabetically outright would change what a module--- means, because an extension can turn others on and a later one can turn--- them off again. Sorting only within these groups keeps the relationships--- that matter: a pack before what it enables, an enabling before a--- disabling, and the stragglers that have to come last at the end.-data ExtensionClass-  = -- | @GHC2021@, @Haskell2010@ and the like.-    Pack-  | -- | Anything else.-    Enabling-  | -- | An extension written with a @No@ prefix.-    Disabling-  | -- | Extensions that only work when nothing follows them.-    Last'-  deriving (Eq, Ord, Show)- -- | Pick the header pragmas out of a comment stream. takeHeaderPragmas ::   -- | The module as written.@@ -108,28 +97,27 @@         { hpSpan = commentSpan c,           hpRun = directivesAbove (spanStartLine (commentSpan c)),           hpName = pragmaName p,-          hpBody = pragmaBody p+          hpBody = pragmaBody p,+          hpWritten =+            if pragmaCommented p then Just (commentBody c) else Nothing         }     headerPragma c = do       p <- commentPragma c       _ <- pragmaOrder (pragmaName p) (pragmaBody p)-      if inHeader headerEnd (commentSpan c) then Just p else Nothing+      if writtenInHeader headerEnd (commentSpan c) then Just p else Nothing  -- | Where a pragma sorts, given its name and its body, or 'Nothing' for one -- the header does not hoist. pragmaOrder :: Text -> Text -> Maybe PragmaOrder pragmaOrder named body = case named of-  "LANGUAGE" -> Just (LanguageOrder (classifyExtension body))+  "LANGUAGE"+    | namesAnEdition body -> Just EditionOrder+    | otherwise -> Just LanguageOrder   "OPTIONS_GHC" -> Just OptionsGhcOrder+  "OPTIONS" -> Just OptionsGhcOrder   "OPTIONS_HADDOCK" -> Just OptionsHaddockOrder   _ -> Nothing --- | Was this written above everything the compiler reads as code?-inHeader :: Maybe Span -> Span -> Bool-inHeader headerEnd s = case headerEnd of-  Nothing -> True-  Just end -> spanStartLine s < spanStartLine end- -- | Take the Stack script header off the front of a comment stream. takeStackHeader ::   -- | Where the header ends.@@ -142,45 +130,51 @@   cs -> (mempty, cs)   where     isStackHeader c =-      inHeader headerEnd (commentSpan c)+      writtenInHeader headerEnd (commentSpan c)         && T.isPrefixOf "stack" (T.stripStart (T.drop 2 (NE.head (commentBody c))))     reproduce c =-      sepBy (verbatimBreak AtMargin TrimWhitespace) (fmap txt (NE.toList (commentBody c)))+      verbatimLines AtMargin TrimWhitespace (NE.toList (commentBody c)) --- | The pragmas of a header, one per line, sorted, with the options in the--- order they were written, which is the order GHC reads their flags in.+-- | The pragmas of a header, one per line, with the options in the order+-- they were written, which is the order GHC reads their flags in, and every+-- one of them kept, since a flag such as @-fplugin-opt@ counts each time it+-- is given.+--+-- The pragmas between two directives are sorted unless that would leave other+-- extensions in force, in which case they keep the order they were written in. pragmaBlock :: [HeaderPragma] -> Doc-pragmaBlock = foldMap render . dedupe . sortOn order . concatMap split+pragmaBlock =+  foldMap render+    . dedupe+    . concatMap (sorted . NE.toList)+    . NE.groupBy ((==) `on` hpRun)+    . concatMap split   where-    order p = (hpRun p, orderOf p, extension p)-    extension p = if hpName p == "LANGUAGE" then hpBody p else ""+    sorted run =+      let candidate = sortOn order run+       in if sameInForce (named candidate) (named run) then candidate else run+    named = fmap (\p -> (hpName p, hpBody p))+    order p = (orderOf p, extension p)+    extension p+      | orderOf p == Just LanguageOrder = hpBody p+      | otherwise = ""     key p = (hpRun p, orderOf p, hpBody p)     orderOf p = pragmaOrder (hpName p) (hpBody p)-    dedupe = fmap NE.head . NE.groupBy ((==) `on` key)+    dedupe = fmap NE.head . NE.groupBy repeated+    repeated a b = hpName a == "LANGUAGE" && key a == key b     split p-      | hpName p == "LANGUAGE" =+      | hpName p == "LANGUAGE",+        isNothing (hpWritten p) =           [ p{hpBody = body}           | body <- languageNames (hpBody p)           ]       | otherwise = [p] -    render p =-      located-        (hpSpan p)-        (txt "{-# " <> txt (hpName p) <> space <> txt (hpBody p) <> txt " #-}")-        <> hardBreak---- | Which group an extension belongs to.-classifyExtension :: Text -> ExtensionClass-classifyExtension t-  | namesAnEdition t = Pack-  -- @ImplicitPrelude@ and @CUSKs@ are turned off by other extensions, so-  -- asking for either of them only takes effect at the end.-  | t == "ImplicitPrelude" = Last'-  | t == "CUSKs" = Last'-  | otherwise = case T.uncons (T.drop 2 t) of-      Just (c, _) | "No" `T.isPrefixOf` t, c `elem` ['A' .. 'Z'] -> Disabling-      _ -> Enabling+    render p = located (hpSpan p) (written p) <> hardBreak+    written p = case hpWritten p of+      Nothing ->+        txt "{-# " <> txt (hpName p) <> space <> txt (hpBody p) <> txt " #-}"+      Just ls -> verbatim (T.intercalate "\n" (NE.toList ls))  -- | Does this name a whole edition of the language rather than one -- extension of it?@@ -210,7 +204,7 @@       (null hsmodDecls)       ( hardBreak           <> declarationsStart-          <> declarationLayout (decls ctx Free hsmodDecls)+          <> declarationLayout (decls ctx hsmodDecls)       )   where     declarationLayout = case (hsmodDecls, spansOf hsmodDecls) of@@ -330,7 +324,7 @@   IEGroup NoExtField n str -> haddock ctx (Section n) Open str   IEDoc NoExtField str -> haddock ctx Pipe Open str   IEDocNamed NoExtField n -> case writtenHaddock ctx here of-    Just written -> sepBy (verbatimBreak AtIndent TrimWhitespace) (fmap txt (NE.toList written))+    Just c -> verbatimLines AtIndent TrimWhitespace (NE.toList (commentBody c))     Nothing -> txt (docSectionName n)   where     plain warning n doc =

@@ -5,7 +5,9 @@  -- | String literals. module Tilia.Render.Literal-  ( stringLiteral,+  ( hsLit,+    writtenString,+    stringLiteral,   ) where @@ -16,10 +18,28 @@ import Data.Text (Text) import Data.Text qualified as T import GHC.Data.FastString (FastString, unpackFS)+import GHC.Hs (GhcPs, HsLit (..)) import GHC.Parser.CharClass (is_space)+import GHC.Types.SourceText (SourceText (..), StringLiteral (..)) import Tilia.Doc.Combinators import Tilia.Render.Layout (Position (..), positioned)+import Tilia.Render.Name (outputable) +-- | A literal, a string one as its author wrote it.+hsLit :: HsLit GhcPs -> Doc+hsLit = \case+  HsString (SourceText s) _ -> stringLiteral s+  HsStringPrim (SourceText s) _ -> stringLiteral s+  HsMultilineString (SourceText s) _ -> stringLiteral s+  other -> outputable other++-- | A string literal as its author wrote it, or the bare text it holds where+-- none was written, as for an unquoted @SCC@ label.+writtenString :: StringLiteral -> Doc+writtenString l = case sl_st l of+  SourceText s -> stringLiteral s+  NoSourceText -> txt (T.pack (unpackFS (sl_fs l)))+ -- | A string literal, from the text the author wrote. stringLiteral :: FastString -> Doc stringLiteral src = case takeApart (T.pack (unpackFS src)) of@@ -33,10 +53,7 @@   where     body = case litKind literal of       Regular -> variant onOneLine acrossLines-      Multiline ->-        sepBy-          (verbatimBreak AtIndent KeepWhitespace)-          (fmap txt (litParts literal))+      Multiline -> verbatimLines AtIndent KeepWhitespace (litParts literal)     onOneLine = txt (joinParts (litParts literal))     acrossLines =       sepBy breakOrSpace (fmap continued (positioned (litParts literal)))

@@ -22,10 +22,10 @@ import GHC.Hs import GHC.Types.Basic (Arity, Boxity (..), ConTag) import GHC.Types.Name.Reader (RdrName)-import GHC.Types.SrcLoc (GenLocated (..)) import Tilia.Doc.Combinators import Tilia.Render.Context import Tilia.Render.Layout+import Tilia.Render.Literal (hsLit) import Tilia.Render.Name import Tilia.Render.Type import Tilia.Span@@ -37,14 +37,12 @@  -- | A pattern whose outermost bracket closes where it is told to. hsPatClosing :: Ctx -> ClosingIndent -> LPat GhcPs -> Doc-hsPatClosing ctx = hsPatIn ctx NoBrace (Isn't #inAsPat)+hsPatClosing ctx = hsPatIn ctx (Isn't #inAsPat)  -- | A pattern that knows where it stands. hsPatIn ::   -- | The context.   Ctx ->-  -- | Bracing an or-pattern inherits.-  Bracing ->   -- | Is this inside an as-pattern?   Choice "inAsPat" ->   -- | Where its outermost bracket closes.@@ -52,15 +50,13 @@   -- | The pattern.   LPat GhcPs ->   Doc-hsPatIn ctx bracing inAsPat closing l =-  at ctx l (patBody ctx bracing inAsPat closing (spanOf l))+hsPatIn ctx inAsPat closing l =+  at ctx l (patBody ctx inAsPat closing (spanOf l))  -- | Every shape a pattern can take. patBody ::   -- | The context.   Ctx ->-  -- | Bracing an or-pattern inherits.-  Bracing ->   -- | Is this inside an as-pattern?   Choice "inAsPat" ->   -- | Where its outermost bracket closes.@@ -70,12 +66,12 @@   -- | The pattern.   Pat GhcPs ->   Doc-patBody ctx bracing inAsPat closing here = \case+patBody ctx inAsPat closing here = \case   WildPat _ -> txt "_"   VarPat _ n -> name ctx n   LazyPat _ p -> txt "~" <> recur p   AsPat _ n p ->-    name ctx n <> txt "@" <> hsPatIn ctx bracing (Is #inAsPat) Indented p+    name ctx n <> txt "@" <> hsPatIn ctx (Is #inAsPat) Indented p   ParPat _ p -> parensWith closing (insideBrackets here (recur p))   BangPat _ p -> txt "!" <> recur p   ListPat _ ps ->@@ -86,16 +82,16 @@       closing       (insideBrackets here (commaSep (fmap (align . recur) ps)))   OrPat _ ps ->-    itemsSepBy (fromBool (isTrue inAsPat)) bracing (fmap recur (NE.toList ps))+    itemsSepBy (fromBool (isTrue inAsPat)) NoBrace (fmap recur (NE.toList ps))   SumPat _ p tag arity -> unboxedSum closing tag arity (recur p)-  ConPat _ con details -> conPattern ctx bracing inAsPat here con details+  ConPat _ con details -> conPattern ctx inAsPat here con details   ViewPat _ e p ->     align $       knotExpr (ctxKnot ctx) ctx plainSite e         <> joinedBy "->"         <> indent (recur p)   SplicePat _ splice -> knotSplice (ctxKnot ctx) ctx DollarSplice splice-  LitPat _ lit -> outputable lit+  LitPat _ lit -> hsLit lit   NPat _ v (isJust -> negated) _ ->     includeWhen negated (txt "-" <> negativeLiteralGap ctx)       <> at ctx v (outputable . ol_val)@@ -109,14 +105,12 @@   EmbTyPat _ (HsTP _ ty) -> txt "type" <> space <> hsType ctx ty   InvisPat _ (HsTP _ ty) -> txt "@" <> hsType ctx ty   where-    recur = hsPatIn ctx bracing inAsPat Indented+    recur = hsPatIn ctx inAsPat Indented  -- | A constructor pattern, in whichever of its three forms. conPattern ::   -- | The context.   Ctx ->-  -- | Bracing an or-pattern inherits.-  Bracing ->   -- | Is this inside an as-pattern?   Choice "inAsPat" ->   -- | Where the pattern was written.@@ -126,7 +120,7 @@   -- | What it was applied to.   HsConPatDetails GhcPs ->   Doc-conPattern ctx bracing inAsPat here con = \case+conPattern ctx inAsPat here con = \case   PrefixCon args ->     align $       name ctx con@@ -141,13 +135,12 @@       recur l         <> attachOperator Normal (spanOf l) (spanOf con) (spanOf r) (name ctx con) (recur r)   where-    recur = hsPatIn ctx bracing inAsPat Indented+    recur = hsPatIn ctx inAsPat Indented     field = either wildcard (at_ ctx (patFieldBind ctx))     wildcard l = at ctx l (const (txt ".."))     visibleFields dotdot fields = case dotdot of       Nothing -> Right <$> fields-      Just l@(L _ (RecFieldsDotDot n)) ->-        (Right <$> take n fields) <> [Left l]+      Just l -> (Right <$> fields) <> [Left l]  -- | One field of a record pattern. patFieldBind :: Ctx -> HsRecField GhcPs (LPat GhcPs) -> Doc

@@ -26,6 +26,7 @@ import GHC.Unit.Module.Warnings import Tilia.Doc.Combinators import Tilia.Render.Context+import Tilia.Render.Literal (writtenString) import Tilia.Render.Name  -- | Wrap a body in pragma braces.@@ -121,5 +122,5 @@ -- | One message is written bare; several go in a list. literalList :: [LocatedE StringLiteral] -> Doc literalList = \case-  [l] -> outputable l-  ls -> brackets (commaSep (fmap outputable ls))+  [l] -> writtenString (unLoc l)+  ls -> brackets (commaSep (fmap (writtenString . unLoc) ls))

@@ -23,7 +23,6 @@     InlinePragma (..),     InlineSpec (..),     RuleMatchInfo (..),-    RuleName,   ) import GHC.Types.Fixity (Fixity (..), FixityDirection (..)) import GHC.Types.Name.Reader (RdrName)@@ -32,6 +31,7 @@ import Tilia.Doc.Combinators import Tilia.Render.Context import Tilia.Render.Expression (hsExpr)+import Tilia.Render.Literal (writtenString) import Tilia.Render.Name import Tilia.Render.Pragma import Tilia.Render.Type@@ -68,7 +68,7 @@   -- | The type they are given.   LHsSigType GhcPs ->   Doc-typeSig _ _ [] _ = mempty+typeSig _ _ [] _ = error "Tilia: a signature names something" typeSig ctx indentTail (n : ns) sigType   | null ns = name ctx n <> typeAscription ctx sigType   | otherwise =@@ -158,8 +158,8 @@               (joinedBy "::" <> commaSep (fmap (hsSigType ctx) types))         )   where-    -- A pragma that says neither when to inline nor whether to is saying-    -- nothing, so the phase is left off rather than printed as @[~]@.+    -- A @NOINLINE@ written without a phase reads as never active, so that+    -- phase is left off rather than printed as @[~]@.     phase = case (inl_inline, inl_act) of       (NoInline _, NeverActive) -> mempty       _ -> activation inl_act@@ -223,7 +223,7 @@ sccSig :: Ctx -> LocatedN RdrName -> Maybe (XRec GhcPs StringLiteral) -> Doc sccSig ctx n literal =   pragma "SCC" . indent $-    name ctx n <> foldMap (\l -> breakOrSpace <> outputable l) literal+    name ctx n <> foldMap (\l -> breakOrSpace <> writtenString (unLoc l)) literal  -- | @type T :: k@. standaloneKindSig :: Ctx -> StandaloneKindSig GhcPs -> Doc@@ -250,8 +250,8 @@  -- | One rule of a @RULES@ block. ruleDecl :: Ctx -> RuleDecl GhcPs -> Doc-ruleDecl ctx (HsRule _ ruleName phase binders lhs rhs) =-  at ctx ruleName ruleNameLiteral+ruleDecl ctx (HsRule (_, written) ruleName phase binders lhs rhs) =+  at ctx ruleName (\n -> writtenString (StringLiteral written n Nothing))     <> space     <> activation phase     <> space@@ -263,11 +263,6 @@           <> txt "="           <> indent (breakOrSpace <> hsExpr ctx rhs)       )---- | A rule's name is a string literal, and printing it as one is what puts--- the quotes back.-ruleNameLiteral :: RuleName -> Doc-ruleNameLiteral n = outputable (HsString NoSourceText n :: HsLit GhcPs)  -- | The @forall@s a rule or a @SPECIALIZE@ pragma binds. ruleBinders :: Ctx -> RuleBndrs GhcPs -> Doc

@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -27,6 +26,7 @@     typeArgument,     typeArgSpan,     typeIsDocumented,+    typeBreak,     asSigType,   ) where@@ -143,7 +143,7 @@     HsRecTy _ fields -> recordFields ctx Nothing fields   where     recur = typeBody ctx documented Nothing-    betweenArgs = if isTrue documented then hardBreak else breakOrSpace+    betweenArgs = typeBreak (isTrue documented)  -- | A chain of type operators, regrouped by precedence. typeChain :: Ctx -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> Doc@@ -193,8 +193,8 @@   IsPromoted -> txt "'"   NotPromoted -> mempty --- | The tick on a promoted name, held off it when the name itself begins--- with one, since @''@ is the spelling of a type-level quote.+-- | The tick on a promoted name, held off it where the name's second+-- character is a tick too, as @'B'@ would read as a character literal. promotion :: PromotionFlag -> LocatedN RdrName -> Doc promotion NotPromoted _ = mempty promotion IsPromoted n =@@ -234,6 +234,11 @@   SrcStrict -> txt "!"   NoSrcStrict -> mempty +-- | The break between the parts of a type, a hard one where the type+-- carries documentation, which ends its line.+typeBreak :: Bool -> Doc+typeBreak documented = if documented then hardBreak else breakOrSpace+ -- | Does any argument of this type carry documentation? typeIsDocumented :: HsType GhcPs -> Bool typeIsDocumented = any documented . spine@@ -269,11 +274,9 @@       _ -> t  -- | A context standing to the left of a @=>@, with the arrow and the break--- after it, or nothing where the context is empty.+-- after it. leftContext :: Ctx -> LHsContext GhcPs -> Doc-leftContext ctx ctxt-  | null (unLoc ctxt) = mempty-  | otherwise = context ctx ctxt <> joinedBy "=>"+leftContext ctx ctxt = context ctx ctxt <> joinedBy "=>"  -- | A context over anything that can stand as a constraint. contextOf ::@@ -390,18 +393,14 @@ hsSigTypeBody ctx HsSig{..} =   outerBndrs ctx afterBinders sig_bndrs <> hsType ctx sig_body   where-    afterBinders-      | typeIsDocumented (unLoc sig_body) = hardBreak-      | otherwise = breakOrSpace+    afterBinders = typeBreak (typeIsDocumented (unLoc sig_body))  -- | The @:: t@ that follows a name. typeAscription :: Ctx -> LHsSigType GhcPs -> Doc typeAscription ctx sigType =   indent (space <> txt "::" <> separator <> hsSigType ctx sigType)   where-    separator-      | typeIsDocumented (unLoc (sig_body (unLoc sigType))) = hardBreak-      | otherwise = breakOrSpace+    separator = typeBreak (typeIsDocumented (unLoc (sig_body (unLoc sigType))))  -- | Give a plain type the shape of a signature type. asSigType :: LHsType GhcPs -> LHsSigType GhcPs

@@ -25,16 +25,16 @@   ) where +import Control.Exception (evaluate) import Data.ByteString qualified as BS import Data.List (sortOn) import Data.Map.Strict qualified as Map import Data.Text (Text) import Data.Text qualified as T-import Data.Text.Encoding qualified as T import System.FilePath (takeExtension) import Tilia.Diff (diffInFull) import Tilia.Format-  ( FormatError (Unreadable),+  ( FormatError (Threw, Unreadable),     Session,     describeFormatError,     formatErrorExitCode,@@ -49,8 +49,9 @@     byteOrderMark,     inParallel,     indent,-    lineWidth,-    wrapTo,+    tshow,+    wrappedUnder,+    writeUtf8File,   )  ----------------------------------------------------------------------------@@ -107,7 +108,7 @@ runOver session = inParallel one   where     one path = do-      !outcome <-+      outcome <-         readAsUtf8 path >>= \case           Left why -> pure (Failed (Unreadable path why))           Right before -> outcomeOf session path before@@ -123,10 +124,13 @@   Text ->   IO Outcome outcomeOf session path before =-  formatSource session path (setNewlineStyle Lf source) >>= \case-    Left e -> pure (if refused e then Declined e else Failed e)-    Right formatted -> pure (formattingOutcome before (mark <> formatted))+  either (Failed . Threw path) id+    <$> attempted (evaluate . outcome =<< formatted)   where+    formatted = formatSource session path (setNewlineStyle Lf source)+    outcome = \case+      Left e -> if refused e then Declined e else Failed e+      Right it -> formattingOutcome before (mark <> it)     (mark, source) = byteOrderMark before  -- | Read a source file as UTF-8.@@ -152,7 +156,7 @@ -- | Put a formatted file back, and only if it changed. writeBack :: (FilePath, Outcome) -> IO () writeBack (path, outcome) = case outcome of-  Changed _ after -> BS.writeFile path (T.encodeUtf8 after)+  Changed _ after -> writeUtf8File path after   _ -> pure ()  ----------------------------------------------------------------------------@@ -274,17 +278,14 @@ -- | Render the number of files. count :: Palette -> Int -> Text -> Text count palette n extension =-  T.pack (show n)+  tshow n     <> " "     <> paint palette Place extension     <> (if n == 1 then " file" else " files")  -- | One case among several, opened by a bullet and wrapped underneath it. bulleted :: Palette -> FormatError -> [Text]-bulleted palette e = case wrapTo (lineWidth - 6) (describeFormatError palette e) of-  [] -> []-  (opening : rest) ->-    (indent 2 <> "· " <> opening) : fmap (indent 3 <>) rest+bulleted palette e = wrappedUnder 3 (indent 2 <> "· ") (describeFormatError palette e)  -- | Something to say under a mark of its own, wrapped to fit beneath it. noted ::@@ -293,8 +294,5 @@   (Text, Color) ->   Text ->   [Text]-noted palette (mark, color) text = case wrapTo (lineWidth - 6) text of-  [] -> []-  (opening : rest) ->-    (indent 1 <> marker palette color mark <> " " <> opening)-      : fmap (indent 3 <>) rest+noted palette (mark, color) =+  wrappedUnder 3 (indent 1 <> marker palette color mark <> " ")