tilia (empty) → 0.0.1.0
raw patch · 253 files changed
+36629/−0 lines, 253 filesdep +Cabal-syntaxdep +Diffdep +QuickCheck
Dependencies added: Cabal-syntax, Diff, QuickCheck, aeson, base, base16-bytestring, bytestring, choice, containers, cryptohash-sha256, directory, filepath, ghc-lib-parser, hspec, http-client, optparse-applicative, process, req, syb, tar, temporary, text, tilia, transformers, zlib
Files
- CHANGELOG.md +3/−0
- LICENSE.md +28/−0
- README.md +144/−0
- app/Main.hs +217/−0
- corpora/hackage/hackage.manifest +5208/−0
- corpora/hackage/hackage.report +481/−0
- corpora/vendored/declaration/class/blank-lines-between-members-out.hs +28/−0
- corpora/vendored/declaration/class/blank-lines-between-members.hs +28/−0
- corpora/vendored/declaration/data/comment-above-a-documented-brace-out.hs +10/−0
- corpora/vendored/declaration/data/comment-above-a-documented-brace.hs +10/−0
- corpora/vendored/declaration/data/comment-above-a-moved-haddock-out.hs +9/−0
- corpora/vendored/declaration/data/comment-above-a-moved-haddock.hs +8/−0
- corpora/vendored/declaration/data/comment-in-record-braces-out.hs +9/−0
- corpora/vendored/declaration/data/comment-in-record-braces.hs +7/−0
- corpora/vendored/declaration/data/haddock-with-a-blank-under-it-out.hs +8/−0
- corpora/vendored/declaration/data/haddock-with-a-blank-under-it.hs +8/−0
- corpora/vendored/declaration/type/lone-variable-context-out.hs +22/−0
- corpora/vendored/declaration/type/lone-variable-context.hs +22/−0
- corpora/vendored/declaration/value/comment-across-a-separator-out.hs +29/−0
- corpora/vendored/declaration/value/comment-across-a-separator.hs +26/−0
- corpora/vendored/declaration/value/comment-after-do-out.hs +8/−0
- corpora/vendored/declaration/value/comment-after-do.hs +8/−0
- corpora/vendored/declaration/value/comment-below-keyword-out.hs +27/−0
- corpora/vendored/declaration/value/comment-below-keyword.hs +27/−0
- corpora/vendored/declaration/value/comment-carried-on-out.hs +40/−0
- corpora/vendored/declaration/value/comment-carried-on.hs +38/−0
- corpora/vendored/declaration/value/comment-in-operator-chain-out.hs +20/−0
- corpora/vendored/declaration/value/comment-in-operator-chain.hs +22/−0
- corpora/vendored/declaration/value/comment-on-record-wildcard-out.hs +28/−0
- corpora/vendored/declaration/value/comment-on-record-wildcard.hs +28/−0
- corpora/vendored/declaration/value/function/arrow/comment-after-a-command-do-out.hs +7/−0
- corpora/vendored/declaration/value/function/arrow/comment-after-a-command-do.hs +7/−0
- corpora/vendored/declaration/value/operator-chain-precedence-out.hs +25/−0
- corpora/vendored/declaration/value/operator-chain-precedence.hs +21/−0
- corpora/vendored/declaration/value/quoted-type-arguments-out.hs +36/−0
- corpora/vendored/declaration/value/quoted-type-arguments.hs +32/−0
- corpora/vendored/import/a-comment-with-no-name-after-it-out.hs +10/−0
- corpora/vendored/import/a-comment-with-no-name-after-it.hs +10/−0
- corpora/vendored/import/comment-in-import-list-out.hs +8/−0
- corpora/vendored/import/comment-in-import-list.hs +6/−0
- corpora/vendored/import/comment-inside-a-repeated-import-out.hs +17/−0
- corpora/vendored/import/comment-inside-a-repeated-import.hs +17/−0
- corpora/vendored/import/comment-inside-import-out.hs +3/−0
- corpora/vendored/import/comment-inside-import.hs +3/−0
- corpora/vendored/import/merging-around-an-anchored-comment-out.hs +13/−0
- corpora/vendored/import/merging-around-an-anchored-comment.hs +11/−0
- corpora/vendored/import/merging-keeps-a-comment-above-a-name-out.hs +11/−0
- corpora/vendored/import/merging-keeps-a-comment-above-a-name.hs +11/−0
- corpora/vendored/import/merging-keeps-a-comment-above-the-block-out.hs +10/−0
- corpora/vendored/import/merging-keeps-a-comment-above-the-block.hs +8/−0
- corpora/vendored/import/merging-keeps-a-comment-inside-a-thing-out.hs +12/−0
- corpora/vendored/import/merging-keeps-a-comment-inside-a-thing.hs +12/−0
- corpora/vendored/import/merging-keeps-a-trailing-comment-out.hs +10/−0
- corpora/vendored/import/merging-keeps-a-trailing-comment.hs +10/−0
- corpora/vendored/import/sorting-keeps-comments-with-their-names-out.hs +11/−0
- corpora/vendored/import/sorting-keeps-comments-with-their-names.hs +11/−0
- corpora/vendored/other/block-comment-above-a-haddock-out.hs +6/−0
- corpora/vendored/other/block-comment-above-a-haddock.hs +6/−0
- corpora/vendored/other/block-comment-under-a-haddock-out.hs +6/−0
- corpora/vendored/other/block-comment-under-a-haddock.hs +6/−0
- corpora/vendored/other/comment-above-the-first-binding-out.hs +9/−0
- corpora/vendored/other/comment-above-the-first-binding.hs +9/−0
- corpora/vendored/other/comment-above-the-in-keyword-out.hs +8/−0
- corpora/vendored/other/comment-above-the-in-keyword.hs +7/−0
- corpora/vendored/other/comment-after-closing-bracket-out.hs +27/−0
- corpora/vendored/other/comment-after-closing-bracket.hs +22/−0
- corpora/vendored/other/comment-after-header-pragma-out.hs +8/−0
- corpora/vendored/other/comment-after-header-pragma.hs +9/−0
- corpora/vendored/other/comment-after-opening-bracket-out.hs +37/−0
- corpora/vendored/other/comment-after-opening-bracket.hs +26/−0
- corpora/vendored/other/comment-after-the-in-keyword-out.hs +7/−0
- corpora/vendored/other/comment-after-the-in-keyword.hs +7/−0
- corpora/vendored/other/comment-after-the-let-keyword-out.hs +8/−0
- corpora/vendored/other/comment-after-the-let-keyword.hs +8/−0
- corpora/vendored/other/comment-before-closing-bracket-out.hs +23/−0
- corpora/vendored/other/comment-before-closing-bracket.hs +17/−0
- corpora/vendored/other/comment-between-let-bindings-out.hs +8/−0
- corpora/vendored/other/comment-between-let-bindings.hs +8/−0
- corpora/vendored/other/comment-carried-on-past-its-second-line-out.hs +21/−0
- corpora/vendored/other/comment-carried-on-past-its-second-line.hs +21/−0
- corpora/vendored/other/comment-held-off-a-haddock-out.hs +8/−0
- corpora/vendored/other/comment-held-off-a-haddock.hs +7/−0
- corpora/vendored/other/comment-in-a-do-let-out.hs +8/−0
- corpora/vendored/other/comment-in-a-do-let.hs +8/−0
- corpora/vendored/other/comment-in-a-one-line-let-out.hs +4/−0
- corpora/vendored/other/comment-in-a-one-line-let.hs +4/−0
- corpora/vendored/other/comment-over-a-hoisted-pragma-out.hs +9/−0
- corpora/vendored/other/comment-over-a-hoisted-pragma.hs +11/−0
- corpora/vendored/other/comment-paragraph-trailing-the-module-out.hs +12/−0
- corpora/vendored/other/comment-paragraph-trailing-the-module.hs +12/−0
- corpora/vendored/other/comment-spliced-into-a-line-out.hs +7/−0
- corpora/vendored/other/comment-spliced-into-a-line.hs +5/−0
- corpora/vendored/other/comment-trailing-a-let-binding-out.hs +7/−0
- corpora/vendored/other/comment-trailing-a-let-binding.hs +7/−0
- corpora/vendored/other/comment-trailing-the-last-let-binding-out.hs +7/−0
- corpora/vendored/other/comment-trailing-the-last-let-binding.hs +7/−0
- corpora/vendored/other/comment-under-a-block-haddock-out.hs +6/−0
- corpora/vendored/other/comment-under-a-block-haddock.hs +6/−0
- corpora/vendored/other/comment-under-a-hoisted-pragma-out.hs +17/−0
- corpora/vendored/other/comment-under-a-hoisted-pragma.hs +16/−0
- corpora/vendored/other/cpp/branch-with-a-where-clause-out.hs +13/−0
- corpora/vendored/other/cpp/branch-with-a-where-clause.hs +13/−0
- corpora/vendored/other/cpp/comments-in-branches-out.hs +16/−0
- corpora/vendored/other/cpp/comments-in-branches.hs +16/−0
- corpora/vendored/other/cpp/conditional-imports-out.hs +12/−0
- corpora/vendored/other/cpp/conditional-imports.hs +12/−0
- corpora/vendored/other/cpp/define-across-lines-out.hs +10/−0
- corpora/vendored/other/cpp/define-across-lines.hs +10/−0
- corpora/vendored/other/cpp/define-ended-by-a-blank-line-out.hs +12/−0
- corpora/vendored/other/cpp/define-ended-by-a-blank-line.hs +12/−0
- corpora/vendored/other/cpp/define-in-a-quasiquote.hs +12/−0
- corpora/vendored/other/cpp/define-out.hs +8/−0
- corpora/vendored/other/cpp/define.hs +8/−0
- corpora/vendored/other/cpp/directive-above-a-trailing-comment-out.hs +12/−0
- corpora/vendored/other/cpp/directive-above-a-trailing-comment.hs +12/−0
- corpora/vendored/other/cpp/directive-after-a-conditional-out.hs +18/−0
- corpora/vendored/other/cpp/directive-after-a-conditional.hs +18/−0
- corpora/vendored/other/cpp/directive-outside-conditionals-out.hs +21/−0
- corpora/vendored/other/cpp/directive-outside-conditionals.hs +21/−0
- corpora/vendored/other/cpp/elif-chain-out.hs +15/−0
- corpora/vendored/other/cpp/elif-chain.hs +15/−0
- corpora/vendored/other/cpp/imports-in-both-branches-out.hs +21/−0
- corpora/vendored/other/cpp/imports-in-both-branches.hs +21/−0
- corpora/vendored/other/cpp/inside-a-binding-group-out.hs +14/−0
- corpora/vendored/other/cpp/inside-a-binding-group.hs +14/−0
- corpora/vendored/other/cpp/inside-a-signature-out.hs +12/−0
- corpora/vendored/other/cpp/inside-a-signature.hs +12/−0
- corpora/vendored/other/cpp/inside-an-expression-out.hs +16/−0
- corpora/vendored/other/cpp/inside-an-expression.hs +16/−0
- corpora/vendored/other/cpp/more-configurations-than-formattings-out.hs +62/−0
- corpora/vendored/other/cpp/more-configurations-than-formattings.hs +62/−0
- corpora/vendored/other/cpp/nested-out.hs +19/−0
- corpora/vendored/other/cpp/nested.hs +18/−0
- corpora/vendored/other/cpp/no-alternative-out.hs +14/−0
- corpora/vendored/other/cpp/no-alternative.hs +14/−0
- corpora/vendored/other/cpp/one-guard-asked-twice-out.hs +49/−0
- corpora/vendored/other/cpp/one-guard-asked-twice.hs +43/−0
- corpora/vendored/other/cpp/same-guard-twice-out.hs +17/−0
- corpora/vendored/other/cpp/same-guard-twice.hs +18/−0
- corpora/vendored/other/cpp/side-by-side-out.hs +22/−0
- corpora/vendored/other/cpp/side-by-side.hs +22/−0
- corpora/vendored/other/cpp/spaced-hash-out.hs +14/−0
- corpora/vendored/other/cpp/spaced-hash.hs +14/−0
- corpora/vendored/other/cpp/unbalanced.hs +7/−0
- corpora/vendored/other/cpp/whole-declarations-out.hs +17/−0
- corpora/vendored/other/cpp/whole-declarations.hs +17/−0
- corpora/vendored/other/deriving-blocks-the-author-grouped-out.hs +17/−0
- corpora/vendored/other/deriving-blocks-the-author-grouped.hs +17/−0
- corpora/vendored/other/haddock-held-off-a-comment-out.hs +7/−0
- corpora/vendored/other/haddock-held-off-a-comment.hs +7/−0
- corpora/vendored/other/haddock-with-a-tight-trigger-out.hs +5/−0
- corpora/vendored/other/haddock-with-a-tight-trigger.hs +5/−0
- corpora/vendored/other/named-chunk-under-a-haddock-out.hs +10/−0
- corpora/vendored/other/named-chunk-under-a-haddock.hs +10/−0
- corpora/vendored/other/position-pragma-only-mentioned-out.hs +12/−0
- corpora/vendored/other/position-pragma-only-mentioned.hs +12/−0
- corpora/vendored/other/position-pragmas.hs +15/−0
- corpora/vendored/other/section-anchor-with-a-blank-line-out.hs +17/−0
- corpora/vendored/other/section-anchor-with-a-blank-line.hs +17/−0
- corpora/vendored/other/section-heading-under-a-haddock-out.hs +9/−0
- corpora/vendored/other/section-heading-under-a-haddock.hs +9/−0
- corpora/vendored/other/trailing-comment-over-a-moved-haddock-out.hs +9/−0
- corpora/vendored/other/trailing-comment-over-a-moved-haddock.hs +8/−0
- corpora/vendored/other/trailing-comment-with-a-gap-under-it-out.hs +9/−0
- corpora/vendored/other/trailing-comment-with-a-gap-under-it.hs +9/−0
- src/Tilia/Comments.hs +387/−0
- src/Tilia/Comments/Attach.hs +185/−0
- src/Tilia/Comments/Place.hs +191/−0
- src/Tilia/Cpp.hs +1677/−0
- src/Tilia/Cpp/Macros.hs +224/−0
- src/Tilia/Diff.hs +157/−0
- src/Tilia/Doc.hs +23/−0
- src/Tilia/Doc/Body.hs +24/−0
- src/Tilia/Doc/Combinators.hs +447/−0
- src/Tilia/Doc/Internal.hs +478/−0
- src/Tilia/Equivalence.hs +675/−0
- src/Tilia/Fixity.hs +964/−0
- src/Tilia/Fixity/Builtin.hs +1182/−0
- src/Tilia/Fixity/ByHand.hs +131/−0
- src/Tilia/Fixity/Cabal.hs +154/−0
- src/Tilia/Fixity/Cache.hs +432/−0
- src/Tilia/Fixity/Debug.hs +231/−0
- src/Tilia/Fixity/Interface.hs +211/−0
- src/Tilia/Fixity/PackageDb.hs +184/−0
- src/Tilia/Fixity/Plan.hs +1937/−0
- src/Tilia/Format.hs +425/−0
- src/Tilia/Imports.hs +306/−0
- src/Tilia/Newline.hs +37/−0
- src/Tilia/Package.hs +230/−0
- src/Tilia/Palette.hs +77/−0
- src/Tilia/Parser.hs +263/−0
- src/Tilia/Pragma.hs +106/−0
- src/Tilia/Process.hs +66/−0
- src/Tilia/Project.hs +93/−0
- src/Tilia/Render.hs +188/−0
- src/Tilia/Render/Body.hs +118/−0
- src/Tilia/Render/Class.hs +353/−0
- src/Tilia/Render/Context.hs +398/−0
- src/Tilia/Render/Data.hs +397/−0
- src/Tilia/Render/Declaration.hs +394/−0
- src/Tilia/Render/Expression.hs +1328/−0
- src/Tilia/Render/Haddock.hs +325/−0
- src/Tilia/Render/Header.hs +428/−0
- src/Tilia/Render/Layout.hs +96/−0
- src/Tilia/Render/Literal.hs +158/−0
- src/Tilia/Render/Name.hs +182/−0
- src/Tilia/Render/Operator.hs +135/−0
- src/Tilia/Render/Pattern.hs +152/−0
- src/Tilia/Render/Pragma.hs +154/−0
- src/Tilia/Render/Signature.hs +280/−0
- src/Tilia/Render/Type.hs +479/−0
- src/Tilia/Run.hs +262/−0
- src/Tilia/Source.hs +74/−0
- src/Tilia/Source/Lines.hs +123/−0
- src/Tilia/Span.hs +118/−0
- src/Tilia/Span/Ghc.hs +45/−0
- src/Tilia/Target.hs +352/−0
- src/Tilia/Utils.hs +60/−0
- tests/Main.hs +82/−0
- tests/Spec.hs +1/−0
- tests/Tilia/Comments/PlaceSpec.hs +230/−0
- tests/Tilia/CommentsSpec.hs +231/−0
- tests/Tilia/Corpus.hs +1030/−0
- tests/Tilia/Corpus/Manifest.hs +183/−0
- tests/Tilia/CorpusSpec.hs +479/−0
- tests/Tilia/Cpp/MacrosSpec.hs +223/−0
- tests/Tilia/Cpp/PropertiesSpec.hs +208/−0
- tests/Tilia/CppSpec.hs +827/−0
- tests/Tilia/Doc/BodySpec.hs +68/−0
- tests/Tilia/Doc/CombinatorsSpec.hs +105/−0
- tests/Tilia/Doc/InternalSpec.hs +90/−0
- tests/Tilia/Doc/PropertiesSpec.hs +98/−0
- tests/Tilia/EquivalenceSpec.hs +177/−0
- tests/Tilia/Fixity/CabalSpec.hs +221/−0
- tests/Tilia/Fixity/CacheSpec.hs +321/−0
- tests/Tilia/Fixity/DebugSpec.hs +227/−0
- tests/Tilia/Fixity/DependenciesSpec.hs +374/−0
- tests/Tilia/Fixity/InterfaceSpec.hs +204/−0
- tests/Tilia/Fixity/PackageDbSpec.hs +57/−0
- tests/Tilia/Fixity/PlanSpec.hs +1517/−0
- tests/Tilia/FixitySpec.hs +757/−0
- tests/Tilia/Gen.hs +185/−0
- tests/Tilia/NewlineSpec.hs +48/−0
- tests/Tilia/PackageSpec.hs +218/−0
- tests/Tilia/PragmaSpec.hs +82/−0
- tests/Tilia/ProcessSpec.hs +50/−0
- tests/Tilia/ProjectSpec.hs +130/−0
- tests/Tilia/Render/OperatorSpec.hs +89/−0
- tests/Tilia/RenderSpec.hs +346/−0
- tests/Tilia/RunSpec.hs +512/−0
- tests/Tilia/TargetSpec.hs +307/−0
- tests/Tilia/TestConfig.hs +192/−0
- tilia.cabal +254/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## Tilia 0.0.1.0++* Initial release.
+ LICENSE.md view
@@ -0,0 +1,28 @@+Copyright © 2026–present Mark Karpov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++* Neither the name Mark Karpov nor the names of contributors may be used to+ endorse or promote products derived from this software without specific+ prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN+NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,144 @@+# Tilia++Tilia is a formatter for Haskell source code. Its primary design choices+are:++* Use `ghc-lib-parser` for parsing, thus achieving correct parsing at all+ times.+* Let single vs multiline layout be influenced by the input.+* Admit no configuration.+* Ensure high-quality formatting of comments.+* Provide first-class support for CPP.+* Guarantee inference of operator fixity with absolute precision at all+ times.++## Getting started++The two most useful (and only!) commands are `inplace` and `check`:++```console+$ tilia inplace [COMPONENT] # format all files of COMPONENT in place+$ tilia check [COMPONENT] # check that all files of COMPONENT are formatted+```++`COMPONENT` may be omitted and in that case it defaults to `all`. To be+precise, the kind of component we are talking about is exactly Cabal's+notion of component: libraries, executables, test suites, and benchmarks.+For example, in the case of Tilia itself the valid choices are:++* `all`+* `tilia`, the package, which means every component of it+* `lib:tilia` or `tilia:lib:tilia`+* `exe:tilia` or `tilia:exe:tilia`+* `test:tests` or `tilia:test:tests`, or just `tests`++It may be surprising that we talk about components rather than individual+files. Well, formatting a Haskell module, fortunately or unfortunately,+depends on much more than the input text. It depends on things like+`default-extensions`, `default-language`, and, most importantly, the actual+dependencies, because that's where the fixities of the operators you use+come from. What all these things have in common is that they are properties+of the respective Cabal components your modules belong to. Therefore, it+makes sense to consider those components the unit of formatting rather than+individual files.++Tilia respects Cabal projects as defined by `cabal.project` files. It finds+the project by starting at the working directory and walking upwards for a+`cabal.project` or a `.cabal` file. A `cabal.project` anywhere above wins+over a `.cabal` file that is nearer, so a package inside a multi-package+repository resolves to the repository. It is worth pointing out that a+package in the tree that the `packages` field does not name is not part of+the project and will not be visited. Within a package, a component's+`hs-source-dirs` say which files belong to it, and every `.hs`, `.hs-boot`,+and `.hsig` under them gets formatted.++If there is no build plan yet, or it is older than the `.cabal` and+`cabal.project` files, or it says nothing about a component you asked for,+Tilia has Cabal solve it with `cabal build all --dry-run`. If the plan is+fine but some dependencies have been neither downloaded nor built, it+fetches them with `cabal build all --only-download`. These commands do not+build anything, and both are one-time costs, since Cabal's package cache is+shared between projects. So do not worry if the first run in a project+prints a few lines from Cabal before Tilia starts formatting. Later runs+check the plan with a read and a `stat` per package.++Both of those calls also pass `--enable-tests` and `--enable-benchmarks`,+because test suites and benchmarks are components Tilia formats, but they+are often not enabled by default and that would be confusing. Where a+project will not solve with those flags, Tilia settles for what Cabal builds+by default, so you get a narrower plan rather than none.++Finally, here are some other flags that may be of interest:++* `--check-ast` performs an AST-equivalence check;+* `--check-idempotence` performs an idempotence check;+* `--debug-fixity` prints information that is useful for debugging+ formatting of operator chains.++## Formatting operator chains++There is nothing you need to know about it or do to make it work. It will+just happen, no matter where your operators come from: Hackage, Nix, private+repos, or the modules of the project you are formatting.++## Formatting CPP++CPP is a first-class formattable object to Tilia. Any Haskell syntactically+enclosed in a conditional branch will format, and it does not even need to+be self-contained valid Haskell on its own, as long as every configuration+of the module is a valid Haskell module.++## Development++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+```++## Contribution++Issues, bugs, and questions may be reported in [the GitHub issue tracker for+this project][issue-tracker].++Pull requests are also welcome.++[issue-tracker]: https://github.com/mrkkrp/tilia/issues++## License++Copyright © 2026–present Mark Karpov++Distributed under the BSD 3-clause license.
+ app/Main.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Main (main) where++import Control.Monad (when)+import Data.Choice (Choice, fromBool)+import Data.Foldable (traverse_)+import Data.Text (Text)+import Data.Text.IO qualified as T+import Data.Version (showVersion)+import GHC.IO.Encoding (TextEncoding (textEncodingName))+import Options.Applicative+import Paths_tilia (version)+import System.Directory (makeRelativeToCurrentDirectory)+import System.Exit (ExitCode (..))+import System.Exit qualified+import System.IO+ ( Handle,+ hFlush,+ hGetEncoding,+ hSetEncoding,+ mkTextEncoding,+ stderr,+ stdout,+ )+import Tilia.Fixity.Debug (renderFixityNotes)+import Tilia.Format+ ( FormatError,+ describeFormatError,+ fixityNotesOf,+ formatErrorExitCode,+ newSession,+ )+import Tilia.Palette (Color (Bad), Palette, paletteFor)+import Tilia.Parser (ghcLibParserVersion)+import Tilia.Project (findProjectRoot)+import Tilia.Run+ ( Outcome,+ Report (..),+ checkReport,+ differs,+ exitCodeOf,+ inplaceReport,+ noted,+ runOver,+ writeBack,+ )+import Tilia.Target+ ( Component,+ Target,+ componentInPlan,+ componentsOfTarget,+ describeTargetProblem,+ filesOfComponents,+ parseTarget,+ )+import Tilia.Utils (lineWidth, quietly)++-- | The program's entry point.+main :: IO ()+main = do+ traverse_ transliterateUnprintable [stdout, stderr]+ Opts {..} <- customExecParser (prefs (columns lineWidth)) optsParserInfo+ palette <- paletteFor+ target <-+ either+ (die usageExitCode palette)+ pure+ (maybe (parseTarget "all") parseTarget optTarget)+ components <- componentsFor palette target+ files <-+ traverse makeRelativeToCurrentDirectory+ =<< filesOfComponents components+ session <-+ newSession+ "."+ (componentInPlan <$> components)+ optCheckAst+ optCheckIdempotence+ optDebugFixity+ >>= either (dieFormatting palette) pure+ outcomes <- runOver session files+ fixityNotesOf session+ >>= traverse_ (T.hPutStrLn stderr) . renderFixityNotes palette+ case optMode of+ Inplace -> do+ traverse_ writeBack outcomes+ printReport (inplaceReport palette outcomes)+ Check -> printReport (checkReport palette outcomes)+ exitWith optMode outcomes++-- | Transliterate unprintable characters if the stream cannot handle them.+transliterateUnprintable :: Handle -> IO ()+transliterateUnprintable h =+ quietly () $+ hGetEncoding h >>= \case+ Just encoding+ | name <- textEncodingName encoding,+ '/' `notElem` name ->+ hSetEncoding h =<< mkTextEncoding (name <> "//TRANSLIT")+ _ -> pure ()++-- | Exit the way the run turned out.+exitWith :: Mode -> [(FilePath, Outcome)] -> IO ()+exitWith mode outcomes = case exitCodeOf outcomes of+ Just code -> System.Exit.exitWith (ExitFailure code)+ Nothing -> case mode of+ Inplace -> pure ()+ Check -> when (any (differs . snd) outcomes) (System.Exit.exitWith (ExitFailure 1))++-- | Print a 'Report'.+printReport :: Report -> IO ()+printReport report = do+ traverse_ T.putStrLn (reportOut report)+ hFlush stdout+ traverse_ (T.hPutStrLn stderr) (reportErr report)+ hFlush stderr++-- | Every component the target asks for.+componentsFor :: Palette -> Target -> IO [Component]+componentsFor palette target =+ findProjectRoot "." >>= \case+ Nothing ->+ die 2 palette "no cabal.project or .cabal file at or above the working directory"+ Just root ->+ componentsOfTarget root target >>= \case+ Left problem -> die usageExitCode palette (describeTargetProblem problem)+ Right components -> pure components++-- | What @sysexits.h@ has called a usage error since 4.3BSD, and well clear+-- of the codes 'formatErrorExitCode' returns.+usageExitCode :: Int+usageExitCode = 64++-- | Give up, under the same mark a failed file wears.+die :: Int -> Palette -> Text -> IO a+die code palette why = do+ traverse_ (T.hPutStrLn stderr) (noted palette ("✗", Bad) why)+ System.Exit.exitWith (ExitFailure code)++-- | Print out the 'FormatError' and exit.+dieFormatting :: Palette -> FormatError -> IO a+dieFormatting palette e =+ die (formatErrorExitCode e) palette (describeFormatError palette e)++----------------------------------------------------------------------------+-- Command line options++-- | What a run was asked to do.+data Mode = Inplace | Check++-- | The options a run was given.+data Opts = Opts+ { -- | The mode of operation.+ optMode :: Mode,+ -- | Which component to work on, if not all of them.+ optTarget :: Maybe String,+ -- | Whether to check AST equivalence.+ optCheckAst :: Choice "checkAst",+ -- | Whether to check idempotence.+ optCheckIdempotence :: Choice "checkIdempotence",+ -- | Whether to print debugging information about fixities.+ optDebugFixity :: Choice "debugFixity"+ }++optsParserInfo :: ParserInfo Opts+optsParserInfo =+ info (helper <*> versionOption <*> optsParser) . mconcat $+ [ fullDesc,+ progDesc "Format Haskell source code",+ header "tilia - a formatter for Haskell source code"+ ]+ where+ versionOption =+ infoOption+ ("tilia " ++ showVersion version ++ "\nusing ghc-lib-parser " ++ ghcLibParserVersion)+ (long "version" <> short 'v' <> help "Print version of the program")++optsParser :: Parser Opts+optsParser =+ hsubparser . mconcat $+ [ command "inplace" (info (parser Inplace) (progDesc "Format files, in place")),+ command "check" (info (parser Check) (progDesc "Report what formatting would change, and fail if anything would"))+ ]+ where+ parser mode =+ Opts mode+ <$> optional targetArgument+ <*> checkAstSwitch+ <*> checkIdempotenceSwitch+ <*> debugFixitySwitch+ checkAstSwitch =+ fromBool+ <$> (switch . mconcat)+ [ long "check-ast",+ help "Check AST equivalence"+ ]+ checkIdempotenceSwitch =+ fromBool+ <$> (switch . mconcat)+ [ long "check-idempotence",+ help "Check idempotence"+ ]+ debugFixitySwitch =+ fromBool+ <$> (switch . mconcat)+ [ long "debug-fixity",+ help "Print debugging information about fixities"+ ]+ targetArgument =+ (strArgument . mconcat)+ [ metavar "COMPONENT",+ help "Component to format: all (the default) or a package/component name"+ ]
+ corpora/hackage/hackage.manifest view
@@ -0,0 +1,5208 @@+# What each example of this corpus does today, one line each.+# Generated: run the test suite with TILIA_CORPUS_ACCEPT=1.+# See Tilia.Corpus.Manifest for what the outcomes mean, and the+# matching .report for why each example that is not `formatted` is+# not.++formatted 8deb10445c00 Agda-2.8.0/src/agda-mode/Main.hs+formatted 4e93ad007cfb Agda-2.8.0/src/data/MAlonzo/src/MAlonzo/RTE.hs+formatted 4e3f28ed5e54 Agda-2.8.0/src/data/MAlonzo/src/MAlonzo/RTE/Float.hs+formatted 111f8e7154e9 Agda-2.8.0/src/full/Agda/Benchmarking.hs+formatted 8080793f0fa5 Agda-2.8.0/src/full/Agda/Compiler/Backend.hs+formatted 98789e7a7f39 Agda-2.8.0/src/full/Agda/Compiler/Backend/Base.hs+formatted b8be5cf3b8d8 Agda-2.8.0/src/full/Agda/Compiler/Builtin.hs+formatted ef45f44548b6 Agda-2.8.0/src/full/Agda/Compiler/CallCompiler.hs+formatted c83ed61f571c Agda-2.8.0/src/full/Agda/Compiler/Common.hs+formatted 591432260542 Agda-2.8.0/src/full/Agda/Compiler/JS/Compiler.hs+formatted ca0717d44b6a Agda-2.8.0/src/full/Agda/Compiler/JS/Pretty.hs+formatted f3ee347549c0 Agda-2.8.0/src/full/Agda/Compiler/JS/Substitution.hs+formatted bb8f414ff908 Agda-2.8.0/src/full/Agda/Compiler/JS/Syntax.hs+formatted 38a999dc0841 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Coerce.hs+formatted 724b18d39db9 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Compiler.hs+formatted a5e37499e9c4 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Encode.hs+formatted bf9e10f9443d Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/HaskellTypes.hs+formatted aa62f795f1b2 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Misc.hs+formatted 63bb8f6c7f1d Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Pragmas.hs+formatted 550643b1a281 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Pretty.hs+formatted 8431d6301172 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Primitives.hs+formatted d1a6c45e8549 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Strict.hs+formatted 5024f9b4392b Agda-2.8.0/src/full/Agda/Compiler/ToTreeless.hs+formatted fcf0c3d029c1 Agda-2.8.0/src/full/Agda/Compiler/Treeless/AsPatterns.hs+formatted e4084ca4a00b Agda-2.8.0/src/full/Agda/Compiler/Treeless/Builtin.hs+formatted ce128b9cab5e Agda-2.8.0/src/full/Agda/Compiler/Treeless/Compare.hs+formatted f24d73001033 Agda-2.8.0/src/full/Agda/Compiler/Treeless/EliminateDefaults.hs+formatted ebfd63fc43ed Agda-2.8.0/src/full/Agda/Compiler/Treeless/EliminateLiteralPatterns.hs+formatted d11b630a3f26 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Erase.hs+formatted 4bf71aa72967 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Erase.hs-boot+formatted e3c866a3b262 Agda-2.8.0/src/full/Agda/Compiler/Treeless/GuardsToPrims.hs+formatted 861aba1dcf19 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Identity.hs+formatted 39d8ddd0447e Agda-2.8.0/src/full/Agda/Compiler/Treeless/NormalizeNames.hs+formatted 79a064f98a58 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Pretty.hs+formatted 9e9ffec9fb88 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Pretty.hs-boot+formatted cca1261b95c2 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Simplify.hs+formatted 3750c8bfe53a Agda-2.8.0/src/full/Agda/Compiler/Treeless/Subst.hs+formatted e0117fa2b8cc Agda-2.8.0/src/full/Agda/Compiler/Treeless/Uncase.hs+formatted 185411c97f8d Agda-2.8.0/src/full/Agda/Compiler/Treeless/Unused.hs+formatted 3985ec175c5f Agda-2.8.0/src/full/Agda/ImpossibleTest.hs+formatted 2dd615d81e66 Agda-2.8.0/src/full/Agda/Interaction/AgdaTop.hs+formatted e41de99732fd Agda-2.8.0/src/full/Agda/Interaction/Base.hs+formatted e47314761701 Agda-2.8.0/src/full/Agda/Interaction/BasicOps.hs+formatted a799c433771a Agda-2.8.0/src/full/Agda/Interaction/BuildLibrary.hs+formatted eb4048782016 Agda-2.8.0/src/full/Agda/Interaction/Command.hs+formatted 27569f5bd988 Agda-2.8.0/src/full/Agda/Interaction/CommandLine.hs+formatted ab83a5beeab5 Agda-2.8.0/src/full/Agda/Interaction/EmacsCommand.hs+formatted 555155a56d86 Agda-2.8.0/src/full/Agda/Interaction/EmacsTop.hs+formatted 720e5305288c Agda-2.8.0/src/full/Agda/Interaction/ExitCode.hs+formatted 7691578538c0 Agda-2.8.0/src/full/Agda/Interaction/FindFile.hs+formatted 3170eb1921b4 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Common.hs+formatted 1fb0462a1b45 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Dot.hs+formatted 604a1fd2d42f Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Dot/Backend.hs+formatted fc10621b7e2c Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Dot/Base.hs+formatted 773365a6b3e4 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Emacs.hs+formatted ff75327912fc Agda-2.8.0/src/full/Agda/Interaction/Highlighting/FromAbstract.hs+formatted a8d4144bdde2 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Generate.hs+formatted 8bc140b18e62 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Generate.hs-boot+formatted 9a3fde618f2b Agda-2.8.0/src/full/Agda/Interaction/Highlighting/HTML.hs+formatted 99b5ef12d008 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/HTML/Backend.hs+formatted b17a80a34eff Agda-2.8.0/src/full/Agda/Interaction/Highlighting/HTML/Base.hs+formatted d36037cbeadf Agda-2.8.0/src/full/Agda/Interaction/Highlighting/JSON.hs+formatted b5bb035e43f1 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/LaTeX.hs+formatted 7f14d85b664e Agda-2.8.0/src/full/Agda/Interaction/Highlighting/LaTeX/Backend.hs+formatted dd1725a94427 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/LaTeX/Base.hs+formatted ab86c6631700 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Precise.hs+formatted 83c7932f742c Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Range.hs+formatted 0054edf8b9e6 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Vim.hs+formatted 767a9afa8f4b Agda-2.8.0/src/full/Agda/Interaction/Imports.hs+formatted 65e8798f3384 Agda-2.8.0/src/full/Agda/Interaction/Imports.hs-boot+formatted 3cfa9e2d2bbf Agda-2.8.0/src/full/Agda/Interaction/InteractionTop.hs+formatted 3424b7b23f57 Agda-2.8.0/src/full/Agda/Interaction/JSON.hs+formatted ee7c581ca624 Agda-2.8.0/src/full/Agda/Interaction/JSONTop.hs+formatted b1854ec69b1d Agda-2.8.0/src/full/Agda/Interaction/Library.hs+formatted d4a922d69a6c Agda-2.8.0/src/full/Agda/Interaction/Library/Base.hs+formatted 79e462154a68 Agda-2.8.0/src/full/Agda/Interaction/Library/Parse.hs+formatted 64d6fc3383fb Agda-2.8.0/src/full/Agda/Interaction/MakeCase.hs+formatted 555b4179be0a Agda-2.8.0/src/full/Agda/Interaction/Monad.hs+formatted c831a742f557 Agda-2.8.0/src/full/Agda/Interaction/Options.hs+formatted 828aef6a3731 Agda-2.8.0/src/full/Agda/Interaction/Options/Base.hs+formatted d1a377c4a707 Agda-2.8.0/src/full/Agda/Interaction/Options/Errors.hs+formatted e44ed789f5f9 Agda-2.8.0/src/full/Agda/Interaction/Options/HasOptions.hs+formatted 434d46226886 Agda-2.8.0/src/full/Agda/Interaction/Options/Help.hs+formatted 1241fd26a436 Agda-2.8.0/src/full/Agda/Interaction/Options/Lenses.hs+formatted 0cacf2e95f8d Agda-2.8.0/src/full/Agda/Interaction/Options/Types.hs+formatted 865f0c039c33 Agda-2.8.0/src/full/Agda/Interaction/Options/Warnings.hs+formatted 11f05a0591fc Agda-2.8.0/src/full/Agda/Interaction/Output.hs+formatted 772e302dedad Agda-2.8.0/src/full/Agda/Interaction/Response.hs+formatted 77cf584c94f3 Agda-2.8.0/src/full/Agda/Interaction/Response/Base.hs+formatted 150002ef2df6 Agda-2.8.0/src/full/Agda/Interaction/SearchAbout.hs+declined - Agda-2.8.0/src/full/Agda/Main.hs+formatted b3fbe2c6389d Agda-2.8.0/src/full/Agda/Mimer/Mimer.hs+formatted 5ee8e2854fd8 Agda-2.8.0/src/full/Agda/Mimer/Options.hs+formatted 4513e6faa1f1 Agda-2.8.0/src/full/Agda/Syntax/Abstract.hs+formatted ed5b0f0a1630 Agda-2.8.0/src/full/Agda/Syntax/Abstract/Name.hs+formatted 992febb98ad9 Agda-2.8.0/src/full/Agda/Syntax/Abstract/Pattern.hs+formatted 8f9f098701be Agda-2.8.0/src/full/Agda/Syntax/Abstract/PatternSynonyms.hs+formatted 3f1f9a03363a Agda-2.8.0/src/full/Agda/Syntax/Abstract/Pretty.hs+formatted 4fdca8ef893f Agda-2.8.0/src/full/Agda/Syntax/Abstract/UsedNames.hs+formatted 120c37e72495 Agda-2.8.0/src/full/Agda/Syntax/Abstract/Views.hs+formatted 4860938107fe Agda-2.8.0/src/full/Agda/Syntax/Builtin.hs+formatted b915aac0abef Agda-2.8.0/src/full/Agda/Syntax/Common.hs+formatted e4fbe59bf094 Agda-2.8.0/src/full/Agda/Syntax/Common/Aspect.hs+formatted 25d40d92c083 Agda-2.8.0/src/full/Agda/Syntax/Common/KeywordRange.hs+formatted bddb87a288f9 Agda-2.8.0/src/full/Agda/Syntax/Common/Pretty.hs+formatted 0b01caf3aafb Agda-2.8.0/src/full/Agda/Syntax/Common/Pretty/ANSI.hs+formatted 6dfde2d67e3b Agda-2.8.0/src/full/Agda/Syntax/Concrete.hs+formatted 00ae9aed3826 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Attribute.hs+formatted 775eefd66300 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Definitions.hs+formatted ac99ea65d8d0 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Definitions/Errors.hs+formatted 3383d8244565 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Definitions/Monad.hs+formatted 0c9352e12d50 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Definitions/Types.hs+formatted 5104de9d5636 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Fixity.hs+formatted 2ef3d6e9d84d Agda-2.8.0/src/full/Agda/Syntax/Concrete/Generic.hs+formatted 6a2db093db8c Agda-2.8.0/src/full/Agda/Syntax/Concrete/Glyph.hs+formatted e23bf915bdc1 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Name.hs+formatted c075c7cb4c0b Agda-2.8.0/src/full/Agda/Syntax/Concrete/Operators.hs+formatted 332b0602c260 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Operators/Parser.hs+formatted d052bdb98637 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Operators/Parser/Monad.hs+formatted ab5dcacbdf6e Agda-2.8.0/src/full/Agda/Syntax/Concrete/Pattern.hs+formatted 3a81fcfb623a Agda-2.8.0/src/full/Agda/Syntax/Concrete/Pretty.hs+formatted a4b545b06abe Agda-2.8.0/src/full/Agda/Syntax/DoNotation.hs+formatted 232b18d60ee2 Agda-2.8.0/src/full/Agda/Syntax/Fixity.hs+formatted cfd07520b531 Agda-2.8.0/src/full/Agda/Syntax/IdiomBrackets.hs+formatted 79409485ed3e Agda-2.8.0/src/full/Agda/Syntax/Info.hs+formatted f69fe6ede869 Agda-2.8.0/src/full/Agda/Syntax/Internal.hs+formatted 0e29f775f790 Agda-2.8.0/src/full/Agda/Syntax/Internal/Blockers.hs+formatted 8a379f39a418 Agda-2.8.0/src/full/Agda/Syntax/Internal/Defs.hs+formatted 150656090085 Agda-2.8.0/src/full/Agda/Syntax/Internal/Elim.hs+formatted 16f733f04829 Agda-2.8.0/src/full/Agda/Syntax/Internal/Generic.hs+formatted 05c9219e868e Agda-2.8.0/src/full/Agda/Syntax/Internal/MetaVars.hs+formatted 7d2cf90ab69b Agda-2.8.0/src/full/Agda/Syntax/Internal/Names.hs+formatted 3bb3112a21db Agda-2.8.0/src/full/Agda/Syntax/Internal/Pattern.hs+formatted 4f0688215ae9 Agda-2.8.0/src/full/Agda/Syntax/Internal/SanityCheck.hs+formatted dc9c871223a7 Agda-2.8.0/src/full/Agda/Syntax/Internal/Univ.hs+formatted 5c12e7741878 Agda-2.8.0/src/full/Agda/Syntax/Literal.hs+formatted 912aaf4945c5 Agda-2.8.0/src/full/Agda/Syntax/Notation.hs+formatted d38be9906bda Agda-2.8.0/src/full/Agda/Syntax/Parser.hs+formatted bbd0148c6f3c Agda-2.8.0/src/full/Agda/Syntax/Parser/Alex.hs+formatted 040f0691743c Agda-2.8.0/src/full/Agda/Syntax/Parser/Comments.hs+formatted aa98a9c8fab8 Agda-2.8.0/src/full/Agda/Syntax/Parser/Helpers.hs+formatted 962b19f0478d Agda-2.8.0/src/full/Agda/Syntax/Parser/Layout.hs+formatted 700549be6fd6 Agda-2.8.0/src/full/Agda/Syntax/Parser/Layout.hs-boot+formatted aa496d556481 Agda-2.8.0/src/full/Agda/Syntax/Parser/LexActions.hs+formatted a5d57cb1b6b9 Agda-2.8.0/src/full/Agda/Syntax/Parser/LexActions.hs-boot+formatted 8bcd7e473217 Agda-2.8.0/src/full/Agda/Syntax/Parser/Literate.hs+formatted bd9441d27edb Agda-2.8.0/src/full/Agda/Syntax/Parser/LookAhead.hs+formatted 988b42cfcde3 Agda-2.8.0/src/full/Agda/Syntax/Parser/Monad.hs+formatted 6b041886ce39 Agda-2.8.0/src/full/Agda/Syntax/Parser/StringLiterals.hs+formatted 2c4b958b94a9 Agda-2.8.0/src/full/Agda/Syntax/Parser/Tokens.hs+formatted aa9d78064d47 Agda-2.8.0/src/full/Agda/Syntax/Position.hs+formatted d16539c2a462 Agda-2.8.0/src/full/Agda/Syntax/Position.hs-boot+formatted b1dd8bfd3111 Agda-2.8.0/src/full/Agda/Syntax/Reflected.hs+formatted bb9a2f130d18 Agda-2.8.0/src/full/Agda/Syntax/Scope/Base.hs+formatted 6ff9f287871d Agda-2.8.0/src/full/Agda/Syntax/Scope/Flat.hs+formatted 3f7e4d1c297e Agda-2.8.0/src/full/Agda/Syntax/Scope/Monad.hs+formatted 5751db976d34 Agda-2.8.0/src/full/Agda/Syntax/TopLevelModuleName.hs+formatted ac2fc82ba8a4 Agda-2.8.0/src/full/Agda/Syntax/TopLevelModuleName/Boot.hs+formatted 09f51b9e33b1 Agda-2.8.0/src/full/Agda/Syntax/Translation/AbstractToConcrete.hs+formatted c0d33e44c05c Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs+formatted 4db4a0bb2579 Agda-2.8.0/src/full/Agda/Syntax/Translation/InternalToAbstract.hs+formatted 4c1a1033f8d5 Agda-2.8.0/src/full/Agda/Syntax/Translation/ReflectedToAbstract.hs+formatted 2ae972608fb0 Agda-2.8.0/src/full/Agda/Syntax/Treeless.hs+formatted 25f21c7793f4 Agda-2.8.0/src/full/Agda/Termination/CallGraph.hs+formatted fec59f499d06 Agda-2.8.0/src/full/Agda/Termination/CallMatrix.hs+formatted ebc4ce14c917 Agda-2.8.0/src/full/Agda/Termination/CutOff.hs+formatted 7978d5a44013 Agda-2.8.0/src/full/Agda/Termination/Monad.hs+formatted 9436ec427f9a Agda-2.8.0/src/full/Agda/Termination/Order.hs+formatted 0f8827158a99 Agda-2.8.0/src/full/Agda/Termination/RecCheck.hs+formatted b6a7543ba3d1 Agda-2.8.0/src/full/Agda/Termination/Semiring.hs+formatted 2978d402a77e Agda-2.8.0/src/full/Agda/Termination/SparseMatrix.hs+formatted 8fdc334dfc0f Agda-2.8.0/src/full/Agda/Termination/TermCheck.hs+formatted ed0ea780ef94 Agda-2.8.0/src/full/Agda/Termination/Termination.hs+formatted 9ce4d907acfa Agda-2.8.0/src/full/Agda/TheTypeChecker.hs+formatted 697581af4578 Agda-2.8.0/src/full/Agda/TypeChecking/Abstract.hs+formatted 7066ed85a0fa Agda-2.8.0/src/full/Agda/TypeChecking/CheckInternal.hs+formatted 2d6bbce1312f Agda-2.8.0/src/full/Agda/TypeChecking/CheckInternal.hs-boot+formatted e158edb02d76 Agda-2.8.0/src/full/Agda/TypeChecking/CompiledClause.hs+formatted e807c1d8a459 Agda-2.8.0/src/full/Agda/TypeChecking/CompiledClause/Compile.hs+formatted 6b8cf4277b16 Agda-2.8.0/src/full/Agda/TypeChecking/CompiledClause/Compile.hs-boot+formatted a51bcd9a85c8 Agda-2.8.0/src/full/Agda/TypeChecking/CompiledClause/Match.hs+formatted 3142e5d8c639 Agda-2.8.0/src/full/Agda/TypeChecking/CompiledClause/Match.hs-boot+formatted 1c45f74cdbf6 Agda-2.8.0/src/full/Agda/TypeChecking/Constraints.hs+formatted 47ac61419563 Agda-2.8.0/src/full/Agda/TypeChecking/Constraints.hs-boot+broken 1b7f9f60a42c Agda-2.8.0/src/full/Agda/TypeChecking/Conversion.hs+formatted cc3a6f5cf005 Agda-2.8.0/src/full/Agda/TypeChecking/Conversion.hs-boot+formatted 330bf1da7807 Agda-2.8.0/src/full/Agda/TypeChecking/Conversion/Pure.hs+formatted 4967e1b8d4f6 Agda-2.8.0/src/full/Agda/TypeChecking/Coverage.hs+formatted 2269cd66c46c Agda-2.8.0/src/full/Agda/TypeChecking/Coverage/Cubical.hs+formatted 12c1a3918395 Agda-2.8.0/src/full/Agda/TypeChecking/Coverage/Match.hs+formatted 66752ed436cd Agda-2.8.0/src/full/Agda/TypeChecking/Coverage/SplitClause.hs+formatted 860fb8b6d684 Agda-2.8.0/src/full/Agda/TypeChecking/Coverage/SplitTree.hs+formatted e11eb64dcee6 Agda-2.8.0/src/full/Agda/TypeChecking/Datatypes.hs+formatted bf771aa7c583 Agda-2.8.0/src/full/Agda/TypeChecking/Datatypes.hs-boot+formatted d195809b35f2 Agda-2.8.0/src/full/Agda/TypeChecking/DeadCode.hs+formatted bb854a3c2b16 Agda-2.8.0/src/full/Agda/TypeChecking/DiscrimTree.hs+formatted c17cb27af1b5 Agda-2.8.0/src/full/Agda/TypeChecking/DiscrimTree/Types.hs+formatted fbe3a0be6a73 Agda-2.8.0/src/full/Agda/TypeChecking/DisplayForm.hs+formatted db46b8c74ecf Agda-2.8.0/src/full/Agda/TypeChecking/DropArgs.hs+formatted a7d18b90b5cb Agda-2.8.0/src/full/Agda/TypeChecking/Empty.hs+formatted 546e2690c8bd Agda-2.8.0/src/full/Agda/TypeChecking/Empty.hs-boot+formatted c3bb228c6556 Agda-2.8.0/src/full/Agda/TypeChecking/Errors.hs+formatted 4d637dbd29d8 Agda-2.8.0/src/full/Agda/TypeChecking/Errors.hs-boot+formatted 3fd276903525 Agda-2.8.0/src/full/Agda/TypeChecking/Errors/Names.hs+formatted 56b2daf135cc Agda-2.8.0/src/full/Agda/TypeChecking/EtaContract.hs+formatted 0b5e5500c9e6 Agda-2.8.0/src/full/Agda/TypeChecking/Forcing.hs+formatted 91ec1972ef50 Agda-2.8.0/src/full/Agda/TypeChecking/Free.hs+formatted b17e10ebb4bf Agda-2.8.0/src/full/Agda/TypeChecking/Free/Lazy.hs+formatted f5cc2aa53ce3 Agda-2.8.0/src/full/Agda/TypeChecking/Free/Precompute.hs+formatted 4652dff8fa52 Agda-2.8.0/src/full/Agda/TypeChecking/Free/Reduce.hs+formatted dda08728d05b Agda-2.8.0/src/full/Agda/TypeChecking/Functions.hs+formatted a2822b4bbb2a Agda-2.8.0/src/full/Agda/TypeChecking/Generalize.hs+formatted 170ae60a3b34 Agda-2.8.0/src/full/Agda/TypeChecking/IApplyConfluence.hs+formatted d2bedae2afec Agda-2.8.0/src/full/Agda/TypeChecking/Implicit.hs+formatted 5230555cc911 Agda-2.8.0/src/full/Agda/TypeChecking/Injectivity.hs+formatted 765027ab5536 Agda-2.8.0/src/full/Agda/TypeChecking/Inlining.hs+formatted f69b901c92d1 Agda-2.8.0/src/full/Agda/TypeChecking/InstanceArguments.hs+formatted daede539773d Agda-2.8.0/src/full/Agda/TypeChecking/InstanceArguments.hs-boot+formatted bc076aa1fdbe Agda-2.8.0/src/full/Agda/TypeChecking/Irrelevance.hs+formatted f5e2359204d8 Agda-2.8.0/src/full/Agda/TypeChecking/Irrelevance.hs-boot+formatted 3809c256f1bf Agda-2.8.0/src/full/Agda/TypeChecking/Level.hs+formatted 4df75f041db4 Agda-2.8.0/src/full/Agda/TypeChecking/Level.hs-boot+formatted 43902630fee9 Agda-2.8.0/src/full/Agda/TypeChecking/Level/Solve.hs+formatted ae0893a4561e Agda-2.8.0/src/full/Agda/TypeChecking/LevelConstraints.hs+formatted c4a1b0f2708c Agda-2.8.0/src/full/Agda/TypeChecking/Lock.hs+formatted 00b8f5e75aa7 Agda-2.8.0/src/full/Agda/TypeChecking/Lock.hs-boot+formatted 4d870d6be892 Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars.hs+formatted 52101179c5b2 Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars.hs-boot+formatted 7e2cc6c3656a Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars/Mention.hs+formatted b8142e719029 Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars/Occurs.hs+formatted a4be1ca0bbf7 Agda-2.8.0/src/full/Agda/TypeChecking/Modalities.hs+formatted 1fd16a038ff2 Agda-2.8.0/src/full/Agda/TypeChecking/Monad.hs+formatted 8628aa83fca2 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Base.hs+formatted d349fd5d15cf Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Base/Types.hs+formatted 7860b2253820 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Base/Warning.hs+formatted 56ab8bfd7ea3 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Benchmark.hs+formatted 6bd9d4f5cc91 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Builtin.hs+formatted 6b2e93e4eef0 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Builtin.hs-boot+formatted a608a81b85da Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Caching.hs+formatted f7eb389a97e5 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Closure.hs+formatted ecdbeb5fb96a Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Constraints.hs+formatted fb8152beded7 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Context.hs+formatted aa421afb353b Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Context.hs-boot+formatted 25a69fe0b2e6 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Debug.hs+formatted 07c8440dbd10 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Debug.hs-boot+formatted e171cc504b07 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Env.hs+formatted 80aecb84d70e Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Imports.hs+formatted 1f2b7f206ac5 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/MetaVars.hs+formatted 894d39f81e58 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/MetaVars.hs-boot+formatted 5d9486ab6943 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Modality.hs+formatted 219de79701c4 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Mutual.hs+formatted 8fe6e5c381d6 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Open.hs+formatted 4e4d159df7b7 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Options.hs+formatted 2b144a9f6ada Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Options.hs-boot+formatted a266ccade893 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Pure.hs+formatted f549f9160d1c Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Pure.hs-boot+formatted 651849abb47d Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Signature.hs+formatted a5b44843ae0b Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Signature.hs-boot+formatted 69d2cf4b28ec Agda-2.8.0/src/full/Agda/TypeChecking/Monad/SizedTypes.hs+formatted 011c35706d91 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/State.hs+formatted 63e1167a5c2e Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Statistics.hs+formatted 9aa1d0aad9a7 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Trace.hs+formatted 9e2717f40129 Agda-2.8.0/src/full/Agda/TypeChecking/Names.hs+formatted 519f4d3abcf4 Agda-2.8.0/src/full/Agda/TypeChecking/Opacity.hs+formatted d26ddecf1923 Agda-2.8.0/src/full/Agda/TypeChecking/Opacity.hs-boot+formatted ec77f6d2c4ee Agda-2.8.0/src/full/Agda/TypeChecking/Patterns/Abstract.hs+formatted 0f6e0c168a7c Agda-2.8.0/src/full/Agda/TypeChecking/Patterns/Internal.hs+formatted 9e7f1b1cf5e9 Agda-2.8.0/src/full/Agda/TypeChecking/Patterns/Match.hs+formatted 5ee7033010bf Agda-2.8.0/src/full/Agda/TypeChecking/Patterns/Match.hs-boot+formatted 262f6816a482 Agda-2.8.0/src/full/Agda/TypeChecking/Polarity.hs+formatted 2f5659c12840 Agda-2.8.0/src/full/Agda/TypeChecking/Polarity.hs-boot+formatted 7503757a37fb Agda-2.8.0/src/full/Agda/TypeChecking/Positivity.hs+formatted 5626959a260d Agda-2.8.0/src/full/Agda/TypeChecking/Positivity/Occurrence.hs+formatted 850bea97b290 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty.hs+formatted 8bd6edac6240 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty.hs-boot+formatted f13c4b57eaf1 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Call.hs+formatted f5434869778b Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Call.hs-boot+formatted c54ae0776ac3 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Constraint.hs+formatted 4c2edd49d675 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Constraint.hs-boot+formatted 5734afd5c29b Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Warning.hs+formatted bf4e737ce041 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Warning.hs-boot+formatted de8c83eec1d4 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive.hs+formatted 3c8fe98419dd Agda-2.8.0/src/full/Agda/TypeChecking/Primitive.hs-boot+formatted 92564f8a667c Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Base.hs+formatted df2301069d40 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Cubical.hs+formatted 2825417cf284 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Cubical/Base.hs+formatted 34da472277ef Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Cubical/Base.hs-boot+formatted 4aec12c8b204 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Cubical/Glue.hs+formatted 4056250b5173 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Cubical/HCompU.hs+formatted dbe29e9e0df8 Agda-2.8.0/src/full/Agda/TypeChecking/ProjectionLike.hs+formatted 21d019305ce5 Agda-2.8.0/src/full/Agda/TypeChecking/ProjectionLike.hs-boot+formatted 0442d4c1571a Agda-2.8.0/src/full/Agda/TypeChecking/Quote.hs+formatted 185176614b3d Agda-2.8.0/src/full/Agda/TypeChecking/ReconstructParameters.hs+formatted 649031626628 Agda-2.8.0/src/full/Agda/TypeChecking/RecordPatterns.hs+formatted 7b9818f0d07e Agda-2.8.0/src/full/Agda/TypeChecking/Records.hs+formatted 65b1d93597cd Agda-2.8.0/src/full/Agda/TypeChecking/Records.hs-boot+formatted 9000008643a3 Agda-2.8.0/src/full/Agda/TypeChecking/Reduce.hs+formatted 82cb10489996 Agda-2.8.0/src/full/Agda/TypeChecking/Reduce.hs-boot+formatted e69843d8012c Agda-2.8.0/src/full/Agda/TypeChecking/Reduce/Fast.hs+formatted 2158647025d5 Agda-2.8.0/src/full/Agda/TypeChecking/Reduce/Fast.hs-boot+formatted 52ceaeb66838 Agda-2.8.0/src/full/Agda/TypeChecking/Reduce/Monad.hs+formatted 88bd74e33b27 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting.hs+formatted 0158a552c77f Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting.hs-boot+formatted 682e7693d697 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/Clause.hs+formatted 0259fd79bf81 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/Confluence.hs+formatted e8d5ebd74ed8 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/NonLinMatch.hs+formatted 996477d19b29 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/NonLinPattern.hs+formatted a6c2b94986a3 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Application.hs+formatted 8094c6b9ca8d Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Application.hs-boot+formatted dbb4bda7bd40 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Builtin.hs+formatted 6100823529c1 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Builtin/Coinduction.hs+formatted 48f627566132 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Builtin/Coinduction.hs-boot+formatted d760db0d3bfa Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Data.hs+formatted 89ea7a6db701 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Data.hs-boot+formatted e7ba6af78bdb Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Decl.hs+formatted c3dda6e649e5 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Decl.hs-boot+formatted d9c53c2db40c Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Def.hs+formatted aa2e722e924d Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Def.hs-boot+formatted cf342aa0175d Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Display.hs+formatted 69ec6b99fd75 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS.hs+formatted 199f73f82f56 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/Implicit.hs+formatted 11b826b41073 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/Problem.hs+formatted c5e217446f2f Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/ProblemRest.hs+formatted 30ba5ebd5abd Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/Unify.hs+formatted c06cebdc5744 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/Unify/LeftInverse.hs+formatted 8db95ca4d472 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/Unify/Types.hs+formatted de67f3e2b3e6 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Record.hs+formatted 3cb29243d1ce Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Term.hs+formatted ccd5b1bd7f62 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Term.hs-boot+formatted 14e895036162 Agda-2.8.0/src/full/Agda/TypeChecking/Serialise.hs+formatted 7e6c6a48b26a Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Base.hs+formatted 0b03fe8ecc8f Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances.hs+formatted 01a9d48b433f Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Abstract.hs+formatted 5e11ce5ca675 Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Common.hs+formatted d11e2e781bb4 Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Compilers.hs+formatted 8047289f42cb Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Errors.hs+formatted abbb853d7207 Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Highlighting.hs+formatted 93eed7f54faa Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Internal.hs+formatted 1a6e0ff617b0 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes.hs+formatted c502702d4646 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/Pretty.hs+formatted 7bbcf170102a Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/Solve.hs+formatted 5e69f4b9b310 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/Syntax.hs+formatted 904a4e241e74 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/Utils.hs+formatted 342d213dbae3 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/WarshallSolver.hs+formatted 8b1a445ba3fc Agda-2.8.0/src/full/Agda/TypeChecking/Sort.hs+formatted 082efa258eb6 Agda-2.8.0/src/full/Agda/TypeChecking/Substitute.hs+formatted c975b7162ab1 Agda-2.8.0/src/full/Agda/TypeChecking/Substitute/Class.hs+formatted 2656f0d28fba Agda-2.8.0/src/full/Agda/TypeChecking/Substitute/DeBruijn.hs+formatted 639f3a17346d Agda-2.8.0/src/full/Agda/TypeChecking/SyntacticEquality.hs+formatted abeda68a8419 Agda-2.8.0/src/full/Agda/TypeChecking/Telescope.hs+formatted d94c0d202dfc Agda-2.8.0/src/full/Agda/TypeChecking/Telescope.hs-boot+formatted cea913d9b4f5 Agda-2.8.0/src/full/Agda/TypeChecking/Telescope/Path.hs+formatted eb5313ed3eb3 Agda-2.8.0/src/full/Agda/TypeChecking/Unquote.hs+formatted ceb3878e054e Agda-2.8.0/src/full/Agda/TypeChecking/Warnings.hs+formatted 0a8e5e5ab7e5 Agda-2.8.0/src/full/Agda/TypeChecking/With.hs+formatted b02f16e6d20a Agda-2.8.0/src/full/Agda/Utils/AffineHole.hs+formatted ae5ced9ae20f Agda-2.8.0/src/full/Agda/Utils/Applicative.hs+formatted 7fe48d6127fe Agda-2.8.0/src/full/Agda/Utils/AssocList.hs+formatted 72df986a37f7 Agda-2.8.0/src/full/Agda/Utils/Bag.hs+formatted 05b1c7f71baf Agda-2.8.0/src/full/Agda/Utils/Benchmark.hs+formatted 19e137bd74e4 Agda-2.8.0/src/full/Agda/Utils/BiMap.hs+formatted 09925de009a1 Agda-2.8.0/src/full/Agda/Utils/BoolSet.hs+formatted 7f37f70bbf2b Agda-2.8.0/src/full/Agda/Utils/Boolean.hs+formatted 880aa8847616 Agda-2.8.0/src/full/Agda/Utils/CallStack.hs+formatted c579014a9dbd Agda-2.8.0/src/full/Agda/Utils/CallStack/Base.hs+formatted 486c936e1b1e Agda-2.8.0/src/full/Agda/Utils/CallStack/Pretty.hs+formatted eeedf1a4e3da Agda-2.8.0/src/full/Agda/Utils/Char.hs+formatted 2b8eb290abc6 Agda-2.8.0/src/full/Agda/Utils/Cluster.hs+formatted b2757fa5ae2f Agda-2.8.0/src/full/Agda/Utils/Either.hs+formatted 5c0f9924f59f Agda-2.8.0/src/full/Agda/Utils/Empty.hs+formatted 284145f1db7f Agda-2.8.0/src/full/Agda/Utils/Environment.hs+formatted 822c68a5ddb8 Agda-2.8.0/src/full/Agda/Utils/Fail.hs+formatted aa59492cb884 Agda-2.8.0/src/full/Agda/Utils/Favorites.hs+formatted 9990de329253 Agda-2.8.0/src/full/Agda/Utils/FileId.hs+formatted 6b83a7abbe9a Agda-2.8.0/src/full/Agda/Utils/FileName.hs+formatted e5f5fbd21c99 Agda-2.8.0/src/full/Agda/Utils/Float.hs+formatted bb823613272f Agda-2.8.0/src/full/Agda/Utils/Function.hs+formatted 75a5028a6b1a Agda-2.8.0/src/full/Agda/Utils/Functor.hs+formatted 026b04b8661e Agda-2.8.0/src/full/Agda/Utils/GetOpt.hs+formatted a7c248d266b0 Agda-2.8.0/src/full/Agda/Utils/Graph/AdjacencyMap/Unidirectional.hs+formatted 989ea83c378b Agda-2.8.0/src/full/Agda/Utils/Graph/TopSort.hs+formatted db38367e7a17 Agda-2.8.0/src/full/Agda/Utils/Hash.hs+formatted 43284ef7124c Agda-2.8.0/src/full/Agda/Utils/HashTable.hs+formatted 019e9637b9b0 Agda-2.8.0/src/full/Agda/Utils/Haskell/Syntax.hs+formatted 7802531cbbc5 Agda-2.8.0/src/full/Agda/Utils/IArray.hs+formatted 8d53e1639c43 Agda-2.8.0/src/full/Agda/Utils/IO.hs+formatted ddd200e851ab Agda-2.8.0/src/full/Agda/Utils/IO/Binary.hs+formatted c62ffb044eae Agda-2.8.0/src/full/Agda/Utils/IO/Directory.hs+formatted 44ca6943bebd Agda-2.8.0/src/full/Agda/Utils/IO/TempFile.hs+formatted 51a9c4ed68e8 Agda-2.8.0/src/full/Agda/Utils/IO/UTF8.hs+formatted d938f94198a6 Agda-2.8.0/src/full/Agda/Utils/IORef.hs+formatted 695329a3bad9 Agda-2.8.0/src/full/Agda/Utils/Impossible.hs+formatted e5520ad27268 Agda-2.8.0/src/full/Agda/Utils/IndexedList.hs+formatted faa55c2f1ad1 Agda-2.8.0/src/full/Agda/Utils/IntSet/Infinite.hs+formatted 37f9f2b34f7d Agda-2.8.0/src/full/Agda/Utils/Lens.hs+formatted 7cc1db9fff98 Agda-2.8.0/src/full/Agda/Utils/Lens/Examples.hs+formatted ef65f125c3b1 Agda-2.8.0/src/full/Agda/Utils/List.hs+formatted 8392227e3997 Agda-2.8.0/src/full/Agda/Utils/List1.hs+formatted 3bd635eb52aa Agda-2.8.0/src/full/Agda/Utils/List1.hs-boot+formatted 3514de48df05 Agda-2.8.0/src/full/Agda/Utils/List2.hs+formatted e460a45d4f65 Agda-2.8.0/src/full/Agda/Utils/ListT.hs+formatted 960b2b6f10d7 Agda-2.8.0/src/full/Agda/Utils/Map.hs+formatted 8c9045bc776a Agda-2.8.0/src/full/Agda/Utils/Map1.hs+formatted 6e06ef12a477 Agda-2.8.0/src/full/Agda/Utils/Maybe.hs+formatted f52b8f698d5f Agda-2.8.0/src/full/Agda/Utils/Maybe/Strict.hs+formatted fde8defcff6d Agda-2.8.0/src/full/Agda/Utils/Memo.hs+formatted df3a8985dc8e Agda-2.8.0/src/full/Agda/Utils/Monad.hs+formatted dd3cac49f886 Agda-2.8.0/src/full/Agda/Utils/Monoid.hs+formatted 92bb2192c3b2 Agda-2.8.0/src/full/Agda/Utils/Null.hs+formatted 4fd8ca5748d3 Agda-2.8.0/src/full/Agda/Utils/POMonoid.hs+formatted bb186d0604db Agda-2.8.0/src/full/Agda/Utils/Parser/MemoisedCPS.hs+formatted 3298d386e71e Agda-2.8.0/src/full/Agda/Utils/PartialOrd.hs+formatted 5763223e9061 Agda-2.8.0/src/full/Agda/Utils/Permutation.hs+formatted 1a3e4a1087c4 Agda-2.8.0/src/full/Agda/Utils/ProfileOptions.hs+formatted b58b87ef89f8 Agda-2.8.0/src/full/Agda/Utils/RangeMap.hs+formatted 5039e6e9abfe Agda-2.8.0/src/full/Agda/Utils/SemiRing.hs+formatted 9aa281a4615c Agda-2.8.0/src/full/Agda/Utils/Semigroup.hs+formatted fdb04073ce98 Agda-2.8.0/src/full/Agda/Utils/Set1.hs+formatted f45ad8f08443 Agda-2.8.0/src/full/Agda/Utils/Singleton.hs+formatted 18c4a0bbe326 Agda-2.8.0/src/full/Agda/Utils/Size.hs+formatted a5753ba84ff3 Agda-2.8.0/src/full/Agda/Utils/SmallSet.hs+formatted 21babb4b50a9 Agda-2.8.0/src/full/Agda/Utils/String.hs+formatted 57a8a5b9fa29 Agda-2.8.0/src/full/Agda/Utils/Suffix.hs+formatted 736b26cda8bc Agda-2.8.0/src/full/Agda/Utils/Three.hs+formatted ebc104ac11d6 Agda-2.8.0/src/full/Agda/Utils/Time.hs+formatted 628c44ebe216 Agda-2.8.0/src/full/Agda/Utils/Trie.hs+formatted 1711e06969b5 Agda-2.8.0/src/full/Agda/Utils/Tuple.hs+formatted db9dcb1b8f66 Agda-2.8.0/src/full/Agda/Utils/TypeLevel.hs+formatted c8c672126225 Agda-2.8.0/src/full/Agda/Utils/TypeLits.hs+formatted 8d8d3b50eebc Agda-2.8.0/src/full/Agda/Utils/Unsafe.hs+formatted 56bf105aca9a Agda-2.8.0/src/full/Agda/Utils/Update.hs+formatted 383866b27bb0 Agda-2.8.0/src/full/Agda/Utils/VarSet.hs+formatted 9f0839da86cb Agda-2.8.0/src/full/Agda/Utils/WithDefault.hs+formatted 415a87aa2127 Agda-2.8.0/src/full/Agda/Utils/Zipper.hs+formatted 86e923a357db Agda-2.8.0/src/main/Main.hs+formatted d3512172a4bc Agda-2.8.0/src/setup/Agda/Setup.hs+formatted 114aa5ab1508 Agda-2.8.0/src/setup/Agda/Setup/DataFiles.hs+formatted 42af21c8ecf8 Agda-2.8.0/src/setup/Agda/Setup/EmacsMode.hs+formatted acb74e0db7a5 Agda-2.8.0/src/setup/Agda/Version.hs+formatted 5164a4006c26 Agda-2.8.0/src/setup/Agda/VersionCommit.hs+formatted 90cd663d9426 HUnit-1.6.2.0/examples/Example.hs+formatted 9b1cac4b6c09 HUnit-1.6.2.0/src/Test/HUnit.hs+formatted a7dea629b3ef HUnit-1.6.2.0/src/Test/HUnit/Base.hs+formatted ab91586830e9 HUnit-1.6.2.0/src/Test/HUnit/Lang.hs+formatted f9959d10adae HUnit-1.6.2.0/src/Test/HUnit/Terminal.hs+formatted c1c1d4fdc273 HUnit-1.6.2.0/src/Test/HUnit/Text.hs+formatted 358e8e211fe4 HUnit-1.6.2.0/tests/HUnitTestExtended.hs+formatted 2277de61adab HUnit-1.6.2.0/tests/HUnitTests.hs+formatted 6f374a392385 HUnit-1.6.2.0/tests/TerminalTest.hs+formatted 3c8a199a8a36 QuickCheck-2.18.0.0/examples/Heap.hs+formatted 0bd3a87ca5b5 QuickCheck-2.18.0.0/examples/Heap_Program.hs+formatted 85df59b82228 QuickCheck-2.18.0.0/examples/Heap_ProgramAlgebraic.hs+formatted cc37d9bcd159 QuickCheck-2.18.0.0/examples/Lambda.hs+formatted 56c98d50971f QuickCheck-2.18.0.0/examples/Merge.hs+formatted 6506a17a91ff QuickCheck-2.18.0.0/examples/Set.hs+formatted 598740b3d57c QuickCheck-2.18.0.0/examples/Simple.hs+partly-checked 5234e8085ba9 QuickCheck-2.18.0.0/src/Test/QuickCheck.hs+formatted d4509e6743a4 QuickCheck-2.18.0.0/src/Test/QuickCheck/All.hs+declined - QuickCheck-2.18.0.0/src/Test/QuickCheck/Arbitrary.hs+formatted b394fbd4debb QuickCheck-2.18.0.0/src/Test/QuickCheck/Compat.hs+partly-checked 06fafd04e06a QuickCheck-2.18.0.0/src/Test/QuickCheck/Exception.hs+formatted 682aa52bce46 QuickCheck-2.18.0.0/src/Test/QuickCheck/Features.hs+declined - QuickCheck-2.18.0.0/src/Test/QuickCheck/Function.hs+formatted 061130c71dd5 QuickCheck-2.18.0.0/src/Test/QuickCheck/Gen.hs+formatted 0488daa21096 QuickCheck-2.18.0.0/src/Test/QuickCheck/Gen/Unsafe.hs+declined - QuickCheck-2.18.0.0/src/Test/QuickCheck/Modifiers.hs+declined - QuickCheck-2.18.0.0/src/Test/QuickCheck/Monadic.hs+formatted 521d14fa41a7 QuickCheck-2.18.0.0/src/Test/QuickCheck/Monoids.hs+formatted c7e1654e2011 QuickCheck-2.18.0.0/src/Test/QuickCheck/Poly.hs+declined - QuickCheck-2.18.0.0/src/Test/QuickCheck/Property.hs+formatted d248979763fb QuickCheck-2.18.0.0/src/Test/QuickCheck/Random.hs+formatted 67a6c49f2d76 QuickCheck-2.18.0.0/src/Test/QuickCheck/State.hs+formatted b836923353a8 QuickCheck-2.18.0.0/src/Test/QuickCheck/Test.hs+formatted fc335cb1eb17 QuickCheck-2.18.0.0/src/Test/QuickCheck/Text.hs+formatted 658c2a75fd36 QuickCheck-2.18.0.0/tests/CollectDataTypes.hs+formatted deb44539c869 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 ddae5a0658b8 QuickCheck-2.18.0.0/tests/Generators.hs+formatted 79d32874cf04 QuickCheck-2.18.0.0/tests/Misc.hs+formatted 414efdc48918 QuickCheck-2.18.0.0/tests/MonadFix.hs+formatted d98e80df98ac QuickCheck-2.18.0.0/tests/Monoids.hs+formatted eae30fa51b1b QuickCheck-2.18.0.0/tests/RunCollectDataTypes.hs+formatted a844703dc876 QuickCheck-2.18.0.0/tests/Split.hs+formatted da1fe583377c QuickCheck-2.18.0.0/tests/Strictness.hs+formatted 5b211214c287 QuickCheck-2.18.0.0/tests/Terminal.hs+formatted 398a0f17171d QuickCheck-2.18.0.0/tests/WithProgress.hs+formatted 5bd7a41e0fb6 ShellCheck-0.11.0/shellcheck.hs+formatted e96f582d0994 ShellCheck-0.11.0/src/ShellCheck/AST.hs+formatted 1a672e0e9b45 ShellCheck-0.11.0/src/ShellCheck/ASTLib.hs+formatted f856db0e58cd ShellCheck-0.11.0/src/ShellCheck/Analytics.hs+formatted a37e7d6ad771 ShellCheck-0.11.0/src/ShellCheck/Analyzer.hs+formatted 53f56d1c3ae1 ShellCheck-0.11.0/src/ShellCheck/AnalyzerLib.hs+formatted ae3b0ca5251a ShellCheck-0.11.0/src/ShellCheck/CFG.hs+formatted 8b94af7378f4 ShellCheck-0.11.0/src/ShellCheck/CFGAnalysis.hs+formatted 64df5efa4dca ShellCheck-0.11.0/src/ShellCheck/Checker.hs+formatted ca5d54071468 ShellCheck-0.11.0/src/ShellCheck/Checks/Commands.hs+formatted c5722fd33abb ShellCheck-0.11.0/src/ShellCheck/Checks/ControlFlow.hs+formatted 0cbfece4e54b ShellCheck-0.11.0/src/ShellCheck/Checks/Custom.hs+formatted a6c175fc2ac7 ShellCheck-0.11.0/src/ShellCheck/Checks/ShellSupport.hs+formatted d39eda0efa56 ShellCheck-0.11.0/src/ShellCheck/Data.hs+formatted 0b8c4331f2cb ShellCheck-0.11.0/src/ShellCheck/Debug.hs+formatted eeebdf1e43d5 ShellCheck-0.11.0/src/ShellCheck/Fixer.hs+formatted 1c5c142bbc8c ShellCheck-0.11.0/src/ShellCheck/Formatter/CheckStyle.hs+formatted 8b36dd878a90 ShellCheck-0.11.0/src/ShellCheck/Formatter/Diff.hs+formatted 78112453fad7 ShellCheck-0.11.0/src/ShellCheck/Formatter/Format.hs+formatted d90b451f113e ShellCheck-0.11.0/src/ShellCheck/Formatter/GCC.hs+formatted b5dba8eeaa1e ShellCheck-0.11.0/src/ShellCheck/Formatter/JSON.hs+formatted 780be929b254 ShellCheck-0.11.0/src/ShellCheck/Formatter/JSON1.hs+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 d91cb8e53cd5 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+formatted f11704872a0d adjunctions-4.4.4/HLint.hs+formatted b76eebd88dde adjunctions-4.4.4/src/Control/Comonad/Representable/Store.hs+formatted 2dcd64bcfe48 adjunctions-4.4.4/src/Control/Comonad/Trans/Adjoint.hs+formatted 7b743cda361d adjunctions-4.4.4/src/Control/Monad/Representable/Reader.hs+formatted 35d839d56a32 adjunctions-4.4.4/src/Control/Monad/Representable/State.hs+formatted 4f5dfaf566a3 adjunctions-4.4.4/src/Control/Monad/Trans/Adjoint.hs+formatted daa2f636edb9 adjunctions-4.4.4/src/Control/Monad/Trans/Contravariant/Adjoint.hs+formatted 067960eebdd3 adjunctions-4.4.4/src/Control/Monad/Trans/Conts.hs+formatted a9be4a7e726b adjunctions-4.4.4/src/Data/Functor/Adjunction.hs+formatted 191e78a8f894 adjunctions-4.4.4/src/Data/Functor/Contravariant/Adjunction.hs+formatted 573a1fcd59fd adjunctions-4.4.4/src/Data/Functor/Contravariant/Rep.hs+formatted 16b695eb1cf2 adjunctions-4.4.4/src/Data/Functor/Rep.hs+formatted 538f4bee921a adjunctions-4.4.4/tests/GenericsSpec.hs+formatted 2fbd14b119a4 adjunctions-4.4.4/tests/Spec.hs+formatted 7bbf4758e5ad aeson-2.3.1.0/src/Data/Aeson.hs+formatted e884d6813fc6 aeson-2.3.1.0/src/Data/Aeson/Decoding.hs+formatted 93bdee10e02a aeson-2.3.1.0/src/Data/Aeson/Decoding/ByteString.hs+formatted 635321399aa4 aeson-2.3.1.0/src/Data/Aeson/Decoding/ByteString/Lazy.hs+formatted 1d3a54288c25 aeson-2.3.1.0/src/Data/Aeson/Decoding/Conversion.hs+formatted f1f142fef403 aeson-2.3.1.0/src/Data/Aeson/Decoding/Internal.hs+formatted e972ebea468c aeson-2.3.1.0/src/Data/Aeson/Decoding/Text.hs+formatted 709b71ada144 aeson-2.3.1.0/src/Data/Aeson/Decoding/Tokens.hs+formatted c6cf8dff7aea aeson-2.3.1.0/src/Data/Aeson/Encoding.hs+formatted 96d4e6121b81 aeson-2.3.1.0/src/Data/Aeson/Encoding/Builder.hs+formatted 32e6990c1aad aeson-2.3.1.0/src/Data/Aeson/Encoding/Internal.hs+formatted d7002010fdc9 aeson-2.3.1.0/src/Data/Aeson/Internal/ByteString.hs+formatted 7ff60392d6c3 aeson-2.3.1.0/src/Data/Aeson/Internal/Functions.hs+formatted e048ffa25767 aeson-2.3.1.0/src/Data/Aeson/Internal/Prelude.hs+formatted 57e28222c296 aeson-2.3.1.0/src/Data/Aeson/Internal/Scientific.hs+formatted 6bb6b5229c29 aeson-2.3.1.0/src/Data/Aeson/Internal/TH.hs+formatted b61b87ef28b1 aeson-2.3.1.0/src/Data/Aeson/Internal/Text.hs+formatted e83337edc6e6 aeson-2.3.1.0/src/Data/Aeson/Internal/Unescape.hs+formatted 20257ed727b2 aeson-2.3.1.0/src/Data/Aeson/Internal/UnescapeFromText.hs+formatted 726df9d09937 aeson-2.3.1.0/src/Data/Aeson/Key.hs+formatted ddeec884181e aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs+formatted a8f98f92bb33 aeson-2.3.1.0/src/Data/Aeson/Parser/Time.hs+formatted 34673c7e3119 aeson-2.3.1.0/src/Data/Aeson/QQ/Simple.hs+formatted 8c47510bfe90 aeson-2.3.1.0/src/Data/Aeson/RFC8785.hs+formatted 7995a04278eb 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 057e2b106402 aeson-2.3.1.0/src/Data/Aeson/Types/FromJSON.hs+formatted 3a14da7819a3 aeson-2.3.1.0/src/Data/Aeson/Types/Generic.hs+formatted 9fc1ad97795b aeson-2.3.1.0/src/Data/Aeson/Types/Internal.hs+formatted edb832a8dbeb aeson-2.3.1.0/src/Data/Aeson/Types/ToJSON.hs+formatted 4a92c519c2c4 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 91fe7aa4d3dc aeson-2.3.1.0/tests/DataFamilies/Properties.hs+formatted 97579c76fd4d aeson-2.3.1.0/tests/DataFamilies/Types.hs+formatted 058d139e8724 aeson-2.3.1.0/tests/DoubleToScientific.hs+formatted 29b00f8c0d83 aeson-2.3.1.0/tests/Encoders.hs+formatted 30150da5a855 aeson-2.3.1.0/tests/ErrorMessages.hs+formatted 72fb423455c1 aeson-2.3.1.0/tests/Functions.hs+formatted a2da87dc85a4 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 5c7e1bcf3dd6 aeson-2.3.1.0/tests/Properties.hs+formatted 47a934388051 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 1c47871a8c20 aeson-2.3.1.0/tests/PropertyTH.hs+formatted 816e57772780 aeson-2.3.1.0/tests/RFC8785.hs+formatted 378b97660503 aeson-2.3.1.0/tests/Regression/Issue1138.hs+formatted 1cfcacdcaf11 aeson-2.3.1.0/tests/Regression/Issue351.hs+formatted d7ea7e8c0a78 aeson-2.3.1.0/tests/Regression/Issue571.hs+formatted c773b848db86 aeson-2.3.1.0/tests/Regression/Issue687.hs+formatted e5c541d1465a aeson-2.3.1.0/tests/Regression/Issue967.hs+formatted 97b26e935032 aeson-2.3.1.0/tests/SerializationFormatSpec.hs+formatted 8eaa36c16021 aeson-2.3.1.0/tests/Tests.hs+formatted fca86e7ab321 aeson-2.3.1.0/tests/Types.hs+formatted b711a1e1b18d 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 095b9b74ccb5 aeson-2.3.1.0/tests/UnitTests/OmitNothingFieldsNote.hs+formatted 579ca9c8641b aeson-2.3.1.0/tests/UnitTests/OptionalFields.hs+formatted 4e613e1ef254 aeson-2.3.1.0/tests/UnitTests/OptionalFields/Common.hs+formatted d8f208687b90 aeson-2.3.1.0/tests/UnitTests/OptionalFields/Generics.hs+formatted cc59c7b4c685 aeson-2.3.1.0/tests/UnitTests/OptionalFields/Manual.hs+formatted 4a6ecc95787f aeson-2.3.1.0/tests/UnitTests/OptionalFields/TH.hs+formatted e93203961852 aeson-2.3.1.0/tests/UnitTests/UTCTime.hs+formatted e865ae48f11b ansi-terminal-1.1.5/Setup.hs+formatted 444d34793bf4 ansi-terminal-1.1.5/app/Example.hs+formatted 64edb10877a8 ansi-terminal-1.1.5/src/System/Console/ANSI.hs+formatted 0cc59e71668d ansi-terminal-1.1.5/unix/System/Console/ANSI/Internal.hs+formatted 2ee987b3a95a ansi-terminal-1.1.5/win/System/Console/ANSI/Internal.hs+formatted 1aaa3e2316a9 ansi-terminal-1.1.5/win/System/Console/ANSI/Windows/Foreign.hs+does-not-parse - 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 539941d64e62 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+formatted 7f1489b412a3 async-2.2.6/bench/concasync.hs+formatted 947eb9e17a7c async-2.2.6/bench/conccancel.hs+formatted 6fd907018c80 async-2.2.6/bench/race.hs+formatted 5737c788d68d async-2.2.6/test/test-async.hs+formatted 9f3238148609 attoparsec-0.14.4/Data/Attoparsec.hs+formatted 7d88b33f4399 attoparsec-0.14.4/Data/Attoparsec/ByteString.hs+formatted 4ba03080e749 attoparsec-0.14.4/Data/Attoparsec/ByteString/Char8.hs+formatted 0e47afce0362 attoparsec-0.14.4/Data/Attoparsec/ByteString/Internal.hs+formatted fcc23ffbbc3d attoparsec-0.14.4/Data/Attoparsec/ByteString/Lazy.hs+formatted 220f76f3ce4e attoparsec-0.14.4/Data/Attoparsec/Char8.hs+formatted 90be588fbc3a attoparsec-0.14.4/Data/Attoparsec/Combinator.hs+formatted 4b9154d41c2a attoparsec-0.14.4/Data/Attoparsec/Internal.hs+formatted 4f1284a9fd4b attoparsec-0.14.4/Data/Attoparsec/Internal/Types.hs+formatted ea3b710a875e attoparsec-0.14.4/Data/Attoparsec/Lazy.hs+formatted 3d8057d5d688 attoparsec-0.14.4/Data/Attoparsec/Number.hs+formatted 45050bdb0a87 attoparsec-0.14.4/Data/Attoparsec/Text.hs+formatted 8419b057d5a4 attoparsec-0.14.4/Data/Attoparsec/Text/Internal.hs+formatted b1c4021729a8 attoparsec-0.14.4/Data/Attoparsec/Text/Lazy.hs+formatted 63d322215a87 attoparsec-0.14.4/Data/Attoparsec/Types.hs+formatted 8ab300fd67b0 attoparsec-0.14.4/Data/Attoparsec/Zepto.hs+formatted 53b0400e60aa attoparsec-0.14.4/benchmarks/Aeson.hs+formatted b151a3ed3e1a attoparsec-0.14.4/benchmarks/Benchmarks.hs+formatted bd0309211105 attoparsec-0.14.4/benchmarks/Common.hs+formatted baa4df75c7d8 attoparsec-0.14.4/benchmarks/Genome.hs+formatted 3f8483fc03da attoparsec-0.14.4/benchmarks/HeadersByteString.hs+formatted bb42606c4a8a attoparsec-0.14.4/benchmarks/HeadersByteString/Atto.hs+formatted 5a57c6aaa740 attoparsec-0.14.4/benchmarks/HeadersText.hs+formatted 8fa6e462f95f attoparsec-0.14.4/benchmarks/Links.hs+formatted f582abe3e244 attoparsec-0.14.4/benchmarks/Numbers.hs+formatted 696be472825c attoparsec-0.14.4/benchmarks/Sets.hs+formatted 4127b367fedd attoparsec-0.14.4/benchmarks/TextFastSet.hs+formatted 2b16e18cd8c0 attoparsec-0.14.4/benchmarks/Warp.hs+formatted 5aab92534568 attoparsec-0.14.4/benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/ReadInt.hs+formatted 1f7d3a417fb5 attoparsec-0.14.4/benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/RequestHeader.hs+formatted 0d3565bef090 attoparsec-0.14.4/examples/Atto_RFC2616.hs+formatted b6861e7aadf8 attoparsec-0.14.4/examples/Parsec_RFC2616.hs+formatted af7fdd1013cc attoparsec-0.14.4/examples/RFC2616.hs+formatted ef93830525fb attoparsec-0.14.4/internal/Data/Attoparsec/ByteString/Buffer.hs+formatted 11586d954f58 attoparsec-0.14.4/internal/Data/Attoparsec/ByteString/FastSet.hs+formatted f21e47830b1f attoparsec-0.14.4/internal/Data/Attoparsec/Internal/Compat.hs+formatted 4498fcbfa61f attoparsec-0.14.4/internal/Data/Attoparsec/Internal/Fhthagn.hs+formatted 5702ff8f1bfe attoparsec-0.14.4/internal/Data/Attoparsec/Text/Buffer.hs+formatted eb9808888de1 attoparsec-0.14.4/internal/Data/Attoparsec/Text/FastSet.hs+formatted ccaeb87485db attoparsec-0.14.4/tests/QC.hs+formatted c4481214d6c0 attoparsec-0.14.4/tests/QC/Buffer.hs+formatted ae7fa7b38a4b attoparsec-0.14.4/tests/QC/ByteString.hs+formatted 455e4866502a attoparsec-0.14.4/tests/QC/Combinator.hs+formatted 432dc39c009b attoparsec-0.14.4/tests/QC/Common.hs+formatted e1690783c200 attoparsec-0.14.4/tests/QC/IPv6/Internal.hs+formatted 0692feda416d attoparsec-0.14.4/tests/QC/IPv6/Types.hs+formatted 08452f3d9508 attoparsec-0.14.4/tests/QC/Rechunked.hs+formatted 0bab40e54197 attoparsec-0.14.4/tests/QC/Simple.hs+formatted f610227583f7 attoparsec-0.14.4/tests/QC/Text.hs+formatted 930b366b3b68 attoparsec-0.14.4/tests/QC/Text/FastSet.hs+formatted ed6a9f21b67c attoparsec-0.14.4/tests/QC/Text/Regressions.hs+formatted 7710b806795e aws-0.25.3/Aws.hs+formatted a9796f263dfc aws-0.25.3/Aws/Aws.hs+formatted 162fd677ca7f 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 816c9145f15f aws-0.25.3/Aws/DynamoDb/Commands/BatchGetItem.hs+formatted 66180bb576de aws-0.25.3/Aws/DynamoDb/Commands/BatchWriteItem.hs+formatted 2dd73c556bae aws-0.25.3/Aws/DynamoDb/Commands/DeleteItem.hs+formatted a4c1ac5401e1 aws-0.25.3/Aws/DynamoDb/Commands/GetItem.hs+formatted 8eeae03bf6c6 aws-0.25.3/Aws/DynamoDb/Commands/PutItem.hs+formatted 39a1d3ed567f aws-0.25.3/Aws/DynamoDb/Commands/Query.hs+formatted ee62e16512fa aws-0.25.3/Aws/DynamoDb/Commands/Scan.hs+formatted c38c6911e37d aws-0.25.3/Aws/DynamoDb/Commands/Table.hs+formatted 63e4dc333814 aws-0.25.3/Aws/DynamoDb/Commands/UpdateItem.hs+formatted 953d8c1f7a8f 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+formatted 6cab7de997d4 aws-0.25.3/Aws/Iam/Commands/AddUserToGroup.hs+formatted 86ddf2e56d99 aws-0.25.3/Aws/Iam/Commands/CreateAccessKey.hs+formatted d91ce3a3d7eb aws-0.25.3/Aws/Iam/Commands/CreateGroup.hs+formatted 0151d576a66e aws-0.25.3/Aws/Iam/Commands/CreateUser.hs+formatted 534cd5da900d aws-0.25.3/Aws/Iam/Commands/DeleteAccessKey.hs+formatted 69f808dacd5c aws-0.25.3/Aws/Iam/Commands/DeleteGroup.hs+formatted c99d76b534c3 aws-0.25.3/Aws/Iam/Commands/DeleteGroupPolicy.hs+formatted 7214274b0a75 aws-0.25.3/Aws/Iam/Commands/DeleteUser.hs+formatted 539089e60152 aws-0.25.3/Aws/Iam/Commands/DeleteUserPolicy.hs+formatted 96c13cf9a584 aws-0.25.3/Aws/Iam/Commands/GetGroupPolicy.hs+formatted 512be8c8f03d aws-0.25.3/Aws/Iam/Commands/GetUser.hs+formatted a2a951b85bd4 aws-0.25.3/Aws/Iam/Commands/GetUserPolicy.hs+formatted 27c28857ce57 aws-0.25.3/Aws/Iam/Commands/ListAccessKeys.hs+formatted dbb935e72374 aws-0.25.3/Aws/Iam/Commands/ListGroupPolicies.hs+formatted 650c943b98e3 aws-0.25.3/Aws/Iam/Commands/ListGroups.hs+formatted ba0e4827b583 aws-0.25.3/Aws/Iam/Commands/ListMfaDevices.hs+formatted 318b8d56fcfa aws-0.25.3/Aws/Iam/Commands/ListUserPolicies.hs+formatted 1238be9d0ebe aws-0.25.3/Aws/Iam/Commands/ListUsers.hs+formatted a9adfe2a442f aws-0.25.3/Aws/Iam/Commands/PutGroupPolicy.hs+formatted 6f67f99ccb94 aws-0.25.3/Aws/Iam/Commands/PutUserPolicy.hs+formatted 3108bb7a63ed aws-0.25.3/Aws/Iam/Commands/RemoveUserFromGroup.hs+formatted fbb2573ec037 aws-0.25.3/Aws/Iam/Commands/UpdateAccessKey.hs+formatted 318f4ad2dd6f aws-0.25.3/Aws/Iam/Commands/UpdateGroup.hs+formatted 0e38dcbc3f33 aws-0.25.3/Aws/Iam/Commands/UpdateUser.hs+formatted 0e616b268e22 aws-0.25.3/Aws/Iam/Core.hs+formatted feab396b426b aws-0.25.3/Aws/Iam/Internal.hs+formatted 02714b33e7fa aws-0.25.3/Aws/Network.hs+formatted ce77812a32a4 aws-0.25.3/Aws/S3.hs+formatted 468614525265 aws-0.25.3/Aws/S3/Commands.hs+formatted 6e0d1bf40820 aws-0.25.3/Aws/S3/Commands/CopyObject.hs+formatted 74b3876221d3 aws-0.25.3/Aws/S3/Commands/DeleteBucket.hs+formatted 2172bd0ac689 aws-0.25.3/Aws/S3/Commands/DeleteObject.hs+formatted 71b066deaf91 aws-0.25.3/Aws/S3/Commands/DeleteObjectVersion.hs+formatted aec32a8ce26a aws-0.25.3/Aws/S3/Commands/DeleteObjects.hs+formatted 58c26ad66fe6 aws-0.25.3/Aws/S3/Commands/GetBucket.hs+formatted 25df4181bd01 aws-0.25.3/Aws/S3/Commands/GetBucketLocation.hs+formatted 8576d8050fa2 aws-0.25.3/Aws/S3/Commands/GetBucketObjectVersions.hs+formatted c2ae17dfac1c aws-0.25.3/Aws/S3/Commands/GetBucketVersioning.hs+formatted 1da66c4c9858 aws-0.25.3/Aws/S3/Commands/GetObject.hs+formatted 6f29ea695d0a aws-0.25.3/Aws/S3/Commands/GetService.hs+formatted 293d655f68ee aws-0.25.3/Aws/S3/Commands/HeadObject.hs+formatted 6d71ddbd4d83 aws-0.25.3/Aws/S3/Commands/Multipart.hs+formatted c9972f937c82 aws-0.25.3/Aws/S3/Commands/PutBucket.hs+formatted 17fac1555526 aws-0.25.3/Aws/S3/Commands/PutBucketVersioning.hs+formatted 5f970509bf06 aws-0.25.3/Aws/S3/Commands/PutObject.hs+formatted 35b464748fc1 aws-0.25.3/Aws/S3/Commands/RestoreObject.hs+formatted 627fffa71c1a aws-0.25.3/Aws/S3/Core.hs+formatted e59133632c71 aws-0.25.3/Aws/Ses.hs+formatted 98906d812790 aws-0.25.3/Aws/Ses/Commands.hs+formatted d82f6af0c772 aws-0.25.3/Aws/Ses/Commands/DeleteIdentity.hs+formatted 0a54c52718c5 aws-0.25.3/Aws/Ses/Commands/GetIdentityDkimAttributes.hs+formatted 661cdba65ae1 aws-0.25.3/Aws/Ses/Commands/GetIdentityNotificationAttributes.hs+formatted abee7d091f47 aws-0.25.3/Aws/Ses/Commands/GetIdentityVerificationAttributes.hs+formatted cf1089b5ea07 aws-0.25.3/Aws/Ses/Commands/ListIdentities.hs+formatted 7ab7fc59aa36 aws-0.25.3/Aws/Ses/Commands/SendRawEmail.hs+formatted 562173d60b20 aws-0.25.3/Aws/Ses/Commands/SetIdentityDkimEnabled.hs+formatted 629ac12fe396 aws-0.25.3/Aws/Ses/Commands/SetIdentityFeedbackForwardingEnabled.hs+formatted 7b13bc8a115c aws-0.25.3/Aws/Ses/Commands/SetIdentityNotificationTopic.hs+formatted 2ef608635aeb aws-0.25.3/Aws/Ses/Commands/VerifyDomainDkim.hs+formatted ffb19c08b235 aws-0.25.3/Aws/Ses/Commands/VerifyDomainIdentity.hs+formatted de43062d4755 aws-0.25.3/Aws/Ses/Commands/VerifyEmailIdentity.hs+formatted b9023a14f6f1 aws-0.25.3/Aws/Ses/Core.hs+formatted 4115c76b6f3d aws-0.25.3/Aws/SimpleDb.hs+formatted 0b6040677d6d aws-0.25.3/Aws/SimpleDb/Commands.hs+formatted 81ffab76c170 aws-0.25.3/Aws/SimpleDb/Commands/Attributes.hs+formatted 9616c948cf13 aws-0.25.3/Aws/SimpleDb/Commands/Domain.hs+formatted 8deb23c46a5b aws-0.25.3/Aws/SimpleDb/Commands/Select.hs+formatted 1542fdb811fb aws-0.25.3/Aws/SimpleDb/Core.hs+formatted 412e7ea774c8 aws-0.25.3/Aws/Sqs.hs+formatted 346f822a2760 aws-0.25.3/Aws/Sqs/Commands.hs+formatted 6d4c58eca68a aws-0.25.3/Aws/Sqs/Commands/Message.hs+formatted 05c968d4a089 aws-0.25.3/Aws/Sqs/Commands/Permission.hs+formatted 3a2b342a12c4 aws-0.25.3/Aws/Sqs/Commands/Queue.hs+formatted 33ff20c0cc1b aws-0.25.3/Aws/Sqs/Commands/QueueAttributes.hs+formatted 8141a49d45ee aws-0.25.3/Aws/Sqs/Core.hs+formatted eb8ba0f68d00 aws-0.25.3/Examples/DynamoDb.hs+formatted 9a96ec734f74 aws-0.25.3/Examples/GetObject.hs+formatted 799e429953e7 aws-0.25.3/Examples/GetObjectGoogle.hs+formatted 8065499ab307 aws-0.25.3/Examples/GetObjectV4.hs+formatted 0121b3f3d691 aws-0.25.3/Examples/MultipartTransfer.hs+formatted c09c03a39390 aws-0.25.3/Examples/MultipartUpload.hs+formatted f8163e1e4473 aws-0.25.3/Examples/NukeBucket.hs+formatted 34698069cedb aws-0.25.3/Examples/PutBucketNearLine.hs+formatted d6caebe65382 aws-0.25.3/Examples/SimpleDb.hs+formatted c31e8b7adbf5 aws-0.25.3/Examples/Sqs.hs+formatted e865ae48f11b aws-0.25.3/Setup.hs+formatted 354bb309a68c aws-0.25.3/tests/DynamoDb/Main.hs+formatted 75daea597c6a aws-0.25.3/tests/DynamoDb/Utils.hs+formatted 3ffa8999bdf7 aws-0.25.3/tests/S3/Main.hs+formatted 44336eea1e26 aws-0.25.3/tests/Sqs/Main.hs+formatted 001f1d1eb163 aws-0.25.3/tests/Utils.hs+formatted c4588035d2e2 base64-bytestring-1.2.1.0/Data/ByteString/Base64.hs+formatted 2897fc80ce31 base64-bytestring-1.2.1.0/Data/ByteString/Base64/Internal.hs+formatted dae9abac8bd0 base64-bytestring-1.2.1.0/Data/ByteString/Base64/Lazy.hs+formatted f0e7d8a34f4b base64-bytestring-1.2.1.0/Data/ByteString/Base64/URL.hs+formatted 0d8bf6b77f56 base64-bytestring-1.2.1.0/Data/ByteString/Base64/URL/Lazy.hs+formatted e865ae48f11b base64-bytestring-1.2.1.0/Setup.hs+formatted 0328dc0c3c7c base64-bytestring-1.2.1.0/benchmarks/BM.hs+formatted e856b328c01f base64-bytestring-1.2.1.0/tests/Tests.hs+formatted d41a83550f57 base64-bytestring-1.2.1.0/utils/Transcode.hs+formatted a696585f6bb3 bifunctors-5.6.3/src/Data/Biapplicative.hs+formatted 445cc73ae2f4 bifunctors-5.6.3/src/Data/Bifunctor/Biap.hs+formatted 4e8e99fc3d02 bifunctors-5.6.3/src/Data/Bifunctor/Biff.hs+formatted 622562a94746 bifunctors-5.6.3/src/Data/Bifunctor/Clown.hs+formatted 5ed71c802f86 bifunctors-5.6.3/src/Data/Bifunctor/Fix.hs+formatted 2b2e1c855d83 bifunctors-5.6.3/src/Data/Bifunctor/Flip.hs+formatted 3ac44f1c96ed bifunctors-5.6.3/src/Data/Bifunctor/Functor.hs+formatted c5ca87b8d191 bifunctors-5.6.3/src/Data/Bifunctor/Join.hs+formatted 50a39353a74f bifunctors-5.6.3/src/Data/Bifunctor/Joker.hs+formatted d60de274f1df bifunctors-5.6.3/src/Data/Bifunctor/Product.hs+formatted a4989781f0a5 bifunctors-5.6.3/src/Data/Bifunctor/Sum.hs+formatted 07398be9dabc bifunctors-5.6.3/src/Data/Bifunctor/TH.hs+formatted b4784a48aa1a bifunctors-5.6.3/src/Data/Bifunctor/TH/Internal.hs+formatted d65d2830209f bifunctors-5.6.3/src/Data/Bifunctor/Tannen.hs+formatted 4b43e6d2b7ee bifunctors-5.6.3/src/Data/Bifunctor/Wrapped.hs+formatted 0abba42a51a4 bifunctors-5.6.3/tests/BifunctorSpec.hs+formatted 2fbd14b119a4 bifunctors-5.6.3/tests/Spec.hs+formatted 20bbaaea7be2 bifunctors-5.6.3/tests/T89Spec.hs+formatted e865ae48f11b blaze-html-0.9.2.0/Setup.hs+formatted 59b1e28dc18c blaze-html-0.9.2.0/src/Text/Blaze/Html.hs+formatted 1ceaed7998ed blaze-html-0.9.2.0/src/Text/Blaze/Html/Renderer/Pretty.hs+formatted a5a8080ce8a3 blaze-html-0.9.2.0/src/Text/Blaze/Html/Renderer/String.hs+formatted 850270b61be0 blaze-html-0.9.2.0/src/Text/Blaze/Html/Renderer/Text.hs+formatted 4dbd824fb533 blaze-html-0.9.2.0/src/Text/Blaze/Html/Renderer/Utf8.hs+formatted 193787aa6e82 blaze-html-0.9.2.0/src/Text/Blaze/Html4/FrameSet.hs+formatted 311d6a242cd1 blaze-html-0.9.2.0/src/Text/Blaze/Html4/FrameSet/Attributes.hs+formatted 980072ab3333 blaze-html-0.9.2.0/src/Text/Blaze/Html4/Strict.hs+formatted 6d96fbabc526 blaze-html-0.9.2.0/src/Text/Blaze/Html4/Strict/Attributes.hs+formatted 4c6ce53fa6c0 blaze-html-0.9.2.0/src/Text/Blaze/Html4/Transitional.hs+formatted d39d423c9274 blaze-html-0.9.2.0/src/Text/Blaze/Html4/Transitional/Attributes.hs+formatted 6593178d8914 blaze-html-0.9.2.0/src/Text/Blaze/Html5.hs+formatted a51b4ec4c88c blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs+formatted a3131475444c blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/FrameSet.hs+formatted b11110851d4d blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/FrameSet/Attributes.hs+formatted 326a6b8007f4 blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/Strict.hs+formatted 614d1d8b8758 blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/Strict/Attributes.hs+formatted f18debc4b04a blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/Transitional.hs+formatted b02420bd150d blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/Transitional/Attributes.hs+formatted 19fcd3fe0b2a blaze-html-0.9.2.0/src/Text/Blaze/XHtml5.hs+formatted e7349ea7b26e blaze-html-0.9.2.0/src/Text/Blaze/XHtml5/Attributes.hs+formatted 6a3eeb3e9d8b blaze-html-0.9.2.0/src/Util/GenerateHtmlCombinators.hs+formatted c350d72adcf6 blaze-html-0.9.2.0/src/Util/Sanitize.hs+formatted 3b0e5b5fbcb0 blaze-html-0.9.2.0/tests/TestSuite.hs+formatted e2943235e42d blaze-html-0.9.2.0/tests/Text/Blaze/Html/Tests.hs+formatted 9dae0554f33d blaze-html-0.9.2.0/tests/Text/Blaze/Html/Tests/Util.hs+formatted c858d7e158e9 blaze-html-0.9.2.0/tests/Util/Tests.hs+formatted e865ae48f11b blaze-markup-0.8.3.0/Setup.hs+formatted a414efd123bb blaze-markup-0.8.3.0/src/Text/Blaze.hs+formatted b748bec53a7d blaze-markup-0.8.3.0/src/Text/Blaze/Internal.hs+formatted 4846f41adc9e blaze-markup-0.8.3.0/src/Text/Blaze/Renderer/Pretty.hs+formatted 2e54745ce84a blaze-markup-0.8.3.0/src/Text/Blaze/Renderer/String.hs+formatted 8bb5a6b40341 blaze-markup-0.8.3.0/src/Text/Blaze/Renderer/Text.hs+formatted c0f54cd6a8ef blaze-markup-0.8.3.0/src/Text/Blaze/Renderer/Utf8.hs+formatted c7292f26d075 blaze-markup-0.8.3.0/tests/TestSuite.hs+formatted efa997a477e9 blaze-markup-0.8.3.0/tests/Text/Blaze/Tests.hs+formatted e6ac9555645c blaze-markup-0.8.3.0/tests/Text/Blaze/Tests/Util.hs+formatted e865ae48f11b brick-2.13/Setup.hs+formatted 63a60b3578b5 brick-2.13/programs/AnimationDemo.hs+formatted 5d807c6bfef9 brick-2.13/programs/AttrDemo.hs+formatted efff9829e309 brick-2.13/programs/BorderDemo.hs+formatted aef958fe74cd brick-2.13/programs/CacheDemo.hs+formatted 095e55ce36f6 brick-2.13/programs/CroppingDemo.hs+formatted 2bd41626b7f1 brick-2.13/programs/CustomEventDemo.hs+formatted 74968af52af2 brick-2.13/programs/CustomKeybindingDemo.hs+formatted 8438ad4ac269 brick-2.13/programs/DialogDemo.hs+formatted 70a751a6fa70 brick-2.13/programs/DynamicBorderDemo.hs+formatted 464ea19b0d91 brick-2.13/programs/EditDemo.hs+formatted 4cce67dc7675 brick-2.13/programs/EditorLineNumbersDemo.hs+formatted cb441c25368f brick-2.13/programs/FileBrowserDemo.hs+formatted f42c468e824d brick-2.13/programs/FillDemo.hs+formatted f53d59f91db3 brick-2.13/programs/FormDemo.hs+formatted ccec85b0d210 brick-2.13/programs/HelloWorldDemo.hs+formatted df3c26970095 brick-2.13/programs/LayerDemo.hs+formatted f010e64931de brick-2.13/programs/ListDemo.hs+formatted 72b3c637e7a9 brick-2.13/programs/ListViDemo.hs+formatted b09c3f445d0e brick-2.13/programs/MouseDemo.hs+formatted 07bae652c697 brick-2.13/programs/PaddingDemo.hs+formatted b42491ad385a brick-2.13/programs/ProgressBarDemo.hs+formatted 663c2424c9c5 brick-2.13/programs/ReadmeDemo.hs+formatted d199bd740848 brick-2.13/programs/SuspendAndResumeDemo.hs+formatted da922e788566 brick-2.13/programs/TableDemo.hs+formatted 4475181f29de brick-2.13/programs/TabularListDemo.hs+formatted b7e39f0a8d19 brick-2.13/programs/TailDemo.hs+formatted d386391b5c6d brick-2.13/programs/TextWrapDemo.hs+formatted 4539be6276d5 brick-2.13/programs/ThemeDemo.hs+formatted 2c64cf0649ba brick-2.13/programs/ViewportScrollDemo.hs+formatted 76a2aa468b27 brick-2.13/programs/ViewportScrollbarsDemo.hs+formatted e2bd645f4c8a brick-2.13/programs/VisibilityDemo.hs+formatted 0abc07286e47 brick-2.13/src/Brick.hs+formatted 5c7acfef56e2 brick-2.13/src/Brick/Animation.hs+formatted deb1866c9333 brick-2.13/src/Brick/Animation/Clock.hs+formatted 91b158ee4b8a brick-2.13/src/Brick/AttrMap.hs+formatted 13c109f25eb8 brick-2.13/src/Brick/BChan.hs+formatted a220048b3f60 brick-2.13/src/Brick/BorderMap.hs+formatted 7aa4818185b3 brick-2.13/src/Brick/Focus.hs+formatted b99dcc536b6e brick-2.13/src/Brick/Forms.hs+formatted d6c2a2e1b0a0 brick-2.13/src/Brick/Keybindings.hs+formatted 4afba3471679 brick-2.13/src/Brick/Keybindings/KeyConfig.hs+formatted e8fe81270a11 brick-2.13/src/Brick/Keybindings/KeyDispatcher.hs+formatted 10682f468a33 brick-2.13/src/Brick/Keybindings/KeyEvents.hs+formatted 20d38a2fef1c brick-2.13/src/Brick/Keybindings/Normalize.hs+formatted 422ce68b006b brick-2.13/src/Brick/Keybindings/Parse.hs+formatted 500582ecf6a0 brick-2.13/src/Brick/Keybindings/Pretty.hs+formatted 3a2fd805219a brick-2.13/src/Brick/Main.hs+formatted 74d114b85be0 brick-2.13/src/Brick/Themes.hs+formatted af2489bd5835 brick-2.13/src/Brick/Types.hs+formatted 5a0fb2f107c1 brick-2.13/src/Brick/Types/Common.hs+formatted 1053ffe4d321 brick-2.13/src/Brick/Types/EventM.hs+formatted 680c7fc4c12b brick-2.13/src/Brick/Types/Internal.hs+formatted 81c674829568 brick-2.13/src/Brick/Types/TH.hs+formatted 02b0e53f451c brick-2.13/src/Brick/Util.hs+formatted cba7b18b8f68 brick-2.13/src/Brick/Widgets/Border.hs+formatted 89894b08f498 brick-2.13/src/Brick/Widgets/Border/Style.hs+formatted e3b47970aba1 brick-2.13/src/Brick/Widgets/Center.hs+formatted d864d6f5529c brick-2.13/src/Brick/Widgets/Core.hs+formatted 9b5313ab5ee9 brick-2.13/src/Brick/Widgets/Dialog.hs+formatted c71ef0bf6ec5 brick-2.13/src/Brick/Widgets/Edit.hs+formatted 4478fd2c6064 brick-2.13/src/Brick/Widgets/FileBrowser.hs+formatted c480d93b371e brick-2.13/src/Brick/Widgets/Internal.hs+formatted f35028306876 brick-2.13/src/Brick/Widgets/List.hs+formatted 45273510047b brick-2.13/src/Brick/Widgets/ProgressBar.hs+formatted 18c427091a7b brick-2.13/src/Brick/Widgets/Table.hs+formatted 868aec6c5d83 brick-2.13/src/Data/IMap.hs+formatted 15733bb95234 brick-2.13/tests/List.hs+formatted 2e6ed8d0e976 brick-2.13/tests/Main.hs+formatted 073f01c2462e brick-2.13/tests/Render.hs+formatted e0fa5e2b222c brittany-0.14.0.2/data/Test1.hs+formatted a7fed1125f29 brittany-0.14.0.2/data/Test10.hs+formatted dd2db552d155 brittany-0.14.0.2/data/Test100.hs+formatted 3ebccae4d2bf brittany-0.14.0.2/data/Test101.hs+formatted 000b618097d0 brittany-0.14.0.2/data/Test102.hs+formatted 26845ab84f6a brittany-0.14.0.2/data/Test103.hs+formatted 25cf4c76ed6b brittany-0.14.0.2/data/Test104.hs+formatted bac120fe0092 brittany-0.14.0.2/data/Test105.hs+formatted e29d7ffca93f brittany-0.14.0.2/data/Test106.hs+formatted 0b6e06bf2c23 brittany-0.14.0.2/data/Test107.hs+formatted eda42fe4d65b brittany-0.14.0.2/data/Test108.hs+formatted 9ce1b7bc7832 brittany-0.14.0.2/data/Test109.hs+formatted c7d09069af77 brittany-0.14.0.2/data/Test11.hs+formatted 61661f795457 brittany-0.14.0.2/data/Test110.hs+formatted 37d78f5961ec brittany-0.14.0.2/data/Test111.hs+formatted 1e4bb8275bfb brittany-0.14.0.2/data/Test112.hs+formatted 8cda89e87702 brittany-0.14.0.2/data/Test113.hs+formatted 751bfd56bc69 brittany-0.14.0.2/data/Test114.hs+formatted 5078888fc5d2 brittany-0.14.0.2/data/Test115.hs+formatted 3fdf3b074d25 brittany-0.14.0.2/data/Test116.hs+formatted 15ad0c63e705 brittany-0.14.0.2/data/Test117.hs+formatted 5d67c955a452 brittany-0.14.0.2/data/Test118.hs+formatted 4581aecedf18 brittany-0.14.0.2/data/Test119.hs+formatted 624becd3f674 brittany-0.14.0.2/data/Test12.hs+formatted 5bbfe94a03d4 brittany-0.14.0.2/data/Test120.hs+formatted 01ac88bcab1a brittany-0.14.0.2/data/Test121.hs+formatted 057f0ce3ffb0 brittany-0.14.0.2/data/Test122.hs+formatted 661f6da49632 brittany-0.14.0.2/data/Test123.hs+formatted 86c1caf3eee5 brittany-0.14.0.2/data/Test124.hs+formatted c6ffbf389d8d brittany-0.14.0.2/data/Test125.hs+formatted 1b2ef1cfadaa brittany-0.14.0.2/data/Test126.hs+formatted 058f31d7f6cc brittany-0.14.0.2/data/Test127.hs+formatted bec0f8aa554d brittany-0.14.0.2/data/Test128.hs+formatted f712d9c961eb brittany-0.14.0.2/data/Test129.hs+formatted 79735ec00a3d brittany-0.14.0.2/data/Test13.hs+formatted f808d5477ba7 brittany-0.14.0.2/data/Test130.hs+formatted 2372bf2e1670 brittany-0.14.0.2/data/Test131.hs+formatted c6526aabb3c3 brittany-0.14.0.2/data/Test132.hs+formatted 5287afc100b5 brittany-0.14.0.2/data/Test133.hs+formatted cbf28cc3de46 brittany-0.14.0.2/data/Test134.hs+formatted e9f15a2df4fd brittany-0.14.0.2/data/Test135.hs+formatted d40ccadec39d brittany-0.14.0.2/data/Test136.hs+formatted e8b4564e3bfa brittany-0.14.0.2/data/Test137.hs+formatted ddbd7b880898 brittany-0.14.0.2/data/Test138.hs+formatted 4ce9b0b36ac2 brittany-0.14.0.2/data/Test139.hs+formatted bb31ea72e15c brittany-0.14.0.2/data/Test14.hs+formatted f04daeaa79e9 brittany-0.14.0.2/data/Test140.hs+formatted 3f2c0367c6f9 brittany-0.14.0.2/data/Test141.hs+formatted edb875329172 brittany-0.14.0.2/data/Test142.hs+formatted fa53ce7f455d brittany-0.14.0.2/data/Test143.hs+formatted 1c5e166b5b3c brittany-0.14.0.2/data/Test144.hs+formatted 412dc562e63e brittany-0.14.0.2/data/Test145.hs+formatted 6594ac0ac89d brittany-0.14.0.2/data/Test146.hs+formatted 0132945dc887 brittany-0.14.0.2/data/Test147.hs+formatted 0277bb5ca795 brittany-0.14.0.2/data/Test148.hs+formatted cbbb9e8ddafa brittany-0.14.0.2/data/Test149.hs+formatted 9db344b52a25 brittany-0.14.0.2/data/Test15.hs+formatted d29a46b01b30 brittany-0.14.0.2/data/Test150.hs+formatted d4d803460298 brittany-0.14.0.2/data/Test151.hs+formatted a36d7b2912f5 brittany-0.14.0.2/data/Test152.hs+formatted ea0b611491be brittany-0.14.0.2/data/Test153.hs+formatted 6607ab7d8924 brittany-0.14.0.2/data/Test154.hs+formatted 66cbd556135d brittany-0.14.0.2/data/Test155.hs+formatted 2913f4f1ea6b brittany-0.14.0.2/data/Test156.hs+formatted 57f3fe7514c4 brittany-0.14.0.2/data/Test157.hs+formatted 7cff7b0ac651 brittany-0.14.0.2/data/Test158.hs+formatted d8fde995e15b brittany-0.14.0.2/data/Test159.hs+formatted b65a3702395c brittany-0.14.0.2/data/Test16.hs+formatted 8f083a4a74fc brittany-0.14.0.2/data/Test160.hs+formatted 756b8d709d75 brittany-0.14.0.2/data/Test161.hs+formatted fb931ccfd1e4 brittany-0.14.0.2/data/Test162.hs+formatted 30ebe5ac65f1 brittany-0.14.0.2/data/Test163.hs+formatted 729a285d4963 brittany-0.14.0.2/data/Test164.hs+formatted 1d7b340799de brittany-0.14.0.2/data/Test165.hs+formatted 660e2a8d17c4 brittany-0.14.0.2/data/Test166.hs+formatted 9034e094d375 brittany-0.14.0.2/data/Test167.hs+formatted d8056c8b2928 brittany-0.14.0.2/data/Test168.hs+formatted cd8fce2bda23 brittany-0.14.0.2/data/Test169.hs+formatted bce8e4d3c9ba brittany-0.14.0.2/data/Test17.hs+formatted b9c1ba677274 brittany-0.14.0.2/data/Test170.hs+formatted 81fa7c381707 brittany-0.14.0.2/data/Test171.hs+formatted ac4339e3794f brittany-0.14.0.2/data/Test172.hs+formatted c651a0d78d61 brittany-0.14.0.2/data/Test173.hs+formatted 893e9047ccc9 brittany-0.14.0.2/data/Test174.hs+formatted 44a807f3c420 brittany-0.14.0.2/data/Test175.hs+formatted feac3083c99d brittany-0.14.0.2/data/Test176.hs+formatted 2cc15cb26130 brittany-0.14.0.2/data/Test177.hs+formatted 47771349ee44 brittany-0.14.0.2/data/Test178.hs+formatted fe3c3245408d brittany-0.14.0.2/data/Test179.hs+formatted 674dab4fdbcb brittany-0.14.0.2/data/Test18.hs+formatted c68cfb31f575 brittany-0.14.0.2/data/Test180.hs+formatted e6325e11af38 brittany-0.14.0.2/data/Test181.hs+formatted 42d9bc7fc2ce brittany-0.14.0.2/data/Test182.hs+formatted a1e86d78ee32 brittany-0.14.0.2/data/Test183.hs+formatted 88ddfc17a44e brittany-0.14.0.2/data/Test184.hs+formatted f6c7f8ad0585 brittany-0.14.0.2/data/Test185.hs+formatted 5016aa65eeae brittany-0.14.0.2/data/Test186.hs+formatted 1f6812c3d99f brittany-0.14.0.2/data/Test187.hs+formatted a063a95ec0b5 brittany-0.14.0.2/data/Test188.hs+formatted 67c40f7b42e6 brittany-0.14.0.2/data/Test189.hs+formatted 1b68494e9013 brittany-0.14.0.2/data/Test19.hs+formatted 96f1ef06a2f4 brittany-0.14.0.2/data/Test190.hs+formatted a063a95ec0b5 brittany-0.14.0.2/data/Test191.hs+formatted dc32174d8f9d brittany-0.14.0.2/data/Test192.hs+formatted b35395abfd05 brittany-0.14.0.2/data/Test193.hs+formatted 4d5ddfd8aaab brittany-0.14.0.2/data/Test194.hs+formatted 8bb98e83f59e brittany-0.14.0.2/data/Test195.hs+formatted 45232601b2c3 brittany-0.14.0.2/data/Test196.hs+formatted bdc233fea9ba brittany-0.14.0.2/data/Test197.hs+formatted 9ce65738e093 brittany-0.14.0.2/data/Test198.hs+formatted eec0cab9f980 brittany-0.14.0.2/data/Test199.hs+formatted 31b2046f8a67 brittany-0.14.0.2/data/Test2.hs+formatted a7a0e1c03060 brittany-0.14.0.2/data/Test20.hs+formatted d2a7653b9ba4 brittany-0.14.0.2/data/Test200.hs+formatted 585cd696f310 brittany-0.14.0.2/data/Test201.hs+formatted 8bba3630cd88 brittany-0.14.0.2/data/Test202.hs+formatted 3e4e79b5a82a brittany-0.14.0.2/data/Test203.hs+formatted 4ce40055a31c brittany-0.14.0.2/data/Test204.hs+formatted be6b7a8883f5 brittany-0.14.0.2/data/Test205.hs+formatted 8e7d7929e338 brittany-0.14.0.2/data/Test206.hs+formatted 3e6a91618060 brittany-0.14.0.2/data/Test207.hs+formatted 59f9efb3349d brittany-0.14.0.2/data/Test208.hs+formatted 79081f0fe37d brittany-0.14.0.2/data/Test209.hs+formatted b383b15d82f0 brittany-0.14.0.2/data/Test21.hs+formatted 4f8c82f9b51b brittany-0.14.0.2/data/Test210.hs+formatted 210d2b918c18 brittany-0.14.0.2/data/Test211.hs+formatted d8fb0486ae8c brittany-0.14.0.2/data/Test212.hs+formatted e75e1dd08970 brittany-0.14.0.2/data/Test213.hs+formatted 43a86c48e3e0 brittany-0.14.0.2/data/Test214.hs+formatted ccd8170ddd1c brittany-0.14.0.2/data/Test215.hs+formatted d9d08f97d6ce brittany-0.14.0.2/data/Test216.hs+formatted ee242f311cec brittany-0.14.0.2/data/Test217.hs+formatted 2c1a4f8388c7 brittany-0.14.0.2/data/Test218.hs+formatted 77521cf0255b brittany-0.14.0.2/data/Test219.hs+formatted df6920225c3e brittany-0.14.0.2/data/Test22.hs+formatted 6912b515f3d4 brittany-0.14.0.2/data/Test220.hs+formatted 7e87f164cb90 brittany-0.14.0.2/data/Test221.hs+formatted d7e0783e5c83 brittany-0.14.0.2/data/Test222.hs+formatted ac59786a0059 brittany-0.14.0.2/data/Test223.hs+formatted f4b2c131b776 brittany-0.14.0.2/data/Test224.hs+formatted fc2a39383602 brittany-0.14.0.2/data/Test225.hs+formatted 0a2523228f93 brittany-0.14.0.2/data/Test226.hs+formatted 228fee2942c2 brittany-0.14.0.2/data/Test227.hs+formatted 911d30954d07 brittany-0.14.0.2/data/Test228.hs+formatted 2f660f4ac662 brittany-0.14.0.2/data/Test229.hs+formatted fbc349a18ac2 brittany-0.14.0.2/data/Test23.hs+formatted a7a3d4cdb042 brittany-0.14.0.2/data/Test230.hs+formatted 8213e25c0010 brittany-0.14.0.2/data/Test231.hs+formatted cf2c7ac7b851 brittany-0.14.0.2/data/Test232.hs+formatted 60e66feea926 brittany-0.14.0.2/data/Test233.hs+formatted b6113299b5da brittany-0.14.0.2/data/Test234.hs+formatted 661c1fe894fb brittany-0.14.0.2/data/Test235.hs+formatted 57f09569ac82 brittany-0.14.0.2/data/Test236.hs+formatted 0dfd55915ad3 brittany-0.14.0.2/data/Test237.hs+formatted 4bc18bfc8664 brittany-0.14.0.2/data/Test238.hs+formatted f1066c5f9396 brittany-0.14.0.2/data/Test239.hs+formatted d0c0b62e11ea brittany-0.14.0.2/data/Test24.hs+formatted a51ff778ca0c brittany-0.14.0.2/data/Test240.hs+formatted 6f66ff6e7884 brittany-0.14.0.2/data/Test241.hs+formatted 7526d4749124 brittany-0.14.0.2/data/Test242.hs+formatted d600bfded86f brittany-0.14.0.2/data/Test243.hs+formatted dc1932ee9eaf brittany-0.14.0.2/data/Test244.hs+formatted 03cd50abedcb brittany-0.14.0.2/data/Test245.hs+formatted 676a58886eb0 brittany-0.14.0.2/data/Test246.hs+formatted 86d72bb559bc brittany-0.14.0.2/data/Test247.hs+formatted 15d8e562989b brittany-0.14.0.2/data/Test248.hs+formatted 95a821921e97 brittany-0.14.0.2/data/Test249.hs+formatted 372e384be5d9 brittany-0.14.0.2/data/Test25.hs+formatted c8b79c319e1b brittany-0.14.0.2/data/Test250.hs+formatted 9e983a1c88d0 brittany-0.14.0.2/data/Test251.hs+formatted e25fa77a311d brittany-0.14.0.2/data/Test252.hs+formatted 2abc462210d7 brittany-0.14.0.2/data/Test253.hs+formatted 3dab93bb6c11 brittany-0.14.0.2/data/Test254.hs+formatted ded4f913ac25 brittany-0.14.0.2/data/Test255.hs+formatted 7072c13a95c7 brittany-0.14.0.2/data/Test256.hs+formatted f79f249e0890 brittany-0.14.0.2/data/Test257.hs+formatted a9cbb8a905a0 brittany-0.14.0.2/data/Test258.hs+formatted 7c0c18756066 brittany-0.14.0.2/data/Test259.hs+formatted a9993e322f84 brittany-0.14.0.2/data/Test26.hs+formatted bd4ad74e5ad1 brittany-0.14.0.2/data/Test260.hs+formatted 40147eb0ec0f brittany-0.14.0.2/data/Test261.hs+formatted 3821b5d35161 brittany-0.14.0.2/data/Test262.hs+formatted fd9a1453387e brittany-0.14.0.2/data/Test263.hs+formatted b7281c5fb795 brittany-0.14.0.2/data/Test264.hs+formatted d815db72d171 brittany-0.14.0.2/data/Test265.hs+formatted e1e74708d396 brittany-0.14.0.2/data/Test266.hs+formatted eedcbb210202 brittany-0.14.0.2/data/Test267.hs+formatted 0ca543b36b5d brittany-0.14.0.2/data/Test268.hs+formatted 93850bc1adc9 brittany-0.14.0.2/data/Test269.hs+formatted b82004f9b520 brittany-0.14.0.2/data/Test27.hs+formatted 56d7e350bfb5 brittany-0.14.0.2/data/Test270.hs+formatted 8da0ed8508b1 brittany-0.14.0.2/data/Test271.hs+formatted 059cb60e3ffb brittany-0.14.0.2/data/Test272.hs+formatted ce7c5a9f7346 brittany-0.14.0.2/data/Test273.hs+formatted cf3d3b9f17a4 brittany-0.14.0.2/data/Test274.hs+formatted 5687e1c0c469 brittany-0.14.0.2/data/Test275.hs+formatted f54d68eb932d brittany-0.14.0.2/data/Test276.hs+formatted 5280a70aa08d brittany-0.14.0.2/data/Test277.hs+formatted 334f9705684d brittany-0.14.0.2/data/Test278.hs+formatted 9a6ca39add52 brittany-0.14.0.2/data/Test279.hs+formatted 35c64cf444f0 brittany-0.14.0.2/data/Test28.hs+formatted 2c62cf845c15 brittany-0.14.0.2/data/Test280.hs+formatted 6582acde6803 brittany-0.14.0.2/data/Test281.hs+formatted d69c5a291173 brittany-0.14.0.2/data/Test282.hs+formatted dad1fa89cc7b brittany-0.14.0.2/data/Test283.hs+formatted 61ba8c0a1014 brittany-0.14.0.2/data/Test284.hs+formatted dc5e12a45407 brittany-0.14.0.2/data/Test285.hs+formatted dc5e12a45407 brittany-0.14.0.2/data/Test286.hs+formatted f395a35ab415 brittany-0.14.0.2/data/Test287.hs+formatted 3fdaf4d18a7c brittany-0.14.0.2/data/Test288.hs+formatted 8472b4d5d119 brittany-0.14.0.2/data/Test289.hs+formatted 4b4297a0f4c5 brittany-0.14.0.2/data/Test29.hs+formatted af881940fba6 brittany-0.14.0.2/data/Test290.hs+formatted 6b8b53cb8029 brittany-0.14.0.2/data/Test291.hs+formatted afd400f5f5ca brittany-0.14.0.2/data/Test292.hs+formatted dbd53f969525 brittany-0.14.0.2/data/Test293.hs+formatted 8e4e40c43066 brittany-0.14.0.2/data/Test294.hs+formatted 5378d8225be8 brittany-0.14.0.2/data/Test295.hs+formatted efa089fba7ce brittany-0.14.0.2/data/Test296.hs+formatted f2528253489c brittany-0.14.0.2/data/Test297.hs+formatted a71313de7a74 brittany-0.14.0.2/data/Test298.hs+formatted 9c7a3513d329 brittany-0.14.0.2/data/Test299.hs+formatted e430aa9e3dac brittany-0.14.0.2/data/Test3.hs+formatted b786e0a045c4 brittany-0.14.0.2/data/Test30.hs+formatted 82411c11ab17 brittany-0.14.0.2/data/Test300.hs+formatted 6578a96b238b brittany-0.14.0.2/data/Test301.hs+formatted 8cee95f91f47 brittany-0.14.0.2/data/Test302.hs+formatted 01d16f13bc99 brittany-0.14.0.2/data/Test303.hs+formatted 2f37bef49ce1 brittany-0.14.0.2/data/Test304.hs+formatted 9d3e8b7bf639 brittany-0.14.0.2/data/Test305.hs+formatted 20c63b9ecba6 brittany-0.14.0.2/data/Test306.hs+formatted 348106878578 brittany-0.14.0.2/data/Test307.hs+formatted 017f020a856d brittany-0.14.0.2/data/Test308.hs+formatted 980708cbb4c4 brittany-0.14.0.2/data/Test309.hs+formatted b7f73c7d2a34 brittany-0.14.0.2/data/Test31.hs+formatted 3c2cc10d169b brittany-0.14.0.2/data/Test310.hs+formatted 66fcc75686ea brittany-0.14.0.2/data/Test311.hs+formatted 8897cdb0ddcd brittany-0.14.0.2/data/Test312.hs+formatted 0c098371b939 brittany-0.14.0.2/data/Test313.hs+formatted 8de65d3cce3e brittany-0.14.0.2/data/Test314.hs+formatted 3e5aa0cbbf8d brittany-0.14.0.2/data/Test315.hs+formatted 77220193f4fd brittany-0.14.0.2/data/Test316.hs+formatted 681c70c26bdd brittany-0.14.0.2/data/Test317.hs+formatted c9b19f55338f brittany-0.14.0.2/data/Test318.hs+formatted fa83330d01a6 brittany-0.14.0.2/data/Test319.hs+formatted 310b7bac3014 brittany-0.14.0.2/data/Test32.hs+formatted d911bbdfeb7f brittany-0.14.0.2/data/Test320.hs+formatted 1275e28eeb82 brittany-0.14.0.2/data/Test321.hs+formatted d51414b5c108 brittany-0.14.0.2/data/Test322.hs+formatted e318ac8aa564 brittany-0.14.0.2/data/Test323.hs+formatted f018e148e8d5 brittany-0.14.0.2/data/Test324.hs+formatted 1d0af944da7b brittany-0.14.0.2/data/Test325.hs+formatted 5798a680c21f brittany-0.14.0.2/data/Test326.hs+formatted 023057e5ea2c brittany-0.14.0.2/data/Test327.hs+formatted 2341d88441d5 brittany-0.14.0.2/data/Test328.hs+formatted 947d63282515 brittany-0.14.0.2/data/Test329.hs+formatted 786cf111bdad brittany-0.14.0.2/data/Test33.hs+formatted 9dd64349f3ea brittany-0.14.0.2/data/Test330.hs+formatted 15292e5353c7 brittany-0.14.0.2/data/Test331.hs+formatted 909ea0b219f8 brittany-0.14.0.2/data/Test332.hs+formatted 2ad0ebe6ebb0 brittany-0.14.0.2/data/Test333.hs+formatted 9b7204f946d7 brittany-0.14.0.2/data/Test334.hs+formatted 2baa737cfd00 brittany-0.14.0.2/data/Test335.hs+formatted b2addef5d712 brittany-0.14.0.2/data/Test336.hs+formatted 571c3cac2376 brittany-0.14.0.2/data/Test337.hs+formatted 7ab714dc2fd3 brittany-0.14.0.2/data/Test338.hs+formatted 0b6993151fe2 brittany-0.14.0.2/data/Test339.hs+formatted 7056ebf6bcea brittany-0.14.0.2/data/Test34.hs+formatted aed8c9d9f03b brittany-0.14.0.2/data/Test340.hs+formatted c93ad9724528 brittany-0.14.0.2/data/Test341.hs+formatted f189a1720eae brittany-0.14.0.2/data/Test342.hs+formatted 1e9cfbe2f3ab brittany-0.14.0.2/data/Test343.hs+formatted 5af677fa0a9b brittany-0.14.0.2/data/Test344.hs+formatted abe1b659b346 brittany-0.14.0.2/data/Test345.hs+formatted 3c1f80fba7f5 brittany-0.14.0.2/data/Test346.hs+formatted 7f12720f2600 brittany-0.14.0.2/data/Test347.hs+formatted 264cc0e7cf96 brittany-0.14.0.2/data/Test348.hs+formatted 03a3efa0a75e brittany-0.14.0.2/data/Test349.hs+formatted b7f73c7d2a34 brittany-0.14.0.2/data/Test35.hs+formatted 726069a13358 brittany-0.14.0.2/data/Test350.hs+formatted a50f8646bfb1 brittany-0.14.0.2/data/Test351.hs+formatted 849dab5ec39d brittany-0.14.0.2/data/Test352.hs+formatted baedf91b8ccd brittany-0.14.0.2/data/Test353.hs+formatted fcae903dc453 brittany-0.14.0.2/data/Test354.hs+formatted 2637fe2659d5 brittany-0.14.0.2/data/Test355.hs+formatted 65798192c40d brittany-0.14.0.2/data/Test356.hs+formatted 2cdb94cbf551 brittany-0.14.0.2/data/Test357.hs+formatted 501e5f69073e brittany-0.14.0.2/data/Test358.hs+formatted 86bec0344083 brittany-0.14.0.2/data/Test359.hs+formatted 987603d032ac brittany-0.14.0.2/data/Test36.hs+formatted 15308dc2dd01 brittany-0.14.0.2/data/Test360.hs+formatted 0b2ad491920b brittany-0.14.0.2/data/Test361.hs+formatted d9da88c7cdef brittany-0.14.0.2/data/Test362.hs+formatted d9831cd6816b brittany-0.14.0.2/data/Test363.hs+formatted 1ae4a98bcc4a brittany-0.14.0.2/data/Test364.hs+formatted ce4109a16e55 brittany-0.14.0.2/data/Test365.hs+formatted d16eae4aad20 brittany-0.14.0.2/data/Test366.hs+formatted b07954dfc9bf brittany-0.14.0.2/data/Test367.hs+formatted 45eeef287ee4 brittany-0.14.0.2/data/Test368.hs+formatted e61e587a6843 brittany-0.14.0.2/data/Test369.hs+formatted f500b3d5f559 brittany-0.14.0.2/data/Test37.hs+formatted 08718fefbaf6 brittany-0.14.0.2/data/Test370.hs+formatted 2fc71603e098 brittany-0.14.0.2/data/Test371.hs+formatted 34177b9d84e3 brittany-0.14.0.2/data/Test372.hs+formatted 5fa71c232724 brittany-0.14.0.2/data/Test373.hs+formatted f5fca966196b brittany-0.14.0.2/data/Test374.hs+formatted a4d64bf7587b brittany-0.14.0.2/data/Test375.hs+formatted 14e2ed1f0f63 brittany-0.14.0.2/data/Test376.hs+formatted f5a4e0c1e34f brittany-0.14.0.2/data/Test377.hs+formatted bddefc49765b brittany-0.14.0.2/data/Test378.hs+formatted ea19c516bcbf brittany-0.14.0.2/data/Test379.hs+formatted 7335e7ca5bd3 brittany-0.14.0.2/data/Test38.hs+formatted d2ee555751f5 brittany-0.14.0.2/data/Test380.hs+formatted 3823e3c2d919 brittany-0.14.0.2/data/Test381.hs+formatted 80271da1e835 brittany-0.14.0.2/data/Test382.hs+formatted ed5f4e8c4709 brittany-0.14.0.2/data/Test383.hs+formatted d4963535df46 brittany-0.14.0.2/data/Test384.hs+formatted 6ced47de66db brittany-0.14.0.2/data/Test385.hs+formatted 1570d72029b7 brittany-0.14.0.2/data/Test386.hs+formatted 1416aa178cdb brittany-0.14.0.2/data/Test387.hs+formatted edfafa8fb3e5 brittany-0.14.0.2/data/Test388.hs+formatted 4e122b4b2697 brittany-0.14.0.2/data/Test389.hs+formatted 6c58063d3fab brittany-0.14.0.2/data/Test39.hs+formatted fac1b1c7f0c1 brittany-0.14.0.2/data/Test390.hs+formatted edfafa8fb3e5 brittany-0.14.0.2/data/Test391.hs+formatted b0d3ee7240ad brittany-0.14.0.2/data/Test392.hs+formatted 3742d5df31d3 brittany-0.14.0.2/data/Test393.hs+formatted 28dd7a32aa13 brittany-0.14.0.2/data/Test394.hs+formatted 91de5c22d799 brittany-0.14.0.2/data/Test395.hs+formatted 15521d568177 brittany-0.14.0.2/data/Test396.hs+formatted bc632756e066 brittany-0.14.0.2/data/Test397.hs+formatted fc2de0dfca48 brittany-0.14.0.2/data/Test398.hs+formatted 8294327ebf8b brittany-0.14.0.2/data/Test399.hs+formatted c3cdd2cbcecc brittany-0.14.0.2/data/Test4.hs+formatted c8a00284c5f4 brittany-0.14.0.2/data/Test40.hs+formatted e55074dcd689 brittany-0.14.0.2/data/Test400.hs+formatted 4da9e5870180 brittany-0.14.0.2/data/Test401.hs+formatted 74396290a673 brittany-0.14.0.2/data/Test402.hs+formatted d2fafd899e89 brittany-0.14.0.2/data/Test403.hs+formatted dede30d772d6 brittany-0.14.0.2/data/Test404.hs+formatted 899e8af490d3 brittany-0.14.0.2/data/Test405.hs+formatted 6a318c357310 brittany-0.14.0.2/data/Test406.hs+formatted 183f062112e1 brittany-0.14.0.2/data/Test407.hs+formatted 55c58dc8cf59 brittany-0.14.0.2/data/Test408.hs+formatted a04dc9525882 brittany-0.14.0.2/data/Test409.hs+formatted cdc2db1c8449 brittany-0.14.0.2/data/Test41.hs+formatted a59bda637fa1 brittany-0.14.0.2/data/Test410.hs+formatted c65e5f1f3ba5 brittany-0.14.0.2/data/Test411.hs+formatted 462efbd02872 brittany-0.14.0.2/data/Test412.hs+formatted 4fc4ab30dcc3 brittany-0.14.0.2/data/Test413.hs+formatted d9eab58246aa brittany-0.14.0.2/data/Test414.hs+formatted 3d11263d426e brittany-0.14.0.2/data/Test415.hs+formatted dbbe7b5f2b24 brittany-0.14.0.2/data/Test416.hs+formatted 099959230be5 brittany-0.14.0.2/data/Test417.hs+formatted 056c3c85e1ce brittany-0.14.0.2/data/Test418.hs+formatted bd3660de0717 brittany-0.14.0.2/data/Test419.hs+formatted e3f087db5440 brittany-0.14.0.2/data/Test42.hs+formatted 821fd8910ac5 brittany-0.14.0.2/data/Test420.hs+formatted d9b47c23fec6 brittany-0.14.0.2/data/Test421.hs+formatted 15fe8b3f5a9e brittany-0.14.0.2/data/Test422.hs+formatted cafda87f90a6 brittany-0.14.0.2/data/Test423.hs+formatted 7fa298da41f9 brittany-0.14.0.2/data/Test424.hs+formatted acddf7b49624 brittany-0.14.0.2/data/Test425.hs+formatted 84cfb756f2f4 brittany-0.14.0.2/data/Test426.hs+formatted 33c641a7a072 brittany-0.14.0.2/data/Test427.hs+formatted 19772ef1090c brittany-0.14.0.2/data/Test428.hs+formatted 07a30e1c142f brittany-0.14.0.2/data/Test429.hs+formatted 6aa1c5a0086b brittany-0.14.0.2/data/Test43.hs+formatted f5d76f5634f5 brittany-0.14.0.2/data/Test430.hs+formatted 9aae587a1706 brittany-0.14.0.2/data/Test431.hs+formatted cab5eb48ea87 brittany-0.14.0.2/data/Test432.hs+formatted 035c19e15e23 brittany-0.14.0.2/data/Test433.hs+formatted 54c8c833912d brittany-0.14.0.2/data/Test434.hs+formatted 4b85517ecc64 brittany-0.14.0.2/data/Test435.hs+formatted ab4c449d67c6 brittany-0.14.0.2/data/Test436.hs+formatted 9e0a9c4de4a7 brittany-0.14.0.2/data/Test437.hs+formatted 22f3bbfaab9e brittany-0.14.0.2/data/Test438.hs+formatted 27ee3c3a9f1d brittany-0.14.0.2/data/Test439.hs+formatted bc6e01f7c126 brittany-0.14.0.2/data/Test44.hs+formatted f114f80afa88 brittany-0.14.0.2/data/Test440.hs+formatted 91959f72bf42 brittany-0.14.0.2/data/Test441.hs+formatted e100c133e0a6 brittany-0.14.0.2/data/Test442.hs+formatted a447fa310286 brittany-0.14.0.2/data/Test443.hs+formatted afb74691ba25 brittany-0.14.0.2/data/Test444.hs+formatted b04dcb13770d brittany-0.14.0.2/data/Test445.hs+formatted 005984004c81 brittany-0.14.0.2/data/Test446.hs+formatted 519cfd48a90e brittany-0.14.0.2/data/Test447.hs+formatted 245fb4545054 brittany-0.14.0.2/data/Test448.hs+formatted 036f126597a1 brittany-0.14.0.2/data/Test449.hs+formatted 914e8892ce9f brittany-0.14.0.2/data/Test45.hs+formatted dfae62440755 brittany-0.14.0.2/data/Test450.hs+formatted 3d8e022d4ea8 brittany-0.14.0.2/data/Test451.hs+formatted 204a8f956d01 brittany-0.14.0.2/data/Test452.hs+formatted 3ae152eef9f8 brittany-0.14.0.2/data/Test453.hs+formatted dd5c2ba000d9 brittany-0.14.0.2/data/Test454.hs+formatted 255bf40fcf81 brittany-0.14.0.2/data/Test455.hs+formatted 186aedf45b55 brittany-0.14.0.2/data/Test456.hs+formatted 00342a85f4ce brittany-0.14.0.2/data/Test457.hs+formatted 4d9ccb4d6155 brittany-0.14.0.2/data/Test458.hs+formatted 33f453ac627f brittany-0.14.0.2/data/Test459.hs+formatted 65a9efd49258 brittany-0.14.0.2/data/Test46.hs+formatted dbfa4f771264 brittany-0.14.0.2/data/Test460.hs+formatted 75bf53838e5c brittany-0.14.0.2/data/Test461.hs+formatted 5fde28db6063 brittany-0.14.0.2/data/Test462.hs+formatted ff5bcd3737f2 brittany-0.14.0.2/data/Test463.hs+formatted e30c0ff394dd brittany-0.14.0.2/data/Test464.hs+formatted 82f7c7fb716e brittany-0.14.0.2/data/Test465.hs+formatted f59579bd97ca brittany-0.14.0.2/data/Test466.hs+formatted 5909971846f9 brittany-0.14.0.2/data/Test467.hs+formatted fe8bf0d3f053 brittany-0.14.0.2/data/Test468.hs+formatted 79dd70b7320f brittany-0.14.0.2/data/Test469.hs+formatted 1983a10a25f3 brittany-0.14.0.2/data/Test47.hs+formatted 271132ce279b brittany-0.14.0.2/data/Test470.hs+formatted 14a056182567 brittany-0.14.0.2/data/Test471.hs+formatted cbe652ef0cbb brittany-0.14.0.2/data/Test472.hs+formatted 3bf39beb5bf7 brittany-0.14.0.2/data/Test473.hs+formatted ac6e5e3c9b28 brittany-0.14.0.2/data/Test474.hs+formatted 7752938de9c6 brittany-0.14.0.2/data/Test475.hs+formatted 756e0e0edd8b brittany-0.14.0.2/data/Test476.hs+formatted a87acb3bdeb3 brittany-0.14.0.2/data/Test477.hs+formatted d489d082ed14 brittany-0.14.0.2/data/Test478.hs+formatted dca2bbac2e81 brittany-0.14.0.2/data/Test479.hs+formatted 00909af2b184 brittany-0.14.0.2/data/Test48.hs+formatted 0150b83ded52 brittany-0.14.0.2/data/Test480.hs+formatted 9fd1038ae87c brittany-0.14.0.2/data/Test481.hs+formatted 99e73c09fd8f brittany-0.14.0.2/data/Test482.hs+formatted b6e0c157ec82 brittany-0.14.0.2/data/Test483.hs+formatted 5308cabef2dd brittany-0.14.0.2/data/Test484.hs+formatted 3b0850dd8d8d brittany-0.14.0.2/data/Test485.hs+formatted 3a14007e64e3 brittany-0.14.0.2/data/Test486.hs+formatted e28b3f6dc92a brittany-0.14.0.2/data/Test487.hs+formatted d7ac2e728ca4 brittany-0.14.0.2/data/Test488.hs+formatted 3455b362a4d8 brittany-0.14.0.2/data/Test489.hs+formatted 379cdfc91569 brittany-0.14.0.2/data/Test49.hs+formatted d2c2b5b45546 brittany-0.14.0.2/data/Test490.hs+formatted 964f39f9fdd1 brittany-0.14.0.2/data/Test491.hs+formatted d469e1b3965b brittany-0.14.0.2/data/Test492.hs+formatted d469e1b3965b brittany-0.14.0.2/data/Test493.hs+formatted 1eddc3503b32 brittany-0.14.0.2/data/Test494.hs+formatted 196d9b015a57 brittany-0.14.0.2/data/Test495.hs+formatted fae583830ad8 brittany-0.14.0.2/data/Test496.hs+formatted cbeb80fac007 brittany-0.14.0.2/data/Test497.hs+formatted 326e5653c262 brittany-0.14.0.2/data/Test498.hs+formatted 7f7e87e04f47 brittany-0.14.0.2/data/Test499.hs+formatted 3bb5ad04d6c9 brittany-0.14.0.2/data/Test5.hs+formatted 30d139cbecdf brittany-0.14.0.2/data/Test50.hs+formatted bb1de50ba61a brittany-0.14.0.2/data/Test500.hs+formatted 46987cddeeb1 brittany-0.14.0.2/data/Test501.hs+formatted a26bb5e5e289 brittany-0.14.0.2/data/Test502.hs+formatted 608441a45ea2 brittany-0.14.0.2/data/Test503.hs+formatted 088a029a2027 brittany-0.14.0.2/data/Test504.hs+formatted b8d19bd75331 brittany-0.14.0.2/data/Test505.hs+formatted 7aafe7248e10 brittany-0.14.0.2/data/Test506.hs+formatted 4c5c5d2bb818 brittany-0.14.0.2/data/Test507.hs+formatted a017d7235dda brittany-0.14.0.2/data/Test508.hs+formatted 525ac73a7645 brittany-0.14.0.2/data/Test509.hs+formatted bdb9309b69ef brittany-0.14.0.2/data/Test51.hs+formatted be3e1e21b3e7 brittany-0.14.0.2/data/Test510.hs+formatted 386680696e97 brittany-0.14.0.2/data/Test511.hs+formatted c74bbb4b17cf brittany-0.14.0.2/data/Test512.hs+formatted bb9ffbc270ba brittany-0.14.0.2/data/Test513.hs+formatted 4babc1db968e brittany-0.14.0.2/data/Test514.hs+formatted 4babc1db968e brittany-0.14.0.2/data/Test515.hs+formatted 4ef117d8e3e2 brittany-0.14.0.2/data/Test516.hs+formatted 9cdba405b7be brittany-0.14.0.2/data/Test517.hs+formatted 6192bf9c4318 brittany-0.14.0.2/data/Test518.hs+formatted 438975b07785 brittany-0.14.0.2/data/Test519.hs+formatted 3e9fb57fe53f brittany-0.14.0.2/data/Test52.hs+formatted e0922f030820 brittany-0.14.0.2/data/Test520.hs+formatted 7a6eceaa78bc brittany-0.14.0.2/data/Test521.hs+formatted cd889668f531 brittany-0.14.0.2/data/Test522.hs+formatted 5eae819cfab2 brittany-0.14.0.2/data/Test523.hs+formatted cdd55a113657 brittany-0.14.0.2/data/Test524.hs+formatted 948aab2f7cf9 brittany-0.14.0.2/data/Test525.hs+formatted 74dd57f3e6b2 brittany-0.14.0.2/data/Test526.hs+formatted ebc6624271d5 brittany-0.14.0.2/data/Test527.hs+formatted 6d566659bc06 brittany-0.14.0.2/data/Test528.hs+formatted 86bb82b0ae12 brittany-0.14.0.2/data/Test529.hs+formatted 113cb843c235 brittany-0.14.0.2/data/Test53.hs+formatted c77ad7418bdb brittany-0.14.0.2/data/Test530.hs+formatted e82e4a69ecaf brittany-0.14.0.2/data/Test531.hs+formatted 98d38ba919b8 brittany-0.14.0.2/data/Test532.hs+formatted 93f0725e6f33 brittany-0.14.0.2/data/Test533.hs+formatted 2f3eea919721 brittany-0.14.0.2/data/Test534.hs+formatted 4dfe442efa9f brittany-0.14.0.2/data/Test535.hs+formatted 083e49e545b1 brittany-0.14.0.2/data/Test536.hs+formatted a93167132f4b brittany-0.14.0.2/data/Test537.hs+formatted 76a9d8390ac0 brittany-0.14.0.2/data/Test538.hs+formatted cb52a4163a3d brittany-0.14.0.2/data/Test539.hs+formatted 3206388ca862 brittany-0.14.0.2/data/Test54.hs+formatted 32bac85b1c99 brittany-0.14.0.2/data/Test540.hs+formatted c1076b4718f2 brittany-0.14.0.2/data/Test55.hs+formatted 5b5da4a27041 brittany-0.14.0.2/data/Test56.hs+formatted 7d48cd742ee9 brittany-0.14.0.2/data/Test57.hs+formatted 09a9442047e7 brittany-0.14.0.2/data/Test58.hs+formatted 007b3f5499fb brittany-0.14.0.2/data/Test59.hs+formatted d9ed4ebe21ed brittany-0.14.0.2/data/Test6.hs+formatted 87e8860858b2 brittany-0.14.0.2/data/Test60.hs+formatted 7bba808f3304 brittany-0.14.0.2/data/Test61.hs+formatted 7e7c53e8f5f9 brittany-0.14.0.2/data/Test62.hs+formatted 38957227fb18 brittany-0.14.0.2/data/Test63.hs+formatted d1d477cbcd19 brittany-0.14.0.2/data/Test64.hs+formatted abec5eceeaf7 brittany-0.14.0.2/data/Test65.hs+formatted 7e83cb328466 brittany-0.14.0.2/data/Test66.hs+formatted 08c924dc75db brittany-0.14.0.2/data/Test67.hs+formatted 534f9f24c4c4 brittany-0.14.0.2/data/Test68.hs+formatted 0edc4bf88879 brittany-0.14.0.2/data/Test69.hs+formatted 6e4a80a16587 brittany-0.14.0.2/data/Test7.hs+formatted c26c8d4af0d4 brittany-0.14.0.2/data/Test70.hs+formatted 7f9b2bb1df69 brittany-0.14.0.2/data/Test71.hs+formatted 9d549df4742d brittany-0.14.0.2/data/Test72.hs+formatted 05ed72d9e760 brittany-0.14.0.2/data/Test73.hs+formatted a54128f146c1 brittany-0.14.0.2/data/Test74.hs+formatted 29302a244e5c brittany-0.14.0.2/data/Test75.hs+formatted 89a2a63deffe brittany-0.14.0.2/data/Test76.hs+formatted 7a3ad7569e3d brittany-0.14.0.2/data/Test77.hs+formatted 286a50a0eb22 brittany-0.14.0.2/data/Test78.hs+formatted bc99bdbbbb1e brittany-0.14.0.2/data/Test79.hs+formatted 0a8cec799b2a brittany-0.14.0.2/data/Test8.hs+formatted 2f2e96416d6d brittany-0.14.0.2/data/Test80.hs+formatted d1d172867e08 brittany-0.14.0.2/data/Test81.hs+formatted f66f9b2381e3 brittany-0.14.0.2/data/Test82.hs+formatted 4fe035cf193a brittany-0.14.0.2/data/Test83.hs+formatted 43e925441c75 brittany-0.14.0.2/data/Test84.hs+formatted dddcd81d8e89 brittany-0.14.0.2/data/Test85.hs+formatted b34676f3162a brittany-0.14.0.2/data/Test86.hs+formatted 847e26a48a11 brittany-0.14.0.2/data/Test87.hs+formatted d37afb2bca9c brittany-0.14.0.2/data/Test88.hs+formatted 870cc6003dc1 brittany-0.14.0.2/data/Test89.hs+formatted cd000b5a236a brittany-0.14.0.2/data/Test9.hs+formatted 14a1a4f54ceb brittany-0.14.0.2/data/Test90.hs+formatted 583f169ace4c brittany-0.14.0.2/data/Test91.hs+formatted 1d30d5458df2 brittany-0.14.0.2/data/Test92.hs+formatted 21ca73bf65e9 brittany-0.14.0.2/data/Test93.hs+formatted 2640ff7299cc brittany-0.14.0.2/data/Test94.hs+formatted 139f17bd37c8 brittany-0.14.0.2/data/Test95.hs+formatted 3f35ed17b5d4 brittany-0.14.0.2/data/Test96.hs+formatted 54dbf9915298 brittany-0.14.0.2/data/Test97.hs+formatted 25178db879d4 brittany-0.14.0.2/data/Test98.hs+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 bd3007c00bcb brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal.hs+formatted 52c61c8f36a7 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Backend.hs+formatted d92b21322bd4 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/BackendUtils.hs+formatted 6c0d53b31d45 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Config.hs+formatted 4387eb5344c3 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Config/Types.hs+formatted e13b5e1cf845 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 10f39372ebc8 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/LayouterBasics.hs+formatted 5d4ba42810fc brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs+formatted c1d4180a7364 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Decl.hs+formatted 6da334c9b8cc 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 acf1184a4039 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/IE.hs+formatted ba5e2c3aa9ff brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Import.hs+formatted b3eeef75906a brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Module.hs+formatted c314ecc033b2 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 08c3e5d27dd4 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot+formatted 48b61a61db4a 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 79e767ee3e91 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 7bd9ea5667be brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs+formatted 8524c6970b7f brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Columns.hs+formatted 73d5a7f6f8f9 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Floating.hs+formatted e2ac60fc2da6 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Indent.hs+formatted 2ed0cc6dc5ae brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Par.hs+formatted a0c752ec0c1d brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Types.hs+formatted df622f9a5a85 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Utils.hs+formatted 5e05cfeb3dd6 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+formatted eb7b2158a88b capability-0.5.0.1/examples/CountLog.hs+formatted aa1d67f90726 capability-0.5.0.1/examples/Error.hs+formatted 7bb91536c52e capability-0.5.0.1/examples/Reader.hs+formatted cf7788db327f capability-0.5.0.1/examples/Reflection.hs+formatted 4ca78b40a428 capability-0.5.0.1/examples/Sink.hs+formatted 4bd9f1f5ce20 capability-0.5.0.1/examples/State.hs+formatted de729285889f capability-0.5.0.1/examples/Test.hs+formatted bc483d61ffa2 capability-0.5.0.1/examples/Test/Common.hs+formatted 6c9e8b236461 capability-0.5.0.1/examples/WordCount.hs+formatted 9a2c6692cf10 capability-0.5.0.1/examples/Writer.hs+formatted c7634b7f4e60 capability-0.5.0.1/src/Capability.hs+formatted 83447b7b7ea5 capability-0.5.0.1/src/Capability/Accessors.hs+formatted 8d8d36f3f008 capability-0.5.0.1/src/Capability/Constraints.hs+formatted f8fc4a2aaee2 capability-0.5.0.1/src/Capability/Derive.hs+formatted 08904961a765 capability-0.5.0.1/src/Capability/Error.hs+formatted 97515747424b capability-0.5.0.1/src/Capability/Reader.hs+formatted 89877e765220 capability-0.5.0.1/src/Capability/Reader/Internal/Class.hs+formatted 007089e89b2a capability-0.5.0.1/src/Capability/Reader/Internal/Strategies.hs+formatted cdf1d99e626f capability-0.5.0.1/src/Capability/Reflection.hs+formatted 42f2a624abd3 capability-0.5.0.1/src/Capability/Sink.hs+formatted dc0a5d3d3878 capability-0.5.0.1/src/Capability/Sink/Internal/Class.hs+formatted 074cd292b8a7 capability-0.5.0.1/src/Capability/Sink/Internal/Strategies.hs+formatted d6a811b81394 capability-0.5.0.1/src/Capability/Source.hs+formatted 7655749a90f6 capability-0.5.0.1/src/Capability/Source/Internal/Class.hs+formatted b718392f90a6 capability-0.5.0.1/src/Capability/Source/Internal/Strategies.hs+formatted e288db1d616d capability-0.5.0.1/src/Capability/State.hs+formatted 9d0280d2e19e capability-0.5.0.1/src/Capability/State/Internal/Class.hs+formatted 77e19ee12ef0 capability-0.5.0.1/src/Capability/State/Internal/Strategies.hs+formatted e0fc7f2c44f9 capability-0.5.0.1/src/Capability/State/Internal/Strategies/Common.hs+formatted dca34ed58cfd capability-0.5.0.1/src/Capability/Stream.hs+formatted 6cd51b2d63f1 capability-0.5.0.1/src/Capability/TypeOf.hs+formatted 9a266b123a93 capability-0.5.0.1/src/Capability/Writer.hs+formatted e865ae48f11b cassava-0.5.5.0/Setup.hs+formatted f8de97e1c58a cassava-0.5.5.0/examples/IncrementalIndexedBasedDecode.hs+formatted b9e7e3d9a0fb cassava-0.5.5.0/examples/IncrementalNamedBasedEncode.hs+formatted a004028b7dc3 cassava-0.5.5.0/examples/IndexBasedDecode.hs+formatted 03830830ed9e cassava-0.5.5.0/examples/IndexBasedGeneric.hs+formatted f4fb7ce7564b cassava-0.5.5.0/examples/NamedBasedDecode.hs+formatted ecf9a4c54a67 cassava-0.5.5.0/examples/NamedBasedExplicitDecode.hs+formatted d51604b7e89f cassava-0.5.5.0/examples/NamedBasedGeneric.hs+formatted 9612391bd37b cassava-0.5.5.0/examples/StreamingIndexBasedDecode.hs+formatted efc1fe9896ec cassava-0.5.5.0/src/Data/Csv.hs+formatted 817b8cca8d06 cassava-0.5.5.0/src/Data/Csv/Builder.hs+formatted 38c7c4badf0a cassava-0.5.5.0/src/Data/Csv/Conversion.hs+formatted a4c56813cba7 cassava-0.5.5.0/src/Data/Csv/Conversion/Internal.hs+formatted 5906452b290a cassava-0.5.5.0/src/Data/Csv/Encoding.hs+formatted 32c60ff1a4fd cassava-0.5.5.0/src/Data/Csv/Incremental.hs+formatted be1c60df3b34 cassava-0.5.5.0/src/Data/Csv/Parser.hs+formatted 014bb9b262b9 cassava-0.5.5.0/src/Data/Csv/Streaming.hs+formatted 20f42a736b97 cassava-0.5.5.0/src/Data/Csv/Types.hs+formatted 4a5a0e1a51c9 cassava-0.5.5.0/src/Data/Csv/Util.hs+formatted a844141d1fe8 cassava-0.5.5.0/tests/UnitTests.hs+formatted 7dbba0331af5 comonad-5.0.10/examples/History.hs+formatted f218701f2ac5 comonad-5.0.10/src/Control/Comonad.hs+formatted d084cf5c7fa7 comonad-5.0.10/src/Control/Comonad/Env.hs+formatted 3b8ec012a04c comonad-5.0.10/src/Control/Comonad/Env/Class.hs+formatted 0dcf633542eb comonad-5.0.10/src/Control/Comonad/Hoist/Class.hs+formatted 4bfafba3ce3b comonad-5.0.10/src/Control/Comonad/Identity.hs+formatted 49b438747b63 comonad-5.0.10/src/Control/Comonad/Store.hs+formatted cf408da422ba comonad-5.0.10/src/Control/Comonad/Store/Class.hs+formatted 2c72a397c339 comonad-5.0.10/src/Control/Comonad/Traced.hs+formatted da617308f9a3 comonad-5.0.10/src/Control/Comonad/Traced/Class.hs+formatted adbd6d7e0f72 comonad-5.0.10/src/Control/Comonad/Trans/Class.hs+formatted 871b9e0bc5cd comonad-5.0.10/src/Control/Comonad/Trans/Env.hs+formatted c405a550608b comonad-5.0.10/src/Control/Comonad/Trans/Identity.hs+formatted 6b990e80a8eb comonad-5.0.10/src/Control/Comonad/Trans/Store.hs+formatted b9f942c1ae6c comonad-5.0.10/src/Control/Comonad/Trans/Traced.hs+formatted 34f425eff98b comonad-5.0.10/src/Data/Functor/Composition.hs+formatted be111de01001 conduit-1.3.6.1/benchmarks/optimize-201408.hs+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 6fba99ab1b1b conduit-1.3.6.1/src/Data/Conduit/Combinators.hs+formatted 9e46f7ab29ac conduit-1.3.6.1/src/Data/Conduit/Combinators/Stream.hs+formatted 1290e9b983f1 conduit-1.3.6.1/src/Data/Conduit/Combinators/Unqualified.hs+formatted 8e861a915c2f conduit-1.3.6.1/src/Data/Conduit/Internal.hs+formatted 2081cc2fc43d conduit-1.3.6.1/src/Data/Conduit/Internal/Conduit.hs+formatted bbfd28e5b98b conduit-1.3.6.1/src/Data/Conduit/Internal/Fusion.hs+formatted 54120af8edce conduit-1.3.6.1/src/Data/Conduit/Internal/List/Stream.hs+formatted 2fe8b1b7e798 conduit-1.3.6.1/src/Data/Conduit/Internal/Pipe.hs+formatted 4a4c14b72249 conduit-1.3.6.1/src/Data/Conduit/Lift.hs+formatted 15e5ac8a2cb1 conduit-1.3.6.1/src/Data/Conduit/List.hs+formatted 55a50272f6a7 conduit-1.3.6.1/src/Data/Streaming/FileRead.hs+formatted 71e1c3bf7039 conduit-1.3.6.1/src/Data/Streaming/Filesystem.hs+formatted d9e8dbaa2534 conduit-1.3.6.1/test/Data/Conduit/Extra/ZipConduitSpec.hs+formatted 3df81ded6599 conduit-1.3.6.1/test/Data/Conduit/StreamSpec.hs+formatted cf41359a6248 conduit-1.3.6.1/test/Spec.hs+formatted d10fe79bbeec conduit-1.3.6.1/test/StreamSpec.hs+formatted db2295b8113a conduit-1.3.6.1/test/doctests.hs+formatted a21201eaf0ea conduit-1.3.6.1/test/main.hs+formatted e29ee20973f2 contravariant-1.5.6/old-src/Data/Functor/Contravariant.hs+formatted acc631e94060 contravariant-1.5.6/src/Data/Functor/Contravariant/Compose.hs+formatted 12261ada3c4f contravariant-1.5.6/src/Data/Functor/Contravariant/Divisible.hs+formatted 6e8599bf8082 contravariant-1.5.6/src/Data/Functor/Contravariant/Generic.hs+formatted 2841bd16822b criterion-1.6.5.0/Criterion.hs+formatted ee1798194249 criterion-1.6.5.0/Criterion/Analysis.hs+formatted c039ba5918a9 criterion-1.6.5.0/Criterion/EmbeddedData.hs+formatted f07714df2d3d criterion-1.6.5.0/Criterion/IO.hs+formatted 9cbbe0381e04 criterion-1.6.5.0/Criterion/IO/Printf.hs+formatted 6b182673462d criterion-1.6.5.0/Criterion/Internal.hs+formatted 9c5a685a07c7 criterion-1.6.5.0/Criterion/Main.hs+formatted 99f71e90fa4b criterion-1.6.5.0/Criterion/Main/Options.hs+formatted aab23b74a86d criterion-1.6.5.0/Criterion/Monad.hs+formatted bbcaa9535a9f criterion-1.6.5.0/Criterion/Monad/Internal.hs+formatted b2eb4d4fb4eb criterion-1.6.5.0/Criterion/Report.hs+formatted 74308ba37d6a criterion-1.6.5.0/Criterion/Types.hs+formatted 54f92871c793 criterion-1.6.5.0/app/Options.hs+formatted 49dcbeebb5c4 criterion-1.6.5.0/app/Report.hs+formatted a437ea93f53e criterion-1.6.5.0/examples/BadReadFile.hs+formatted bfb4844251ca criterion-1.6.5.0/examples/Comparison.hs+formatted f54fba36e069 criterion-1.6.5.0/examples/ConduitVsPipes.hs+formatted a4f8cda29d3c criterion-1.6.5.0/examples/ExtensibleCLI.hs+formatted 8f4df570ff4e criterion-1.6.5.0/examples/Fibber.hs+formatted 9196e3f4c3d7 criterion-1.6.5.0/examples/GoodReadFile.hs+formatted 30240b972d60 criterion-1.6.5.0/examples/Judy.hs+formatted 7d1ede331f1f criterion-1.6.5.0/examples/Maps.hs+formatted f396bcf9c829 criterion-1.6.5.0/examples/Overhead.hs+formatted 3a50edf5477c criterion-1.6.5.0/examples/Quotes.hs+formatted ce8d353ea567 criterion-1.6.5.0/tests/Cleanup.hs+formatted 78253dc00e1a criterion-1.6.5.0/tests/Properties.hs+formatted a99e4edb542c criterion-1.6.5.0/tests/Sanity.hs+formatted f8a8d8f2c4ae criterion-1.6.5.0/tests/Tests.hs+formatted 44af498375d5 cryptonite-0.30/Crypto/Cipher/AES.hs+formatted 2240267dad51 cryptonite-0.30/Crypto/Cipher/AES/Primitive.hs+formatted 5694da9617bf cryptonite-0.30/Crypto/Cipher/AESGCMSIV.hs+formatted ab05e6ed96e9 cryptonite-0.30/Crypto/Cipher/Blowfish.hs+formatted 98e1845904ad cryptonite-0.30/Crypto/Cipher/Blowfish/Box.hs+formatted 23c195272bfd cryptonite-0.30/Crypto/Cipher/Blowfish/Primitive.hs+formatted 7ece5bd42232 cryptonite-0.30/Crypto/Cipher/CAST5.hs+formatted d0210ba9a96f cryptonite-0.30/Crypto/Cipher/CAST5/Primitive.hs+formatted c818f5ccfd4a cryptonite-0.30/Crypto/Cipher/Camellia.hs+formatted f429b69d6156 cryptonite-0.30/Crypto/Cipher/Camellia/Primitive.hs+formatted dbd216d2f0aa cryptonite-0.30/Crypto/Cipher/ChaCha.hs+formatted bcadafa03089 cryptonite-0.30/Crypto/Cipher/ChaChaPoly1305.hs+formatted 092e6bcae818 cryptonite-0.30/Crypto/Cipher/DES.hs+formatted 7b3282079b6c cryptonite-0.30/Crypto/Cipher/DES/Primitive.hs+formatted bc58b513348e cryptonite-0.30/Crypto/Cipher/RC4.hs+formatted d59fa1e97895 cryptonite-0.30/Crypto/Cipher/Salsa.hs+formatted 58b5729d32db cryptonite-0.30/Crypto/Cipher/TripleDES.hs+formatted 8aafca6b830e cryptonite-0.30/Crypto/Cipher/Twofish.hs+formatted 7d7789d95b82 cryptonite-0.30/Crypto/Cipher/Twofish/Primitive.hs+formatted 54afbb146e5c cryptonite-0.30/Crypto/Cipher/Types.hs+formatted 9872fb82a680 cryptonite-0.30/Crypto/Cipher/Types/AEAD.hs+formatted 839caaf5c14b cryptonite-0.30/Crypto/Cipher/Types/Base.hs+formatted e02385d86f90 cryptonite-0.30/Crypto/Cipher/Types/Block.hs+formatted 7c2782316618 cryptonite-0.30/Crypto/Cipher/Types/GF.hs+formatted 17ceaf6e3360 cryptonite-0.30/Crypto/Cipher/Types/Stream.hs+formatted 6cdb1c7bd28d cryptonite-0.30/Crypto/Cipher/Types/Utils.hs+formatted f1893d3edfa7 cryptonite-0.30/Crypto/Cipher/Utils.hs+formatted 20107f92349f cryptonite-0.30/Crypto/Cipher/XSalsa.hs+formatted 117e7ce7c967 cryptonite-0.30/Crypto/ConstructHash/MiyaguchiPreneel.hs+formatted 4f15b3874982 cryptonite-0.30/Crypto/Data/AFIS.hs+formatted 37c60fc95ef2 cryptonite-0.30/Crypto/Data/Padding.hs+formatted 2ba3cd2f51b9 cryptonite-0.30/Crypto/ECC.hs+formatted 951ccc172449 cryptonite-0.30/Crypto/ECC/Edwards25519.hs+formatted e213548aa40e cryptonite-0.30/Crypto/ECC/Simple/Prim.hs+formatted 64fc04cd74ae cryptonite-0.30/Crypto/ECC/Simple/Types.hs+formatted 3560b9821c3b cryptonite-0.30/Crypto/Error.hs+formatted 0caeb40058f2 cryptonite-0.30/Crypto/Error/Types.hs+formatted bcc2e2a5ecac cryptonite-0.30/Crypto/Hash.hs+formatted 514502d73233 cryptonite-0.30/Crypto/Hash/Algorithms.hs+formatted a83eee5ae7b0 cryptonite-0.30/Crypto/Hash/Blake2.hs+formatted f99040e35232 cryptonite-0.30/Crypto/Hash/Blake2b.hs+formatted 9fc6dd4195c9 cryptonite-0.30/Crypto/Hash/Blake2bp.hs+formatted aa6fb8816478 cryptonite-0.30/Crypto/Hash/Blake2s.hs+formatted 5987b76d2285 cryptonite-0.30/Crypto/Hash/Blake2sp.hs+formatted 36d330a27ffe cryptonite-0.30/Crypto/Hash/IO.hs+formatted 527ac917164f cryptonite-0.30/Crypto/Hash/Keccak.hs+formatted 988960beff03 cryptonite-0.30/Crypto/Hash/MD2.hs+formatted 643fd2f5f7f2 cryptonite-0.30/Crypto/Hash/MD4.hs+formatted 0176320f82f4 cryptonite-0.30/Crypto/Hash/MD5.hs+formatted 54c369b13f00 cryptonite-0.30/Crypto/Hash/RIPEMD160.hs+formatted 0cf990ecd2cd cryptonite-0.30/Crypto/Hash/SHA1.hs+formatted 6b15758ab087 cryptonite-0.30/Crypto/Hash/SHA224.hs+formatted a5a52f418404 cryptonite-0.30/Crypto/Hash/SHA256.hs+formatted 05629720d732 cryptonite-0.30/Crypto/Hash/SHA3.hs+formatted 076c9d704bf2 cryptonite-0.30/Crypto/Hash/SHA384.hs+formatted d65edf0aeac8 cryptonite-0.30/Crypto/Hash/SHA512.hs+formatted 94400683916e cryptonite-0.30/Crypto/Hash/SHA512t.hs+formatted 9b214034fb00 cryptonite-0.30/Crypto/Hash/SHAKE.hs+formatted 506e64c190a2 cryptonite-0.30/Crypto/Hash/Skein256.hs+formatted da70bee9980a cryptonite-0.30/Crypto/Hash/Skein512.hs+formatted 2f8832cc95bb cryptonite-0.30/Crypto/Hash/Tiger.hs+formatted f7994b599588 cryptonite-0.30/Crypto/Hash/Types.hs+formatted 4ea25e04f5c1 cryptonite-0.30/Crypto/Hash/Whirlpool.hs+formatted f70544b8e5f8 cryptonite-0.30/Crypto/Internal/Builder.hs+formatted 98a5de0267ed cryptonite-0.30/Crypto/Internal/ByteArray.hs+formatted f801f423094d cryptonite-0.30/Crypto/Internal/Compat.hs+formatted 54db2fce0fcc cryptonite-0.30/Crypto/Internal/CompatPrim.hs+formatted d4435b068486 cryptonite-0.30/Crypto/Internal/DeepSeq.hs+formatted 4646f54cc944 cryptonite-0.30/Crypto/Internal/Imports.hs+formatted 4878b8fb8411 cryptonite-0.30/Crypto/Internal/Nat.hs+formatted 483861a9b72d cryptonite-0.30/Crypto/Internal/WordArray.hs+formatted 5786998be3b3 cryptonite-0.30/Crypto/Internal/Words.hs+formatted 0434f24b7a9f cryptonite-0.30/Crypto/KDF/Argon2.hs+formatted 9725e47b1b66 cryptonite-0.30/Crypto/KDF/BCrypt.hs+formatted 28be07832b83 cryptonite-0.30/Crypto/KDF/BCryptPBKDF.hs+formatted 7c78160cd13d cryptonite-0.30/Crypto/KDF/HKDF.hs+formatted f25d68c357c2 cryptonite-0.30/Crypto/KDF/PBKDF2.hs+formatted 3307468c4b5d cryptonite-0.30/Crypto/KDF/Scrypt.hs+formatted 8f3891401559 cryptonite-0.30/Crypto/MAC/CMAC.hs+formatted b5b065a845f0 cryptonite-0.30/Crypto/MAC/HMAC.hs+formatted 4d0062fd1ebe cryptonite-0.30/Crypto/MAC/KMAC.hs+formatted a54d3189768c cryptonite-0.30/Crypto/MAC/Poly1305.hs+formatted c065c0ae8804 cryptonite-0.30/Crypto/Number/Basic.hs+partly-checked 27ebb2f56bcc cryptonite-0.30/Crypto/Number/Compat.hs+formatted d8e4da3cf8c5 cryptonite-0.30/Crypto/Number/F2m.hs+formatted 7b62d9f0185b cryptonite-0.30/Crypto/Number/Generate.hs+formatted 53fbd1bf4d6c cryptonite-0.30/Crypto/Number/ModArithmetic.hs+formatted 3887ba3c7c43 cryptonite-0.30/Crypto/Number/Nat.hs+formatted 930fa05c486f cryptonite-0.30/Crypto/Number/Prime.hs+formatted 3be1d9c43e52 cryptonite-0.30/Crypto/Number/Serialize.hs+formatted cfe6a456efe7 cryptonite-0.30/Crypto/Number/Serialize/Internal.hs+formatted 8f181f9bc069 cryptonite-0.30/Crypto/Number/Serialize/Internal/LE.hs+formatted c21267dc7970 cryptonite-0.30/Crypto/Number/Serialize/LE.hs+formatted 306914497f38 cryptonite-0.30/Crypto/OTP.hs+formatted 47ac3109be1c cryptonite-0.30/Crypto/PubKey/Curve25519.hs+formatted ff1bad4fe0ae cryptonite-0.30/Crypto/PubKey/Curve448.hs+formatted 7279b7fc32ee cryptonite-0.30/Crypto/PubKey/DH.hs+formatted 61fc8cd02023 cryptonite-0.30/Crypto/PubKey/DSA.hs+formatted 9671d669d9fb cryptonite-0.30/Crypto/PubKey/ECC/DH.hs+formatted face3da85363 cryptonite-0.30/Crypto/PubKey/ECC/ECDSA.hs+formatted 97c5eb3f0754 cryptonite-0.30/Crypto/PubKey/ECC/Generate.hs+formatted d4527eb98a84 cryptonite-0.30/Crypto/PubKey/ECC/P256.hs+formatted 0a2b67b3348e cryptonite-0.30/Crypto/PubKey/ECC/Prim.hs+formatted 65081a388743 cryptonite-0.30/Crypto/PubKey/ECC/Types.hs+formatted dae44ef68546 cryptonite-0.30/Crypto/PubKey/ECDSA.hs+formatted 04ef544fcbc1 cryptonite-0.30/Crypto/PubKey/ECIES.hs+formatted ca8ec46db323 cryptonite-0.30/Crypto/PubKey/Ed25519.hs+formatted dba822ca565e cryptonite-0.30/Crypto/PubKey/Ed448.hs+formatted 365814eb2b58 cryptonite-0.30/Crypto/PubKey/EdDSA.hs+formatted e083f4a748a3 cryptonite-0.30/Crypto/PubKey/ElGamal.hs+formatted 5a0517dd2399 cryptonite-0.30/Crypto/PubKey/Internal.hs+formatted 83e024783092 cryptonite-0.30/Crypto/PubKey/MaskGenFunction.hs+formatted aaafa0f20f26 cryptonite-0.30/Crypto/PubKey/RSA.hs+formatted c12317773f47 cryptonite-0.30/Crypto/PubKey/RSA/OAEP.hs+formatted b777939c6984 cryptonite-0.30/Crypto/PubKey/RSA/PKCS15.hs+formatted 9255a1c6fd3d cryptonite-0.30/Crypto/PubKey/RSA/PSS.hs+formatted 8643b6ddea84 cryptonite-0.30/Crypto/PubKey/RSA/Prim.hs+formatted 7ab3ae862f55 cryptonite-0.30/Crypto/PubKey/RSA/Types.hs+formatted a97d7fbec7cf cryptonite-0.30/Crypto/PubKey/Rabin/Basic.hs+formatted 3e0ac8c999c0 cryptonite-0.30/Crypto/PubKey/Rabin/Modified.hs+formatted a53ee7c1c1a5 cryptonite-0.30/Crypto/PubKey/Rabin/OAEP.hs+formatted b578b97afc3e cryptonite-0.30/Crypto/PubKey/Rabin/RW.hs+formatted c0eae64dcf68 cryptonite-0.30/Crypto/PubKey/Rabin/Types.hs+formatted 1854f69b3828 cryptonite-0.30/Crypto/Random.hs+formatted f3902d2c9c96 cryptonite-0.30/Crypto/Random/ChaChaDRG.hs+formatted 8b31b5a87af9 cryptonite-0.30/Crypto/Random/Entropy.hs+formatted f8afb2ba19cc cryptonite-0.30/Crypto/Random/Entropy/Backend.hs+formatted 9b0c8653e10a cryptonite-0.30/Crypto/Random/Entropy/RDRand.hs+formatted 0c206170779c cryptonite-0.30/Crypto/Random/Entropy/Source.hs+formatted 75121bc8d581 cryptonite-0.30/Crypto/Random/Entropy/Unix.hs+formatted 2b02d2fc4203 cryptonite-0.30/Crypto/Random/Entropy/Unsafe.hs+declined - cryptonite-0.30/Crypto/Random/Entropy/Windows.hs+formatted 4f4ac464c6e9 cryptonite-0.30/Crypto/Random/EntropyPool.hs+formatted 762f30275eb4 cryptonite-0.30/Crypto/Random/Probabilistic.hs+formatted dd360e4a76e6 cryptonite-0.30/Crypto/Random/SystemDRG.hs+formatted 3613df3a0846 cryptonite-0.30/Crypto/Random/Types.hs+formatted b12c43b64866 cryptonite-0.30/Crypto/System/CPU.hs+formatted 3f10131f3add cryptonite-0.30/Crypto/Tutorial.hs+formatted e865ae48f11b cryptonite-0.30/Setup.hs+formatted 6977c38d789e cryptonite-0.30/benchs/Bench.hs+formatted 772fcb717c67 cryptonite-0.30/benchs/Number/F2m.hs+formatted 57d09cf26ff7 cryptonite-0.30/tests/BCrypt.hs+formatted e0a9d879663a cryptonite-0.30/tests/BCryptPBKDF.hs+formatted 523e547e051d cryptonite-0.30/tests/BlockCipher.hs+formatted ae1da1712bf7 cryptonite-0.30/tests/ChaCha.hs+formatted 2ff39a30e968 cryptonite-0.30/tests/ChaChaPoly1305.hs+formatted c628564c97aa cryptonite-0.30/tests/ECC.hs+formatted 5d886e661761 cryptonite-0.30/tests/ECC/Edwards25519.hs+formatted e8de6edaf6ac cryptonite-0.30/tests/ECDSA.hs+formatted 27ce811073c1 cryptonite-0.30/tests/Hash.hs+formatted e00752436aeb cryptonite-0.30/tests/Imports.hs+formatted b56f327286e8 cryptonite-0.30/tests/KAT_AES.hs+formatted 810d48314931 cryptonite-0.30/tests/KAT_AES/KATCBC.hs+formatted 18eaacc22a0b cryptonite-0.30/tests/KAT_AES/KATCCM.hs+formatted 44fe15b7084a cryptonite-0.30/tests/KAT_AES/KATECB.hs+formatted 82fa19f7ce7a cryptonite-0.30/tests/KAT_AES/KATGCM.hs+formatted 615d3d0c3896 cryptonite-0.30/tests/KAT_AES/KATOCB3.hs+formatted 7ab1f2d998b8 cryptonite-0.30/tests/KAT_AES/KATXTS.hs+formatted 0ad3fede040b cryptonite-0.30/tests/KAT_AESGCMSIV.hs+formatted 5f71c9d0489d cryptonite-0.30/tests/KAT_AFIS.hs+formatted a29f1f177a83 cryptonite-0.30/tests/KAT_Argon2.hs+formatted f080f3e9d382 cryptonite-0.30/tests/KAT_Blowfish.hs+formatted c8352efb01e7 cryptonite-0.30/tests/KAT_CAST5.hs+formatted a3584b1b317f cryptonite-0.30/tests/KAT_CMAC.hs+formatted a2b1c23d4a23 cryptonite-0.30/tests/KAT_Camellia.hs+formatted 6afe12fcf4eb cryptonite-0.30/tests/KAT_Curve25519.hs+formatted 6093259a5aa9 cryptonite-0.30/tests/KAT_Curve448.hs+formatted 101e8ac3b19d cryptonite-0.30/tests/KAT_DES.hs+formatted 3a7902b73bd8 cryptonite-0.30/tests/KAT_Ed25519.hs+formatted bbf6a21d5f18 cryptonite-0.30/tests/KAT_Ed448.hs+formatted 6a2436512f8d cryptonite-0.30/tests/KAT_EdDSA.hs+formatted 0fa0afdb302b cryptonite-0.30/tests/KAT_HKDF.hs+formatted f0b45b263f2a cryptonite-0.30/tests/KAT_HMAC.hs+formatted 1735ae86f00c cryptonite-0.30/tests/KAT_KMAC.hs+formatted 66cf41c37e13 cryptonite-0.30/tests/KAT_MiyaguchiPreneel.hs+formatted 5161823955d7 cryptonite-0.30/tests/KAT_OTP.hs+formatted e23a8a363aff cryptonite-0.30/tests/KAT_PBKDF2.hs+formatted 1f0d2812b0a5 cryptonite-0.30/tests/KAT_PubKey.hs+formatted c92369374dbb cryptonite-0.30/tests/KAT_PubKey/DSA.hs+formatted 743790d1c893 cryptonite-0.30/tests/KAT_PubKey/ECC.hs+formatted 72827abb8090 cryptonite-0.30/tests/KAT_PubKey/ECDSA.hs+formatted 0a8edec8bb84 cryptonite-0.30/tests/KAT_PubKey/OAEP.hs+formatted 6ba37e5828ed cryptonite-0.30/tests/KAT_PubKey/P256.hs+formatted 93c9f8d40494 cryptonite-0.30/tests/KAT_PubKey/PSS.hs+formatted bba8cd12072c cryptonite-0.30/tests/KAT_PubKey/RSA.hs+formatted cd527ad025c4 cryptonite-0.30/tests/KAT_PubKey/Rabin.hs+formatted fa1389bb8af8 cryptonite-0.30/tests/KAT_RC4.hs+formatted 6c174475decc cryptonite-0.30/tests/KAT_Scrypt.hs+formatted 36380d994c1c cryptonite-0.30/tests/KAT_TripleDES.hs+formatted 509c09091817 cryptonite-0.30/tests/KAT_Twofish.hs+formatted d3ffb4dd724c cryptonite-0.30/tests/Number.hs+formatted 7da4a28c8580 cryptonite-0.30/tests/Number/F2m.hs+formatted 153769199399 cryptonite-0.30/tests/Padding.hs+formatted e4b87212dc1f cryptonite-0.30/tests/Poly1305.hs+formatted 38c09837971d cryptonite-0.30/tests/Salsa.hs+formatted 54065ea7b3f2 cryptonite-0.30/tests/Tests.hs+formatted 8ebf266d6afa cryptonite-0.30/tests/Utils.hs+formatted f7ee48c90ce9 cryptonite-0.30/tests/XSalsa.hs+formatted e865ae48f11b diagrams-core-1.5.1.2/Setup.hs+formatted 390dfdff3fbc diagrams-core-1.5.1.2/src/Diagrams/Core.hs+formatted 5b9f4064740f diagrams-core-1.5.1.2/src/Diagrams/Core/Compile.hs+formatted dcc0b6e7d82d diagrams-core-1.5.1.2/src/Diagrams/Core/Envelope.hs+formatted c945af86b66d diagrams-core-1.5.1.2/src/Diagrams/Core/HasOrigin.hs+formatted 5e6397a73cbf diagrams-core-1.5.1.2/src/Diagrams/Core/Juxtapose.hs+formatted 5d249b0ae2ba diagrams-core-1.5.1.2/src/Diagrams/Core/Measure.hs+formatted 3f232ced8cd3 diagrams-core-1.5.1.2/src/Diagrams/Core/Names.hs+formatted 169fec80496d diagrams-core-1.5.1.2/src/Diagrams/Core/Points.hs+formatted d8167797c638 diagrams-core-1.5.1.2/src/Diagrams/Core/Query.hs+formatted c1f6572049e6 diagrams-core-1.5.1.2/src/Diagrams/Core/Style.hs+formatted 67cdc6b4a26e diagrams-core-1.5.1.2/src/Diagrams/Core/Trace.hs+formatted ceb1829b99d5 diagrams-core-1.5.1.2/src/Diagrams/Core/Transform.hs+formatted 053c9acdc8a3 diagrams-core-1.5.1.2/src/Diagrams/Core/Types.hs+formatted a9f71c9c75d0 diagrams-core-1.5.1.2/src/Diagrams/Core/V.hs+formatted 5cabe7655bac distributed-process-0.7.8/benchmarks/Channels.hs+formatted 504953bb1387 distributed-process-0.7.8/benchmarks/Latency.hs+formatted d09b9e8f8cf6 distributed-process-0.7.8/benchmarks/ProcessRing.hs+formatted c83a31f749c7 distributed-process-0.7.8/benchmarks/Spawns.hs+formatted 85c826b4657d distributed-process-0.7.8/benchmarks/Throughput.hs+formatted e7bfb48f27d1 distributed-process-0.7.8/src/Control/Distributed/Process.hs+formatted 3f710068b83b distributed-process-0.7.8/src/Control/Distributed/Process/Closure.hs+formatted 9abdf121594b distributed-process-0.7.8/src/Control/Distributed/Process/Debug.hs+formatted c98976ba0493 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/BiMultiMap.hs+formatted fe72c6f43347 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/CQueue.hs+formatted 2946b3a11a2f distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Closure/BuiltIn.hs+formatted a950bf8d3ff9 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Closure/Explicit.hs+formatted 8ab242465a6d distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Closure/TH.hs+formatted 4f632ae95bca distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Messaging.hs+formatted 371d302bf97d distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Primitives.hs+formatted e8934f2fb775 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Spawn.hs+formatted cd3afabcd890 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/StrictContainerAccessors.hs+formatted 8a9d9c67b86f distributed-process-0.7.8/src/Control/Distributed/Process/Internal/StrictList.hs+formatted b21182e8f9f2 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/StrictMVar.hs+formatted 8741f1720d69 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Types.hs+formatted d8a70ea27555 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/WeakTQueue.hs+formatted 7260ec04f829 distributed-process-0.7.8/src/Control/Distributed/Process/Management.hs+formatted 0fc21b015e4c distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Agent.hs+formatted 39b50d32c5a6 distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Bus.hs+formatted 5e7aa53931dc distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Trace/Primitives.hs+formatted 818907f11c3f distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Trace/Remote.hs+formatted de6da63f59ad distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Trace/Tracer.hs+formatted 2b21046051cd distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Trace/Types.hs+formatted 7142839f16fe distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Types.hs+formatted 412c9677cfbc distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs+formatted 6b86ee01b32a distributed-process-0.7.8/src/Control/Distributed/Process/Serializable.hs+formatted daf3cd1d8b53 distributed-process-0.7.8/src/Control/Distributed/Process/UnsafePrimitives.hs+broken c7f3522faa0a dlist-1.0/Data/DList.hs+formatted 20c1dbe536f4 dlist-1.0/Data/DList/DNonEmpty.hs+formatted 3d51b496abb0 dlist-1.0/Data/DList/DNonEmpty/Internal.hs+declined - dlist-1.0/Data/DList/Internal.hs+formatted 669ee89127ed dlist-1.0/Data/DList/Unsafe.hs+formatted c7f9b52c6db5 dlist-1.0/tests/DListProperties.hs+formatted 54f0c52fc06b dlist-1.0/tests/DNonEmptyProperties.hs+formatted 9471e1a867e9 dlist-1.0/tests/ImportUnsafe.hs+formatted 977d78f79456 dlist-1.0/tests/Main.hs+formatted ff0ea90a2896 dlist-1.0/tests/OverloadedStrings.hs+formatted eda938831fc8 dlist-1.0/tests/QuickCheckUtil.hs+formatted e865ae48f11b esqueleto-3.6.0.3/Setup.hs+formatted fb274a829f01 esqueleto-3.6.0.3/src/Database/Esqueleto.hs+formatted 99a3554c79c4 esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental.hs+formatted 62ae3d4e946f esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/From.hs+formatted 66df5876db87 esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/From/CommonTableExpression.hs+formatted 1c658ac7468e esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/From/Join.hs+formatted beecd102c083 esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/From/SqlSetOperation.hs+formatted d4056ae5fdae esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/ToAlias.hs+formatted 570cc685ebf9 esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/ToAliasReference.hs+formatted 9f36875401e2 esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/ToMaybe.hs+formatted 1182bc5f07a3 esqueleto-3.6.0.3/src/Database/Esqueleto/Internal/ExprParser.hs+formatted 7d5926bb95a1 esqueleto-3.6.0.3/src/Database/Esqueleto/Internal/Internal.hs+formatted 8e8a8c378f2b esqueleto-3.6.0.3/src/Database/Esqueleto/Internal/PersistentImport.hs+formatted 23c62f207b2d esqueleto-3.6.0.3/src/Database/Esqueleto/Legacy.hs+formatted 9cd66d1b3ed2 esqueleto-3.6.0.3/src/Database/Esqueleto/MySQL.hs+formatted c89093d794d3 esqueleto-3.6.0.3/src/Database/Esqueleto/PostgreSQL.hs+formatted c9c85bd4863e esqueleto-3.6.0.3/src/Database/Esqueleto/PostgreSQL/JSON.hs+formatted 1499072a5bb5 esqueleto-3.6.0.3/src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs+formatted c9e808f99d5b esqueleto-3.6.0.3/src/Database/Esqueleto/Record.hs+formatted 167fa1cef38a esqueleto-3.6.0.3/src/Database/Esqueleto/SQLite.hs+formatted 87d19093371d esqueleto-3.6.0.3/test/Common/Record.hs+formatted 898e906dfbfd esqueleto-3.6.0.3/test/Common/Test.hs+formatted c745d9be5124 esqueleto-3.6.0.3/test/Common/Test/CTE.hs+formatted 1f83d04692e3 esqueleto-3.6.0.3/test/Common/Test/Import.hs+formatted 2e16567983e5 esqueleto-3.6.0.3/test/Common/Test/Models.hs+formatted 1e1af0ff65e2 esqueleto-3.6.0.3/test/Common/Test/Select.hs+formatted 6c403a7dbfd3 esqueleto-3.6.0.3/test/MySQL/Test.hs+formatted 649022fe6ecf esqueleto-3.6.0.3/test/PostgreSQL/MigrateJSON.hs+formatted 2b853749fb75 esqueleto-3.6.0.3/test/PostgreSQL/Test.hs+formatted 0e0ef1763885 esqueleto-3.6.0.3/test/SQLite/Test.hs+formatted 9c274d8e66c1 esqueleto-3.6.0.3/test/Spec.hs+formatted 27965836c84d exceptions-0.10.12/src/Control/Monad/Catch.hs+formatted bfa68dd05586 exceptions-0.10.12/src/Control/Monad/Catch/Pure.hs+formatted 9e0076961bd9 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 ec9eeba0c6a1 fay-0.24.2.0/examples/CodeWorld.hs+formatted 99245f57be0e fay-0.24.2.0/examples/CodeWorldMain.hs+formatted 548a2ab668be fay-0.24.2.0/examples/Cont.hs+formatted 51acf9e074e7 fay-0.24.2.0/examples/D3TreeSample.hs+formatted 5ecb259af8cb 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 2d60fb67f2de fay-0.24.2.0/examples/canvaswater.hs+formatted 97df12f5dfa2 fay-0.24.2.0/examples/console.hs+formatted 219026b77ebc fay-0.24.2.0/examples/data.hs+formatted 57124dd1aa0e fay-0.24.2.0/examples/dom.hs+formatted a017f7092550 fay-0.24.2.0/examples/jquery.hs+formatted aabfbe529b18 fay-0.24.2.0/examples/json.hs+formatted db1cb782ccc3 fay-0.24.2.0/examples/node.hs+formatted f3df3b020033 fay-0.24.2.0/examples/nqueens.hs+formatted 082f30944841 fay-0.24.2.0/examples/obj.hs+formatted 876df6e6b3f1 fay-0.24.2.0/examples/oscillator.hs+formatted c79a44579d85 fay-0.24.2.0/examples/pat.hs+formatted fa732b1a5e66 fay-0.24.2.0/examples/properties.hs+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 1463fee0cdc0 fay-0.24.2.0/src/Fay.hs+formatted 07c67e558a55 fay-0.24.2.0/src/Fay/Compiler.hs+formatted 08e147a7ca10 fay-0.24.2.0/src/Fay/Compiler/Decl.hs+formatted d4575500ee48 fay-0.24.2.0/src/Fay/Compiler/Defaults.hs+formatted 9e167b4dd860 fay-0.24.2.0/src/Fay/Compiler/Desugar.hs+formatted e8e463edecee 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 07d2e834d04c fay-0.24.2.0/src/Fay/Compiler/Exp.hs+formatted 28a5f094dde5 fay-0.24.2.0/src/Fay/Compiler/FFI.hs+formatted 69fd6dd80a66 fay-0.24.2.0/src/Fay/Compiler/GADT.hs+formatted 1a601ae0f75b fay-0.24.2.0/src/Fay/Compiler/Import.hs+formatted a2f05f014ae5 fay-0.24.2.0/src/Fay/Compiler/InitialPass.hs+formatted a22d45c5c321 fay-0.24.2.0/src/Fay/Compiler/Misc.hs+formatted bce0992d570d fay-0.24.2.0/src/Fay/Compiler/ModuleT.hs+formatted 5ff84858fb95 fay-0.24.2.0/src/Fay/Compiler/Optimizer.hs+formatted ac32749d90ec fay-0.24.2.0/src/Fay/Compiler/Packages.hs+formatted a76cfec53b82 fay-0.24.2.0/src/Fay/Compiler/Parse.hs+formatted 4e8f1b8a0816 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 ea36afcb904b fay-0.24.2.0/src/Fay/Compiler/Print.hs+formatted 66a7ddb00b81 fay-0.24.2.0/src/Fay/Compiler/QName.hs+formatted fa9988c44218 fay-0.24.2.0/src/Fay/Compiler/State.hs+formatted fb1831a445cc fay-0.24.2.0/src/Fay/Compiler/Typecheck.hs+formatted 413034d717c7 fay-0.24.2.0/src/Fay/Config.hs+formatted 15cd1e849d0e 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 bd1f234d96c0 fay-0.24.2.0/src/Fay/Exts/Scoped.hs+formatted f7856f337bee fay-0.24.2.0/src/Fay/FFI.hs+formatted 7dd89da8a466 fay-0.24.2.0/src/Fay/Runtime.hs+formatted 0ac5069cbf76 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 f21a75633d68 fay-0.24.2.0/src/Fay/Types/FFI.hs+formatted 16c62b3f8086 fay-0.24.2.0/src/Fay/Types/Js.hs+formatted 8b5e7dc5b55c fay-0.24.2.0/src/Fay/Types/ModulePath.hs+formatted 70b756fa52b3 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 bfea4a051d5e fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Annotated.hs+formatted b36e999e1b42 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Exports.hs+formatted ba7a7290b652 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/GetBound.hs+formatted dcc2c3f113a9 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 c7ae29226dad 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 b64dde2af1d1 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 b12db8ba5ce9 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Open/Derived.hs+formatted e5d7ccfc13f3 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Open/Instances.hs+formatted 5830466c394d 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 0c478b11a301 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/ScopeUtils.hs+formatted 0ad105ebc45d fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/SyntaxUtils.hs+formatted 2b1329bafe82 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 4aba97e21b8e fay-0.24.2.0/src/tests/Test/Compile.hs+formatted 86467d080a45 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 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 85b587f06e29 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 a64f08ccafac fay-0.24.2.0/tests/Compile/CPPTypecheck.hs+formatted 66d008a435ce fay-0.24.2.0/tests/Compile/EnumChar.hs+formatted 79a705007362 fay-0.24.2.0/tests/Compile/ImportRecords.hs+formatted a0d1bb7739c9 fay-0.24.2.0/tests/Compile/Records.hs+formatted 654d49354de8 fay-0.24.2.0/tests/Compile/StrictWrapper.hs+formatted 3f10c446d77e fay-0.24.2.0/tests/Compile/pretty.hs+formatted 3f10c446d77e fay-0.24.2.0/tests/Compile/prettyOperators.hs+formatted 3f10c446d77e fay-0.24.2.0/tests/Compile/prettyThunks.hs+formatted 7e5ba819c89a fay-0.24.2.0/tests/Defined.hs+formatted 933b5c75c95d fay-0.24.2.0/tests/DesugarFFI.hs+formatted 247bf5cdbba0 fay-0.24.2.0/tests/DoLet2.hs+formatted 8e59e23cdef2 fay-0.24.2.0/tests/DoLet3.hs+formatted 8506e48ae167 fay-0.24.2.0/tests/Double.hs+formatted 555ed6125da8 fay-0.24.2.0/tests/Double2.hs+formatted 940c2db0f038 fay-0.24.2.0/tests/Double3.hs+formatted ce51517b312e fay-0.24.2.0/tests/Double4.hs+formatted e7d8f2571cb1 fay-0.24.2.0/tests/Either.hs+formatted f00c11dbed60 fay-0.24.2.0/tests/EmptyDataDeclArray.hs+formatted 7c2bc66a86e6 fay-0.24.2.0/tests/Eq.hs+formatted 25d8fd9d5d5a fay-0.24.2.0/tests/ExportEThingAll.hs+formatted bea5851db3b4 fay-0.24.2.0/tests/ExportEThingAll_Export.hs+formatted b86ba0189dff fay-0.24.2.0/tests/ExportEThingWith.hs+formatted 19c335568239 fay-0.24.2.0/tests/ExportList.hs+formatted b39169d37973 fay-0.24.2.0/tests/ExportList_A.hs+formatted eb351b1cfd3e fay-0.24.2.0/tests/ExportList_B.hs+formatted 4736c70718a7 fay-0.24.2.0/tests/ExportList_C.hs+formatted 41c7f9eb857a fay-0.24.2.0/tests/ExportList_D.hs+formatted b42dad751766 fay-0.24.2.0/tests/ExportQualified_Export.hs+formatted e08dc6f4e84b fay-0.24.2.0/tests/ExportQualified_Import.hs+formatted 7778565bb389 fay-0.24.2.0/tests/ExportType.hs+formatted ba54245a67ef fay-0.24.2.0/tests/Floating.hs+formatted 02165869295d fay-0.24.2.0/tests/FromString.hs+formatted fc43945a5277 fay-0.24.2.0/tests/FromString/Dep.hs+formatted 09e516e107ad fay-0.24.2.0/tests/FromString/DepDep.hs+formatted a8e31b7f9068 fay-0.24.2.0/tests/FromString/FayText.hs+formatted 3da43a919ebc fay-0.24.2.0/tests/GADTs_without_records.hs+formatted 102949714efb fay-0.24.2.0/tests/GuardWhere.hs+formatted 4c6803c7f169 fay-0.24.2.0/tests/HidePreludeImport.hs+formatted a1408d450caf fay-0.24.2.0/tests/HidePreludeImport_Import.hs+formatted fa5b4cc76a44 fay-0.24.2.0/tests/Hierarchical/Export.hs+formatted 102307416bcd fay-0.24.2.0/tests/Hierarchical/RecordDefined.hs+formatted 920c9acca3b5 fay-0.24.2.0/tests/HierarchicalImport.hs+formatted def230ba708f fay-0.24.2.0/tests/ImplicitPrelude.hs+formatted c71809dd7876 fay-0.24.2.0/tests/ImportHiding.hs+formatted 75f8ddda7df8 fay-0.24.2.0/tests/ImportIThingAll.hs+formatted b4c50a46461c fay-0.24.2.0/tests/ImportList.hs+formatted 87c5a69d1b76 fay-0.24.2.0/tests/ImportList1/A.hs+formatted 8d3ac5b6cbc9 fay-0.24.2.0/tests/ImportList1/B.hs+formatted baf7f8cf38cc fay-0.24.2.0/tests/ImportList1/C.hs+formatted b5cb6de55974 fay-0.24.2.0/tests/ImportListType.hs+formatted 69bb47d76aef fay-0.24.2.0/tests/ImportType.hs+formatted 440bc41f78be fay-0.24.2.0/tests/ImportType2.hs+formatted 5ff8e931a567 fay-0.24.2.0/tests/ImportType2I/A.hs+formatted e15dbb9a2720 fay-0.24.2.0/tests/ImportType2I/B.hs+formatted 9d4bcec16bd7 fay-0.24.2.0/tests/Integer.hs+formatted ed2b3650244f fay-0.24.2.0/tests/Integral.hs+formatted dadef2b7cb03 fay-0.24.2.0/tests/Issue215/B.hs+formatted eeedb44973d0 fay-0.24.2.0/tests/Issue215A.hs+formatted b0a19078b259 fay-0.24.2.0/tests/Js2FayFunc.hs+formatted 8592007d3db3 fay-0.24.2.0/tests/JsFunctionPassing.hs+formatted 009642e56a6b fay-0.24.2.0/tests/LambdaCase.hs+formatted 47266926fa39 fay-0.24.2.0/tests/LazyOperators.hs+formatted ee291ee7e00e fay-0.24.2.0/tests/List.hs+formatted c8021ca9ec3f fay-0.24.2.0/tests/List2.hs+formatted a93b0ff4bcc5 fay-0.24.2.0/tests/ListEq.hs+formatted c3daafcf2461 fay-0.24.2.0/tests/MainThunk.hs+formatted 350d9831d6f8 fay-0.24.2.0/tests/ModuleReExport/ExportsIdentifier.hs+formatted 25cef8780cae fay-0.24.2.0/tests/ModuleReExport/ExportsModule.hs+formatted 9dfef0f7c129 fay-0.24.2.0/tests/ModuleReExports.hs+formatted c082d387d888 fay-0.24.2.0/tests/ModuleRecordClash.hs+formatted 997782df97ba fay-0.24.2.0/tests/ModuleRecordClash/R.hs+formatted 53ea9782c8a3 fay-0.24.2.0/tests/ModuleRecordClash2.hs+formatted 9800c4c956c7 fay-0.24.2.0/tests/ModuleRecordClash2_Hello.hs+formatted 1a83fbebaaf8 fay-0.24.2.0/tests/Monad.hs+formatted 86f64805684f fay-0.24.2.0/tests/Monad2.hs+formatted 0c9780229637 fay-0.24.2.0/tests/MultiWayIf.hs+formatted 0e3845c048a2 fay-0.24.2.0/tests/NestedImporting.hs+formatted 4b3a670722e0 fay-0.24.2.0/tests/NestedImporting/A.hs+formatted 2a092a0c1f4c fay-0.24.2.0/tests/NestedImporting2.hs+formatted 19cbbffb80bc fay-0.24.2.0/tests/NestedImporting2/A.hs+formatted 5b0905d26851 fay-0.24.2.0/tests/NewtypeImport_Export.hs+formatted 34ed28dbd073 fay-0.24.2.0/tests/NewtypeImport_Import.hs+formatted ad07b3a0d755 fay-0.24.2.0/tests/Nullable.hs+formatted f01c35cc494d fay-0.24.2.0/tests/Num.hs+formatted 75ea0e91fb04 fay-0.24.2.0/tests/Ord.hs+formatted 66e4369c7bda fay-0.24.2.0/tests/PrefixOpPat.hs+formatted cc9547968f50 fay-0.24.2.0/tests/QualifiedImport.hs+formatted e548782c2e69 fay-0.24.2.0/tests/QualifiedImport/X.hs+formatted 391559feaa6f fay-0.24.2.0/tests/QualifiedImport/Y.hs+formatted 5a73215af899 fay-0.24.2.0/tests/Ratio.hs+formatted 577c81fcbe39 fay-0.24.2.0/tests/ReExport1.hs+formatted 97f273a7040d fay-0.24.2.0/tests/ReExport2.hs+formatted 9fb50fe15789 fay-0.24.2.0/tests/ReExport3.hs+formatted 8b077416b2a2 fay-0.24.2.0/tests/ReExportGlobally.hs+formatted 51e4cd174ea4 fay-0.24.2.0/tests/ReExportGlobally/A.hs+formatted b21d1616e152 fay-0.24.2.0/tests/ReExportGloballyExplicit.hs+formatted 9315bbd88930 fay-0.24.2.0/tests/RealFrac.hs+formatted 1a6a33c6ac9d fay-0.24.2.0/tests/RecCon.hs+formatted d0c6c8bc95e4 fay-0.24.2.0/tests/RecDecl.hs+formatted 23fcb8f6b7c4 fay-0.24.2.0/tests/RecordImport2_Export1.hs+formatted 1cf7d6a06d1d fay-0.24.2.0/tests/RecordImport2_Export2.hs+formatted c044e70c8101 fay-0.24.2.0/tests/RecordImport2_Import.hs+formatted 4a78cf573fbc fay-0.24.2.0/tests/RecordImport_Export.hs+formatted 602840c8fb4f fay-0.24.2.0/tests/RecordImport_Import.hs+formatted 50271d9b8bd9 fay-0.24.2.0/tests/Sink.hs+formatted 0d52d0cd7e4b fay-0.24.2.0/tests/SkipLetTypes.hs+formatted 79a7eb241171 fay-0.24.2.0/tests/SkipWhereTypes.hs+formatted b2f90faa6d96 fay-0.24.2.0/tests/StringForcing.hs+formatted 78f704c770c1 fay-0.24.2.0/tests/Strings.hs+formatted b23a6f00c551 fay-0.24.2.0/tests/T190.hs+formatted 692f0dae5fb8 fay-0.24.2.0/tests/T190_A.hs+formatted 8e73afc88ae8 fay-0.24.2.0/tests/T190_B.hs+formatted e68acdaf2dfe fay-0.24.2.0/tests/T190_C.hs+formatted 7bd1c4fd8478 fay-0.24.2.0/tests/TextOrd.hs+formatted f47544b81667 fay-0.24.2.0/tests/Trace.hs+formatted c578ce2acbf6 fay-0.24.2.0/tests/TupleCalls.hs+formatted d35a3f3c7245 fay-0.24.2.0/tests/TyVarSerialization.hs+formatted 7d85fb13bd93 fay-0.24.2.0/tests/Var.hs+formatted 7a2ffc1587f5 fay-0.24.2.0/tests/VarPtr.hs+formatted 5bcb67338113 fay-0.24.2.0/tests/WhenUnlessRecursion.hs+formatted c767b8778a1d fay-0.24.2.0/tests/asPatternMatch.hs+formatted aa05f8bd2bf0 fay-0.24.2.0/tests/automatic.hs+formatted 83d1d385ae83 fay-0.24.2.0/tests/baseFixities.hs+formatted ce58f47bac04 fay-0.24.2.0/tests/basicFunctions.hs+formatted 33b5a5453ff8 fay-0.24.2.0/tests/case.hs+formatted a51f036ac082 fay-0.24.2.0/tests/case2.hs+formatted 4a4542652251 fay-0.24.2.0/tests/case3.hs+formatted e563419849e3 fay-0.24.2.0/tests/caseList.hs+formatted 6f41ab7df8c9 fay-0.24.2.0/tests/caseWildcard.hs+formatted 9437474fc565 fay-0.24.2.0/tests/circular.hs+formatted 3ac360393116 fay-0.24.2.0/tests/curry.hs+formatted 9bbe8cd8c749 fay-0.24.2.0/tests/cycle.hs+formatted d07827315b77 fay-0.24.2.0/tests/do.hs+formatted 262e4e61e6b8 fay-0.24.2.0/tests/doAssingPatternMatch.hs+formatted ad5b707f664a fay-0.24.2.0/tests/doBindAssign.hs+formatted e41cbdd7656a fay-0.24.2.0/tests/doLet.hs+formatted 9f8a8d10c1d3 fay-0.24.2.0/tests/emptyMain.hs+formatted 380eff7dedb9 fay-0.24.2.0/tests/enumFrom.hs+formatted 05834fe58432 fay-0.24.2.0/tests/error.hs+formatted f563902672cb fay-0.24.2.0/tests/ffiExpr.hs+formatted 73697f0c099c fay-0.24.2.0/tests/ffimunging.hs+formatted dc67c504a097 fay-0.24.2.0/tests/fix.hs+formatted 9267690ec8d2 fay-0.24.2.0/tests/fromInteger.hs+formatted 73a7dce83bdd fay-0.24.2.0/tests/fromIntegral.hs+formatted 860a7aed8af3 fay-0.24.2.0/tests/guards.hs+formatted 8ff7b7e5d80d fay-0.24.2.0/tests/infixDataConst.hs+formatted 99c963974ca0 fay-0.24.2.0/tests/ints.hs+formatted 9ec2af24577b fay-0.24.2.0/tests/linesAndWords.hs+formatted 36a10a974013 fay-0.24.2.0/tests/listComprehensions.hs+formatted 392b79e97d1d fay-0.24.2.0/tests/listlen.hs+formatted 9d98dc262b39 fay-0.24.2.0/tests/mutableReference.hs+formatted 7fe9f65a3adf fay-0.24.2.0/tests/nameGen.hs+formatted c17264ffcbde fay-0.24.2.0/tests/namedFieldPuns.hs+formatted 68fcd666b331 fay-0.24.2.0/tests/negation.hs+formatted 18a910a17dd2 fay-0.24.2.0/tests/newtype.hs+formatted ea2625a5c5d9 fay-0.24.2.0/tests/newtypeIndirectApp.hs+formatted a587812e6602 fay-0.24.2.0/tests/numTheory.hs+formatted 40bd883716b3 fay-0.24.2.0/tests/nums.hs+formatted c27df9670630 fay-0.24.2.0/tests/pats.hs+formatted b317cbb85f97 fay-0.24.2.0/tests/patternGuards.hs+formatted 353e37b5a857 fay-0.24.2.0/tests/patternMatchFail.hs+formatted 0e69935e45c9 fay-0.24.2.0/tests/patternMatchLet.hs+formatted f963663ae2cf fay-0.24.2.0/tests/patternMatchingTuples.hs+formatted 41871bce5735 fay-0.24.2.0/tests/recordFunctionPatternMatch.hs+formatted 6010444abc75 fay-0.24.2.0/tests/recordPatternMatch.hs+formatted 0dda5fc8df9d fay-0.24.2.0/tests/recordPatternMatch2.hs+formatted 63b9091a92a2 fay-0.24.2.0/tests/recordUseBeforeDefine.hs+formatted 1534c0770b97 fay-0.24.2.0/tests/recordWildCards.hs+formatted 38ba272a8da1 fay-0.24.2.0/tests/records.hs+formatted a371f7d8d704 fay-0.24.2.0/tests/recursive.hs+formatted 9797f8836f3b fay-0.24.2.0/tests/reservedWords.hs+formatted 3bdaf5d65328 fay-0.24.2.0/tests/sections.hs+formatted 19e9c7c69db9 fay-0.24.2.0/tests/seq-fake.hs+formatted 2ac1dc3c2516 fay-0.24.2.0/tests/seq.hs+formatted 3bf92844987c fay-0.24.2.0/tests/serialization.hs+formatted e76961e79030 fay-0.24.2.0/tests/succPred.hs+formatted 461d16ef4da1 fay-0.24.2.0/tests/tailRecursion.hs+formatted b29bc268b713 fay-0.24.2.0/tests/then.hs+formatted 7b2a525c6d17 fay-0.24.2.0/tests/tupleCon.hs+formatted 71a59816933e fay-0.24.2.0/tests/tupleSec.hs+formatted c864de89b243 fay-0.24.2.0/tests/unit.hs+formatted cfb7dd15a745 fay-0.24.2.0/tests/utf8.hs+formatted 68905bc32429 fay-0.24.2.0/tests/where.hs+formatted 6ea0b301c8c4 fay-0.24.2.0/tests/whereBind.hs+formatted 62b7dd25b5c9 fay-0.24.2.0/tests/whereBind2.hs+formatted dd52de0acf94 fay-0.24.2.0/tests/whereBind3.hs+formatted b3d258de0403 free-5.2/examples/PerfTH.hs+formatted 24418bc38fac free-5.2/examples/RetryTH.hs+formatted 7641743d0c1f free-5.2/examples/ValidationForm.hs+formatted 550f8b9da7b3 free-5.2/src/Control/Alternative/Free.hs+formatted f8e32632bd32 free-5.2/src/Control/Alternative/Free/Final.hs+formatted 8b307bae43e5 free-5.2/src/Control/Applicative/Free.hs+formatted 1593e637f12f free-5.2/src/Control/Applicative/Free/Fast.hs+formatted 883709cfad5b free-5.2/src/Control/Applicative/Free/Final.hs+formatted bf937338e8cd free-5.2/src/Control/Applicative/Trans/Free.hs+formatted dd9069083e98 free-5.2/src/Control/Comonad/Cofree.hs+formatted 9b0f6d5a4082 free-5.2/src/Control/Comonad/Cofree/Class.hs+formatted 38f0ea646bae free-5.2/src/Control/Comonad/Trans/Cofree.hs+formatted 09cad19ae5db free-5.2/src/Control/Comonad/Trans/Coiter.hs+formatted f6734128b306 free-5.2/src/Control/Monad/Free.hs+formatted 92f9ffbc940f free-5.2/src/Control/Monad/Free/Ap.hs+formatted aa9c76266363 free-5.2/src/Control/Monad/Free/Church.hs+formatted 39bf4e33f6e2 free-5.2/src/Control/Monad/Free/Class.hs+formatted d6318fb07edb free-5.2/src/Control/Monad/Free/TH.hs+formatted 3088c885facf free-5.2/src/Control/Monad/Trans/Free.hs+formatted 294db67cce93 free-5.2/src/Control/Monad/Trans/Free/Ap.hs+formatted eacfb36ea2de free-5.2/src/Control/Monad/Trans/Free/Church.hs+formatted aabaf90633fd free-5.2/src/Control/Monad/Trans/Iter.hs+formatted e865ae48f11b hakyll-4.17.0.0/Setup.hs+formatted 0a3f98709f72 hakyll-4.17.0.0/data/example/site.hs+formatted 116aaa72d476 hakyll-4.17.0.0/lib/Data/List/Extended.hs+formatted f638cd45236f hakyll-4.17.0.0/lib/Data/Yaml/Extended.hs+formatted 0fcae45b2ba9 hakyll-4.17.0.0/lib/Hakyll.hs+formatted 7abdda6d7a7a hakyll-4.17.0.0/lib/Hakyll/Check.hs+formatted d16c4d72c9d4 hakyll-4.17.0.0/lib/Hakyll/Commands.hs+formatted ee8ce55f1a4b hakyll-4.17.0.0/lib/Hakyll/Core/Compiler.hs+formatted 2f2012949948 hakyll-4.17.0.0/lib/Hakyll/Core/Compiler/Internal.hs+formatted c7cfc530bd2a hakyll-4.17.0.0/lib/Hakyll/Core/Compiler/Require.hs+formatted 10bda89cbe6d hakyll-4.17.0.0/lib/Hakyll/Core/Configuration.hs+formatted 8f683f53a9e9 hakyll-4.17.0.0/lib/Hakyll/Core/Dependencies.hs+formatted 558f0d294954 hakyll-4.17.0.0/lib/Hakyll/Core/File.hs+formatted 2a29ca50b4cf hakyll-4.17.0.0/lib/Hakyll/Core/Identifier.hs+formatted 02b568af6a14 hakyll-4.17.0.0/lib/Hakyll/Core/Identifier/Pattern.hs+formatted 4da1703227de hakyll-4.17.0.0/lib/Hakyll/Core/Identifier/Pattern/Internal.hs+formatted 25bce39252d0 hakyll-4.17.0.0/lib/Hakyll/Core/Item.hs+formatted ea66b0f47f92 hakyll-4.17.0.0/lib/Hakyll/Core/Item/SomeItem.hs+formatted 8d06795590b2 hakyll-4.17.0.0/lib/Hakyll/Core/Logger.hs+formatted 9c84e3b20e81 hakyll-4.17.0.0/lib/Hakyll/Core/Metadata.hs+formatted 6e39852547dc hakyll-4.17.0.0/lib/Hakyll/Core/Provider.hs+formatted 13032bda8285 hakyll-4.17.0.0/lib/Hakyll/Core/Provider/Internal.hs+formatted d080542e3185 hakyll-4.17.0.0/lib/Hakyll/Core/Provider/Metadata.hs+formatted 0cfbeb9b73ba hakyll-4.17.0.0/lib/Hakyll/Core/Provider/MetadataCache.hs+formatted b66bbdf4a200 hakyll-4.17.0.0/lib/Hakyll/Core/Routes.hs+formatted 6fc04bfca9f2 hakyll-4.17.0.0/lib/Hakyll/Core/Rules.hs+formatted a3472736a528 hakyll-4.17.0.0/lib/Hakyll/Core/Rules/Internal.hs+formatted 3ff34b463d20 hakyll-4.17.0.0/lib/Hakyll/Core/Runtime.hs+formatted df1c2bd7e8fb hakyll-4.17.0.0/lib/Hakyll/Core/Store.hs+formatted 69e4cf2a975a hakyll-4.17.0.0/lib/Hakyll/Core/UnixFilter.hs+formatted acbb971a63bc hakyll-4.17.0.0/lib/Hakyll/Core/Util/File.hs+formatted 5cef0dfbc5f6 hakyll-4.17.0.0/lib/Hakyll/Core/Util/Parser.hs+formatted 3f21bbf445b2 hakyll-4.17.0.0/lib/Hakyll/Core/Util/String.hs+formatted a3abc0522132 hakyll-4.17.0.0/lib/Hakyll/Core/Writable.hs+formatted 4a743a6f14b2 hakyll-4.17.0.0/lib/Hakyll/Main.hs+formatted daae4ce0a7f7 hakyll-4.17.0.0/lib/Hakyll/Preview/Poll.hs+formatted d363dc04f1a7 hakyll-4.17.0.0/lib/Hakyll/Preview/Server.hs+formatted 90f95798e3c7 hakyll-4.17.0.0/lib/Hakyll/Web/CompressCss.hs+formatted 2fc0d8fdc6f4 hakyll-4.17.0.0/lib/Hakyll/Web/Feed.hs+formatted 9e925648d786 hakyll-4.17.0.0/lib/Hakyll/Web/Html.hs+formatted 2c80bbb22db0 hakyll-4.17.0.0/lib/Hakyll/Web/Html/RelativizeUrls.hs+formatted 0923e680c5d2 hakyll-4.17.0.0/lib/Hakyll/Web/Meta/JSONLD.hs+formatted a3dbe80d0b45 hakyll-4.17.0.0/lib/Hakyll/Web/Meta/OpenGraph.hs+formatted a3b6503b2c4a hakyll-4.17.0.0/lib/Hakyll/Web/Meta/TwitterCard.hs+formatted 47b99b2ffc3a hakyll-4.17.0.0/lib/Hakyll/Web/Paginate.hs+formatted fe263519bf71 hakyll-4.17.0.0/lib/Hakyll/Web/Pandoc.hs+formatted 5f46737f3756 hakyll-4.17.0.0/lib/Hakyll/Web/Pandoc/Biblio.hs+formatted 63c711e3ed6f hakyll-4.17.0.0/lib/Hakyll/Web/Pandoc/Binary.hs+formatted 413e30365505 hakyll-4.17.0.0/lib/Hakyll/Web/Pandoc/FileType.hs+formatted d77258d3d120 hakyll-4.17.0.0/lib/Hakyll/Web/Redirect.hs+formatted 174f0977fbfb hakyll-4.17.0.0/lib/Hakyll/Web/Tags.hs+formatted 0e9947c1a4f2 hakyll-4.17.0.0/lib/Hakyll/Web/Template.hs+formatted 61c4714e9090 hakyll-4.17.0.0/lib/Hakyll/Web/Template/Context.hs+formatted 46295fe0766a hakyll-4.17.0.0/lib/Hakyll/Web/Template/Internal.hs+formatted 1ba12838107a hakyll-4.17.0.0/lib/Hakyll/Web/Template/Internal/Element.hs+formatted 7741b1b5c63c hakyll-4.17.0.0/lib/Hakyll/Web/Template/Internal/Trim.hs+formatted 270fe0160883 hakyll-4.17.0.0/lib/Hakyll/Web/Template/List.hs+formatted 3bd65fed66ca hakyll-4.17.0.0/src/Init.hs+formatted a98f565dc3bd hakyll-4.17.0.0/tests/Hakyll/Core/Dependencies/Tests.hs+formatted 178a4cbe186e hakyll-4.17.0.0/tests/Hakyll/Core/Identifier/Tests.hs+formatted f8af7a73d467 hakyll-4.17.0.0/tests/Hakyll/Core/Provider/Metadata/Tests.hs+formatted 7741f8e19a21 hakyll-4.17.0.0/tests/Hakyll/Core/Provider/Tests.hs+formatted 0a6fac8a3fe5 hakyll-4.17.0.0/tests/Hakyll/Core/Routes/Tests.hs+formatted db910a6e5dc7 hakyll-4.17.0.0/tests/Hakyll/Core/Rules/Tests.hs+formatted 82ed53ac9567 hakyll-4.17.0.0/tests/Hakyll/Core/Runtime/Tests.hs+formatted 3a05a7e0bc33 hakyll-4.17.0.0/tests/Hakyll/Core/Store/Tests.hs+formatted 7d940c89cef0 hakyll-4.17.0.0/tests/Hakyll/Core/UnixFilter/Tests.hs+formatted e736c3a104ec hakyll-4.17.0.0/tests/Hakyll/Core/Util/String/Tests.hs+formatted 0bb0c4e70b5a hakyll-4.17.0.0/tests/Hakyll/Web/CompressCss/Tests.hs+formatted a15554f5d248 hakyll-4.17.0.0/tests/Hakyll/Web/Feed/Tests.hs+formatted e35e1039078b hakyll-4.17.0.0/tests/Hakyll/Web/Html/RelativizeUrls/Tests.hs+formatted 4744c78df9c5 hakyll-4.17.0.0/tests/Hakyll/Web/Html/Tests.hs+formatted 024dfd4bd370 hakyll-4.17.0.0/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs+formatted 6ca61c42770e hakyll-4.17.0.0/tests/Hakyll/Web/Pandoc/FileType/Tests.hs+formatted 84bc8e02e810 hakyll-4.17.0.0/tests/Hakyll/Web/Tags/Tests.hs+formatted 22cdf7a972b8 hakyll-4.17.0.0/tests/Hakyll/Web/Template/Context/Tests.hs+formatted 713b01148048 hakyll-4.17.0.0/tests/Hakyll/Web/Template/Tests.hs+formatted 7638b562c2be hakyll-4.17.0.0/tests/TestSuite.hs+formatted d0e8ca390798 hakyll-4.17.0.0/tests/TestSuite/Util.hs+formatted 66153c16e099 hakyll-4.17.0.0/web/site.hs+formatted 9226007b6541 hashable-1.5.1.0/Setup.hs+formatted ca97ac3a2690 hashable-1.5.1.0/examples/Main.hs+formatted eeae7da4f236 hashable-1.5.1.0/src/Data/Hashable.hs+declined - hashable-1.5.1.0/src/Data/Hashable/Class.hs+formatted 63527ee9cd6b hashable-1.5.1.0/src/Data/Hashable/FFI.hs+formatted d2be5b809f2a hashable-1.5.1.0/src/Data/Hashable/Generic.hs+formatted ca3275b258b3 hashable-1.5.1.0/src/Data/Hashable/Generic/Instances.hs+formatted c9c87bb00bc0 hashable-1.5.1.0/src/Data/Hashable/Imports.hs+formatted e6b4c010a36d hashable-1.5.1.0/src/Data/Hashable/Lifted.hs+formatted 710bda251742 hashable-1.5.1.0/src/Data/Hashable/LowLevel.hs+formatted 228c88ef0843 hashable-1.5.1.0/src/Data/Hashable/Mix.hs+formatted bd7108c77ca4 hashable-1.5.1.0/src/Data/Hashable/XXH3.hs+formatted f74f5b618f9a hashable-1.5.1.0/tests/Main.hs+formatted 5f3b7f834308 hashable-1.5.1.0/tests/Properties.hs+broken 42af08530ac7 hashable-1.5.1.0/tests/Regress.hs+formatted 468c72120829 hashable-1.5.1.0/tests/xxhash-tests.hs+formatted 867a035875ee haxl-2.5.1.1/Haxl/Core.hs+formatted d1219c0fe211 haxl-2.5.1.1/Haxl/Core/CallGraph.hs+formatted 0ae77138c17c haxl-2.5.1.1/Haxl/Core/DataCache.hs+formatted 87d5268c5c21 haxl-2.5.1.1/Haxl/Core/DataSource.hs+formatted b4583121e35d haxl-2.5.1.1/Haxl/Core/Exception.hs+formatted 2a7c39599c8c haxl-2.5.1.1/Haxl/Core/Fetch.hs+formatted b4afaa8d717d haxl-2.5.1.1/Haxl/Core/Flags.hs+formatted f5053bdd605e haxl-2.5.1.1/Haxl/Core/Memo.hs+formatted 295e686b1256 haxl-2.5.1.1/Haxl/Core/Monad.hs+formatted 59de6a1f9ba8 haxl-2.5.1.1/Haxl/Core/Parallel.hs+formatted dfa57a1a8071 haxl-2.5.1.1/Haxl/Core/Profile.hs+formatted 72749066756e haxl-2.5.1.1/Haxl/Core/RequestStore.hs+formatted c5d4556673d1 haxl-2.5.1.1/Haxl/Core/Run.hs+formatted a8e73c380c33 haxl-2.5.1.1/Haxl/Core/ShowP.hs+formatted f2cb25c4ae73 haxl-2.5.1.1/Haxl/Core/StateStore.hs+formatted 979f6f3e416c haxl-2.5.1.1/Haxl/Core/Stats.hs+formatted bd368a5862fd haxl-2.5.1.1/Haxl/Core/Util.hs+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 7392cb2bf8df haxl-2.5.1.1/tests/AllTests.hs+formatted d2d969d17124 haxl-2.5.1.1/tests/BadDataSource.hs+formatted c747d2048e95 haxl-2.5.1.1/tests/BatchTests.hs+formatted a75656cc58b4 haxl-2.5.1.1/tests/Bench.hs+formatted 67f526c34fd3 haxl-2.5.1.1/tests/CoreTests.hs+formatted 616081b9f14c haxl-2.5.1.1/tests/DataCacheTest.hs+formatted 8120f9ee1106 haxl-2.5.1.1/tests/DataSourceDispatchTests.hs+formatted e20ece2dcc35 haxl-2.5.1.1/tests/ExampleDataSource.hs+formatted 60d04dd78c5e haxl-2.5.1.1/tests/ExceptionStackTests.hs+formatted 329e1c7e0fd4 haxl-2.5.1.1/tests/FullyAsyncTest.hs+formatted 5b348a1f5fab haxl-2.5.1.1/tests/LoadCache.hs+formatted 4c9a496637db haxl-2.5.1.1/tests/MemoizationTests.hs+formatted fc04b9cb728b haxl-2.5.1.1/tests/MockTAO.hs+formatted 679224c9d5e5 haxl-2.5.1.1/tests/MonadAsyncTest.hs+formatted 98176d25f2d8 haxl-2.5.1.1/tests/MonadBench.hs+formatted 44fb28b20457 haxl-2.5.1.1/tests/OutgoneFetchesTests.hs+formatted f760bff6e190 haxl-2.5.1.1/tests/ParallelTests.hs+formatted ea594477eb7f haxl-2.5.1.1/tests/ProfileTests.hs+formatted 478999c2d1bd haxl-2.5.1.1/tests/SleepDataSource.hs+formatted acd820448a53 haxl-2.5.1.1/tests/StatsTests.hs+formatted e30def33c769 haxl-2.5.1.1/tests/TestBadDataSource.hs+formatted 26dd7ea798ca 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+formatted 19781f6f8677 haxl-2.5.1.1/tests/WorkDataSource.hs+formatted b8be7bcaa06e haxl-2.5.1.1/tests/WriteTests.hs+formatted 39ae68a1e26c hedgehog-1.7/src/Hedgehog.hs+formatted 1c094fda6263 hedgehog-1.7/src/Hedgehog/Gen.hs+formatted c03c7c6e1080 hedgehog-1.7/src/Hedgehog/Internal/Barbie.hs+formatted d9db2ccb4bc7 hedgehog-1.7/src/Hedgehog/Internal/Config.hs+formatted 7855a4bfe6fc hedgehog-1.7/src/Hedgehog/Internal/Discovery.hs+formatted 968088a89cf8 hedgehog-1.7/src/Hedgehog/Internal/Distributive.hs+formatted db3d79ebed8e hedgehog-1.7/src/Hedgehog/Internal/Exception.hs+formatted 9815c1a50552 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 6810eba33ae6 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 ab1296ed4cc9 hedgehog-1.7/src/Hedgehog/Internal/Report.hs+formatted f73ae514c1f8 hedgehog-1.7/src/Hedgehog/Internal/Runner.hs+formatted 5c17cc008e95 hedgehog-1.7/src/Hedgehog/Internal/Seed.hs+formatted 704b5c10e39d hedgehog-1.7/src/Hedgehog/Internal/Show.hs+formatted c446e4f9c366 hedgehog-1.7/src/Hedgehog/Internal/Shrink.hs+formatted c9e8e47ba6c5 hedgehog-1.7/src/Hedgehog/Internal/Source.hs+formatted dc592494d5b6 hedgehog-1.7/src/Hedgehog/Internal/State.hs+formatted 6c94f06be1cf hedgehog-1.7/src/Hedgehog/Internal/TH.hs+formatted 8a627c0fefb1 hedgehog-1.7/src/Hedgehog/Internal/Tree.hs+formatted 42e8fad71904 hedgehog-1.7/src/Hedgehog/Internal/Tripping.hs+formatted 33c9141eeffd hedgehog-1.7/src/Hedgehog/Main.hs+formatted d71772dad16c hedgehog-1.7/src/Hedgehog/Range.hs+formatted e23ab85e9c05 hedgehog-1.7/test/Test/Hedgehog/Applicative.hs+formatted 37e6a1383406 hedgehog-1.7/test/Test/Hedgehog/Confidence.hs+formatted 937e5890d2b0 hedgehog-1.7/test/Test/Hedgehog/Filter.hs+formatted 6e253dd6a871 hedgehog-1.7/test/Test/Hedgehog/Maybe.hs+formatted b90e9af1e67d hedgehog-1.7/test/Test/Hedgehog/Seed.hs+formatted 4edd92333a33 hedgehog-1.7/test/Test/Hedgehog/Skip.hs+formatted d20ec251ab72 hedgehog-1.7/test/Test/Hedgehog/Text.hs+formatted 2d3b2e9d7168 hedgehog-1.7/test/Test/Hedgehog/Zip.hs+formatted df799f9ffb57 hedgehog-1.7/test/test.hs+formatted 01b498bf6573 hledger-1.52.1/Hledger/Cli.hs+formatted 2883f330eae3 hledger-1.52.1/Hledger/Cli/Anchor.hs+formatted 8da9d899b517 hledger-1.52.1/Hledger/Cli/Anon.hs+formatted 43e230af0dbc hledger-1.52.1/Hledger/Cli/CliOptions.hs+formatted df73224dbfc3 hledger-1.52.1/Hledger/Cli/Commands.hs+formatted b5468ff32d68 hledger-1.52.1/Hledger/Cli/Commands/Accounts.hs+formatted 9f82d9b83f50 hledger-1.52.1/Hledger/Cli/Commands/Activity.hs+formatted 390f5c20db45 hledger-1.52.1/Hledger/Cli/Commands/Add.hs+formatted d2b5d8ddbfe2 hledger-1.52.1/Hledger/Cli/Commands/Aregister.hs+formatted 3d162d8b81a6 hledger-1.52.1/Hledger/Cli/Commands/Balance.hs+formatted f0880edebbde hledger-1.52.1/Hledger/Cli/Commands/Balancesheet.hs+formatted 6efd74ac6427 hledger-1.52.1/Hledger/Cli/Commands/Balancesheetequity.hs+formatted e7815e4484c7 hledger-1.52.1/Hledger/Cli/Commands/Cashflow.hs+formatted 71fa0aea1fe8 hledger-1.52.1/Hledger/Cli/Commands/Check.hs+formatted 9acd11176d66 hledger-1.52.1/Hledger/Cli/Commands/Close.hs+formatted 1ee9d5996a53 hledger-1.52.1/Hledger/Cli/Commands/Codes.hs+formatted d9cafa4a7ba9 hledger-1.52.1/Hledger/Cli/Commands/Commodities.hs+formatted 8b9bde91d49e hledger-1.52.1/Hledger/Cli/Commands/Demo.hs+formatted c6b07096e5d5 hledger-1.52.1/Hledger/Cli/Commands/Descriptions.hs+formatted d7f05c08652b hledger-1.52.1/Hledger/Cli/Commands/Diff.hs+formatted 314567299894 hledger-1.52.1/Hledger/Cli/Commands/Files.hs+formatted 15d50a6cb01a hledger-1.52.1/Hledger/Cli/Commands/Help.hs+formatted ab6a528f18d5 hledger-1.52.1/Hledger/Cli/Commands/Import.hs+formatted f52dabbdb8da hledger-1.52.1/Hledger/Cli/Commands/Incomestatement.hs+formatted f3beae981cf6 hledger-1.52.1/Hledger/Cli/Commands/Notes.hs+formatted c2ba7a5f589f hledger-1.52.1/Hledger/Cli/Commands/Payees.hs+formatted 386853c2aabb hledger-1.52.1/Hledger/Cli/Commands/Prices.hs+formatted 710dcb2e4f9b hledger-1.52.1/Hledger/Cli/Commands/Print.hs+formatted 0776c0d4e1bb hledger-1.52.1/Hledger/Cli/Commands/Register.hs+formatted 86dbaaa31622 hledger-1.52.1/Hledger/Cli/Commands/Rewrite.hs+formatted 5057749fdb76 hledger-1.52.1/Hledger/Cli/Commands/Roi.hs+formatted fdd3ce4aced8 hledger-1.52.1/Hledger/Cli/Commands/Run.hs+formatted 9eb1c950c825 hledger-1.52.1/Hledger/Cli/Commands/Setup.hs+formatted 619de6c78d7a hledger-1.52.1/Hledger/Cli/Commands/Stats.hs+formatted 7a05bf643d07 hledger-1.52.1/Hledger/Cli/Commands/Tags.hs+formatted f3805bd9e067 hledger-1.52.1/Hledger/Cli/CompoundBalanceCommand.hs+formatted 790c0d70714f hledger-1.52.1/Hledger/Cli/Conf.hs+formatted d2d28f0566d1 hledger-1.52.1/Hledger/Cli/DocFiles.hs+formatted 060eef1f372e hledger-1.52.1/Hledger/Cli/Script.hs+formatted 692db84f9314 hledger-1.52.1/Hledger/Cli/Utils.hs+formatted 75e82c3d7f3a hledger-1.52.1/Hledger/Cli/Version.hs+formatted e865ae48f11b hledger-1.52.1/Setup.hs+formatted 5f05220c744b hledger-1.52.1/app/hledger-cli.hs+formatted 4aa7156cea96 hledger-1.52.1/bench/bench.hs+formatted 770ce114d693 hledger-1.52.1/test/unittest.hs+formatted e865ae48f11b hlint-3.10/Setup.hs+formatted c359541e6f23 hlint-3.10/data/HLint_QuickCheck.hs+declined - hlint-3.10/data/HLint_TypeCheck.hs+formatted 7f62e2698706 hlint-3.10/data/Test.hs+formatted 3d97c22b05bf hlint-3.10/src/Apply.hs+formatted 3fcacf39d946 hlint-3.10/src/CC.hs+formatted b10eb0886b76 hlint-3.10/src/CmdLine.hs+formatted 221e9adae31a hlint-3.10/src/Config/Compute.hs+formatted a7c73de17e90 hlint-3.10/src/Config/Haskell.hs+formatted 747182f5f5c1 hlint-3.10/src/Config/Read.hs+formatted 1c0e336b9e8f hlint-3.10/src/Config/Type.hs+declined - hlint-3.10/src/Config/Yaml.hs+formatted 871e24292ba2 hlint-3.10/src/EmbedData.hs+formatted a0cce8b000d7 hlint-3.10/src/Extension.hs+formatted 232c5ddbbb9b hlint-3.10/src/Fixity.hs+formatted d904d8984e43 hlint-3.10/src/GHC/All.hs+formatted 63d81c2c405a hlint-3.10/src/GHC/Util.hs+formatted 0106b9c8d879 hlint-3.10/src/GHC/Util/ApiAnnotation.hs+formatted f9d97257610d hlint-3.10/src/GHC/Util/Brackets.hs+formatted 8cff3984ef92 hlint-3.10/src/GHC/Util/DynFlags.hs+formatted 56ec3add8792 hlint-3.10/src/GHC/Util/FreeVars.hs+formatted 9ab2d91ee37b hlint-3.10/src/GHC/Util/HsDecl.hs+formatted ba417cad3380 hlint-3.10/src/GHC/Util/HsExpr.hs+formatted 7e3362b9d0bb hlint-3.10/src/GHC/Util/Scope.hs+formatted d8a06089d209 hlint-3.10/src/GHC/Util/SrcLoc.hs+formatted 32a1ee71787a hlint-3.10/src/GHC/Util/Unify.hs+formatted ee5a3002a158 hlint-3.10/src/GHC/Util/View.hs+formatted dcf2b6c06331 hlint-3.10/src/HLint.hs+formatted 6e2f629bc2ae hlint-3.10/src/Hint/All.hs+formatted fea1c1a2897d hlint-3.10/src/Hint/Bracket.hs+formatted e0953eb3c567 hlint-3.10/src/Hint/Comment.hs+formatted 4a34094f4e91 hlint-3.10/src/Hint/Duplicate.hs+formatted a58adef76952 hlint-3.10/src/Hint/Export.hs+formatted ebafd0f86b73 hlint-3.10/src/Hint/Extensions.hs+formatted 8e9b77e23dc7 hlint-3.10/src/Hint/Fixities.hs+formatted 9e280ced172a hlint-3.10/src/Hint/Import.hs+formatted e123b5497c48 hlint-3.10/src/Hint/Lambda.hs+formatted 9306ce4be39c hlint-3.10/src/Hint/List.hs+formatted 367ea0ed84f0 hlint-3.10/src/Hint/ListRec.hs+formatted ff76042813f8 hlint-3.10/src/Hint/Match.hs+formatted 54ff68f3bc0d hlint-3.10/src/Hint/Monad.hs+formatted f5cb1a9c0152 hlint-3.10/src/Hint/Naming.hs+formatted 53ee9e6f677c hlint-3.10/src/Hint/Negation.hs+formatted 199df51582af hlint-3.10/src/Hint/NewType.hs+formatted 66e2152899c5 hlint-3.10/src/Hint/NumLiteral.hs+formatted 03b48e865a24 hlint-3.10/src/Hint/Pattern.hs+formatted 0076ccb5bd1c hlint-3.10/src/Hint/Pragma.hs+formatted c8af37d55e42 hlint-3.10/src/Hint/Restrict.hs+formatted 793c20138fa4 hlint-3.10/src/Hint/Smell.hs+formatted 3308ee100b88 hlint-3.10/src/Hint/Type.hs+formatted 06d92bcca35f hlint-3.10/src/Hint/Unsafe.hs+formatted 48cd04ad2e02 hlint-3.10/src/HsColour.hs+formatted 9f80ce05e290 hlint-3.10/src/Idea.hs+formatted 21091880d7b8 hlint-3.10/src/Language/Haskell/HLint.hs+formatted 7b8846cb4591 hlint-3.10/src/Main.hs+formatted fcdf50a5835c hlint-3.10/src/Parallel.hs+formatted cddb107b52b7 hlint-3.10/src/Refact.hs+formatted 08757ddcd20a hlint-3.10/src/Report.hs+formatted 63e79ae7e622 hlint-3.10/src/SARIF.hs+formatted d0eb61196032 hlint-3.10/src/Summary.hs+formatted e23d1347a2dd hlint-3.10/src/Test/All.hs+formatted 4a4b0f06e68b hlint-3.10/src/Test/Annotations.hs+formatted 80dc7efdd537 hlint-3.10/src/Test/InputOutput.hs+formatted f69b332bdb4f hlint-3.10/src/Test/Util.hs+formatted 0f5eb69b44dd hlint-3.10/src/Timing.hs+formatted 40bafe709540 hlint-3.10/src/Util.hs+formatted 14f5f9f6c72a hspec-core-2.11.17/src/GetOpt/Declarative.hs+formatted 13b54fc56d9e hspec-core-2.11.17/src/GetOpt/Declarative/Environment.hs+formatted ac874aa7540a hspec-core-2.11.17/src/GetOpt/Declarative/Interpret.hs+formatted aed8c8d69571 hspec-core-2.11.17/src/GetOpt/Declarative/Types.hs+formatted 7963314c7b2d hspec-core-2.11.17/src/GetOpt/Declarative/Util.hs+formatted c59700aebda7 hspec-core-2.11.17/src/Test/Hspec/Core/Annotations.hs+formatted aaed3a708e2b hspec-core-2.11.17/src/Test/Hspec/Core/Clock.hs+broken 043159a88536 hspec-core-2.11.17/src/Test/Hspec/Core/Compat.hs+formatted 0599f76d3382 hspec-core-2.11.17/src/Test/Hspec/Core/Config.hs+formatted d4499d7a9df1 hspec-core-2.11.17/src/Test/Hspec/Core/Config/Definition.hs+formatted 2c2affbefb39 hspec-core-2.11.17/src/Test/Hspec/Core/Config/Options.hs+formatted d65135838a37 hspec-core-2.11.17/src/Test/Hspec/Core/Example.hs+formatted 67abe1344a1b hspec-core-2.11.17/src/Test/Hspec/Core/Example/Location.hs+formatted 19c90134f072 hspec-core-2.11.17/src/Test/Hspec/Core/Extension.hs+formatted b5766e2580e3 hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Config.hs+formatted d822d438fd19 hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Config/Type.hs+formatted 5eb7b97d332b hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Item.hs+formatted 61fffea8ad44 hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Option.hs+formatted 2c1d2b4038d2 hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Spec.hs+formatted 090871045b95 hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Tree.hs+formatted 9a4c4c61d167 hspec-core-2.11.17/src/Test/Hspec/Core/FailureReport.hs+formatted cb0511463c94 hspec-core-2.11.17/src/Test/Hspec/Core/Format.hs+formatted b8b03afd38ee hspec-core-2.11.17/src/Test/Hspec/Core/Formatters.hs+formatted 0f6c87760ec2 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Diff.hs+formatted da7bd7f0c6a9 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Internal.hs+formatted cd8a29b5bab7 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Pretty.hs+formatted 71e26cb11ffa hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs+formatted 07264fb33ca8 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Pretty/Unicode.hs+formatted 32564aeda195 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/V1.hs+formatted f7f280a9eab8 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/V1/Free.hs+formatted 2ade5a4b4c64 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/V1/Internal.hs+formatted 0879c2625e9f hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/V1/Monad.hs+formatted 2b46e6d892ef hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/V2.hs+formatted de2f6f0279c1 hspec-core-2.11.17/src/Test/Hspec/Core/Hooks.hs+formatted 35f4b48b53f0 hspec-core-2.11.17/src/Test/Hspec/Core/QuickCheck.hs+formatted e8c000ca0db9 hspec-core-2.11.17/src/Test/Hspec/Core/QuickCheck/Util.hs+formatted 24c9dad2d9bd hspec-core-2.11.17/src/Test/Hspec/Core/Runner.hs+formatted ce1b03ea14a3 hspec-core-2.11.17/src/Test/Hspec/Core/Runner/Eval.hs+formatted 45d877a0b59c hspec-core-2.11.17/src/Test/Hspec/Core/Runner/JobQueue.hs+formatted 3324ca8fd649 hspec-core-2.11.17/src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs+formatted dfca3a9a186c hspec-core-2.11.17/src/Test/Hspec/Core/Runner/Result.hs+formatted 9a99abc1c86d hspec-core-2.11.17/src/Test/Hspec/Core/Shuffle.hs+formatted 54648918fc16 hspec-core-2.11.17/src/Test/Hspec/Core/Spec.hs+formatted 2d50b76229a7 hspec-core-2.11.17/src/Test/Hspec/Core/Spec/Monad.hs+formatted 1b327d112974 hspec-core-2.11.17/src/Test/Hspec/Core/Timer.hs+formatted faae992d66db hspec-core-2.11.17/src/Test/Hspec/Core/Tree.hs+formatted 80d2d2b8d380 hspec-core-2.11.17/src/Test/Hspec/Core/Util.hs+formatted e06b7cc46fd9 hspec-core-2.11.17/test/GetOpt/Declarative/EnvironmentSpec.hs+formatted 6655e2e71bb3 hspec-core-2.11.17/test/GetOpt/Declarative/UtilSpec.hs+formatted c4b66f907855 hspec-core-2.11.17/test/Helper.hs+formatted 10aa2070ffb6 hspec-core-2.11.17/test/Mock.hs+formatted 42263bafabb2 hspec-core-2.11.17/test/Spec.hs+formatted 409fb8a0b5e3 hspec-core-2.11.17/test/SpecHook.hs+formatted ae9de2079048 hspec-core-2.11.17/test/Test/Hspec/Core/AnnotationsSpec.hs+formatted 1157d1650ac3 hspec-core-2.11.17/test/Test/Hspec/Core/ClockSpec.hs+formatted 819d29d3431f hspec-core-2.11.17/test/Test/Hspec/Core/CompatSpec.hs+formatted e5db68e3c868 hspec-core-2.11.17/test/Test/Hspec/Core/Config/DefinitionSpec.hs+formatted 105756fabf5e hspec-core-2.11.17/test/Test/Hspec/Core/Config/OptionsSpec.hs+formatted edfe82f15e2d hspec-core-2.11.17/test/Test/Hspec/Core/ConfigSpec.hs+formatted 035e99ae64f4 hspec-core-2.11.17/test/Test/Hspec/Core/Example/LocationSpec.hs+formatted d51ddf803043 hspec-core-2.11.17/test/Test/Hspec/Core/ExampleSpec.hs+formatted 4c0452141fce hspec-core-2.11.17/test/Test/Hspec/Core/FailureReportSpec.hs+formatted 8992979a0121 hspec-core-2.11.17/test/Test/Hspec/Core/FormatSpec.hs+formatted c2d7791f1000 hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/DiffSpec.hs+formatted cb3d38eb1461 hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/InternalSpec.hs+formatted 2ffb49f5a742 hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs+formatted afa9ffaa3bf1 hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/Pretty/UnicodeSpec.hs+formatted ac2da1dd4d6b hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/PrettySpec.hs+formatted 614ca58f541d hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/V1Spec.hs+formatted e113498e6ff6 hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/V2Spec.hs+formatted b43a06946394 hspec-core-2.11.17/test/Test/Hspec/Core/HooksSpec.hs+formatted a32929c3e3b9 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 1a7b81d688ce hspec-core-2.11.17/test/Test/Hspec/Core/Runner/JobQueueSpec.hs+formatted 453f7a305fc2 hspec-core-2.11.17/test/Test/Hspec/Core/Runner/PrintSlowSpecItemsSpec.hs+formatted 6222147e36c5 hspec-core-2.11.17/test/Test/Hspec/Core/Runner/ResultSpec.hs+formatted fa3a7e8ed2cf hspec-core-2.11.17/test/Test/Hspec/Core/RunnerSpec.hs+formatted be08f1178641 hspec-core-2.11.17/test/Test/Hspec/Core/ShuffleSpec.hs+formatted 6c250c13b42b hspec-core-2.11.17/test/Test/Hspec/Core/SpecSpec.hs+formatted ccd964421c9d hspec-core-2.11.17/test/Test/Hspec/Core/TimerSpec.hs+formatted ad44f3bb30b2 hspec-core-2.11.17/test/Test/Hspec/Core/TreeSpec.hs+formatted a46fa24d2bd0 hspec-core-2.11.17/test/Test/Hspec/Core/UtilSpec.hs+formatted 47b3f474a58b hspec-core-2.11.17/vendor/Data/Algorithm/Diff.hs+partly-checked 0fb98ceed356 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+formatted 4b70560a046e http-client-0.7.19/Data/KeyedPool.hs+formatted ee21d51c58b7 http-client-0.7.19/Network/HTTP/Client.hs+formatted 78f4e79070b8 http-client-0.7.19/Network/HTTP/Client/Body.hs+formatted e9db5b7dff2e http-client-0.7.19/Network/HTTP/Client/Connection.hs+formatted e02d2d7818fe http-client-0.7.19/Network/HTTP/Client/Cookies.hs+formatted f2e7c7f3925a http-client-0.7.19/Network/HTTP/Client/Core.hs+formatted 7a5aad8e01a5 http-client-0.7.19/Network/HTTP/Client/Headers.hs+formatted 44b1ad27a89e http-client-0.7.19/Network/HTTP/Client/Internal.hs+formatted 4ea11457dd48 http-client-0.7.19/Network/HTTP/Client/Manager.hs+formatted 7bbd1549c1c5 http-client-0.7.19/Network/HTTP/Client/MultipartFormData.hs+formatted 3803b865de9c http-client-0.7.19/Network/HTTP/Client/Request.hs+formatted b31b91e4e8d8 http-client-0.7.19/Network/HTTP/Client/Response.hs+formatted 3a988ae6956e http-client-0.7.19/Network/HTTP/Client/Types.hs+formatted ca6a48d5e983 http-client-0.7.19/Network/HTTP/Client/Util.hs+formatted 0cd574de49ba http-client-0.7.19/Network/HTTP/Proxy.hs+formatted e865ae48f11b http-client-0.7.19/Setup.hs+formatted b1d3bc1d8679 http-client-0.7.19/publicsuffixlist/Network/PublicSuffixList/DataStructure.hs+formatted 245d124b8415 http-client-0.7.19/publicsuffixlist/Network/PublicSuffixList/Lookup.hs+formatted 765e07adf78d http-client-0.7.19/publicsuffixlist/Network/PublicSuffixList/Serialize.hs+formatted 5696ba4166cb http-client-0.7.19/publicsuffixlist/Network/PublicSuffixList/Types.hs+formatted 5a31984d56fd http-client-0.7.19/test-nonet/Network/HTTP/Client/BodySpec.hs+formatted 329d7775ecfb http-client-0.7.19/test-nonet/Network/HTTP/Client/ConnectionSpec.hs+formatted baf77babfc94 http-client-0.7.19/test-nonet/Network/HTTP/Client/CookieSpec.hs+formatted 11f71ff1af3c http-client-0.7.19/test-nonet/Network/HTTP/Client/HeadersSpec.hs+formatted 5a9957b3a2b8 http-client-0.7.19/test-nonet/Network/HTTP/Client/RequestBodySpec.hs+formatted a8c38aff0a1a http-client-0.7.19/test-nonet/Network/HTTP/Client/RequestSpec.hs+formatted 50108fcc3e79 http-client-0.7.19/test-nonet/Network/HTTP/Client/ResponseSpec.hs+formatted ca2b9c8a628f http-client-0.7.19/test-nonet/Network/HTTP/ClientSpec.hs+formatted 2fbd14b119a4 http-client-0.7.19/test-nonet/Spec.hs+formatted ef38979ac638 http-client-0.7.19/test/Network/HTTP/ClientSpec.hs+formatted 2fbd14b119a4 http-client-0.7.19/test/Spec.hs+formatted 13d151556922 http-types-0.12.6/Network/HTTP/Types.hs+formatted e7eff6d3c526 http-types-0.12.6/Network/HTTP/Types/Header.hs+formatted 26f2850b0a92 http-types-0.12.6/Network/HTTP/Types/Method.hs+formatted 937169187cf1 http-types-0.12.6/Network/HTTP/Types/QueryLike.hs+formatted d965b24d0a62 http-types-0.12.6/Network/HTTP/Types/Status.hs+formatted 8393cb3031e8 http-types-0.12.6/Network/HTTP/Types/URI.hs+formatted f437cc36b9fa http-types-0.12.6/Network/HTTP/Types/Version.hs+formatted e865ae48f11b http-types-0.12.6/Setup.hs+formatted 7d11c2eb808e http-types-0.12.6/test/Network/HTTP/Types/HeaderSpec.hs+formatted 1816a6090b5e http-types-0.12.6/test/Network/HTTP/Types/MethodSpec.hs+formatted 848ef1c45ded http-types-0.12.6/test/Network/HTTP/Types/StatusSpec.hs+formatted 9a3fe7ad6e47 http-types-0.12.6/test/Network/HTTP/Types/URISpec.hs+formatted 5ac67585c5a1 http-types-0.12.6/test/Network/HTTP/Types/VersionSpec.hs+formatted 2fbd14b119a4 http-types-0.12.6/test/Spec.hs+formatted 6d7c004ed36a http-types-0.12.6/test/doctests.hs+declined - idris-1.3.4/Setup.hs+formatted eaad300a8c66 idris-1.3.4/codegen/idris-codegen-c/Main.hs+formatted 98c659d52656 idris-1.3.4/codegen/idris-codegen-javascript/Main.hs+formatted 1c34071e721a idris-1.3.4/codegen/idris-codegen-node/Main.hs+formatted eaa6467947db idris-1.3.4/main/Main.hs+formatted 3fd541795c69 idris-1.3.4/src/IRTS/Bytecode.hs+formatted 9c31d32e255a idris-1.3.4/src/IRTS/CodegenC.hs+formatted 9e5812762ec8 idris-1.3.4/src/IRTS/CodegenCommon.hs+formatted 563f242aebaf idris-1.3.4/src/IRTS/CodegenJavaScript.hs+formatted 2940f3b8e91c idris-1.3.4/src/IRTS/Compiler.hs+formatted 649c4334c449 idris-1.3.4/src/IRTS/Defunctionalise.hs+formatted 521a60c0c99b idris-1.3.4/src/IRTS/DumpBC.hs+formatted 67e26a69bf18 idris-1.3.4/src/IRTS/Exports.hs+formatted 9e44d172890b idris-1.3.4/src/IRTS/Inliner.hs+formatted ca2a16bd8e2f idris-1.3.4/src/IRTS/JavaScript/AST.hs+formatted f768c79df832 idris-1.3.4/src/IRTS/JavaScript/Codegen.hs+formatted b171baf09627 idris-1.3.4/src/IRTS/JavaScript/LangTransforms.hs+formatted 837e1fafadd6 idris-1.3.4/src/IRTS/JavaScript/Name.hs+formatted cd5cebdbb649 idris-1.3.4/src/IRTS/JavaScript/PrimOp.hs+formatted 5eff81bf418b idris-1.3.4/src/IRTS/JavaScript/Specialize.hs+formatted be460f171d5f idris-1.3.4/src/IRTS/Lang.hs+formatted 877532317321 idris-1.3.4/src/IRTS/LangOpts.hs+formatted 54ee13488588 idris-1.3.4/src/IRTS/Portable.hs+formatted c092168371c9 idris-1.3.4/src/IRTS/Simplified.hs+formatted 8a93ea593409 idris-1.3.4/src/IRTS/System.hs+formatted 85927651d0ed idris-1.3.4/src/Idris/ASTUtils.hs+broken d6a87f54c89d idris-1.3.4/src/Idris/AbsSyntax.hs+formatted fb61ce03a769 idris-1.3.4/src/Idris/AbsSyntaxTree.hs+formatted 9f032fa98b74 idris-1.3.4/src/Idris/Apropos.hs+formatted 71a19541ed28 idris-1.3.4/src/Idris/CaseSplit.hs+formatted 887228791bf4 idris-1.3.4/src/Idris/Chaser.hs+formatted a47646c618f2 idris-1.3.4/src/Idris/CmdOptions.hs+formatted 4da7f931a59f idris-1.3.4/src/Idris/Colours.hs+formatted f4a75f24bcf9 idris-1.3.4/src/Idris/Completion.hs+formatted 499686be90c6 idris-1.3.4/src/Idris/Core/Binary.hs+formatted 306094253161 idris-1.3.4/src/Idris/Core/CaseTree.hs+formatted 51f525230ab3 idris-1.3.4/src/Idris/Core/Constraints.hs+formatted 32e1f1dc7a41 idris-1.3.4/src/Idris/Core/DeepSeq.hs+formatted 0b062ce794a9 idris-1.3.4/src/Idris/Core/Elaborate.hs+formatted 91f9a262eab1 idris-1.3.4/src/Idris/Core/Evaluate.hs+formatted 248e1a132506 idris-1.3.4/src/Idris/Core/Execute.hs+formatted 6b1accf65b3b idris-1.3.4/src/Idris/Core/ProofState.hs+formatted 3c7bae0176ad idris-1.3.4/src/Idris/Core/ProofTerm.hs+formatted 230ce006aa2f idris-1.3.4/src/Idris/Core/TT.hs+formatted 418dc775272d idris-1.3.4/src/Idris/Core/Typecheck.hs+formatted 1125cc1a59f1 idris-1.3.4/src/Idris/Core/Unify.hs+formatted 71eb35dcc836 idris-1.3.4/src/Idris/Core/WHNF.hs+formatted e884d58256bb idris-1.3.4/src/Idris/Coverage.hs+formatted 9c0fa0df0c99 idris-1.3.4/src/Idris/DSL.hs+formatted 4ff1e76d5e39 idris-1.3.4/src/Idris/DataOpts.hs+formatted 591136fc0c25 idris-1.3.4/src/Idris/DeepSeq.hs+formatted a47430a4c0e3 idris-1.3.4/src/Idris/Delaborate.hs+formatted d26382c2ddf7 idris-1.3.4/src/Idris/Directives.hs+formatted 2b830d08f106 idris-1.3.4/src/Idris/Docs.hs+formatted a485f5642886 idris-1.3.4/src/Idris/Docstrings.hs+formatted b2d1eec4cfbd idris-1.3.4/src/Idris/Elab/AsPat.hs+formatted 6388538eb9c9 idris-1.3.4/src/Idris/Elab/Clause.hs+formatted 9e5c2909e062 idris-1.3.4/src/Idris/Elab/Data.hs+formatted 82554cd8b109 idris-1.3.4/src/Idris/Elab/Implementation.hs+formatted 3983268f06e4 idris-1.3.4/src/Idris/Elab/Interface.hs+formatted 7c5f6b45e740 idris-1.3.4/src/Idris/Elab/Provider.hs+formatted 432315b423c7 idris-1.3.4/src/Idris/Elab/Quasiquote.hs+formatted 229f49cf1c9d idris-1.3.4/src/Idris/Elab/Record.hs+formatted 967c221efde2 idris-1.3.4/src/Idris/Elab/Rewrite.hs+formatted c43e0233a370 idris-1.3.4/src/Idris/Elab/RunElab.hs+formatted 89d365a14a2b idris-1.3.4/src/Idris/Elab/Term.hs+formatted 0883dc0ae293 idris-1.3.4/src/Idris/Elab/Transform.hs+formatted 26f6a53369bb idris-1.3.4/src/Idris/Elab/Type.hs+formatted 0e0ed355579b idris-1.3.4/src/Idris/Elab/Utils.hs+formatted 9f4ab880839f idris-1.3.4/src/Idris/Elab/Value.hs+formatted 1216ba79966f idris-1.3.4/src/Idris/ElabDecls.hs+formatted 68025bd6dc21 idris-1.3.4/src/Idris/Erasure.hs+formatted 7c4b0ef95bf4 idris-1.3.4/src/Idris/ErrReverse.hs+formatted 28314a1db8cc idris-1.3.4/src/Idris/Error.hs+formatted 21bcb871fca8 idris-1.3.4/src/Idris/Help.hs+formatted ad762fec9411 idris-1.3.4/src/Idris/IBC.hs+formatted cce75249d4d5 idris-1.3.4/src/Idris/IdeMode.hs+formatted 0c615974bec1 idris-1.3.4/src/Idris/IdrisDoc.hs+formatted 8b7f62814233 idris-1.3.4/src/Idris/Imports.hs+formatted 3e21520569d8 idris-1.3.4/src/Idris/Info.hs+formatted 90f54928d9ca idris-1.3.4/src/Idris/Info/Show.hs+formatted eb72f451c8f1 idris-1.3.4/src/Idris/Inliner.hs+formatted 98284ea4cd70 idris-1.3.4/src/Idris/Interactive.hs+formatted e0647767ec17 idris-1.3.4/src/Idris/Main.hs+formatted c79bede9bfeb idris-1.3.4/src/Idris/ModeCommon.hs+formatted 28bd80263c16 idris-1.3.4/src/Idris/Options.hs+formatted 3a608b013c4d idris-1.3.4/src/Idris/Output.hs+formatted 7b5bdcbe0f57 idris-1.3.4/src/Idris/Package.hs+formatted 2a5fae85b8c9 idris-1.3.4/src/Idris/Package/Common.hs+formatted 2bcb2e55e8aa idris-1.3.4/src/Idris/Package/Parser.hs+formatted b45be2cdbede idris-1.3.4/src/Idris/Parser.hs+formatted d28684b909dc idris-1.3.4/src/Idris/Parser/Data.hs+formatted da61e7dddf50 idris-1.3.4/src/Idris/Parser/Expr.hs+formatted 656292b222ab idris-1.3.4/src/Idris/Parser/Helpers.hs+formatted 00297a830b2d idris-1.3.4/src/Idris/Parser/Ops.hs+formatted 5182dd3b924f idris-1.3.4/src/Idris/Parser/Stack.hs+formatted 4873bf37b5fc idris-1.3.4/src/Idris/PartialEval.hs+formatted 58ad84ded5d8 idris-1.3.4/src/Idris/Primitives.hs+formatted 55a7e58fbd43 idris-1.3.4/src/Idris/ProofSearch.hs+formatted d74d60292062 idris-1.3.4/src/Idris/Prover.hs+formatted b2ed059dd3da idris-1.3.4/src/Idris/Providers.hs+formatted b8a3a757c0ca idris-1.3.4/src/Idris/REPL.hs+formatted d43671c3f627 idris-1.3.4/src/Idris/REPL/Browse.hs+formatted adeb73659e58 idris-1.3.4/src/Idris/REPL/Commands.hs+formatted 73f3c0c7bf6c idris-1.3.4/src/Idris/REPL/Parser.hs+formatted 9d0eae88a108 idris-1.3.4/src/Idris/Reflection.hs+formatted a069b8d050ff idris-1.3.4/src/Idris/Termination.hs+formatted 6837e439e7d6 idris-1.3.4/src/Idris/Transforms.hs+formatted a10eb7eb6eb8 idris-1.3.4/src/Idris/TypeSearch.hs+formatted efed23bf7411 idris-1.3.4/src/Idris/Unlit.hs+formatted b613b7be20de idris-1.3.4/src/Idris/WhoCalls.hs+declined - idris-1.3.4/src/Util/DynamicLinker.hs+formatted 038d72b760c3 idris-1.3.4/src/Util/Net.hs+formatted f47f361e150a idris-1.3.4/src/Util/Pretty.hs+formatted 13363649406c idris-1.3.4/src/Util/ScreenSize.hs+formatted 7d39399c082d idris-1.3.4/src/Util/System.hs+formatted 1dbb680d7054 idris-1.3.4/test/TestData.hs+formatted a31adc2b319f idris-1.3.4/test/TestRun.hs+formatted e865ae48f11b intero-0.1.40/Setup.hs+formatted 4bbbd2876ae9 intero-0.1.40/src/Completion.hs+formatted 7440e90ebfc6 intero-0.1.40/src/GhciFind.hs+partly-checked 20ef14d3e5df intero-0.1.40/src/GhciInfo.hs+formatted 7e9ae2f7b242 intero-0.1.40/src/GhciMonad.hs+formatted e7b607350a86 intero-0.1.40/src/GhciTags.hs+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+declined - 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+formatted 9b1bc79c9ca2 leksah-0.16.2.2/main/Main.hs+formatted d6d376192ba6 leksah-0.16.2.2/src/IDE/BufferMode.hs+formatted f92d6d5ed01c leksah-0.16.2.2/src/IDE/Build.hs+formatted 8362830b28ae leksah-0.16.2.2/src/IDE/Command.hs+formatted 311f46674981 leksah-0.16.2.2/src/IDE/Command/Print.hs+formatted 3587f60b8002 leksah-0.16.2.2/src/IDE/Command/VCS.hs+formatted c5a7ac7f5eb1 leksah-0.16.2.2/src/IDE/Command/VCS/Common.hs+formatted 800101f9a2a4 leksah-0.16.2.2/src/IDE/Command/VCS/Common/GUI.hs+formatted 84a0ff8c4900 leksah-0.16.2.2/src/IDE/Command/VCS/Common/Helper.hs+formatted 8615cfe9c636 leksah-0.16.2.2/src/IDE/Command/VCS/Common/Workspaces.hs+formatted 703e291d1e3f leksah-0.16.2.2/src/IDE/Command/VCS/GIT.hs+formatted 5bebaffe9dd2 leksah-0.16.2.2/src/IDE/Command/VCS/Mercurial.hs+formatted bd58623b7bee leksah-0.16.2.2/src/IDE/Command/VCS/SVN.hs+formatted 092138f05183 leksah-0.16.2.2/src/IDE/Command/VCS/Types.hs+formatted a448596691a1 leksah-0.16.2.2/src/IDE/Completion.hs+formatted 3c38d16ac03e leksah-0.16.2.2/src/IDE/Core/State.hs+formatted 4192db73165d leksah-0.16.2.2/src/IDE/Core/Types.hs+formatted c997e6f71ffb leksah-0.16.2.2/src/IDE/Debug.hs+does-not-parse - leksah-0.16.2.2/src/IDE/Find.hs+formatted ce97dab05a0d leksah-0.16.2.2/src/IDE/GUIHistory.hs+formatted 8f069cee943e leksah-0.16.2.2/src/IDE/HLint.hs+formatted d257bd397599 leksah-0.16.2.2/src/IDE/ImportTool.hs+formatted 9d846a900a68 leksah-0.16.2.2/src/IDE/Keymap.hs+formatted 3f0638c605cd leksah-0.16.2.2/src/IDE/LPaste.hs+formatted 7903248aba99 leksah-0.16.2.2/src/IDE/Leksah.hs+formatted 23fd13492eb9 leksah-0.16.2.2/src/IDE/LogRef.hs+formatted ca5d19c20d5c leksah-0.16.2.2/src/IDE/Metainfo/Provider.hs+formatted 68ab2c0137cc leksah-0.16.2.2/src/IDE/NotebookFlipper.hs+formatted d441d0417158 leksah-0.16.2.2/src/IDE/OSX.hs+formatted a720dde570ba leksah-0.16.2.2/src/IDE/Package.hs+formatted 59c82086f3fb leksah-0.16.2.2/src/IDE/Pane/Breakpoints.hs+formatted 3b9a25799eee leksah-0.16.2.2/src/IDE/Pane/Errors.hs+formatted c3bd99376237 leksah-0.16.2.2/src/IDE/Pane/Files.hs+formatted eaeecabefb74 leksah-0.16.2.2/src/IDE/Pane/Grep.hs+formatted 776709b4edac leksah-0.16.2.2/src/IDE/Pane/HLint.hs+formatted fc1b596b6aca leksah-0.16.2.2/src/IDE/Pane/Info.hs+formatted f3eae8aa0577 leksah-0.16.2.2/src/IDE/Pane/Log.hs+formatted 46903fd63785 leksah-0.16.2.2/src/IDE/Pane/Modules.hs+broken 49647b5943cd leksah-0.16.2.2/src/IDE/Pane/PackageEditor.hs+formatted 0d756eaf206d leksah-0.16.2.2/src/IDE/Pane/PackageFlags.hs+formatted 47d0e3537432 leksah-0.16.2.2/src/IDE/Pane/Search.hs+formatted 2b12c871920e leksah-0.16.2.2/src/IDE/Pane/SourceBuffer.hs+formatted f60ebab7323c leksah-0.16.2.2/src/IDE/Pane/Trace.hs+formatted d1243f6e2cb2 leksah-0.16.2.2/src/IDE/Pane/Variables.hs+formatted 10d80ccd68e9 leksah-0.16.2.2/src/IDE/Pane/WebKit/Documentation.hs+formatted f066058beef4 leksah-0.16.2.2/src/IDE/Pane/WebKit/Inspect.hs+formatted c747b2fb58a0 leksah-0.16.2.2/src/IDE/Pane/WebKit/Output.hs+formatted b4a06836dbcf leksah-0.16.2.2/src/IDE/Pane/Workspace.hs+formatted 33a766cc1c7d leksah-0.16.2.2/src/IDE/PaneGroups.hs+formatted 21c053af24d4 leksah-0.16.2.2/src/IDE/Preferences.hs+formatted 2f0f2284081d leksah-0.16.2.2/src/IDE/Session.hs+formatted 277f211ae71b leksah-0.16.2.2/src/IDE/SourceCandy.hs+formatted 95169d9d3f63 leksah-0.16.2.2/src/IDE/Statusbar.hs+formatted 70eb7c99746e leksah-0.16.2.2/src/IDE/SymbolNavigation.hs+formatted 265b135c829e leksah-0.16.2.2/src/IDE/TextEditor.hs+formatted b345661c1e07 leksah-0.16.2.2/src/IDE/TextEditor/Class.hs+formatted 341ec1727c7d leksah-0.16.2.2/src/IDE/TextEditor/CodeMirror.hs+formatted 8d9cbb5030a9 leksah-0.16.2.2/src/IDE/TextEditor/GtkSourceView.hs+formatted 668535f1f6ff leksah-0.16.2.2/src/IDE/TextEditor/Yi.hs+formatted c73baf7194c2 leksah-0.16.2.2/src/IDE/TextEditor/Yi/Config.hs+formatted 007fe37642f2 leksah-0.16.2.2/src/IDE/Utils/CabalUtils.hs+formatted a1e35678dab5 leksah-0.16.2.2/src/IDE/Utils/DirectoryUtils.hs+formatted fbdb61765ca2 leksah-0.16.2.2/src/IDE/Utils/ExternalTool.hs+formatted f82cd3575fb1 leksah-0.16.2.2/src/IDE/Utils/GUIUtils.hs+formatted dba5fad6d1d6 leksah-0.16.2.2/src/IDE/Utils/ServerConnection.hs+formatted 889365128863 leksah-0.16.2.2/src/IDE/Workspaces.hs+formatted 1a17606cf12b leksah-0.16.2.2/src/IDE/Workspaces/Writer.hs+formatted 0c3ca0ef251f lens-5.3.6/benchmarks/alongside.hs+formatted 5a0e24f56d19 lens-5.3.6/benchmarks/folds.hs+formatted a5e826be2e18 lens-5.3.6/benchmarks/plated.hs+formatted 91de2eafe033 lens-5.3.6/benchmarks/traversals.hs+formatted cf0afb8efdca 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 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+broken 6f66b6321d8b 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+formatted 45285718981c lens-5.3.6/src/Control/Lens/Cons.hs+formatted 087aa6536345 lens-5.3.6/src/Control/Lens/Each.hs+formatted db06507f8eb3 lens-5.3.6/src/Control/Lens/Empty.hs+formatted afba13ca40b2 lens-5.3.6/src/Control/Lens/Equality.hs+formatted e63ce52c62a6 lens-5.3.6/src/Control/Lens/Extras.hs+formatted bc07f01d16f1 lens-5.3.6/src/Control/Lens/Fold.hs+formatted 1d6b4529afae lens-5.3.6/src/Control/Lens/Getter.hs+formatted be96a32da04a lens-5.3.6/src/Control/Lens/Indexed.hs+formatted f2b77c23d24e lens-5.3.6/src/Control/Lens/Internal.hs+formatted ef704ee92ff4 lens-5.3.6/src/Control/Lens/Internal/Bazaar.hs+formatted 77d72de128e9 lens-5.3.6/src/Control/Lens/Internal/ByteString.hs+formatted d8ca8cef6fef lens-5.3.6/src/Control/Lens/Internal/CTypes.hs+formatted baf096fc8d0a lens-5.3.6/src/Control/Lens/Internal/Context.hs+formatted a6d8f75d39fc lens-5.3.6/src/Control/Lens/Internal/Deque.hs+formatted 4c63a54a8aeb lens-5.3.6/src/Control/Lens/Internal/Doctest.hs+formatted 36dfae32602b lens-5.3.6/src/Control/Lens/Internal/Exception.hs+formatted a7d4a6263d7d lens-5.3.6/src/Control/Lens/Internal/FieldTH.hs+formatted 0bf84e037423 lens-5.3.6/src/Control/Lens/Internal/Fold.hs+formatted 9d8c7d9a024a lens-5.3.6/src/Control/Lens/Internal/Getter.hs+formatted 76d7f11378f9 lens-5.3.6/src/Control/Lens/Internal/Indexed.hs+formatted 74a115066cae lens-5.3.6/src/Control/Lens/Internal/Instances.hs+formatted a9257a233659 lens-5.3.6/src/Control/Lens/Internal/Iso.hs+formatted 6790556bd514 lens-5.3.6/src/Control/Lens/Internal/Level.hs+formatted 929b3db19b16 lens-5.3.6/src/Control/Lens/Internal/List.hs+formatted eae79aadfa29 lens-5.3.6/src/Control/Lens/Internal/Magma.hs+formatted e8fad9977f5a lens-5.3.6/src/Control/Lens/Internal/Prelude.hs+formatted d033545bb0fa lens-5.3.6/src/Control/Lens/Internal/Prism.hs+formatted 4dffbb5256da lens-5.3.6/src/Control/Lens/Internal/PrismTH.hs+formatted a529e2b12e5a lens-5.3.6/src/Control/Lens/Internal/Profunctor.hs+formatted a0cfb7f64915 lens-5.3.6/src/Control/Lens/Internal/Review.hs+formatted bd611b570342 lens-5.3.6/src/Control/Lens/Internal/Setter.hs+formatted cb94f36001d0 lens-5.3.6/src/Control/Lens/Internal/TH.hs+formatted 962f8a77a69c lens-5.3.6/src/Control/Lens/Internal/Zoom.hs+formatted 4d4a8b86f259 lens-5.3.6/src/Control/Lens/Iso.hs+formatted 90c89d25de5a lens-5.3.6/src/Control/Lens/Lens.hs+formatted bde563e05b67 lens-5.3.6/src/Control/Lens/Level.hs+formatted b84cf710176f lens-5.3.6/src/Control/Lens/Operators.hs+formatted 61aef519b850 lens-5.3.6/src/Control/Lens/Plated.hs+formatted cd556da34caa lens-5.3.6/src/Control/Lens/Prism.hs+formatted b465099e5056 lens-5.3.6/src/Control/Lens/Profunctor.hs+formatted f12a4f9ff0a9 lens-5.3.6/src/Control/Lens/Reified.hs+formatted 6e871d8e4385 lens-5.3.6/src/Control/Lens/Review.hs+formatted 5f1a95d65c20 lens-5.3.6/src/Control/Lens/Setter.hs+formatted dcdba8e5777c lens-5.3.6/src/Control/Lens/TH.hs+formatted e1d252b2bb3a lens-5.3.6/src/Control/Lens/Traversal.hs+formatted 3a5cbb2c959c lens-5.3.6/src/Control/Lens/Tuple.hs+formatted 181a647a9c7b lens-5.3.6/src/Control/Lens/Type.hs+formatted ff8881502434 lens-5.3.6/src/Control/Lens/Unsound.hs+declined - lens-5.3.6/src/Control/Lens/Wrapped.hs+formatted 2c3a223dec39 lens-5.3.6/src/Control/Lens/Zoom.hs+formatted d04fd074c74d lens-5.3.6/src/Control/Monad/Error/Lens.hs+formatted b9bfa6cc2ae6 lens-5.3.6/src/Control/Parallel/Strategies/Lens.hs+formatted 3580c9fdbe74 lens-5.3.6/src/Control/Seq/Lens.hs+formatted ae1408607f92 lens-5.3.6/src/Data/Array/Lens.hs+formatted 4f2a2066b52a lens-5.3.6/src/Data/Bits/Lens.hs+formatted e1c3ede72b89 lens-5.3.6/src/Data/ByteString/Lazy/Lens.hs+formatted fd83b8412797 lens-5.3.6/src/Data/ByteString/Lens.hs+formatted a0beda949826 lens-5.3.6/src/Data/ByteString/Strict/Lens.hs+formatted e7fc0d3b8334 lens-5.3.6/src/Data/Complex/Lens.hs+formatted dab824fea092 lens-5.3.6/src/Data/Data/Lens.hs+formatted ae776c45408a lens-5.3.6/src/Data/Dynamic/Lens.hs+formatted 9817c7fd06d9 lens-5.3.6/src/Data/HashSet/Lens.hs+formatted 9b6a7ea1de9a lens-5.3.6/src/Data/IntSet/Lens.hs+formatted afd0c52fb1bb lens-5.3.6/src/Data/List/Lens.hs+formatted c78898aaa504 lens-5.3.6/src/Data/Map/Lens.hs+formatted bf33871e79d3 lens-5.3.6/src/Data/Sequence/Lens.hs+formatted 3b630e1120f0 lens-5.3.6/src/Data/Set/Lens.hs+formatted 6abbc5ff2a97 lens-5.3.6/src/Data/Text/Lazy/Lens.hs+formatted c144e0a2b4d7 lens-5.3.6/src/Data/Text/Lens.hs+formatted 5ce20871a8d2 lens-5.3.6/src/Data/Text/Strict/Lens.hs+formatted a4a006800f1d lens-5.3.6/src/Data/Tree/Lens.hs+formatted bfb9f14912e5 lens-5.3.6/src/Data/Typeable/Lens.hs+formatted fa5b2f903156 lens-5.3.6/src/Data/Vector/Generic/Lens.hs+formatted 4348b84e4ed7 lens-5.3.6/src/Data/Vector/Lens.hs+formatted 7e80fcd30b07 lens-5.3.6/src/GHC/Generics/Lens.hs+declined - lens-5.3.6/src/Language/Haskell/TH/Lens.hs+formatted 6142187a095c lens-5.3.6/src/Numeric/Lens.hs+formatted 11d5331927be lens-5.3.6/src/Numeric/Natural/Lens.hs+formatted 353cf4551a49 lens-5.3.6/src/System/Exit/Lens.hs+formatted 5a4f7cf6359b lens-5.3.6/src/System/FilePath/Lens.hs+formatted e8fab2c360dd 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 b4be82b75781 lens-5.3.6/tests/T799.hs+formatted f9a61b457a6c lens-5.3.6/tests/T917.hs+formatted c8d456a949a1 lens-5.3.6/tests/T972.hs+formatted 1e9429a79aca lens-5.3.6/tests/doctests.hs+formatted cc78a4a446ba lens-5.3.6/tests/hunit.hs+declined - lens-5.3.6/tests/properties.hs+formatted 411e9ff9fd4b lens-5.3.6/tests/templates.hs+formatted 8e582508019b megaparsec-9.8.1/Text/Megaparsec.hs+formatted aaf0968c72cf megaparsec-9.8.1/Text/Megaparsec/Byte.hs+formatted af93162c0732 megaparsec-9.8.1/Text/Megaparsec/Byte/Binary.hs+formatted 6daebd54878b megaparsec-9.8.1/Text/Megaparsec/Byte/Lexer.hs+formatted a8f12808d592 megaparsec-9.8.1/Text/Megaparsec/Char.hs+formatted fb0aa0491a35 megaparsec-9.8.1/Text/Megaparsec/Char/Lexer.hs+formatted 9ada7619d986 megaparsec-9.8.1/Text/Megaparsec/Class.hs+formatted 04c41e5e9d68 megaparsec-9.8.1/Text/Megaparsec/Common.hs+formatted 56cf25afe110 megaparsec-9.8.1/Text/Megaparsec/Debug.hs+formatted 2a0ab69a0154 megaparsec-9.8.1/Text/Megaparsec/Error.hs+formatted 6dc9b6ce5897 megaparsec-9.8.1/Text/Megaparsec/Error.hs-boot+formatted 92e848d5b88d megaparsec-9.8.1/Text/Megaparsec/Error/Builder.hs+formatted ef8c030d6d02 megaparsec-9.8.1/Text/Megaparsec/Internal.hs+formatted 2d845f6be8a2 megaparsec-9.8.1/Text/Megaparsec/Internal.hs-boot+formatted fb54b4f4cab3 megaparsec-9.8.1/Text/Megaparsec/Lexer.hs+formatted 0db88dbc985e megaparsec-9.8.1/Text/Megaparsec/Pos.hs+formatted 4f1b6ce7ca12 megaparsec-9.8.1/Text/Megaparsec/State.hs+formatted 1391285f39da megaparsec-9.8.1/Text/Megaparsec/Stream.hs+formatted 5e21ab523a4c megaparsec-9.8.1/Text/Megaparsec/Unicode.hs+formatted 882124e5ceb6 megaparsec-9.8.1/bench/memory/Main.hs+formatted d8a32e7340de megaparsec-9.8.1/bench/speed/Main.hs+formatted e865ae48f11b microlens-0.5.0.0/Setup.hs+declined - microlens-0.5.0.0/src/Lens/Micro.hs+formatted a33fe5ffd3d9 microlens-0.5.0.0/src/Lens/Micro/Extras.hs+formatted 3608b82ef46d microlens-0.5.0.0/src/Lens/Micro/FieldN.hs+declined - microlens-0.5.0.0/src/Lens/Micro/Internal.hs+formatted de09492cc927 microlens-0.5.0.0/src/Lens/Micro/Type.hs+formatted 9fd4d8759261 mtl-2.3.2/Control/Monad/Accum.hs+formatted 1c966453ae10 mtl-2.3.2/Control/Monad/Cont.hs+formatted 6543a3adf1ee mtl-2.3.2/Control/Monad/Cont/Class.hs+formatted a1002896353b mtl-2.3.2/Control/Monad/Error/Class.hs+formatted 241b9ab5b29e mtl-2.3.2/Control/Monad/Except.hs+formatted fae093b03648 mtl-2.3.2/Control/Monad/Identity.hs+formatted 8bb64ac32001 mtl-2.3.2/Control/Monad/RWS.hs+formatted f59a78122b11 mtl-2.3.2/Control/Monad/RWS/CPS.hs+formatted 853a42d0a7d0 mtl-2.3.2/Control/Monad/RWS/Class.hs+formatted 6fedd348f84f mtl-2.3.2/Control/Monad/RWS/Lazy.hs+formatted ddc740ed2ba9 mtl-2.3.2/Control/Monad/RWS/Strict.hs+formatted 70448da6c08e mtl-2.3.2/Control/Monad/Reader.hs+formatted 048f1d41ceeb mtl-2.3.2/Control/Monad/Reader/Class.hs+formatted fda85a3d8a5b mtl-2.3.2/Control/Monad/Select.hs+formatted dbf53d8970a0 mtl-2.3.2/Control/Monad/State.hs+formatted a11cb9d9968b mtl-2.3.2/Control/Monad/State/Class.hs+formatted 297011983d2c mtl-2.3.2/Control/Monad/State/Lazy.hs+formatted 77f07f071154 mtl-2.3.2/Control/Monad/State/Strict.hs+formatted 4442f9cb2755 mtl-2.3.2/Control/Monad/Trans.hs+formatted c315c681e4a7 mtl-2.3.2/Control/Monad/Writer.hs+formatted bd34c32bca35 mtl-2.3.2/Control/Monad/Writer/CPS.hs+formatted 220119ac3010 mtl-2.3.2/Control/Monad/Writer/Class.hs+formatted 26c1b816de3a mtl-2.3.2/Control/Monad/Writer/Lazy.hs+formatted e5a4e79a643b mtl-2.3.2/Control/Monad/Writer/Strict.hs+formatted e865ae48f11b mtl-2.3.2/Setup.hs+formatted 9007a7528d49 optics-0.4.2.1/benchmarks/folds.hs+formatted 6819e713d7fd optics-0.4.2.1/benchmarks/traversals.hs+formatted 39c6a1f9e980 optics-0.4.2.1/src/Optics.hs+formatted fbb3a44aca1a optics-0.4.2.1/tests/Optics/Tests.hs+formatted c6d811f3b338 optics-0.4.2.1/tests/Optics/Tests/Computation.hs+formatted 26a0cf8a6c0d optics-0.4.2.1/tests/Optics/Tests/Core.hs+formatted 714f321c1085 optics-0.4.2.1/tests/Optics/Tests/Eta.hs+formatted 1fbb1734b1b2 optics-0.4.2.1/tests/Optics/Tests/Labels/Generic.hs+formatted 0d08d0986a64 optics-0.4.2.1/tests/Optics/Tests/Labels/TH.hs+formatted 1ec08bb9f22e optics-0.4.2.1/tests/Optics/Tests/Misc.hs+formatted 9a4b74c6e2a0 optics-0.4.2.1/tests/Optics/Tests/Properties.hs+declined - optics-0.4.2.1/tests/Optics/Tests/Utils.hs+formatted e865ae48f11b optparse-applicative-0.19.0.0/Setup.hs+formatted 64905439cdc6 optparse-applicative-0.19.0.0/src/Options/Applicative.hs+formatted c906682e4329 optparse-applicative-0.19.0.0/src/Options/Applicative/Arrows.hs+formatted fa5bdd86f120 optparse-applicative-0.19.0.0/src/Options/Applicative/BashCompletion.hs+formatted fdefdf302889 optparse-applicative-0.19.0.0/src/Options/Applicative/Builder.hs+formatted b35877965cca optparse-applicative-0.19.0.0/src/Options/Applicative/Builder/Completer.hs+formatted 86de039c8195 optparse-applicative-0.19.0.0/src/Options/Applicative/Builder/Internal.hs+formatted 2677a4207b59 optparse-applicative-0.19.0.0/src/Options/Applicative/Common.hs+formatted e2a26a2c39e5 optparse-applicative-0.19.0.0/src/Options/Applicative/Extra.hs+formatted 02404b06b751 optparse-applicative-0.19.0.0/src/Options/Applicative/Help.hs+formatted 309f18523f28 optparse-applicative-0.19.0.0/src/Options/Applicative/Help/Chunk.hs+formatted 71aeb73c7d0a optparse-applicative-0.19.0.0/src/Options/Applicative/Help/Core.hs+formatted c6289fc77a0b optparse-applicative-0.19.0.0/src/Options/Applicative/Help/Levenshtein.hs+formatted dbad440603b5 optparse-applicative-0.19.0.0/src/Options/Applicative/Help/Pretty.hs+formatted ea64d277c8d8 optparse-applicative-0.19.0.0/src/Options/Applicative/Help/Types.hs+formatted 5f19dd3bfbfc optparse-applicative-0.19.0.0/src/Options/Applicative/Internal.hs+formatted cfaae94bf094 optparse-applicative-0.19.0.0/src/Options/Applicative/NonEmpty.hs+formatted 0375c798d3bc optparse-applicative-0.19.0.0/src/Options/Applicative/Types.hs+formatted 88e47dac52ad optparse-applicative-0.19.0.0/tests/Examples/Alternatives.hs+formatted 9cdd4cffe98a optparse-applicative-0.19.0.0/tests/Examples/Cabal.hs+formatted 6eb87c31763d optparse-applicative-0.19.0.0/tests/Examples/Commands.hs+formatted 3e7e8c6885db optparse-applicative-0.19.0.0/tests/Examples/Formatting.hs+formatted 63619af33822 optparse-applicative-0.19.0.0/tests/Examples/Hello.hs+formatted 515fef001627 optparse-applicative-0.19.0.0/tests/Examples/LongSub.hs+formatted c2e700c8f642 optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/AllGrouped.hs+formatted f5ab674c163c optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/Basic.hs+formatted dbff3ca47a7d optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/CommandGroups.hs+formatted 87c22c856d69 optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/DuplicateCommandGroups.hs+formatted ded6a73332cc optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/Duplicates.hs+formatted 8ea0fc79c8f6 optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/Nested.hs+formatted 25bcbf4b701f optparse-applicative-0.19.0.0/tests/test.hs+formatted 037d20016ff3 pandoc-3.10.2/benchmark/benchmark-pandoc.hs+formatted e9cc6bbe8397 pandoc-3.10.2/src/Text/Pandoc.hs+formatted 45884709d219 pandoc-3.10.2/src/Text/Pandoc/App.hs+formatted 2a51cd540ed5 pandoc-3.10.2/src/Text/Pandoc/App/CommandLineOptions.hs+formatted 5c6f2514f305 pandoc-3.10.2/src/Text/Pandoc/App/Input.hs+formatted 87ef6eb61ae6 pandoc-3.10.2/src/Text/Pandoc/App/Opt.hs+formatted 3a8ec3e92f62 pandoc-3.10.2/src/Text/Pandoc/App/OutputSettings.hs+formatted 30536e2da049 pandoc-3.10.2/src/Text/Pandoc/Asciify.hs+formatted 0798d787f37f pandoc-3.10.2/src/Text/Pandoc/CSS.hs+formatted eb9916b55f28 pandoc-3.10.2/src/Text/Pandoc/CSV.hs+formatted 425285a86e63 pandoc-3.10.2/src/Text/Pandoc/Char.hs+formatted 16a677692492 pandoc-3.10.2/src/Text/Pandoc/Chunks.hs+formatted dd27f0bb68e4 pandoc-3.10.2/src/Text/Pandoc/Citeproc.hs+formatted 73b49670ac75 pandoc-3.10.2/src/Text/Pandoc/Citeproc/BibTeX.hs+formatted f4a7c604316e pandoc-3.10.2/src/Text/Pandoc/Citeproc/CslJson.hs+formatted a47804651b9d pandoc-3.10.2/src/Text/Pandoc/Citeproc/Data.hs+formatted 53e47a128316 pandoc-3.10.2/src/Text/Pandoc/Citeproc/Locator.hs+formatted f41105d87bc7 pandoc-3.10.2/src/Text/Pandoc/Citeproc/MetaValue.hs+formatted a318c7f44fea pandoc-3.10.2/src/Text/Pandoc/Citeproc/Name.hs+formatted 76559347a97c pandoc-3.10.2/src/Text/Pandoc/Citeproc/Util.hs+formatted 1b13d0dc5e1b pandoc-3.10.2/src/Text/Pandoc/Class.hs+formatted 121629e38e36 pandoc-3.10.2/src/Text/Pandoc/Class/CommonState.hs+formatted 27b0d8ea4952 pandoc-3.10.2/src/Text/Pandoc/Class/IO.hs+formatted 554e3fd3f722 pandoc-3.10.2/src/Text/Pandoc/Class/PandocIO.hs+formatted f986b2d26417 pandoc-3.10.2/src/Text/Pandoc/Class/PandocMonad.hs+formatted 7ef781658145 pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs+formatted 6704a4c38841 pandoc-3.10.2/src/Text/Pandoc/Class/Sandbox.hs+formatted 407b6ea8dcf3 pandoc-3.10.2/src/Text/Pandoc/Data.hs+formatted a40ce7ee511d pandoc-3.10.2/src/Text/Pandoc/Data/BakedIn.hs+formatted 58434b0c4602 pandoc-3.10.2/src/Text/Pandoc/Emoji.hs+formatted b6a210497f11 pandoc-3.10.2/src/Text/Pandoc/Error.hs+formatted 72ff19ca80f5 pandoc-3.10.2/src/Text/Pandoc/Extensions.hs+formatted 3bdc8aed022b pandoc-3.10.2/src/Text/Pandoc/Filter.hs+formatted 1be979d2afbf pandoc-3.10.2/src/Text/Pandoc/Filter/Environment.hs+formatted 3921a2426b07 pandoc-3.10.2/src/Text/Pandoc/Filter/JSON.hs+formatted 47f670c3a0ba pandoc-3.10.2/src/Text/Pandoc/Format.hs+formatted 3df0ace70613 pandoc-3.10.2/src/Text/Pandoc/Highlighting.hs+formatted 834edab63758 pandoc-3.10.2/src/Text/Pandoc/Image.hs+formatted fd7cafba4cb8 pandoc-3.10.2/src/Text/Pandoc/ImageSize.hs+formatted 2aebfb9a4784 pandoc-3.10.2/src/Text/Pandoc/Logging.hs+formatted 198eaaad0ea2 pandoc-3.10.2/src/Text/Pandoc/MIME.hs+formatted fc58bac11b5e pandoc-3.10.2/src/Text/Pandoc/MediaBag.hs+formatted cd7ca82c574c pandoc-3.10.2/src/Text/Pandoc/Options.hs+formatted d4caa78b9b84 pandoc-3.10.2/src/Text/Pandoc/PDF.hs+formatted 1378d4b80344 pandoc-3.10.2/src/Text/Pandoc/Parsing.hs+formatted d0bfe0ebb5ca pandoc-3.10.2/src/Text/Pandoc/Parsing/Capabilities.hs+formatted 78249fa68c58 pandoc-3.10.2/src/Text/Pandoc/Parsing/Citations.hs+formatted 9be74d6c3ee8 pandoc-3.10.2/src/Text/Pandoc/Parsing/Future.hs+formatted 854dc9763274 pandoc-3.10.2/src/Text/Pandoc/Parsing/General.hs+formatted ebf243a003b2 pandoc-3.10.2/src/Text/Pandoc/Parsing/GridTable.hs+formatted 6ae9fc28f92d pandoc-3.10.2/src/Text/Pandoc/Parsing/Lists.hs+formatted 957cafdf0f36 pandoc-3.10.2/src/Text/Pandoc/Parsing/Math.hs+formatted fad3834b08e5 pandoc-3.10.2/src/Text/Pandoc/Parsing/Smart.hs+formatted 3a6f9d5669d3 pandoc-3.10.2/src/Text/Pandoc/Parsing/State.hs+formatted a83effd57b53 pandoc-3.10.2/src/Text/Pandoc/Process.hs+formatted 5798ce9f1d3b pandoc-3.10.2/src/Text/Pandoc/Readers.hs+formatted b0383bb6bbf3 pandoc-3.10.2/src/Text/Pandoc/Readers/AsciiDoc.hs+formatted fb9989e02f4c pandoc-3.10.2/src/Text/Pandoc/Readers/BibTeX.hs+formatted 6df32968e0c9 pandoc-3.10.2/src/Text/Pandoc/Readers/CSV.hs+formatted 9daab54008b1 pandoc-3.10.2/src/Text/Pandoc/Readers/CommonMark.hs+formatted a342a5d39536 pandoc-3.10.2/src/Text/Pandoc/Readers/Creole.hs+formatted 9a91a657b202 pandoc-3.10.2/src/Text/Pandoc/Readers/CslJson.hs+formatted 8f06acca3961 pandoc-3.10.2/src/Text/Pandoc/Readers/Djot.hs+formatted 1d2ab70b7b4f pandoc-3.10.2/src/Text/Pandoc/Readers/DocBook.hs+formatted cf58716fb7b3 pandoc-3.10.2/src/Text/Pandoc/Readers/Docx.hs+formatted fc9009e1ca7b pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Combine.hs+formatted 2d1f14f169d4 pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Fields.hs+formatted 93c7c8635e18 pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Lists.hs+formatted bc3c2892099c pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Parse.hs+formatted cdafbece822b pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Parse/Styles.hs+formatted 59a529967b45 pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Symbols.hs+formatted bc3f39ebba02 pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Util.hs+formatted 40fc6fdc95bf pandoc-3.10.2/src/Text/Pandoc/Readers/DokuWiki.hs+formatted e7e64c311852 pandoc-3.10.2/src/Text/Pandoc/Readers/EPUB.hs+formatted f3a6089222df pandoc-3.10.2/src/Text/Pandoc/Readers/EndNote.hs+formatted 7db3a804d654 pandoc-3.10.2/src/Text/Pandoc/Readers/FB2.hs+formatted 4383de7c2335 pandoc-3.10.2/src/Text/Pandoc/Readers/HTML.hs+formatted dffd88697abd pandoc-3.10.2/src/Text/Pandoc/Readers/HTML/Parsing.hs+formatted 7906dc4b5ee7 pandoc-3.10.2/src/Text/Pandoc/Readers/HTML/Table.hs+formatted d02eee6a5e0a pandoc-3.10.2/src/Text/Pandoc/Readers/HTML/TagCategories.hs+formatted 70831845aec7 pandoc-3.10.2/src/Text/Pandoc/Readers/HTML/Types.hs+formatted eff46e987f16 pandoc-3.10.2/src/Text/Pandoc/Readers/Haddock.hs+formatted e0709d478a16 pandoc-3.10.2/src/Text/Pandoc/Readers/Ipynb.hs+formatted 3f4f03f7cb25 pandoc-3.10.2/src/Text/Pandoc/Readers/JATS.hs+formatted c7b531b762cd pandoc-3.10.2/src/Text/Pandoc/Readers/Jira.hs+formatted 6ef7e7e8a336 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX.hs+formatted 43d3ff6389de pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Citation.hs+formatted 42ef4f6efe29 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Inline.hs+formatted c4741ac43b79 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Lang.hs+formatted 7da4b015aff1 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Macro.hs+formatted 99583e0adb7e pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Math.hs+formatted a4f0a47266af pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Parsing.hs+formatted c5052708c057 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/SIunitx.hs+formatted 6cfc2c0c5f07 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Table.hs+formatted 6b532f75206a pandoc-3.10.2/src/Text/Pandoc/Readers/Man.hs+formatted a4a565478d90 pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs+formatted a22f7f9ddf30 pandoc-3.10.2/src/Text/Pandoc/Readers/Mdoc.hs+formatted d33fca4fc582 pandoc-3.10.2/src/Text/Pandoc/Readers/Mdoc/Lex.hs+formatted 728f79b431ec pandoc-3.10.2/src/Text/Pandoc/Readers/Mdoc/Macros.hs+formatted 1a3b54c227b9 pandoc-3.10.2/src/Text/Pandoc/Readers/Mdoc/Standards.hs+formatted 930a7a29e8cd pandoc-3.10.2/src/Text/Pandoc/Readers/MediaWiki.hs+formatted 3a3c4b5afb54 pandoc-3.10.2/src/Text/Pandoc/Readers/Metadata.hs+formatted fa0c9ab8ddff pandoc-3.10.2/src/Text/Pandoc/Readers/Muse.hs+formatted b5fdcc7976c0 pandoc-3.10.2/src/Text/Pandoc/Readers/Native.hs+formatted 00dc84441dee pandoc-3.10.2/src/Text/Pandoc/Readers/ODT.hs+formatted 4b763e5899cb pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Arrows/State.hs+formatted 978b213b2283 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Arrows/Utils.hs+formatted bf610e3c1650 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Base.hs+formatted 824410efced3 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/ContentReader.hs+formatted c708199aa2c5 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Generic/Fallible.hs+formatted 3cb13f8a11b2 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Generic/Namespaces.hs+formatted 6d9540eaec43 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Generic/SetMap.hs+formatted e530287347dc pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Generic/Utils.hs+formatted b9912baa7f2d pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Generic/XMLConverter.hs+formatted 32a05a5e6b5d pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Namespaces.hs+formatted 0e276b72ff84 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/StyleReader.hs+formatted fc024f0c1f5f pandoc-3.10.2/src/Text/Pandoc/Readers/OOXML/Shared.hs+formatted 567609e53504 pandoc-3.10.2/src/Text/Pandoc/Readers/OPML.hs+formatted f0c2a727f84e pandoc-3.10.2/src/Text/Pandoc/Readers/Org.hs+formatted b11790cf298d pandoc-3.10.2/src/Text/Pandoc/Readers/Org/BlockStarts.hs+formatted 5af99478081e pandoc-3.10.2/src/Text/Pandoc/Readers/Org/Blocks.hs+formatted 43bd91b13dca pandoc-3.10.2/src/Text/Pandoc/Readers/Org/DocumentTree.hs+formatted 845ce0261537 pandoc-3.10.2/src/Text/Pandoc/Readers/Org/ExportSettings.hs+formatted f91afc951ab9 pandoc-3.10.2/src/Text/Pandoc/Readers/Org/Inlines.hs+formatted 161b1ccc8ff6 pandoc-3.10.2/src/Text/Pandoc/Readers/Org/Meta.hs+formatted 721a0cf8a327 pandoc-3.10.2/src/Text/Pandoc/Readers/Org/ParserState.hs+formatted c16136fb606c pandoc-3.10.2/src/Text/Pandoc/Readers/Org/Parsing.hs+formatted 56b3882f7c5f pandoc-3.10.2/src/Text/Pandoc/Readers/Org/Shared.hs+formatted dc3e8e78c3f0 pandoc-3.10.2/src/Text/Pandoc/Readers/Pod.hs+formatted 53643fbdc8d6 pandoc-3.10.2/src/Text/Pandoc/Readers/Pptx.hs+formatted 9f0a1be15c9c pandoc-3.10.2/src/Text/Pandoc/Readers/Pptx/Parse.hs+formatted 06b32e0a02bb pandoc-3.10.2/src/Text/Pandoc/Readers/Pptx/Shapes.hs+formatted 68136f2cd896 pandoc-3.10.2/src/Text/Pandoc/Readers/Pptx/Slides.hs+formatted 2a1143e52057 pandoc-3.10.2/src/Text/Pandoc/Readers/Pptx/SmartArt.hs+formatted 546eac2a8514 pandoc-3.10.2/src/Text/Pandoc/Readers/RIS.hs+formatted 04715a4be3c2 pandoc-3.10.2/src/Text/Pandoc/Readers/RST.hs+formatted 0ee83c7814cd pandoc-3.10.2/src/Text/Pandoc/Readers/RTF.hs+formatted 955d2e3df5d4 pandoc-3.10.2/src/Text/Pandoc/Readers/Roff.hs+formatted a8d91c97594d pandoc-3.10.2/src/Text/Pandoc/Readers/Roff/Escape.hs+formatted 38145b00e92b pandoc-3.10.2/src/Text/Pandoc/Readers/TWiki.hs+formatted a6cf06abeac2 pandoc-3.10.2/src/Text/Pandoc/Readers/Textile.hs+formatted 64ebaf0c8d6d pandoc-3.10.2/src/Text/Pandoc/Readers/TikiWiki.hs+formatted 00edc33e277f pandoc-3.10.2/src/Text/Pandoc/Readers/Txt2Tags.hs+formatted 9dbc78144769 pandoc-3.10.2/src/Text/Pandoc/Readers/Typst.hs+formatted 2f111f50b7d1 pandoc-3.10.2/src/Text/Pandoc/Readers/Typst/Math.hs+formatted 45263032cedf pandoc-3.10.2/src/Text/Pandoc/Readers/Typst/Parsing.hs+formatted b3509cf614af pandoc-3.10.2/src/Text/Pandoc/Readers/Vimwiki.hs+formatted 5b0aec20be18 pandoc-3.10.2/src/Text/Pandoc/Readers/XML.hs+formatted 6da1519e9667 pandoc-3.10.2/src/Text/Pandoc/Readers/Xlsx.hs+formatted 835a84d727ab pandoc-3.10.2/src/Text/Pandoc/Readers/Xlsx/Cells.hs+formatted da7c96257b3c pandoc-3.10.2/src/Text/Pandoc/Readers/Xlsx/Parse.hs+formatted cec0a64a8f3d pandoc-3.10.2/src/Text/Pandoc/Readers/Xlsx/Sheets.hs+formatted a3abe5c4303a pandoc-3.10.2/src/Text/Pandoc/RoffChar.hs+formatted 3b2c2c8b4a58 pandoc-3.10.2/src/Text/Pandoc/Scripting.hs+formatted 9a1066febe5c pandoc-3.10.2/src/Text/Pandoc/SelfContained.hs+formatted 31da664c4c88 pandoc-3.10.2/src/Text/Pandoc/Shared.hs+formatted 172e62890a2c pandoc-3.10.2/src/Text/Pandoc/Slides.hs+formatted fac36a909e04 pandoc-3.10.2/src/Text/Pandoc/Sources.hs+formatted 4723b914e051 pandoc-3.10.2/src/Text/Pandoc/TeX.hs+formatted b778b3bd0b9d pandoc-3.10.2/src/Text/Pandoc/Templates.hs+formatted e7f689faf2da pandoc-3.10.2/src/Text/Pandoc/Transforms.hs+formatted fbd643d9a8d0 pandoc-3.10.2/src/Text/Pandoc/Translations.hs+formatted de44be6d90ad pandoc-3.10.2/src/Text/Pandoc/Translations/Types.hs+formatted e8b9d88b67b0 pandoc-3.10.2/src/Text/Pandoc/URI.hs+formatted 4aa82cbc83c8 pandoc-3.10.2/src/Text/Pandoc/UTF8.hs+formatted e958a4d78635 pandoc-3.10.2/src/Text/Pandoc/UUID.hs+formatted c4b212f4e18f pandoc-3.10.2/src/Text/Pandoc/Version.hs+formatted 64127df72dfc pandoc-3.10.2/src/Text/Pandoc/Writers.hs+formatted eb7cc09ed150 pandoc-3.10.2/src/Text/Pandoc/Writers/ANSI.hs+formatted a5a598c6ebd6 pandoc-3.10.2/src/Text/Pandoc/Writers/AnnotatedTable.hs+formatted a752406eebfa pandoc-3.10.2/src/Text/Pandoc/Writers/AsciiDoc.hs+formatted 9f7f40cd3260 pandoc-3.10.2/src/Text/Pandoc/Writers/BBCode.hs+formatted 74bebaa57c03 pandoc-3.10.2/src/Text/Pandoc/Writers/BibTeX.hs+formatted c3a3e99a6a7b pandoc-3.10.2/src/Text/Pandoc/Writers/Blaze.hs+formatted 2afa2a035da6 pandoc-3.10.2/src/Text/Pandoc/Writers/ChunkedHTML.hs+formatted 936b3d7e333a pandoc-3.10.2/src/Text/Pandoc/Writers/CommonMark.hs+formatted 5380c20c8b47 pandoc-3.10.2/src/Text/Pandoc/Writers/ConTeXt.hs+formatted d9b0707d098c pandoc-3.10.2/src/Text/Pandoc/Writers/CslJson.hs+formatted 22ad2f699b3c pandoc-3.10.2/src/Text/Pandoc/Writers/Djot.hs+formatted 45e80a32da2f pandoc-3.10.2/src/Text/Pandoc/Writers/DocBook.hs+formatted f9b453669273 pandoc-3.10.2/src/Text/Pandoc/Writers/Docx.hs+formatted 178a9f4e8f5b pandoc-3.10.2/src/Text/Pandoc/Writers/Docx/OpenXML.hs+formatted 3c521e018180 pandoc-3.10.2/src/Text/Pandoc/Writers/Docx/StyleMap.hs+formatted e75d942f93e2 pandoc-3.10.2/src/Text/Pandoc/Writers/Docx/Table.hs+formatted c18d8fc12f6b pandoc-3.10.2/src/Text/Pandoc/Writers/Docx/Types.hs+formatted 1a9e5464ba71 pandoc-3.10.2/src/Text/Pandoc/Writers/DokuWiki.hs+formatted e2c1380dcce6 pandoc-3.10.2/src/Text/Pandoc/Writers/EPUB.hs+formatted 77cb32a02d14 pandoc-3.10.2/src/Text/Pandoc/Writers/FB2.hs+formatted c4b4f9d5a6e4 pandoc-3.10.2/src/Text/Pandoc/Writers/GridTable.hs+formatted 8049d235acfb pandoc-3.10.2/src/Text/Pandoc/Writers/HTML.hs+formatted 41b62b0da79a pandoc-3.10.2/src/Text/Pandoc/Writers/Haddock.hs+formatted b546180b4522 pandoc-3.10.2/src/Text/Pandoc/Writers/ICML.hs+formatted 66a1ea7e86c8 pandoc-3.10.2/src/Text/Pandoc/Writers/Ipynb.hs+formatted 94c2c79c2e7d pandoc-3.10.2/src/Text/Pandoc/Writers/JATS.hs+formatted 4a683f5d9700 pandoc-3.10.2/src/Text/Pandoc/Writers/JATS/References.hs+formatted 1141a590a5a6 pandoc-3.10.2/src/Text/Pandoc/Writers/JATS/Table.hs+formatted 3aae3967440a pandoc-3.10.2/src/Text/Pandoc/Writers/JATS/Types.hs+formatted d4bd43fd7b4e pandoc-3.10.2/src/Text/Pandoc/Writers/Jira.hs+formatted a1b3438d0207 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX.hs+formatted f67e173fe943 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Caption.hs+formatted fc260b26dbb5 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Citation.hs+formatted e89e979a29e1 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Lang.hs+formatted 8c164dd5cc9c pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Notes.hs+formatted 0043c2edb649 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Table.hs+formatted a4eb629d0029 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Types.hs+formatted a77d0a8b6cab pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Util.hs+formatted dd8b72ea1d45 pandoc-3.10.2/src/Text/Pandoc/Writers/Man.hs+formatted 0d826f85d47d pandoc-3.10.2/src/Text/Pandoc/Writers/Markdown.hs+formatted 9d6fe41d9669 pandoc-3.10.2/src/Text/Pandoc/Writers/Markdown/Inline.hs+formatted c57101b9ec66 pandoc-3.10.2/src/Text/Pandoc/Writers/Markdown/Table.hs+formatted 02c7eb593d88 pandoc-3.10.2/src/Text/Pandoc/Writers/Markdown/Types.hs+formatted 3d9d722a4e7e pandoc-3.10.2/src/Text/Pandoc/Writers/Math.hs+formatted e3e2e03bc6f6 pandoc-3.10.2/src/Text/Pandoc/Writers/MediaWiki.hs+formatted f08666425ec1 pandoc-3.10.2/src/Text/Pandoc/Writers/Ms.hs+formatted 0b3a871730b6 pandoc-3.10.2/src/Text/Pandoc/Writers/Muse.hs+formatted 4acde5355993 pandoc-3.10.2/src/Text/Pandoc/Writers/Native.hs+formatted 705d62226dba pandoc-3.10.2/src/Text/Pandoc/Writers/ODT.hs+formatted 0bd4c0281dd2 pandoc-3.10.2/src/Text/Pandoc/Writers/OOXML.hs+formatted 0a04485cd0b6 pandoc-3.10.2/src/Text/Pandoc/Writers/OPML.hs+formatted 38c7390489d7 pandoc-3.10.2/src/Text/Pandoc/Writers/OpenDocument.hs+formatted 461f088c8308 pandoc-3.10.2/src/Text/Pandoc/Writers/Org.hs+formatted 74e7486aeef1 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint.hs+formatted 0ee7de5d58d9 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs+formatted a991cb709520 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs+formatted 9da06ad78575 pandoc-3.10.2/src/Text/Pandoc/Writers/RST.hs+formatted 76c4e973a30e pandoc-3.10.2/src/Text/Pandoc/Writers/RTF.hs+formatted d94d420d102a pandoc-3.10.2/src/Text/Pandoc/Writers/Roff.hs+formatted 170dad242971 pandoc-3.10.2/src/Text/Pandoc/Writers/Shared.hs+formatted 966f9f568486 pandoc-3.10.2/src/Text/Pandoc/Writers/TEI.hs+formatted da5f7182e705 pandoc-3.10.2/src/Text/Pandoc/Writers/Texinfo.hs+formatted df1a1a706a3d pandoc-3.10.2/src/Text/Pandoc/Writers/Textile.hs+formatted 9ea50cc6925a pandoc-3.10.2/src/Text/Pandoc/Writers/Txt2Tags.hs+formatted 745407966672 pandoc-3.10.2/src/Text/Pandoc/Writers/Typst.hs+formatted 9df037d0e0af pandoc-3.10.2/src/Text/Pandoc/Writers/Vimdoc.hs+formatted e34d3122403b pandoc-3.10.2/src/Text/Pandoc/Writers/XML.hs+formatted a11946cf7174 pandoc-3.10.2/src/Text/Pandoc/Writers/XWiki.hs+formatted 1ee6529c659c pandoc-3.10.2/src/Text/Pandoc/Writers/ZimWiki.hs+formatted c0bf42044a17 pandoc-3.10.2/src/Text/Pandoc/XML.hs+formatted 29da3381e068 pandoc-3.10.2/src/Text/Pandoc/XMLFormat.hs+formatted 9533e4f4b6c4 pandoc-3.10.2/test/Tests/Command.hs+formatted 44e0d3fa8621 pandoc-3.10.2/test/Tests/Helpers.hs+formatted 08a6d3f3d84f pandoc-3.10.2/test/Tests/MediaBag.hs+formatted 58f15e3f067a pandoc-3.10.2/test/Tests/Old.hs+formatted 7b96b4d20921 pandoc-3.10.2/test/Tests/Readers/Creole.hs+formatted 0e634958fc8c pandoc-3.10.2/test/Tests/Readers/Docx.hs+formatted dc0961425873 pandoc-3.10.2/test/Tests/Readers/DokuWiki.hs+formatted 150d1390d716 pandoc-3.10.2/test/Tests/Readers/EPUB.hs+formatted b786e572a74c pandoc-3.10.2/test/Tests/Readers/FB2.hs+formatted fa79877906a8 pandoc-3.10.2/test/Tests/Readers/HTML.hs+formatted a047fe6e2033 pandoc-3.10.2/test/Tests/Readers/JATS.hs+formatted 3ee2ef6dea11 pandoc-3.10.2/test/Tests/Readers/Jira.hs+formatted e617bc68c809 pandoc-3.10.2/test/Tests/Readers/LaTeX.hs+formatted 54c9a9360dac pandoc-3.10.2/test/Tests/Readers/Man.hs+formatted 67e0bd9ae4b8 pandoc-3.10.2/test/Tests/Readers/Markdown.hs+formatted 7aec4f85c064 pandoc-3.10.2/test/Tests/Readers/Mdoc.hs+formatted 96cc9670fdfb pandoc-3.10.2/test/Tests/Readers/Muse.hs+formatted 6d5ec7415c5d pandoc-3.10.2/test/Tests/Readers/ODT.hs+formatted 4cec297f4fab pandoc-3.10.2/test/Tests/Readers/Org.hs+formatted e5c1db2d073f pandoc-3.10.2/test/Tests/Readers/Org/Block.hs+formatted b4b9cddd5711 pandoc-3.10.2/test/Tests/Readers/Org/Block/CodeBlock.hs+formatted 8bfbfbb823bf pandoc-3.10.2/test/Tests/Readers/Org/Block/Figure.hs+formatted 1db2ce6020c8 pandoc-3.10.2/test/Tests/Readers/Org/Block/Header.hs+formatted ac82b8a4a7bf pandoc-3.10.2/test/Tests/Readers/Org/Block/List.hs+formatted 3e9d7a83d060 pandoc-3.10.2/test/Tests/Readers/Org/Block/Table.hs+formatted 5f3808eb1a55 pandoc-3.10.2/test/Tests/Readers/Org/Directive.hs+formatted bfd915a68797 pandoc-3.10.2/test/Tests/Readers/Org/Inline.hs+formatted c762e1d74166 pandoc-3.10.2/test/Tests/Readers/Org/Inline/Citation.hs+formatted b2fb48f770ee pandoc-3.10.2/test/Tests/Readers/Org/Inline/Note.hs+formatted 1ab451370fda pandoc-3.10.2/test/Tests/Readers/Org/Inline/Smart.hs+formatted 06c0169c3199 pandoc-3.10.2/test/Tests/Readers/Org/Meta.hs+formatted b1b4397e99d3 pandoc-3.10.2/test/Tests/Readers/Org/Shared.hs+formatted 1eb1a05f4635 pandoc-3.10.2/test/Tests/Readers/Pod.hs+formatted 7f0ab3cbdf98 pandoc-3.10.2/test/Tests/Readers/Pptx.hs+formatted 3b5a69d54626 pandoc-3.10.2/test/Tests/Readers/RST.hs+formatted 525c19538ad3 pandoc-3.10.2/test/Tests/Readers/RTF.hs+formatted aca713b17e29 pandoc-3.10.2/test/Tests/Readers/Txt2Tags.hs+formatted 15bd1659725f pandoc-3.10.2/test/Tests/Readers/Xlsx.hs+formatted 2692dc26ee41 pandoc-3.10.2/test/Tests/Shared.hs+formatted ad523df96992 pandoc-3.10.2/test/Tests/Writers/AnnotatedTable.hs+formatted b21e7e06def4 pandoc-3.10.2/test/Tests/Writers/AsciiDoc.hs+formatted 70088c61a9f3 pandoc-3.10.2/test/Tests/Writers/BBCode.hs+formatted 98cca991f01d pandoc-3.10.2/test/Tests/Writers/ConTeXt.hs+formatted 59de8eac5d46 pandoc-3.10.2/test/Tests/Writers/DocBook.hs+formatted 648f15c3487d pandoc-3.10.2/test/Tests/Writers/Docx.hs+formatted c93a204195d1 pandoc-3.10.2/test/Tests/Writers/FB2.hs+formatted 8485eb418c1f pandoc-3.10.2/test/Tests/Writers/HTML.hs+formatted 864ccac4606e pandoc-3.10.2/test/Tests/Writers/JATS.hs+formatted f691886863f7 pandoc-3.10.2/test/Tests/Writers/Jira.hs+formatted 2c7232780cd3 pandoc-3.10.2/test/Tests/Writers/LaTeX.hs+formatted 0d9dc37df4e1 pandoc-3.10.2/test/Tests/Writers/Markdown.hs+formatted c8345b0f787e pandoc-3.10.2/test/Tests/Writers/Markua.hs+formatted fb4d32e30070 pandoc-3.10.2/test/Tests/Writers/Ms.hs+formatted 53258d5a9e50 pandoc-3.10.2/test/Tests/Writers/Muse.hs+formatted f2f1ca1b8764 pandoc-3.10.2/test/Tests/Writers/Native.hs+formatted 16780a5a789f pandoc-3.10.2/test/Tests/Writers/OOXML.hs+formatted 3033600cbe42 pandoc-3.10.2/test/Tests/Writers/Org.hs+formatted 0e4b414e2dea pandoc-3.10.2/test/Tests/Writers/Plain.hs+formatted e496fc51153d pandoc-3.10.2/test/Tests/Writers/Powerpoint.hs+formatted 9d6e4a5505a1 pandoc-3.10.2/test/Tests/Writers/RST.hs+formatted 7f7f9e6de407 pandoc-3.10.2/test/Tests/Writers/TEI.hs+formatted 9286c785c97e pandoc-3.10.2/test/Tests/Writers/Txt2Tags.hs+formatted ad01bdc72c8e pandoc-3.10.2/test/Tests/XML.hs+formatted 16057c777a9d pandoc-3.10.2/test/command/3510-src.hs+formatted 3f023b0abbe3 pandoc-3.10.2/test/command/6466-beg.hs+formatted 06289f98fcac pandoc-3.10.2/test/command/6466-end.hs+formatted 546301610b9b pandoc-3.10.2/test/command/6466-mid.hs+formatted b6f515e00962 pandoc-3.10.2/test/command/6466-whole.hs+formatted 53aaf2e2c6e0 pandoc-3.10.2/test/test-pandoc.hs+formatted 2556d5cb9f72 pandoc-3.10.2/xml-light/Text/Pandoc/XML/Light.hs+formatted d13fc87f4907 pandoc-3.10.2/xml-light/Text/Pandoc/XML/Light/Output.hs+formatted 3f7a60f285f2 pandoc-3.10.2/xml-light/Text/Pandoc/XML/Light/Proc.hs+formatted 11f398c0d479 pandoc-3.10.2/xml-light/Text/Pandoc/XML/Light/Types.hs+formatted e865ae48f11b pandoc-types-1.23.1.2/Setup.hs+formatted 8376040e03f4 pandoc-types-1.23.1.2/benchmark/bench.hs+formatted 8e6368ed5c21 pandoc-types-1.23.1.2/src/Text/Pandoc/Arbitrary.hs+formatted 23cfca937427 pandoc-types-1.23.1.2/src/Text/Pandoc/Builder.hs+formatted 041d27bf9170 pandoc-types-1.23.1.2/src/Text/Pandoc/Definition.hs+formatted 42a13347f367 pandoc-types-1.23.1.2/src/Text/Pandoc/Generic.hs+formatted 8fad29f2adc4 pandoc-types-1.23.1.2/src/Text/Pandoc/JSON.hs+formatted 3e061e7b176e pandoc-types-1.23.1.2/src/Text/Pandoc/Walk.hs+formatted dcf10d45e788 pandoc-types-1.23.1.2/test/Data/String/QQ.hs+formatted 25a6ff086c83 pandoc-types-1.23.1.2/test/test-pandoc-types.hs+formatted 7474b7e1d4f5 parsec3-1.0.1.8/Setup.hs+formatted 48d72ad7fc59 parsec3-1.0.1.8/Text/Parsec.hs+formatted afc3d5a902fe parsec3-1.0.1.8/Text/Parsec/ByteString.hs+formatted a9c7a6dd5b30 parsec3-1.0.1.8/Text/Parsec/ByteString/Lazy.hs+formatted 5e6bdea20cf6 parsec3-1.0.1.8/Text/Parsec/Char.hs+formatted 4abab8f9ceb8 parsec3-1.0.1.8/Text/Parsec/Combinator.hs+formatted 94a0c2798c5a parsec3-1.0.1.8/Text/Parsec/Error.hs+formatted 048c32e5a768 parsec3-1.0.1.8/Text/Parsec/Expr.hs+formatted 156014d6ed26 parsec3-1.0.1.8/Text/Parsec/Language.hs+formatted 40bf4d018d51 parsec3-1.0.1.8/Text/Parsec/Perm.hs+formatted c50efff79fe5 parsec3-1.0.1.8/Text/Parsec/Pos.hs+formatted 1d4feb99b3e8 parsec3-1.0.1.8/Text/Parsec/Prim.hs+formatted c911dc63e8d5 parsec3-1.0.1.8/Text/Parsec/String.hs+formatted 72422924874a parsec3-1.0.1.8/Text/Parsec/Text.hs+formatted 6fd69590f1d3 parsec3-1.0.1.8/Text/Parsec/Text/Lazy.hs+formatted b6e8b0e16d14 parsec3-1.0.1.8/Text/Parsec/Token.hs+formatted 22b02f116512 parser-combinators-1.3.1/Control/Applicative/Combinators.hs+formatted 2b483a550d21 parser-combinators-1.3.1/Control/Applicative/Combinators/NonEmpty.hs+formatted 7d01c0dddfcd parser-combinators-1.3.1/Control/Applicative/Permutations.hs+formatted 80eb76464ce8 parser-combinators-1.3.1/Control/Monad/Combinators.hs+formatted 203c01d41bb8 parser-combinators-1.3.1/Control/Monad/Combinators/Expr.hs+formatted f63c3b21684d parser-combinators-1.3.1/Control/Monad/Combinators/NonEmpty.hs+formatted 2ce12720b575 parser-combinators-1.3.1/Control/Monad/Permutations.hs+formatted 4c7a2ed66fb7 persistent-2.18.1.0/Database/Persist.hs+formatted af7417196697 persistent-2.18.1.0/Database/Persist/Class.hs+formatted a62cb576f4b1 persistent-2.18.1.0/Database/Persist/Class/PersistConfig.hs+formatted 56f625ad1ea2 persistent-2.18.1.0/Database/Persist/Class/PersistEntity.hs+formatted 63c55d24c1a6 persistent-2.18.1.0/Database/Persist/Class/PersistField.hs+formatted 4229d83e727f persistent-2.18.1.0/Database/Persist/Class/PersistQuery.hs+formatted 194836df1fd0 persistent-2.18.1.0/Database/Persist/Class/PersistStore.hs+formatted c7df1c76c273 persistent-2.18.1.0/Database/Persist/Class/PersistUnique.hs+formatted 8411f5f4d556 persistent-2.18.1.0/Database/Persist/Compatible.hs+formatted 40afca283a80 persistent-2.18.1.0/Database/Persist/Compatible/TH.hs+formatted f77b6e49e3d3 persistent-2.18.1.0/Database/Persist/Compatible/Types.hs+formatted 4da910742f5d persistent-2.18.1.0/Database/Persist/EntityDef.hs+formatted 849d0a429195 persistent-2.18.1.0/Database/Persist/EntityDef/Internal.hs+formatted 8b9538a7e637 persistent-2.18.1.0/Database/Persist/FieldDef.hs+formatted ab8743cef9ef persistent-2.18.1.0/Database/Persist/FieldDef/Internal.hs+formatted 62ee350971e4 persistent-2.18.1.0/Database/Persist/ImplicitIdDef.hs+formatted 9051746eba78 persistent-2.18.1.0/Database/Persist/ImplicitIdDef/Internal.hs+formatted 4002aeb84669 persistent-2.18.1.0/Database/Persist/Names.hs+formatted 67c816fd5b28 persistent-2.18.1.0/Database/Persist/PersistValue.hs+formatted 3b8981721873 persistent-2.18.1.0/Database/Persist/Quasi.hs+formatted bf1548cc69c8 persistent-2.18.1.0/Database/Persist/Quasi/Internal.hs+formatted cabfd6b48df2 persistent-2.18.1.0/Database/Persist/Quasi/Internal/ModelParser.hs+formatted 7c334061474c persistent-2.18.1.0/Database/Persist/Quasi/Internal/TypeParser.hs+formatted 21110acf54fd persistent-2.18.1.0/Database/Persist/Quasi/PersistSettings.hs+formatted a65ab8f1929f persistent-2.18.1.0/Database/Persist/Quasi/PersistSettings/Internal.hs+formatted a2208d509db2 persistent-2.18.1.0/Database/Persist/Sql.hs+formatted 5eb8c1f034c5 persistent-2.18.1.0/Database/Persist/Sql/Class.hs+formatted ccfe7e6d9996 persistent-2.18.1.0/Database/Persist/Sql/Internal.hs+formatted 8961bf4b32ff persistent-2.18.1.0/Database/Persist/Sql/Migration.hs+formatted 7e371de867be persistent-2.18.1.0/Database/Persist/Sql/Orphan/PersistQuery.hs+formatted e01289d09a16 persistent-2.18.1.0/Database/Persist/Sql/Orphan/PersistStore.hs+formatted 423a6f1ddcbf persistent-2.18.1.0/Database/Persist/Sql/Orphan/PersistUnique.hs+formatted 4da2e4b129cc persistent-2.18.1.0/Database/Persist/Sql/Raw.hs+formatted 9376d473879f persistent-2.18.1.0/Database/Persist/Sql/Run.hs+formatted e899729d586e persistent-2.18.1.0/Database/Persist/Sql/Types.hs+formatted 39dcf72b8d4a persistent-2.18.1.0/Database/Persist/Sql/Types/Internal.hs+formatted b8d70cb7744c persistent-2.18.1.0/Database/Persist/Sql/Util.hs+formatted 9535b7d9a001 persistent-2.18.1.0/Database/Persist/SqlBackend.hs+formatted e5f2ff2dc144 persistent-2.18.1.0/Database/Persist/SqlBackend/Internal.hs+formatted 47acc3733907 persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/InsertSqlResult.hs+formatted 4bd5d30fe421 persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/IsolationLevel.hs+formatted c8a378801422 persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/MkSqlBackend.hs+formatted 945521fad6a2 persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/SqlPoolHooks.hs+formatted 4e0a2509487b persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/Statement.hs+formatted 1710f992776b persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/StatementCache.hs+formatted 4304cc0b95bf persistent-2.18.1.0/Database/Persist/SqlBackend/SqlPoolHooks.hs+formatted 081bf168d849 persistent-2.18.1.0/Database/Persist/SqlBackend/StatementCache.hs+formatted c43972a3241b persistent-2.18.1.0/Database/Persist/TH.hs+formatted a484cb2adef0 persistent-2.18.1.0/Database/Persist/TH/Internal.hs+formatted 3eb1ab75fbdf persistent-2.18.1.0/Database/Persist/Types.hs+formatted 602702e0f86e persistent-2.18.1.0/Database/Persist/Types/Base.hs+formatted b8189bc0e07d persistent-2.18.1.0/Database/Persist/Types/SourceSpan.hs+formatted 1aec50d3544f persistent-2.18.1.0/bench/Main.hs+formatted d4e78e3f895b persistent-2.18.1.0/bench/Models.hs+formatted 1e8c8c93c976 persistent-2.18.1.0/test/Database/Persist/ClassSpec.hs+formatted 6082a8164f41 persistent-2.18.1.0/test/Database/Persist/PersistValueSpec.hs+formatted 906326245f86 persistent-2.18.1.0/test/Database/Persist/QuasiSpec.hs+formatted 8882f34c07fe persistent-2.18.1.0/test/Database/Persist/TH/CommentSpec.hs+formatted d773a41935ea persistent-2.18.1.0/test/Database/Persist/TH/CompositeKeyStyleSpec.hs+formatted f9f4014951e3 persistent-2.18.1.0/test/Database/Persist/TH/DiscoverEntitiesSpec.hs+formatted c444c6731179 persistent-2.18.1.0/test/Database/Persist/TH/EmbedSpec.hs+formatted bf23d25d4982 persistent-2.18.1.0/test/Database/Persist/TH/EntityHaddockSpec.hs+formatted 4f00a9a51fee persistent-2.18.1.0/test/Database/Persist/TH/ForeignRefSpec.hs+formatted 0c3421ff2893 persistent-2.18.1.0/test/Database/Persist/TH/ImplicitIdColSpec.hs+formatted 6d733cdba565 persistent-2.18.1.0/test/Database/Persist/TH/JsonEncodingSpec.hs+formatted 8adfe4a4228d persistent-2.18.1.0/test/Database/Persist/TH/KindEntitiesSpec.hs+formatted 5aacd109f219 persistent-2.18.1.0/test/Database/Persist/TH/KindEntitiesSpecImports.hs+formatted 95ba90d362da persistent-2.18.1.0/test/Database/Persist/TH/MaybeFieldDefsSpec.hs+formatted c4b2085e7249 persistent-2.18.1.0/test/Database/Persist/TH/MigrationOnlySpec.hs+formatted dbad9d8d922f persistent-2.18.1.0/test/Database/Persist/TH/MultiBlockSpec.hs+formatted b776165f7ac3 persistent-2.18.1.0/test/Database/Persist/TH/MultiBlockSpec/Model.hs+formatted baa7f67273ec persistent-2.18.1.0/test/Database/Persist/TH/NestedSymbolsInTypeSpec.hs+formatted f0e370f995e7 persistent-2.18.1.0/test/Database/Persist/TH/NestedSymbolsInTypeSpecImports.hs+formatted 16ab595a1cc4 persistent-2.18.1.0/test/Database/Persist/TH/NoFieldSelectorsSpec.hs+formatted e227905a242e persistent-2.18.1.0/test/Database/Persist/TH/OverloadedLabelSpec.hs+formatted ad712bcac46e persistent-2.18.1.0/test/Database/Persist/TH/PersistWith/Model.hs+formatted 8d58beb8b33c persistent-2.18.1.0/test/Database/Persist/TH/PersistWith/Model2.hs+formatted a7b8dff135f1 persistent-2.18.1.0/test/Database/Persist/TH/PersistWithSpec.hs+formatted 7b6cf72d5ecc persistent-2.18.1.0/test/Database/Persist/TH/RequireOnlyPersistImportSpec.hs+formatted 9a0756832b2d persistent-2.18.1.0/test/Database/Persist/TH/SharedPrimaryKeyImportedSpec.hs+formatted 885e1164f19c persistent-2.18.1.0/test/Database/Persist/TH/SharedPrimaryKeySpec.hs+formatted 145463b36f4d persistent-2.18.1.0/test/Database/Persist/TH/SumSpec.hs+formatted e6bfe40fd881 persistent-2.18.1.0/test/Database/Persist/TH/ToFromPersistValuesSpec.hs+formatted a18bfc6474db persistent-2.18.1.0/test/Database/Persist/TH/TypeLitFieldDefsSpec.hs+formatted 634967bdd99d persistent-2.18.1.0/test/Database/Persist/THSpec.hs+formatted f9304e426550 persistent-2.18.1.0/test/TemplateTestImports.hs+formatted 7f05465b25d5 persistent-2.18.1.0/test/main.hs+formatted e865ae48f11b pipes-4.3.16/Setup.hs+formatted bc3b140ba83c pipes-4.3.16/benchmarks/Common.hs+formatted e459e4d124d4 pipes-4.3.16/benchmarks/LiftBench.hs+formatted d100cca123ea pipes-4.3.16/benchmarks/PreludeBench.hs+formatted c30da8c52f2b pipes-4.3.16/src/Pipes.hs+formatted 332e8aaad352 pipes-4.3.16/src/Pipes/Core.hs+formatted e021398dbff3 pipes-4.3.16/src/Pipes/Internal.hs+formatted e3b36f0685b2 pipes-4.3.16/src/Pipes/Lift.hs+formatted 82bba5f85292 pipes-4.3.16/src/Pipes/Prelude.hs+formatted 436224de8a77 pipes-4.3.16/src/Pipes/Tutorial.hs+formatted 6ca40cc862a8 pipes-4.3.16/tests/Main.hs+formatted 56dca68e0a87 postgrest-9.0.1/Setup.hs+formatted 772d4f353686 postgrest-9.0.1/main/Main.hs+formatted bd3eb89beb11 postgrest-9.0.1/src/PostgREST/App.hs+formatted aeefa441d9ea postgrest-9.0.1/src/PostgREST/AppState.hs+formatted fa5f086364f2 postgrest-9.0.1/src/PostgREST/Auth.hs+formatted f42af00966e2 postgrest-9.0.1/src/PostgREST/CLI.hs+formatted 41c49c80f153 postgrest-9.0.1/src/PostgREST/Config.hs+formatted 26e0ccfa04f8 postgrest-9.0.1/src/PostgREST/Config/Database.hs+formatted 9632241317fd postgrest-9.0.1/src/PostgREST/Config/JSPath.hs+formatted b719e278251b postgrest-9.0.1/src/PostgREST/Config/PgVersion.hs+formatted 4f3444c0a949 postgrest-9.0.1/src/PostgREST/Config/Proxy.hs+formatted 65c66f863629 postgrest-9.0.1/src/PostgREST/ContentType.hs+formatted 9200d4931d04 postgrest-9.0.1/src/PostgREST/Cors.hs+formatted 4eef76b76acf postgrest-9.0.1/src/PostgREST/DbStructure.hs+formatted a0f5c884d319 postgrest-9.0.1/src/PostgREST/DbStructure/Identifiers.hs+formatted 28e71accad76 postgrest-9.0.1/src/PostgREST/DbStructure/Proc.hs+formatted 8670bffe5d4a postgrest-9.0.1/src/PostgREST/DbStructure/Relationship.hs+formatted 0951365600a0 postgrest-9.0.1/src/PostgREST/DbStructure/Table.hs+formatted 50ae92f8d312 postgrest-9.0.1/src/PostgREST/Error.hs+formatted f1b82d17eed8 postgrest-9.0.1/src/PostgREST/GucHeader.hs+formatted 2c6a7ae61af9 postgrest-9.0.1/src/PostgREST/Logger.hs+formatted 42324fca62e1 postgrest-9.0.1/src/PostgREST/Middleware.hs+formatted 9b991a36398d postgrest-9.0.1/src/PostgREST/OpenAPI.hs+formatted ccef8516712f postgrest-9.0.1/src/PostgREST/Query/QueryBuilder.hs+formatted 491a8b321ce9 postgrest-9.0.1/src/PostgREST/Query/SqlFragment.hs+formatted 5f4cbf20b7f3 postgrest-9.0.1/src/PostgREST/Query/Statements.hs+formatted 7d83276a4311 postgrest-9.0.1/src/PostgREST/RangeQuery.hs+formatted 468dcbe76687 postgrest-9.0.1/src/PostgREST/Request/ApiRequest.hs+formatted 307adfedde88 postgrest-9.0.1/src/PostgREST/Request/DbRequestBuilder.hs+formatted fc3632173741 postgrest-9.0.1/src/PostgREST/Request/Parsers.hs+formatted 8e710c5836da postgrest-9.0.1/src/PostgREST/Request/Preferences.hs+formatted c051dbc66c29 postgrest-9.0.1/src/PostgREST/Request/Types.hs+formatted 0c839dec485e postgrest-9.0.1/src/PostgREST/Unix.hs+formatted 793800bb054f postgrest-9.0.1/src/PostgREST/Version.hs+formatted 2b137fd794c3 postgrest-9.0.1/src/PostgREST/Workers.hs+formatted c719f882d27c postgrest-9.0.1/test/doc/Main.hs+formatted 5bf94bd709a7 postgrest-9.0.1/test/spec/Feature/AndOrParamsSpec.hs+formatted 000191b3349e postgrest-9.0.1/test/spec/Feature/AsymmetricJwtSpec.hs+formatted 5a86c6233052 postgrest-9.0.1/test/spec/Feature/AudienceJwtSecretSpec.hs+formatted acbe9362314e postgrest-9.0.1/test/spec/Feature/AuthSpec.hs+formatted 7cb71699f728 postgrest-9.0.1/test/spec/Feature/BinaryJwtSecretSpec.hs+formatted 2fb433681c01 postgrest-9.0.1/test/spec/Feature/ConcurrentSpec.hs+formatted db553e991f45 postgrest-9.0.1/test/spec/Feature/CorsSpec.hs+formatted 343d3e3a465e postgrest-9.0.1/test/spec/Feature/DeleteSpec.hs+formatted 112082d3da25 postgrest-9.0.1/test/spec/Feature/DisabledOpenApiSpec.hs+formatted ad7384965a9e postgrest-9.0.1/test/spec/Feature/EmbedDisambiguationSpec.hs+formatted f7a7ea3d2a87 postgrest-9.0.1/test/spec/Feature/EmbedInnerJoinSpec.hs+formatted a3dddabdb704 postgrest-9.0.1/test/spec/Feature/ExtraSearchPathSpec.hs+formatted ff20687cb475 postgrest-9.0.1/test/spec/Feature/HtmlRawOutputSpec.hs+formatted c2e75b5529a0 postgrest-9.0.1/test/spec/Feature/IgnorePrivOpenApiSpec.hs+formatted ea599ebfe99c postgrest-9.0.1/test/spec/Feature/InsertSpec.hs+formatted 9264b830952f postgrest-9.0.1/test/spec/Feature/JsonOperatorSpec.hs+formatted 12271bc52ad6 postgrest-9.0.1/test/spec/Feature/LegacyGucsSpec.hs+formatted 5228aaf9349c postgrest-9.0.1/test/spec/Feature/MultipleSchemaSpec.hs+formatted 3e8b6471e229 postgrest-9.0.1/test/spec/Feature/NoJwtSpec.hs+formatted a7144a84ab24 postgrest-9.0.1/test/spec/Feature/NonexistentSchemaSpec.hs+formatted f7d94a10d9ad postgrest-9.0.1/test/spec/Feature/OpenApiSpec.hs+formatted 1b9c2f6f5c75 postgrest-9.0.1/test/spec/Feature/OptionsSpec.hs+formatted 89a1589ff0fe postgrest-9.0.1/test/spec/Feature/ProxySpec.hs+formatted 4e889783f9ba postgrest-9.0.1/test/spec/Feature/QueryLimitedSpec.hs+formatted f305fa66460e postgrest-9.0.1/test/spec/Feature/QuerySpec.hs+formatted 146347d5ddec postgrest-9.0.1/test/spec/Feature/RangeSpec.hs+formatted 7cb746560127 postgrest-9.0.1/test/spec/Feature/RawOutputTypesSpec.hs+formatted b4a3ab5a81a9 postgrest-9.0.1/test/spec/Feature/RollbackSpec.hs+formatted dc5321d79fb3 postgrest-9.0.1/test/spec/Feature/RootSpec.hs+formatted 77a649eeb2e6 postgrest-9.0.1/test/spec/Feature/RpcPreRequestGucsSpec.hs+formatted 3a4705fe539d postgrest-9.0.1/test/spec/Feature/RpcSpec.hs+formatted 73c0ab518a3d postgrest-9.0.1/test/spec/Feature/SingularSpec.hs+formatted be03de84804f postgrest-9.0.1/test/spec/Feature/UnicodeSpec.hs+formatted 162dade8a566 postgrest-9.0.1/test/spec/Feature/UpdateSpec.hs+formatted 55bb47ad8764 postgrest-9.0.1/test/spec/Feature/UpsertSpec.hs+formatted 7a9dd3383794 postgrest-9.0.1/test/spec/Main.hs+formatted f32b163f57d7 postgrest-9.0.1/test/spec/QueryCost.hs+formatted ab30ff617540 postgrest-9.0.1/test/spec/SpecHelper.hs+formatted c136e6235ce2 postgrest-9.0.1/test/spec/TestTypes.hs+formatted 13abd8b59335 profunctors-5.6.3/src/Data/Profunctor.hs+formatted cd53a440a7f3 profunctors-5.6.3/src/Data/Profunctor/Adjunction.hs+formatted 604108a2b13e profunctors-5.6.3/src/Data/Profunctor/Cayley.hs+formatted 8b5e0d5c4b28 profunctors-5.6.3/src/Data/Profunctor/Choice.hs+formatted 4a0c88f45f54 profunctors-5.6.3/src/Data/Profunctor/Closed.hs+formatted de00ff751f38 profunctors-5.6.3/src/Data/Profunctor/Composition.hs+formatted a6085622ae89 profunctors-5.6.3/src/Data/Profunctor/Mapping.hs+formatted 59b30aaa8b06 profunctors-5.6.3/src/Data/Profunctor/Monad.hs+formatted 5b7a528834d1 profunctors-5.6.3/src/Data/Profunctor/Ran.hs+formatted dc01020464c2 profunctors-5.6.3/src/Data/Profunctor/Rep.hs+formatted a405de2f08b4 profunctors-5.6.3/src/Data/Profunctor/Sieve.hs+formatted 072c0f89a17b profunctors-5.6.3/src/Data/Profunctor/Strong.hs+formatted 1c7f87812e16 profunctors-5.6.3/src/Data/Profunctor/Traversing.hs+formatted 74b9958fedc6 profunctors-5.6.3/src/Data/Profunctor/Types.hs+formatted 6d4d49816f3c profunctors-5.6.3/src/Data/Profunctor/Unsafe.hs+formatted 074b9f00e701 profunctors-5.6.3/src/Data/Profunctor/Yoneda.hs+formatted f97b976f5a71 purescript-0.15.15/Setup.hs+formatted fc25cc9ab507 purescript-0.15.15/app/Command/Bundle.hs+formatted a46f2214fbc8 purescript-0.15.15/app/Command/Compile.hs+formatted 7219813f0a5c purescript-0.15.15/app/Command/Docs.hs+formatted 55df8737ff2c purescript-0.15.15/app/Command/Docs/Html.hs+formatted 037036ef66e1 purescript-0.15.15/app/Command/Docs/Markdown.hs+formatted eb687ab7bdfe purescript-0.15.15/app/Command/Graph.hs+formatted 60131f690f8b purescript-0.15.15/app/Command/Hierarchy.hs+formatted d627a10507ea purescript-0.15.15/app/Command/Ide.hs+formatted 2c3998824b51 purescript-0.15.15/app/Command/Publish.hs+formatted 5ed2f192bfb3 purescript-0.15.15/app/Command/REPL.hs+formatted aa128423c4fb purescript-0.15.15/app/Main.hs+formatted 8c8cfed900b8 purescript-0.15.15/app/SharedCLI.hs+formatted 18a85337fa6b purescript-0.15.15/app/Version.hs+formatted ee21446da604 purescript-0.15.15/src/Control/Monad/Logger.hs+formatted a06d72dd0adb purescript-0.15.15/src/Control/Monad/Supply.hs+formatted 4199e8087c69 purescript-0.15.15/src/Control/Monad/Supply/Class.hs+formatted 7a4d7979e1c9 purescript-0.15.15/src/Data/Text/PureScript.hs+formatted eef5dd037abf purescript-0.15.15/src/Language/PureScript.hs+formatted 64c0d4442190 purescript-0.15.15/src/Language/PureScript/AST.hs+formatted 147dc6ad6c67 purescript-0.15.15/src/Language/PureScript/AST/Binders.hs+formatted ebd8d9a20974 purescript-0.15.15/src/Language/PureScript/AST/Declarations.hs+formatted 0368132e2a7c purescript-0.15.15/src/Language/PureScript/AST/Declarations/ChainId.hs+formatted b8b152a00a9e purescript-0.15.15/src/Language/PureScript/AST/Exported.hs+formatted 16c598490b8b purescript-0.15.15/src/Language/PureScript/AST/Literals.hs+formatted 6dde4019084f purescript-0.15.15/src/Language/PureScript/AST/Operators.hs+formatted c7ebd057b2a2 purescript-0.15.15/src/Language/PureScript/AST/SourcePos.hs+formatted 1c8f80e1b700 purescript-0.15.15/src/Language/PureScript/AST/Traversals.hs+formatted cb23b5c86a87 purescript-0.15.15/src/Language/PureScript/AST/Utils.hs+formatted 64329f97de0d purescript-0.15.15/src/Language/PureScript/Bundle.hs+formatted 665ede6abf17 purescript-0.15.15/src/Language/PureScript/CST.hs+formatted 1c47033ea161 purescript-0.15.15/src/Language/PureScript/CST/Convert.hs+formatted 4c71bba856aa purescript-0.15.15/src/Language/PureScript/CST/Errors.hs+formatted c81c2ecf7ebe purescript-0.15.15/src/Language/PureScript/CST/Flatten.hs+formatted 36fe1c70493a purescript-0.15.15/src/Language/PureScript/CST/Layout.hs+formatted cce231cd663a purescript-0.15.15/src/Language/PureScript/CST/Lexer.hs+formatted aa182229b809 purescript-0.15.15/src/Language/PureScript/CST/Monad.hs+formatted fa367dbaa6aa purescript-0.15.15/src/Language/PureScript/CST/Positions.hs+formatted 2df3a82dec66 purescript-0.15.15/src/Language/PureScript/CST/Print.hs+formatted c741805ffed3 purescript-0.15.15/src/Language/PureScript/CST/Traversals.hs+formatted 81c5d151f932 purescript-0.15.15/src/Language/PureScript/CST/Traversals/Type.hs+formatted 46dd73253c21 purescript-0.15.15/src/Language/PureScript/CST/Types.hs+formatted 2bdb1cb651fc purescript-0.15.15/src/Language/PureScript/CST/Utils.hs+formatted ebd74707d2df purescript-0.15.15/src/Language/PureScript/CodeGen.hs+formatted f9bd11aadd08 purescript-0.15.15/src/Language/PureScript/CodeGen/JS.hs+formatted f10bc54be3c8 purescript-0.15.15/src/Language/PureScript/CodeGen/JS/Common.hs+formatted 9f17f1c77074 purescript-0.15.15/src/Language/PureScript/CodeGen/JS/Printer.hs+formatted acabda342dbe purescript-0.15.15/src/Language/PureScript/Comments.hs+formatted 7e1454fed47d purescript-0.15.15/src/Language/PureScript/Constants/Libs.hs+formatted 4e84deb1970c purescript-0.15.15/src/Language/PureScript/Constants/Prim.hs+formatted 08cf8657b87b purescript-0.15.15/src/Language/PureScript/Constants/TH.hs+formatted 0e372eb9e534 purescript-0.15.15/src/Language/PureScript/CoreFn.hs+formatted c133879c858f purescript-0.15.15/src/Language/PureScript/CoreFn/Ann.hs+formatted 2556afbb3bea purescript-0.15.15/src/Language/PureScript/CoreFn/Binders.hs+formatted 1141b43d30ff purescript-0.15.15/src/Language/PureScript/CoreFn/CSE.hs+formatted 6cbe0845ef8c purescript-0.15.15/src/Language/PureScript/CoreFn/Desugar.hs+formatted 2f90c3840d55 purescript-0.15.15/src/Language/PureScript/CoreFn/Expr.hs+formatted 8464185844d4 purescript-0.15.15/src/Language/PureScript/CoreFn/FromJSON.hs+formatted 1ee1c24577da purescript-0.15.15/src/Language/PureScript/CoreFn/Laziness.hs+formatted 083a81cbf5bf purescript-0.15.15/src/Language/PureScript/CoreFn/Meta.hs+formatted 2b2d42f479f2 purescript-0.15.15/src/Language/PureScript/CoreFn/Module.hs+formatted 8a65378bdb7b purescript-0.15.15/src/Language/PureScript/CoreFn/Optimizer.hs+formatted a01b08124299 purescript-0.15.15/src/Language/PureScript/CoreFn/ToJSON.hs+formatted 74e775f771b9 purescript-0.15.15/src/Language/PureScript/CoreFn/Traversals.hs+formatted 63122a31d5b9 purescript-0.15.15/src/Language/PureScript/CoreImp.hs+formatted b1fad463eff6 purescript-0.15.15/src/Language/PureScript/CoreImp/AST.hs+formatted 07f8248f1a4c purescript-0.15.15/src/Language/PureScript/CoreImp/Module.hs+formatted 76a5683510a3 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer.hs+formatted 900e45f47ef2 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/Blocks.hs+formatted 635c6dcfbee9 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/Common.hs+formatted 458709d8b573 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs+formatted d416fbf811c6 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs+formatted 3a758985a163 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/TCO.hs+formatted c3bcb1230471 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/Unused.hs+formatted 54228acabdeb purescript-0.15.15/src/Language/PureScript/Crash.hs+formatted d38f4a6a3f33 purescript-0.15.15/src/Language/PureScript/Docs.hs+formatted 057fb7fec258 purescript-0.15.15/src/Language/PureScript/Docs/AsHtml.hs+formatted 4113354e65ae purescript-0.15.15/src/Language/PureScript/Docs/AsMarkdown.hs+formatted 1253c947865b purescript-0.15.15/src/Language/PureScript/Docs/Collect.hs+formatted 0d989be52a8a purescript-0.15.15/src/Language/PureScript/Docs/Convert.hs+formatted 70ed8016e77f purescript-0.15.15/src/Language/PureScript/Docs/Convert/ReExports.hs+formatted 01c0ebe958e5 purescript-0.15.15/src/Language/PureScript/Docs/Convert/Single.hs+formatted d97124c1ab6a purescript-0.15.15/src/Language/PureScript/Docs/Css.hs+formatted f90d0d26dd2b purescript-0.15.15/src/Language/PureScript/Docs/Prim.hs+formatted e7ab3625ae1e purescript-0.15.15/src/Language/PureScript/Docs/Render.hs+formatted 4c98064ffe67 purescript-0.15.15/src/Language/PureScript/Docs/RenderedCode.hs+formatted 2f9857670eb2 purescript-0.15.15/src/Language/PureScript/Docs/RenderedCode/RenderType.hs+formatted a592688b187e purescript-0.15.15/src/Language/PureScript/Docs/RenderedCode/Types.hs+formatted 876b5438b748 purescript-0.15.15/src/Language/PureScript/Docs/Tags.hs+formatted 2145c65037f8 purescript-0.15.15/src/Language/PureScript/Docs/Types.hs+formatted bc381d509404 purescript-0.15.15/src/Language/PureScript/Docs/Utils/MonoidExtras.hs+formatted f3b1444d35a5 purescript-0.15.15/src/Language/PureScript/Environment.hs+formatted 27ca88d0bd04 purescript-0.15.15/src/Language/PureScript/Errors.hs+formatted 805b37c2988c purescript-0.15.15/src/Language/PureScript/Errors/JSON.hs+formatted 7a36f37df732 purescript-0.15.15/src/Language/PureScript/Externs.hs+formatted 347eb6f7f34d purescript-0.15.15/src/Language/PureScript/Glob.hs+formatted a91b6028a053 purescript-0.15.15/src/Language/PureScript/Graph.hs+formatted 0af324e42f5f purescript-0.15.15/src/Language/PureScript/Hierarchy.hs+formatted 615dd3e96d83 purescript-0.15.15/src/Language/PureScript/Ide.hs+formatted e69502626a1b purescript-0.15.15/src/Language/PureScript/Ide/CaseSplit.hs+formatted b9d2fcb8535a purescript-0.15.15/src/Language/PureScript/Ide/Command.hs+formatted e26de1f28e1b purescript-0.15.15/src/Language/PureScript/Ide/Completion.hs+formatted 7c4c157c15a2 purescript-0.15.15/src/Language/PureScript/Ide/Error.hs+formatted f831eeaf68b3 purescript-0.15.15/src/Language/PureScript/Ide/Externs.hs+formatted 925e97a78180 purescript-0.15.15/src/Language/PureScript/Ide/Filter.hs+formatted 3576f2d7de05 purescript-0.15.15/src/Language/PureScript/Ide/Filter/Declaration.hs+formatted d48adbab9be5 purescript-0.15.15/src/Language/PureScript/Ide/Filter/Imports.hs+formatted 93d2180b21af purescript-0.15.15/src/Language/PureScript/Ide/Imports.hs+formatted 395f2cbf5c2c purescript-0.15.15/src/Language/PureScript/Ide/Imports/Actions.hs+formatted dae869e09d51 purescript-0.15.15/src/Language/PureScript/Ide/Logging.hs+formatted 6495efed1636 purescript-0.15.15/src/Language/PureScript/Ide/Matcher.hs+formatted fe69a6b2ed2c purescript-0.15.15/src/Language/PureScript/Ide/Prim.hs+formatted f203b7c7db4d purescript-0.15.15/src/Language/PureScript/Ide/Rebuild.hs+formatted a65fbc555581 purescript-0.15.15/src/Language/PureScript/Ide/Reexports.hs+formatted 8dad96598473 purescript-0.15.15/src/Language/PureScript/Ide/SourceFile.hs+formatted 7c86ee11f6ae purescript-0.15.15/src/Language/PureScript/Ide/State.hs+formatted f41fbbfd0237 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 0c379aba42be purescript-0.15.15/src/Language/PureScript/Interactive.hs+formatted ea47006e2013 purescript-0.15.15/src/Language/PureScript/Interactive/Completion.hs+formatted 17488dfda517 purescript-0.15.15/src/Language/PureScript/Interactive/Directive.hs+formatted 2ab1349ff2ec purescript-0.15.15/src/Language/PureScript/Interactive/IO.hs+formatted f41f6e5826db purescript-0.15.15/src/Language/PureScript/Interactive/Message.hs+formatted 595ebf5e2141 purescript-0.15.15/src/Language/PureScript/Interactive/Module.hs+formatted 4b81e9100134 purescript-0.15.15/src/Language/PureScript/Interactive/Parser.hs+formatted aa71f85f0c45 purescript-0.15.15/src/Language/PureScript/Interactive/Printer.hs+formatted 2a5d0038271f purescript-0.15.15/src/Language/PureScript/Interactive/Types.hs+formatted d71ef7f9fb6c purescript-0.15.15/src/Language/PureScript/Label.hs+formatted a6c99546ca7b purescript-0.15.15/src/Language/PureScript/Linter.hs+formatted a4813ff2c614 purescript-0.15.15/src/Language/PureScript/Linter/Exhaustive.hs+formatted a875b0da533f purescript-0.15.15/src/Language/PureScript/Linter/Imports.hs+formatted eefa6de7d2e3 purescript-0.15.15/src/Language/PureScript/Linter/Wildcards.hs+formatted a91628e7f7d5 purescript-0.15.15/src/Language/PureScript/Make.hs+formatted 8ef53feca8d8 purescript-0.15.15/src/Language/PureScript/Make/Actions.hs+formatted a5c1fea38376 purescript-0.15.15/src/Language/PureScript/Make/BuildPlan.hs+formatted 2ff6ea3e0439 purescript-0.15.15/src/Language/PureScript/Make/Cache.hs+formatted 5a62260bbc36 purescript-0.15.15/src/Language/PureScript/Make/Monad.hs+formatted d32972a1d126 purescript-0.15.15/src/Language/PureScript/ModuleDependencies.hs+formatted 0415064ad3ac purescript-0.15.15/src/Language/PureScript/Names.hs+formatted 0f9b1ea22f14 purescript-0.15.15/src/Language/PureScript/Options.hs+formatted 57e5473deb15 purescript-0.15.15/src/Language/PureScript/PSString.hs+formatted 2b26a96d8bcc purescript-0.15.15/src/Language/PureScript/Pretty.hs+formatted c6838281b4ea purescript-0.15.15/src/Language/PureScript/Pretty/Common.hs+formatted 61f00923794e purescript-0.15.15/src/Language/PureScript/Pretty/Types.hs+formatted 719bfaeded1b purescript-0.15.15/src/Language/PureScript/Pretty/Values.hs+formatted 53f985a5fefa purescript-0.15.15/src/Language/PureScript/Publish.hs+formatted 79e26f16154a purescript-0.15.15/src/Language/PureScript/Publish/BoxesHelpers.hs+formatted 6bbf592abed7 purescript-0.15.15/src/Language/PureScript/Publish/ErrorsWarnings.hs+formatted 717e37e4a15e purescript-0.15.15/src/Language/PureScript/Publish/Registry/Compat.hs+formatted fba7a9e201e6 purescript-0.15.15/src/Language/PureScript/Publish/Utils.hs+formatted 7537fedb9664 purescript-0.15.15/src/Language/PureScript/Renamer.hs+formatted 9e88be14067d purescript-0.15.15/src/Language/PureScript/Roles.hs+formatted 2530d5774295 purescript-0.15.15/src/Language/PureScript/Sugar.hs+formatted 834b0e83e969 purescript-0.15.15/src/Language/PureScript/Sugar/AdoNotation.hs+formatted cea4abccd1cf purescript-0.15.15/src/Language/PureScript/Sugar/BindingGroups.hs+formatted 502cd635c402 purescript-0.15.15/src/Language/PureScript/Sugar/CaseDeclarations.hs+formatted 7efb24168510 purescript-0.15.15/src/Language/PureScript/Sugar/DoNotation.hs+formatted b4240a4449c4 purescript-0.15.15/src/Language/PureScript/Sugar/LetPattern.hs+formatted 224e99106e55 purescript-0.15.15/src/Language/PureScript/Sugar/Names.hs+formatted b2eab3efd8fe purescript-0.15.15/src/Language/PureScript/Sugar/Names/Common.hs+formatted 346caf48f81c purescript-0.15.15/src/Language/PureScript/Sugar/Names/Env.hs+formatted 48e3da823478 purescript-0.15.15/src/Language/PureScript/Sugar/Names/Exports.hs+formatted a4d64c36bc25 purescript-0.15.15/src/Language/PureScript/Sugar/Names/Imports.hs+formatted 54d278b2a1af purescript-0.15.15/src/Language/PureScript/Sugar/ObjectWildcards.hs+formatted 5fd120196aba purescript-0.15.15/src/Language/PureScript/Sugar/Operators.hs+formatted 2a167c659922 purescript-0.15.15/src/Language/PureScript/Sugar/Operators/Binders.hs+formatted 13722182a0e7 purescript-0.15.15/src/Language/PureScript/Sugar/Operators/Common.hs+formatted af45497618ed purescript-0.15.15/src/Language/PureScript/Sugar/Operators/Expr.hs+formatted 93053d3544f1 purescript-0.15.15/src/Language/PureScript/Sugar/Operators/Types.hs+formatted bf9cdccf9cd8 purescript-0.15.15/src/Language/PureScript/Sugar/TypeClasses.hs+formatted b5057db581ea purescript-0.15.15/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+formatted 84ce0264acbb purescript-0.15.15/src/Language/PureScript/Sugar/TypeDeclarations.hs+formatted 24e5df024499 purescript-0.15.15/src/Language/PureScript/Traversals.hs+formatted 9fc0861959b2 purescript-0.15.15/src/Language/PureScript/TypeChecker.hs+formatted 2c26865167b9 purescript-0.15.15/src/Language/PureScript/TypeChecker/Deriving.hs+formatted 77af37aaf14d purescript-0.15.15/src/Language/PureScript/TypeChecker/Entailment.hs+formatted fa60a8caf03a purescript-0.15.15/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs+formatted b504bbdc02b8 purescript-0.15.15/src/Language/PureScript/TypeChecker/Entailment/IntCompare.hs+formatted 2f14273075e4 purescript-0.15.15/src/Language/PureScript/TypeChecker/Kinds.hs+formatted d65280bbc8f4 purescript-0.15.15/src/Language/PureScript/TypeChecker/Monad.hs+formatted 71ace1d575fe purescript-0.15.15/src/Language/PureScript/TypeChecker/Roles.hs+formatted 5f769d073cac purescript-0.15.15/src/Language/PureScript/TypeChecker/Skolems.hs+formatted c8964442e6c6 purescript-0.15.15/src/Language/PureScript/TypeChecker/Subsumption.hs+formatted c5b309590b3d purescript-0.15.15/src/Language/PureScript/TypeChecker/Synonyms.hs+formatted 6dcac272ef52 purescript-0.15.15/src/Language/PureScript/TypeChecker/TypeSearch.hs+formatted d5153c7b177b purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs+formatted 0189781f7243 purescript-0.15.15/src/Language/PureScript/TypeChecker/Unify.hs+formatted 2d148264f334 purescript-0.15.15/src/Language/PureScript/TypeClassDictionaries.hs+formatted 9cac73392e4f purescript-0.15.15/src/Language/PureScript/Types.hs+formatted 50a45fbad08d purescript-0.15.15/src/System/IO/UTF8.hs+formatted 4533a74fbdb2 purescript-0.15.15/tests/Language/PureScript/Ide/CompletionSpec.hs+formatted 099ba0badfd6 purescript-0.15.15/tests/Language/PureScript/Ide/FilterSpec.hs+formatted 1033245eef97 purescript-0.15.15/tests/Language/PureScript/Ide/ImportsSpec.hs+formatted 028f5c10dae7 purescript-0.15.15/tests/Language/PureScript/Ide/MatcherSpec.hs+formatted e7c92690fcf3 purescript-0.15.15/tests/Language/PureScript/Ide/RebuildSpec.hs+formatted 7890facc486a purescript-0.15.15/tests/Language/PureScript/Ide/ReexportsSpec.hs+formatted 59d2a1d292e1 purescript-0.15.15/tests/Language/PureScript/Ide/SourceFileSpec.hs+formatted 904535829fba purescript-0.15.15/tests/Language/PureScript/Ide/StateSpec.hs+formatted 1698cf9a91b8 purescript-0.15.15/tests/Language/PureScript/Ide/Test.hs+formatted 67fe4d589cdb purescript-0.15.15/tests/Language/PureScript/Ide/UsageSpec.hs+formatted 0406ed28e812 purescript-0.15.15/tests/Main.hs+formatted ed333c67c3b1 purescript-0.15.15/tests/PscIdeSpec.hs+formatted a2b0f5e823b9 purescript-0.15.15/tests/TestAst.hs+formatted 856645ead459 purescript-0.15.15/tests/TestCompiler.hs+formatted 4184ded3056f purescript-0.15.15/tests/TestCoreFn.hs+formatted 3d3b4f7c14d7 purescript-0.15.15/tests/TestCst.hs+formatted 98e4356992c1 purescript-0.15.15/tests/TestDocs.hs+formatted e29c16f400a0 purescript-0.15.15/tests/TestGraph.hs+formatted 7314022489fa purescript-0.15.15/tests/TestHierarchy.hs+formatted 0874e238b9c0 purescript-0.15.15/tests/TestIde.hs+formatted df1c4148215e purescript-0.15.15/tests/TestMake.hs+formatted e782a733be50 purescript-0.15.15/tests/TestPrimDocs.hs+formatted d2998d562480 purescript-0.15.15/tests/TestPscPublish.hs+formatted e47fc0f000ee purescript-0.15.15/tests/TestPsci.hs+formatted 557206f834dc purescript-0.15.15/tests/TestPsci/CommandTest.hs+formatted a139fd3aa0c9 purescript-0.15.15/tests/TestPsci/CompletionTest.hs+formatted 5fa6ca09e4c4 purescript-0.15.15/tests/TestPsci/EvalTest.hs+formatted 1396270146b9 purescript-0.15.15/tests/TestPsci/TestEnv.hs+formatted 82c9984e8670 purescript-0.15.15/tests/TestSourceMaps.hs+formatted e6fa08547d76 purescript-0.15.15/tests/TestUtils.hs+formatted 002d52c424b7 raaz-0.3.11/api/aead/Auth/Implementation.hsig+formatted 4a86cd34c9e7 raaz-0.3.11/api/aead/Cipher/Implementation.hsig+formatted 16fa84cb7ae5 raaz-0.3.11/api/aead/Interface.hs+formatted a346882029b3 raaz-0.3.11/api/auth/Implementation.hsig+formatted 77a977c85c0d raaz-0.3.11/api/auth/Interface.hs+formatted 29b7f7e93ae5 raaz-0.3.11/api/digest/Implementation.hsig+formatted 7b45644314ef raaz-0.3.11/api/digest/Interface.hs+formatted 711ebf2e3620 raaz-0.3.11/api/encrypt/Implementation.hsig+formatted abdae110e56a raaz-0.3.11/api/encrypt/Interface.hs+formatted 10d5d9d622cd raaz-0.3.11/api/random/Entropy.hsig+formatted 83b376fec166 raaz-0.3.11/api/random/Implementation.hsig+formatted ffc859b186af raaz-0.3.11/api/random/Internal.hs+formatted 71c16f895f6c raaz-0.3.11/api/random/PRGenerator.hs+formatted a9538ed599c8 raaz-0.3.11/benchmarks/Main.hs+formatted 876b405577a3 raaz-0.3.11/benchmarks/internal/Benchmark/CSPRG.hs+formatted 20cee45b7828 raaz-0.3.11/benchmarks/internal/Benchmark/Primitive.hs+formatted 0d27567b2a16 raaz-0.3.11/benchmarks/internal/Benchmark/Types.hs+formatted 9ec4c716a238 raaz-0.3.11/core/Raaz/Core.hs+formatted 52634a64c590 raaz-0.3.11/core/Raaz/Core/ByteSource.hs+formatted a05146df1142 raaz-0.3.11/core/Raaz/Core/Constants.hs+formatted 97564cea364d raaz-0.3.11/core/Raaz/Core/CpuSupports.hs+formatted b89a1297556b raaz-0.3.11/core/Raaz/Core/Encode.hs+formatted f463b4886df2 raaz-0.3.11/core/Raaz/Core/Encode/Base16.hs+formatted e95c13b6113a raaz-0.3.11/core/Raaz/Core/Encode/Base64.hs+formatted f8721f54231f raaz-0.3.11/core/Raaz/Core/Encode/Internal.hs+formatted 45c46e35a34f raaz-0.3.11/core/Raaz/Core/Memory.hs+formatted be5bdc9fc1ae raaz-0.3.11/core/Raaz/Core/MonoidalAction.hs+formatted a44dbacd364d raaz-0.3.11/core/Raaz/Core/Parse.hs+formatted 514d08e6f301 raaz-0.3.11/core/Raaz/Core/Parse/Unsafe.hs+formatted 3d4dcaf4509d raaz-0.3.11/core/Raaz/Core/Prelude.hs+formatted 48ceb85b87f3 raaz-0.3.11/core/Raaz/Core/Primitive.hs+formatted f026c14b5cef raaz-0.3.11/core/Raaz/Core/Transfer.hs+formatted 5113d120fe4d raaz-0.3.11/core/Raaz/Core/Transfer/Unsafe.hs+formatted 03cf11da4658 raaz-0.3.11/core/Raaz/Core/Types.hs+formatted 2efdce977481 raaz-0.3.11/core/Raaz/Core/Types/Copying.hs+formatted da6a05924170 raaz-0.3.11/core/Raaz/Core/Types/Endian.hs+formatted 49cc9654b3b0 raaz-0.3.11/core/Raaz/Core/Types/Equality.hs+formatted 72aa730843b9 raaz-0.3.11/core/Raaz/Core/Types/Internal.hs+formatted 87409be71259 raaz-0.3.11/core/Raaz/Core/Types/Pointer.hs+formatted e89e04794868 raaz-0.3.11/core/Raaz/Core/Types/Tuple.hs+formatted d98d94a62e17 raaz-0.3.11/core/Raaz/Core/Util/ByteString.hs+formatted aadc37085673 raaz-0.3.11/core/Raaz/Primitive/AEAD/Internal.hs+formatted bdf59fdf9536 raaz-0.3.11/core/Raaz/Primitive/Blake2/Internal.hs+formatted 26f42c9a3385 raaz-0.3.11/core/Raaz/Primitive/ChaCha20/Internal.hs+formatted 933091143258 raaz-0.3.11/core/Raaz/Primitive/HashMemory.hs+formatted 2e41cccfd947 raaz-0.3.11/core/Raaz/Primitive/Keyed/Internal.hs+formatted 11f319d28f77 raaz-0.3.11/core/Raaz/Primitive/Poly1305/Internal.hs+formatted 662036acbd84 raaz-0.3.11/core/Raaz/Primitive/Sha2/Internal.hs+formatted d321e6f120cc raaz-0.3.11/implementation/Blake2b/CHandWritten.hs+formatted c7f7e16ff427 raaz-0.3.11/implementation/Blake2b/CPortable.hs+formatted 380071ee384a raaz-0.3.11/implementation/Blake2s/CHandWritten.hs+formatted d4911e2aba2f raaz-0.3.11/implementation/ChaCha20/CHandWritten.hs+formatted fd7ed676bf40 raaz-0.3.11/implementation/ChaCha20/CPortable.hs+formatted 2f7657c239d7 raaz-0.3.11/implementation/ChaCha20/Random/CPortable.hs+formatted e3deac8e5358 raaz-0.3.11/implementation/Poly1305/CPortable.hs+formatted 340ec557db99 raaz-0.3.11/implementation/Poly1305/Memory.hs+formatted 720f42375ee4 raaz-0.3.11/implementation/Sha256/CHandWritten.hs+formatted c064cc7a8421 raaz-0.3.11/implementation/Sha256/CPortable.hs+formatted a59c773526b4 raaz-0.3.11/implementation/Sha512/CHandWritten.hs+formatted 53529d47a59f raaz-0.3.11/implementation/Sha512/CPortable.hs+formatted e5d101450ea0 raaz-0.3.11/implementation/entropy/arc4random/Entropy.hs+formatted fe1af598e9b2 raaz-0.3.11/implementation/entropy/urandom/Entropy.hs+formatted 0a7a863b87f6 raaz-0.3.11/indef/Implementation.hsig+formatted 5b5f82999259 raaz-0.3.11/indef/Utils.hs+formatted 666dcbf885e6 raaz-0.3.11/indef/buffer/Buffer.hs+formatted 4d0bd2b93b60 raaz-0.3.11/indef/buffer/Context.hs+formatted d34b17eeb2fb raaz-0.3.11/indef/buffer/Implementation.hsig+formatted a79a9dc1ec44 raaz-0.3.11/indef/chacha20/Implementation.hsig+formatted 496eb8d3a6e9 raaz-0.3.11/indef/chacha20/XChaCha20/Implementation.hs+formatted a2c11b61575b raaz-0.3.11/indef/keyed/hash/Implementation.hsig+formatted 875f23f8f911 raaz-0.3.11/indef/keyed/hash/Mac/Implementation.hs+formatted fd3b4278ccc5 raaz-0.3.11/libverse/Raaz/Verse/Blake2b/C/Portable.hs+formatted 44b600e76f74 raaz-0.3.11/libverse/Raaz/Verse/ChaCha20/C/Portable.hs+formatted 221da1a1ba37 raaz-0.3.11/libverse/Raaz/Verse/Poly1305/C/Portable.hs+formatted 7ccb752d8b1d raaz-0.3.11/libverse/Raaz/Verse/Sha256/C/Portable.hs+formatted 695112ac1280 raaz-0.3.11/libverse/Raaz/Verse/Sha512/C/Portable.hs+formatted 2fbd14b119a4 raaz-0.3.11/monocypher/tests/Monocypher.hs+formatted 1d0ec4de7195 raaz-0.3.11/monocypher/tests/Monocypher/Blake2bSpec.hs+formatted 0c1244f02a18 raaz-0.3.11/monocypher/tests/Monocypher/ChaCha20Spec.hs+formatted e81070c8d0f4 raaz-0.3.11/monocypher/tests/Monocypher/Sha512Spec.hs+formatted 309f4011c1b9 raaz-0.3.11/raaz/Raaz.hs+formatted d7e15e03f1d7 raaz-0.3.11/raaz/Raaz/Auth.hs+formatted 44194680e191 raaz-0.3.11/raaz/Raaz/AuthEncrypt.hs+formatted 6c7dee472711 raaz-0.3.11/raaz/Raaz/AuthEncrypt/Unsafe.hs+formatted 1f2758b948a2 raaz-0.3.11/raaz/Raaz/Digest.hs+formatted fb3ff8903f10 raaz-0.3.11/raaz/Raaz/Random.hs+formatted 14ec81125123 raaz-0.3.11/raaz/Raaz/V1/Auth.hs+formatted 54d933b4519f raaz-0.3.11/raaz/Raaz/V1/AuthEncrypt.hs+formatted 9c227de3e844 raaz-0.3.11/raaz/Raaz/V1/AuthEncrypt/Unsafe.hs+formatted b221e97b02a1 raaz-0.3.11/raaz/Raaz/V1/Digest.hs+formatted a903f78514a8 raaz-0.3.11/raaz/bin/Command/Checksum.hs+formatted 6af965bca577 raaz-0.3.11/raaz/bin/Command/Info.hs+formatted 8b84f490d89a raaz-0.3.11/raaz/bin/Command/Rand.hs+formatted 2bbae784706a raaz-0.3.11/raaz/bin/Main.hs+formatted bb0aca2148f4 raaz-0.3.11/raaz/bin/Usage.hs+formatted 8955f3f595d6 raaz-0.3.11/tests/Raaz/Cipher/ChaCha20Spec.hs+formatted 66c20297d941 raaz-0.3.11/tests/Raaz/Cipher/XChaCha20Spec.hs+formatted f70ba0951ea5 raaz-0.3.11/tests/Raaz/Core/ByteSourceSpec.hs+formatted f50f5814ce13 raaz-0.3.11/tests/Raaz/Core/EncodeSpec.hs+formatted a5cc6d99aed2 raaz-0.3.11/tests/Raaz/Core/MemorySpec.hs+formatted 11c7d4db7839 raaz-0.3.11/tests/Raaz/Core/Types/WordSpec.hs+formatted e27cf91514a1 raaz-0.3.11/tests/Raaz/Core/Util/ByteStringSpec.hs+formatted 9d02caada1d9 raaz-0.3.11/tests/Raaz/Digest/Blake2Spec.hs+formatted 4f62e035aa97 raaz-0.3.11/tests/Raaz/Digest/Sha256Spec.hs+formatted ab3342a1c1c3 raaz-0.3.11/tests/Raaz/Digest/Sha512Spec.hs+formatted 57a10ec0221b raaz-0.3.11/tests/Raaz/Mac/Poly1305Spec.hs+formatted 6cdc5c00b3a8 raaz-0.3.11/tests/Raaz/RandomSpec.hs+formatted 2fbd14b119a4 raaz-0.3.11/tests/Spec.hs+formatted b1a4cba13110 raaz-0.3.11/tests/auth/Implementation.hsig+formatted ae7499e9f1a2 raaz-0.3.11/tests/auth/Tests/Auth.hs+formatted 146a3742af4d raaz-0.3.11/tests/auth/implementation/Auth/Mac/Blake2b.hs+formatted 1400f8497a4b raaz-0.3.11/tests/auth/implementation/Auth/Mac/Blake2s.hs+formatted f25bf91a517e raaz-0.3.11/tests/auth/implementation/Auth/Poly1305.hs+formatted 7123559f7c81 raaz-0.3.11/tests/cipher/Tests/Cipher.hs+formatted 0c05cee23c2f raaz-0.3.11/tests/comparative/AuthEncrypt.hs+formatted 97ef04d16217 raaz-0.3.11/tests/comparative/AuthEncrypt/ChaCha20Poly1305Spec.hs+formatted 741dc859a7b4 raaz-0.3.11/tests/comparative/Compare.hs+formatted 5a902c132987 raaz-0.3.11/tests/comparative/Digest.hs+formatted 9b0b9e470964 raaz-0.3.11/tests/comparative/Digest/Blake2bSpec.hs+formatted 5e40537778de raaz-0.3.11/tests/comparative/Digest/Sha256Spec.hs+formatted 1d23a17f155b raaz-0.3.11/tests/comparative/Digest/Sha512Spec.hs+formatted a5fa5869f401 raaz-0.3.11/tests/comparative/Encrypt.hs+formatted 43a4a9f511ea raaz-0.3.11/tests/comparative/Encrypt/ChaCha20Spec.hs+formatted 2fbd14b119a4 raaz-0.3.11/tests/comparative/Main.hs+formatted 9a4da070ca55 raaz-0.3.11/tests/core/Tests/Core.hs+formatted 2249765a4b51 raaz-0.3.11/tests/core/Tests/Core/Imports.hs+formatted c746b6855fd8 raaz-0.3.11/tests/core/Tests/Core/Instances.hs+formatted 62f66214a824 raaz-0.3.11/tests/core/Tests/Core/Utils.hs+formatted bcc780e22f03 raaz-0.3.11/tests/message-digest/Implementation.hsig+formatted 2bb252395b85 raaz-0.3.11/tests/message-digest/Tests/Digest.hs+formatted 4a8ac51676df random-1.3.1/Setup.hs+formatted f81df0c89774 random-1.3.1/bench-legacy/BinSearch.hs+formatted ec53458f4d57 random-1.3.1/bench-legacy/SimpleRNGBench.hs+formatted 0584292cc54f random-1.3.1/bench/Main.hs+formatted 3d4520480456 random-1.3.1/src/System/Random.hs+formatted 0719577a75c1 random-1.3.1/src/System/Random/Array.hs+formatted 0648347f5df7 random-1.3.1/src/System/Random/GFinite.hs+formatted 2d02e33ff4f9 random-1.3.1/src/System/Random/Internal.hs+formatted 43cf9948fc9c random-1.3.1/src/System/Random/Seed.hs+formatted 0d9957bbf13d random-1.3.1/src/System/Random/Stateful.hs+formatted 0d72e1db2b6d random-1.3.1/test-inspection/Spec.hs+formatted c6f769b56ab6 random-1.3.1/test-inspection/Spec/Inspection.hs+formatted ed91342d3f30 random-1.3.1/test-legacy/Legacy.hs+formatted 0160098f7cc5 random-1.3.1/test-legacy/Random1283.hs+formatted ad6c39289552 random-1.3.1/test-legacy/RangeTest.hs+formatted 4c1669996d8d random-1.3.1/test-legacy/T7936.hs+formatted 398febcc8a6f random-1.3.1/test-legacy/TestRandomIOs.hs+formatted 3ef25c06bdfc random-1.3.1/test-legacy/TestRandomRs.hs+formatted 170817d6d661 random-1.3.1/test/Spec.hs+formatted a65d68fad80b random-1.3.1/test/Spec/Range.hs+formatted e0e7306312ea random-1.3.1/test/Spec/Run.hs+formatted b3fd15d83ccf random-1.3.1/test/Spec/Seed.hs+formatted 53b268e9c80a random-1.3.1/test/Spec/Stateful.hs+formatted 8bcbf019c7ab recursion-schemes-5.2.3/examples/Expr.hs+formatted 0ec37f362849 recursion-schemes-5.2.3/src/Data/Functor/Base.hs+formatted 3ca7a5ae5fb0 recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs+formatted db17ac3b1e40 recursion-schemes-5.2.3/src/Data/Functor/Foldable/TH.hs+formatted 1581398eb1b5 resourcet-1.3.0/Control/Monad/Trans/Resource.hs+formatted 491af03a5ea1 resourcet-1.3.0/Control/Monad/Trans/Resource/Internal.hs+formatted 22ba33396e6e resourcet-1.3.0/Data/Acquire.hs+formatted 4a9defd159ee resourcet-1.3.0/Data/Acquire/Internal.hs+formatted 27565132aa25 resourcet-1.3.0/UnliftIO/Resource.hs+formatted 1434a2ae8bde resourcet-1.3.0/test/main.hs+formatted e865ae48f11b retry-0.9.3.1/Setup.hs+formatted d4f84e488fb0 retry-0.9.3.1/src/Control/Retry.hs+formatted cce7cb264472 retry-0.9.3.1/src/UnliftIO/Retry.hs+formatted 94b4a78445b3 retry-0.9.3.1/test/Main.hs+formatted 08af947c789a retry-0.9.3.1/test/Tests/Control/Retry.hs+formatted 0b770fc83ef2 retry-0.9.3.1/test/Tests/UnliftIO/Retry.hs+formatted e865ae48f11b safe-exceptions-0.1.7.4/Setup.hs+formatted 9dd8a8e1a75f safe-exceptions-0.1.7.4/src/Control/Exception/Safe.hs+formatted c34af7148814 safe-exceptions-0.1.7.4/test/Control/Exception/SafeSpec.hs+formatted 2fbd14b119a4 safe-exceptions-0.1.7.4/test/Spec.hs+formatted e865ae48f11b scientific-0.3.8.1/Setup.hs+formatted 6a2de24bbe1d scientific-0.3.8.1/bench/bench.hs+formatted b51f688e4f66 scientific-0.3.8.1/src/Data/ByteString/Builder/Scientific.hs+formatted a00104fdca94 scientific-0.3.8.1/src/Data/Scientific.hs+formatted 5837fdbf8485 scientific-0.3.8.1/src/Data/Text/Lazy/Builder/Scientific.hs+formatted 8e2c4142aa7f scientific-0.3.8.1/src/GHC/Integer/Compat.hs+formatted 70da6923c6d5 scientific-0.3.8.1/src/Utils.hs+formatted 511632de8f71 scientific-0.3.8.1/test/test.hs+formatted e865ae48f11b scotty-0.30/Setup.hs+formatted b4007b5fca90 scotty-0.30/Web/Scotty.hs+formatted 06db4e678a89 scotty-0.30/Web/Scotty/Action.hs+formatted 61431d95ef5b scotty-0.30/Web/Scotty/Body.hs+formatted 42bb0728a5d6 scotty-0.30/Web/Scotty/Cookie.hs+formatted 517b584372bf scotty-0.30/Web/Scotty/Internal/Types.hs+formatted ccdc72ea4dc8 scotty-0.30/Web/Scotty/Route.hs+formatted 220c453f0fd9 scotty-0.30/Web/Scotty/Session.hs+formatted 1d39c130ee80 scotty-0.30/Web/Scotty/Trans.hs+formatted e2036cbfa7c2 scotty-0.30/Web/Scotty/Trans/Lazy.hs+formatted 2645fdc50126 scotty-0.30/Web/Scotty/Trans/Strict.hs+formatted 6bad8484016a scotty-0.30/Web/Scotty/Util.hs+formatted 19a63b08e8cc scotty-0.30/bench/Main.hs+formatted ff18ebd00d97 scotty-0.30/doctest/Main.hs+formatted bfcc28288099 scotty-0.30/examples/basic.hs+formatted 128fcbdca77d scotty-0.30/examples/bodyecho.hs+formatted 0bfdeec9e9d5 scotty-0.30/examples/cookies.hs+formatted e68dfe58dd88 scotty-0.30/examples/exceptions.hs+formatted 99664eb0da8e scotty-0.30/examples/globalstate.hs+formatted 984bcbbe2aa7 scotty-0.30/examples/gzip.hs+formatted 8efdf09d4d75 scotty-0.30/examples/json_mode.hs+formatted d96b13ea35d6 scotty-0.30/examples/middleware.hs+formatted dd5796ac98ac scotty-0.30/examples/nested.hs+formatted f424d2128b4a scotty-0.30/examples/options.hs+formatted 8b1e46c9aeb7 scotty-0.30/examples/reader.hs+formatted 6750528250e9 scotty-0.30/examples/session.hs+formatted d40e0a8e64ea scotty-0.30/examples/upload.hs+formatted 94f10fda97e5 scotty-0.30/examples/urlshortener.hs+formatted 2fbd14b119a4 scotty-0.30/test/Spec.hs+formatted dd9baecda733 scotty-0.30/test/Test/Hspec/Wai/Extra.hs+formatted 409d10e2c1d9 scotty-0.30/test/Web/ScottySpec.hs+formatted 091ccbfea22a semigroupoids-6.0.2/src/Data/Bifunctor/Apply.hs+formatted 43f2fc743e76 semigroupoids-6.0.2/src/Data/Functor/Alt.hs+formatted b091ae1639ae semigroupoids-6.0.2/src/Data/Functor/Apply.hs+formatted 4322a16f4eaf semigroupoids-6.0.2/src/Data/Functor/Bind.hs+declined - semigroupoids-6.0.2/src/Data/Functor/Bind/Class.hs+formatted 82dabf65525e semigroupoids-6.0.2/src/Data/Functor/Bind/Trans.hs+formatted dbcbf10c5fed semigroupoids-6.0.2/src/Data/Functor/Contravariant/Conclude.hs+formatted a7b3bbac40b5 semigroupoids-6.0.2/src/Data/Functor/Contravariant/Decide.hs+formatted abf4c37d3996 semigroupoids-6.0.2/src/Data/Functor/Contravariant/Divise.hs+formatted 91c0a22860b9 semigroupoids-6.0.2/src/Data/Functor/Extend.hs+formatted da9d284cb9bb semigroupoids-6.0.2/src/Data/Functor/Plus.hs+formatted 2c9e2b95e1c6 semigroupoids-6.0.2/src/Data/Groupoid.hs+formatted 2a2382799a6a semigroupoids-6.0.2/src/Data/Isomorphism.hs+formatted c38d3ee4d146 semigroupoids-6.0.2/src/Data/Semigroup/Bifoldable.hs+formatted 3b69bf2b2c98 semigroupoids-6.0.2/src/Data/Semigroup/Bitraversable.hs+formatted 6ec751a395e5 semigroupoids-6.0.2/src/Data/Semigroup/Foldable.hs+formatted 15d51636f77f semigroupoids-6.0.2/src/Data/Semigroup/Foldable/Class.hs+formatted e46135ea634e semigroupoids-6.0.2/src/Data/Semigroup/Traversable.hs+formatted 5db895bd9aed semigroupoids-6.0.2/src/Data/Semigroup/Traversable/Class.hs+formatted 8288490eb6a8 semigroupoids-6.0.2/src/Data/Semigroupoid.hs+formatted b3380ca605a0 semigroupoids-6.0.2/src/Data/Semigroupoid/Categorical.hs+formatted 45153648a25d semigroupoids-6.0.2/src/Data/Semigroupoid/Dual.hs+formatted f1c21cb8613d semigroupoids-6.0.2/src/Data/Semigroupoid/Ob.hs+formatted b8cb23896bf9 semigroupoids-6.0.2/src/Data/Semigroupoid/Static.hs+formatted 9945f77c9069 semigroupoids-6.0.2/src/Data/Traversable/Instances.hs+formatted 4f91affffbe0 semigroupoids-6.0.2/src/Semigroupoids/Do.hs+formatted 689e1e042e62 semigroupoids-6.0.2/src/Semigroupoids/Internal.hs+formatted e865ae48f11b servant-0.20.3.0/Setup.hs+formatted 9153c9da89d5 servant-0.20.3.0/src/Servant/API.hs+formatted 6ca32413e226 servant-0.20.3.0/src/Servant/API/Alternative.hs+formatted c265b91e3c97 servant-0.20.3.0/src/Servant/API/BasicAuth.hs+formatted a2c409071755 servant-0.20.3.0/src/Servant/API/Capture.hs+formatted a15886878620 servant-0.20.3.0/src/Servant/API/ContentTypes.hs+formatted ae6eeb995066 servant-0.20.3.0/src/Servant/API/Description.hs+formatted 3529480c44cb servant-0.20.3.0/src/Servant/API/Empty.hs+formatted ca9f880fe9c3 servant-0.20.3.0/src/Servant/API/Experimental/Auth.hs+formatted 1cb7b7979a37 servant-0.20.3.0/src/Servant/API/Fragment.hs+formatted 0b0271e38424 servant-0.20.3.0/src/Servant/API/Generic.hs+formatted 6ace49e9ee6c servant-0.20.3.0/src/Servant/API/Header.hs+formatted a4120f74a189 servant-0.20.3.0/src/Servant/API/Host.hs+formatted 9add62e890f1 servant-0.20.3.0/src/Servant/API/HttpVersion.hs+formatted efd092f09057 servant-0.20.3.0/src/Servant/API/IsSecure.hs+formatted 714c99b4ea0e servant-0.20.3.0/src/Servant/API/Modifiers.hs+formatted 684bc7886ecb servant-0.20.3.0/src/Servant/API/MultiVerb.hs+formatted 56acb7471063 servant-0.20.3.0/src/Servant/API/NamedRoutes.hs+formatted 2a67c6814cd7 servant-0.20.3.0/src/Servant/API/QueryParam.hs+formatted c9e33c06dd4d servant-0.20.3.0/src/Servant/API/QueryString.hs+formatted d94765f780c5 servant-0.20.3.0/src/Servant/API/Range.hs+formatted 54177faefb7f servant-0.20.3.0/src/Servant/API/Raw.hs+formatted 0d8ceb92e030 servant-0.20.3.0/src/Servant/API/RemoteHost.hs+formatted fa0f8d364af9 servant-0.20.3.0/src/Servant/API/ReqBody.hs+formatted 8acf042b8234 servant-0.20.3.0/src/Servant/API/ResponseHeaders.hs+formatted c67668bb6c05 servant-0.20.3.0/src/Servant/API/ServerSentEvents.hs+formatted d944ce6b72bb servant-0.20.3.0/src/Servant/API/Status.hs+formatted 80b82bca3c39 servant-0.20.3.0/src/Servant/API/Stream.hs+formatted edf5b4aed88d servant-0.20.3.0/src/Servant/API/Sub.hs+formatted ff144efc7edd servant-0.20.3.0/src/Servant/API/TypeErrors.hs+formatted 29ad4adf0dc7 servant-0.20.3.0/src/Servant/API/TypeLevel.hs+formatted c0878f59a227 servant-0.20.3.0/src/Servant/API/TypeLevel/List.hs+formatted 9be4a4b0a678 servant-0.20.3.0/src/Servant/API/UVerb.hs+formatted 46da2eb7f65a servant-0.20.3.0/src/Servant/API/UVerb/Union.hs+formatted 635eed50f570 servant-0.20.3.0/src/Servant/API/Vault.hs+formatted 2dc0c94ac83c servant-0.20.3.0/src/Servant/API/Verbs.hs+formatted 5dcaa0e3d262 servant-0.20.3.0/src/Servant/API/WithNamedContext.hs+formatted c8d1802909fc servant-0.20.3.0/src/Servant/API/WithResource.hs+formatted 7bd50129afee servant-0.20.3.0/src/Servant/Links.hs+formatted 4a79910df177 servant-0.20.3.0/src/Servant/Test/ComprehensiveAPI.hs+formatted 72397d3bb59f servant-0.20.3.0/src/Servant/Types/Internal/Response.hs+formatted e57b2e66d9d5 servant-0.20.3.0/src/Servant/Types/SourceT.hs+formatted 8e01166db243 servant-0.20.3.0/test/Servant/API/ContentTypesSpec.hs+formatted 8d914b5e174f servant-0.20.3.0/test/Servant/API/ResponseHeadersSpec.hs+formatted 19481f24edd2 servant-0.20.3.0/test/Servant/API/StreamSpec.hs+formatted 4f1634d779c6 servant-0.20.3.0/test/Servant/LinksSpec.hs+formatted 2fbd14b119a4 servant-0.20.3.0/test/Spec.hs+formatted e865ae48f11b servant-server-0.20.3.0/Setup.hs+formatted e0bc38ee2107 servant-server-0.20.3.0/example/greet.hs+formatted a401126eeff8 servant-server-0.20.3.0/src/Servant.hs+formatted 9ef459de1886 servant-server-0.20.3.0/src/Servant/Server.hs+formatted 1f26409f3f2c servant-server-0.20.3.0/src/Servant/Server/Experimental/Auth.hs+formatted 6fc6eff93d47 servant-server-0.20.3.0/src/Servant/Server/Generic.hs+formatted a4686d4d8168 servant-server-0.20.3.0/src/Servant/Server/Internal.hs+formatted 6ece26e7e14b servant-server-0.20.3.0/src/Servant/Server/Internal/BasicAuth.hs+formatted 840da824ddc2 servant-server-0.20.3.0/src/Servant/Server/Internal/Context.hs+formatted f75d6b244e90 servant-server-0.20.3.0/src/Servant/Server/Internal/Delayed.hs+formatted b1e176cb1e12 servant-server-0.20.3.0/src/Servant/Server/Internal/DelayedIO.hs+formatted 577b2ebfe120 servant-server-0.20.3.0/src/Servant/Server/Internal/ErrorFormatter.hs+formatted a235c4a5477e servant-server-0.20.3.0/src/Servant/Server/Internal/Handler.hs+formatted bd96b8ecb097 servant-server-0.20.3.0/src/Servant/Server/Internal/ResponseRender.hs+formatted f0244940436b servant-server-0.20.3.0/src/Servant/Server/Internal/RouteResult.hs+formatted c383b059c7cd servant-server-0.20.3.0/src/Servant/Server/Internal/Router.hs+formatted 09cdf39e03b6 servant-server-0.20.3.0/src/Servant/Server/Internal/RoutingApplication.hs+formatted b15781d6d1a7 servant-server-0.20.3.0/src/Servant/Server/Internal/ServerError.hs+formatted 4be302b8cfbe servant-server-0.20.3.0/src/Servant/Server/StaticFiles.hs+formatted 7a929eb5f6c6 servant-server-0.20.3.0/src/Servant/Server/UVerb.hs+formatted d43150f68994 servant-server-0.20.3.0/src/Servant/Utils/StaticFiles.hs+formatted e9e090db95fa servant-server-0.20.3.0/test/Servant/ArbitraryMonadServerSpec.hs+formatted a92186c8737e servant-server-0.20.3.0/test/Servant/HoistSpec.hs+formatted 5a2bd30f3c12 servant-server-0.20.3.0/test/Servant/Server/ErrorSpec.hs+formatted 6f993e850de5 servant-server-0.20.3.0/test/Servant/Server/Internal/ContextSpec.hs+formatted 6979f09da111 servant-server-0.20.3.0/test/Servant/Server/Internal/RoutingApplicationSpec.hs+formatted ebf15aace7c8 servant-server-0.20.3.0/test/Servant/Server/RouterSpec.hs+formatted ca1d8b69c2d4 servant-server-0.20.3.0/test/Servant/Server/StaticFilesSpec.hs+formatted e9a7ef4fbb57 servant-server-0.20.3.0/test/Servant/Server/StreamingSpec.hs+formatted 6bd03c4fd0e6 servant-server-0.20.3.0/test/Servant/Server/UsingContextSpec.hs+formatted c68eea536d8f servant-server-0.20.3.0/test/Servant/Server/UsingContextSpec/TestCombinators.hs+formatted 52710abf0bdb servant-server-0.20.3.0/test/Servant/ServerSpec.hs+formatted 2fbd14b119a4 servant-server-0.20.3.0/test/Spec.hs+formatted e865ae48f11b shake-0.19.9/Setup.hs+formatted 85840851c997 shake-0.19.9/docs/manual/Shakefile.hs+formatted 659df897f906 shake-0.19.9/src/Development/Ninja/All.hs+formatted 3104f3ca6fe0 shake-0.19.9/src/Development/Ninja/Env.hs+formatted 7cb2becdc041 shake-0.19.9/src/Development/Ninja/Lexer.hs+formatted 750928680562 shake-0.19.9/src/Development/Ninja/Parse.hs+formatted c0a33fcdb116 shake-0.19.9/src/Development/Ninja/Type.hs+formatted 1e091717f0e4 shake-0.19.9/src/Development/Shake.hs+formatted 5a0ba406abd6 shake-0.19.9/src/Development/Shake/Classes.hs+formatted 7ae91e4024b4 shake-0.19.9/src/Development/Shake/Command.hs+formatted 5959e8996e24 shake-0.19.9/src/Development/Shake/Config.hs+formatted e9d594f06006 shake-0.19.9/src/Development/Shake/Database.hs+formatted 6a9f5286dbbd shake-0.19.9/src/Development/Shake/FilePath.hs+formatted 4da3a2b0f58b shake-0.19.9/src/Development/Shake/Forward.hs+formatted 7718900e8a44 shake-0.19.9/src/Development/Shake/Internal/Args.hs+formatted 176c017dbbd9 shake-0.19.9/src/Development/Shake/Internal/CmdOption.hs+formatted aaf913d99d5c shake-0.19.9/src/Development/Shake/Internal/CompactUI.hs+formatted f6bbbd69a477 shake-0.19.9/src/Development/Shake/Internal/Core/Action.hs+formatted 66a65bc9bc34 shake-0.19.9/src/Development/Shake/Internal/Core/Build.hs+formatted 4e75290b3b44 shake-0.19.9/src/Development/Shake/Internal/Core/Database.hs+formatted 3e4afc55b835 shake-0.19.9/src/Development/Shake/Internal/Core/Monad.hs+formatted e0107f7baea9 shake-0.19.9/src/Development/Shake/Internal/Core/Pool.hs+formatted f6fa2073bad8 shake-0.19.9/src/Development/Shake/Internal/Core/Rules.hs+formatted cf3d65d83229 shake-0.19.9/src/Development/Shake/Internal/Core/Run.hs+formatted 5af9f97a9e29 shake-0.19.9/src/Development/Shake/Internal/Core/Storage.hs+formatted ab347cc10d7a shake-0.19.9/src/Development/Shake/Internal/Core/Types.hs+formatted 30ee262fedde shake-0.19.9/src/Development/Shake/Internal/Demo.hs+formatted 1afe6f5f82c8 shake-0.19.9/src/Development/Shake/Internal/Derived.hs+formatted 09c8188aa053 shake-0.19.9/src/Development/Shake/Internal/Errors.hs+declined - shake-0.19.9/src/Development/Shake/Internal/FileInfo.hs+formatted 759fa2b54278 shake-0.19.9/src/Development/Shake/Internal/FileName.hs+formatted 4d3c15baa1e4 shake-0.19.9/src/Development/Shake/Internal/FilePattern.hs+formatted 1e054a94085b shake-0.19.9/src/Development/Shake/Internal/History/Bloom.hs+formatted 01551ed3cbf4 shake-0.19.9/src/Development/Shake/Internal/History/Cloud.hs+formatted 249ed8efaa13 shake-0.19.9/src/Development/Shake/Internal/History/Network.hs+formatted 4f537be442b0 shake-0.19.9/src/Development/Shake/Internal/History/Serialise.hs+formatted 14a6f9c117dc shake-0.19.9/src/Development/Shake/Internal/History/Server.hs+formatted bf25365673d0 shake-0.19.9/src/Development/Shake/Internal/History/Shared.hs+declined - shake-0.19.9/src/Development/Shake/Internal/History/Symlink.hs+formatted 765062af5b1e shake-0.19.9/src/Development/Shake/Internal/History/Types.hs+formatted 7a68e11d3f88 shake-0.19.9/src/Development/Shake/Internal/Options.hs+formatted c8651e83c45c shake-0.19.9/src/Development/Shake/Internal/Paths.hs+formatted 208cc40e49ba shake-0.19.9/src/Development/Shake/Internal/Profile.hs+declined - shake-0.19.9/src/Development/Shake/Internal/Progress.hs+formatted c9971fdca3e5 shake-0.19.9/src/Development/Shake/Internal/Resource.hs+formatted 5733144919c3 shake-0.19.9/src/Development/Shake/Internal/Rules/Default.hs+formatted 8a63ca21fcda shake-0.19.9/src/Development/Shake/Internal/Rules/Directory.hs+formatted f000c73ea4b7 shake-0.19.9/src/Development/Shake/Internal/Rules/File.hs+formatted 6e7322f7f7c1 shake-0.19.9/src/Development/Shake/Internal/Rules/Files.hs+formatted 18637b215cdb shake-0.19.9/src/Development/Shake/Internal/Rules/Oracle.hs+formatted b0d13ac0a3a9 shake-0.19.9/src/Development/Shake/Internal/Rules/OrderOnly.hs+formatted 941f5cc2dd1d shake-0.19.9/src/Development/Shake/Internal/Rules/Rerun.hs+formatted 25ffba5bb7e7 shake-0.19.9/src/Development/Shake/Internal/Value.hs+formatted 4f57cc655ba3 shake-0.19.9/src/Development/Shake/Rule.hs+formatted 2df0d77b7d5c shake-0.19.9/src/Development/Shake/Util.hs+formatted 796b5a76fb8c shake-0.19.9/src/General/Bilist.hs+formatted a2e9bfc4e206 shake-0.19.9/src/General/Binary.hs+formatted 0208bf728797 shake-0.19.9/src/General/Chunks.hs+formatted d8ae6dd155de shake-0.19.9/src/General/Cleanup.hs+declined - shake-0.19.9/src/General/EscCodes.hs+formatted 5c8c7f7e8bf2 shake-0.19.9/src/General/Extra.hs+formatted 6ac31a44af53 shake-0.19.9/src/General/Fence.hs+declined - shake-0.19.9/src/General/FileLock.hs+formatted 4813c23ad42d shake-0.19.9/src/General/GetOpt.hs+formatted 5efc029ad726 shake-0.19.9/src/General/Ids.hs+formatted 9126ed0fbd34 shake-0.19.9/src/General/Intern.hs+formatted 5049f87854f9 shake-0.19.9/src/General/ListBuilder.hs+formatted 54fa4898327b shake-0.19.9/src/General/Makefile.hs+formatted e1829b34f218 shake-0.19.9/src/General/Pool.hs+formatted 4e88a21092ea shake-0.19.9/src/General/Process.hs+formatted 0d39543216b1 shake-0.19.9/src/General/Template.hs+formatted 20e74944695a shake-0.19.9/src/General/Thread.hs+formatted b9b9368bdf92 shake-0.19.9/src/General/Timing.hs+formatted f1cfb5928cdc shake-0.19.9/src/General/TypeMap.hs+formatted 8d69ed0989cc shake-0.19.9/src/General/Wait.hs+formatted 4743f12ee1b5 shake-0.19.9/src/Paths.hs+formatted 80112aa74398 shake-0.19.9/src/Run.hs+formatted e59791013e00 shake-0.19.9/src/Test.hs+formatted 8559d6daa99e shake-0.19.9/src/Test/Basic.hs+formatted 93ef4d632053 shake-0.19.9/src/Test/Batch.hs+formatted 9817e09728fc shake-0.19.9/src/Test/Benchmark.hs+formatted 72e8b4ab4dea shake-0.19.9/src/Test/Builtin.hs+formatted 48ec6eca2417 shake-0.19.9/src/Test/BuiltinOverride.hs+formatted 10efc06e6c7b shake-0.19.9/src/Test/C.hs+formatted 53e433c2fd6d shake-0.19.9/src/Test/Cache.hs+formatted 2d7ccbb45ced shake-0.19.9/src/Test/Cleanup.hs+formatted 448b76c4e03f shake-0.19.9/src/Test/CloseFileHandles.hs+formatted 52e8e06b790c shake-0.19.9/src/Test/Command.hs+formatted 5ea96ce5a74d shake-0.19.9/src/Test/Config.hs+formatted 42fd949d6eef shake-0.19.9/src/Test/Database.hs+formatted e8ca948ce33e shake-0.19.9/src/Test/Digest.hs+formatted 9b70158e614d shake-0.19.9/src/Test/Directory.hs+formatted 6bbe2ff03da5 shake-0.19.9/src/Test/Docs.hs+formatted 7425a9004035 shake-0.19.9/src/Test/Errors.hs+formatted b698eeb22c5b shake-0.19.9/src/Test/Existence.hs+formatted 33dfd1039065 shake-0.19.9/src/Test/FileLock.hs+formatted 53f9a23d9106 shake-0.19.9/src/Test/FilePath.hs+formatted f735f16c91d5 shake-0.19.9/src/Test/FilePattern.hs+formatted 7f088d1e23e6 shake-0.19.9/src/Test/Files.hs+formatted f46b5feb3e77 shake-0.19.9/src/Test/Forward.hs+formatted 07a41b0c82df shake-0.19.9/src/Test/History.hs+formatted a6278c0f744f shake-0.19.9/src/Test/Journal.hs+formatted ea3088aef841 shake-0.19.9/src/Test/Lint.hs+formatted abb6b38a5148 shake-0.19.9/src/Test/Live.hs+formatted b1f4f9102098 shake-0.19.9/src/Test/Manual.hs+formatted 0ea86eab061d shake-0.19.9/src/Test/Match.hs+formatted 3358afb343e9 shake-0.19.9/src/Test/Monad.hs+formatted 30eaa5d85dba shake-0.19.9/src/Test/Ninja.hs+formatted 78f51e13afdb shake-0.19.9/src/Test/Oracle.hs+formatted 3a29cbe0f415 shake-0.19.9/src/Test/OrderOnly.hs+formatted 11c7d4112a98 shake-0.19.9/src/Test/Parallel.hs+formatted af1e17f9eab1 shake-0.19.9/src/Test/Pool.hs+formatted 278a912d8e40 shake-0.19.9/src/Test/Progress.hs+formatted 8f84d993fd5b shake-0.19.9/src/Test/Random.hs+formatted 2cbfb37c7d59 shake-0.19.9/src/Test/Rebuild.hs+formatted 685ecba8ab37 shake-0.19.9/src/Test/Reschedule.hs+formatted a4beab4d5e04 shake-0.19.9/src/Test/Resources.hs+formatted 4c2e03f5a06d shake-0.19.9/src/Test/Self.hs+formatted f161b0f0a749 shake-0.19.9/src/Test/SelfMake.hs+formatted ce7a14c40a6c shake-0.19.9/src/Test/Tar.hs+formatted 010efc5cef7a shake-0.19.9/src/Test/Targets.hs+formatted 2ada3fd9cfe5 shake-0.19.9/src/Test/Thread.hs+formatted 54ac2eb76326 shake-0.19.9/src/Test/Tup.hs+formatted 306bd01403f4 shake-0.19.9/src/Test/Type.hs+formatted 068337f03a57 shake-0.19.9/src/Test/Unicode.hs+formatted 312e45ba1b16 shake-0.19.9/src/Test/Util.hs+formatted 6649fd7b7e4a shake-0.19.9/src/Test/Verbosity.hs+formatted f32aa5af75ac shake-0.19.9/src/Test/Version.hs+formatted a7151db2ed5c split-0.2.5/src/Data/List/Split.hs+formatted 63fb58665984 split-0.2.5/src/Data/List/Split/Internals.hs+formatted 1c394a59af79 split-0.2.5/test/Properties.hs+formatted e865ae48f11b stack-9.9.9/Setup.hs+formatted e865ae48f11b stack-9.9.9/new-template/Setup.hs+formatted 76b6ff5a6856 stack-9.9.9/new-template/app/Main.hs+formatted b206a21d3b3c stack-9.9.9/new-template/src/Lib.hs+formatted ef8d1c0c14bd stack-9.9.9/new-template/test/Spec.hs+formatted 2cb36e6bb1bb stack-9.9.9/src/Control/Concurrent/Execute.hs+formatted de0bbff44bba stack-9.9.9/src/Data/Aeson/Extended.hs+formatted 45b24cbb6885 stack-9.9.9/src/Data/Attoparsec/Args.hs+formatted 6be772a6002d stack-9.9.9/src/Data/Attoparsec/Combinators.hs+formatted e4f1165dc10b stack-9.9.9/src/Data/Binary/VersionTagged.hs+formatted b0799314dce2 stack-9.9.9/src/Data/Maybe/Extra.hs+formatted 8740a5fcb2ef stack-9.9.9/src/Data/Set/Monad.hs+formatted 40389f299346 stack-9.9.9/src/Network/HTTP/Download.hs+formatted 9e93dca6ce44 stack-9.9.9/src/Network/HTTP/Download/Verified.hs+formatted d7a0d294e3c7 stack-9.9.9/src/Options/Applicative/Args.hs+formatted 0116483c0e39 stack-9.9.9/src/Options/Applicative/Builder/Extra.hs+formatted 35d5981b158d stack-9.9.9/src/Path/Find.hs+formatted eafb883091d5 stack-9.9.9/src/Path/IO.hs+formatted 2df07688f5ed stack-9.9.9/src/Stack/Build.hs+formatted bdc4f36f2c62 stack-9.9.9/src/Stack/Build/Cache.hs+formatted 846d984fa5a3 stack-9.9.9/src/Stack/Build/ConstructPlan.hs+formatted 335c39b2a711 stack-9.9.9/src/Stack/Build/Execute.hs+formatted c154ec698482 stack-9.9.9/src/Stack/Build/Haddock.hs+formatted d45c6e3e96c6 stack-9.9.9/src/Stack/Build/Installed.hs+formatted 8f851999c795 stack-9.9.9/src/Stack/Build/Source.hs+formatted 4d0e41188711 stack-9.9.9/src/Stack/Build/Types.hs+formatted c422573c7530 stack-9.9.9/src/Stack/BuildPlan.hs+formatted dc215b9523e2 stack-9.9.9/src/Stack/Config.hs+formatted db186c830bf3 stack-9.9.9/src/Stack/Constants.hs+formatted 655fc3d77d9a stack-9.9.9/src/Stack/Docker.hs+formatted 7dac02fa726c stack-9.9.9/src/Stack/Docker/GlobalDB.hs+formatted 7d15eaae39ff stack-9.9.9/src/Stack/Dot.hs+formatted e3fe02818737 stack-9.9.9/src/Stack/Exec.hs+formatted 44beb7f3ec53 stack-9.9.9/src/Stack/Fetch.hs+formatted 667b523cf3db stack-9.9.9/src/Stack/GhcPkg.hs+formatted 733ecb413de7 stack-9.9.9/src/Stack/Init.hs+formatted 9f228f8da7ce stack-9.9.9/src/Stack/New.hs+formatted ebbee12a77fc stack-9.9.9/src/Stack/Package.hs+formatted a4d6c3332390 stack-9.9.9/src/Stack/PackageDump.hs+formatted 2b3785c57355 stack-9.9.9/src/Stack/PackageIndex.hs+formatted 2814387b2b76 stack-9.9.9/src/Stack/Repl.hs+formatted 8d70e82cb03c stack-9.9.9/src/Stack/Setup.hs+formatted 68c48310e4ce stack-9.9.9/src/Stack/Solver.hs+formatted ebbf896669e4 stack-9.9.9/src/Stack/Types.hs+formatted 4f7543f1a686 stack-9.9.9/src/Stack/Types/BuildPlan.hs+formatted 38eedeb37ea4 stack-9.9.9/src/Stack/Types/Config.hs+formatted dc9a426c72cd stack-9.9.9/src/Stack/Types/Docker.hs+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 88a4f8bd73e5 stack-9.9.9/src/Stack/Types/PackageName.hs+formatted bcc9e5fa699d stack-9.9.9/src/Stack/Types/StackT.hs+formatted 403717ac1cf2 stack-9.9.9/src/Stack/Types/Version.hs+formatted 2f4855580908 stack-9.9.9/src/Stack/Upgrade.hs+formatted e1e4da453112 stack-9.9.9/src/Stack/Upload.hs+formatted 85d5e680f53b stack-9.9.9/src/System/Process/Log.hs+formatted 015e3efd2d86 stack-9.9.9/src/System/Process/PagerEditor.hs+formatted 3d6b7b0e58e8 stack-9.9.9/src/System/Process/Read.hs+formatted c40dad9ce8ee stack-9.9.9/src/System/Process/Run.hs+formatted fc7e2b25ab4e stack-9.9.9/src/main/Main.hs+formatted 4eec70869c80 stack-9.9.9/src/main/Plugins.hs+formatted 50b246d28182 stack-9.9.9/src/main/Plugins/Commands.hs+formatted 65c8c298f7aa stack-9.9.9/src/test/Spec.hs+formatted bbf9464a53ee stack-9.9.9/src/test/Stack/ArgsSpec.hs+formatted 41ea23b8880f stack-9.9.9/src/test/Stack/Build/ExecuteSpec.hs+formatted 38d5f430f742 stack-9.9.9/src/test/Stack/BuildPlanSpec.hs+formatted 8f505819b19a stack-9.9.9/src/test/Stack/ConfigSpec.hs+formatted 2d4cbcc98b0c stack-9.9.9/src/test/Stack/PackageDumpSpec.hs+formatted fd075df62297 stack-9.9.9/src/test/Test.hs+formatted 53953d153dfa stack-9.9.9/test/integration/Spec.hs+formatted 56e4e5258116 statistics-0.16.5.0/Statistics/Autocorrelation.hs+formatted bda03074d5aa statistics-0.16.5.0/Statistics/ConfidenceInt.hs+formatted 069d7156f594 statistics-0.16.5.0/Statistics/Correlation.hs+formatted 9ba74f547b39 statistics-0.16.5.0/Statistics/Correlation/Kendall.hs+formatted bbd4e3259f36 statistics-0.16.5.0/Statistics/Distribution.hs+formatted ae8ad80251ff statistics-0.16.5.0/Statistics/Distribution/Beta.hs+formatted 7b32fc5b6cfc statistics-0.16.5.0/Statistics/Distribution/Binomial.hs+formatted 23f140cdf9bc statistics-0.16.5.0/Statistics/Distribution/CauchyLorentz.hs+formatted dc30bfda499d statistics-0.16.5.0/Statistics/Distribution/ChiSquared.hs+formatted f4734696df71 statistics-0.16.5.0/Statistics/Distribution/DiscreteUniform.hs+formatted cc3d61a22aa0 statistics-0.16.5.0/Statistics/Distribution/Exponential.hs+formatted 5d35b356cb29 statistics-0.16.5.0/Statistics/Distribution/FDistribution.hs+formatted 1258f180d7c0 statistics-0.16.5.0/Statistics/Distribution/Gamma.hs+formatted 97a9584986c7 statistics-0.16.5.0/Statistics/Distribution/Geometric.hs+formatted e05ef1359929 statistics-0.16.5.0/Statistics/Distribution/Hypergeometric.hs+formatted ca93eabbbf15 statistics-0.16.5.0/Statistics/Distribution/Laplace.hs+formatted 1e363f04365e statistics-0.16.5.0/Statistics/Distribution/Lognormal.hs+formatted f5cce916fd78 statistics-0.16.5.0/Statistics/Distribution/NegativeBinomial.hs+formatted fb17da6ed19d statistics-0.16.5.0/Statistics/Distribution/Normal.hs+formatted 1bbb63345a51 statistics-0.16.5.0/Statistics/Distribution/Poisson.hs+formatted fb54f6de83df statistics-0.16.5.0/Statistics/Distribution/Poisson/Internal.hs+formatted f2dd661c1f1a statistics-0.16.5.0/Statistics/Distribution/StudentT.hs+formatted 06505b01e90a statistics-0.16.5.0/Statistics/Distribution/Transform.hs+formatted ead3df94c4d5 statistics-0.16.5.0/Statistics/Distribution/Uniform.hs+formatted bd8bb4f92c76 statistics-0.16.5.0/Statistics/Distribution/Weibull.hs+formatted 1a6eda2dc778 statistics-0.16.5.0/Statistics/Function.hs+formatted 4ce5ca3ee348 statistics-0.16.5.0/Statistics/Internal.hs+formatted 86e8d1a0a535 statistics-0.16.5.0/Statistics/Quantile.hs+formatted 4eb8961889ae statistics-0.16.5.0/Statistics/Regression.hs+formatted 535c5c96b342 statistics-0.16.5.0/Statistics/Resampling.hs+formatted 76d271403a9e statistics-0.16.5.0/Statistics/Resampling/Bootstrap.hs+formatted cc05168e10be statistics-0.16.5.0/Statistics/Sample.hs+formatted 24ce2ba6d88a statistics-0.16.5.0/Statistics/Sample/Histogram.hs+formatted cab9e68a7e21 statistics-0.16.5.0/Statistics/Sample/Internal.hs+formatted 43f665ddfdd4 statistics-0.16.5.0/Statistics/Sample/KernelDensity.hs+formatted 57cb926959b9 statistics-0.16.5.0/Statistics/Sample/KernelDensity/Simple.hs+formatted e7d037eb7906 statistics-0.16.5.0/Statistics/Sample/Normalize.hs+formatted 1242733971ab statistics-0.16.5.0/Statistics/Sample/Powers.hs+formatted a2b672b48aca statistics-0.16.5.0/Statistics/Test/Bartlett.hs+formatted da8b73ff5c88 statistics-0.16.5.0/Statistics/Test/ChiSquared.hs+formatted 4990518d53f6 statistics-0.16.5.0/Statistics/Test/Internal.hs+formatted e5d5a7822558 statistics-0.16.5.0/Statistics/Test/KolmogorovSmirnov.hs+formatted 68068b68b9a0 statistics-0.16.5.0/Statistics/Test/KruskalWallis.hs+formatted 6e9db487a147 statistics-0.16.5.0/Statistics/Test/Levene.hs+formatted a4c13293539e statistics-0.16.5.0/Statistics/Test/MannWhitneyU.hs+formatted 63ad198bde51 statistics-0.16.5.0/Statistics/Test/StudentT.hs+formatted 8222073f1e45 statistics-0.16.5.0/Statistics/Test/Types.hs+formatted f3c789b5cb44 statistics-0.16.5.0/Statistics/Test/WilcoxonT.hs+formatted 4dc98e7c6347 statistics-0.16.5.0/Statistics/Transform.hs+formatted f4cfb5a2aebb statistics-0.16.5.0/Statistics/Types.hs+formatted f071cb4c4814 statistics-0.16.5.0/Statistics/Types/Internal.hs+formatted b5402a2dc355 statistics-0.16.5.0/bench-papi/Bench.hs+formatted 3963835f0889 statistics-0.16.5.0/bench-time/Bench.hs+formatted 61d4105d3456 statistics-0.16.5.0/benchmark/Main.hs+formatted d80f7bf6f96d statistics-0.16.5.0/examples/kde/KDE.hs+formatted dcea40eeb511 statistics-0.16.5.0/tests/Tests/ApproxEq.hs+formatted 2ae25961f71d statistics-0.16.5.0/tests/Tests/Correlation.hs+formatted b0317e3f9b24 statistics-0.16.5.0/tests/Tests/Distribution.hs+formatted 3d4db70bc7ca statistics-0.16.5.0/tests/Tests/ExactDistribution.hs+formatted 299f43f28485 statistics-0.16.5.0/tests/Tests/Function.hs+formatted 9c5a618f3bf1 statistics-0.16.5.0/tests/Tests/Helpers.hs+formatted fec77bb7c2ff statistics-0.16.5.0/tests/Tests/KDE.hs+formatted cf822ef362eb statistics-0.16.5.0/tests/Tests/Matrix.hs+formatted 27d419347379 statistics-0.16.5.0/tests/Tests/Matrix/Types.hs+formatted ea56dc62a57a statistics-0.16.5.0/tests/Tests/NonParametric.hs+formatted 4d0172724882 statistics-0.16.5.0/tests/Tests/NonParametric/Table.hs+formatted 65adfee8e313 statistics-0.16.5.0/tests/Tests/Orphanage.hs+formatted bc01b981cd07 statistics-0.16.5.0/tests/Tests/Parametric.hs+formatted bb2edc2f982d statistics-0.16.5.0/tests/Tests/Quantile.hs+formatted 4e08d3c82170 statistics-0.16.5.0/tests/Tests/Serialization.hs+formatted d60faa0d5f6c statistics-0.16.5.0/tests/Tests/Transform.hs+formatted 55f699624c9d statistics-0.16.5.0/tests/doctest.hs+formatted f0e3d45c9159 statistics-0.16.5.0/tests/tests.hs+formatted 2c4811cee336 stm-2.5.3.1/Control/Concurrent/STM.hs+formatted fd81deb0a4a0 stm-2.5.3.1/Control/Concurrent/STM/TArray.hs+formatted 9e9c5d20cb7c stm-2.5.3.1/Control/Concurrent/STM/TBQueue.hs+formatted 643c4c4304ca stm-2.5.3.1/Control/Concurrent/STM/TChan.hs+formatted 5de1c73d983a stm-2.5.3.1/Control/Concurrent/STM/TMVar.hs+formatted 4fabec7ab606 stm-2.5.3.1/Control/Concurrent/STM/TQueue.hs+formatted 0167cfd0c06a stm-2.5.3.1/Control/Concurrent/STM/TSem.hs+formatted 6a0ece958ded stm-2.5.3.1/Control/Concurrent/STM/TVar.hs+partly-checked 6aa0575474c4 stm-2.5.3.1/Control/Monad/STM.hs+formatted 6aecb29a12ab stm-2.5.3.1/Control/Sequential/STM.hs+formatted 7474b7e1d4f5 stm-2.5.3.1/Setup.hs+formatted e290291970ca stm-2.5.3.1/testsuite/src/Issue17.hs+formatted c3343c4d48cb stm-2.5.3.1/testsuite/src/Issue9.hs+formatted 9159857aaf7c stm-2.5.3.1/testsuite/src/Main.hs+formatted 5a7bdca5eb2f stm-2.5.3.1/testsuite/src/Stm052.hs+formatted 9b30ce222d29 stm-2.5.3.1/testsuite/src/Stm064.hs+formatted 0f86f9b94d82 stm-2.5.3.1/testsuite/src/Stm065.hs+formatted 0872066614e0 swagger2-2.9.1/Setup.hs+formatted e53974342c33 swagger2-2.9.1/examples/hackage.hs+formatted bbac1d7e9767 swagger2-2.9.1/src/Data/HashMap/Strict/InsOrd/Compat.hs+formatted d71d272f220f swagger2-2.9.1/src/Data/Swagger.hs+formatted 3a66f17ffe6b swagger2-2.9.1/src/Data/Swagger/Declare.hs+formatted 3d36b503c6bf swagger2-2.9.1/src/Data/Swagger/Internal.hs+formatted 7dfa5b7b4803 swagger2-2.9.1/src/Data/Swagger/Internal/AesonUtils.hs+formatted be2b0df4ab34 swagger2-2.9.1/src/Data/Swagger/Internal/ParamSchema.hs+formatted e4da8109511e swagger2-2.9.1/src/Data/Swagger/Internal/Schema.hs+formatted eb4f3c8c3253 swagger2-2.9.1/src/Data/Swagger/Internal/Schema/Validation.hs+formatted 185e997df260 swagger2-2.9.1/src/Data/Swagger/Internal/TypeShape.hs+formatted abc8c961e8d8 swagger2-2.9.1/src/Data/Swagger/Internal/Utils.hs+formatted fac02daa06aa swagger2-2.9.1/src/Data/Swagger/Lens.hs+formatted 69c86ada5be4 swagger2-2.9.1/src/Data/Swagger/Operation.hs+formatted 385ee16b2de5 swagger2-2.9.1/src/Data/Swagger/Optics.hs+formatted b74d3f8d9ea4 swagger2-2.9.1/src/Data/Swagger/ParamSchema.hs+formatted 19a9a7c3a0de swagger2-2.9.1/src/Data/Swagger/Schema.hs+formatted 59f835605e15 swagger2-2.9.1/src/Data/Swagger/Schema/Generator.hs+formatted 7770e1fe2353 swagger2-2.9.1/src/Data/Swagger/Schema/Validation.hs+formatted 2fd313eb8746 swagger2-2.9.1/src/Data/Swagger/SchemaOptions.hs+formatted 151ebac1c141 swagger2-2.9.1/test/Data/Swagger/CommonTestTypes.hs+formatted 88ae3e07f1d6 swagger2-2.9.1/test/Data/Swagger/ParamSchemaSpec.hs+formatted ba8d29dd4929 swagger2-2.9.1/test/Data/Swagger/Schema/GeneratorSpec.hs+formatted 2bbe75a01f34 swagger2-2.9.1/test/Data/Swagger/Schema/ValidationSpec.hs+formatted bc07fee39679 swagger2-2.9.1/test/Data/Swagger/SchemaSpec.hs+formatted b59e746b8895 swagger2-2.9.1/test/Data/SwaggerSpec.hs+formatted 2fbd14b119a4 swagger2-2.9.1/test/Spec.hs+formatted 1534dc51af48 swagger2-2.9.1/test/SpecCommon.hs+formatted cc17d35cb01d swagger2-2.9.1/test/doctests.hs+formatted 2620b9109dd2 tasty-1.5.4/Control/Concurrent/Async.hs+formatted e865ae48f11b tasty-1.5.4/Setup.hs+formatted 02df8ffe2eb3 tasty-1.5.4/Test/Tasty.hs+formatted 244024ebd276 tasty-1.5.4/Test/Tasty/CmdLine.hs+formatted aaf8f6f4fdaf tasty-1.5.4/Test/Tasty/Core.hs+formatted dd00b52edeb7 tasty-1.5.4/Test/Tasty/Ingredients.hs+formatted 9e13d30f1aac tasty-1.5.4/Test/Tasty/Ingredients/Basic.hs+formatted 4ed0611c5431 tasty-1.5.4/Test/Tasty/Ingredients/ConsoleReporter.hs+formatted 8c6cf8ae3d46 tasty-1.5.4/Test/Tasty/Ingredients/IncludingOptions.hs+formatted 095b09b1c146 tasty-1.5.4/Test/Tasty/Ingredients/ListTests.hs+formatted 26649d291142 tasty-1.5.4/Test/Tasty/Options.hs+formatted ebd9fd9c2ca5 tasty-1.5.4/Test/Tasty/Options/Core.hs+formatted d9fbf61e13b4 tasty-1.5.4/Test/Tasty/Options/Env.hs+formatted bc3c7e134e5c tasty-1.5.4/Test/Tasty/Parallel.hs+formatted d8b2acdcc674 tasty-1.5.4/Test/Tasty/Patterns.hs+formatted 0d97fca4d8c9 tasty-1.5.4/Test/Tasty/Patterns/Eval.hs+formatted 4d5e43449879 tasty-1.5.4/Test/Tasty/Patterns/Expr.hs+formatted 29b2bd9b3c0c tasty-1.5.4/Test/Tasty/Patterns/Parser.hs+formatted 3b88b836a8da tasty-1.5.4/Test/Tasty/Patterns/Printer.hs+formatted 76352e15e8e6 tasty-1.5.4/Test/Tasty/Patterns/Types.hs+formatted b2ce3b3d2ba6 tasty-1.5.4/Test/Tasty/Providers.hs+formatted 1e9dd494aa0d tasty-1.5.4/Test/Tasty/Providers/ConsoleFormat.hs+formatted 00b00e15f6b6 tasty-1.5.4/Test/Tasty/Run.hs+formatted cb5862c8ea8c tasty-1.5.4/Test/Tasty/Runners.hs+formatted 2b0086f6772b tasty-1.5.4/Test/Tasty/Runners/Reducers.hs+formatted b1a27c0f0bde tasty-1.5.4/Test/Tasty/Runners/Utils.hs+formatted e865ae48f11b tensorflow-0.2.0.1/Setup.hs+formatted 1f1f98c9417e tensorflow-0.2.0.1/src/TensorFlow/Build.hs+formatted 6a8867b44ef1 tensorflow-0.2.0.1/src/TensorFlow/BuildOp.hs+formatted 77489c8b8f87 tensorflow-0.2.0.1/src/TensorFlow/ControlFlow.hs+formatted 4cc5cc869f78 tensorflow-0.2.0.1/src/TensorFlow/Core.hs+formatted 76a2093eefd8 tensorflow-0.2.0.1/src/TensorFlow/Internal/FFI.hs+formatted 62d7a0995301 tensorflow-0.2.0.1/src/TensorFlow/Internal/VarInt.hs+formatted 33a0218dc730 tensorflow-0.2.0.1/src/TensorFlow/Nodes.hs+formatted 575aa8d6acdd tensorflow-0.2.0.1/src/TensorFlow/Output.hs+formatted 969822ad8386 tensorflow-0.2.0.1/src/TensorFlow/Session.hs+formatted 2456b562c83a tensorflow-0.2.0.1/src/TensorFlow/Tensor.hs+formatted 60f3e396af96 tensorflow-0.2.0.1/src/TensorFlow/Types.hs+formatted 7786d8f90a48 tensorflow-0.2.0.1/tests/FFITest.hs+formatted 0f5db84dd77b tensorflow-0.2.0.1/tests/VarIntTest.hs+formatted 8ae0364c5862 text-2.1.4/benchmarks/haskell/Benchmarks.hs+formatted ffe091bc4536 text-2.1.4/benchmarks/haskell/Benchmarks/Builder.hs+formatted 46dcd64eb8e5 text-2.1.4/benchmarks/haskell/Benchmarks/Concat.hs+formatted 1e546a146930 text-2.1.4/benchmarks/haskell/Benchmarks/DecodeUtf8.hs+formatted 41909e2de312 text-2.1.4/benchmarks/haskell/Benchmarks/EncodeUtf8.hs+formatted 919f36b12c57 text-2.1.4/benchmarks/haskell/Benchmarks/Equality.hs+formatted a5d1f5795b29 text-2.1.4/benchmarks/haskell/Benchmarks/FileRead.hs+formatted 09b54ec2d23a text-2.1.4/benchmarks/haskell/Benchmarks/FileWrite.hs+formatted ad27e899bf04 text-2.1.4/benchmarks/haskell/Benchmarks/FoldLines.hs+formatted 983d6f9117cd text-2.1.4/benchmarks/haskell/Benchmarks/Micro.hs+formatted 78b2688949ff text-2.1.4/benchmarks/haskell/Benchmarks/Multilang.hs+formatted 6ee308d7049c text-2.1.4/benchmarks/haskell/Benchmarks/Programs/BigTable.hs+formatted b1d195224e1a text-2.1.4/benchmarks/haskell/Benchmarks/Programs/Cut.hs+formatted 2814a67c6d1b text-2.1.4/benchmarks/haskell/Benchmarks/Programs/Fold.hs+formatted 2cebf4fe82ba text-2.1.4/benchmarks/haskell/Benchmarks/Programs/Sort.hs+formatted d9f35273ed3a text-2.1.4/benchmarks/haskell/Benchmarks/Programs/StripTags.hs+formatted 760d861cf866 text-2.1.4/benchmarks/haskell/Benchmarks/Programs/Throughput.hs+formatted 5126bd0f0a93 text-2.1.4/benchmarks/haskell/Benchmarks/Pure.hs+formatted e54e95cc30f1 text-2.1.4/benchmarks/haskell/Benchmarks/ReadNumbers.hs+formatted bf7477bd4934 text-2.1.4/benchmarks/haskell/Benchmarks/Replace.hs+formatted 36cf43ee1086 text-2.1.4/benchmarks/haskell/Benchmarks/Search.hs+formatted ce632d47d038 text-2.1.4/benchmarks/haskell/Benchmarks/Stream.hs+formatted 582c824b5ff5 text-2.1.4/benchmarks/haskell/Benchmarks/WordFrequencies.hs+formatted 352931675b25 text-2.1.4/scripts/ApiCompare.hs+formatted 227860122661 text-2.1.4/scripts/Arsec.hs+formatted a2272b1457ad text-2.1.4/scripts/CaseFolding.hs+formatted a0bdad468ca4 text-2.1.4/scripts/CaseMapping.hs+formatted 50cd030932e1 text-2.1.4/scripts/SpecialCasing.hs+formatted d775bb623580 text-2.1.4/scripts/UnicodeData.hs+partly-checked 08b3c96288dc text-2.1.4/src/Data/Text.hs+formatted 5b72823ffe98 text-2.1.4/src/Data/Text/Array.hs+formatted 4970b89f4e7e text-2.1.4/src/Data/Text/Encoding.hs+formatted d6231f7ebe99 text-2.1.4/src/Data/Text/Encoding/Error.hs+formatted 7580816061c0 text-2.1.4/src/Data/Text/Foreign.hs+formatted d1ee1d8d8964 text-2.1.4/src/Data/Text/IO.hs+formatted 8c24fec0de81 text-2.1.4/src/Data/Text/IO/Utf8.hs+formatted 8c62dc2df371 text-2.1.4/src/Data/Text/Internal.hs+formatted 48c631518261 text-2.1.4/src/Data/Text/Internal/ArrayUtils.hs+formatted e5f93165747b text-2.1.4/src/Data/Text/Internal/Builder.hs+formatted 3a05c951a914 text-2.1.4/src/Data/Text/Internal/Builder/Functions.hs+formatted f5f871c975a4 text-2.1.4/src/Data/Text/Internal/Builder/Int/Digits.hs+formatted ab51e88834e1 text-2.1.4/src/Data/Text/Internal/Builder/RealFloat/Functions.hs+formatted 7fa192160c9b text-2.1.4/src/Data/Text/Internal/ByteStringCompat.hs+formatted 370cd9150da5 text-2.1.4/src/Data/Text/Internal/Encoding.hs+formatted 43a1a670b3db text-2.1.4/src/Data/Text/Internal/Encoding/Fusion.hs+formatted 07ceae987c37 text-2.1.4/src/Data/Text/Internal/Encoding/Fusion/Common.hs+formatted 875961737225 text-2.1.4/src/Data/Text/Internal/Encoding/Utf16.hs+formatted 48ea4745d7e8 text-2.1.4/src/Data/Text/Internal/Encoding/Utf32.hs+formatted 999f28ae046f text-2.1.4/src/Data/Text/Internal/Encoding/Utf8.hs+formatted 9b74d0d7d95a text-2.1.4/src/Data/Text/Internal/Fusion.hs+formatted 9ae139203b50 text-2.1.4/src/Data/Text/Internal/Fusion/CaseMapping.hs+formatted 0858f0992142 text-2.1.4/src/Data/Text/Internal/Fusion/Common.hs+formatted eb26e26b5392 text-2.1.4/src/Data/Text/Internal/Fusion/Size.hs+formatted a8149e253de6 text-2.1.4/src/Data/Text/Internal/Fusion/Types.hs+formatted e8fe9af0fd3d text-2.1.4/src/Data/Text/Internal/IO.hs+formatted e2bb47936e11 text-2.1.4/src/Data/Text/Internal/IsAscii.hs+formatted 538632ba614a text-2.1.4/src/Data/Text/Internal/Lazy.hs+formatted 513ae58ba231 text-2.1.4/src/Data/Text/Internal/Lazy/Encoding/Fusion.hs+formatted c627413119e8 text-2.1.4/src/Data/Text/Internal/Lazy/Fusion.hs+formatted a3c76abdf09c text-2.1.4/src/Data/Text/Internal/Lazy/Search.hs+formatted 7eee07692410 text-2.1.4/src/Data/Text/Internal/Measure.hs+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 eff6a5ffb928 text-2.1.4/src/Data/Text/Internal/Search.hs+formatted 67bf06cca611 text-2.1.4/src/Data/Text/Internal/StrictBuilder.hs+formatted a739bca575a2 text-2.1.4/src/Data/Text/Internal/Transformation.hs+formatted 18ae86a38924 text-2.1.4/src/Data/Text/Internal/Unsafe.hs+formatted d3b144e675ef text-2.1.4/src/Data/Text/Internal/Unsafe/Char.hs+formatted 66e47e950ff0 text-2.1.4/src/Data/Text/Internal/Validate.hs+formatted ef7a4a273c4d text-2.1.4/src/Data/Text/Internal/Validate/Native.hs+formatted 530d639cfd22 text-2.1.4/src/Data/Text/Internal/Validate/Simd.hs+formatted 6d4a57a9277a text-2.1.4/src/Data/Text/Lazy.hs+formatted 38ff2d7cb674 text-2.1.4/src/Data/Text/Lazy/Builder.hs+formatted 38666af96d86 text-2.1.4/src/Data/Text/Lazy/Builder/Int.hs+formatted 29e65f5a5a13 text-2.1.4/src/Data/Text/Lazy/Builder/RealFloat.hs+formatted a19c3620d230 text-2.1.4/src/Data/Text/Lazy/Encoding.hs+formatted b420221eedf6 text-2.1.4/src/Data/Text/Lazy/IO.hs+formatted 737ca3b98c79 text-2.1.4/src/Data/Text/Lazy/Internal.hs+formatted 4053796b9111 text-2.1.4/src/Data/Text/Lazy/Read.hs+formatted 95185ba2e9b4 text-2.1.4/src/Data/Text/Read.hs+formatted 1140737c74af text-2.1.4/src/Data/Text/Show.hs+formatted 5aa1e6b706a4 text-2.1.4/src/Data/Text/Unsafe.hs+formatted 8c35444bb7ce text-2.1.4/tests/LiteralRuleTest.hs+formatted 6c129d5c79c5 text-2.1.4/tests/Tests.hs+formatted 8c9ba4deec7f text-2.1.4/tests/Tests/Lift.hs+formatted eea1f5be128d text-2.1.4/tests/Tests/Properties.hs+formatted a1795fe9db0d text-2.1.4/tests/Tests/Properties/Basics.hs+formatted 4095b24da789 text-2.1.4/tests/Tests/Properties/Builder.hs+formatted 0da554ece794 text-2.1.4/tests/Tests/Properties/CornerCases.hs+formatted 966d6896eccc text-2.1.4/tests/Tests/Properties/Folds.hs+formatted 05ba3e128127 text-2.1.4/tests/Tests/Properties/Instances.hs+formatted 85722c4277cd text-2.1.4/tests/Tests/Properties/LowLevel.hs+formatted 73ce8ac597c8 text-2.1.4/tests/Tests/Properties/Read.hs+formatted 3429b9447ca6 text-2.1.4/tests/Tests/Properties/Substrings.hs+formatted bc4a76ea99f3 text-2.1.4/tests/Tests/Properties/Text.hs+formatted 8c294303c64a text-2.1.4/tests/Tests/Properties/Transcoding.hs+formatted cd2ce6693a46 text-2.1.4/tests/Tests/Properties/Validate.hs+formatted f69fd3fb97e5 text-2.1.4/tests/Tests/QuickCheckUtils.hs+formatted c6e25a3408e0 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+formatted 375091fbe743 text-2.1.4/tests/Tests/Utils.hs+formatted e865ae48f11b th-abstraction-0.7.2.0/Setup.hs+formatted 2a559d420115 th-abstraction-0.7.2.0/src/Language/Haskell/TH/Datatype.hs+formatted b67b7b9c968e th-abstraction-0.7.2.0/src/Language/Haskell/TH/Datatype/Internal.hs+formatted 0bd7defdc9f9 th-abstraction-0.7.2.0/src/Language/Haskell/TH/Datatype/TyVarBndr.hs+formatted ede8a6d3e460 th-abstraction-0.7.2.0/test/Harness.hs+partly-checked 4515e1386d50 th-abstraction-0.7.2.0/test/Main.hs+formatted dc9970880595 th-abstraction-0.7.2.0/test/Types.hs+formatted fd2ff7ad97e3 time-1.16.0.1/Setup.hs+formatted 125260959da8 time-1.16.0.1/benchmark/Main.hs+formatted 06fdc32a2b7b time-1.16.0.1/lib/Data/Format.hs+formatted 138e9cb35e13 time-1.16.0.1/lib/Data/Time.hs+formatted d808f69809c2 time-1.16.0.1/lib/Data/Time/Calendar.hs+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 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+formatted eee4b0761e17 time-1.16.0.1/lib/Data/Time/Calendar/MonthDay.hs+formatted fe021b5bb8e1 time-1.16.0.1/lib/Data/Time/Calendar/OrdinalDate.hs+formatted 025bb4e6307c time-1.16.0.1/lib/Data/Time/Calendar/Private.hs+formatted 7d5d5b51baca time-1.16.0.1/lib/Data/Time/Calendar/Quarter.hs+formatted 61e7261c13da time-1.16.0.1/lib/Data/Time/Calendar/Types.hs+formatted 55892c430b7b time-1.16.0.1/lib/Data/Time/Calendar/Week.hs+formatted 8d6d0ff3c8ec time-1.16.0.1/lib/Data/Time/Calendar/WeekDate.hs+formatted c2de888ee84b time-1.16.0.1/lib/Data/Time/Clock.hs+formatted 0b01b660df99 time-1.16.0.1/lib/Data/Time/Clock/Internal/AbsoluteTime.hs+declined - time-1.16.0.1/lib/Data/Time/Clock/Internal/CTimeval.hs+formatted fde88246f337 time-1.16.0.1/lib/Data/Time/Clock/Internal/DiffTime.hs+formatted 130201256efa time-1.16.0.1/lib/Data/Time/Clock/Internal/NominalDiffTime.hs+formatted 8ef6afa040bc time-1.16.0.1/lib/Data/Time/Clock/Internal/POSIXTime.hs+formatted e9a83d4e7327 time-1.16.0.1/lib/Data/Time/Clock/Internal/SystemTime.hs+formatted 310750655010 time-1.16.0.1/lib/Data/Time/Clock/Internal/UTCDiff.hs+formatted a58732cd7eb8 time-1.16.0.1/lib/Data/Time/Clock/Internal/UTCTime.hs+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 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 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 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 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 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 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+formatted 921506ceef7c time-1.16.0.1/test/main/Main.hs+formatted a04f2637edec time-1.16.0.1/test/main/Test/AddDiff.hs+formatted 5b7aef4fe245 time-1.16.0.1/test/main/Test/Arbitrary.hs+formatted a31b50175d67 time-1.16.0.1/test/main/Test/Calendar/AddDays.hs+formatted 5b09874748fc time-1.16.0.1/test/main/Test/Calendar/AddDaysRef.hs+formatted 1f2ab37cb077 time-1.16.0.1/test/main/Test/Calendar/CalendarProps.hs+formatted fe6ab3f07aa9 time-1.16.0.1/test/main/Test/Calendar/Calendars.hs+formatted ba59184d394c time-1.16.0.1/test/main/Test/Calendar/CalendarsRef.hs+formatted e4ef550ce506 time-1.16.0.1/test/main/Test/Calendar/ClipDates.hs+formatted f707c1ddaec1 time-1.16.0.1/test/main/Test/Calendar/ClipDatesRef.hs+formatted d031fd80c27f time-1.16.0.1/test/main/Test/Calendar/ConvertBack.hs+formatted 168e9526852a time-1.16.0.1/test/main/Test/Calendar/DayPeriod.hs+formatted 3347574732a8 time-1.16.0.1/test/main/Test/Calendar/Duration.hs+formatted 56b1c2b8beea time-1.16.0.1/test/main/Test/Calendar/Easter.hs+formatted 3f35f96f7337 time-1.16.0.1/test/main/Test/Calendar/LongWeekYears.hs+formatted bdfb9e546ba3 time-1.16.0.1/test/main/Test/Calendar/LongWeekYearsRef.hs+formatted b5181d1d6218 time-1.16.0.1/test/main/Test/Calendar/MonthDay.hs+formatted c01cb667a9a8 time-1.16.0.1/test/main/Test/Calendar/MonthDayRef.hs+formatted fc8caea8866a time-1.16.0.1/test/main/Test/Calendar/MonthOfYear.hs+formatted bdc7d2df472c time-1.16.0.1/test/main/Test/Calendar/Valid.hs+formatted 516d424dfa89 time-1.16.0.1/test/main/Test/Calendar/Week.hs+formatted 96f42a259e5f time-1.16.0.1/test/main/Test/Calendar/Year.hs+formatted 868a03b5a657 time-1.16.0.1/test/main/Test/Clock/Conversion.hs+formatted 5c09197a3ec5 time-1.16.0.1/test/main/Test/Clock/Pattern.hs+formatted 449c0cf9b9bd time-1.16.0.1/test/main/Test/Clock/Resolution.hs+formatted e5afef596413 time-1.16.0.1/test/main/Test/Clock/TAI.hs+formatted 56759726b4b9 time-1.16.0.1/test/main/Test/Format/Compile.hs+formatted 9a5ff5f775a0 time-1.16.0.1/test/main/Test/Format/Format.hs+formatted 8aaf7b1caf88 time-1.16.0.1/test/main/Test/Format/ISO8601.hs+formatted 37b32c4a0925 time-1.16.0.1/test/main/Test/Format/ParseTime.hs+formatted 87d53b9f2df8 time-1.16.0.1/test/main/Test/LocalTime/CalendarDiffTime.hs+formatted 3c6fcbef621e time-1.16.0.1/test/main/Test/LocalTime/Time.hs+formatted 4c37e59c357b time-1.16.0.1/test/main/Test/LocalTime/TimeOfDay.hs+formatted db61298fae47 time-1.16.0.1/test/main/Test/LocalTime/TimeRef.hs+formatted 274e9173e128 time-1.16.0.1/test/main/Test/TestUtil.hs+formatted 41cfd788db10 time-1.16.0.1/test/main/Test/Types.hs+formatted 2e8ad72db81a time-1.16.0.1/test/template/Main.hs+formatted 29972ed619e0 time-1.16.0.1/test/template/Test/TastyWrapper.hs+formatted ea580c874e6f time-1.16.0.1/test/unix/Main.hs+formatted 2259bf37c138 time-1.16.0.1/test/unix/Test/Format/Format.hs+formatted 21b333187684 time-1.16.0.1/test/unix/Test/LocalTime/TimeZone.hs+formatted 80c12af20c6e time-1.16.0.1/test/unix/Test/TestUtil.hs+formatted 7917eb9d1f66 tls-2.4.3/Benchmarks/Benchmarks.hs+formatted 489534a90c4b tls-2.4.3/Network/TLS.hs+formatted 7ce1364dcb4a tls-2.4.3/Network/TLS/Backend.hs+formatted f9d4f25241e6 tls-2.4.3/Network/TLS/Cipher.hs+formatted a0fa75894b05 tls-2.4.3/Network/TLS/Compression.hs+formatted 1a706256562f tls-2.4.3/Network/TLS/Context.hs+formatted 1eeefa415421 tls-2.4.3/Network/TLS/Context/Internal.hs+formatted bbff565b3ae1 tls-2.4.3/Network/TLS/Core.hs+formatted e1443ef58aff tls-2.4.3/Network/TLS/Credentials.hs+formatted 1e866a0b1add tls-2.4.3/Network/TLS/Crypto.hs+formatted a8fca7835f0d tls-2.4.3/Network/TLS/Crypto/DH.hs+formatted 446c8c8a07ed tls-2.4.3/Network/TLS/Crypto/IES.hs+formatted b7e6a0d5aaac tls-2.4.3/Network/TLS/Crypto/Types.hs+formatted 025f72c75341 tls-2.4.3/Network/TLS/ErrT.hs+formatted 76e7495f609c tls-2.4.3/Network/TLS/Error.hs+formatted 5f5ef96f88b3 tls-2.4.3/Network/TLS/Extension.hs+formatted a7c47ad146ac tls-2.4.3/Network/TLS/Extension.hs-boot+formatted 49db661a445a tls-2.4.3/Network/TLS/Extra.hs+formatted 31d3b677e3dd tls-2.4.3/Network/TLS/Extra/Cipher.hs+formatted 0ee5bebb0e07 tls-2.4.3/Network/TLS/Extra/CipherCBC.hs+formatted 5d51d07ab286 tls-2.4.3/Network/TLS/Extra/FFDHE.hs+formatted 0003b888622d tls-2.4.3/Network/TLS/Handshake.hs+formatted 34fa3d5f9250 tls-2.4.3/Network/TLS/Handshake/Certificate.hs+formatted 2ece306df042 tls-2.4.3/Network/TLS/Handshake/Client.hs+formatted c309df62a6dc tls-2.4.3/Network/TLS/Handshake/Client/ClientHello.hs+formatted 7f2f22708910 tls-2.4.3/Network/TLS/Handshake/Client/Common.hs+formatted 51e7fc6f4794 tls-2.4.3/Network/TLS/Handshake/Client/ServerHello.hs+formatted 3f13588f75b3 tls-2.4.3/Network/TLS/Handshake/Client/TLS12.hs+formatted cbcf509e71d1 tls-2.4.3/Network/TLS/Handshake/Client/TLS13.hs+formatted a165513e351d tls-2.4.3/Network/TLS/Handshake/Common.hs+formatted 781edf2ff067 tls-2.4.3/Network/TLS/Handshake/Common13.hs+formatted 02f97ef7593d tls-2.4.3/Network/TLS/Handshake/Control.hs+formatted 2c0676398aca tls-2.4.3/Network/TLS/Handshake/Key.hs+formatted 9dc05a147d3b tls-2.4.3/Network/TLS/Handshake/Random.hs+formatted 718a7715d422 tls-2.4.3/Network/TLS/Handshake/Server.hs+formatted 20f083ce3b73 tls-2.4.3/Network/TLS/Handshake/Server/ClientHello.hs+formatted 31d74cce1ec5 tls-2.4.3/Network/TLS/Handshake/Server/ClientHello12.hs+formatted c10c507909d1 tls-2.4.3/Network/TLS/Handshake/Server/ClientHello13.hs+formatted a2f2d3470f0f tls-2.4.3/Network/TLS/Handshake/Server/Common.hs+formatted e0d048534445 tls-2.4.3/Network/TLS/Handshake/Server/ServerHello12.hs+formatted 4f5074d8165a tls-2.4.3/Network/TLS/Handshake/Server/ServerHello13.hs+formatted b29b9f3d0ef7 tls-2.4.3/Network/TLS/Handshake/Server/TLS12.hs+formatted 06002a108581 tls-2.4.3/Network/TLS/Handshake/Server/TLS13.hs+formatted 6a8388c49af7 tls-2.4.3/Network/TLS/Handshake/Signature.hs+formatted 009f1658802d tls-2.4.3/Network/TLS/Handshake/State.hs+formatted 8533c61b72e3 tls-2.4.3/Network/TLS/Handshake/State13.hs+formatted 11825b040470 tls-2.4.3/Network/TLS/Handshake/TranscriptHash.hs+formatted 38c7f1733b3a tls-2.4.3/Network/TLS/HashAndSignature.hs+formatted 7be5df148925 tls-2.4.3/Network/TLS/Hooks.hs+formatted be666dff7b14 tls-2.4.3/Network/TLS/IO.hs+formatted f83586ff735d tls-2.4.3/Network/TLS/IO/Decode.hs+formatted b5b4ec68ca00 tls-2.4.3/Network/TLS/IO/Encode.hs+formatted 6c20cf748535 tls-2.4.3/Network/TLS/Imports.hs+formatted 21e9ce7c3507 tls-2.4.3/Network/TLS/Internal.hs+formatted 92999e90c6b3 tls-2.4.3/Network/TLS/KeySchedule.hs+formatted febba7334e9e tls-2.4.3/Network/TLS/MAC.hs+formatted 44b7f6f73115 tls-2.4.3/Network/TLS/Measurement.hs+formatted f0042ddb2e2e tls-2.4.3/Network/TLS/Packet.hs+formatted 8d74b7707cba tls-2.4.3/Network/TLS/Packet13.hs+formatted a14ea5098afd tls-2.4.3/Network/TLS/Parameters.hs+formatted 29784d509f48 tls-2.4.3/Network/TLS/PostHandshake.hs+formatted 8edf9e30c18b tls-2.4.3/Network/TLS/QUIC.hs+formatted 360a52dcf151 tls-2.4.3/Network/TLS/RNG.hs+formatted 805eb6800681 tls-2.4.3/Network/TLS/Record.hs+formatted 176fc6cb0e0b tls-2.4.3/Network/TLS/Record/Decrypt.hs+formatted 58803d051f03 tls-2.4.3/Network/TLS/Record/Encrypt.hs+formatted 3d9c53507eaa tls-2.4.3/Network/TLS/Record/Layer.hs+formatted a66c641fa8a1 tls-2.4.3/Network/TLS/Record/Recv.hs+formatted 9fa588833e07 tls-2.4.3/Network/TLS/Record/Send.hs+formatted 2af800e2c322 tls-2.4.3/Network/TLS/Record/State.hs+formatted 5bfbdf5546a3 tls-2.4.3/Network/TLS/Record/Types.hs+formatted 42bed44c3eaa tls-2.4.3/Network/TLS/Session.hs+formatted 5bef08c36337 tls-2.4.3/Network/TLS/State.hs+formatted ff17eb8d38b8 tls-2.4.3/Network/TLS/Struct.hs+formatted 2aeee057d9ff tls-2.4.3/Network/TLS/Struct13.hs+formatted ea0d39cd9f70 tls-2.4.3/Network/TLS/Types.hs+formatted 997becc4fe58 tls-2.4.3/Network/TLS/Types/Cipher.hs+formatted e6e9255220bb tls-2.4.3/Network/TLS/Types/Secret.hs+formatted 35bf4ee60be8 tls-2.4.3/Network/TLS/Types/Session.hs+formatted 741cb1c84257 tls-2.4.3/Network/TLS/Types/Version.hs+formatted be921f75cb0a tls-2.4.3/Network/TLS/Util.hs+formatted 1d021bd7e9a7 tls-2.4.3/Network/TLS/Util/ASN1.hs+formatted 9d70166f446f tls-2.4.3/Network/TLS/Util/Serialization.hs+formatted 32a205e8e871 tls-2.4.3/Network/TLS/Wire.hs+formatted 8d9038e38c2b tls-2.4.3/Network/TLS/X509.hs+formatted e865ae48f11b tls-2.4.3/Setup.hs+formatted 45a83b6cde24 tls-2.4.3/test/API.hs+formatted eaaf5def6469 tls-2.4.3/test/Arbitrary.hs+formatted ba1557ab2831 tls-2.4.3/test/Certificate.hs+formatted 37c216e39fd1 tls-2.4.3/test/CiphersSpec.hs+formatted 127368e06936 tls-2.4.3/test/ECHSpec.hs+formatted a99d04d129f7 tls-2.4.3/test/EncodeSpec.hs+formatted fe70454cad85 tls-2.4.3/test/HandshakeSpec.hs+formatted 6851deeb2440 tls-2.4.3/test/PipeChan.hs+formatted 338dcd8056de tls-2.4.3/test/PubKey.hs+formatted 9621232ed432 tls-2.4.3/test/Run.hs+formatted a550a90f6578 tls-2.4.3/test/Session.hs+formatted 2fbd14b119a4 tls-2.4.3/test/Spec.hs+formatted 9034972735e8 tls-2.4.3/test/ThreadSpec.hs+formatted 0d661eb8f9c2 tls-2.4.3/util/Client.hs+formatted c555911ae465 tls-2.4.3/util/Common.hs+formatted 7dd3b5f2e44a tls-2.4.3/util/Imports.hs+formatted 6e9aa070c533 tls-2.4.3/util/Server.hs+formatted 2e4c1c1f2132 tls-2.4.3/util/tls-client.hs+formatted cc5d29d77364 tls-2.4.3/util/tls-server.hs+partly-checked 3fb7ad77e453 transformers-0.6.3.0/Control/Applicative/Backwards.hs+partly-checked 1e0b5cb5f0b3 transformers-0.6.3.0/Control/Applicative/Lift.hs+formatted 578b0e3c1682 transformers-0.6.3.0/Control/Monad/Signatures.hs+partly-checked 903d26036ddf transformers-0.6.3.0/Control/Monad/Trans/Accum.hs+formatted dc84c86bb82a transformers-0.6.3.0/Control/Monad/Trans/Class.hs+formatted 1817d0d25545 transformers-0.6.3.0/Control/Monad/Trans/Cont.hs+partly-checked 98eeed8cf935 transformers-0.6.3.0/Control/Monad/Trans/Except.hs+partly-checked 67b62194140d transformers-0.6.3.0/Control/Monad/Trans/Identity.hs+partly-checked c166041a8c5e transformers-0.6.3.0/Control/Monad/Trans/Maybe.hs+formatted 6f7326668607 transformers-0.6.3.0/Control/Monad/Trans/RWS.hs+formatted c18cfc68a7ca transformers-0.6.3.0/Control/Monad/Trans/RWS/CPS.hs+partly-checked fa6eb9bac0a7 transformers-0.6.3.0/Control/Monad/Trans/RWS/Lazy.hs+partly-checked d7f98f96171d transformers-0.6.3.0/Control/Monad/Trans/RWS/Strict.hs+partly-checked d75058073c9e transformers-0.6.3.0/Control/Monad/Trans/Reader.hs+formatted b58555f08340 transformers-0.6.3.0/Control/Monad/Trans/Select.hs+formatted dc729d1936a2 transformers-0.6.3.0/Control/Monad/Trans/State.hs+partly-checked f062acd2848c transformers-0.6.3.0/Control/Monad/Trans/State/Lazy.hs+partly-checked 53dea27ba637 transformers-0.6.3.0/Control/Monad/Trans/State/Strict.hs+formatted 6a9857bbd181 transformers-0.6.3.0/Control/Monad/Trans/Writer.hs+formatted 1b5b2ad9e9d8 transformers-0.6.3.0/Control/Monad/Trans/Writer/CPS.hs+partly-checked 579da23e5e5b transformers-0.6.3.0/Control/Monad/Trans/Writer/Lazy.hs+partly-checked f89a27634c86 transformers-0.6.3.0/Control/Monad/Trans/Writer/Strict.hs+declined - transformers-0.6.3.0/Data/Functor/Constant.hs+partly-checked 9b1d6b4e909d transformers-0.6.3.0/Data/Functor/Reverse.hs+formatted e865ae48f11b transformers-0.6.3.0/Setup.hs+declined - transformers-0.6.3.0/legacy/pre709/Data/Functor/Identity.hs+formatted ee4ba7098a5c transformers-0.6.3.0/legacy/pre711/Control/Monad/IO/Class.hs+formatted 7d9fab9a0caf transformers-0.6.3.0/legacy/pre711/Data/Functor/Classes.hs+formatted 284d6d5fc1d3 transformers-0.6.3.0/legacy/pre711/Data/Functor/Compose.hs+partly-checked e96184ffa2ec transformers-0.6.3.0/legacy/pre711/Data/Functor/Product.hs+formatted 87f324f0c768 transformers-0.6.3.0/legacy/pre711/Data/Functor/Sum.hs+formatted e865ae48f11b typed-process-0.2.13.0/Setup.hs+formatted b26f653e6a78 typed-process-0.2.13.0/src/System/Process/Typed.hs+formatted a2f3c6df3e9b typed-process-0.2.13.0/src/System/Process/Typed/Internal.hs+formatted 2fbd14b119a4 typed-process-0.2.13.0/test/Spec.hs+formatted 7da6b9dd8336 typed-process-0.2.13.0/test/System/Process/TypedSpec.hs+formatted e865ae48f11b unliftio-0.2.25.1/Setup.hs+formatted 86399961b28a unliftio-0.2.25.1/bench/ConcBench.hs+formatted 737706872ccf unliftio-0.2.25.1/src/UnliftIO.hs+formatted 713d1458fd8d unliftio-0.2.25.1/src/UnliftIO/Async.hs+formatted 5463e06f3adf unliftio-0.2.25.1/src/UnliftIO/Chan.hs+formatted 189c6c89bb81 unliftio-0.2.25.1/src/UnliftIO/Concurrent.hs+partly-checked c708a2f3ee0e unliftio-0.2.25.1/src/UnliftIO/Directory.hs+formatted 402fb486b3cf unliftio-0.2.25.1/src/UnliftIO/Environment.hs+formatted c9305d3c9be9 unliftio-0.2.25.1/src/UnliftIO/Exception.hs+formatted e5401695da5a unliftio-0.2.25.1/src/UnliftIO/Exception/Lens.hs+formatted ff1234d6ddbd unliftio-0.2.25.1/src/UnliftIO/Foreign.hs+formatted a64a8ea6c117 unliftio-0.2.25.1/src/UnliftIO/IO.hs+formatted c940b0ac5eb1 unliftio-0.2.25.1/src/UnliftIO/IO/File.hs+formatted 8f52b4c4db23 unliftio-0.2.25.1/src/UnliftIO/IO/File/Posix.hs+formatted 2688f4b976d8 unliftio-0.2.25.1/src/UnliftIO/IORef.hs+formatted 1738f330bd77 unliftio-0.2.25.1/src/UnliftIO/Internals/Async.hs+formatted 2e37ab380c8b unliftio-0.2.25.1/src/UnliftIO/MVar.hs+formatted 25ab39f4a7d1 unliftio-0.2.25.1/src/UnliftIO/Memoize.hs+formatted 5803964631a0 unliftio-0.2.25.1/src/UnliftIO/Process.hs+formatted f17d64d4c913 unliftio-0.2.25.1/src/UnliftIO/QSem.hs+formatted 6e50df49a6ba unliftio-0.2.25.1/src/UnliftIO/QSemN.hs+formatted ee3bf4d22673 unliftio-0.2.25.1/src/UnliftIO/STM.hs+formatted 809c4f4424bb unliftio-0.2.25.1/src/UnliftIO/Temporary.hs+formatted 0f5f7167bc7b unliftio-0.2.25.1/src/UnliftIO/Timeout.hs+formatted 2fbd14b119a4 unliftio-0.2.25.1/test/Spec.hs+formatted 3118f2133668 unliftio-0.2.25.1/test/UnliftIO/AsyncSpec.hs+formatted dda4d2f1b5ef unliftio-0.2.25.1/test/UnliftIO/DirectorySpec.hs+formatted 500e291fb7a1 unliftio-0.2.25.1/test/UnliftIO/ExceptionSpec.hs+formatted a899c691b2e6 unliftio-0.2.25.1/test/UnliftIO/IO/FileSpec.hs+formatted 258e4c04879b unliftio-0.2.25.1/test/UnliftIO/IOSpec.hs+formatted 68c4411ed8f4 unliftio-0.2.25.1/test/UnliftIO/MemoizeSpec.hs+formatted f878ce9da222 unliftio-0.2.25.1/test/UnliftIO/PooledAsyncSpec.hs+formatted 2f5ad1921f27 unordered-containers-0.2.21/Data/HashMap/Internal.hs+declined - unordered-containers-0.2.21/Data/HashMap/Internal/Array.hs+formatted 7be08d5816ff unordered-containers-0.2.21/Data/HashMap/Internal/Debug.hs+formatted 25f94316b17e unordered-containers-0.2.21/Data/HashMap/Internal/List.hs+formatted 08e073c2c7dd unordered-containers-0.2.21/Data/HashMap/Internal/Strict.hs+formatted a4d22b20936f unordered-containers-0.2.21/Data/HashMap/Lazy.hs+formatted b51d84ac0257 unordered-containers-0.2.21/Data/HashMap/Strict.hs+formatted d88b52d5dce2 unordered-containers-0.2.21/Data/HashSet.hs+formatted a238b77b05ef unordered-containers-0.2.21/Data/HashSet/Internal.hs+formatted e865ae48f11b unordered-containers-0.2.21/Setup.hs+formatted e85bc02778c3 unordered-containers-0.2.21/benchmarks/Benchmarks.hs+formatted 0ed2a6102dba unordered-containers-0.2.21/benchmarks/FineGrained.hs+formatted 7e72d194e206 unordered-containers-0.2.21/benchmarks/Key/Bytes.hs+formatted de9c7b30da36 unordered-containers-0.2.21/benchmarks/Util/ByteString.hs+formatted 284694c5798b unordered-containers-0.2.21/benchmarks/Util/Int.hs+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 feff92267a82 unordered-containers-0.2.21/tests/Properties/HashMapLazy.hs+formatted f2a904c3a89a unordered-containers-0.2.21/tests/Properties/HashMapStrict.hs+formatted a612762e1b58 unordered-containers-0.2.21/tests/Properties/HashSet.hs+formatted 3584a01b2cdd unordered-containers-0.2.21/tests/Properties/List.hs+formatted 6464664cb68b unordered-containers-0.2.21/tests/Regressions.hs+formatted d094f07710f5 unordered-containers-0.2.21/tests/Strictness.hs+formatted 00cf0a5ee0ea unordered-containers-0.2.21/tests/Util/Key.hs+formatted e865ae48f11b unpacked-containers-0/Setup.hs+formatted 8523e9d3c669 unpacked-containers-0/example/Int.hs+formatted ba3a254765ca unpacked-containers-0/example/Main.hs+formatted 941a76a7e532 unpacked-containers-0/src/Key.hsig+formatted 0ab7b95772b1 unpacked-containers-0/src/Map.hs+formatted 4ab593177929 unpacked-containers-0/src/Map/Internal.hs+formatted 412fdc3e3871 unpacked-containers-0/src/Map/Internal/Debug.hs+formatted 88e3acab50fe unpacked-containers-0/src/Map/Lazy.hs+formatted d160eb88e766 unpacked-containers-0/src/Map/Merge/Lazy.hs+formatted 3401a14fe602 unpacked-containers-0/src/Map/Merge/Strict.hs+formatted 1da0e231433b unpacked-containers-0/src/Map/Strict.hs+formatted 9b01f9961f71 unpacked-containers-0/src/Map/Strict/Internal.hs+formatted bb6c9398369f unpacked-containers-0/src/Set.hs+formatted cb11e5a3315d unpacked-containers-0/src/Set/Internal.hs+formatted 867c9afd504a unpacked-containers-0/utils/Internal/BitQueue.hs+formatted 7c96e08090d5 unpacked-containers-0/utils/Internal/BitUtil.hs+formatted a1134be4230d unpacked-containers-0/utils/Internal/PtrEquality.hs+formatted 5dd1b940181c unpacked-containers-0/utils/Internal/State.hs+formatted ed12f1faf0ed unpacked-containers-0/utils/Internal/StrictFold.hs+formatted 621944df674c unpacked-containers-0/utils/Internal/StrictMaybe.hs+formatted b7a091ef4c77 unpacked-containers-0/utils/Internal/StrictPair.hs+formatted 4a8ac51676df uuid-types-1.0.6.1/Setup.hs+formatted e97eca400518 uuid-types-1.0.6.1/src/Data/UUID/Types.hs+formatted 2dc18f83b9c9 uuid-types-1.0.6.1/src/Data/UUID/Types/Internal.hs+formatted d63508f44841 uuid-types-1.0.6.1/src/Data/UUID/Types/Internal/Builder.hs+formatted 14a92dc8286f 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 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+formatted c647f14c61cb vector-0.13.2.0/benchlib/Bench/Vector/Algo/ListRank.hs+formatted bbc9ffdd439f vector-0.13.2.0/benchlib/Bench/Vector/Algo/MutableSet.hs+formatted 49998369707c vector-0.13.2.0/benchlib/Bench/Vector/Algo/NextPermutation.hs+formatted a1d4d3d489b4 vector-0.13.2.0/benchlib/Bench/Vector/Algo/Quickhull.hs+formatted cff7efe83577 vector-0.13.2.0/benchlib/Bench/Vector/Algo/Rootfix.hs+formatted bc96aa2b8cdf vector-0.13.2.0/benchlib/Bench/Vector/Algo/Spectral.hs+formatted 438dab6789ad vector-0.13.2.0/benchlib/Bench/Vector/Algo/Tridiag.hs+formatted ec97bfaffec3 vector-0.13.2.0/benchlib/Bench/Vector/Tasty.hs+formatted 368deb66d310 vector-0.13.2.0/benchlib/Bench/Vector/TestData/Graph.hs+formatted 476c4f42945a vector-0.13.2.0/benchlib/Bench/Vector/TestData/ParenTree.hs+formatted 6b1b4aea2361 vector-0.13.2.0/benchmarks/Main.hs+formatted 77ce7d3b1eda vector-0.13.2.0/internal/GenUnboxTuple.hs+formatted 7e257cfd7468 vector-0.13.2.0/src/Data/Vector.hs+formatted 16d1d0522130 vector-0.13.2.0/src/Data/Vector/Fusion/Bundle.hs+formatted c77517ac5b6b vector-0.13.2.0/src/Data/Vector/Fusion/Bundle/Monadic.hs+formatted 281a320dd1fd vector-0.13.2.0/src/Data/Vector/Fusion/Bundle/Size.hs+formatted 8b09b3b8c680 vector-0.13.2.0/src/Data/Vector/Fusion/Stream/Monadic.hs+formatted cfc06f7907bc vector-0.13.2.0/src/Data/Vector/Fusion/Util.hs+formatted a981b8dada8f vector-0.13.2.0/src/Data/Vector/Generic.hs+formatted 24e087932bf9 vector-0.13.2.0/src/Data/Vector/Generic/Base.hs+formatted 6c34f319e085 vector-0.13.2.0/src/Data/Vector/Generic/Mutable.hs+formatted 14ab0fea35a5 vector-0.13.2.0/src/Data/Vector/Generic/Mutable/Base.hs+formatted 31ef8684e6a5 vector-0.13.2.0/src/Data/Vector/Generic/New.hs+formatted 1842a6e1d83f vector-0.13.2.0/src/Data/Vector/Internal/Check.hs+formatted 3a331752a108 vector-0.13.2.0/src/Data/Vector/Mutable.hs+formatted c77c6d8b48f1 vector-0.13.2.0/src/Data/Vector/Primitive.hs+formatted 7790a579fd85 vector-0.13.2.0/src/Data/Vector/Primitive/Mutable.hs+formatted d63a299a6982 vector-0.13.2.0/src/Data/Vector/Storable.hs+formatted f3208fa21c31 vector-0.13.2.0/src/Data/Vector/Storable/Internal.hs+formatted a312fe3ca55a vector-0.13.2.0/src/Data/Vector/Storable/Mutable.hs+formatted ca6c3919dbe4 vector-0.13.2.0/src/Data/Vector/Strict.hs+formatted 3bc69095cb4d vector-0.13.2.0/src/Data/Vector/Strict/Mutable.hs+formatted 5a349caedbaf vector-0.13.2.0/src/Data/Vector/Unboxed.hs+formatted fa9e19a0d58d vector-0.13.2.0/src/Data/Vector/Unboxed/Base.hs+formatted 58ff39d532e3 vector-0.13.2.0/src/Data/Vector/Unboxed/Mutable.hs+formatted f4e17f002657 vector-0.13.2.0/tests-inspect/Inspect.hs+formatted 992258e8ec96 vector-0.13.2.0/tests-inspect/Inspect/DerivingVia.hs+formatted 005977089309 vector-0.13.2.0/tests-inspect/Inspect/DerivingVia/OtherFoo.hs+formatted c86daf6b0506 vector-0.13.2.0/tests-inspect/main.hs+formatted b27a545b7df5 vector-0.13.2.0/tests/Boilerplater.hs+formatted 9d758ab214f1 vector-0.13.2.0/tests/Main.hs+formatted 8061fe09f977 vector-0.13.2.0/tests/Tests/Bundle.hs+formatted 1525be7e0a46 vector-0.13.2.0/tests/Tests/Move.hs+formatted 43dd4c8d5a9c vector-0.13.2.0/tests/Tests/Vector/Boxed.hs+formatted 54a741f726e9 vector-0.13.2.0/tests/Tests/Vector/Primitive.hs+formatted 4c1e86e31a44 vector-0.13.2.0/tests/Tests/Vector/Property.hs+formatted 89d6f5f286c7 vector-0.13.2.0/tests/Tests/Vector/Storable.hs+formatted cc9e0bc6f8e0 vector-0.13.2.0/tests/Tests/Vector/Strict.hs+formatted 891ffe33c45c vector-0.13.2.0/tests/Tests/Vector/Unboxed.hs+formatted 9d70a141ca8e vector-0.13.2.0/tests/Tests/Vector/UnitTests.hs+formatted 915b72919a48 vector-0.13.2.0/tests/Utilities.hs+formatted 88ed51490944 vector-0.13.2.0/tests/doctests.hs+formatted 5561dc5bc4a0 vector-algorithms-0.9.1.0/bench/simple/Blocks.hs+formatted 501fcfb24218 vector-algorithms-0.9.1.0/bench/simple/Main.hs+formatted 518a902d3c59 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms.hs+formatted 553211019f78 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/AmericanFlag.hs+formatted 5bc324a60b4f vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Common.hs+formatted a7c93d247f1d vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Heap.hs+formatted 385f1aecc6ac vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Insertion.hs+formatted eaaf49335045 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Intro.hs+formatted 4a50f751547a vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Merge.hs+formatted 9a4c2dc71a47 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Optimal.hs+formatted b7b0f718deb2 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Radix.hs+formatted 47f1d28b6145 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Search.hs+formatted 0a376532e9cb vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Tim.hs+formatted a9ac57f13756 vector-algorithms-0.9.1.0/tests/properties/Optimal.hs+formatted b19d49d0db4b vector-algorithms-0.9.1.0/tests/properties/Properties.hs+formatted 9b8afe81a4c6 vector-algorithms-0.9.1.0/tests/properties/Tests.hs+formatted 68c72976d14e vector-algorithms-0.9.1.0/tests/properties/Util.hs+formatted 8509e18a780a wai-3.2.5/Network/Wai.hs+formatted 7174252dda45 wai-3.2.5/Network/Wai/Internal.hs+formatted 76fdb58b6d05 wai-3.2.5/test/Network/WaiSpec.hs+formatted 2fbd14b119a4 wai-3.2.5/test/Spec.hs+formatted d069d134e586 warp-3.4.15/Network/Wai/Handler/Warp.hs+formatted 009ccfac9d51 warp-3.4.15/Network/Wai/Handler/Warp/Buffer.hs+formatted f910265f50d3 warp-3.4.15/Network/Wai/Handler/Warp/Conduit.hs+formatted c978e6eb627c warp-3.4.15/Network/Wai/Handler/Warp/Counter.hs+formatted 26b005936471 warp-3.4.15/Network/Wai/Handler/Warp/Date.hs+formatted 349d250e5826 warp-3.4.15/Network/Wai/Handler/Warp/FdCache.hs+formatted 5c8ff344b068 warp-3.4.15/Network/Wai/Handler/Warp/File.hs+formatted e56514093065 warp-3.4.15/Network/Wai/Handler/Warp/FileInfoCache.hs+formatted 2b7f4d356448 warp-3.4.15/Network/Wai/Handler/Warp/HTTP1.hs+formatted f32ce233886c warp-3.4.15/Network/Wai/Handler/Warp/HTTP2.hs+formatted a7debda99dd6 warp-3.4.15/Network/Wai/Handler/Warp/HTTP2/File.hs+formatted cd7ebbac04db warp-3.4.15/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs+formatted 40821f53b1d9 warp-3.4.15/Network/Wai/Handler/Warp/HTTP2/Request.hs+formatted 831c4440cde7 warp-3.4.15/Network/Wai/Handler/Warp/HTTP2/Response.hs+formatted 40e59aa92ecc warp-3.4.15/Network/Wai/Handler/Warp/HTTP2/Types.hs+formatted 69c55babd99e warp-3.4.15/Network/Wai/Handler/Warp/HashMap.hs+formatted cee4ba0a15b3 warp-3.4.15/Network/Wai/Handler/Warp/Header.hs+formatted a036771b5a25 warp-3.4.15/Network/Wai/Handler/Warp/IO.hs+formatted d92af26eb2ec warp-3.4.15/Network/Wai/Handler/Warp/Imports.hs+formatted 98f2e1cfdade warp-3.4.15/Network/Wai/Handler/Warp/Internal.hs+formatted e8583e08a2e4 warp-3.4.15/Network/Wai/Handler/Warp/MultiMap.hs+formatted ed16ebc20147 warp-3.4.15/Network/Wai/Handler/Warp/PackInt.hs+formatted 22e5a5d6d3c9 warp-3.4.15/Network/Wai/Handler/Warp/ReadInt.hs+formatted e29d1517c375 warp-3.4.15/Network/Wai/Handler/Warp/Request.hs+formatted c7905b72682b warp-3.4.15/Network/Wai/Handler/Warp/RequestHeader.hs+formatted 7100fbff6910 warp-3.4.15/Network/Wai/Handler/Warp/Response.hs+formatted 27cae25ae83a warp-3.4.15/Network/Wai/Handler/Warp/ResponseHeader.hs+formatted 621b343ceaa3 warp-3.4.15/Network/Wai/Handler/Warp/Run.hs+formatted 47a04a642ad1 warp-3.4.15/Network/Wai/Handler/Warp/SendFile.hs+formatted bad8f2d42358 warp-3.4.15/Network/Wai/Handler/Warp/Settings.hs+formatted bc4925a06045 warp-3.4.15/Network/Wai/Handler/Warp/ShuttingDown.hs+formatted a531dacd44be warp-3.4.15/Network/Wai/Handler/Warp/Types.hs+formatted f1ff20ab87da warp-3.4.15/Network/Wai/Handler/Warp/Windows.hs+formatted 2bef9620132e warp-3.4.15/Network/Wai/Handler/Warp/WithApplication.hs+formatted f3a2c7ee7659 warp-3.4.15/bench/Parser.hs+formatted 8f739e595518 warp-3.4.15/test/BufferSpec.hs+formatted 6d25fc643699 warp-3.4.15/test/ConduitSpec.hs+formatted 103842d1ec84 warp-3.4.15/test/ConnectionSpec.hs+formatted 7d698edc37d0 warp-3.4.15/test/EarlyHintsSpec.hs+formatted 3b37c702fe26 warp-3.4.15/test/ExceptionSpec.hs+formatted 6da076d7c2ae warp-3.4.15/test/FdCacheSpec.hs+formatted f91844cc6a8f warp-3.4.15/test/FileSpec.hs+formatted 0ba618e41ab1 warp-3.4.15/test/GracefulShutdownSpec.hs+formatted c99958718db1 warp-3.4.15/test/HTTP.hs+formatted 70bab0349402 warp-3.4.15/test/PackIntSpec.hs+formatted c0ed531ac6d7 warp-3.4.15/test/ReadIntSpec.hs+formatted 203ea20f13bf warp-3.4.15/test/RequestSpec.hs+formatted 4ef55f7e523c warp-3.4.15/test/ResponseHeaderSpec.hs+formatted ac591a85b19f warp-3.4.15/test/ResponseSpec.hs+formatted 190ad2e064b1 warp-3.4.15/test/RunSpec.hs+formatted 12d7c8bf7283 warp-3.4.15/test/SendFileSpec.hs+formatted 56bf11ebdf68 warp-3.4.15/test/ServerStateSpec.hs+formatted 2fbd14b119a4 warp-3.4.15/test/Spec.hs+formatted 6239c41d8ad7 warp-3.4.15/test/WithApplicationSpec.hs+formatted c61ebeab72e9 warp-3.4.15/test/doctests.hs+formatted c3a0978b358e xmonad-0.18.1/Main.hs+formatted 147fdbecf10c xmonad-0.18.1/man/xmonad.hs+formatted 1b9e38e5ffc2 xmonad-0.18.1/src/XMonad.hs+formatted d5ed6e53aeb6 xmonad-0.18.1/src/XMonad/Config.hs+formatted a69fbe62400f xmonad-0.18.1/src/XMonad/Core.hs+formatted 16d9eaa37934 xmonad-0.18.1/src/XMonad/Layout.hs+formatted 185beff032bf xmonad-0.18.1/src/XMonad/Main.hs+formatted fececd53a9f5 xmonad-0.18.1/src/XMonad/ManageHook.hs+formatted 1ce7bcb56804 xmonad-0.18.1/src/XMonad/Operations.hs+formatted 436b2faa58c9 xmonad-0.18.1/src/XMonad/StackSet.hs+formatted 710ec0764541 xmonad-0.18.1/tests/Instances.hs+formatted 682615fd57ec xmonad-0.18.1/tests/Properties.hs+formatted b9cbebbac632 xmonad-0.18.1/tests/Properties/Delete.hs+formatted 2b2b85b4c7fe xmonad-0.18.1/tests/Properties/Failure.hs+formatted 2825306e83f9 xmonad-0.18.1/tests/Properties/Floating.hs+formatted ae9be34908bc xmonad-0.18.1/tests/Properties/Focus.hs+formatted 1418915d6ac8 xmonad-0.18.1/tests/Properties/GreedyView.hs+formatted ff83b882ad73 xmonad-0.18.1/tests/Properties/Insert.hs+formatted 2d0f361b70f7 xmonad-0.18.1/tests/Properties/Layout/Full.hs+formatted d216f32ba806 xmonad-0.18.1/tests/Properties/Layout/Tall.hs+formatted 65709ceae761 xmonad-0.18.1/tests/Properties/Screen.hs+formatted 13ed9089c892 xmonad-0.18.1/tests/Properties/Shift.hs+formatted 879d6f9db8a2 xmonad-0.18.1/tests/Properties/Stack.hs+formatted 7384642a8941 xmonad-0.18.1/tests/Properties/StackSet.hs+formatted e48be0e8732d xmonad-0.18.1/tests/Properties/Swap.hs+formatted f6f63b59cfb0 xmonad-0.18.1/tests/Properties/View.hs+formatted ef9aade1e2ca xmonad-0.18.1/tests/Properties/Workspace.hs+formatted 87ba4b32b250 xmonad-0.18.1/tests/Utils.hs+formatted d8adcc5e8871 yesod-core-1.7.0.0/bench/widget.hs+formatted 810a9b2932db yesod-core-1.7.0.0/src/Yesod/Core.hs+formatted 76a91abab9c7 yesod-core-1.7.0.0/src/Yesod/Core/Class/Breadcrumbs.hs+formatted 5eb301cd4009 yesod-core-1.7.0.0/src/Yesod/Core/Class/Dispatch.hs+formatted 4e0e4c27884b yesod-core-1.7.0.0/src/Yesod/Core/Class/Dispatch/ToParentRoute.hs+formatted f5e77d45ac7f yesod-core-1.7.0.0/src/Yesod/Core/Class/Handler.hs+formatted b609ce0ae4aa yesod-core-1.7.0.0/src/Yesod/Core/Class/Yesod.hs+formatted 7b7185683c72 yesod-core-1.7.0.0/src/Yesod/Core/Content.hs+formatted 8f8e6e5fb762 yesod-core-1.7.0.0/src/Yesod/Core/Dispatch.hs+formatted a266e1ec29d7 yesod-core-1.7.0.0/src/Yesod/Core/Handler.hs+formatted 88d4d8c2323a yesod-core-1.7.0.0/src/Yesod/Core/Internal.hs+formatted 212235b50682 yesod-core-1.7.0.0/src/Yesod/Core/Internal/LiteApp.hs+formatted ca64c4e6d606 yesod-core-1.7.0.0/src/Yesod/Core/Internal/Request.hs+formatted bbb065ca69ff yesod-core-1.7.0.0/src/Yesod/Core/Internal/Response.hs+formatted 3032144ec1d6 yesod-core-1.7.0.0/src/Yesod/Core/Internal/Run.hs+formatted da5ec533b3d0 yesod-core-1.7.0.0/src/Yesod/Core/Internal/Session.hs+formatted 7d85bdcde5ef yesod-core-1.7.0.0/src/Yesod/Core/Internal/TH.hs+formatted a4d70c77b953 yesod-core-1.7.0.0/src/Yesod/Core/Internal/Util.hs+formatted 3c6023c01f8d yesod-core-1.7.0.0/src/Yesod/Core/Json.hs+formatted 3d3ea6cd2254 yesod-core-1.7.0.0/src/Yesod/Core/TypeCache.hs+formatted aa67fd550b47 yesod-core-1.7.0.0/src/Yesod/Core/Types.hs+formatted 38102a09e32a yesod-core-1.7.0.0/src/Yesod/Core/Types/Content.hs+formatted 49991219fbf5 yesod-core-1.7.0.0/src/Yesod/Core/Types/ErrorResponse.hs+formatted 2f42d728713c yesod-core-1.7.0.0/src/Yesod/Core/Types/HandlerContents.hs+formatted eea90c376092 yesod-core-1.7.0.0/src/Yesod/Core/Types/TypedContent.hs+formatted abfe32d3eadd yesod-core-1.7.0.0/src/Yesod/Core/Unsafe.hs+formatted 1620502b047c yesod-core-1.7.0.0/src/Yesod/Core/Widget.hs+formatted b35c9ac0daff yesod-core-1.7.0.0/src/Yesod/Routes/Class.hs+formatted 06717cf94aef yesod-core-1.7.0.0/src/Yesod/Routes/Overlap.hs+formatted 728c1336d2fd yesod-core-1.7.0.0/src/Yesod/Routes/Parse.hs+formatted 7bcf63c3b7e5 yesod-core-1.7.0.0/src/Yesod/Routes/TH.hs+formatted aba7c8cd51ca yesod-core-1.7.0.0/src/Yesod/Routes/TH/Dispatch.hs+formatted a463b5f83292 yesod-core-1.7.0.0/src/Yesod/Routes/TH/Internal.hs+formatted f88d33d3ea28 yesod-core-1.7.0.0/src/Yesod/Routes/TH/ParseRoute.hs+formatted dbc4eb3d7e58 yesod-core-1.7.0.0/src/Yesod/Routes/TH/RenderRoute.hs+formatted 3baa6af3d56d yesod-core-1.7.0.0/src/Yesod/Routes/TH/RouteAttrs.hs+formatted b435513e2c49 yesod-core-1.7.0.0/src/Yesod/Routes/TH/Types.hs+formatted 4cf83d0b0f07 yesod-core-1.7.0.0/test/Hierarchy.hs+formatted acf61854d2ec yesod-core-1.7.0.0/test/Hierarchy/Admin.hs+formatted 38126f8a1ed6 yesod-core-1.7.0.0/test/Hierarchy/Nest.hs+formatted a739150f03f1 yesod-core-1.7.0.0/test/Hierarchy/Nest2.hs+formatted 1998d7e7b6f0 yesod-core-1.7.0.0/test/Hierarchy/Nest2/NestInner.hs+formatted 6e683051218c yesod-core-1.7.0.0/test/Hierarchy/Nest3.hs+formatted 8f1d12dc181e yesod-core-1.7.0.0/test/Hierarchy/ResourceTree.hs+formatted f70ab72cd608 yesod-core-1.7.0.0/test/Route/DeepAritySpec.hs+formatted 1a22181a9cf2 yesod-core-1.7.0.0/test/Route/DeepArityTypes.hs+formatted 6cf89c893af0 yesod-core-1.7.0.0/test/Route/DiscoveryModeSpec.hs+formatted 8742e593c3d0 yesod-core-1.7.0.0/test/Route/FallthroughSpec.hs+formatted 83547078da44 yesod-core-1.7.0.0/test/Route/FocusLeafConsSpec.hs+formatted b96279c392b7 yesod-core-1.7.0.0/test/Route/InlineParseClausesSpec.hs+formatted d8f6752d05e7 yesod-core-1.7.0.0/test/Route/InstanceProbeSpec.hs+formatted 5f762e160869 yesod-core-1.7.0.0/test/Route/InstanceProbeTypes.hs+formatted 66f474c75dbf yesod-core-1.7.0.0/test/Route/MissingFocusTargetSpec.hs+formatted 4ca53b8c21db yesod-core-1.7.0.0/test/Route/MissingFocusTargetTypes.hs+formatted c4733044c565 yesod-core-1.7.0.0/test/Route/NestedParseClausesSpec.hs+formatted 96c9db79de94 yesod-core-1.7.0.0/test/Route/PureQ.hs+formatted 1084d2ca990f yesod-core-1.7.0.0/test/Route/RenderRouteSpec.hs+formatted 5cf00838dae7 yesod-core-1.7.0.0/test/Route/RouteAttrSpec.hs+formatted 9303c7a203b3 yesod-core-1.7.0.0/test/Route/SubDispatchAritySpec.hs+formatted 141148a01530 yesod-core-1.7.0.0/test/RouteSpec.hs+formatted 456251f78b44 yesod-core-1.7.0.0/test/YesodCoreTest.hs+formatted f0034c742a78 yesod-core-1.7.0.0/test/YesodCoreTest/Auth.hs+formatted 3a700bfeb45e yesod-core-1.7.0.0/test/YesodCoreTest/BangSeparatorRuntime.hs+formatted 33355032a6ea yesod-core-1.7.0.0/test/YesodCoreTest/Breadcrumb.hs+formatted 6192a640749e yesod-core-1.7.0.0/test/YesodCoreTest/Cache.hs+formatted 5731b7743f4b yesod-core-1.7.0.0/test/YesodCoreTest/CleanPath.hs+formatted 36a004c6a4e3 yesod-core-1.7.0.0/test/YesodCoreTest/Content.hs+formatted 6d11e0679e7e yesod-core-1.7.0.0/test/YesodCoreTest/Csrf.hs+formatted a73924c2a367 yesod-core-1.7.0.0/test/YesodCoreTest/ErrorHandling.hs+formatted d369eb73b47a yesod-core-1.7.0.0/test/YesodCoreTest/ErrorHandling/CustomApp.hs+formatted 75e0dffb40ce yesod-core-1.7.0.0/test/YesodCoreTest/Exceptions.hs+formatted 82e178e31f61 yesod-core-1.7.0.0/test/YesodCoreTest/FallthroughDispatch/Resources.hs+formatted e4f8f0ea3e72 yesod-core-1.7.0.0/test/YesodCoreTest/FallthroughDispatch/Runtime.hs+formatted 4d5c1d9a3551 yesod-core-1.7.0.0/test/YesodCoreTest/FallthroughMatrix/FirstFoo.hs+formatted bd497866625d yesod-core-1.7.0.0/test/YesodCoreTest/FallthroughMatrix/Resources.hs+formatted 8c70739a50e7 yesod-core-1.7.0.0/test/YesodCoreTest/FallthroughMatrix/Runtime.hs+formatted 2ec1229d8e62 yesod-core-1.7.0.0/test/YesodCoreTest/Header.hs+formatted 964ef508ce0f yesod-core-1.7.0.0/test/YesodCoreTest/InternalRequest.hs+formatted f7afe29ae117 yesod-core-1.7.0.0/test/YesodCoreTest/JsAttributes.hs+formatted 84646813873d yesod-core-1.7.0.0/test/YesodCoreTest/JsLoader.hs+formatted f8cdd188f370 yesod-core-1.7.0.0/test/YesodCoreTest/JsLoaderSites/Bottom.hs+formatted bda9b1f5f2d2 yesod-core-1.7.0.0/test/YesodCoreTest/Json.hs+formatted 23181a127cee yesod-core-1.7.0.0/test/YesodCoreTest/Links.hs+formatted ab54e89c96fb yesod-core-1.7.0.0/test/YesodCoreTest/LiteApp.hs+formatted cc9f882fd64b yesod-core-1.7.0.0/test/YesodCoreTest/Media.hs+formatted 0078c3a7e79d yesod-core-1.7.0.0/test/YesodCoreTest/MediaData.hs+formatted 46b0e2d1153d yesod-core-1.7.0.0/test/YesodCoreTest/Meta.hs+formatted d8beeb52123f yesod-core-1.7.0.0/test/YesodCoreTest/MultiPieceNestedRuntime.hs+formatted fb29902bb9c5 yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/InnerR.hs+formatted 4c9ceb4fb663 yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/NestR.hs+formatted 4aed48f429ab yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/Parent0R.hs+formatted 0f8ca6cd8fe6 yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/Parent0R/Child0R.hs+formatted 762195ad3d8f yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/ParentR.hs+formatted 7587ed701299 yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/Resources.hs+formatted 36defe4aa862 yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/Runtime.hs+formatted 2c72e04ebbc2 yesod-core-1.7.0.0/test/YesodCoreTest/NoOverloadedStrings.hs+formatted 320b6668f0c5 yesod-core-1.7.0.0/test/YesodCoreTest/NoOverloadedStringsSub.hs+formatted ab80a9a09e84 yesod-core-1.7.0.0/test/YesodCoreTest/ParamDefaultSplit/Data.hs+formatted a8472a7588f7 yesod-core-1.7.0.0/test/YesodCoreTest/ParamDefaultSplit/Runtime.hs+formatted 3b1830a98315 yesod-core-1.7.0.0/test/YesodCoreTest/ParamFallthroughRuntime.hs+formatted 9191317f2178 yesod-core-1.7.0.0/test/YesodCoreTest/ParamFocusSplit/Resources.hs+formatted 0d171db106f1 yesod-core-1.7.0.0/test/YesodCoreTest/ParamFocusSplit/Runtime.hs+formatted 6f7510d0b57c yesod-core-1.7.0.0/test/YesodCoreTest/ParamFocusSplit/SubR.hs+formatted 46dbd15fa23d yesod-core-1.7.0.0/test/YesodCoreTest/ParamNestedNoFallthroughRuntime.hs+formatted 32c5372b9148 yesod-core-1.7.0.0/test/YesodCoreTest/ParamNoExplicitArgs.hs+formatted 30470908614f yesod-core-1.7.0.0/test/YesodCoreTest/ParamNoFallthroughRuntime.hs+formatted cf6ee78ba4ee yesod-core-1.7.0.0/test/YesodCoreTest/ParamSubsite/Data.hs+formatted e0dfb958d109 yesod-core-1.7.0.0/test/YesodCoreTest/ParamSubsite/InstanceRuntime.hs+formatted 020a44aa16b1 yesod-core-1.7.0.0/test/YesodCoreTest/ParamSubsite/SplitNested.hs+formatted f8d1220c3bf2 yesod-core-1.7.0.0/test/YesodCoreTest/ParamSubsite/SplitRuntime.hs+formatted 1981b86c26db yesod-core-1.7.0.0/test/YesodCoreTest/ParamTopLevelRuntime.hs+formatted f991cd7adeb7 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite.hs+formatted 0476a7be2abf yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/Compat.hs+formatted b2b143cf4a47 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/PolyAny.hs+formatted eb56902b1432 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/PolyShow.hs+formatted acaebbfebc7a yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/SubRoute.hs+formatted 48e797fc7ef7 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubData.hs+formatted 18a74bf9331c yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubDispatch.hs+formatted eb2ad79d2f60 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubDispatch/Data.hs+formatted c0c9e30ebea8 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubDispatchRuntime.hs+formatted 09c5b840c977 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubDispatchRuntime/Data.hs+formatted 4555e2245690 yesod-core-1.7.0.0/test/YesodCoreTest/RawResponse.hs+formatted de49c81693c6 yesod-core-1.7.0.0/test/YesodCoreTest/Redirect.hs+formatted ddda63d607db yesod-core-1.7.0.0/test/YesodCoreTest/RenderRouteSpec.hs+formatted 139e78486aea yesod-core-1.7.0.0/test/YesodCoreTest/RenderRouteSpec/TH.hs+formatted 73425f7bb9ab yesod-core-1.7.0.0/test/YesodCoreTest/Reps.hs+formatted e18610f848a2 yesod-core-1.7.0.0/test/YesodCoreTest/RequestBodySize.hs+formatted bf72ad1f5d18 yesod-core-1.7.0.0/test/YesodCoreTest/RuntimeHarness.hs+formatted e78bf62c9259 yesod-core-1.7.0.0/test/YesodCoreTest/SplitSubsite/Data.hs+formatted d553ab39b43f yesod-core-1.7.0.0/test/YesodCoreTest/SplitSubsite/NestedR.hs+formatted 1f144a63c0ce yesod-core-1.7.0.0/test/YesodCoreTest/SplitSubsite/Runtime.hs+formatted a05df238a9e5 yesod-core-1.7.0.0/test/YesodCoreTest/Ssl.hs+formatted 203d5f3df4f0 yesod-core-1.7.0.0/test/YesodCoreTest/Streaming.hs+formatted 4a163efbc574 yesod-core-1.7.0.0/test/YesodCoreTest/StubLaxSameSite.hs+formatted 5831f923349c yesod-core-1.7.0.0/test/YesodCoreTest/StubSslOnly.hs+formatted 6510112ce4b4 yesod-core-1.7.0.0/test/YesodCoreTest/StubStrictSameSite.hs+formatted 9cb2274c1880 yesod-core-1.7.0.0/test/YesodCoreTest/StubUnsecured.hs+formatted 1f8bcbc31bb2 yesod-core-1.7.0.0/test/YesodCoreTest/SubSub.hs+formatted e3aad0dd9042 yesod-core-1.7.0.0/test/YesodCoreTest/SubSubData.hs+formatted dbed829ecef5 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteFallthrough/Data.hs+formatted 6ef87c226f01 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteFallthrough/Nested.hs+formatted d5e98e912280 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteFallthrough/Runtime.hs+formatted fffa6b1eb3e9 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteOptsFallthrough/Data.hs+formatted a30c02d77457 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteOptsFallthrough/Runtime.hs+formatted 353abcbca9cc yesod-core-1.7.0.0/test/YesodCoreTest/WaiSubsite.hs+formatted 67eac096b1a7 yesod-core-1.7.0.0/test/YesodCoreTest/Widget.hs+formatted a3265609217d yesod-core-1.7.0.0/test/YesodCoreTest/YesodTest.hs+formatted 4c3c5fb5bdaf yesod-core-1.7.0.0/test/YesodCoreTest/ZeroPieceShadow/FallApp.hs+formatted b332d1f4e633 yesod-core-1.7.0.0/test/YesodCoreTest/ZeroPieceShadow/ShadowApp.hs+formatted 829a6148e881 yesod-core-1.7.0.0/test/YesodCoreTest/ZeroPieceShadowRuntime.hs+formatted 23bd2996a55a yesod-core-1.7.0.0/test/test.hs
+ corpora/hackage/hackage.report view
@@ -0,0 +1,481 @@+Why every example of this corpus that is not `formatted` is not.++Generated beside the manifest, and compared against nothing: this+file is the work list, and it is free to say as much as it likes.++5202 examples, 5137 formatted.++==========================================================================+broken (7)+==========================================================================++Agda-2.8.0/src/full/Agda/TypeChecking/Conversion.hs+ a configuration of the output does not parse: 2240:17: parse error (possibly incorrect indentation or mismatched brackets)+ 2236 blocker = getBlocker s1b+ 2237 -- Jesper, 2019-12-27: SizeUniv is disabled at the moment.+ 2238 if+ 2239 {- sizedTypesEnabled || -} | propEnabled || cubicalEnabled ->+ > 2240 case funSort' s1 (Type l2) of+ 2241 -- If the work we did makes the @funSort@ compute,+ 2242 -- continue working.+ 2243 Right s -> equalSort (Type l) s+ 2244 -- Otherwise: postpone+ + --- input+ +++ output+ @@ -1,137 +1,131 @@+ {-# LANGUAGE CPP #-}+ {-# LANGUAGE NondecreasingIndentation #-}+ -+ #if __GLASGOW_HASKELL__ >= 810+ {-# OPTIONS_GHC -fmax-pmcheck-models=390 #-} -- Andreas, 2023-05-12, limit determined by binary search+ #endif+ + module Agda.TypeChecking.Conversion where+ + -import Control.Arrow (second)+ -import Control.Monad.Except ( MonadError(..) )+ -+ -import Data.Function (on)+ -import Data.Semigroup ((<>))+ -import Data.IntMap (IntMap)+ -+ -import qualified Data.List as List+ -import qualified Data.IntMap as IntMap+ -import qualified Data.IntSet as IntSet+ -import qualified Data.Set as Set+ -+ +import Agda.Interaction.Options+ import Agda.Syntax.Common+ +import Agda.Syntax.Common.Pretty (prettyShow)+ import Agda.Syntax.Internal+ import Agda.Syntax.Internal.MetaVars+ import Agda.Syntax.Translation.InternalToAbstract (reify)+ -+ -import Agda.TypeChecking.Monad+ -import Agda.TypeChecking.MetaVars+ -import Agda.TypeChecking.MetaVars.Occurs (killArgs,PruneResult(..),rigidVarsNotContainedIn)+ -import Agda.TypeChecking.Names+ -import Agda.TypeChecking.Reduce+ -import Agda.TypeChecking.Substitute+ -import qualified Agda.TypeChecking.SyntacticEquality as SynEq+ -import Agda.TypeChecking.Telescope+ import Agda.TypeChecking.Constraints+ import Agda.TypeChecking.Conversion.Pure (pureCompareAs, runPureConversion)+ +import Agda.TypeChecking.Da++dlist-1.0/Data/DList.hs+ a configuration of the input does not parse: 54:13: parse error on input `Nil'+ --- input+ +++ output+ @@ -1,6 +1,5 @@+ {- ORMOLU_DISABLE -}+ {-# LANGUAGE CPP #-}+ -+ -- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list+ #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 800+ {-# LANGUAGE PatternSynonyms #-}+ @@ -41,23 +40,33 @@+ + module Data.DList+ ( -- * Difference List Type+ -+ --- CPP: GHC >= 8 for pattern synonyms allowed in the constructor+ #if __GLASGOW_HASKELL__ >= 800+ ++ + -- CPP: GHC >= 8 for pattern synonyms allowed in the constructor+ DList (Nil, Cons),+ ++ + -- * Conversion+ #else+ ++ + -- CPP: GHC >= 8 for pattern synonyms allowed in the constructor+ DList,+ + --- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list+ #if __GLASGOW_HASKELL__ >= 708+ ++ + -- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list+ ++ -- ** Bundled Patterns+ pattern Nil,+ pattern Cons,+ -#endif+ + -#endif+ + -- * Conversion+ +#else+ + + -- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list+ ++ -- * Conversion+ +#endif+ +#endif+ fromList,+ toList,+ apply,++hashable-1.5.1.0/tests/Regress.hs+ formatting changed how many configurations there are, from 6 to 8+ --- input+ +++ output+ @@ -4,126 +4,190 @@+ + module Regress (regressions) where+ + -import Test.Tasty (TestTree, testGroup)+ import Control.Monad (when)+ -import Test.Tasty.HUnit (testCase, Assertion, assertFailure, (@?=))+ -import Test.Tasty.QuickCheck (testProperty)+ -import GHC.Generics (Generic)+ -import Data.List (nub)+ -import Data.Fixed (Pico)+ -import Data.Text (Text)+ import Data.ByteString (ByteString)+ -+ -import qualified Data.Text.Lazy as TL+ import qualified Data.ByteString.Char8 as BS8+ import qualified Data.ByteString.Lazy as BSL+ import qualified Data.ByteString.Lazy.Char8 as BSL8+ -+ +import Data.Fixed (Pico)+ +import Data.List (nub)+ +import Data.Text (Text)+ +import qualified Data.Text.Lazy as TL+ +import GHC.Generics (Generic)+ +import Test.Tasty (TestTree, testGroup)+ +import Test.Tasty.HUnit (Assertion, assertFailure, testCase, (@?=))+ +import Test.Tasty.QuickCheck (testProperty)+ #ifdef HAVE_MMAP+ import qualified Regress.Mmap as Mmap+ #endif+ -+ import Data.Hashable+ + #include "MachDeps.h"+ + -assertInequal :: Eq a => String -> a -> a -> Assertion+ +assertInequal :: (Eq a) => String -> a -> a -> Assertion+ assertInequal msg x y+ - | x == y = assertFailure msg+ - | otherwise = return ()+ + | x == y = assertFailure msg+ + | otherwise = return ()+ + regressions :: [TestTree]+ -regressions = [] +++ +regressions =+ + []+ #ifdef HAVE_MMAP+ - Mmap.regressions +++ - [ testCase "Fixed" $ do+ - (hash (1 :: Pico) == hash (2 :: Pico)) @?= False+ - ] +++ -#endif+ - [ testGroup "Generic: sum of nullary constructors"+ - [ testCase "0" $ nullaryCase 0 S0+ - , testCase "1" $ nullaryCase 1 S1+ - , testCase "2" $ nullaryCase 2 S2+ - , testCase "3" $ nullaryCase 3 S3+ - , testCase "4" $ nullaryCase 4 S4+ - ]+ … and 214 more lines++hspec-core-2.11.17/src/Test/Hspec/Core/Compat.hs+ formatting is non-idempotent+ --- first pass+ +++ second pass+ @@ -78,17 +78,21 @@+ #endif+ import Control.Concurrent+ import Data.Bool as Imports (bool)+ +#ifndef __MHS__+ +import GHC.IO.Exception+ + ( IOErrorType (..),+ + ioe_type,+ + )+ +#endif+ import System.Environment as Imports (lookupEnv)+ -import Text.Read as Imports (readMaybe)+ -import+ #ifndef __MHS__+ - GHC.IO.Exception+ #else+ - System.IO.Error+ -#endif+ +import System.IO.Error+ ( IOErrorType (..),+ ioe_type,+ )+ +#endif+ +import Text.Read as Imports (readMaybe)+ + isUnsupportedOperation :: IOError -> Bool+ isUnsupportedOperation e = ioe_type e == UnsupportedOperation++idris-1.3.4/src/Idris/AbsSyntax.hs+ formatting is non-idempotent+ --- first pass+ +++ second pass+ @@ -1517,9 +1517,8 @@+ mkShadow (NS x s) = NS (mkShadow x) s+ + en ::+ - Int -- \^ The quotation level - only transform terms that are used, not terms+ - -- that are merely mentioned.+ - ->+ + Int -> -- \^ The quotation level - only transform terms that are used, not terms+ + -- that are merely mentioned.+ PTerm ->+ PTerm+ en 0 (PLam fc n nfc t s)++leksah-0.16.2.2/src/IDE/Pane/PackageEditor.hs+ the output cannot be formatted again: too many configurations to format++lens-5.3.6/src/Control/Exception/Lens.hs+ comments, in one configuration: `{-\n$setup\n>>> :set -XNoOverloadedStrings\n>>> :set -XScopedTypeVariables\n>>> import Control.Lens\n>>> import Control.Applicative\n>>> :m + Control.Exception Control.Monad Data.List Prelude\n\n>>> :m + Control.Exception.Context\n\n-}` became `{-\n$setup\n>>> :set -XNoOverloadedStrings\n>>> :set -XScopedTypeVariables\n>>> import Control.Lens\n>>> import Control.Applicative\n>>> :m + Control.Exception Control.Monad Data.List Prelude\n\n\n>>> :m + Control.Exception.Context\n\n\n\n\n\n\n-}`+ --- input+ +++ output+ @@ -1,12 +1,11 @@+ {-# LANGUAGE CPP #-}+ -{-# LANGUAGE Rank2Types #-}+ {-# LANGUAGE FlexibleInstances #-}+ -{-# LANGUAGE ScopedTypeVariables #-}+ {-# LANGUAGE MultiParamTypeClasses #-}+ -{-# LANGUAGE NoMonomorphismRestriction #-}+ {-# LANGUAGE PatternSynonyms #-}+ +{-# LANGUAGE Rank2Types #-}+ +{-# LANGUAGE ScopedTypeVariables #-}+ {-# LANGUAGE ViewPatterns #-}+ -+ +{-# LANGUAGE NoMonomorphismRestriction #-}+ #ifdef TRUSTWORTHY+ {-# LANGUAGE Trustworthy #-}+ #endif+ @@ -14,6 +13,7 @@+ #include "lens-common.h"+ + -----------------------------------------------------------------------------+ ++ -- |+ -- Module : Control.Exception.Lens+ -- Copyright : (C) 2012-16 Edward Kmett+ @@ -31,139 +31,177 @@+ -- The combinators in this module have been generalized to work with+ -- 'MonadCatch' instead of just 'Prelude.IO'. This enables them to be used+ -- more easily in 'Monad' transformer stacks.+ ++ ----------------------------------------------------------------------------+ module Control.Exception.Lens+ - (+ - -- * Handling+ - catching, catching_+ - , handling, handling_+ - -- * Trying+ - , trying, trying_+ - -- * Throwing+ - , throwing+ - , throwing_+ - , throwingM+ - , throwingTo+ - -- * Mapping+ - , mappedException, mappedException'+ - -- * Exceptions+ - , exception+ - , pattern Exception+ - -- * Exception Handlers+ - , Handleable(..)+ - -- ** IOExceptions+ - , AsIOException(..)+ - , pattern IOException_+ - -- ** Arithmetic Exception++==========================================================================+does-not-parse (2)+==========================================================================++ansi-terminal-1.1.5/win/System/Console/ANSI/Windows/Win32/Types.hs+ 49:1: parse error on input `#'++leksah-0.16.2.2/src/IDE/Find.hs+ 615:36: Bang pattern in expression context: !matchIndex+ Did you mean to add a space after the '!'?++==========================================================================+partly-checked (25)+==========================================================================++QuickCheck-2.18.0.0/src/Test/QuickCheck.hs+ 512 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++QuickCheck-2.18.0.0/src/Test/QuickCheck/Exception.hs+ 192 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++async-2.2.6/Control/Concurrent/Async/Internal.hs+ 1024 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++cryptonite-0.30/Crypto/Number/Compat.hs+ 180 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++hspec-core-2.11.17/vendor/async-2.2.5/Control/Concurrent/Async.hs+ 256 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++intero-0.1.40/src/GhciInfo.hs+ 72 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++stm-2.5.3.1/Control/Monad/STM.hs+ 72 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++text-2.1.4/src/Data/Text.hs+ 192 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++th-abstraction-0.7.2.0/test/Main.hs+ 4096 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Applicative/Backwards.hs+ 3072 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Applicative/Lift.hs+ 96 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Monad/Trans/Accum.hs+ 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Monad/Trans/Except.hs+ 1536 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Monad/Trans/Identity.hs+ 12288 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Monad/Trans/Maybe.hs+ 1536 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Monad/Trans/RWS/Lazy.hs+ 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Monad/Trans/RWS/Strict.hs+ 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Monad/Trans/Reader.hs+ 24576 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Monad/Trans/State/Lazy.hs+ 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Monad/Trans/State/Strict.hs+ 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Monad/Trans/Writer/Lazy.hs+ 1024 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Control/Monad/Trans/Writer/Strict.hs+ 1024 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/Data/Functor/Reverse.hs+ 6144 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++transformers-0.6.3.0/legacy/pre711/Data/Functor/Product.hs+ 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++unliftio-0.2.25.1/src/UnliftIO/Directory.hs+ 1024 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared++==========================================================================+declined (31)+==========================================================================++Agda-2.8.0/src/full/Agda/Main.hs+ too many configurations to format++QuickCheck-2.18.0.0/src/Test/QuickCheck/Arbitrary.hs+ too many configurations to format++QuickCheck-2.18.0.0/src/Test/QuickCheck/Function.hs+ too many configurations to format++QuickCheck-2.18.0.0/src/Test/QuickCheck/Modifiers.hs+ too many configurations to format++QuickCheck-2.18.0.0/src/Test/QuickCheck/Monadic.hs+ too many configurations to format++QuickCheck-2.18.0.0/src/Test/QuickCheck/Property.hs+ QuickCheck-2.18.0.0/src/Test/QuickCheck/Property.hs:315:13-14: parse error on input `::', in the configuration taking #ifndef NO_TYPEABLE, then #ifndef NO_SAFE_HASKELL, then #ifndef NO_TIMEOUT, then #if defined(MIN_VERSION_base), then #ifndef NO_DEEPSEQ, then #ifdef NO_TIMEOUT++cryptonite-0.30/Crypto/Random/Entropy/Windows.hs+ cryptonite-0.30/Crypto/Random/Entropy/Windows.hs:64:16-28: parse error on input `WINDOWS_CCONV', in the configuration taking #if defined(ARCH_X86)++dlist-1.0/Data/DList/Internal.hs+ too many configurations to format++hashable-1.5.1.0/src/Data/Hashable/Class.hs+ too many configurations to format++hlint-3.10/data/HLint_TypeCheck.hs+ a pragma that moves positions, which we do not rewrite++hlint-3.10/src/Config/Yaml.hs+ too many configurations to format++idris-1.3.4/Setup.hs+ too many configurations to format++idris-1.3.4/src/Util/DynamicLinker.hs+ idris-1.3.4/src/Util/DynamicLinker.hs:43:63: parse error on input `\', in the configuration taking #ifdef IDRIS_FFI, then #ifdef mingw32_HOST_OS, then #if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) \, then #ifndef mingw32_HOST_OS, then #ifdef linux_HOST_OS++intero-0.1.40/src/InteractiveUI.hs+ too many configurations to format++intero-0.1.40/src/Main.hs+ too many configurations to format++lens-5.3.6/src/Control/Lens/Wrapped.hs+ too many configurations to format++lens-5.3.6/src/Language/Haskell/TH/Lens.hs+ too many configurations to format++lens-5.3.6/tests/properties.hs+ lens-5.3.6/tests/properties.hs:118:26-28: parse error on input `KVS'++microlens-0.5.0.0/src/Lens/Micro.hs+ too many configurations to format++microlens-0.5.0.0/src/Lens/Micro/Internal.hs+ too many configurations to format++optics-0.4.2.1/tests/Optics/Tests/Utils.hs+ optics-0.4.2.1/tests/Optics/Tests/Utils.hs:123:62: parse error on input `\', in the configuration taking #if __GLASGOW_HASKELL__ >= 802 && __GLASGOW_HASKELL__ <= 806, then #if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ <= 810, then #if __GLASGOW_HASKELL__ == 802, then #if __GLASGOW_HASKELL__ == 810, then #if __GLASGOW_HASKELL__ >= 806, then #if __GLASGOW_HASKELL__ <= 804, then #if __GLASGOW_HASKELL__ == 802 \, then #if __GLASGOW_HASKELL__ >= 900, then #if __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ <= 904, then #if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ <= 810 \++semigroupoids-6.0.2/src/Data/Functor/Bind/Class.hs+ too many configurations to format++shake-0.19.9/src/Development/Shake/Internal/FileInfo.hs+ shake-0.19.9/src/Development/Shake/Internal/FileInfo.hs:149:16-23: parse error on input `CALLCONV', in the configuration taking #ifndef MIN_VERSION_unix, then #ifndef MIN_VERSION_time, then #elif defined(mingw32_HOST_OS), then #ifdef x86_64_HOST_ARCH++shake-0.19.9/src/Development/Shake/Internal/History/Symlink.hs+ shake-0.19.9/src/Development/Shake/Internal/History/Symlink.hs:31:16-23: parse error on input `CALLCONV', in the configuration taking #ifdef mingw32_HOST_OS, then #ifdef x86_64_HOST_ARCH++shake-0.19.9/src/Development/Shake/Internal/Progress.hs+ shake-0.19.9/src/Development/Shake/Internal/Progress.hs:44:16-23: parse error on input `CALLCONV', in the configuration taking #ifdef mingw32_HOST_OS, then #ifdef x86_64_HOST_ARCH++shake-0.19.9/src/General/EscCodes.hs+ shake-0.19.9/src/General/EscCodes.hs:52:16-23: parse error on input `CALLCONV', in the configuration taking #ifdef mingw32_HOST_OS, then #ifdef x86_64_HOST_ARCH++shake-0.19.9/src/General/FileLock.hs+ shake-0.19.9/src/General/FileLock.hs:28:16-23: parse error on input `CALLCONV', in the configuration taking #ifdef mingw32_HOST_OS, then #ifdef x86_64_HOST_ARCH++time-1.16.0.1/lib/Data/Time/Clock/Internal/CTimeval.hs+ time-1.16.0.1/lib/Data/Time/Clock/Internal/CTimeval.hs:35:16-19: parse error on input `capi', in the configuration taking no branch of #if !defined(javascript_HOST_ARCH), then #ifndef mingw32_HOST_OS, then no branch of #if defined(javascript_HOST_ARCH) || defined(__MHS__)++transformers-0.6.3.0/Data/Functor/Constant.hs+ too many configurations to format++transformers-0.6.3.0/legacy/pre709/Data/Functor/Identity.hs+ too many configurations to format++unordered-containers-0.2.21/Data/HashMap/Internal/Array.hs+ unordered-containers-0.2.21/Data/HashMap/Internal/Array.hs:(266,9)-(267,31): Unexpected case expression in function application:+ case writeSmallArray# (unMArray ary) i# b s of s' -> (# s', () #), in the configuration taking #if defined(ASSERTS), then #if defined(__GLASGOW_HASKELL__)+
+ corpora/vendored/declaration/class/blank-lines-between-members-out.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE DefaultSignatures #-}++class Storable a where+ put :: a -> Bytes++ -- for when there is no hand-written instance+ default put :: (Generic a) => a -> Bytes++ -- which is what this then uses+ put = genericPut++class Sized a where+ width :: a -> Int++ height :: a -> Int++class Packed a where+ pack :: a -> Bytes+ unpack :: Bytes -> a++type family Width a where+ -- the ones that fit in a machine word+ Width Int = 64+ Width Word = 64++ -- and the ones that do not+ Width Integer = Unbounded+ Width Rational = Unbounded
+ corpora/vendored/declaration/class/blank-lines-between-members.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE DefaultSignatures #-}++class Storable a where+ put :: a -> Bytes++ -- for when there is no hand-written instance+ default put :: Generic a => a -> Bytes++ -- which is what this then uses+ put = genericPut++class Sized a where+ width :: a -> Int++ height :: a -> Int++class Packed a where+ pack :: a -> Bytes+ unpack :: Bytes -> a++type family Width a where+ -- the ones that fit in a machine word+ Width Int = 64+ Width Word = 64++ -- and the ones that do not+ Width Integer = Unbounded+ Width Rational = Unbounded
+ corpora/vendored/declaration/data/comment-above-a-documented-brace-out.hs view
@@ -0,0 +1,10 @@+module Terminal.Size where++data Size+ = MkSize+ -- static+ { -- | how tall the terminal is+ rows :: Int,+ -- | how wide it is+ columns :: Int+ }
+ corpora/vendored/declaration/data/comment-above-a-documented-brace.hs view
@@ -0,0 +1,10 @@+module Terminal.Size where++data Size+ = MkSize+ -- static+ { rows :: Int+ -- ^ how tall the terminal is+ , columns :: Int+ -- ^ how wide it is+ }
+ corpora/vendored/declaration/data/comment-above-a-moved-haddock-out.hs view
@@ -0,0 +1,9 @@+module Terminal.Size where++data Size = Size+ { rows :: Int,+ -- Measured once at startup; the terminal is not resized while we run.++ -- | How wide the terminal is.+ columns :: Int+ }
+ corpora/vendored/declaration/data/comment-above-a-moved-haddock.hs view
@@ -0,0 +1,8 @@+module Terminal.Size where++data Size = Size+ { rows :: Int+ -- Measured once at startup; the terminal is not resized while we run.+ , columns :: Int+ -- ^ How wide the terminal is.+ }
+ corpora/vendored/declaration/data/comment-in-record-braces-out.hs view
@@ -0,0 +1,9 @@+data Empty = Empty+ {+ -- room for fields later+ }++data One = One+ { only :: Int+ -- and nothing else+ }
+ corpora/vendored/declaration/data/comment-in-record-braces.hs view
@@ -0,0 +1,7 @@+data Empty = Empty {+ -- room for fields later+ }++data One = One { only :: Int+ -- and nothing else+ }
+ corpora/vendored/declaration/data/haddock-with-a-blank-under-it-out.hs view
@@ -0,0 +1,8 @@+module Terminal.Size where++data Unit+ = -- | measured in rows+ --+ Rows+ | -- | measured in columns+ Columns
+ corpora/vendored/declaration/data/haddock-with-a-blank-under-it.hs view
@@ -0,0 +1,8 @@+module Terminal.Size where++data Unit+ = Rows+ -- ^ measured in rows+ --+ | Columns+ -- ^ measured in columns
+ corpora/vendored/declaration/type/lone-variable-context-out.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE RequiredTypeArguments #-}++variable :: r => Int+variable = undefined++applied :: (Show a) => a -> a+applied = id++pair :: (r, s) => Int+pair = undefined++variableAndApplied :: (r, Show a) => a+variableAndApplied = undefined++nothing :: () => Int+nothing = undefined++quotedVariable = describe (r => Int)++quotedApplied = describe ((Show a) => a)++quotedPair = describe ((r, s) => Int)
+ corpora/vendored/declaration/type/lone-variable-context.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE RequiredTypeArguments #-}++variable :: r => Int+variable = undefined++applied :: Show a => a -> a+applied = id++pair :: (r, s) => Int+pair = undefined++variableAndApplied :: (r, Show a) => a+variableAndApplied = undefined++nothing :: () => Int+nothing = undefined++quotedVariable = describe (r => Int)++quotedApplied = describe (Show a => a)++quotedPair = describe ((r, s) => Int)
+ corpora/vendored/declaration/value/comment-across-a-separator-out.hs view
@@ -0,0 +1,29 @@+-- A block comment closes itself, so it is printed where the region that+-- carries it is printed. It must not be carried back across the token that+-- opens a body, or it comes out in front of what is being defined.+plain =+ {- one at a time -}+ 1++withArguments n m =+ {- takes two -}+ n + m++inAnAlternative n =+ case n of+ 0 ->+ {- the base case -}+ stop+ _ -> go n++-- Crossing a token in the middle of a construct is another matter: it+-- neither leaves the construct nor lands in front of it.+inTheMiddle n =+ case n {- worth a look -} of+ 0 -> stop+ _ -> go n++-- A line comment owns the rest of its line wherever it is put, so it stays+-- at the end of the line the author wrote it on.+heldBack n = -- one at a time+ n
+ corpora/vendored/declaration/value/comment-across-a-separator.hs view
@@ -0,0 +1,26 @@+-- A block comment closes itself, so it is printed where the region that+-- carries it is printed. It must not be carried back across the token that+-- opens a body, or it comes out in front of what is being defined.+plain = {- one at a time -}+ 1++withArguments n m = {- takes two -}+ n + m++inAnAlternative n =+ case n of+ 0 -> {- the base case -}+ stop+ _ -> go n++-- Crossing a token in the middle of a construct is another matter: it+-- neither leaves the construct nor lands in front of it.+inTheMiddle n =+ case n of {- worth a look -}+ 0 -> stop+ _ -> go n++-- A line comment owns the rest of its line wherever it is put, so it stays+-- at the end of the line the author wrote it on.+heldBack n = -- one at a time+ n
+ corpora/vendored/declaration/value/comment-after-do-out.hs view
@@ -0,0 +1,8 @@+warmEverything =+ entries+ >>= \entry -> -- one at a time, so a failure names the entry+ warm entry++reportOn entry = do -- the counters are read once, before any of this runs+ hits <- readCounter entry+ pure hits
+ corpora/vendored/declaration/value/comment-after-do.hs view
@@ -0,0 +1,8 @@+warmEverything =+ entries+ >>= \entry -> -- one at a time, so a failure names the entry+ warm entry++reportOn entry = do -- the counters are read once, before any of this runs+ hits <- readCounter entry+ pure hits
+ corpora/vendored/declaration/value/comment-below-keyword-out.hs view
@@ -0,0 +1,27 @@+afterAnEquals n =+ let step = -- one at a time+ -- and no faster than that+ 1+ in n + step++afterAnArrow n =+ case compare n 0 of+ GT -> -- above zero+ -- so we climb+ climb n+ EQ -> stay+ LT -> fall n++afterThen n =+ if n > 0+ then -- the only interesting branch+ -- and the only one worth a remark+ climb n+ else fall n++afterElse n =+ if n > 0+ then climb n+ else -- everything that is left+ -- which is most of it+ fall n
+ corpora/vendored/declaration/value/comment-below-keyword.hs view
@@ -0,0 +1,27 @@+afterAnEquals n =+ let step = -- one at a time+ -- and no faster than that+ 1+ in n + step++afterAnArrow n =+ case compare n 0 of+ GT -> -- above zero+ -- so we climb+ climb n+ EQ -> stay+ LT -> fall n++afterThen n =+ if n > 0+ then -- the only interesting branch+ -- and the only one worth a remark+ climb n+ else fall n++afterElse n =+ if n > 0+ then climb n+ else -- everything that is left+ -- which is most of it+ fall n
+ corpora/vendored/declaration/value/comment-carried-on-out.hs view
@@ -0,0 +1,40 @@+-- A comment lined up under a line that ended in one, with nothing below it+-- at that column, carries that remark on rather than beginning one about+-- what follows.+carriedOn xs ys =+ [ (a, b)+ | a <-+ xs+ + xs -- said once+ -- and never twice+ | b <- ys+ ]++-- The same, where what follows is not a sibling but nothing at all.+class+ a -- said once+ :+ b -- said twice+ -- and a third time++-- Code below at the comment's own column is code the comment sits over,+-- however the line above ended.+sitsOver =+ opening+ <> -- said once+ -- and never twice+ closing++-- Lined up with nothing, because the line above was blank.+afterAGap = do+ a --++ bar++-- Lined up with a line that has a comment on it but does not end in one, so+-- there is no remark above to carry on.+codeAfterTheComment =+ g+ (a {- said once -} + b)+ -- and this is about something else+ where+ h = 1
+ corpora/vendored/declaration/value/comment-carried-on.hs view
@@ -0,0 +1,38 @@+-- A comment lined up under a line that ended in one, with nothing below it+-- at that column, carries that remark on rather than beginning one about+-- what follows.+carriedOn xs ys =+ [ (a, b)+ | a <- xs+ + xs -- said once+ -- and never twice+ | b <- ys+ ]++-- The same, where what follows is not a sibling but nothing at all.+class+ a -- said once+ :+ b -- said twice+ -- and a third time++-- Code below at the comment's own column is code the comment sits over,+-- however the line above ended.+sitsOver =+ opening+ <> -- said once+ -- and never twice+ closing++-- Lined up with nothing, because the line above was blank.+afterAGap = do+ a --++ bar++-- Lined up with a line that has a comment on it but does not end in one, so+-- there is no remark above to carry on.+codeAfterTheComment = g+ (a {- said once -} + b)+ -- and this is about something else+ where+ h = 1
+ corpora/vendored/declaration/value/comment-in-operator-chain-out.hs view
@@ -0,0 +1,20 @@+everyOperandAnnotated =+ base -- what we started from+ + delta -- what was added+ - refund -- and what came back++annotatedOperators =+ base+ + delta -- the adjustment+ - refund -- the reimbursement++remarkBetweenOperatorAndOperand =+ opening+ <> -- said once+ -- and never twice+ closing++lastOperandOnly =+ first+ `mappend` second+ `mappend` third -- and no further
+ corpora/vendored/declaration/value/comment-in-operator-chain.hs view
@@ -0,0 +1,22 @@+everyOperandAnnotated =+ base -- what we started from+ + delta -- what was added+ - refund -- and what came back++annotatedOperators =+ base+ + -- the adjustment+ delta+ - -- the reimbursement+ refund++remarkBetweenOperatorAndOperand =+ opening+ <> -- said once+ -- and never twice+ closing++lastOperandOnly =+ first+ `mappend` second+ `mappend` third -- and no further
+ corpora/vendored/declaration/value/comment-on-record-wildcard-out.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE RecordWildCards #-}++wildcardAlone =+ Shape+ { .. -- whatever is in scope+ }++wildcardLast =+ Shape+ { name = "circle",+ colour = Red,+ .. -- and the radius comes from above+ }++wildcardWithARemarkAbove =+ Shape+ { name = "square",+ -- the sides are already bound+ .. -- so they need no mention+ }++wildcardInAPattern Shape {..} = name -- bound by the wildcard++wildcardInAPatternWithFields+ Shape+ { name, -- named outright+ ..+ } = name
+ corpora/vendored/declaration/value/comment-on-record-wildcard.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE RecordWildCards #-}++wildcardAlone =+ Shape+ { .. -- whatever is in scope+ }++wildcardLast =+ Shape+ { name = "circle",+ colour = Red,+ .. -- and the radius comes from above+ }++wildcardWithARemarkAbove =+ Shape+ { name = "square",+ -- the sides are already bound+ .. -- so they need no mention+ }++wildcardInAPattern Shape {..} = name -- bound by the wildcard++wildcardInAPatternWithFields+ Shape+ { name, -- named outright+ ..+ } = name
+ corpora/vendored/declaration/value/function/arrow/comment-after-a-command-do-out.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE Arrows #-}++module Cache.Pipeline where++widen f = proc entry -> do -- one stage at a time, so a failure names the stage+ warmed <- f -< entry+ returnA -< warmed
+ corpora/vendored/declaration/value/function/arrow/comment-after-a-command-do.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE Arrows #-}++module Cache.Pipeline where++widen f = proc entry -> do -- one stage at a time, so a failure names the stage+ warmed <- f -< entry+ returnA -< warmed
+ corpora/vendored/declaration/value/operator-chain-precedence-out.hs view
@@ -0,0 +1,25 @@+infixl 2 `stackOn`++infix 9 `keyedBy`++infixr 1 `orElse`++onOneLine = base `stackOn` middle `keyedBy` name++tighterOperatorNestsUnderLooser =+ base+ `stackOn` middle+ `keyedBy` name++behindADollar =+ render $+ base+ `stackOn` middle+ `keyedBy` name++oneLevelStaysFlat = first `orElse` second `orElse` third++oneLevelStaysFlatWhenSpread =+ first+ `orElse` second+ `orElse` third
+ corpora/vendored/declaration/value/operator-chain-precedence.hs view
@@ -0,0 +1,21 @@+infixl 2 `stackOn`++infix 9 `keyedBy`++infixr 1 `orElse`++onOneLine = base `stackOn` middle `keyedBy` name++tighterOperatorNestsUnderLooser = base+ `stackOn` middle+ `keyedBy` name++behindADollar = render $ base+ `stackOn` middle+ `keyedBy` name++oneLevelStaysFlat = first `orElse` second `orElse` third++oneLevelStaysFlatWhenSpread = first+ `orElse` second+ `orElse` third
+ corpora/vendored/declaration/value/quoted-type-arguments-out.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE LinearTypes #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE UnicodeSyntax #-}++plain = describe (Bool)++arrow = describe (Char -> Bool)++quantified = describe (forall k. Holder k)++constrained = describe ((Readable r) => r)++constrainedTwice = describe ((Readable r, Countable r) => r)++linear = describe (Char %1 -> Bool)++linearUnicode = describe (Char %1 -> Bool)++multiplicity = describe (forall n. Char %n -> Bool)++wrapped =+ describe+ ( ( forall k.+ Holder k+ )+ )++sprawling =+ describe+ ( forall k n.+ (Readable k, Countable k) =>+ Holder k %n ->+ Maybe+ (Char, Word) %1 ->+ Text+ )
+ corpora/vendored/declaration/value/quoted-type-arguments.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE LinearTypes #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE UnicodeSyntax #-}++plain = describe (Bool)++arrow = describe (Char -> Bool)++quantified = describe (forall k. Holder k)++constrained = describe (Readable r => r)++constrainedTwice = describe ((Readable r, Countable r) => r)++linear = describe (Char %1 -> Bool)++linearUnicode = describe (Char ⊸ Bool)++multiplicity = describe (forall n. Char %n -> Bool)++wrapped =+ describe+ ( ( forall k.+ Holder k+ )+ )++sprawling = describe (forall k n. (Readable k, Countable k)+ => Holder k+ %n -> Maybe+ (Char , Word)+ ⊸ Text)
+ corpora/vendored/import/a-comment-with-no-name-after-it-out.hs view
@@ -0,0 +1,10 @@+module Ledger.Journal where++import Ledger.Entry (entryDate)+import Ledger.Entry+ ( entryNarration,+ -- kept as written, trailing spaces and all+ )++dated :: Entry -> Int+dated = entryDate
+ corpora/vendored/import/a-comment-with-no-name-after-it.hs view
@@ -0,0 +1,10 @@+module Ledger.Journal where++import Ledger.Entry (entryDate)+import Ledger.Entry+ ( entryNarration+ -- kept as written, trailing spaces and all+ )++dated :: Entry -> Int+dated = entryDate
+ corpora/vendored/import/comment-in-import-list-out.hs view
@@ -0,0 +1,8 @@+import Alpha+ (+ -- nothing taken yet+ )+import Beta+ ( one,+ -- and nothing else+ )
+ corpora/vendored/import/comment-in-import-list.hs view
@@ -0,0 +1,6 @@+import Alpha (+ -- nothing taken yet+ )+import Beta (one+ -- and nothing else+ )
+ corpora/vendored/import/comment-inside-a-repeated-import-out.hs view
@@ -0,0 +1,17 @@+module Cache.Report where++import Cache.Entry+ ( Entry+ ( key+ -- the path the entry was read from+ ),+ )+import Cache.Entry+ ( Entry+ ( hits+ -- counted since the last eviction+ ),+ )++describe :: Entry -> String+describe _ = "entry"
+ corpora/vendored/import/comment-inside-a-repeated-import.hs view
@@ -0,0 +1,17 @@+module Cache.Report where++import Cache.Entry+ ( Entry+ ( key+ -- the path the entry was read from+ )+ )+import Cache.Entry+ ( Entry+ ( hits+ -- counted since the last eviction+ )+ )++describe :: Entry -> String+describe _ = "entry"
+ corpora/vendored/import/comment-inside-import-out.hs view
@@ -0,0 +1,3 @@+import qualified+ -- on a line of its own+ Gamma
+ corpora/vendored/import/comment-inside-import.hs view
@@ -0,0 +1,3 @@+import qualified+ -- on a line of its own+ Gamma
+ corpora/vendored/import/merging-around-an-anchored-comment-out.hs view
@@ -0,0 +1,13 @@+module Ledger.Rules where++import Ledger.Rule+ ( ruleName,+ rulePriority,+ )+import Ledger.Rule+ ( ruleMatcher,+ -- matched against the whole description+ )++named :: Rule -> String+named = ruleName
+ corpora/vendored/import/merging-around-an-anchored-comment.hs view
@@ -0,0 +1,11 @@+module Ledger.Rules where++import Ledger.Rule (ruleName)+import Ledger.Rule+ ( ruleMatcher+ -- matched against the whole description+ )+import Ledger.Rule (rulePriority)++named :: Rule -> String+named = ruleName
+ corpora/vendored/import/merging-keeps-a-comment-above-a-name-out.hs view
@@ -0,0 +1,11 @@+module Ledger.Balance where++import Ledger.Account+ ( accountKind,+ accountName,+ -- carried in from the period before this one+ accountOpening,+ )++label :: Account -> String+label = accountName
+ corpora/vendored/import/merging-keeps-a-comment-above-a-name.hs view
@@ -0,0 +1,11 @@+module Ledger.Balance where++import Ledger.Account (accountName)+import Ledger.Account+ ( -- carried in from the period before this one+ accountOpening,+ accountKind+ )++label :: Account -> String+label = accountName
+ corpora/vendored/import/merging-keeps-a-comment-above-the-block-out.hs view
@@ -0,0 +1,10 @@+module Telemetry.Report where++-- both halves of a sink live in the one module+import Telemetry.Sink+ ( sinkFlush,+ sinkName,+ )++describe :: Sink -> String+describe = sinkName
+ corpora/vendored/import/merging-keeps-a-comment-above-the-block.hs view
@@ -0,0 +1,8 @@+module Telemetry.Report where++-- both halves of a sink live in the one module+import Telemetry.Sink (sinkName)+import Telemetry.Sink (sinkFlush)++describe :: Sink -> String+describe = sinkName
+ corpora/vendored/import/merging-keeps-a-comment-inside-a-thing-out.hs view
@@ -0,0 +1,12 @@+module Survey.Render where++import Survey.Form+ ( Form+ ( formLocale,+ formPages, -- in the order they are shown+ formTitle+ ),+ )++title :: Form -> String+title = formTitle
+ corpora/vendored/import/merging-keeps-a-comment-inside-a-thing.hs view
@@ -0,0 +1,12 @@+module Survey.Render where++import Survey.Form (Form (formTitle))+import Survey.Form+ ( Form+ ( formPages, -- in the order they are shown+ formLocale+ )+ )++title :: Form -> String+title = formTitle
+ corpora/vendored/import/merging-keeps-a-trailing-comment-out.hs view
@@ -0,0 +1,10 @@+module Ledger.Summary where++import Ledger.Posting+ ( postingAccount,+ postingAmount, -- signed, negative for credits+ postingDate,+ )++total :: [Posting] -> Int+total = sum . map postingAmount
+ corpora/vendored/import/merging-keeps-a-trailing-comment.hs view
@@ -0,0 +1,10 @@+module Ledger.Summary where++import Ledger.Posting (postingDate)+import Ledger.Posting+ ( postingAccount,+ postingAmount -- signed, negative for credits+ )++total :: [Posting] -> Int+total = sum . map postingAmount
+ corpora/vendored/import/sorting-keeps-comments-with-their-names-out.hs view
@@ -0,0 +1,11 @@+module Survey.Answer where++import Survey.Question+ ( questionId, -- unique within a survey, not across surveys+ -- answered before the respondent may go on+ questionRequired,+ questionText,+ )++ask :: Question -> String+ask = questionText
+ corpora/vendored/import/sorting-keeps-comments-with-their-names.hs view
@@ -0,0 +1,11 @@+module Survey.Answer where++import Survey.Question+ ( questionText,+ questionId, -- unique within a survey, not across surveys+ -- answered before the respondent may go on+ questionRequired+ )++ask :: Question -> String+ask = questionText
+ corpora/vendored/other/block-comment-above-a-haddock-out.hs view
@@ -0,0 +1,6 @@+module Cache.Cold where++{- Not exported: the eviction order is Cache.Warm's business. -}+-- | Drop everything the cache is holding.+cool :: IO ()+cool = pure ()
+ corpora/vendored/other/block-comment-above-a-haddock.hs view
@@ -0,0 +1,6 @@+module Cache.Cold where++{- Not exported: the eviction order is Cache.Warm's business. -}+-- | Drop everything the cache is holding.+cool :: IO ()+cool = pure ()
+ corpora/vendored/other/block-comment-under-a-haddock-out.hs view
@@ -0,0 +1,6 @@+module Cache.Size where++-- | How many entries the cache holds, which the type already fixes.+{-@ entries :: Cache n a -> {k : Int | k == n} @-}+entries :: Cache n a -> Int+entries = const 0
+ corpora/vendored/other/block-comment-under-a-haddock.hs view
@@ -0,0 +1,6 @@+module Cache.Size where++-- | How many entries the cache holds, which the type already fixes.+{-@ entries :: Cache n a -> {k : Int | k == n} @-}+entries :: Cache n a -> Int+entries = const 0
+ corpora/vendored/other/comment-above-the-first-binding-out.hs view
@@ -0,0 +1,9 @@+module Route.Fare where++fare :: Int -> Int+fare riders =+ let+ -- the share the operator keeps+ operator = 3+ levy = 1+ in operator * riders + levy
+ corpora/vendored/other/comment-above-the-first-binding.hs view
@@ -0,0 +1,9 @@+module Route.Fare where++fare :: Int -> Int+fare riders =+ let+ -- the share the operator keeps+ operator = 3+ levy = 1+ in operator * riders + levy
+ corpora/vendored/other/comment-above-the-in-keyword-out.hs view
@@ -0,0 +1,8 @@+module Route.Total where++total :: Int -> Int+total stops =+ let each = 12+ in+ -- the sum every caller ends up wanting+ each * stops
+ corpora/vendored/other/comment-above-the-in-keyword.hs view
@@ -0,0 +1,7 @@+module Route.Total where++total :: Int -> Int+total stops =+ let each = 12+ -- the sum every caller ends up wanting+ in each * stops
+ corpora/vendored/other/comment-after-closing-bracket-out.hs view
@@ -0,0 +1,27 @@+tupleOfHalves =+ combine+ ( north,+ south+ ) -- the two halves+ ( east,+ west+ ) -- and the other two++nestedRuns =+ render+ [ [ alpha,+ beta+ ] -- the inner run+ ] -- the outer run++runningTotal =+ weigh+ ( heavier+ + lighter+ ) -- everything so far++blockAfterBracket =+ measure+ ( width,+ height+ ) {- taken at the widest point -}
+ corpora/vendored/other/comment-after-closing-bracket.hs view
@@ -0,0 +1,22 @@+tupleOfHalves =+ combine+ ( north,+ south ) -- the two halves+ ( east,+ west ) -- and the other two++nestedRuns =+ render+ [ [ alpha,+ beta ] -- the inner run+ ] -- the outer run++runningTotal =+ weigh+ ( heavier+ + lighter ) -- everything so far++blockAfterBracket =+ measure+ ( width,+ height ) {- taken at the widest point -}
+ corpora/vendored/other/comment-after-header-pragma-out.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-} -- Foldable and Functor come with it+-- said about the pragma below, not about the module+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-} -- until the instances move upstream+{-# OPTIONS_HADDOCK not-home #-}++module Header where
+ corpora/vendored/other/comment-after-header-pragma.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE DeriveTraversable #-} -- Foldable and Functor come with it+{-# LANGUAGE DeriveFunctor #-}++-- said about the pragma below, not about the module+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-} -- until the instances move upstream+{-# OPTIONS_HADDOCK not-home #-}++module Header where
+ corpora/vendored/other/comment-after-opening-bracket-out.hs view
@@ -0,0 +1,37 @@+import Data.List+ (+ -- on a line of its own+ sort,+ )++parenthesised =+ (+ -- on a line of its own+ value+ )++listed =+ [+ -- on a line of its own+ first,+ second+ ]++typed ::+ (+ -- on a line of its own+ Int+ )+typed = 0++data Colour+ = Red+ |+ -- on a line of its own+ Green++data Shape = Circle+ {+ -- on a line of its own+ radius :: Int+ }
+ corpora/vendored/other/comment-after-opening-bracket.hs view
@@ -0,0 +1,26 @@+import Data.List+ (+ -- on a line of its own+ sort)++parenthesised = (+ -- on a line of its own+ value)++listed = [+ -- on a line of its own+ first, second]++typed :: (+ -- on a line of its own+ Int)+typed = 0++data Colour =+ Red+ -- on a line of its own+ | Green++data Shape = Circle {+ -- on a line of its own+ radius :: Int }
+ corpora/vendored/other/comment-after-the-in-keyword-out.hs view
@@ -0,0 +1,7 @@+module Route.Trim where++trim :: Int -> Int+trim n =+ let kept = n - 1+ in -- rounded down on purpose+ kept
+ corpora/vendored/other/comment-after-the-in-keyword.hs view
@@ -0,0 +1,7 @@+module Route.Trim where++trim :: Int -> Int+trim n =+ let kept = n - 1+ in -- rounded down on purpose+ kept
+ corpora/vendored/other/comment-after-the-let-keyword-out.hs view
@@ -0,0 +1,8 @@+module Route.Cost where++leg :: Int -> Int+leg n =+ let -- charged once, whatever the distance+ base = 40+ perStop = 7+ in base + perStop * n
+ corpora/vendored/other/comment-after-the-let-keyword.hs view
@@ -0,0 +1,8 @@+module Route.Cost where++leg :: Int -> Int+leg n =+ let -- charged once, whatever the distance+ base = 40+ perStop = 7+ in base + perStop * n
+ corpora/vendored/other/comment-before-closing-bracket-out.hs view
@@ -0,0 +1,23 @@+oneElement =+ [ first+ -- and nothing after it+ ]++severalElements =+ [ first,+ second+ -- and nothing after them+ ]++blockComment =+ [ first+ {- room+ for more -}+ ]++nested =+ [ outer,+ [ inner+ -- innermost+ ]+ ]
+ corpora/vendored/other/comment-before-closing-bracket.hs view
@@ -0,0 +1,17 @@+oneElement = [ first+ -- and nothing after it+ ]++severalElements = [ first, second+ -- and nothing after them+ ]++blockComment = [ first+ {- room+ for more -}+ ]++nested = [ outer, [ inner+ -- innermost+ ]+ ]
+ corpora/vendored/other/comment-between-let-bindings-out.hs view
@@ -0,0 +1,8 @@+module Route.Split where++split :: Int -> Int+split total =+ let outward = total `div` 2+ -- whatever is left over rides home+ homeward = total - outward+ in homeward
+ corpora/vendored/other/comment-between-let-bindings.hs view
@@ -0,0 +1,8 @@+module Route.Split where++split :: Int -> Int+split total =+ let outward = total `div` 2+ -- whatever is left over rides home+ homeward = total - outward+ in homeward
+ corpora/vendored/other/comment-carried-on-past-its-second-line-out.hs view
@@ -0,0 +1,21 @@+module Kiln.Schedule where++rampRate :: Int -> Int+rampRate held =+ clamp+ ( between+ (floorOf held)+ (ceilingOf held) -- the kiln never reports+ -- a reading below this+ -- once the burners are lit+ )++soakTime :: Int -> Int+soakTime held =+ clamp+ ( between+ (floorOf held)+ (ceilingOf held)+ -- a remark of its own, begun here+ -- and carried on to a second line+ )
+ corpora/vendored/other/comment-carried-on-past-its-second-line.hs view
@@ -0,0 +1,21 @@+module Kiln.Schedule where++rampRate :: Int -> Int+rampRate held =+ clamp+ ( between+ (floorOf held)+ (ceilingOf held) -- the kiln never reports+ -- a reading below this+ -- once the burners are lit+ )++soakTime :: Int -> Int+soakTime held =+ clamp+ ( between+ (floorOf held)+ (ceilingOf held)+ -- a remark of its own, begun here+ -- and carried on to a second line+ )
+ corpora/vendored/other/comment-held-off-a-haddock-out.hs view
@@ -0,0 +1,8 @@+module Cache.Hit where++hits :: Int+hits = 0 -- counted since the last eviction++-- | Whether the last lookup found anything.+found :: Bool+found = True
+ corpora/vendored/other/comment-held-off-a-haddock.hs view
@@ -0,0 +1,7 @@+module Cache.Hit where++hits :: Int+hits = 0 -- counted since the last eviction+-- | Whether the last lookup found anything.+found :: Bool+found = True
+ corpora/vendored/other/comment-in-a-do-let-out.hs view
@@ -0,0 +1,8 @@+module Route.Plan where++plan :: IO Int+plan = do+ let -- worked out before anything is printed+ stops = 9+ print stops+ pure stops
+ corpora/vendored/other/comment-in-a-do-let.hs view
@@ -0,0 +1,8 @@+module Route.Plan where++plan :: IO Int+plan = do+ let -- worked out before anything is printed+ stops = 9+ print stops+ pure stops
+ corpora/vendored/other/comment-in-a-one-line-let-out.hs view
@@ -0,0 +1,4 @@+module Route.Once where++once :: Int+once = let n = 1 {- settled when the timetable is built -} in n
+ corpora/vendored/other/comment-in-a-one-line-let.hs view
@@ -0,0 +1,4 @@+module Route.Once where++once :: Int+once = let n = 1 {- settled when the timetable is built -} in n
+ corpora/vendored/other/comment-over-a-hoisted-pragma-out.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE OverloadedStrings #-}+-- eviction order is Cache.Warm's business+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- | Cooling the cache.+module Cache.Cool where++cool :: IO ()+cool = pure ()
+ corpora/vendored/other/comment-over-a-hoisted-pragma.hs view
@@ -0,0 +1,11 @@+-- | Cooling the cache.++{-# LANGUAGE OverloadedStrings #-}++-- eviction order is Cache.Warm's business+{-# OPTIONS_GHC -Wno-unused-imports #-}++module Cache.Cool where++cool :: IO ()+cool = pure ()
+ corpora/vendored/other/comment-paragraph-trailing-the-module-out.hs view
@@ -0,0 +1,12 @@+module Kiln.Firing where++holdFor :: Int -> Int -> Int+holdFor minutes degrees = minutes * degrees++-- The lines of this paragraph belong to one another, and the lexer hands+-- each of them over on its own. An empty line written over every one would+-- take the paragraph apart and set out each line as a remark of its own.++-- A second paragraph, which the empty line above it does set apart. The+-- spacing between the two is the author's, and so is the lack of it within+-- either.
+ corpora/vendored/other/comment-paragraph-trailing-the-module.hs view
@@ -0,0 +1,12 @@+module Kiln.Firing where++holdFor :: Int -> Int -> Int+holdFor minutes degrees = minutes * degrees++-- The lines of this paragraph belong to one another, and the lexer hands+-- each of them over on its own. An empty line written over every one would+-- take the paragraph apart and set out each line as a remark of its own.++-- A second paragraph, which the empty line above it does set apart. The+-- spacing between the two is the author's, and so is the lack of it within+-- either.
+ corpora/vendored/other/comment-spliced-into-a-line-out.hs view
@@ -0,0 +1,7 @@+module Terminal.Size where++resize d = case d of+ Size+ { rows = r,+ columns = c {-, depth = d-}+ } -> r + c
+ corpora/vendored/other/comment-spliced-into-a-line.hs view
@@ -0,0 +1,5 @@+module Terminal.Size where++resize d = case d of+ Size{ rows = r, columns = c+ {-, depth = d-} } -> r + c
+ corpora/vendored/other/comment-trailing-a-let-binding-out.hs view
@@ -0,0 +1,7 @@+module Route.Delay where++delay :: Int -> Int+delay minutes =+ let slack = 4 -- padding the timetable already allows+ late = minutes - slack+ in max 0 late
+ corpora/vendored/other/comment-trailing-a-let-binding.hs view
@@ -0,0 +1,7 @@+module Route.Delay where++delay :: Int -> Int+delay minutes =+ let slack = 4 -- padding the timetable already allows+ late = minutes - slack+ in max 0 late
+ corpora/vendored/other/comment-trailing-the-last-let-binding-out.hs view
@@ -0,0 +1,7 @@+module Route.Final where++final :: Int -> Int+final n =+ let first = n+ second = first + 1 -- the one the caller actually gets+ in second
+ corpora/vendored/other/comment-trailing-the-last-let-binding.hs view
@@ -0,0 +1,7 @@+module Route.Final where++final :: Int -> Int+final n =+ let first = n+ second = first + 1 -- the one the caller actually gets+ in second
+ corpora/vendored/other/comment-under-a-block-haddock-out.hs view
@@ -0,0 +1,6 @@+module Cache.Warm where++{- | Fill the cache before the first request arrives. -}+-- TODO: measure whether this still earns its keep+warm :: IO ()+warm = pure ()
+ corpora/vendored/other/comment-under-a-block-haddock.hs view
@@ -0,0 +1,6 @@+module Cache.Warm where++{- | Fill the cache before the first request arrives. -}+-- TODO: measure whether this still earns its keep+warm :: IO ()+warm = pure ()
+ corpora/vendored/other/comment-under-a-hoisted-pragma-out.hs view
@@ -0,0 +1,17 @@+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}++-- | Warming the cache.+--+-- Usage:+-- @+--+-- import qualified Cache.Warm as Warm+--+-- @++-- the shapes below are exhaustive, but not obviously so++module Cache.Warm where++warm :: IO ()+warm = pure ()
+ corpora/vendored/other/comment-under-a-hoisted-pragma.hs view
@@ -0,0 +1,16 @@+-- | Warming the cache.+--+-- Usage:+-- @+--+-- import qualified Cache.Warm as Warm+--+-- @++{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+ -- the shapes below are exhaustive, but not obviously so++module Cache.Warm where++warm :: IO ()+warm = pure ()
+ corpora/vendored/other/cpp/branch-with-a-where-clause-out.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}++module Cache.Warm where++warm :: IO ()+warm = do+#if TRACING+ report (label 1)+ where+ label n = "warm " <> show n+#else+ pure ()+#endif
+ corpora/vendored/other/cpp/branch-with-a-where-clause.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}++module Cache.Warm where++warm :: IO ()+warm = do+#if TRACING+ report (label 1)+ where+ label n = "warm " <> show n+#else+ pure ()+#endif
+ corpora/vendored/other/cpp/comments-in-branches-out.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE CPP #-}++module Terminal.Timing where++-- | How long to wait for a response.+timeout :: Int+#ifdef SLOW_LINK+-- A serial line needs a great deal longer than a pipe does.+timeout = 30000 -- milliseconds+#else+timeout = 250+#endif++-- | Retries before giving up.+retries :: Int+retries = 3
+ corpora/vendored/other/cpp/comments-in-branches.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE CPP #-}++module Terminal.Timing where++-- | How long to wait for a response.+timeout :: Int+#ifdef SLOW_LINK+-- A serial line needs a great deal longer than a pipe does.+timeout = 30000 -- milliseconds+#else+timeout = 250+#endif++-- | Retries before giving up.+retries :: Int+retries = 3
+ corpora/vendored/other/cpp/conditional-imports-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++module Terminal.Encode (encode) where++import Data.List (intercalate)+#if MIN_VERSION_base(4,20,0)+import Data.Foldable (foldl')+#endif+import Data.Char (ord)++encode :: String -> String+encode = intercalate ";" . map (show . ord)
+ corpora/vendored/other/cpp/conditional-imports.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++module Terminal.Encode (encode) where++import Data.List (intercalate)+#if MIN_VERSION_base(4,20,0)+import Data.Foldable (foldl')+#endif+import Data.Char (ord)++encode :: String -> String+encode = intercalate ";" . map (show . ord)
+ corpora/vendored/other/cpp/define-across-lines-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}++module Terminal.Wrapped where++#define WRAP(a,b) \+ ("<" ++ a \+ ++ b ++ ">")++both :: String+both = WRAP ("x", "y")
+ corpora/vendored/other/cpp/define-across-lines.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE CPP #-}++module Terminal.Wrapped where++#define WRAP(a,b) \+ ("<" ++ a \+ ++ b ++ ">")++both :: String+both = WRAP("x","y")
+ corpora/vendored/other/cpp/define-ended-by-a-blank-line-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++module Terminal.Derived where++class Described a++#define describe(ty) \+instance Described ty where { \+ } \++describe (Int)+describe (Bool)
+ corpora/vendored/other/cpp/define-ended-by-a-blank-line.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++module Terminal.Derived where++class Described a++#define describe(ty) \+instance Described ty where { \+ } \++describe(Int)+describe(Bool)
+ corpora/vendored/other/cpp/define-in-a-quasiquote.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}++module Terminal.Template where++import Terminal.Quoter (template)++banner :: String+banner =+ [template|+#include "banner.txt"+|]
+ corpora/vendored/other/cpp/define-out.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE CPP #-}++module Terminal.Macro where++#define ESCAPE(n) ("\ESC[" ++ show n ++ "m")++plain :: String+plain = ESCAPE (0)
+ corpora/vendored/other/cpp/define.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE CPP #-}++module Terminal.Macro where++#define ESCAPE(n) ("\ESC[" ++ show n ++ "m")++plain :: String+plain = ESCAPE(0)
+ corpora/vendored/other/cpp/directive-above-a-trailing-comment-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++module Terminal.Size where++#ifndef NO_CALLSTACK+import GHC.Stack+#define TRACED(ty) HasCallStack => ty+#endif++newtype Size = Size Int++-- A comment with nothing written under it.
+ corpora/vendored/other/cpp/directive-above-a-trailing-comment.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++module Terminal.Size where++#ifndef NO_CALLSTACK+import GHC.Stack+#define TRACED(ty) HasCallStack => ty+#endif++newtype Size = Size Int++-- A comment with nothing written under it.
+ corpora/vendored/other/cpp/directive-after-a-conditional-out.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif++#include "terminal.h"++module Terminal.Size where++#if MIN_VERSION_base(4, 20, 0)+rows :: Int+rows = 24+#endif++#if MIN_VERSION_base(4, 18, 0)+columns :: Int+columns = 80+#endif
+ corpora/vendored/other/cpp/directive-after-a-conditional.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif++#include "terminal.h"++module Terminal.Size where++#if MIN_VERSION_base(4, 20, 0)+rows :: Int+rows = 24+#endif++#if MIN_VERSION_base(4, 18, 0)+columns :: Int+columns = 80+#endif
+ corpora/vendored/other/cpp/directive-outside-conditionals-out.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE CPP #-}++module Terminal.Size where++#include "terminal.h"++#if defined(HAVE_IOCTL)+rows :: Int+rows = 24+#else+rows :: Int+rows = 0+#endif++#if defined(HAVE_TERMCAP)+columns :: Int+columns = 80+#else+columns :: Int+columns = 0+#endif
+ corpora/vendored/other/cpp/directive-outside-conditionals.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE CPP #-}++module Terminal.Size where++#include "terminal.h"++#if defined(HAVE_IOCTL)+rows :: Int+rows = 24+#else+rows :: Int+rows = 0+#endif++#if defined(HAVE_TERMCAP)+columns :: Int+columns = 80+#else+columns :: Int+columns = 0+#endif
+ corpora/vendored/other/cpp/elif-chain-out.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}++module Terminal.Newline where++newline :: String+#if defined(TARGET_WINDOWS)+newline = "\r\n"+#elif defined(TARGET_CLASSIC_MAC)+newline = "\r"+#else+newline = "\n"+#endif++indent :: Int+indent = 2
+ corpora/vendored/other/cpp/elif-chain.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}++module Terminal.Newline where++newline :: String+#if defined(TARGET_WINDOWS)+newline = "\r\n"+#elif defined(TARGET_CLASSIC_MAC)+newline = "\r"+#else+newline = "\n"+#endif++indent :: Int+indent = 2
+ corpora/vendored/other/cpp/imports-in-both-branches-out.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE CPP #-}++module Terminal.Capability (probe) where++import Data.Maybe (fromMaybe)+import Terminal.Encode (encode)+#ifdef WITH_TERMINFO+import Data.List (isPrefixOf)+import Terminal.Terminfo (lookupCapability)+#else+import Terminal.Static (staticCapability)+#endif++probe :: String -> String+#ifdef WITH_TERMINFO+probe name+ | "x" `isPrefixOf` name = encode name+ | otherwise = fromMaybe "" (lookupCapability name)+#else+probe name = fromMaybe (encode name) (staticCapability name)+#endif
+ corpora/vendored/other/cpp/imports-in-both-branches.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE CPP #-}++module Terminal.Capability (probe) where++import Data.Maybe (fromMaybe)+import Terminal.Encode (encode)+#ifdef WITH_TERMINFO+import Data.List (isPrefixOf)+import Terminal.Terminfo (lookupCapability)+#else+import Terminal.Static (staticCapability)+#endif++probe :: String -> String+#ifdef WITH_TERMINFO+probe name+ | "x" `isPrefixOf` name = encode name+ | otherwise = fromMaybe "" (lookupCapability name)+#else+probe name = fromMaybe (encode name) (staticCapability name)+#endif
+ corpora/vendored/other/cpp/inside-a-binding-group-out.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE CPP #-}++module Terminal.Describe where++describe :: Int -> String+describe n = go n+ where+ go 0 = "none"+#ifdef VERBOSE+ go 1 = "exactly one"+#else+ go 1 = "1"+#endif+ go k = show k
+ corpora/vendored/other/cpp/inside-a-binding-group.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE CPP #-}++module Terminal.Describe where++describe :: Int -> String+describe n = go n+ where+ go 0 = "none"+#ifdef VERBOSE+ go 1 = "exactly one"+#else+ go 1 = "1"+#endif+ go k = show k
+ corpora/vendored/other/cpp/inside-a-signature-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++module Terminal.Trace where++import GHC.Stack (HasCallStack)++traceMessage ::+#ifdef WITH_CALLSTACK+ (HasCallStack) =>+#endif+ String -> [(String, Int)] -> Maybe String -> Either String Int -> IO ()+traceMessage message _pairs _fallback _outcome = putStrLn message
+ corpora/vendored/other/cpp/inside-a-signature.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}++module Terminal.Trace where++import GHC.Stack (HasCallStack)++traceMessage ::+#ifdef WITH_CALLSTACK+ (HasCallStack) =>+#endif+ String -> [(String, Int)] -> Maybe String -> Either String Int -> IO ()+traceMessage message _pairs _fallback _outcome = putStrLn message
+ corpora/vendored/other/cpp/inside-an-expression-out.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE CPP #-}++module Terminal.Width where++base :: Int+base = 80++width :: Int+width =+ base+#ifdef WITH_MARGIN+ + 4+#endif++height :: Int+height = 24
+ corpora/vendored/other/cpp/inside-an-expression.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE CPP #-}++module Terminal.Width where++base :: Int+base = 80++width :: Int+width =+ base+#ifdef WITH_MARGIN+ + 4+#endif++height :: Int+height = 24
+ corpora/vendored/other/cpp/more-configurations-than-formattings-out.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE CPP #-}++module Build.Flags where++#ifdef WITH_MOUSE+mouse :: Bool+mouse = True+#else+mouse :: Bool+mouse = False+#endif++#ifdef WITH_PASTE+paste :: Bool+paste = True+#else+paste :: Bool+paste = False+#endif++#ifdef WITH_COLOUR+colour :: Bool+colour = True+#else+colour :: Bool+colour = False+#endif++#ifdef WITH_TITLE+title :: Bool+title = True+#else+title :: Bool+title = False+#endif++#ifdef WITH_CURSOR+cursor :: Bool+cursor = True+#else+cursor :: Bool+cursor = False+#endif++#ifdef WITH_RESIZE+resize :: Bool+resize = True+#else+resize :: Bool+resize = False+#endif++#ifdef WITH_UNICODE+unicode :: Bool+unicode = True+#else+unicode :: Bool+unicode = False+#endif++everything :: [Bool]+everything = [mouse, paste, colour, title, cursor, resize, unicode]
+ corpora/vendored/other/cpp/more-configurations-than-formattings.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE CPP #-}++module Build.Flags where++#ifdef WITH_MOUSE+mouse :: Bool+mouse = True+#else+mouse :: Bool+mouse = False+#endif++#ifdef WITH_PASTE+paste :: Bool+paste = True+#else+paste :: Bool+paste = False+#endif++#ifdef WITH_COLOUR+colour :: Bool+colour = True+#else+colour :: Bool+colour = False+#endif++#ifdef WITH_TITLE+title :: Bool+title = True+#else+title :: Bool+title = False+#endif++#ifdef WITH_CURSOR+cursor :: Bool+cursor = True+#else+cursor :: Bool+cursor = False+#endif++#ifdef WITH_RESIZE+resize :: Bool+resize = True+#else+resize :: Bool+resize = False+#endif++#ifdef WITH_UNICODE+unicode :: Bool+unicode = True+#else+unicode :: Bool+unicode = False+#endif++everything :: [Bool]+everything = [mouse, paste, colour, title, cursor, resize, unicode]
+ corpora/vendored/other/cpp/nested-out.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE CPP #-}++module Terminal.Cursor where++#ifdef ANSI+home :: String+home = "\ESC[H"++#ifdef ANSI_PRIVATE+hide :: String+hide = "\ESC[?25l"+#endif+#else+home :: String+home = "\r"+#endif++bell :: String+bell = "\a"
+ corpora/vendored/other/cpp/nested.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}++module Terminal.Cursor where++#ifdef ANSI+home :: String+home = "\ESC[H"+# ifdef ANSI_PRIVATE+hide :: String+hide = "\ESC[?25l"+# endif+#else+home :: String+home = "\r"+#endif++bell :: String+bell = "\a"
+ corpora/vendored/other/cpp/no-alternative-out.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE CPP #-}++module Terminal.Legacy where++columns :: Int+columns = 80++#if !MIN_VERSION_base(4,19,0)+rows :: Int+rows = 24+#endif++title :: String+title = "session"
+ corpora/vendored/other/cpp/no-alternative.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE CPP #-}++module Terminal.Legacy where++columns :: Int+columns = 80++#if !MIN_VERSION_base(4,19,0)+rows :: Int+rows = 24+#endif++title :: String+title = "session"
+ corpora/vendored/other/cpp/one-guard-asked-twice-out.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE CPP #-}+#if defined(HAVE_PATTERNS)+{-# LANGUAGE PatternSynonyms #-}+#endif++module Terminal.Key+ ( Key (..),+ keyCode,+#if defined(HAVE_PATTERNS)+#ifndef NO_NAMES+ keyName,+ keyLabel,+ pattern Escape,+ pattern Enter,+ keyGlyph,+#endif+#else+#ifndef NO_NAMES+ keyName,+ keyLabel,+ keyGlyph,+#endif+#endif+ )+where++data Key = Key Int++keyCode :: Key -> Int+keyCode (Key c) = c++#ifndef NO_NAMES+keyName :: Key -> String+keyName (Key c) = "key" <> show c++keyLabel :: Key -> String+keyLabel k = "<" <> keyName k <> ">"++keyGlyph :: Key -> Char+keyGlyph (Key c) = toEnum c+#endif++#if defined(HAVE_PATTERNS)+pattern Escape :: Key+pattern Escape = Key 27++pattern Enter :: Key+pattern Enter = Key 13+#endif
+ corpora/vendored/other/cpp/one-guard-asked-twice.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE CPP #-}+#if defined(HAVE_PATTERNS)+{-# LANGUAGE PatternSynonyms #-}+#endif++module Terminal.Key+ ( Key (..),+ keyCode,+#ifndef NO_NAMES+ keyName,+ keyLabel,+#if defined(HAVE_PATTERNS)+ pattern Escape,+ pattern Enter,+#endif+ keyGlyph,+#endif+ )+where++data Key = Key Int++keyCode :: Key -> Int+keyCode (Key c) = c++#ifndef NO_NAMES+keyName :: Key -> String+keyName (Key c) = "key" <> show c++keyLabel :: Key -> String+keyLabel k = "<" <> keyName k <> ">"++keyGlyph :: Key -> Char+keyGlyph (Key c) = toEnum c+#endif++#if defined(HAVE_PATTERNS)+pattern Escape :: Key+pattern Escape = Key 27++pattern Enter :: Key+pattern Enter = Key 13+#endif
+ corpora/vendored/other/cpp/same-guard-twice-out.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}++module Terminal.Run (runFrame) where++import Control.Monad.ST (ST, runST)+import Terminal.Buffer (Buffer, freeze, shrink)+#if defined(ASSERTS)+import GHC.Stack (HasCallStack)+#endif++runFrame ::+#if defined(ASSERTS)+ (HasCallStack) =>+#endif+ (forall s. (Buffer s -> Int -> ST s Buffer) -> ST s Buffer) -> Buffer+runFrame act = runST (act (\buffer used -> shrink buffer used >> freeze buffer))
+ corpora/vendored/other/cpp/same-guard-twice.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}++module Terminal.Run (runFrame) where++import Control.Monad.ST (ST, runST)+import Terminal.Buffer (Buffer, freeze, shrink)++#if defined(ASSERTS)+import GHC.Stack (HasCallStack)+#endif++runFrame ::+#if defined(ASSERTS)+ (HasCallStack) =>+#endif+ (forall s. (Buffer s -> Int -> ST s Buffer) -> ST s Buffer) -> Buffer+runFrame act = runST (act (\buffer used -> shrink buffer used >> freeze buffer))
+ corpora/vendored/other/cpp/side-by-side-out.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}++module Terminal.Feature where++#ifdef WITH_MOUSE+mouse :: Bool+mouse = True+#else+mouse :: Bool+mouse = False+#endif++always :: Bool+always = True++#ifdef WITH_BRACKETED_PASTE+paste :: Bool+paste = True+#endif++version :: Int+version = 3
+ corpora/vendored/other/cpp/side-by-side.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}++module Terminal.Feature where++#ifdef WITH_MOUSE+mouse :: Bool+mouse = True+#else+mouse :: Bool+mouse = False+#endif++always :: Bool+always = True++#ifdef WITH_BRACKETED_PASTE+paste :: Bool+paste = True+#endif++version :: Int+version = 3
+ corpora/vendored/other/cpp/spaced-hash-out.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE CPP #-}++module Terminal.Signal where++interrupt :: Int+interrupt = 2++#if defined(HAS_SIGWINCH)+resize :: Int+resize = 28+#else+resize :: Int+resize = 0+#endif
+ corpora/vendored/other/cpp/spaced-hash.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE CPP #-}++module Terminal.Signal where++interrupt :: Int+interrupt = 2++# if defined(HAS_SIGWINCH)+resize :: Int+resize = 28+# else+resize :: Int+resize = 0+# endif
+ corpora/vendored/other/cpp/unbalanced.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE CPP #-}++module Terminal.Truncated where++#ifdef SOMETHING+value :: Int+value = 1
+ corpora/vendored/other/cpp/whole-declarations-out.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}++module Terminal.Palette where++reset :: String+reset = "\ESC[0m"++#ifdef TRUECOLOUR+paint :: Int -> Int -> Int -> String+paint r g b = "\ESC[38;2;" ++ show r ++ ";" ++ show g ++ ";" ++ show b ++ "m"+#else+paint :: Int -> Int -> Int -> String+paint _ _ _ = ""+#endif++clear :: String+clear = "\ESC[2J"
+ corpora/vendored/other/cpp/whole-declarations.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}++module Terminal.Palette where++reset :: String+reset = "\ESC[0m"++#ifdef TRUECOLOUR+paint :: Int -> Int -> Int -> String+paint r g b = "\ESC[38;2;" ++ show r ++ ";" ++ show g ++ ";" ++ show b ++ "m"+#else+paint :: Int -> Int -> Int -> String+paint _ _ _ = ""+#endif++clear :: String+clear = "\ESC[2J"
+ corpora/vendored/other/deriving-blocks-the-author-grouped-out.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE StandaloneDeriving #-}++module Ledger.Posting where++newtype Tallied a = Tallied a++deriving via Tallied Receipt instance Eq Receipt+deriving via Tallied Receipt instance Ord Receipt+deriving via Tallied Receipt instance Show Receipt++deriving via Tallied Invoice instance Eq Invoice+deriving via Tallied Invoice instance Ord Invoice+-- A note written against the block it stands in, and staying inside it.+deriving via Tallied Invoice instance Show Invoice++deriving via Tallied Memo instance Eq Memo
+ corpora/vendored/other/deriving-blocks-the-author-grouped.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE StandaloneDeriving #-}++module Ledger.Posting where++newtype Tallied a = Tallied a++deriving via Tallied Receipt instance Eq Receipt+deriving via Tallied Receipt instance Ord Receipt+deriving via Tallied Receipt instance Show Receipt++deriving via Tallied Invoice instance Eq Invoice+deriving via Tallied Invoice instance Ord Invoice+-- A note written against the block it stands in, and staying inside it.+deriving via Tallied Invoice instance Show Invoice++deriving via Tallied Memo instance Eq Memo
+ corpora/vendored/other/haddock-held-off-a-comment-out.hs view
@@ -0,0 +1,7 @@+module Cache.Evict where++-- | Drop the entries nothing has asked for lately.++-- TODO: the threshold wants to come from the configuration+evict :: IO ()+evict = pure ()
+ corpora/vendored/other/haddock-held-off-a-comment.hs view
@@ -0,0 +1,7 @@+module Cache.Evict where++-- | Drop the entries nothing has asked for lately.++-- TODO: the threshold wants to come from the configuration+evict :: IO ()+evict = pure ()
+ corpora/vendored/other/haddock-with-a-tight-trigger-out.hs view
@@ -0,0 +1,5 @@+module Terminal.Size where++-- | Rows and columns, as the terminal reported them when we+-- started up.+data Size = Size Int Int
+ corpora/vendored/other/haddock-with-a-tight-trigger.hs view
@@ -0,0 +1,5 @@+module Terminal.Size where++-- |Rows and columns, as the terminal reported them when we+-- started up.+data Size = Size Int Int
+ corpora/vendored/other/named-chunk-under-a-haddock-out.hs view
@@ -0,0 +1,10 @@+module Cache.Doctest where++-- | The examples below are run by doctest.++-- $setup+-- >>> import Cache.Warm++-- | Warm the cache and say how long it took.+timed :: IO ()+timed = pure ()
+ corpora/vendored/other/named-chunk-under-a-haddock.hs view
@@ -0,0 +1,10 @@+module Cache.Doctest where++-- | The examples below are run by doctest.++-- $setup+-- >>> import Cache.Warm++-- | Warm the cache and say how long it took.+timed :: IO ()+timed = pure ()
+ corpora/vendored/other/position-pragma-only-mentioned-out.hs view
@@ -0,0 +1,12 @@+-- | Talking about @{-# LINE #-}@ is not carrying one.+module Woven.Notes where++{- A block comment may name {-# COLUMN #-} too, nested {- and all -}. -}++-- | The text a generator would emit.+marker :: String+marker = "{-# LINE 40 \"Template.hs\" #-}"++-- Nor is --> a comment opener, so a pragma after it still counts.+described :: Int+described = 1
+ corpora/vendored/other/position-pragma-only-mentioned.hs view
@@ -0,0 +1,12 @@+-- | Talking about @{-# LINE #-}@ is not carrying one.+module Woven.Notes where++{- A block comment may name {-# COLUMN #-} too, nested {- and all -}. -}++-- | The text a generator would emit.+marker :: String+marker = "{-# LINE 40 \"Template.hs\" #-}"++-- Nor is --> a comment opener, so a pragma after it still counts.+described :: Int+described = 1
+ corpora/vendored/other/position-pragmas.hs view
@@ -0,0 +1,15 @@+-- | Generated code, which says where each part of it came from.+module Woven where++ownLine :: Int -> Int+ownLine n = n + 1++{-# LINE 40 "Template.hs" #-}++fromTheTemplate :: Int -> Int+fromTheTemplate n = n++{-# LINE 12 "Woven.hs" #-}++andBackAgain :: Int -> Int+andBackAgain n = n - 1
+ corpora/vendored/other/section-anchor-with-a-blank-line-out.hs view
@@ -0,0 +1,17 @@+module Terminal.Size+ ( -- * Getting started+ -- $intro+ --++ -- * Measuring+ -- $measuring+ rows,+ columns,+ )+where++rows :: Int+rows = 24++columns :: Int+columns = 80
+ corpora/vendored/other/section-anchor-with-a-blank-line.hs view
@@ -0,0 +1,17 @@+module Terminal.Size+ ( -- * Getting started+ -- $intro+ --++ -- * Measuring+ -- $measuring+ rows,+ columns,+ )+where++rows :: Int+rows = 24++columns :: Int+columns = 80
+ corpora/vendored/other/section-heading-under-a-haddock-out.hs view
@@ -0,0 +1,9 @@+module Cache.Report where++-- | Everything under here is about reporting, not about the cache itself.++-- * Counters++-- | How many lookups found something.+hits :: Int+hits = 0
+ corpora/vendored/other/section-heading-under-a-haddock.hs view
@@ -0,0 +1,9 @@+module Cache.Report where++-- | Everything under here is about reporting, not about the cache itself.++-- * Counters++-- | How many lookups found something.+hits :: Int+hits = 0
+ corpora/vendored/other/trailing-comment-over-a-moved-haddock-out.hs view
@@ -0,0 +1,9 @@+module Cache.Stats where++data Stats = Stats+ { hits :: Int,+ -- Misc++ -- | lookups that found nothing+ misses :: Int+ }
+ corpora/vendored/other/trailing-comment-over-a-moved-haddock.hs view
@@ -0,0 +1,8 @@+module Cache.Stats where++data Stats = Stats+ { hits :: Int+ , -- Misc+ misses :: Int+ -- ^ lookups that found nothing+ }
+ corpora/vendored/other/trailing-comment-with-a-gap-under-it-out.hs view
@@ -0,0 +1,9 @@+module Cache.Probe where++probe :: [Int]+probe =+ [ -- the first of these is the one that regressed++ 1,+ 2+ ]
+ corpora/vendored/other/trailing-comment-with-a-gap-under-it.hs view
@@ -0,0 +1,9 @@+module Cache.Probe where++probe :: [Int]+probe =+ [ -- the first of these is the one that regressed++ 1+ , 2+ ]
+ src/Tilia/Comments.hs view
@@ -0,0 +1,387 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Extracting comments from a parsed module.+module Tilia.Comments+ ( Comment (..),+ CommentStyle (..),+ Above (..),+ commentsOf,+ renderComment,+ closesItself,+ bracketed,+ commentTrailing,+ singleLine,+ widenTrigger,+ escapeTrigger,+ triggerEscaped,+ opensHaddock,+ commentsWithin,++ -- * Pragmas+ Pragma (..),+ commentPragma,+ )+where++import Data.Char (isSpace)+import Data.Generics.Schemes (listify)+import Data.List (sortOn)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE+import Data.Maybe (isJust, mapMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Hs (HsModule)+import GHC.Hs.Extension (GhcPs)+import GHC.Parser.Annotation qualified as GHC+import GHC.Types.SrcLoc qualified as GHC+import Tilia.Source.Lines (Lines, blankAt, lineAt, lineTexts)+import Tilia.Span (Span, endPoint, startPoint)+import Tilia.Span.Ghc (spanOfReal)++-- | One comment.+data Comment = Comment+ { -- | Where it was in the input.+ commentSpan :: Span,+ -- | Its lines, dedented, without trailing whitespace. A line comment+ -- has one; a block comment has one per line it spanned.+ commentBody :: NonEmpty Text,+ -- | How it was written.+ commentStyle :: CommentStyle,+ -- | What was on the line above it.+ --+ -- What a comment lines up with is how its author said what it is about,+ -- and the line above is the only thing it can line up with.+ commentAbove :: Above,+ -- | Where the code before it on its opening line stops: the column one+ -- past the last character of that code, or 'Nothing' when the comment+ -- had the line to itself.+ commentCodeBeforeStopsAt :: Maybe Int,+ -- | Whether anything other than whitespace follows it on its closing+ -- line.+ commentFollowed :: Bool,+ -- | Whether to leave an empty line above it when it is printed.+ commentGapAbove :: Bool,+ -- | Whether to leave an empty line below it when it is printed.+ commentGapBelow :: Bool+ }+ deriving (Eq, Show)++-- | How a comment was written. The distinction is kept because it+-- constrains what may be done with the comment.+data CommentStyle+ = -- | @-- …@+ LineComment+ | -- | @{- … -}@+ BlockComment+ | -- | @-- |@, @-- ^@, @-- *@, @-- $@ and the block forms+ DocComment+ deriving (Eq, Show)++-- | What was on the line above a comment.+data Above+ = -- | Nothing was: the comment begins on the first line of the file.+ TopOfFile+ | -- | An empty line.+ BlankLine+ | -- | Something, beginning at this column.+ ContentAt !Int+ deriving (Eq, Show)++-- | Every comment in a module, in source order.+commentsOf ::+ -- | The module's lines, which every comment is read against+ Lines ->+ -- | Comments the tree does not carry+ --+ -- Everything above a signature's @signature@ keyword: the parser leaves+ -- those in its own state rather than in an annotation.+ [GHC.LEpaComment] ->+ -- | Parsed module+ HsModule GhcPs ->+ [Comment]+commentsOf ls loose hsModule =+ map (uncurry (mkComment ls))+ . dedupeOnSpan+ . sortOn (GHC.realSrcSpanStart . fst)+ . mapMaybe located+ $ loose <> concatMap annComments (listify anyAnnComments hsModule)+ where+ dedupeOnSpan = \case+ (x : y : rest) | fst x == fst y -> dedupeOnSpan (x : rest)+ (x : rest) -> x : dedupeOnSpan rest+ [] -> []+ anyAnnComments :: GHC.EpAnnComments -> Bool+ anyAnnComments _ = True+ annComments = \case+ GHC.EpaComments xs -> xs+ GHC.EpaCommentsBalanced xs ys -> xs <> ys+ located (GHC.L anchor (GHC.EpaComment tok _)) = case anchor of+ GHC.EpaSpan (GHC.RealSrcSpan s _) -> Just (s, tok)+ _ -> Nothing++-- | Build a comment from a token and the span it occupied.+mkComment :: Lines -> GHC.RealSrcSpan -> GHC.EpaCommentTok -> Comment+mkComment ls spn tok =+ Comment+ { commentSpan = spanOfReal spn,+ commentBody = normalizeBody startColumn style raw,+ commentStyle = style,+ commentAbove = above,+ commentCodeBeforeStopsAt = codeBeforeStopsAt,+ commentFollowed = followed,+ commentGapAbove = above == BlankLine,+ commentGapBelow = blankAt (GHC.srcSpanEndLine spn + 1) ls+ }+ where+ (style, raw) = case tok of+ GHC.EpaLineComment s -> (LineComment, T.pack s)+ GHC.EpaBlockComment s -> (BlockComment, T.pack s)+ GHC.EpaDocComment _ -> (DocComment, sliceSpan (lineTexts ls) spn)+ GHC.EpaDocOptions s -> (LineComment, T.pack s)++ -- The lines the answers are read off, and where on the opening one the+ -- comment starts. Indentation is how many characters precede, which is+ -- not the column: see 'offsetOf'.+ startColumn = maybe 0 (`offsetOf` GHC.srcSpanStartCol spn) openingLine+ openingLine = lineAt (GHC.srcSpanStartLine spn) ls+ lineAbove+ | GHC.srcSpanStartLine spn <= 1 = Nothing+ | otherwise = lineAt (GHC.srcSpanStartLine spn - 1) ls++ -- The rest in the order the fields are declared in.+ above = case lineAbove of+ Nothing -> TopOfFile+ Just l+ | T.all isSpace l -> BlankLine+ | otherwise -> ContentAt (columnOf l (T.length (T.takeWhile isSpace l)))+ codeBeforeStopsAt = do+ l <- openingLine+ let before' = T.stripEnd (T.take startColumn l)+ if T.null before' then Nothing else Just (columnOf l (T.length before'))+ followed = case lineAt (GHC.srcSpanEndLine spn) ls of+ Just l -> not (T.all isSpace (T.drop (offsetOf l (GHC.srcSpanEndCol spn)) l))+ Nothing -> False++-- | Apply the normalizations, in the only order that works: dedent before+-- stripping, since a line of nothing but spaces has to still count as+-- indented when the common indentation is measured.+normalizeBody :: Int -> CommentStyle -> Text -> NonEmpty Text+normalizeBody startColumn style raw =+ case NE.nonEmpty (T.lines raw) of+ Nothing -> spaceAfterDashes style raw :| []+ Just (first' :| rest) ->+ fmap T.stripEnd (spaceAfterDashes style first' :| map dedent rest)+ where+ dedent l = T.drop (min startColumn (T.length (T.takeWhile isSpace l))) l++-- | @--foo@ becomes @-- foo@; @----@ and @-- foo@ are left alone.+--+-- Only the opening line of a line comment is eligible. Inside a block+-- comment a @--@ is just two characters the author wrote.+spaceAfterDashes :: CommentStyle -> Text -> Text+spaceAfterDashes BlockComment t = t+spaceAfterDashes _ t = case T.stripPrefix "--" t of+ Nothing -> t+ Just rest -> case T.uncons rest of+ Nothing -> t+ Just (c, _)+ | c == ' ' || c == '-' -> t+ | otherwise -> "-- " <> rest++-- | The text a span covers.+sliceSpan :: [Text] -> GHC.RealSrcSpan -> Text+sliceSpan sourceLines spn =+ T.intercalate "\n" (zipWith clip [startLine ..] covered)+ where+ covered =+ take (endLine - startLine + 1) (drop (startLine - 1) sourceLines)+ clip n l =+ (if n == startLine then T.drop (offsetOf l startCol) else id)+ . (if n == endLine then T.take (offsetOf l endCol) else id)+ $ l++ startLine = GHC.srcSpanStartLine spn+ endLine = GHC.srcSpanEndLine spn+ startCol = GHC.srcSpanStartCol spn+ endCol = GHC.srcSpanEndCol spn++-- | Put a comment back together as it will appear in the output.+renderComment :: Comment -> Text+renderComment = T.intercalate "\n" . NE.toList . commentBody++-- | Does this comment let code follow it on the same line?+closesItself :: Comment -> Bool+closesItself c = commentStyle c == BlockComment && singleLine c++-- | Was this comment written between brackets rather than as @--@ lines?+bracketed :: Comment -> Bool+bracketed c = "{-" `T.isPrefixOf` T.stripStart (NE.head (commentBody c))++-- | Was the comment written after code on its line?+commentTrailing :: Comment -> Bool+commentTrailing = isJust . commentCodeBeforeStopsAt++-- | Is this comment a single line?+singleLine :: Comment -> Bool+singleLine c = case commentBody c of+ (_ :| []) -> True+ _ -> False++-- | Put a space between a doc comment's trigger and the text after it, so+-- that @-- |Foo@ comes out as @-- | Foo@.+--+-- Only doc comments have triggers; on anything else this is a no-op.+widenTrigger :: Comment -> Comment+widenTrigger c+ | DocComment <- commentStyle c,+ (headLine :| rest) <- commentBody c,+ Just (upToTrigger, body) <- splitTrigger headLine,+ not (T.null body),+ not (" " `T.isPrefixOf` body) =+ c {commentBody = (upToTrigger <> " " <> body) :| map shiftOne rest}+ | otherwise = c+ where+ shiftOne l = case openerWidth l of+ Just _ -> l+ Nothing -> " " <> l++-- | Put a backslash in front of a doc comment's trigger.+--+-- For a doc comment the compiler did not manage to attach to anything: it+-- is going to come back out as an ordinary comment, and written as it+-- stands it would be lexed as a doc comment again on the next pass, so the+-- formatter would not have a fixed point. The backslash is what Haddock+-- reads as \"this is not a trigger\".+escapeTrigger :: Comment -> Comment+escapeTrigger c = case commentStyle c of+ DocComment ->+ c+ { commentBody = fmap escape (commentBody c),+ commentStyle = ordinaryStyle+ }+ _ -> c+ where+ ordinaryStyle+ | "{-" `T.isPrefixOf` NE.head (commentBody c) = BlockComment+ | otherwise = LineComment++ escape l = case openerWidth l of+ Just n+ | (gap, rest) <- T.span (== ' ') (T.drop n l),+ triggered rest ->+ T.take n l <> (if T.null gap then " " else gap) <> "\\" <> rest+ _ -> l++-- | Has this comment been through 'escapeTrigger'?+--+-- What it was written as cannot be read off the comment any more—that is+-- the point of escaping—so anything wanting to know whether a comment+-- started life as a Haddock has to ask this.+triggerEscaped :: Comment -> Bool+triggerEscaped c = case openerWidth headLine of+ Nothing -> False+ Just n -> case T.uncons (T.dropWhile (== ' ') (T.drop n headLine)) of+ Just ('\\', rest) -> triggered rest+ _ -> False+ where+ headLine = NE.head (commentBody c)++-- | Does this text begin with one of the characters that opens a Haddock?+triggered :: Text -> Bool+triggered t = case T.uncons t of+ Just (ch, _) -> ch `elem` ("|^*$" :: String)+ Nothing -> False++-- | Does this line open a Haddock?+opensHaddock :: Text -> Bool+opensHaddock = isJust . splitTrigger++-- | Split a doc comment's opening line into everything up to and including+-- its trigger, and whatever follows.+splitTrigger :: Text -> Maybe (Text, Text)+splitTrigger l = do+ n <- openerWidth l+ let (opener, afterOpener) = T.splitAt n l+ (gap, rest) = T.span (== ' ') afterOpener+ (trigger, body) <- case T.uncons rest of+ Just ('|', b) -> Just ("|", b)+ Just ('^', b) -> Just ("^", b)+ Just ('*', _) -> Just (T.span (== '*') rest)+ _ -> Nothing+ pure (opener <> gap <> trigger, body)++-- | How many characters open a comment, if it opens one.+openerWidth :: Text -> Maybe Int+openerWidth l+ | "--" `T.isPrefixOf` l = Just 2+ | "{-" `T.isPrefixOf` l = Just 2+ | otherwise = Nothing++-- | The comments written inside a region.+commentsWithin :: Span -> [Comment] -> [Comment]+commentsWithin s = filter (within . commentSpan)+ where+ within c = startPoint s <= startPoint c && endPoint c <= endPoint s++----------------------------------------------------------------------------+-- Pragmas++-- | A compiler pragma, which is written as a block comment but is not one.+--+-- GHC reads pragmas only from the file header, so where a pragma sits+-- decides whether it does anything at all. That is why recognising one is+-- not enough on its own: see 'Tilia.Parser.pmHeaderEnd' for the boundary+-- that says which pragmas are real.+data Pragma = Pragma+ { -- | 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+ }+ 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)+ if T.null name+ then Nothing+ else+ Just+ Pragma+ { pragmaName = T.toUpper name,+ pragmaBody = T.strip body+ }+ where+ oneLine = T.unwords (map T.strip (NE.toList (commentBody c)))++----------------------------------------------------------------------------+-- Columns and offsets++-- | 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
+ src/Tilia/Comments/Attach.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE LambdaCase #-}++-- | Putting comments into the document.+--+-- Attachment happens once, on the finished document, before anything is+-- rendered. A comment becomes an ordinary part of the document like any+-- other, and from then on nothing distinguishes it.+module Tilia.Comments.Attach+ ( attachComments,+ )+where++import Data.Bifunctor (first, second)+import Data.List (mapAccumL, unsnoc)+import Data.List.NonEmpty qualified as NE+import Data.Maybe (listToMaybe)+import Data.Text (Text)+import Tilia.Comments+import Tilia.Comments.Place+import Tilia.Doc.Combinators+import Tilia.Doc.Internal (Doc (..))+import Tilia.Span++-- | Put every comment into the document.+attachComments :: [Comment] -> Doc -> Doc+attachComments cs doc = written <> afterEverything (unplaced left)+ where+ (written, left) = walk (placeComments regions fences cs) doc+ (regions, fences) = markedSpans doc++-- | The comments nothing came to collect, written after everything.+afterEverything :: [Comment] -> Doc+afterEverything = \case+ [] -> mempty+ (opening : rest) -> atEnd True opening <> foldMap (atEnd False) rest++-- | The spans of every 'DLocated' in the document, and of every 'DFence',+-- in that order.+markedSpans :: Doc -> ([Span], [Span])+markedSpans = \case+ DLocated s d -> first (s :) (markedSpans d)+ DFence s d -> second (s :) (markedSpans d)+ DCat a b -> markedSpans a <> markedSpans b+ DNest _ d -> markedSpans d+ DAlign d -> markedSpans d+ DGroup _ d -> markedSpans d+ DVariant a _ -> markedSpans a+ DCppChoice bs e -> foldMap (markedSpans . snd) bs <> markedSpans e+ _ -> ([], [])++-- | Walk the document, giving each region what it was given.+walk :: Placements -> Doc -> (Doc, Placements)+walk = go+ where+ go p = \case+ DCat a b ->+ let (a', p') = go p a+ (b', p'') = go p' b+ in (DCat a' b', p'')+ DLocated s d ->+ let (mine, p') = takePlaced s p+ (d', p'') = go p' d+ write position cs =+ foldMap (writtenAs (endOfAConstruct s) position) cs+ before' = heldOffFrom d [c | (q, c) <- mine, q == Before]+ after' = [c | (q, c) <- mine, q == After]+ in (write Before before' <> DLocated s d' <> write After after', p'')+ DFence s d -> first (DFence s) (go p d)+ DCppChoice bs e ->+ let branch q (c, d) = let (d', q') = go q d in (q', (c, d'))+ (p', bs') = mapAccumL branch p bs+ (e', p'') = go p' e+ in (DCppChoice bs' e', p'')+ DNest n d -> first (DNest n) (go p d)+ DAlign d -> first DAlign (go p d)+ DGroup l d -> first (DGroup l) (go p d)+ DVariant a b ->+ let (a', p') = go p a+ (b', _) = go p b+ in (DVariant a' b', p')+ d -> (d, p)++-- | Hold the last comment off a Haddock about to be written under it.+--+-- Only a comment written as @--@ lines needs holding off: the lexer would+-- read it and the Haddock under it as one comment. A @{- … -}@ ends at its+-- own bracket and may sit against whatever follows.+heldOffFrom :: Doc -> [Comment] -> [Comment]+heldOffFrom d cs = case unsnoc cs of+ Just (earlier, c)+ | not (bracketed c),+ opensWithHaddock d ->+ earlier <> [c {commentGapBelow = True}]+ _ -> cs++-- | Does this region begin its first line with a Haddock?+opensWithHaddock :: Doc -> Bool+opensWithHaddock = maybe False opensHaddock . listToMaybe . fst . firstLine Broken+ where+ firstLine layout = \case+ DText t -> ([t], False)+ DCat a b -> case firstLine layout a of+ (before, True) -> (before, True)+ (before, False) -> first (before <>) (firstLine layout b)+ DNest _ x -> firstLine layout x+ DAlign x -> firstLine layout x+ DLocated _ x -> firstLine layout x+ DFence _ x -> firstLine layout x+ DGroup l x -> firstLine l x+ DVariant a b -> firstLine layout (case layout of Flat -> a; Broken -> b)+ DHardBreak -> ([], True)+ DCloseLine -> ([], True)+ DBreak -> ([], layout == Broken)+ DSoftBreak -> ([], layout == Broken)+ _ -> ([], False)++-- | Does this region stand for where a construct stops rather than for+-- anything written?+endOfAConstruct :: Span -> Bool+endOfAConstruct s = startPoint s == endPoint s++----------------------------------------------------------------------------+-- What a comment looks like++-- | One comment, written where it was placed.+writtenAs ::+ -- | Does what follows only mark where the construct ends?+ Bool ->+ Position ->+ Comment ->+ Doc+writtenAs atTheEnd position c = commentDoc c $ case shapeOf position c of+ InPlace -> case position of+ Before -> includeWhen (not (commentTrailing c)) space <> body <> space+ After -> space <> body <> space+ EndsTheLine -> space <> body <> closeLine <> gapBelow+ HeldBack -> holdBack (renderComment c)+ OnItsOwnLines -> gapAbove <> closeLine <> body <> closeLine <> gapBelow+ where+ body = commentText c+ gapAbove = includeWhen (commentGapAbove c) (closeLine <> blankLine)+ gapBelow = includeWhen (commentGapBelow c && not atTheEnd) blankLine++-- | Turn a 'Comment' that trails the document into a 'Doc'.+atEnd ::+ -- | Is this the first of them, and so the one held off the code above?+ Bool ->+ Comment ->+ Doc+atEnd opensTheRun c =+ commentDoc c $+ closeLine+ <> includeWhen (opensTheRun || commentGapAbove c) blankLine+ <> commentText c+ <> closeLine++-- | A comment, and the spacing that goes with it, as one region.+--+-- One region and not several, because the empty line a comment is held off+-- by belongs to the comment and not to whatever it happens to sit next to.+-- Anything that takes a document apart and puts it back together—the merge+-- in "Tilia.Cpp" above all—works on what a region holds, and would+-- otherwise be free to keep the spacing and move the comment, which is how+-- a blank line comes to be left behind in a place that cannot produce it+-- again.+commentDoc :: Comment -> Doc -> Doc+commentDoc = located . commentSpan++-- | The text of a comment, laid out as it was written.+commentText :: Comment -> Doc+commentText c =+ align $ sepBy (verbatimBreak AtIndent) (map txt (NE.toList (commentBody c)))++----------------------------------------------------------------------------+-- The two document atoms that exist for comments++-- | Text put at the end of the line this position falls on.+--+-- The argument must not contain a line break.+holdBack :: Text -> Doc+holdBack = DHoldBack++-- | Close the line, absorbing a break that immediately follows.+closeLine :: Doc+closeLine = DCloseLine
+ src/Tilia/Comments/Place.hs view
@@ -0,0 +1,191 @@+-- | Deciding where each comment goes.+module Tilia.Comments.Place+ ( -- * Where a comment goes+ Position (..),+ Shape (..),+ shapeOf,++ -- * The answers+ Placements,+ placeComments,+ takePlaced,+ unplaced,+ )+where++import Data.IntMap.Strict qualified as IntMap+import Data.IntSet qualified as IntSet+import Data.List (sortOn)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Ord (Down (..))+import Data.Set qualified as Set+import Tilia.Comments+ ( Above (..),+ Comment (..),+ closesItself,+ commentTrailing,+ singleLine,+ )+import Tilia.Span++-- | Which side of its region a comment is emitted on.+data Position+ = -- | Before the region.+ Before+ | -- | After the region.+ After+ deriving (Eq, Show)++-- | How a comment is printed in relation to the region carrying it.+data Shape+ = -- | Spliced where the region prints, with code able to follow it on the+ -- same line.+ InPlace+ | -- | Printed where the region is, and the line closed after it.+ EndsTheLine+ | -- | Held back to the end of whatever line of output it lands on,+ -- however much of that line is still to be written.+ HeldBack+ | -- | On lines of its own, keeping the empty lines the author left around+ -- it.+ OnItsOwnLines+ deriving (Eq, Show)++-- | What a comment given to a region at this position will look like.+shapeOf :: Position -> Comment -> Shape+shapeOf position c = case position of+ Before+ | closesItself c && commentFollowed c -> InPlace+ | commentTrailing c -> EndsTheLine+ | otherwise -> OnItsOwnLines+ After+ | closesItself c -> InPlace+ | singleLine c -> HeldBack+ | otherwise -> EndsTheLine++-- | What each region was given, and what nothing could be found for.+data Placements = Placements+ { placedAt :: Map Span [(Position, Comment)],+ placedNowhere :: [Comment]+ }++-- | Give every comment to a region.+placeComments ::+ -- | The regions a comment may be given to+ [Span] ->+ -- | The boundaries a comment printed in place may not be carried across+ [Span] ->+ [Comment] ->+ Placements+placeComments regions fences comments =+ Placements+ { placedAt = Map.fromListWith (flip (<>)) [(r, [(p, c)]) | (Just (r, p), c) <- decided],+ placedNowhere = [c | (Nothing, c) <- decided]+ }+ where+ decided = [(against c, c) | c <- comments]++ linesEndingInAComment =+ IntSet.fromList+ [ spanEndLine (commentSpan c)+ | c <- comments,+ commentTrailing c,+ not (commentFollowed c)+ ]++ ownLineComments =+ IntMap.fromList+ [ (spanStartLine s, (spanStartColumn s, commentAbove c))+ | c <- comments,+ not (commentTrailing c),+ not (commentFollowed c),+ let s = commentSpan c+ ]++ carriedOnFrom column = go+ where+ go line+ | IntSet.member line linesEndingInAComment = Just line+ | Just (col, above) <- IntMap.lookup line ownLineComments,+ col == column,+ above == ContentAt column =+ go (line - 1)+ | otherwise = Nothing++ regionsByEndLine =+ IntMap.fromListWith (<>) [(spanEndLine r, [r]) | r <- regions]++ regionEndPoints = Set.fromList (map endPoint regions)++ regionsByStartPoint =+ Map.fromListWith wider [(startPoint r, r) | r <- regions]+ where+ wider a b = if endPoint a >= endPoint b then a else b++ against c+ | commentTrailing c, Just r <- trailed = Just (r, After)+ | not (commentTrailing c), Just r <- continues = Just (r, After)+ | Just r <- next = Just (r, Before)+ | otherwise = Nothing+ where+ here = commentSpan c+ trailed+ | writtenAgainst || not (commentFollowed c) = endingOn (spanStartLine here)+ | otherwise = Nothing+ endingOn line =+ nearest (\r -> (Down (endPoint r), startPoint r)) (filter candidate onThatLine)+ where+ onThatLine = IntMap.findWithDefault [] line regionsByEndLine+ candidate r = endPoint r <= startPoint here && not (fencedOff r)++ writtenAgainst = maybe False (`Set.member` regionEndPoints) stopsAt+ stopsAt = (,) (spanStartLine here) <$> commentCodeBeforeStopsAt c++ enclosingRegions = filter (here `inside`) regions+ enclosingFences = filter (here `inside`) fences++ fencedOff r = outside enclosingRegions || (printedInPlace && outside enclosingFences)+ where+ outside = any (not . (r `inside`))++ printedInPlace = shapeOf After c == InPlace++ next = snd <$> Map.lookupGE (endPoint here) regionsByStartPoint++ continues+ | ContentAt column <- commentAbove c,+ column == spanStartColumn here,+ nothingBelowItLinesUp,+ Just anchor <- carriedOnFrom column (spanStartLine here - 1) =+ endingOn anchor+ | otherwise = Nothing++ nothingBelowItLinesUp =+ all (\r -> spanStartColumn r < spanStartColumn here) next++ -- Folded rather than sorted: this runs for every comment against every+ -- region, and only the first of the order is ever wanted.+ nearest :: (Ord k) => (Span -> k) -> [Span] -> Maybe Span+ nearest key = fmap fst . foldl' closer Nothing+ where+ closer best s = case best of+ Just (_, k) | k <= key s -> best+ _ -> Just (s, key s)++-- | Does the first region fall within the second?+inside :: Span -> Span -> Bool+inside a b = startPoint b <= startPoint a && endPoint a <= endPoint b++-- | Take what a region was given, so that nothing can take it again.+takePlaced :: Span -> Placements -> ([(Position, Comment)], Placements)+takePlaced s p = case Map.updateLookupWithKey forget s (placedAt p) of+ (found, rest) -> (concat found, p {placedAt = rest})+ where+ forget _ _ = Nothing++-- | The comments no region ever came to collect.+unplaced :: Placements -> [Comment]+unplaced p =+ sortOn (startPoint . commentSpan) $+ placedNowhere p <> [c | (_, c) <- concat (Map.elems (placedAt p))]
+ src/Tilia/Cpp.hs view
@@ -0,0 +1,1677 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Formatting a module with the C preprocessor involved.+module Tilia.Cpp+ ( -- * Formatting+ formatWithCpp,+ usesCpp,+ blankCpp,+ withoutRuledOut,+ CppError (..),+ describeCppError,++ -- * Splitting+ Guard (..),+ Configurations (..),+ configurations,+ leaves,+ branchLeaves,+ linearLeaves,+ countLeaves,+ answeredLeaves,+ answeredLinearLeaves,++ -- * Diagnostics+ regions,+ )+where++import Data.Char (isAsciiLower)+import Data.List (maximumBy, sortOn, transpose, unsnoc)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (isJust, listToMaybe, maybeToList)+import Data.Ord (comparing)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.LanguageExtensions.Type (Extension (..))+import Tilia.Cpp.Macros (Macros, answerTo)+import Tilia.Doc (defaultRenderOptions, printDoc)+import Tilia.Doc.Combinators qualified as Doc+import Tilia.Doc.Internal (Doc (..), Layout (..))+import Tilia.Parser+ ( ParseError,+ ParserConfig,+ describeParseError,+ parseConfiguration,+ )+import Tilia.Render (RenderConfig (..), renderModule)+import Tilia.Source+ ( Lines,+ Written (..),+ blankAt,+ blankBelow,+ closesABranch,+ dropping,+ lineTexts,+ linesOf,+ )+import Tilia.Span (Span, covers, meets, mkSpan, spanEndLine, spanStartLine)++----------------------------------------------------------------------------+-- Formatting++-- | Format a module which uses the C preprocessor.+--+-- Each configuration is formatted by the ordinary printer. The resulting+-- documents are then merged.+formatWithCpp ::+ -- | What to parse each configuration with+ ParserConfig ->+ -- | What to print each configuration with+ RenderConfig ->+ -- | The file this is, for the positions in an error+ FilePath ->+ -- | The module, directives and all+ Text ->+ -- | The formatted module, or why not+ Either CppError Text+formatWithCpp parser render path source =+ printDoc defaultRenderOptions . fst+ <$> formatAllConfigs+ parser+ (knowing render)+ path+ (noAnswers source)+ configurationBudget+ source+ where+ knowing c =+ c {rcImportBarriers = maybe [] (map dLine) (scanDirectives source)}++-- | Format every configuration of a module, and merge them into one+-- document.+formatAllConfigs ::+ -- | What to parse a configuration with+ ParserConfig ->+ -- | What to print it with+ RenderConfig ->+ -- | The file this is, for the positions in a parse error+ FilePath ->+ -- | How this configuration was reached+ Reached ->+ -- | Formattings left to spend+ Int ->+ Text ->+ Either CppError (Doc, Int)+formatAllConfigs parser render path reached budget source = case variations source of+ Nothing+ | any isDirective (T.lines left) -> Left (UnhandledDirective (unhandledIn left))+ | budget <= 0 -> Left TooManyConfigurations+ | otherwise -> do+ document <-+ formatSingleConfig+ parser+ render+ path+ reached+ left+ (,budget - 1)+ <$> replacing+ (reachedLines reached)+ (reachedAnswers reached)+ opaque+ document+ where+ opaque = opaqueDirectives source+ left = withoutOpaque source+ Just apart -> case linearly apart of+ Right built -> Right built+ Left (Refused TooManyConfigurations, _) -> Left TooManyConfigurations+ Left (_, left')+ | Right many <- countLeaves source,+ many > configurationsWorthTrying ->+ Left TooManyConfigurations+ | otherwise ->+ maybe+ (Left UnsplittableConditional)+ (together parser render path reached left')+ (configurations source)+ where+ linearly v =+ case separately parser render path reached budget v of+ Left why -> Left (Refused why, budget)+ Right (baseDoc, merged, budget') ->+ case combine Broken baseDoc (zip (map cfgWholes (vaGroups v)) merged) of+ Just d -> Right (d, budget')+ Nothing -> Left (InOneConstruct, budget')++-- | Why the linear form did not work.+data Linearly+ = -- | A configuration under it was refused, and this is what for.+ Refused CppError+ | -- | The merge came back a bare choice, so the conditionals' differences+ -- land on one construct and cannot be put back one at a time.+ InOneConstruct++-- | What every question asked at the top level of a module splits it into,+-- each taken on its own.+data Variation = Variation+ { -- | Every question answered with its first branch.+ vaBaseline :: Text,+ -- | The branches that answer left out. See 'Tilia.Source.dropping'.+ vaBaselineDropped :: [(Int, Int)],+ -- | One question varied, with all the others held at the baseline.+ vaGroups :: [Configurations]+ }++-- | Split a module on every conditional at its top level, one at a time.+variations :: Text -> Maybe Variation+variations source = do+ ds <- scanDirectives source+ specs <- traverse groupSpec (groupsAtLevel 0 ds)+ case [[gs] | gs <- specs] of+ [] -> Nothing+ dimensions ->+ let blanked at =+ concat [blankingFor g (at k) | (k, dim) <- zip [0 :: Int ..] dimensions, g <- dim]+ gone at =+ concat [droppedFor g (at k) | (k, dim) <- zip [0 :: Int ..] dimensions, g <- dim]+ held at = blanking (blanked at) source+ in Just+ Variation+ { vaBaseline = held (const 0),+ vaBaselineDropped = gone (const 0),+ vaGroups =+ [ Configurations+ { cfgGuards = gsGuards gs,+ cfgTexts =+ [ held (\j -> if j == k then i else 0)+ | i <- [0 .. gsCount gs - 1]+ ],+ cfgDropped =+ [ gone (\j -> if j == k then i else 0)+ | i <- [0 .. gsCount gs - 1]+ ],+ cfgWholes = Varied (map gsWhole dim)+ }+ | (k, dim@(gs : _)) <- zip [0 :: Int ..] dimensions+ ]+ }++-- | Vary each conditional on its own, holding the others at their first+-- branch.+separately ::+ -- | What to parse a configuration with+ ParserConfig ->+ -- | What to print it with+ RenderConfig ->+ -- | The file this is, for the positions in a parse error+ FilePath ->+ -- | How this configuration was reached+ Reached ->+ -- | Formattings left to spend+ Int ->+ -- | The conditionals to vary, and the baseline to hold them against+ Variation ->+ Either CppError (Doc, [Doc], Int)+separately parser render path reached budget v = do+ (baseDoc, spent) <-+ formatAllConfigs+ parser+ render+ path+ (without (vaBaselineDropped v) reached)+ budget+ (vaBaseline v)+ (merged, left) <- eachGroup baseDoc spent (vaGroups v)+ pure (baseDoc, merged, left)+ where+ free = freeOf reached++ eachGroup _ b [] = Right ([], b)+ eachGroup baseDoc b (c : cs) = do+ (docs, b') <- eachBranch c baseDoc b (zip [0 ..] (cfgTexts c))+ (rest, b'') <- eachGroup baseDoc b' cs+ pure (merge free (cfgGuards c) (cfgWholes c) docs : rest, b'')++ eachBranch _ _ b [] = Right ([], b)+ eachBranch c baseDoc b ((i, t) : ts) = do+ (d, b') <-+ if t == vaBaseline v+ then Right (baseDoc, b)+ else formatAllConfigs parser render path (answering c i reached) b t+ (ds, b'') <- eachBranch c baseDoc b' ts+ pure (d : ds, b'')++-- | Vary the conditionals together, one group at a time.+together ::+ -- | What to parse a configuration with+ ParserConfig ->+ -- | What to print it with+ RenderConfig ->+ -- | The file this is, for the positions in a parse error+ FilePath ->+ -- | How this configuration was reached+ Reached ->+ -- | Formattings left to spend+ Int ->+ -- | The group to split on, and the branch texts to split it into+ Configurations ->+ Either CppError (Doc, Int)+together parser render path reached budget c = do+ (docs, budget') <- eachBranch budget (zip [0 ..] (cfgTexts c))+ pure (merge (freeOf reached) (cfgGuards c) (cfgWholes c) docs, budget')+ where+ inside = reached+ eachBranch b [] = Right ([], b)+ eachBranch b ((i, t) : ts) = do+ (d, b') <- formatAllConfigs parser render path (answering c i inside) b t+ (ds, b'') <- eachBranch b' ts+ pure (d : ds, b'')++-- | Format one configuration with the ordinary printer.+formatSingleConfig ::+ -- | What to parse it with+ ParserConfig ->+ -- | What to print it with+ RenderConfig ->+ -- | The file this is, for the positions in a parse error+ FilePath ->+ -- | How this configuration was reached+ Reached ->+ -- | The configuration itself, with no directives left in it+ Text ->+ Either CppError Doc+formatSingleConfig parser render path reached text =+ case parseConfiguration parser path (reachedLines reached) text of+ Left e -> Left (ConfigurationNotParsed (reachedAnswers reached) e)+ Right parsed -> Right (renderModule render parsed)++-- | How a configuration was reached, and what to call it.+data Reached = Reached+ { -- | Which branch each question was answered with, outermost first.+ reachedAnswers :: [([Guard], Int)],+ -- | Every line the author wrote, except for those written inside a+ -- branch this configuration did not take.+ reachedLines :: Lines+ }++-- | The configuration nothing has been decided about yet.+noAnswers :: Text -> Reached+noAnswers source =+ Reached+ { reachedAnswers = [],+ reachedLines = linesOf (Written source)+ }++-- | Answer one group's question with the branch at the given index.+answering :: Configurations -> Int -> Reached -> Reached+answering c i reached =+ reached+ { reachedAnswers = reachedAnswers reached <> [(cfgGuards c, i)],+ reachedLines = dropping (concat (take 1 (drop i (cfgDropped c)))) (reachedLines reached)+ }++-- | Leave out the branches a baseline does not take, without answering+-- anything: the baseline is every question taken at its first branch, and+-- which question is being varied is not settled until 'answering'.+without :: [(Int, Int)] -> Reached -> Reached+without gone reached =+ reached {reachedLines = dropping gone (reachedLines reached)}++-- | How many whole formattings of a module one call may spend.+configurationBudget :: Int+configurationBudget = 64++-- | How many configurations a module may have and still be worth trying the+-- product on.+configurationsWorthTrying :: Integer+configurationsWorthTrying = 4096++-- | Put the directives that do not introduce new configurations back where+-- they were written.+replacing :: Lines -> [([Guard], Int)] -> [Opaque] -> Doc -> Either CppError Doc+replacing written answers opaque doc = foldl step (Right doc) opaque+ where+ step acc d+ | reproducedAt n doc = Left (DirectiveInQuotedText answers (keyword t))+ | otherwise =+ acc+ >>= maybe (Left (DirectiveUnplaceable answers (keyword t))) Right+ . place d+ where+ n = opLine d+ t = opText d+ keyword = T.takeWhile (/= ' ')+ reproducedAt n = any inside . located+ where+ inside (s, x) =+ spanStartLine s < n && n <= spanEndLine s && reproduced x++ located = \case+ DLocated s x -> (s, x) : located x+ DFence s x -> (s, x) : located x+ DNest _ x -> located x+ DAlign x -> located x+ DGroup _ x -> located x+ DVariant _ b -> located b+ DCat a b -> located a <> located b+ _ -> []++ reproduced = \case+ DVerbatimBreak _ -> True+ DNest _ x -> reproduced x+ DAlign x -> reproduced x+ DGroup _ x -> reproduced x+ DVariant _ b -> reproduced b+ DCat a b -> reproduced a || reproduced b+ _ -> False++ place directive = go+ where+ n = opLine directive++ body =+ DCppDirective (opSpan directive) (opText directive)+ <> if gapUnder written directive then Doc.blankLine else mempty++ go d = case d of+ DNest k x -> DNest k <$> go x+ DAlign x -> DAlign <$> go x+ DGroup l x -> DGroup l <$> go x+ DVariant a b -> DVariant <$> go a <*> go b+ DLocated s x | spanEndLine s >= n -> DLocated s <$> go x+ DFence s x | spanEndLine s >= n -> DFence s <$> go x+ DCat _ _ -> inSpine (spine d)+ _ -> Nothing++ inSpine parts = case break startsAfter parts of+ (before, after)+ | Just (earlier, holder, spacing) <- holding before,+ maybe False (>= n) (endOf holder) ->+ (\x -> mconcat (earlier <> [x] <> spacing <> after)) <$> go holder+ | Just (printed, anchor, spacing) <- tight before,+ Just from <- endOf anchor,+ not (gapWritten written (from + 1) (n - 1)) ->+ Just (mconcat (printed <> [anchor, body] <> spacing <> after))+ | otherwise -> Just (mconcat (before <> [body] <> after))+ where+ startsAfter x = maybe False (>= n) (startOf x)++ holding ds = case break (isJust . endOf) (reverse ds) of+ (spacing, holder : earlier) -> Just (reverse earlier, holder, reverse spacing)+ _ -> Nothing++ tight ds = case break (isJust . endOf) (reverse ds) of+ (spacing, anchor : earlier) -> Just (reverse earlier, anchor, reverse spacing)+ _ -> Nothing++ startOf = fmap fst . boundsOf++ endOf = fmap snd . boundsOf++ boundsOf = \case+ DLocated s _ -> Just (spanStartLine s, spanEndLine s)+ DFence s _ -> Just (spanStartLine s, spanEndLine s)+ DCppDirective s _ -> Just (spanStartLine s, spanEndLine s)+ DNest _ x -> boundsOf x+ DAlign x -> boundsOf x+ DGroup _ x -> boundsOf x+ DVariant _ b -> boundsOf b+ DCat a b -> case (boundsOf a, boundsOf b) of+ (Just (from, _), Just (_, to)) -> Just (from, to)+ (found, Nothing) -> found+ (Nothing, found) -> found+ _ -> Nothing++-- | A module with the directives that ask nothing blanked out of it.+--+-- The same blanking every branch gets, and for the same reason: what is+-- left occupies the lines it always did, so everything downstream can go on+-- lining documents up by where they came from.+withoutOpaque :: Text -> Text+withoutOpaque source =+ blanking [(opLine d, opLastLine d) | d <- opaqueDirectives source] source++-- | Merge the documents one conditional's branches printed to.+--+-- A structural walk that keeps what they all agree on and puts a choice+-- where they part.+merge :: [(Span, Text)] -> [Guard] -> Varied -> [Doc] -> Doc+merge free guards varied = go Broken+ where+ go _ [] = mempty+ go layout ds@(d : rest)+ | all (agree varied layout d) rest = d+ | Just xs <- traverse only spines = alongside layout xs+ | otherwise = factored layout spines+ where+ spines = map (spineAt layout) ds++ alongside _ [] = mempty+ alongside layout xs@(x : _) = case x of+ DLocated s _+ | Just tds <- every (\case DLocated t d -> Just (t, d); _ -> Nothing),+ all (meets s . fst) tds ->+ case go layout (map snd tds) of+ DCppChoice _ _+ | Just opened <- unwrapping layout (map fst tds) xs -> opened+ descended -> DLocated (hull s tds) descended+ DFence s _+ | Just tds <- every (\case DFence t d -> Just (t, d); _ -> Nothing),+ all (meets s . fst) tds ->+ DFence (hull s tds) (go layout (map snd tds))+ DNest n _ | Just ds <- every (\case DNest m d | m == n -> Just d; _ -> Nothing) -> DNest n (go layout ds)+ DGroup _ _+ | Just ls <- every (\case DGroup l _ -> Just l; _ -> Nothing),+ Just ds@(d : rest) <- every (\case DGroup _ d -> Just d; _ -> Nothing) ->+ let inside = if Broken `elem` ls then Broken else Flat+ merged = go inside ds+ in case merged of+ DCppChoice _ _+ | not (all (== inside) ls),+ not (all (agree varied inside d) rest) ->+ choice xs+ _ -> DGroup inside merged+ DAlign _ | Just ds <- every (\case DAlign d -> Just d; _ -> Nothing) -> DAlign (go layout ds)+ _ -> choice xs+ where+ every f = traverse f xs++ unwrapping layout spans xs = do+ inside <- sole [i | (i, s) <- zip [0 :: Int ..] spans, all (covers s) spans]+ wrapper <- listToMaybe (drop inside xs)+ if opens layout wrapper then Just (openedAgainst layout inside wrapper) else Nothing+ where+ sole [i] = Just i+ sole _ = Nothing++ openedAgainst l inside' d = case d of+ DLocated s x -> DLocated s (openedAgainst l inside' x)+ DFence s x -> DFence s (openedAgainst l inside' x)+ DNest n x -> DNest n (openedAgainst l inside' x)+ DAlign x -> DAlign (openedAgainst l inside' x)+ DGroup m x -> DGroup m (openedAgainst m inside' x)+ _ -> case spineAt l d of+ parts@(_ : _ : _) ->+ factored l [if k == inside' then parts else [e] | (k, e) <- zip [0 :: Int ..] xs]+ _ -> choice xs++ opens layout = \case+ DLocated _ x -> opens layout x+ DFence _ x -> opens layout x+ DNest _ x -> opens layout x+ DAlign x -> opens layout x+ DGroup l x -> opens l x+ d -> case spineAt layout d of+ _ : _ : _ -> True+ _ -> False++ factored layout ss =+ let exposed = map (exposing (filter split' (sharedDirectives ss))) ss+ split' d = d `elem` free && any (holds d) ss && not (all (holds d) ss)+ holds d = any (isNamed d)+ lining = alignable varied layout+ shared = foldl1 (lcs lining) exposed+ cut = map (segments (anchored lining) shared) exposed+ stretches = transpose (map fst cut)+ anchors = transpose (map snd cut)+ in mconcat (woven layout stretches (map (go layout) anchors))++ woven layout (s : ss) (c : cs) = varying layout s : c : woven layout ss cs+ woven layout ss [] = map (varying layout) ss+ woven _ [] _ = []++ varying layout ss =+ let (opening, ss1) = sharedStart layout ss+ (ss2, closing) = sharedEnd layout ss1+ (lead, ss3, trail) = hoisted layout ss2+ in mconcat opening+ <> mconcat lead+ <> middle layout ss3+ <> mconcat trail+ <> mconcat closing++ sharedStart layout ss+ | Just (h : hs) <- traverse listToMaybe ss,+ all (agree varied layout h) hs =+ let (c, ss') = sharedStart layout (map (drop 1) ss) in (h : c, ss')+ | otherwise = ([], ss)++ sharedEnd layout ss =+ let (c, ss') = sharedStart layout (map reverse ss)+ in (map reverse ss', reverse c)++ middle _ [] = mempty+ middle layout ss@(s : rest)+ | all (alike layout s) rest = mconcat s+ | Just xs <- traverse only ss = go layout xs+ | Just merged <- alongsideHeads layout ss,+ weigh layout merged < weigh layout apart =+ merged+ | otherwise = apart+ where+ apart = choice (map mconcat ss)++ alongsideHeads layout ss = do+ heads <- traverse listToMaybe ss+ let tails = map (drop 1) ss+ case heads of+ (h : hs)+ | all (sameKind h) hs,+ all breaksFirst tails ->+ Just (joined (go layout heads) (middle layout tails))+ _ -> Nothing+ where+ breaksFirst t = case dropWhile ((== 0) . weigh layout) t of+ [] -> True+ (d : _) -> opensWithBreak layout d++ joined before after = case (endingChoice before, startingChoice after) of+ (Just (opening, bs, e, gap), Just (gap', cs, e', closing))+ | map fst bs == map fst cs ->+ opening+ <> Doc.cppChoice+ [(g, x <> between <> y) | ((g, x), (_, y)) <- zip bs cs]+ (e <> between <> e')+ <> closing+ where+ between = gap <> gap'+ _ -> before <> after++ sameKind x y = case (x, y) of+ (DLocated s t, DLocated u v) -> meets s u && bothWritten t v+ (DFence s t, DFence u v) -> meets s u && bothWritten t v+ (DNest n t, DNest m v) -> n == m && bothWritten t v+ (DGroup _ t, DGroup _ v) -> bothWritten t v+ (DAlign t, DAlign v) -> bothWritten t v+ _ -> False+ where+ bothWritten t v = not (empty' t) && not (empty' v)+ empty' DEmpty = True+ empty' _ = False++ alike layout xs ys =+ length xs == length ys && and (zipWith (agree varied layout) xs ys)++ hoisted layout ss = case filter (not . null . middleOf) peeled of+ [] ->+ ( widest [l | (l, _, _) <- peeled],+ map (const []) ss,+ widest [r | (_, _, r) <- peeled]+ )+ speaking ->+ ( widest [l | (l, _, _) <- speaking],+ map middleOf peeled,+ widest [r | (_, _, r) <- speaking]+ )+ where+ peeled = map peel ss+ middleOf (_, m, _) = m+ widest = \case+ [] -> []+ runs -> maximumBy (comparing (spaceOf layout)) runs++ peel ds =+ let (l, rest) = span spacing ds+ (r, m) = span spacing (reverse rest)+ in (l, reverse m, reverse r)++ spacing = \case+ DEmpty -> True+ DBreak -> True+ DSoftBreak -> True+ DHardBreak -> True+ DCloseLine -> True+ _ -> False++ choice ds = case unsnoc ds of+ Just (branches, fallback) -> Doc.cppChoice (zip (map guardText guards) branches) fallback+ Nothing -> mempty++ only [d] = Just d+ only _ = Nothing++-- | 'freeDirectives' of the module as its author wrote it.+freeOf :: Reached -> [(Span, Text)]+freeOf = freeDirectives . T.unlines . lineTexts . reachedLines++-- | The opaque directives written outside every conditional.+freeDirectives :: Text -> [(Span, Text)]+freeDirectives source =+ [ (opSpan d, opText d)+ | d <- opaqueDirectives source,+ Map.findWithDefault 0 (opLine d) depths == (0 :: Int)+ ]+ where+ depths = Map.fromList (zip [1 ..] (scanl step 0 (T.lines source)))+ step depth l+ | not (isDirective l) = depth+ | keyword `elem` ["if", "ifdef", "ifndef"] = depth + 1+ | keyword == "endif" = max 0 (depth - 1)+ | otherwise = depth+ where+ keyword = T.takeWhile isAsciiLower (T.stripStart (T.drop 1 (T.stripStart l)))++-- | Is this spine element the named directive itself, bare?+isNamed :: (Span, Text) -> Doc -> Bool+isNamed (s, t) = \case+ DCppDirective u v -> u == s && v == t+ _ -> False++-- | The directives every one of these spines holds.+sharedDirectives :: [[Doc]] -> [(Span, Text)]+sharedDirectives = \case+ [] -> []+ s : ss -> foldl (\acc t -> filter (`elem` namesIn t) acc) (namesIn s) ss+ where+ namesIn = concatMap named++-- | The directives a document holds, as far down as one may be brought out+-- from.+named :: Doc -> [(Span, Text)]+named = \case+ DCppDirective s t -> [(s, t)]+ DCat a b -> named a <> named b+ DNest _ x -> named x+ DAlign x -> named x+ DGroup _ x -> named x+ DVariant _ b -> named b+ _ -> []++-- | Bring the given directives out to the top of the spine.+exposing :: [(Span, Text)] -> [Doc] -> [Doc]+exposing wanted+ | null wanted = id+ | otherwise = concatMap out+ where+ out d+ | not (any here (named d)) = [d]+ | otherwise = case d of+ DCat a b -> out a <> out b+ DNest k x -> split (DNest k) (out x)+ DAlign x -> split DAlign (out x)+ DGroup l x -> split (DGroup l) (out x)+ DVariant a b -> varied (out a) (out b)+ _ -> [d]++ here (s, t) = (s, t) `elem` wanted++ bare = \case+ DCppDirective s t -> here (s, t)+ _ -> False++ split w ps = case break bare ps of+ (before, []) -> [w (mconcat before) | not (null before)]+ (before, x : rest) ->+ [w (mconcat before) | not (null before)] <> [x] <> split w rest++ varied as bs =+ let (xs, ds) = chunk as+ (ys, es) = chunk bs+ in if ds == es && length xs == length ys+ then interleave xs ys ds+ else [DVariant (mconcat as) (mconcat bs)]++ chunk ps = case break bare ps of+ (before, []) -> ([mconcat before], [])+ (before, x : rest) ->+ let (cs, ds) = chunk rest in (mconcat before : cs, x : ds)++ interleave (x : xs) (y : ys) ds = case ds of+ [] -> [DVariant x y]+ z : zs -> DVariant x y : z : interleave xs ys zs+ interleave _ _ _ = []++-- | Would these two documents print the same, laid out like this?+agree :: Varied -> Layout -> Doc -> Doc -> Bool+agree varied layout a b = alike (chunked (spineAt layout a)) (chunked (spineAt layout b))+ where+ alike (Left s : xs) (Left t : ys) = s == t && alike xs ys+ alike (Right x : xs) (Right y : ys) = here x y && alike xs ys+ alike [] [] = True+ alike _ _ = False++ chunked ds =+ let (space, rest) = span isSpace' ds+ in Left (spaceOf layout space) : case rest of+ [] -> []+ x : more -> Right x : chunked more++ isSpace' = \case+ DEmpty -> True+ DSpace -> True+ DBreak -> True+ DSoftBreak -> True+ DHardBreak -> True+ DCloseLine -> True+ _ -> False++ inside x y = agree varied layout x y++ here x y = case (x, y) of+ (DGroup l x', DGroup m y') -> l == m && agree varied l x' y'+ (DNest n x', DNest m y') -> n == m && inside x' y'+ (DAlign x', DAlign y') -> inside x' y'+ (DLocated s x', DLocated t y') ->+ s == t && (untouched varied s || inside x' y')+ (DFence s x', DFence t y') -> s == t && inside x' y'+ (DCppChoice bs x', DCppChoice cs y') ->+ length bs == length cs+ && and [g == h && inside p q | ((g, p), (h, q)) <- zip bs cs]+ && inside x' y'+ (DText s, DText t) -> s == t+ (DCppDirective s u, DCppDirective t v) -> s == t && u == v+ (DHoldBack s, DHoldBack t) -> s == t+ (DVerbatimBreak r, DVerbatimBreak q) -> r == q+ (DSpace, DSpace) -> True+ (DBreak, DBreak) -> True+ (DSoftBreak, DSoftBreak) -> True+ (DHardBreak, DHardBreak) -> True+ (DCloseLine, DCloseLine) -> True+ _ -> False++-- | What a run of space comes to on the page.+--+-- How many lines it ends, which is all that can be told of it afterwards+-- since the printer never writes two empty lines in a row, and whether it+-- holds the text either side of it apart on a line it did not end.+--+-- The 'Ord' instance is how much space it is, which is why the fields are in+-- that order: nothing, then a space, then a line ended, then two.+data Space = Space !Int !Bool+ deriving (Eq, Ord)++-- | Read a run of space, the way 'Tilia.Doc.Internal.breakLine' does.+spaceOf :: Layout -> [Doc] -> Space+spaceOf layout = go 0 False False+ where+ go ended closed apart = \case+ [] -> Space (min 2 ended) (apart && ended == 0)+ d : ds -> case d of+ DSpace -> go ended closed True ds+ DCloseLine+ | closed -> go ended closed apart ds+ | otherwise -> go (ended + 1) True apart ds+ DHardBreak -> broke ds+ DBreak+ | layout == Broken -> broke ds+ | otherwise -> go ended closed True ds+ DSoftBreak+ | layout == Broken -> broke ds+ | otherwise -> go ended closed apart ds+ _ -> go ended closed apart ds+ where+ broke rest+ | closed = go ended False apart rest+ | otherwise = go (ended + 1) False apart rest++-- | The lines one conditional could have printed differently.+newtype Varied = Varied {variedLines :: [(Int, Int)]}+ deriving (Eq, Show)++-- | Was this region printed from lines the conditional left alone?+untouched :: Varied -> Span -> Bool+untouched (Varied ranges) s = not (any reaches ranges)+ where+ reaches (from, to) = spanStartLine s <= to && from <= spanEndLine s++-- | Put several documents' differences from a baseline into one document.+--+-- Each of them is the baseline except inside one conditional's lines, and+-- those lines do not overlap, so their differences can be applied side by+-- side rather than chosen between. Which is what makes varying the+-- conditionals one at a time add up to varying them together, and so what+-- makes the cost linear.+combine :: Layout -> Doc -> [(Varied, Doc)] -> Maybe Doc+combine layout base ds = case filter (\(v, d) -> not (agree v layout base d)) ds of+ [] -> 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+ (bs, ss) -> spliced bs ss+ where+ single [d] = Just d+ single _ = Nothing++ descend b xs = case b of+ DLocated s i+ | Just tds <- every (\case DLocated t d -> Just (t, d); _ -> Nothing),+ all (meets s . fst . snd) tds ->+ DLocated (hull s (map snd tds)) <$> combine layout i (inner tds)+ DFence s i+ | Just tds <- every (\case DFence t d -> Just (t, d); _ -> Nothing),+ all (meets s . fst . snd) tds ->+ DFence (hull s (map snd tds)) <$> combine layout i (inner tds)+ DNest n i | Just is <- every (\case DNest m d | m == n -> Just d; _ -> Nothing) -> DNest n <$> combine layout i is+ DAlign i | Just is <- every (\case DAlign d -> Just d; _ -> Nothing) -> DAlign <$> combine layout i is+ DGroup l i+ | Just ls <- every (\case DGroup m _ -> Just m; _ -> Nothing),+ Just is <- every (\case DGroup _ d -> Just d; _ -> Nothing) ->+ let inside = if Broken `elem` (l : map snd ls) then Broken else Flat+ in DGroup inside <$> combine inside i is+ _ -> Nothing+ where+ every f = traverse (\(v, d) -> (,) v <$> f d) xs+ inner tds = [(v, d) | (v, (_, d)) <- tds]++ spliced bs ss = do+ clustered <-+ traverse+ (cluster bs)+ ( overlapping+ ( sortOn+ chFrom+ ( concat+ [ changesAgainst v (alignable v layout) (agree v layout) bs s+ | (v, s) <- ss+ ]+ )+ )+ )+ pure (mconcat (applied bs clustered))++ cluster _ [c] = Just c+ cluster bs cs+ | to - from == 1,+ Just xs <- traverse (\c -> (,) (chVaried c) <$> single (chWith c)) cs,+ (b : _) <- drop from bs =+ ( \d ->+ Change+ { chFrom = from,+ chTo = to,+ chWith = [d],+ chVaried = Varied (concatMap (variedLines . chVaried) cs)+ }+ )+ <$> combine layout b xs+ | otherwise = Nothing+ where+ from = minimum (map chFrom cs)+ to = maximum (map chTo cs)++ applied bs = go 0+ where+ go i [] = drop i bs+ go i (c : cs) =+ take (chFrom c - i) (drop i bs) <> chWith c <> go (chTo c) cs++-- | The smallest span covering a node's own and those of everything merged+-- into it.+hull :: Span -> [(Span, Doc)] -> Span+hull = foldr ((<>) . fst)++-- | A stretch of the baseline, and what one document put there instead.+data Change = Change+ { chFrom :: !Int,+ chTo :: !Int,+ chWith :: [Doc],+ -- | The lines the conditional this change came from could have reached.+ -- Carried so that a cluster of two of them can be combined without+ -- losing which conditional each half belongs to. See 'Varied'.+ chVaried :: Varied+ }++-- | What one document changed about the baseline, as the stretches it+-- replaced and what it put in each of their places.+changesAgainst ::+ Varied ->+ -- | Whether two elements stand for the same thing, which lines the spines up+ (Doc -> Doc -> Bool) ->+ -- | Whether two elements print the same, which says nothing changed+ (Doc -> Doc -> Bool) ->+ [Doc] ->+ [Doc] ->+ [Change]+changesAgainst varied lining plain bs xs = go 0 bs xs (lcs lining bs xs)+ where+ anchor = anchored lining++ go i b x [] = between i b x+ go i b x (c : cs) =+ let (b', b'') = break (anchor c) b+ (x', x'') = break (anchor c) x+ j = i + length b'+ in between i b' x'+ <> held j (listToMaybe b'') (listToMaybe x'')+ <> go (j + 1) (drop 1 b'') (drop 1 x'') cs++ held j (Just b') (Just x')+ | not (plain b' x') =+ [Change {chFrom = j, chTo = j + 1, chWith = [x'], chVaried = varied}]+ held _ _ _ = []++ between i b x =+ [ Change+ { chFrom = i + shared,+ chTo = i + shared + length b',+ chWith = x',+ chVaried = varied+ }+ | not (null b' && null x')+ ]+ where+ shared = length (takeWhile id (zipWith plain b x))+ atEnd = length (takeWhile id (zipWith plain (reverse b) (reverse x)))+ kept = min atEnd (min (length b) (length x) - shared)+ b' = take (length b - kept - shared) (drop shared b)+ x' = take (length x - kept - shared) (drop shared x)++-- | Group changes that reach the same stretch of the baseline.+--+-- Ones that merely touch are left apart: a change ending where the next+-- begins has not reached into it.+overlapping :: [Change] -> [[Change]]+overlapping [] = []+overlapping (c : cs) = go [c] (chTo c) cs+ where+ go acc _ [] = [reverse acc]+ go acc end (x : xs)+ | chFrom x < end = go (x : acc) (max end (chTo x)) xs+ | otherwise = reverse acc : go [x] (chTo x) xs++-- | What a document prints before its final choice, and that choice.+endingChoice :: Doc -> Maybe (Doc, [(Text, Doc)], Doc, Doc)+endingChoice d = case span onlySpacing (reverse (spine d)) of+ (trailing, x : earlier) ->+ let opening = mconcat (reverse earlier)+ gap = mconcat (reverse trailing)+ around w (o, bs, e, g) =+ (opening <> w o, map (fmap w) bs, w e, w g <> gap)+ in case x of+ DCppChoice bs e -> Just (opening, bs, e, gap)+ DGroup l y -> around (DGroup l) <$> endingChoice y+ DNest n y -> around (DNest n) <$> endingChoice y+ DLocated s y -> around (DLocated s) <$> endingChoice y+ DFence s y -> around (DFence s) <$> endingChoice y+ _ -> Nothing+ _ -> Nothing++-- | The mirror of 'endingChoice': a document's opening choice, and the rest.+startingChoice :: Doc -> Maybe (Doc, [(Text, Doc)], Doc, Doc)+startingChoice d = case span onlySpacing (spine d) of+ (leading, x : later) ->+ let gap = mconcat leading+ closing = mconcat later+ around w (g, bs, e, c) =+ (gap <> w g, map (fmap w) bs, w e, w c <> closing)+ in case x of+ DCppChoice bs e -> Just (gap, bs, e, closing)+ DGroup l y -> around (DGroup l) <$> startingChoice y+ DNest n y -> around (DNest n) <$> startingChoice y+ DLocated s y -> around (DLocated s) <$> startingChoice y+ DFence s y -> around (DFence s) <$> startingChoice y+ _ -> Nothing+ _ -> Nothing++-- | Nothing but the whitespace that separates one thing from the next.+onlySpacing :: Doc -> Bool+onlySpacing = \case+ DEmpty -> True+ DSpace -> True+ DBreak -> True+ DSoftBreak -> True+ DHardBreak -> True+ DCloseLine -> True+ _ -> False++-- | Does the first thing this document puts on the page end a line?+opensWithBreak :: Layout -> Doc -> Bool+opensWithBreak layout d = case dropWhile quiet (spineAt layout d) of+ (x : _) -> case x of+ DNest _ y -> opensWithBreak layout y+ DAlign y -> opensWithBreak layout y+ DGroup l y -> opensWithBreak l y+ DLocated _ y -> opensWithBreak layout y+ DFence _ y -> opensWithBreak layout y+ DHardBreak -> True+ DCloseLine -> True+ DBreak -> layout == Broken+ DSoftBreak -> layout == Broken+ DCppDirective _ _ -> True+ DCppChoice _ _ -> True+ _ -> False+ [] -> False+ where+ quiet = \case+ DEmpty -> True+ DSpace -> True+ _ -> False++-- | How much text this document holds, counting what a choice repeats once+-- for each alternative that repeats it.+weigh :: Layout -> Doc -> Int+weigh layout = go+ where+ go = \case+ DCat a b -> go a + go b+ DNest _ d -> go d+ DAlign d -> go d+ DGroup l d -> weigh l d+ DVariant flatD brokenD ->+ go (case layout of Flat -> flatD; Broken -> brokenD)+ DLocated _ d -> go d+ DFence _ d -> go d+ DCppChoice bs e -> sum (map (go . snd) bs) + go e+ DText t -> T.length t+ DCppDirective _ t -> T.length t+ DHoldBack t -> T.length t+ _ -> 0++-- | A document as the sequence of things it concatenates.+spine :: Doc -> [Doc]+spine = \case+ DEmpty -> []+ DCat a b -> spine a <> spine b+ d -> [d]++-- | 'spine', with the variants resolved the way this layout will print them.+spineAt :: Layout -> Doc -> [Doc]+spineAt layout = go+ where+ go = \case+ DEmpty -> []+ DCat a b -> go a <> go b+ DVariant flatD brokenD ->+ go (case layout of Flat -> flatD; Broken -> brokenD)+ d -> [d]++-- | The longest run of elements two spines have in common, in order,+-- allowing for anything either of them has that the other does not.+lcs :: (Doc -> Doc -> Bool) -> [Doc] -> [Doc] -> [Doc]+lcs same xs ys =+ filter anchoring opening <> table middleX middleY <> filter anchoring closing+ where+ agreeing as bs = length (takeWhile id (zipWith same as bs))++ ahead = agreeing xs ys+ (opening, xs1) = splitAt ahead xs+ ys1 = drop ahead ys+ behind = agreeing (reverse xs1) (reverse ys1)+ (middleX, closing) = splitAt (length xs1 - behind) xs1+ middleY = take (length ys1 - behind) ys1++ table [] _ = []+ table _ [] = []+ table as bs = reverse (snd (last (foldl' (row bs) (start bs) as)))+ where+ start cs = replicate (length cs + 1) (0 :: Int, [])+ row cs previous x = cells 0 [] (zip3 cs previous (drop 1 previous))+ where+ cells !n acc rest =+ (n, acc) : case rest of+ [] -> []+ ((y, (dn, ds), (an, as')) : more)+ | anchoring x, same x y -> cells (dn + 1) (x : ds) more+ | n >= an -> cells n acc more+ | otherwise -> cells an as' more++-- | Do these two documents stand for the same thing?+alignable :: Varied -> Layout -> Doc -> Doc -> Bool+alignable = agree++-- | Only let something that was printed line two spines up.+anchored :: (Doc -> Doc -> Bool) -> Doc -> Doc -> Bool+anchored same a b = anchoring a && same a b++-- | Could this element hold two spines together, if it turned up in both?+anchoring :: Doc -> Bool+anchoring = \case+ DEmpty -> False+ DSpace -> False+ DBreak -> False+ DSoftBreak -> False+ DHardBreak -> False+ DCloseLine -> False+ DVerbatimBreak _ -> False+ _ -> True++-- | A spine cut at the elements it shares with the others: one stretch+-- before each of them, and one after the last, and the elements themselves.+--+-- Always one more stretch than there are shared elements, either end of+-- which may be empty. Leftmost matching is enough to find each of them,+-- since what is being matched is a subsequence of this spine to begin with.+--+-- The matched elements come back rather than being dropped because the+-- caller cannot assume they are interchangeable: what lined them up is+-- 'alignable', and only 'agree' would say they print the same.+segments :: (Doc -> Doc -> Bool) -> [Doc] -> [Doc] -> ([[Doc]], [Doc])+segments same = go+ where+ go [] s = ([s], [])+ go (c : cs) s = case break (same c) s of+ (before', matched : rest) -> keeping before' matched (go cs rest)+ (before', []) -> keeping before' c (go cs [])+ where+ keeping before' matched (stretches, anchors) =+ (before' : stretches, matched : anchors)++-- | Would the preprocessor be run over this module, and find anything to+-- do?+usesCpp :: [Extension] -> Text -> Bool+usesCpp extensions source =+ Cpp `elem` extensions && any isDirective (T.lines source)++-- | Blank out the directive lines, keeping every branch.+blankCpp :: Text -> Text+blankCpp = T.unlines . go False . T.lines+ where+ go _ [] = []+ go continuing (l : ls)+ | continuing || isDirective l = "" : go (runsOn l) ls+ | otherwise = l : go False ls+ runsOn = T.isSuffixOf "\\" . T.stripEnd++-- | Blank out every branch the macros rule out, and the conditionals that+-- ask about them.+--+-- This is for reading a module, not for printing one. What it takes out is+-- text the file contains and the output must keep, so nothing that builds+-- the output may be given the result.+withoutRuledOut :: Macros -> Text -> Text+withoutRuledOut macros source = case scanDirectives source of+ Nothing -> source+ Just ds ->+ blanking+ [ range+ | group <- allGroups ds,+ Just gs <- [groupSpec group],+ Just taken <- [branchTaken macros gs],+ range <- blankingFor gs taken+ ]+ source++-- | Which branch of a conditional the macros settle on, where they settle+-- one.+--+-- A branch is taken when its own condition holds and every condition before+-- it failed, so one unanswered condition leaves every branch after it+-- unanswered too. Where they all fail the answer is the last branch, which+-- is the @#else@ where there is one and nothing at all where there is not:+-- the same numbering 'blankingFor' uses.+branchTaken :: Macros -> GroupSpec -> Maybe Int+branchTaken macros = go 0 . gsGuards+ where+ go i = \case+ [] -> Just i+ g : rest -> case answerTo macros (guardText g) of+ Just True -> Just i+ Just False -> go (i + 1) rest+ Nothing -> Nothing++-- | Why a module using the preprocessor could not be formatted.+data CppError+ = -- | A directive we do not handle, and its keyword.+ UnhandledDirective Text+ | -- | Conditionals that do not nest, or an @#else@ out of place.+ UnsplittableConditional+ | -- | More configurations than 'configurationBudget' allows.+ TooManyConfigurations+ | -- | A configuration the parser rejected, and which one it was.+ ConfigurationNotParsed [([Guard], Int)] ParseError+ | -- | A directive whose place in the document could not be found.+ DirectiveUnplaceable [([Guard], Int)] Text+ | -- | A directive written inside a quasiquote or other verbatim text.+ DirectiveInQuotedText [([Guard], Int)] Text++-- | Say what went wrong, in one line. The edge of the system.+describeCppError :: CppError -> Text+describeCppError = \case+ UnhandledDirective k -> "a #" <> k <> " directive, which we do not handle"+ UnsplittableConditional -> "conditionals that do not nest, or an #else out of place"+ TooManyConfigurations -> "too many configurations to format"+ ConfigurationNotParsed c e -> describeParseError e <> inConfiguration c+ DirectiveUnplaceable c k -> "nowhere to put the #" <> k <> inConfiguration c+ DirectiveInQuotedText c k ->+ "a #" <> k <> " inside something quoted verbatim" <> inConfiguration c++-- | Which configuration, in words. Empty where there is only one.+inConfiguration :: [([Guard], Int)] -> Text+inConfiguration [] = ""+inConfiguration answers =+ ", in the configuration taking " <> T.intercalate ", then " (map said answers)+ where+ said (guards, i) = case (drop i guards, guards) of+ (g : _, _) -> "#" <> guardText g+ ([], g : _) -> "no branch of #" <> guardText g+ ([], []) -> "no branch"++-- | The keyword of the first directive here that we do not handle.+unhandledIn :: Text -> Text+unhandledIn source =+ case [keywordOf l | l <- T.lines source, isDirective l] of+ k : _ -> k+ [] -> ""+ where+ keywordOf = T.takeWhile isAsciiLower . T.stripStart . T.drop 1 . T.stripStart++----------------------------------------------------------------------------+-- Splitting++-- | One conditional directive, as written after its hash.+newtype Guard = Guard {guardText :: Text}+ deriving (Eq, Ord, Show)++-- | What one conditional splits a module into.+data Configurations = Configurations+ { -- | The directives: the @#if@ of the group, and then one per @#elif@.+ cfgGuards :: [Guard],+ -- | One module text per branch, in the same order as the directives, and+ -- then one more for the @#else@.+ cfgTexts :: [Text],+ -- | What each of those branches leaves out, in the same order.+ cfgDropped :: [[(Int, Int)]],+ -- | From each tied group's @#if@ to its @#endif@, inclusive.+ --+ -- Everything a branch of this conditional can be responsible for lies+ -- between one of these pairs, because that is what a group /is/. What+ -- reads them is 'Varied', and what it does with them is skip the rest of+ -- the module.+ cfgWholes :: Varied+ }+ deriving (Eq, Show)++-- | Split a module on its first outermost conditional, and on every other one+-- written behind the same directives, wherever in the module it sits.+configurations :: Text -> Maybe Configurations+configurations source = do+ ds <- scanDirectives source+ gs <- groupSpec =<< listToMaybe (groupsAtLevel 0 ds)+ let tied = sameGuard gs ds+ pure+ Configurations+ { cfgGuards = gsGuards gs,+ cfgTexts =+ [ blanking (concatMap (`blankingFor` i) tied) source+ | i <- [0 .. gsCount gs - 1]+ ],+ cfgDropped =+ [concatMap (`droppedFor` i) tied | i <- [0 .. gsCount gs - 1]],+ cfgWholes = Varied (map gsWhole tied)+ }++-- | One conditional group, read off the directives that make it up.+data GroupSpec = GroupSpec+ { gsGuards :: [Guard],+ gsHasElse :: Bool,+ gsOwnLines :: [Int],+ gsBranches :: [(Int, Int)],+ gsWhole :: (Int, Int)+ }++-- | Read a group off its directives, refusing one that is malformed.+groupSpec :: [Directive] -> Maybe GroupSpec+groupSpec group = do+ (separators, end) <- unsnoc group+ opener <- listToMaybe separators+ require (dKeyword opener `elem` opensGroup)+ require (dKeyword end == "endif")+ require (all ((`elem` continuesGroup) . dKeyword) (drop 1 separators))+ require (all ((/= "else") . dKeyword) (drop 1 (reverse separators)))+ pure+ GroupSpec+ { gsGuards = [dGuard d | d <- separators, dKeyword d /= "else"],+ gsHasElse = any ((== "else") . dKeyword) separators,+ gsOwnLines = map dLine group,+ gsBranches = [(dLine a + 1, dLine b - 1) | (a, b) <- zip group (drop 1 group)],+ gsWhole = (dLine opener, dLine end)+ }+ where+ require b = if b then Just () else Nothing++-- | How many configurations a group has: one per condition, and one more+-- for when none of them holds.+gsCount :: GroupSpec -> Int+gsCount gs = length (gsGuards gs) + 1++-- | The lines to blank so that configuration @i@ of a group is what is left.+--+-- The branches this configuration does not take, and the directives+-- themselves: a directive belongs to no configuration, which is the whole of+-- what separates this from 'droppedFor'.+blankingFor :: GroupSpec -> Int -> [(Int, Int)]+blankingFor gs i = droppedFor gs i <> [(n, n) | n <- gsOwnLines gs]++-- | The lines a configuration of a group is not including.+droppedFor :: GroupSpec -> Int -> [(Int, Int)]+droppedFor gs i+ | i < length (gsGuards gs) || gsHasElse gs =+ [r | (k, r) <- zip [0 :: Int ..] (gsBranches gs), k /= i]+ | otherwise = gsBranches gs++-- | Every conditional in a module, at whatever depth it sits.+allGroups :: [Directive] -> [[Directive]]+allGroups ds = concat [groupsAtLevel l ds | l <- [0 .. deepest]]+ where+ deepest = maximum (0 : map dLevel ds)++-- | Every group in a module written behind the same directives as this one.+sameGuard :: GroupSpec -> [Directive] -> [GroupSpec]+sameGuard gs ds =+ [g | grp <- allGroups ds, Just g <- [groupSpec grp], gsGuards g == gsGuards gs]++-- | The directives at one level of nesting, split into the groups they make+-- up.+groupsAtLevel :: Int -> [Directive] -> [[Directive]]+groupsAtLevel level = split . filter ((== level) . dLevel)+ where+ split ds = case break ((== "endif") . dKeyword) ds of+ (_, []) -> []+ (before', end : rest) -> (before' <> [end]) : split rest++-- | One preprocessor directive, and how deep in the conditionals it sits.+data Directive = Directive+ { dLine :: !Int,+ dKeyword :: !Text,+ dGuard :: !Guard,+ dLevel :: !Int+ }+ deriving (Eq, Show)++-- | Every conditional directive in a module, or 'Nothing' if its+-- conditionals do not make sense.+scanDirectives :: Text -> Maybe [Directive]+scanDirectives source = go 0 (zip [1 ..] (T.lines source))+ where+ go 0 [] = Just []+ go _ [] = Nothing -- the lines ran out inside a conditional+ go level ((n, l) : ls)+ | not (isDirective l) = go level ls+ | keyword `elem` opensGroup = at level (level + 1)+ | keyword `elem` continuesGroup, level > 0 = at (level - 1) level+ | keyword == "endif", level > 0 = at (level - 1) (level - 1)+ | keyword `notElem` conditionalKeywords = go level ls+ | otherwise = Nothing+ where+ at here next =+ (Directive {dLine = n, dKeyword = keyword, dGuard = Guard (T.stripEnd body), dLevel = here} :)+ <$> go next ls+ keyword = T.takeWhile isAsciiLower body+ body = T.stripStart (T.drop 1 (T.stripStart l))++-- | Every directive the C preprocessor takes, whether or not this module+-- can do anything with the ones it names.+directiveKeywords :: [Text]+directiveKeywords = conditionalKeywords <> opaqueKeywords++-- | The directives that ask a question, and so split a module in two.+conditionalKeywords :: [Text]+conditionalKeywords = opensGroup <> continuesGroup <> ["endif"]++-- | The keywords that open a group, continue one, and close one.+opensGroup, continuesGroup :: [Text]+opensGroup = ["if", "ifdef", "ifndef"]+continuesGroup = ["elif", "elifdef", "elifndef", "else"]++opaqueKeywords :: [Text]+opaqueKeywords =+ ["define", "undef", "include", "line", "error", "warning", "pragma"]++-- | Does this line begin with a preprocessor directive?+--+-- A hash at the start of a line is not enough to say so, which is worth+-- being careful about: the closing @#-}@ of a pragma written across several+-- lines begins one too, and that is Haskell. What settles it is the word+-- after the hash.+isDirective :: Text -> Bool+isDirective l = case T.stripPrefix "#" (T.stripStart l) of+ Just rest -> T.takeWhile isAsciiLower (T.stripStart rest) `elem` directiveKeywords+ Nothing -> False++-- | Directives that do not introduce configurations.+opaqueDirectives :: Text -> [Opaque]+opaqueDirectives source =+ [ Opaque+ { opLine = n,+ opLastLine = end n,+ opText = T.stripEnd (T.intercalate "\n" (body : map lineOf below))+ }+ | (n, l) <- numbered,+ isDirective l,+ let body = T.stripStart (T.drop 1 (T.stripStart l)),+ T.takeWhile isAsciiLower body `elem` opaqueKeywords,+ let below = continuing n+ ]+ where+ numbered = zip [1 ..] (T.lines source)+ byLine = Map.fromList numbered+ lineOf n = Map.findWithDefault "" n byLine+ end n = last (n : continuing n)+ continuing n+ | maybe False runsOn (Map.lookup n byLine) = n + 1 : continuing (n + 1)+ | otherwise = []+ runsOn = T.isSuffixOf "\\" . T.stripEnd++-- | Did the author leave an empty line anywhere between these two lines?+gapWritten :: Lines -> Int -> Int -> Bool+gapWritten written from to = any (`blankAt` written) [from .. to]++-- | One directive that asks nothing, and what is known about it.+data Opaque = Opaque+ { -- | The line it was written on.+ opLine :: Int,+ -- | The last line it takes up, which is 'opLine' unless it was written+ -- across several with backslashes.+ opLastLine :: Int,+ -- | What follows its hash, kept whole and never read.+ opText :: Text+ }+ deriving (Eq, Show)++-- | The lines a directive was written on, as a span, which is what the+-- document carries so that two directives written the same can be told+-- apart.+opSpan :: Opaque -> Span+opSpan d = mkSpan (opLine d, 1) (opLastLine d, 1)++-- | Did the author leave an empty line under this directive?+--+-- Not one that stands at the end of a branch: see 'closesABranch'.+gapUnder :: Lines -> Opaque -> Bool+gapUnder written d =+ (blankAt n written || blankBelow n written) && not (closesABranch n written)+ where+ n = opLastLine d++-- | Replace the given line ranges with empty lines, keeping every other line+-- where it was.+blanking :: [(Int, Int)] -> Text -> Text+blanking ranges source =+ T.unlines+ [ if any (holds n) ranges then "" else l+ | (n, l) <- zip [1 ..] (T.lines source)+ ]+ where+ holds n (from, to) = from <= n && n <= to++-- | One configuration for every branch of every conditional, and no more.+--+-- 'leaves' takes every combination of answers, of which there are as many as+-- the branches multiplied together: a module of moderate size can have tens+-- of thousands, and a reader that has to look at all of them cannot look at+-- it at all. These are the sum instead of the product—one configuration per+-- branch, with every other conditional taking its first—which is few enough+-- to read even for the worst of them.+--+-- What that buys is coverage rather than completeness: every line of the+-- module appears in at least one of these, so nothing written under a+-- directive goes unseen. What it does not buy is every /combination/ of+-- lines, so this answers questions asked of the parts and not of the whole.+-- Conditionals asking the same question are answered the same way+-- throughout, as they are everywhere else here, so no configuration+-- contradicts itself.+branchLeaves :: Text -> Either CppError [Text]+branchLeaves source = case scanDirectives source of+ Nothing -> Left (UnhandledDirective (unhandledIn source))+ Just ds -> case nesting 0 ds of+ Nothing -> Left UnsplittableConditional+ Just forest -> traverse resolved (distinct (map configuration (assignments forest)))+ where+ reachable = go Map.empty+ where+ go asked ns =+ concat+ [ (asked, gs)+ : concat+ [ go (Map.insert (gsGuards gs) i asked) nested+ | (i, nested) <- zip [0 ..] branches+ ]+ | Nest gs branches <- ns+ ]+ assignments forest =+ Map.empty+ : [ Map.insert (gsGuards gs) i asked+ | (asked, gs) <- reachable forest,+ i <- [0 .. gsCount gs - 1]+ ]+ configuration answers =+ blanking+ [ r+ | grp <- allGroups (concat (maybeToList (scanDirectives source))),+ Just gs <- [groupSpec grp],+ r <- blankingFor gs (Map.findWithDefault 0 (gsGuards gs) answers)+ ]+ source++ distinct = Map.elems . Map.fromList . map (\t -> (t, t))++-- | Every configuration of a module, with every conditional resolved.+--+-- What 'formatWithCpp' formats, without the formatting. This is what the+-- @forall cfg@ quantifies over, and keeping it apart from the building is+-- what lets a test ask whether the building agreed with it.+leaves :: Text -> Either CppError [Text]+leaves = fmap (map snd) . answeredLeaves++-- | The configurations reached by varying one conditional at a time.+linearLeaves :: Text -> Either CppError [Text]+linearLeaves = fmap (map snd) . answeredLinearLeaves++-- | How many configurations a module has, without building any of them.+countLeaves :: Text -> Either CppError Integer+countLeaves source = case scanDirectives source of+ Nothing -> Left (UnhandledDirective (unhandledIn source))+ Just ds -> case nesting 0 ds of+ Nothing -> Left UnsplittableConditional+ Just forest ->+ Right (sum [across answers forest | answers <- combinations (afforded forest)])+ where+ across answers = product . map (one answers)+ one answers (Nest gs nested) = case lookup (gsGuards gs) answers of+ Just i -> across answers (branch nested i)+ Nothing -> sum [across answers (branch nested i) | i <- [0 .. gsCount gs - 1]]+ branch nested i = concat (take 1 (drop i nested))+ combinations = traverse (\(g, k) -> [(g, i) | i <- [0 .. k - 1]])+ afforded forest = go 1 (repeated forest)+ where+ go _ [] = []+ go n ((g, k) : rest)+ | n * toInteger k <= guardsToTie = (g, k) : go (n * toInteger k) rest+ | otherwise = []++-- | A module's conditionals as a forest: each group, with the groups nested+-- inside each of its branches.+data Nest = Nest GroupSpec [[Nest]]++-- | Read the forest off the directives, refusing a group 'groupSpec' refuses.+nesting :: Int -> [Directive] -> Maybe [Nest]+nesting level ds = traverse one (groupsAtLevel level ds)+ where+ one group = do+ gs <- groupSpec group+ Nest gs <$> traverse (\r -> nesting (level + 1) (inside r ds)) (gsBranches gs)+ inside (from, to) = filter (\d -> from <= dLine d && dLine d <= to)++-- | The guards a module asks more than once, and how many answers each has.+--+-- In the order they were written, and each named once however often it+-- appears.+repeated :: [Nest] -> [([Guard], Int)]+repeated forest = distinct Map.empty [q | q@(g, _) <- asked forest, twice g]+ where+ asked ns = concat [(gsGuards gs, gsCount gs) : asked (concat nested) | Nest gs nested <- ns]+ times = Map.fromListWith (+) [(g, 1 :: Int) | (g, _) <- asked forest]+ twice g = Map.findWithDefault 0 g times >= 2++ distinct _ [] = []+ distinct seen (q@(g, _) : rest)+ | Map.member g seen = distinct seen rest+ | otherwise = q : distinct (Map.insert g () seen) rest++-- | How many combinations of answers 'countLeaves' will enumerate.+guardsToTie :: Integer+guardsToTie = 4096++-- | Which branch every question was answered with to reach a configuration.+type Answers = Map [Guard] Int++-- | Every configuration, and the answers that reach it.+answeredLeaves :: Text -> Either CppError [(Answers, Text)]+answeredLeaves = go Map.empty+ where+ go answers source = case configurations source of+ Nothing -> (\t -> [(answers, t)]) <$> resolved source+ Just c ->+ concat+ <$> traverse+ (\(i, t) -> go (Map.insert (cfgGuards c) i answers) t)+ (zip [0 ..] (cfgTexts c))++-- | The same, labelled by the answers that reach each one, and for the same+-- reason as 'answeredLeaves'.+answeredLinearLeaves :: Text -> Either CppError [(Answers, Text)]+answeredLinearLeaves = go Map.empty+ where+ go answers source = case configurations source of+ Nothing -> (\t -> [(answers, t)]) <$> resolved source+ Just c -> case zip [0 ..] (cfgTexts c) of+ [] -> Right []+ (i, first) : rest ->+ (<>)+ <$> go (Map.insert (cfgGuards c) i answers) first+ <*> traverse (held answers (cfgGuards c)) rest+ where+ held before gs (i, t) = answeredBaseline (Map.insert gs i before) t++-- | The configuration in which every question still to be asked takes its+-- first branch, and the answers that gives.+answeredBaseline :: Answers -> Text -> Either CppError (Answers, Text)+answeredBaseline answers source = case configurations source of+ Nothing -> (answers,) <$> resolved source+ Just c -> case cfgTexts c of+ [] -> Right (answers, source)+ t : _ -> answeredBaseline (Map.insert (cfgGuards c) 0 answers) t++-- | A module with no conditionals left in it, or the reason it is not one.+resolved :: Text -> Either CppError Text+resolved source+ | any isDirective (T.lines left) =+ Left (UnhandledDirective (unhandledIn left))+ | otherwise = Right left+ where+ left = withoutOpaque source++----------------------------------------------------------------------------+-- Diagnostics++-- | Every region a document records provenance for, with what was printed+-- there.+--+-- The outermost wins where a span appears twice, which is the one 'walk'+-- would have given a comment to.+regions :: Doc -> Map Span Doc+regions = Map.fromListWith (\_ outer -> outer) . go+ where+ go = \case+ DLocated s d -> (s, d) : go d+ DFence _ d -> go d+ DCat a b -> go a <> go b+ DNest _ d -> go d+ DAlign d -> go d+ DGroup _ d -> go d+ DVariant a _ -> go a+ DCppChoice bs e -> foldMap (go . snd) bs <> go e+ _ -> []
+ src/Tilia/Cpp/Macros.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | The questions a module's conditionals ask that the build plan has+-- already answered.+module Tilia.Cpp.Macros+ ( Macros (..),+ answerTo,+ )+where++import Data.Char (isAsciiLower, isAsciiUpper, isDigit)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T++-- | What the preprocessor would have been told.+data Macros = Macros+ { -- | The macros that take a version apart and compare it:+ -- @MIN_VERSION_containers@ and its like, each under the version the+ -- plan resolved that package to. @MIN_VERSION_GLASGOW_HASKELL@ is one+ -- of these, under the compiler's four-part version.+ macroVersions :: Map Text [Integer],+ -- | The macros that stand for a number, which is @__GLASGOW_HASKELL__@+ -- and its patch levels.+ macroNumbers :: Map Text Integer+ }+ deriving (Eq, Show)++-- | What a conditional's guard comes to, where what is known settles it.+--+-- The text is the whole directive as it was written after its hash, keyword+-- and all, because @#if@ and @#ifdef@ ask about their rest in different+-- ways.+answerTo :: Macros -> Text -> Maybe Bool+answerTo macros written = case T.span isNameChar (T.stripStart written) of+ (keyword, rest) -> case keyword of+ "if" -> (/= 0) <$> evaluate macros rest+ "elif" -> (/= 0) <$> evaluate macros rest+ "ifdef" -> nameIsKnown rest+ "elifdef" -> nameIsKnown rest+ "ifndef" -> not <$> nameIsKnown rest+ "elifndef" -> not <$> nameIsKnown rest+ _ -> Nothing+ where+ nameIsKnown rest = case tokensOf rest of+ Just [Name n] | known macros n -> Just True+ _ -> Nothing++-- | Is this a macro whose value we know?+known :: Macros -> Text -> Bool+known macros n =+ Map.member n (macroVersions macros) || Map.member n (macroNumbers macros)++----------------------------------------------------------------------------+-- The expression++-- | What an expression came to, where it came to anything.+evaluate :: Macros -> Text -> Maybe Integer+evaluate macros written = case tokensOf written of+ Nothing -> Nothing+ Just ts -> case orExpr macros ts of+ Just (value, []) -> value+ _ -> Nothing++-- | An expression, and what is left of the tokens after it.+--+-- The outer 'Maybe' is whether it could be read at all; the inner one is+-- whether what it means is known.+type Reading = Maybe (Maybe Integer, [Token])++orExpr :: Macros -> [Token] -> Reading+orExpr macros ts = do+ (left, rest) <- andExpr macros ts+ more left rest+ where+ more left = \case+ Punct "||" : rest -> do+ (right, rest') <- andExpr macros rest+ more (either' left right) rest'+ rest -> Just (left, rest)+ either' a b+ | any true [a, b] = Just 1+ | all false [a, b] = Just 0+ | otherwise = Nothing++andExpr :: Macros -> [Token] -> Reading+andExpr macros ts = do+ (left, rest) <- compared macros ts+ more left rest+ where+ more left = \case+ Punct "&&" : rest -> do+ (right, rest') <- compared macros rest+ more (both left right) rest'+ rest -> Just (left, rest)+ both a b+ | any false [a, b] = Just 0+ | all true [a, b] = Just 1+ | otherwise = Nothing++true, false :: Maybe Integer -> Bool+true = maybe False (/= 0)+false = maybe False (== 0)++compared :: Macros -> [Token] -> Reading+compared macros ts = do+ (left, rest) <- unary macros ts+ case rest of+ Punct op : rest' | Just test <- comparison op -> do+ (right, rest'') <- unary macros rest'+ pure (fromBool . uncurry test <$> pair left right, rest'')+ _ -> Just (left, rest)+ where+ pair a b = (,) <$> a <*> b+ fromBool b = if b then 1 else 0+ comparison = \case+ "==" -> Just (==)+ "!=" -> Just (/=)+ "<" -> Just (<)+ ">" -> Just (>)+ "<=" -> Just (<=)+ ">=" -> Just (>=)+ _ -> Nothing++unary :: Macros -> [Token] -> Reading+unary macros = \case+ Punct "!" : rest -> do+ (value, rest') <- unary macros rest+ pure (negated <$> value, rest')+ Punct "(" : rest -> do+ (value, rest') <- orExpr macros rest+ case rest' of+ Punct ")" : rest'' -> Just (value, rest'')+ _ -> Nothing+ Name "defined" : rest -> case rest of+ Name n : rest' -> Just (asKnown n, rest')+ Punct "(" : Name n : Punct ")" : rest' -> Just (asKnown n, rest')+ _ -> Nothing+ Name n : Punct "(" : rest -> do+ (arguments, rest') <- argumentList rest+ pure (atLeast <$> Map.lookup n (macroVersions macros) <*> arguments, rest')+ Name n : rest -> Just (Map.lookup n (macroNumbers macros), rest)+ Number n : rest -> Just (Just n, rest)+ _ -> Nothing+ where+ negated n = if n == 0 then 1 else 0+ asKnown n = if known macros n then Just 1 else Nothing+ atLeast held wanted = if pad held >= pad wanted then 1 else 0+ where+ width = max (length held) (length wanted)+ pad v = take width (v <> repeat 0)++-- | What an application was given, and what follows its closing bracket.+--+-- Every argument has to be a plain number. One written as an expression is+-- not something to work out—a module that writes one is not asking the+-- question this can answer—but its brackets are still counted through, so+-- that the rest of the guard can be read and go on deciding what it can.+argumentList :: [Token] -> Maybe (Maybe [Integer], [Token])+argumentList ts = do+ (inside, rest) <- upToClose (0 :: Int) [] ts+ pure (numbersOf inside, rest)+ where+ upToClose depth acc = \case+ Punct ")" : rest+ | depth == 0 -> Just (reverse acc, rest)+ | otherwise -> upToClose (depth - 1) (Punct ")" : acc) rest+ Punct "(" : rest -> upToClose (depth + 1) (Punct "(" : acc) rest+ t : rest -> upToClose depth (t : acc) rest+ [] -> Nothing+ numbersOf = \case+ [Number n] -> Just [n]+ Number n : Punct "," : rest -> (n :) <$> numbersOf rest+ _ -> Nothing++----------------------------------------------------------------------------+-- The tokens++-- | One piece of a guard.+data Token+ = Name Text+ | Number Integer+ | Punct Text+ deriving (Eq, Show)++-- | Take a guard apart, or refuse it whole.+--+-- Refusing is not a failure. A guard with arithmetic in it, or a character+-- literal, or a hexadecimal constant, is one this does not read, and a+-- guard it does not read is a question left open.+tokensOf :: Text -> Maybe [Token]+tokensOf = go . T.stripStart+ where+ go t+ | T.null t = Just []+ | Just (c, _) <- T.uncons t,+ isNameStart c =+ let (n, rest) = T.span isNameChar t in (Name n :) <$> next rest+ | Just (c, _) <- T.uncons t,+ isDigit c =+ let (digits, rest) = T.span isDigit t+ rest' = T.dropWhile (`T.elem` "uUlL") rest+ in case T.uncons rest' of+ Just (c', _) | isNameChar c' || c' == '.' -> Nothing+ _ -> (Number (readDigits digits) :) <$> next rest'+ | Just punct <- firstThat (`T.stripPrefix` t) punctuation =+ (Punct (T.take (T.length t - T.length punct) t) :) <$> next punct+ | otherwise = Nothing+ next = go . T.stripStart+ firstThat f = foldr (\x acc -> maybe acc Just (f x)) Nothing+ readDigits = T.foldl' (\n c -> n * 10 + toInteger (fromEnum c - fromEnum '0')) 0++-- | The punctuation of the expressions we read, longest first so that @<=@+-- is never taken for @<@.+punctuation :: [Text]+punctuation = ["&&", "||", "==", "!=", "<=", ">=", "(", ")", ",", "!", "<", ">"]++isNameStart :: Char -> Bool+isNameStart c = isAsciiLower c || isAsciiUpper c || c == '_'++isNameChar :: Char -> Bool+isNameChar c = isNameStart c || isDigit c
+ src/Tilia/Diff.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Showing what changed.+module Tilia.Diff+ ( diff,+ diffInFull,+ )+where++import Data.Algorithm.Diff qualified as D+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Tilia.Palette (Color (..), Palette, paint)++-- | One line of the comparison, with the number it has on each side.+data Line = Line !Mark !Int !Int !Text++-- | The type of mark.+data Mark = Context | Removed | Added+ deriving (Eq)++-- | A unified diff of two texts, cut short once it has said enough.+diff ::+ Palette ->+ -- | What to call the two sides+ (Text, Text) ->+ -- | Before+ Text ->+ -- | After+ Text ->+ Text+diff palette = unified palette (Just roomFor) []++-- | The whole of a unified diff of one file against its formatted self,+-- headed the way @git diff@ heads one.+diffInFull ::+ Palette ->+ -- | The file, named as it was given on the command line+ FilePath ->+ -- | What is in it+ Text ->+ -- | What would be+ Text ->+ Text+diffInFull palette path =+ unified+ palette+ Nothing+ [paint palette Place ("diff --git " <> before <> " " <> after)]+ (before, after)+ where+ before = "a/" <> T.pack path+ after = "b/" <> T.pack path++unified ::+ Palette ->+ -- | How many lines are worth printing, where there is a limit at all+ Maybe Int ->+ -- | Whatever goes above the two file names+ [Text] ->+ -- | What to call the two sides+ (Text, Text) ->+ -- | Before+ Text ->+ -- | After+ Text ->+ Text+unified palette limit above (beforeName, afterName) before after+ | null hunks,+ before /= after =+ "(the two differ only in how they end their lines)"+ | null hunks =+ "(the two are identical as text, so the difference is in something\+ \ the text does not show)"+ | otherwise = T.intercalate "\n" (above <> heading <> shown)+ where+ heading =+ [ paint palette (Header Gone) ("--- " <> beforeName),+ paint palette (Header New) ("+++ " <> afterName)+ ]++ shown = case limit of+ Just room | length body > room -> take room body <> [omitted room]+ _ -> body+ where+ omitted room =+ paint palette Meta $+ "… and " <> T.pack (show (length body - room)) <> " more lines"++ body = concatMap render hunks++ render range = hunkHeading range : map line (slice range)++ hunkHeading range =+ paint palette Meta $+ "@@ -"+ <> span' beforeOf (countingBefore (slice range))+ <> " +"+ <> span' afterOf (countingAfter (slice range))+ <> " @@"+ where+ span' which n = case slice range of+ (l : _) -> T.pack (show (which l)) <> "," <> T.pack (show n)+ [] -> "0,0"++ line (Line mark _ _ text) = case mark of+ Context -> paint palette Unchanged (" " <> text)+ Removed -> paint palette Gone ("-" <> text)+ Added -> paint palette New ("+" <> text)++ slice (from, to) = take (to - from + 1) (drop from lines')++ countingBefore = length . filter (\(Line m _ _ _) -> m /= Added)+ countingAfter = length . filter (\(Line m _ _ _) -> m /= Removed)+ beforeOf (Line _ b _ _) = b+ afterOf (Line _ _ a _) = a++ hunks = merge [(max 0 (i - margin), min (total - 1) (i + margin)) | i <- changed]+ changed = [i | (i, Line m _ _ _) <- zip [0 ..] lines', m /= Context]+ total = length lines'+ lines' = tag (D.getGroupedDiff (split before) (split after))+ split = map withoutReturn . T.splitOn "\n"+ withoutReturn l = fromMaybe l (T.stripSuffix "\r" l)++-- | How many unchanged lines to show either side of a change.+margin :: Int+margin = 3++-- | How many lines of diff are worth printing before it stops being read.+roomFor :: Int+roomFor = 60++-- | Join hunks that have grown into one another.+merge :: [(Int, Int)] -> [(Int, Int)]+merge = \case+ ((a, b) : (c, d) : rest)+ | c <= b + 1 -> merge ((a, max b d) : rest)+ | otherwise -> (a, b) : merge ((c, d) : rest)+ xs -> xs++-- | Number the lines of a grouped diff on both sides at once.+tag :: [D.Diff [Text]] -> [Line]+tag = go 1 1+ where+ go _ _ [] = []+ go !b !a (d : ds) = case d of+ D.Both xs _ ->+ [Line Context (b + i) (a + i) x | (i, x) <- zip [0 ..] xs]+ <> go (b + length xs) (a + length xs) ds+ D.First xs ->+ [Line Removed (b + i) a x | (i, x) <- zip [0 ..] xs]+ <> go (b + length xs) a ds+ D.Second xs ->+ [Line Added b (a + i) x | (i, x) <- zip [0 ..] xs]+ <> go b (a + length xs) ds
+ src/Tilia/Doc.hs view
@@ -0,0 +1,23 @@+-- | Turning a printed document into source text.+module Tilia.Doc+ ( -- * Documents+ Doc,++ -- * Rendering+ RenderOptions (..),+ defaultRenderOptions,+ printDoc,+ )+where++import Data.Text (Text)+import Tilia.Doc.Internal+ ( Doc,+ RenderOptions (..),+ defaultRenderOptions,+ render,+ )++-- | Render a document to source text.+printDoc :: RenderOptions -> Doc -> Text+printDoc = render
+ src/Tilia/Doc/Body.hs view
@@ -0,0 +1,24 @@+-- | Constructs that can stand as the body of an enclosing one.+module Tilia.Doc.Body+ ( Body (..),+ attachBody,+ )+where++import Tilia.Doc.Combinators++-- | Something that can appear as the body of an enclosing construct.+class Body a where+ -- | Print it.+ printBody :: a -> Doc++ -- | Whether it absorbs its own line break.+ bodyPlacement :: a -> Placement++-- | Print a body and join it to whatever precedes it.+--+-- This is the whole of what an enclosing construct needs, which is why it+-- is worth having: a caller that reaches for 'printBody' and+-- 'bodyPlacement' separately is about to reimplement it.+attachBody :: (Body a) => a -> Doc+attachBody x = attach (bodyPlacement x) (printBody x)
+ src/Tilia/Doc/Combinators.hs view
@@ -0,0 +1,447 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | The vocabulary for writing printing code.+module Tilia.Doc.Combinators+ ( -- * Documents+ Doc,++ -- * Atoms+ txt,+ space,+ breakOrSpace,+ breakOrNothing,+ hardBreak,+ blankLine,+ Resume (..),+ verbatimBreak,+ verbatim,+ emptyAnchor,++ -- * Layout+ Layout (..),+ group,+ flat,+ broken,+ variant,+ located,+ fence,+ cppChoice,++ -- * Attachment+ Placement (..),+ attach,+ hangingIfSingleLine,++ -- * Indentation+ nest,+ indent,+ align,++ -- * Combining+ hsep,+ vsep,+ sepBy,+ joinedBy,+ punctuate,++ -- * Wrapping+ ClosingIndent (..),+ bracket,+ parens,+ parensWith,+ brackets,+ bracketsWith,+ braces,+ bananaWith,+ unboxed,+ unboxedWith,+ backticks,++ -- * Punctuation+ comma,+ commaSep,+ semi,++ -- * Conditionals+ includeWhen,+ includeUnless,+ )+where++import Data.List (intersperse)+import Data.Text (Text)+import Data.Text qualified as T+import Tilia.Doc.Internal+ ( Doc (..),+ Layout (..),+ Resume (..),+ groupLayout,+ )+import Tilia.Span (Span, isSingleLine)++----------------------------------------------------------------------------+-- Atoms++-- | A literal fragment of output.+--+-- The argument must not contain a line break; use 'hardBreak'. This is for+-- keywords, punctuation and names—anything whose spelling is fixed.+txt :: Text -> Doc+txt = DText++-- | A space. Repeated spaces collapse and a space before a line break is+-- dropped.+space :: Doc+space = DSpace++-- | A place the line may break. It becomes a line break if the enclosing+-- 'group' is broken, and a space if it is flat. This is the workhorse: it+-- is what lets one printer serve both layouts.+breakOrSpace :: Doc+breakOrSpace = DBreak++-- | A place the line may break, leaving nothing behind if it does not. For+-- the positions where the two layouts differ by a break rather than by a+-- space, such as immediately inside a bracket.+breakOrNothing :: Doc+breakOrNothing = DSoftBreak++-- | A line break, whatever the enclosing group decided.+hardBreak :: Doc+hardBreak = DHardBreak++-- | An empty line.+blankLine :: Doc+blankLine = hardBreak <> hardBreak++-- | A line break between two lines of text that is being reproduced.+--+-- Only for text that is being reproduced rather than laid out: the lines of+-- a block comment, of a multi-line string literal, of a quasi-quotation.+-- Unlike every other break this one collapses nothing, because an empty line+-- among those is the author's and not spacing.+verbatimBreak :: Resume -> Doc+verbatimBreak = DVerbatimBreak++-- | Text reproduced exactly, line breaks and all.+verbatim :: Text -> Doc+verbatim = sepBy (verbatimBreak AtMargin) . map txt . T.splitOn "\n"++-- | An anchor for a construct that contains nothing.+emptyAnchor :: Span -> Doc+emptyAnchor s = located s mempty++----------------------------------------------------------------------------+-- Layout++-- | Lay the document out as the input had it: flat if the construct was+-- written on one line, broken if it was spread across several.+group :: Span -> Doc -> Doc+group s = DGroup (groupLayout (Just s))++-- | Force flat layout.+flat :: Doc -> Doc+flat = DGroup Flat++-- | Force broken layout.+broken :: Doc -> Doc+broken = DGroup Broken++-- | Choose according to the layout the enclosing 'group' settled on.+--+-- Reach for this only when the two layouts differ by more than where the+-- breaks fall; when they differ only in that, 'breakOrSpace' and+-- 'breakOrNothing' already say so and read better.+variant ::+ -- | When flat+ Doc ->+ -- | When broken+ Doc ->+ Doc+variant = DVariant++-- | Record where the output is coming from in the input.+--+-- This has no effect on layout. It is provenance, kept so that later+-- passes—comment attachment above all—can ask which region of the input a+-- piece of the document corresponds to.+located :: Span -> Doc -> Doc+located = DLocated++-- | Fence prevents comments inside from floating out and attaching to+-- elements they are not supposed to attach to.+fence :: Span -> Doc -> Doc+fence = DFence++-- | Alternatives the preprocessor chooses between.+cppChoice ::+ -- | One alternative per directive, each directive as written after its+ -- hash+ [(Text, Doc)] ->+ -- | What holds when none of them applies+ Doc ->+ Doc+cppChoice branches fallback+ | all (silent . snd) branches && silent fallback = DEmpty+ | otherwise = DCppChoice branches (if silent fallback then DEmpty else fallback)++-- | Does this document put nothing at all on the page?+silent :: Doc -> Bool+silent = \case+ DEmpty -> True+ DCat a b -> silent a && silent b+ DNest _ d -> silent d+ DAlign d -> silent d+ DGroup _ d -> silent d+ DLocated _ d -> silent d+ DFence _ d -> silent d+ DVariant flatD brokenD -> silent flatD && silent brokenD+ _ -> False++----------------------------------------------------------------------------+-- Attachment++-- | Whether a construct absorbs its own line break.+data Placement+ = -- | The preceding construct breaks and indents.+ Normal+ | -- | The construct is handed the rest of the line and breaks itself.+ Hanging+ deriving (Eq, Show)++-- | Join a body to whatever precedes it, according to its 'Placement'.+attach :: Placement -> Doc -> Doc+attach Hanging body = space <> body+attach Normal body = breakOrSpace <> indent body++-- | 'Hanging' if the span was a single line in the input, 'Normal'+-- otherwise.+--+-- A handful of constructs hang only when what comes before their own break+-- was written on one line—a lambda whose parameters ran on, for instance,+-- would leave the body indented under nothing legible. Those constructs+-- consult the input, exactly as 'group' does, and this is the shared+-- spelling of that question so that it reads as policy rather than as a+-- special case repeated in each classifier.+hangingIfSingleLine :: Span -> Placement+hangingIfSingleLine s = if isSingleLine s then Hanging else Normal++----------------------------------------------------------------------------+-- Indentation++-- | Indent by the given number of steps, relative to the current level.+nest :: Int -> Doc -> Doc+nest = DNest++-- | Indent by one step.+indent :: Doc -> Doc+indent = DNest 1++-- | Indent to the column the line has already reached, so that a broken+-- construct lines up under its own beginning rather than under the start of+-- the line.+align :: Doc -> Doc+align = DAlign++----------------------------------------------------------------------------+-- Combining++-- | Concatenate, separated by 'space'.+hsep :: [Doc] -> Doc+hsep = sepBy space++-- | Concatenate, separated by 'hardBreak'.+vsep :: [Doc] -> Doc+vsep = sepBy hardBreak++-- | Concatenate, separated by the given document.+sepBy :: Doc -> [Doc] -> Doc+sepBy s = mconcat . intersperse s++-- | The token that joins two parts of a construct: a space, the token, and+-- then the place the line may break.+joinedBy :: Text -> Doc+joinedBy t = space <> txt t <> breakOrSpace++-- | Append the separator to every element but the last.+--+-- For the cases where the separator has to travel with the element rather+-- than sit between elements, such as a trailing comma that must stay on the+-- line above a break.+punctuate :: Doc -> [Doc] -> [Doc]+punctuate _ [] = []+punctuate _ [x] = [x]+punctuate s (x : xs) = (x <> s) : punctuate s xs++----------------------------------------------------------------------------+-- 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.+ Outdented+ | -- | Kept one step in.+ Indented+ deriving (Eq, Show)++-- | Surround with a bracket pair that opens up when broken.+--+-- Flat, this is @open body close@ with nothing added. Broken, the opening+-- bracket keeps the first line of the body company and the rest of the body+-- lines up under it, with the closing bracket alone on the last line:+--+-- > ( first,+-- > second+-- > )+bracket ::+ -- | Opening bracket+ Text ->+ -- | Closing bracket+ Text ->+ -- | Body+ Doc ->+ Doc+bracket = bracketWith Outdented++-- | 'bracket', with a say in where the closing bracket goes.+bracketWith ::+ -- | Where the closing bracket goes+ ClosingIndent ->+ -- | Opening bracket+ Text ->+ -- | Closing bracket+ Text ->+ -- | Body+ Doc ->+ Doc+bracketWith closing open close body =+ -- The pair is aligned as a whole so that the closing bracket comes back+ -- out to the column the opening one is on, wherever on its line that was.+ align $+ txt open+ <> variant body (space <> align body <> hardBreak)+ <> nest (closingSteps closing) (txt close)++-- | Surround with a bracket pair whose brackets are held off the body.+--+-- For the brackets that are more than one character wide—@(#@, @(|@—where+-- running the body up against them makes both harder to pick out, and where+-- an operator beginning with @#@ would lex as part of the bracket. Broken,+-- the body goes on its own indented lines.+spacedBracket ::+ -- | Where the closing bracket goes+ ClosingIndent ->+ -- | Opening bracket+ Text ->+ -- | Closing bracket+ Text ->+ -- | Body+ Doc ->+ Doc+spacedBracket closing open close body =+ align $+ txt open+ <> variant (space <> body <> space) (hardBreak <> indent body <> hardBreak)+ <> nest (closingSteps closing) (txt close)++closingSteps :: ClosingIndent -> Int+closingSteps = \case+ Outdented -> 0+ Indented -> 1++-- | @(@ and @)@.+parens :: Doc -> Doc+parens = bracket "(" ")"++-- | @(@ and @)@, with a say in where the closing bracket goes.+parensWith ::+ -- | Where the closing parenthesis goes+ ClosingIndent ->+ -- | Body+ Doc ->+ Doc+parensWith closing = bracketWith closing "(" ")"++-- | @[@ and @]@.+brackets :: Doc -> Doc+brackets = bracket "[" "]"++-- | @[@ and @]@, with a say in where the closing bracket goes.+bracketsWith ::+ -- | Where the closing bracket goes+ ClosingIndent ->+ -- | Body+ Doc ->+ Doc+bracketsWith closing = bracketWith closing "[" "]"++-- | @{@ and @}@.+braces :: Doc -> Doc+braces = bracket "{" "}"++-- | @(|@ and @|)@, from arrow notation, with a say in where the closing+-- bracket goes.+bananaWith ::+ -- | Where the closing banana goes+ ClosingIndent ->+ -- | Body+ Doc ->+ Doc+bananaWith closing = spacedBracket closing "(|" "|)"++-- | @(#@ and @#)@, for unboxed tuples and sums.+unboxed :: Doc -> Doc+unboxed = unboxedWith Outdented++-- | @(#@ and @#)@, with a say in where the closing bracket goes.+unboxedWith ::+ -- | Where the closing bracket goes+ ClosingIndent ->+ -- | Body+ Doc ->+ Doc+unboxedWith closing = spacedBracket closing "(#" "#)"++-- | Surround with backticks.+backticks :: Doc -> Doc+backticks = enclose (txt "`") (txt "`")++----------------------------------------------------------------------------+-- Punctuation++-- | @,@.+comma :: Doc+comma = txt ","++-- | @;@.+semi :: Doc+semi = txt ";"++-- | Separate by a comma and a 'breakOrSpace', so that a broken list puts each+-- element on its own line with the comma left behind on the one above.+commaSep :: [Doc] -> Doc+commaSep = sepBy (comma <> breakOrSpace)++----------------------------------------------------------------------------+-- Conditionals++-- | The document if the condition holds, nothing otherwise.+includeWhen :: Bool -> Doc -> Doc+includeWhen b d = if b then d else mempty++-- | The document unless the condition holds.+includeUnless :: Bool -> Doc -> Doc+includeUnless b = includeWhen (not b)
+ src/Tilia/Doc/Internal.hs view
@@ -0,0 +1,478 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | The document representation and the engine that turns it into text.+--+-- Printing code should not import this module; import+-- "Tilia.Doc.Combinators" instead, which exposes 'Doc' abstractly along+-- with the vocabulary for building one. What needs the constructors is the+-- engine below, the passes that walk a finished document rather than build+-- one — comment attachment in "Tilia.Comments.Attach", and the merge in+-- "Tilia.Cpp", which takes the documents of several configurations apart and+-- puts one back together — and tests that look inside a document.+-- Those three take a document apart rather than build one, which is the+-- thing the vocabulary cannot express.+--+-- The printer is split in two halves that meet at 'Doc'. Code that walks+-- the syntax tree builds a 'Doc', which is an ordinary immutable value with+-- no notion of columns, indentation or what has already been written. The+-- engine in this module is the only thing that knows about those, and it+-- learns them by walking the finished document. Nothing in the first half+-- can observe the second, which is what keeps printing code from having to+-- reason about emission order.+module Tilia.Doc.Internal+ ( -- * Documents+ Doc (..),+ Layout (..),+ Resume (..),+ groupLayout,++ -- * Rendering+ RenderOptions (..),+ defaultRenderOptions,+ render,+ )+where++import Data.Maybe (listToMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Tilia.Span (Span, isSingleLine)++----------------------------------------------------------------------------+-- Documents++-- | A description of what to print.+data Doc+ = -- | Print nothing.+ DEmpty+ | -- | A literal fragment. Must not contain a line break: the engine+ -- tracks columns by counting characters, and an embedded newline would+ -- make that count wrong. Use 'DHardBreak'.+ DText !Text+ | -- | A space. Repeats collapse, and one at the end of a line is dropped,+ -- so printing code may emit them freely rather than working out whether+ -- one is already there.+ DSpace+ | -- | A space when the enclosing group is flat, a line break when it is+ -- broken.+ DBreak+ | -- | Nothing when the enclosing group is flat, a line break when it is+ -- broken.+ DSoftBreak+ | -- | A line break regardless of the enclosing group.+ --+ -- Two in a row leave one empty line between what surrounds them, which+ -- is all a blank line is; there is deliberately no separate constructor+ -- for one. Further breaks add nothing.+ DHardBreak+ | -- | Text to be put at the end of the line this position falls on,+ -- however much of the line is still to be written.+ --+ -- For a comment the author wrote at the end of a line. Where it belongs+ -- is not a position in the document but a position in the /output/: it+ -- has to come after everything else on its line, including punctuation+ -- the printer has not emitted yet. Putting it in the document where the+ -- node it trails happens to sit would push a comma, an arrow or a+ -- closing bracket onto the next line.+ --+ -- One line holds one of these at its end. A second means two comments+ -- trailing what turned out to be a single line of output, and it goes on+ -- a line of its own underneath rather than being run together with the+ -- first into a comment neither author wrote.+ DHoldBack !Text+ | -- | Close the line, and let a break that immediately follows know that+ -- it has nothing left to do.+ --+ -- A comment owns the rest of its line, so something has to end that+ -- line; but whatever the comment was attached to very often ends it+ -- too, and two breaks in a row are a blank line. This is the break that+ -- says \"the line is finished\" rather than \"break here\", so the two+ -- do not add up to an empty line nobody asked for.+ DCloseLine+ | -- | A line break between two lines of text that is being reproduced+ -- rather than laid out.+ --+ -- Collapsing nothing and skipping nothing, unlike every other break+ -- here: the lines either side are the author's, so an empty one among+ -- them is content and not spacing. Where the next line begins is the+ -- only thing left to decide, and 'Resume' decides it.+ DVerbatimBreak !Resume+ | -- | Concatenation. See the 'Semigroup' instance.+ DCat !Doc !Doc+ | -- | Indent the enclosed document by the given number of steps, relative+ -- to the current indentation.+ DNest !Int !Doc+ | -- | Indent the enclosed document to whatever column the line has+ -- reached, so that it lines up under itself when broken.+ DAlign !Doc+ | -- | Lay the enclosed document out flat or broken.+ --+ -- The decision is already made by the time it reaches the engine.+ -- 'groupLayout' is what makes it, from the span the construct occupied+ -- in the input, and it lives in the combinator layer's vocabulary+ -- rather than here so that the engine has no policy in it at all.+ DGroup !Layout !Doc+ | -- | Choose between two documents according to the enclosing group: the+ -- first when it is flat, the second when it is broken. For the+ -- constructs whose two layouts differ by more than where the breaks+ -- fall.+ --+ -- Both fields are lazy, and that is not an oversight. The engine walks+ -- one of them and never looks at the other, so the branch not taken+ -- should cost nothing. Were they strict, building a variant would build+ -- both layouts of everything inside it; a construct nested @n@ deep+ -- would be built @2^n@ times.+ DVariant Doc Doc+ | -- | Record that the enclosed document was produced from the given+ -- region of the input.+ --+ -- This carries no layout meaning at all and the engine ignores it.+ -- Keeping provenance separate from grouping is deliberate: the two+ -- coincide often, but a construct can need one without the other, and+ -- fusing them is what forces a printer to grow an escape hatch for each+ -- case where they come apart.+ DLocated !Span !Doc+ | -- | Fence prevents comments inside from floating out and attaching to+ -- elements they are not supposed to attach to.+ DFence !Span !Doc+ | -- | Alternatives the preprocessor chooses between, and the condition it+ -- chooses on.+ DCppChoice ![(Text, Doc)] !Doc+ | -- | A preprocessor line that is not a conditional, reproduced, and the+ -- region of the input it was written in.+ --+ -- The span is included so that two directives can be told apart.+ DCppDirective !Span !Text+ deriving (Eq, Show)++-- | Documents concatenate. @'DEmpty'@ is the unit, so a document is a+-- monoid and printing code can use @'mconcat'@, @'foldMap'@ and the rest of+-- the ordinary vocabulary instead of a bespoke sequencing operator.+instance Semigroup Doc where+ DEmpty <> b = b+ a <> DEmpty = a+ a <> b = DCat a b++instance Monoid Doc where+ mempty = DEmpty++-- | Whether a group is laid out on one line or across several.+data Layout+ = Flat+ | Broken+ deriving (Eq, Show)++-- | Where the line after a 'DVerbatimBreak' begins.+data Resume+ = -- | At the indentation in force, as any other break would.+ AtIndent+ | -- | At column zero, whatever the indentation.+ AtMargin+ deriving (Eq, Show)++-- | Decide how to lay a group out.+--+-- This is the whole of the policy, in one place on purpose. Layout follows+-- the input: a construct written on one line stays on one line, and one+-- that was spread out stays spread out. A group with no span is one the+-- printer synthesised rather than read, and has nothing to follow, so it+-- goes flat.+--+-- Notably absent is any notion of a maximum line width. Nothing in the+-- engine measures the result against a limit, so a long line that was+-- written as one line is reproduced as one line.+groupLayout :: Maybe Span -> Layout+groupLayout = \case+ Nothing -> Flat+ Just s+ | isSingleLine s -> Flat+ | otherwise -> Broken++----------------------------------------------------------------------------+-- Rendering++-- | Knobs for 'render'.+newtype RenderOptions = RenderOptions+ { -- | Columns per indentation step.+ roIndentStep :: Int+ }+ deriving (Eq, Show)++-- | Two columns per step.+defaultRenderOptions :: RenderOptions+defaultRenderOptions = RenderOptions {roIndentStep = 2}++-- | What the engine carries while walking a document.+--+-- Indentation and layout flow downwards and are restored on the way out, so+-- they are passed as arguments. Everything else is output being+-- accumulated.+data Env = Env+ { envIndent :: !Int,+ envLayout :: !Layout,+ envIndentStep :: !Int+ }++-- | Output built so far.+--+-- Lines are finished one at a time and never revisited, so the current line+-- is kept as a reversed list of fragments and completed lines as a reversed+-- list of lines.+data Out = Out+ { -- | Completed lines, most recent first.+ outLines :: [Text],+ -- | Fragments of the line being built, most recent first.+ outCurrent :: [Text],+ -- | Column the current line has reached.+ outColumn :: !Int,+ -- | Whether anything has been written to the current line. Indentation+ -- is emitted lazily, when the first fragment arrives, so that a line+ -- with nothing on it stays genuinely empty.+ outStarted :: !Bool,+ -- | Fragments held back until the line ends, in the order they were+ -- given. The first goes at the end of the line; any after it get lines+ -- of their own under it, since two comments run together would be one+ -- comment neither author wrote.+ outHeldBack :: ![Text],+ -- | Whether the line was closed by something that already knew it was+ -- ending it, so that a break arriving now would add an empty line rather+ -- than end anything.+ outClosed :: !Bool+ }++emptyOut :: Out+emptyOut =+ Out+ { outLines = [],+ outCurrent = [],+ outColumn = 0,+ outStarted = False,+ outHeldBack = [],+ outClosed = False+ }++-- | Turn a document into text.+render :: RenderOptions -> Doc -> Text+render opts doc = finish (go env doc emptyOut)+ where+ env =+ Env+ { envIndent = 0,+ envLayout = Broken,+ envIndentStep = roIndentStep opts+ }++-- | Walk a document, accumulating output.+go :: Env -> Doc -> Out -> Out+go env = \case+ DEmpty -> id+ DText t -> putText (envIndent env) t+ DSpace -> putSpace+ DBreak -> case envLayout env of+ Flat -> putSpace+ Broken -> breakLine (envIndent env)+ DSoftBreak -> case envLayout env of+ Flat -> id+ Broken -> breakLine (envIndent env)+ DHoldBack t -> putHeldBack (envIndent env) t+ DCloseLine -> closeLine (envIndent env)+ DHardBreak -> breakLine (envIndent env)+ DVerbatimBreak resume -> verbatimBreakLine resume+ DCat a b -> go env b . go env a+ DNest n d -> go env {envIndent = envIndent env + n * envIndentStep env} d+ DAlign d -> \out ->+ go env {envIndent = max (envIndent env) (outColumn out)} d out+ DGroup l d -> go env {envLayout = l} d+ DVariant flatD brokenD -> case envLayout env of+ Flat -> go env flatD+ Broken -> go env brokenD+ DLocated _ d -> go env d+ DFence _ d -> go env d+ DCppChoice branches fallback ->+ foldr (flip (.)) id . concat $+ [ [atMargin ("#" <> guard'), go env taken]+ | (guard', taken) <- branches+ ]+ <> [[atMargin "#else", go env fallback] | fallback /= DEmpty]+ <> [[atMargin "#endif"]]+ DCppDirective _ t -> atMargin ("#" <> t)++-- | Put a line of text at the margin, on a line of its own.+--+-- A preprocessor directive is not part of the program's layout and does not+-- take its indentation: it begins where the line begins, whatever is in+-- force around it. The line before it is closed only if anything was+-- written to it, so a directive following something that already ended its+-- line does not leave an empty one behind.+atMargin :: Text -> Out -> Out+atMargin t = closeLine 0 . putText 0 t . closeLine 0++-- | Append a fragment, emitting the line's indentation first if this is the+-- first thing on it.+putText :: Int -> Text -> Out -> Out+putText indent t out0+ | T.null t = out0+ | outStarted out =+ out+ { outCurrent = t : outCurrent out,+ outColumn = outColumn out + T.length t+ }+ | otherwise =+ out+ { outCurrent = [t, T.replicate indent " "],+ outColumn = indent + T.length t,+ outStarted = True+ }+ where+ out = out0 {outClosed = False}++-- | Hold a fragment back until the line ends.+putHeldBack :: Int -> Text -> Out -> Out+putHeldBack indent t out+ | outStarted out || not (null (outHeldBack out)) =+ out {outHeldBack = outHeldBack out <> [t], outClosed = False}+ | otherwise = closeLine indent (putText indent t out)++-- | Append a space, unless the line has not started or already ends in one.+putSpace :: Out -> Out+putSpace out+ | not (outStarted out) = out+ | endsWithSpace out = out+ | otherwise =+ out+ { outCurrent = " " : outCurrent out,+ outColumn = outColumn out + 1+ }++endsWithSpace :: Out -> Bool+endsWithSpace out = case outCurrent out of+ (t : _) -> maybe False ((== ' ') . snd) (T.unsnoc t)+ [] -> False++-- | Close the current line, if there is anything on it.+--+-- Unlike 'breakLine' this leaves a mark: the next break sees that the line+-- was already ended on purpose and does nothing, so a comment that ends its+-- own line and a construct that would have ended it anyway do not between+-- them leave an empty one.+closeLine ::+ -- | Where the line after this one begins+ Int ->+ Out ->+ Out+closeLine indent out+ | hasContent out = (breakLine indent out) {outClosed = True}+ | otherwise = out++-- | Finish the current line.+--+-- Two breaks in a row leave one empty line between the text either side of+-- them, which is a blank line the author asked for. Further breaks add+-- nothing: the output never carries two blank lines in a row, however many+-- times printing code breaks. Breaking before anything has been written is+-- dropped for the same reason, since 'finish' strips empty lines only from+-- the end. Nor is an empty line written at the top of a block, where there+-- is nothing above it to be held off.+--+-- Between them these rules mean printing code may break wherever a break+-- might be wanted without first working out what it already emitted.+breakLine ::+ -- | Where the line after this one begins+ Int ->+ Out ->+ Out+breakLine indent out+ | outClosed out = out {outClosed = False}+ | atStart out = out+ | not (hasContent out), repeatsBlank out || opensABlock indent out = discarded+ | otherwise = discarded {outLines = overflow indent out <> outLines out}+ where+ discarded =+ out {outCurrent = [], outColumn = 0, outStarted = False, outHeldBack = []}++-- | Every line the break that has just happened produces.+--+-- Usually one: the line that was being built. There are more when several+-- fragments were held back for it, because only the first of them can go at+-- its end and the rest need lines of their own. Held-back fragments are+-- always comments, so several mean several comments that trailed different+-- things in the input which have turned out to share a line of output; run+-- together they would read as one comment nobody wrote, so each of the+-- others gets a line below.+--+-- Held back until here rather than written when it arrived, because the+-- line was not finished then. A comma or a closing bracket still to come+-- would have been pushed underneath the comment.+--+-- Ordered as 'outLines' is, most recent first, ready to be put in front+-- of it.+overflow ::+ -- | Where the line after these would begin, used only if there is no line+ -- to take the indentation from+ Int ->+ Out ->+ [Text]+overflow indent out = reverse (finished : map below spilled)+ where+ finished = currentLine out+ spilled = drop 1 (outHeldBack out)++ -- Indented to match the line they spilled from rather than to the+ -- indentation in force, so that they stay under the thing they were+ -- written against instead of under whatever encloses it.+ below t = T.replicate column " " <> T.stripEnd t+ column+ | T.null finished = indent+ | otherwise = T.length (T.takeWhile (== ' ') finished)++-- | Would an empty line here be the first thing inside a block?+opensABlock :: Int -> Out -> Bool+opensABlock indent out = case outLines out of+ (l : _) -> T.length l <= indent+ [] -> False++-- | Finish the current line between two lines of reproduced text.+verbatimBreakLine :: Resume -> Out -> Out+verbatimBreakLine resume out =+ out+ { outLines = overflow 0 out <> outLines out,+ outCurrent = [],+ outColumn = 0,+ outStarted = resume == AtMargin,+ outHeldBack = [],+ outClosed = False+ }++-- | Would this empty line be a second one in a row?+repeatsBlank :: Out -> Bool+repeatsBlank out = case outLines out of+ ("" : _) -> True+ _ -> False++-- | Is the output still empty?+atStart :: Out -> Bool+atStart out = null (outLines out) && not (hasContent out)++-- | Is there anything on the current line, written or held back?+hasContent :: Out -> Bool+hasContent out = outStarted out || not (null (outHeldBack out))++-- | The current line: what was written to it, then whatever was held back+-- for its end, with one space between them and no trailing whitespace.+currentLine :: Out -> Text+currentLine out+ | T.null written = heldBack+ | T.null heldBack = written+ | otherwise = written <> " " <> heldBack+ where+ written = T.stripEnd (T.concat (reverse (outCurrent out)))+ heldBack = maybe "" T.stripEnd (listToMaybe (outHeldBack out))++-- | Assemble the final text: one trailing newline, no blank lines at the+-- end, no trailing whitespace anywhere.+finish :: Out -> Text+finish out =+ case dropWhile T.null (outLines (breakLine 0 out)) of+ [] -> ""+ ls -> T.unlines (reverse ls)
+ src/Tilia/Equivalence.hs view
@@ -0,0 +1,675 @@+{-# 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+ ( syntaxDifference,+ commentDifference,+ )+where++import Control.Applicative ((<|>))+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Choice (pattern Is)+import Data.Data+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)+import Data.List (sortOn)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (catMaybes, isNothing, listToMaybe, mapMaybe)+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Data.FastString (FastString)+import GHC.Hs (HsModule (..), XModulePs (..))+import GHC.Hs.Decls (DerivClauseTys (..), DocDecl (..), HsDecl (..), LHsDecl)+import GHC.Hs.Doc (LHsDoc, WithHsDocIdentifiers (..))+import GHC.Hs.DocString+ ( HsDocString (..),+ HsDocStringChunk (..),+ HsDocStringDecorator (..),+ )+import GHC.Hs.Expr (HsExpr (..), LHsExpr)+import GHC.Hs.Extension (GhcPs)+import GHC.Hs.ImpExp+ ( IE (..),+ ImportDeclQualifiedStyle,+ LIE,+ LImportDecl,+ isImportDeclQualified,+ )+import GHC.Hs.Type (HsType (..), LHsContext, LHsSigType)+import GHC.Types.Name (Name)+import GHC.Types.Name.Occurrence (OccName)+import GHC.Types.SrcLoc (unLoc)+import GHC.Unit.Types (Unit)+import Language.Haskell.Syntax.Extension (XRec)+import Language.Haskell.Syntax.Module.Name (ModuleName)+import System.IO.Unsafe (unsafePerformIO)+import Tilia.Comments+ ( Comment (..),+ CommentStyle (..),+ Pragma (..),+ commentPragma,+ commentTrailing,+ escapeTrigger,+ triggerEscaped,+ )+import Tilia.Imports (normalizeImports)+import Tilia.Span (Span (..))+import Tilia.Span.Ghc (spanOf, spansOf)++----------------------------------------------------------------------------+-- Syntax++-- | Where two fragments of syntax stop saying the same thing.+--+-- Everything is compared but the annotations, which is what makes this a+-- question about the program rather than about its layout: a span, a+-- token's position and the comments hung off a node all change when the+-- module is reformatted, and are supposed to.+--+-- 'Nothing' when they agree. Otherwise the constructors on the way down to+-- the first disagreement, ending in what the two sides had there. A bare+-- \"these differ\" is no use against ten thousand files: what makes a+-- corpus worth running is being able to see that six hundred failures are+-- four causes.+syntaxDifference :: (Data a) => a -> a -> Maybe Text+syntaxDifference = differ []++-- | The constructors on the way down to where the walk has got to,+-- innermost first.+--+-- Innermost first because it is built by consing. The walk visits some+-- millions of nodes for every one it reports on, and appending to the end of+-- a list that grows with the depth — at every node, packing a constructor's+-- name into 'Text' to do it — was a large part of what a comparison cost.+-- 'describe' puts it back in reading order, and only for a difference that+-- is really being reported.+type Path = [Constr]++differ :: forall a. (Data a) => Path -> a -> a -> Maybe Text+differ path x y = case classify (typeOf x) of+ Incidental -> Nothing+ Special+ | Just outcome <- asStandaloneDoc path x y -> outcome+ | Just outcome <- asExportItems path x y -> outcome+ | Just outcome <- asDeclarations path x y -> outcome+ | Just outcome <- asDerivingClause path x y -> outcome+ | Just outcome <- asQualifiedStyle path x y -> outcome+ | Just outcome <- asDocString path x y -> outcome+ | Just outcome <- asContext path x y -> outcome+ | Just outcome <- asImports path x y -> outcome+ | otherwise -> structurally+ Ordinary -> structurally+ where+ structurally = case dataTypeRep (dataTypeOf x) of+ AlgRep _+ | toConstr x /= toConstr y -> Just disagreement+ | settledByConstructor (toConstr x) -> Nothing+ | otherwise ->+ firstOf+ ( zipWith+ (cellDiffer (toConstr x : path))+ (gmapQ Cell x)+ (gmapQ Cell y)+ )+ NoRep+ | opaque x y -> Nothing+ | otherwise ->+ Just (describe path (T.pack (typeNameOf x) <> " changed"))+ _+ | toConstr x == toConstr y -> Nothing+ | otherwise -> Just disagreement++ disagreement =+ describe path (named (toConstr x) <> " became " <> named (toConstr y))++-- | What is known about a type before either value of it is looked at.+data Verdict+ = -- | Records only how or where something was written. See 'incidental'.+ Incidental+ | -- | One of the types the @as…@ functions below compare by hand.+ Special+ | -- | Compared by its constructor and then field by field.+ Ordinary++-- | Which of the three a type is, worked out once.+--+-- Worth memoising rather than recomputing: 'incidental' is string+-- manipulation over a type's module and name, and the question is asked at+-- every node of every configuration of every module. There are a few+-- hundred types in a parse tree and tens of millions of nodes.+--+-- The cache races harmlessly. A reader that misses an entry another thread+-- has just written recomputes a pure function of the key and writes the+-- same answer.+classify :: TypeRep -> Verdict+classify rep = unsafePerformIO $ do+ known <- readIORef classified+ case Map.lookup rep known of+ Just verdict -> pure verdict+ Nothing -> do+ let verdict = worked+ atomicModifyIORef' classified (\m -> (Map.insert rep verdict m, ()))+ pure verdict+ where+ worked+ | incidental rep = Incidental+ | rep `Set.member` spokenFor = Special+ | otherwise = Ordinary++classified :: IORef (Map TypeRep Verdict)+classified = unsafePerformIO (newIORef Map.empty)+{-# NOINLINE classified #-}++-- | The types compared by hand, which is to say the ones the @as…@ chain in+-- 'differ' can match.+--+-- Kept beside that chain and in the same order. A type here with nothing to+-- match it costs one failed run down the chain; a type in the chain and not+-- here is never reached at all, which is why the corpora are what says this+-- list is right.+spokenFor :: Set TypeRep+spokenFor =+ Set.fromList+ [ typeRep (Proxy @(Maybe (LHsDoc GhcPs))),+ typeRep (Proxy @[LIE GhcPs]),+ typeRep (Proxy @[LHsDecl GhcPs]),+ typeRep (Proxy @(DerivClauseTys GhcPs)),+ typeRep (Proxy @ImportDeclQualifiedStyle),+ typeRep (Proxy @HsDocString),+ typeRep (Proxy @(Maybe (LHsContext GhcPs))),+ typeRep (Proxy @(LHsContext GhcPs)),+ typeRep (Proxy @(XRec GhcPs [LHsExpr GhcPs])),+ typeRep (Proxy @[LImportDecl GhcPs])+ ]++-- | Constructors whose fields say only how they were written.+--+-- @HsStarTy@ carries a flag for whether the @*@ was typed as @★@. Both are+-- the same kind; which one the author reached for is spelling.+settledByConstructor :: Constr -> Bool+settledByConstructor c = showConstr c == "HsStarTy"++named :: Constr -> Text+named = T.pack . showConstr++-- | The tail of the path, and what was found at the end of it.+describe :: Path -> Text -> Text+describe path leaf =+ T.intercalate " > " (map named (reverse (take 5 path)) <> [leaf])++firstOf :: [Maybe a] -> Maybe a+firstOf = listToMaybe . catMaybes++-- | One field of a value, with its type hidden.+data Cell = forall d. (Data d) => Cell d++cellDiffer :: Path -> Cell -> Cell -> Maybe Text+cellDiffer path (Cell a) (Cell b) = case cast b of+ Just b' -> differ path a b'+ Nothing -> Just (describe path "fields of different types")++-- | Two lists compared one element at a time.+--+-- Handed back to 'differ' whole they would arrive at the same @as…@ function+-- again and never stop, which is why the lengths are settled here and only+-- the elements go back round.+elementwise :: (Data b) => Path -> Text -> [b] -> [b] -> Maybe Text+elementwise path what before after+ | length before /= length after = Just (describe path what)+ | otherwise = firstOf (zipWith (differ path) before after)++-- | Does this documentation comment say anything?+saysNothing :: HsDocString -> Bool+saysNothing = null . docWords++-- | A documentation comment with no words in it is no comment at all.+--+-- @-- |@ on a line of its own attaches an empty doc string to whatever+-- follows, and the formatter drops it, which is not a change to what the+-- module says.+--+-- This and the two below were a pass over both trees with @everywhere@+-- before the comparison started. That rebuilt two whole parse trees per+-- configuration in order to remove a handful of nodes from each; done here,+-- the same normalisation costs nothing until the walk arrives at one.+asStandaloneDoc :: (Data a) => Path -> a -> a -> Maybe (Maybe Text)+asStandaloneDoc path x y = case (cast x, cast y) of+ (Just before, Just after) -> Just (compared (kept before) (kept after))+ _ -> Nothing+ where+ kept :: Maybe (LHsDoc GhcPs) -> Maybe (LHsDoc GhcPs)+ kept d = if any (saysNothing . hsDocString . unLoc) d then Nothing else d++ compared before after = case (before, after) of+ (Nothing, Nothing) -> Nothing+ (Just b, Just a) -> differ (toConstr before : path) b a+ _ ->+ Just+ ( describe+ path+ (named (toConstr before) <> " became " <> named (toConstr after))+ )++-- | An export list, minus the documentation that says nothing.+asExportItems :: (Data a) => Path -> a -> a -> Maybe (Maybe Text)+asExportItems path x y = case (cast x, cast y) of+ (Just before, Just after) ->+ Just (elementwise path "the module exports a different list" (kept before) (kept after))+ _ -> Nothing+ where+ kept :: [LIE GhcPs] -> [LIE GhcPs]+ kept = filter (not . emptyExport . unLoc)+ emptyExport = \case+ IEDoc _ doc -> saysNothing (hsDocString (unLoc doc))+ _ -> False++-- | A block of declarations, minus the documentation that says nothing.+asDeclarations :: (Data a) => Path -> a -> a -> Maybe (Maybe Text)+asDeclarations path x y = case (cast x, cast y) of+ (Just before, Just after) ->+ Just (elementwise path "a different number of declarations" (kept before) (kept after))+ _ -> Nothing+ where+ kept :: [LHsDecl GhcPs] -> [LHsDecl GhcPs]+ kept = filter (not . emptyDecl . unLoc)+ emptyDecl = \case+ DocD _ d -> case d of+ DocCommentNext doc -> saysNothing (hsDocString (unLoc doc))+ DocCommentPrev doc -> saysNothing (hsDocString (unLoc doc))+ _ -> False+ _ -> False++-- | Does this type record only how or where something was written?+incidental :: TypeRep -> Bool+incidental rep = case splitTyConApp rep of+ (con, args)+ | qualified con == "GHC.Types.SrcLoc.GenLocated" -> False+ | notation con -> True+ | structural con -> not (null args) && all incidental args+ | otherwise -> False+ where+ qualified con = tyConModule con <> "." <> tyConName con++-- | Types that exist to record punctuation, position or spelling.+notation :: TyCon -> Bool+notation con =+ tyConModule con == "GHC.Parser.Annotation"+ || tyConModule con == "GHC.Types.SrcLoc"+ || ("GHC.Hs." `isPrefix` tyConModule con && "Ann" `isPrefix` tyConName con)+ || qualified `Set.member` alsoNotation+ where+ qualified = tyConModule con <> "." <> tyConName con+ isPrefix p t = take (length p) t == p++-- | The stragglers, named in full.+alsoNotation :: Set String+alsoNotation =+ Set.fromList+ [ -- Where a layout block's column was, which is the whole of what+ -- reformatting changes.+ "GHC.Hs.Extension.EpLayout",+ "Language.Haskell.Syntax.Extension.EpLayout",+ -- The text GHC keeps beside a literal or a pragma so that it can+ -- reproduce what was typed: the spaces inside @{-# INLINE f #-}@,+ -- whether an integer was written in hex, how a multi-line string was+ -- indented. The value itself is in the next field along.+ "GHC.Types.SourceText.SourceText",+ -- Whether a linear arrow was written @%1 ->@ or @⊸@. The multiplicity+ -- it stands for is a different field, and is compared.+ "GHC.Hs.Type.EpLinear"+ ]++-- | Containers that are transparent to the question.+structural :: TyCon -> Bool+structural con =+ tyConName con+ `elem` ["Maybe", "List", "NonEmpty", "Tuple2", "Tuple3", "Tuple4", "Tuple5"]++-- | Which side of the module name @qualified@ was written on.+--+-- @import qualified M@ and @import M qualified@ are the same import. Which+-- spelling is allowed is settled by @ImportQualifiedPost@ and the formatter+-- writes whichever the extension calls for, so the two are not expected to+-- survive as they were. Whether the import is qualified at all is another+-- matter, and that is what is compared.+asQualifiedStyle :: (Data a) => Path -> a -> a -> Maybe (Maybe Text)+asQualifiedStyle path x y = case (cast x, cast y) of+ (Just before, Just after) -> Just (compared before after)+ _ -> Nothing+ where+ compared :: ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Maybe Text+ compared before after+ | isImportDeclQualified before == isImportDeclQualified after = Nothing+ | otherwise = Just (describe path "the import stopped being qualified")++-- | A @deriving@ clause, however it was punctuated.+--+-- @deriving Eq@ and @deriving (Eq)@ are one clause written two ways, and+-- they are held in two different constructors with two different shapes, so+-- the generic comparison cannot see past the brackets. The formatter always+-- writes the brackets, so what is compared is the list of types being+-- derived.+asDerivingClause :: (Data a) => Path -> a -> a -> Maybe (Maybe Text)+asDerivingClause path x y = case (cast x, cast y) of+ (Just before, Just after) ->+ Just (differ path (derived before) (derived after))+ _ -> Nothing+ where+ derived :: DerivClauseTys GhcPs -> [LHsSigType GhcPs]+ derived = \case+ DctSingle _ t -> [t]+ DctMulti _ ts -> ts++-- | A module's imports, compared as the set they are.+--+-- The formatter sorts them and folds together the ones that say the same+-- thing, because the compiler reads imports as a set and the order they were+-- written in is the order somebody happened to add them. Comparing them in+-- sequence would report every module whose imports+-- were not already sorted.+--+-- Both sides are put through the same normalisation rather than being+-- compared loosely, so an import that was genuinely lost or whose list lost+-- an entry still shows up.+asImports :: (Data a) => Path -> a -> a -> Maybe (Maybe Text)+asImports path x y = case (cast x, cast y) of+ (Just before, Just after) -> Just (alongside (normalised before) (normalised after))+ _ -> Nothing+ where+ -- No comments are offered, so both sides are always reordered. That is+ -- what makes this comparison indifferent to the order: the formatter+ -- may have declined to sort a particular module, and the question here+ -- is whether it imports the same things either way. For the same reason+ -- it does not matter what is said about the Prelude, only that the same+ -- thing is said about both sides.+ normalised :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]+ normalised = normalizeImports (Is #implicitPrelude) [] []++ -- Compared one import at a time rather than as two lists, because a+ -- list of imports is what this function is called on: handing it back+ -- to `differ` whole would arrive here again and never stop.+ alongside before after+ | length before /= length after =+ Just (describe path "the module imports a different set of modules")+ | otherwise = firstOf (zipWith (differ path) before after)++-- | A context, compared for the constraints it holds.+--+-- Two things are levelled. @class () => Foo a@ and @class Foo a@ say the+-- same thing, and the formatter writes the second; the tree keeps them+-- apart because one has brackets in it. And a constraint may be written+-- bracketed or bare—@(Show a) =>@ against @Show a =>@—where the brackets+-- are the context's own punctuation rather than part of the constraint, so+-- the formatter writes them whether or not the author did.+--+-- Only the brackets directly around a constraint are dropped. Brackets+-- inside one group a type and are compared like any others.+asContext :: (Data a) => Path -> a -> a -> Maybe (Maybe Text)+asContext path x y = compared optional <|> compared written <|> compared quoted+ where+ compared :: forall b c. (Typeable b, Data c) => (b -> c) -> Maybe (Maybe Text)+ compared strip = case (cast x, cast y) of+ (Just before, Just after) -> Just (differ path (strip before) (strip after))+ _ -> Nothing++ optional :: Maybe (LHsContext GhcPs) -> [HsType GhcPs]+ optional = maybe [] written++ written :: LHsContext GhcPs -> [HsType GhcPs]+ written = map (unbracket . unLoc) . unLoc++ -- With @RequiredTypeArguments@ a constraint may stand where a term+ -- does, and until it is elaborated it is an expression. The brackets+ -- there are the context's own just as much as anywhere else.+ quoted :: XRec GhcPs [LHsExpr GhcPs] -> [HsExpr GhcPs]+ quoted = map (unparenthesised . unLoc) . unLoc++ unbracket = \case+ HsParTy _ t -> unbracket (unLoc t)+ t -> t++ unparenthesised = \case+ HsPar _ e -> unparenthesised (unLoc e)+ e -> e++-- | A Haddock, compared for what it documents.+--+-- What must survive is the words, in order, and what kind of Haddock it is:+-- a @$section@ and a @* heading@ say more than which way a comment points,+-- so those stay distinct while @|@ and @^@ do not.+asDocString :: (Data a) => Path -> a -> a -> Maybe (Maybe Text)+asDocString path x y = case (cast x, cast y) of+ (Just before, Just after)+ | summarised before == summarised after -> Just Nothing+ | otherwise ->+ Just (Just (describe path "a documentation comment changed"))+ _ -> Nothing+ where+ summarised :: HsDocString -> (Text, [ByteString])+ summarised d = (kindOf d, docWords d)++ kindOf = \case+ MultiLineDocString dec _ -> decorator dec+ NestedDocString dec _ -> decorator dec+ GeneratedDocString _ -> "generated"++ decorator = \case+ HsDocStringNext -> "pointer"+ HsDocStringPrevious -> "pointer"+ HsDocStringNamed n -> "named " <> T.pack n+ HsDocStringGroup n -> "group " <> T.pack (show n)++-- | What a doc string says, with the whitespace thrown away.+docWords :: HsDocString -> [ByteString]+docWords =+ concatMap chunkWords . \case+ MultiLineDocString _ cs -> map unLoc (NE.toList cs)+ NestedDocString _ c -> [unLoc c]+ GeneratedDocString c -> [c]+ where+ chunkWords (HsDocStringChunk bytes) =+ filter (not . BS.null) (BS.splitWith isAsciiSpace bytes)+ isAsciiSpace w = w == 32 || w == 9 || w == 10 || w == 13++-- | Compare two values of a type that will not be taken apart.+opaque :: forall a b. (Data a, Data b) => a -> b -> Bool+opaque x y = case dataTypeName (dataTypeOf x) of+ -- How every name and every literal is spelled.+ "FastString" -> by @FastString+ "OccName" -> by @OccName+ "ModuleName" -> by @ModuleName+ "Name" -> by @Name+ "Unit" -> by @Unit+ "Data.ByteString.ByteString" -> by @ByteString+ name ->+ error $+ "Tilia.Equivalence: "+ <> name+ <> " does not expose its structure and is not one of the types this\+ \ knows how to compare. Decide whether it carries meaning and add\+ \ it to `opaque`, or to `alsoOnlyAboutPlacement` if it is a\+ \ position."+ where+ by :: forall t. (Typeable t, Eq t) => Bool+ by = case (cast x, cast y) of+ (Just p, Just q) -> p == (q :: t)+ _ -> False++typeNameOf :: (Data a) => a -> String+typeNameOf = dataTypeName . dataTypeOf++----------------------------------------------------------------------------+-- Comments++-- | Did every comment survive, and if not, which one and how?+--+-- 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 neighbour+-- does not.+--+-- Except in the header, where the order says nothing. The pragmas are+-- sorted and so are the imports, and a comment written against either+-- travels with it, so the two streams are put in a settled order there+-- before being compared. What is still asked of that stretch is that the+-- same comments come out of it.+--+-- Documentation comments are counted rather than compared. The printer may+-- 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.+commentDifference ::+ -- | The module each stream came from, which is asked only how far down its+ -- header reaches+ (HsModule GhcPs, HsModule GhcPs) ->+ [Comment] ->+ [Comment] ->+ Maybe Text+commentDifference (moduleBefore, moduleAfter) before0 after0+ | not (Set.null lost) = Just ("lost the pragma " <> pragmaList lost)+ | not (Set.null gained) = Just ("invented the pragma " <> pragmaList gained)+ | docsBefore /= docsAfter =+ Just $+ "the module's "+ <> tshow docsBefore+ <> " documentation comments became "+ <> tshow docsAfter+ | otherwise =+ diverge (belowHeader moduleBefore before) (belowHeader moduleAfter after)+ <|> diverge+ (settled (withinHeader moduleBefore before))+ (settled (withinHeader moduleAfter after))+ where+ before = escapedAndSplit before0+ after = escapedAndSplit after0++ belowHeader m = filter (not . inHeader m) . ordinary+ withinHeader m = filter (inHeader m) . ordinary+ settled = sortOn bodyKey++ inHeader m c = case rearranged m of+ Nothing -> False+ Just lastLine -> spanStartLine (commentSpan c) <= lastLine++ escapedAndSplit = concatMap explode++ explode c = case commentStyle c of+ DocComment+ | "--" `T.isPrefixOf` NE.head (commentBody c) ->+ [ c {commentBody = l :| [], commentCodeBeforeStopsAt = before'}+ | (n, l) <- zip [0 :: Int ..] (NE.toList (body (escapeTrigger c))),+ let before' =+ if n == 0 then commentCodeBeforeStopsAt c else Nothing+ ]+ | otherwise -> [escapeTrigger c]+ _ -> [c]+ body = commentBody++ lost = pragmasOf before `Set.difference` pragmasOf after+ gained = pragmasOf after `Set.difference` pragmasOf before+ docsBefore = length (documentation before)+ docsAfter = length (documentation after)++ documentation = filter isDocumentation+ isDocumentation = triggerEscaped++ -- Pragmas are held apart from the comments they are written as, because+ -- the formatter moves them on purpose: it hoists them to the top, sorts+ -- them, drops duplicates and splits a @{-# LANGUAGE A, B #-}@ in two. So+ -- what has to survive is the set of them, not the order, and comparing+ -- them in sequence with everything else would report every module that+ -- did not already have them in sorted order.+ ordinary =+ filter (\c -> not (isDocumentation c) && isNothing (commentPragma c))++ diverge [] [] = Nothing+ diverge (b : _) [] = Just ("lost " <> quoted b)+ diverge [] (a : _) = Just ("gained " <> quoted a)+ diverge (b : bs) (a : as)+ | bodyKey b == bodyKey a = diverge bs as+ | Just (bs', as') <- crossed (b : bs) (a : as) = diverge bs' as'+ | otherwise = Just (quoted b <> " became " <> quoted a)++ -- A Haddock written after what it documents comes out before it, which+ -- lifts its lines over a comment trailing the same construct:+ --+ -- > _terSizeDepth :: Int -- lazy by intention!+ -- > -- ^ How many @SIZELT@ relations are in the context+ -- > -- (= clause telescope).+ --+ -- The comments have not moved and neither has the documentation; they+ -- have swapped, and the lines the Haddock runs on to are read here as+ -- comments like any other. Only comments that trail code may be crossed,+ -- only by comments that do not, and only where each block turns up whole+ -- and in order on the other side—so this says \"these two swapped\" and+ -- not \"these are the same comments in some order\".+ crossed written printed =+ listToMaybe+ [ (drop (j + k) written, drop (j + k) printed)+ | j <- [1 .. length (takeWhile commentTrailing written)],+ let lifted = drop j written,+ let shared = length (takeWhile id (zipWith alike printed lifted)),+ k <- [shared, shared - 1 .. 1],+ all (not . commentTrailing) (take k lifted),+ map bodyKey (take j (drop k printed)) == map bodyKey (take j written)+ ]++ alike x y = bodyKey x == bodyKey y++ quoted c = "`" <> T.intercalate "\\n" (NE.toList (commentBody c)) <> "`"+ tshow = T.pack . show+ pragmaList =+ T.intercalate ", "+ . map (\(n, b) -> "{-# " <> n <> " " <> b <> " #-}")+ . Set.toList++-- | A comment's lines, as they are compared.+bodyKey :: Comment -> NonEmpty Text+bodyKey c = case commentBody c of+ (l :| []) -> T.stripStart l :| []+ ls -> ls++-- | How far down the file the formatter rearranges things.+--+-- Everything from the top down to the last import: the pragmas are sorted,+-- the imports are sorted and folded together, and the comments written+-- against them travel along. Below that nothing is reordered, and there the+-- order of the comment stream is exactly what has to be checked.+rearranged :: HsModule GhcPs -> Maybe Int+rearranged m = spanEndLine <$> (spansOf (hsmodImports m) <> header)+ where+ header =+ foldMap spanOf (hsmodName m)+ <> foldMap spanOf (hsmodDeprecMessage (hsmodExt m))+ <> foldMap spanOf (hsmodExports m)++-- | The pragmas a module carries, however they were written.+--+-- A @{-# LANGUAGE A, B #-}@ counts as two, because that is what the+-- formatter turns it into, and the name is upper-cased and the body trimmed+-- so that two spellings of the same pragma are the same pragma.+pragmasOf :: [Comment] -> Set (Text, Text)+pragmasOf = Set.fromList . concatMap entries . mapMaybe commentPragma+ where+ entries p+ | pragmaName p == "LANGUAGE" =+ [ ("LANGUAGE", extension)+ | e <- T.splitOn "," (pragmaBody p),+ let extension = T.strip e,+ not (T.null extension)+ ]+ | otherwise = [(pragmaName p, pragmaBody p)]
+ src/Tilia/Fixity.hs view
@@ -0,0 +1,964 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Working out the fixity of the operators a module uses.+module Tilia.Fixity+ ( -- * Fixities+ OpName (..),+ Direction (..),+ Fixity (..),+ defaultFixity,++ -- * What a module declares+ declaredFixities,+ declaredNames,+ moduleName,++ -- * What a module passes on+ ExportItem (..),+ moduleExports,+ exportedOperators,+ declaredChildren,+ moduleChildren,++ -- * What a module can see+ Import (..),+ ImportItem (..),+ moduleImports,+ mightBring,+ surelyNames,+ Known (..),+ nothingKnown,+ Namespace (..),+ Fixities,+ inBothNamespaces,+ Unread (..),+ ModuleChain (..),+ spellModuleChain,+ Scope (..),+ Reach (..),+ reachIn,+ resolveScope,++ -- * Answers+ Provenance (..),+ Resolution (..),+ lookupFixity,++ -- * What could not be answered+ Unknown (..),+ operatorsUsed,+ unknownOperators,+ operatorSpelling,+ spellUnreadIn,++ -- * What reading a module established+ Established (..),+ Exported (..),+ exportedNames,+ asExported,+ )+where++import Data.Choice (Choice, isTrue)+import Data.Foldable (toList)+import Data.Generics.Schemes (listify)+import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, mapMaybe)+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, OpName)+import GHC.Types.Fixity qualified as GHC+import GHC.Types.Name.Occurrence (occNameString)+import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc)+import GHC.Types.SrcLoc (GenLocated (..), unLoc)+import Tilia.Palette (Color (Place), Palette, paint)++----------------------------------------------------------------------------+-- Fixities++-- | An operator, spelled as it appears in an @infix@ declaration: @<+>@, or+-- @div@ for a function used infix in backticks.+newtype OpName = OpName Text+ deriving (Eq, Ord, Show)++-- | Which way an operator associates.+data Direction = LeftAssoc | RightAssoc | NoAssoc+ deriving (Eq, Show)++-- | A fixity: how tightly an operator binds, and which way it associates.+data Fixity = Fixity+ { fixityDirection :: Direction,+ fixityPrecedence :: Int+ }+ deriving (Eq, Show)++-- | What an operator with no declaration in scope means: @infixl 9@.+defaultFixity :: Fixity+defaultFixity = Fixity LeftAssoc 9++----------------------------------------------------------------------------+-- What a module declares++-- | Which of Haskell's two namespaces an operator is written in.+data Namespace = InTypes | InTerms+ deriving (Eq, Ord, Show)++-- | The fixities a module offers, by the namespace each is written in.+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]+ ]++-- | The fixities in one namespace, by the operator alone.+fixitiesIn :: Namespace -> Fixities -> Map OpName Fixity+fixitiesIn namespace declared =+ Map.fromList [(op, fixity) | ((n, op), fixity) <- Map.toList declared, n == namespace]++-- | The fixities a module declares for its own operators.+declaredFixities :: HsModule GhcPs -> Fixities+declaredFixities hsModule =+ Map.fromList+ [ ((namespace, op), fixity)+ | (specifier, op, fixity) <- concatMap (fromDecl . unLoc) (hsmodDecls hsModule),+ namespace <- namespacesOf specifier op+ ]+ where+ (types, terms) = declaredNamespaces hsModule+ namespacesOf specifier op = case specifier of+ TypeNamespaceSpecifier _ -> [InTypes]+ DataNamespaceSpecifier _ -> [InTerms]+ NoNamespaceSpecifier ->+ case ([InTypes | Set.member op types] <> [InTerms | Set.member op terms]) of+ [] -> [InTypes, InTerms]+ found -> found++ fromDecl = \case+ SigD _ sig -> fromSig sig+ TyClD _ ClassDecl {tcdSigs} -> concatMap (fromSig . unLoc) tcdSigs+ _ -> []+ fromSig = \case+ FixSig _ (FixitySig specifier names fixity) ->+ [(specifier, opName (unLoc n), fromGhcFixity fixity) | n <- names]+ _ -> []++-- | The names a module declares among types, and those it declares among+-- terms.+declaredNamespaces :: HsModule GhcPs -> (Set OpName, Set OpName)+declaredNamespaces hsModule =+ ( Set.fromList (concatMap (types . unLoc) decls),+ Set.fromList (concatMap (terms . unLoc) decls)+ )+ where+ decls = hsmodDecls hsModule+ types = \case+ TyClD _ d -> case d of+ FamDecl _ FamilyDecl {fdLName} -> [opName (unLoc fdLName)]+ SynDecl {tcdLName} -> [opName (unLoc tcdLName)]+ DataDecl {tcdLName} -> [opName (unLoc tcdLName)]+ ClassDecl {tcdLName, tcdATs} ->+ opName (unLoc tcdLName)+ : [opName (unLoc (fdLName (unLoc f))) | f <- tcdATs]+ _ -> []+ terms = \case+ ValD _ b -> boundNames b+ SigD _ sig -> signedNames sig+ ForD _ f -> [opName (unLoc (fd_name f))]+ TyClD _ d@DataDecl {} -> membersOf d+ TyClD _ ClassDecl {tcdSigs} -> concatMap (classMethods . unLoc) tcdSigs+ _ -> []++-- | Every name a module defines itself.+--+-- Not the same question as 'declaredFixities', which is about @infix@+-- declarations. This one is asked of an export list: a name a module+-- exports and also defines needs no chasing, and one it merely passes on+-- does. Getting the two confused makes a module appear to re-export+-- everything it exports, and then a single dependency whose source is+-- missing makes the whole module unanswerable.+--+-- Erring towards too few is safe and towards too many is not: a name left+-- out here is chased when it need not have been, whereas one wrongly+-- included is a fixity nobody looked for.+declaredNames :: HsModule GhcPs -> Set OpName+declaredNames = Set.fromList . concatMap (fromDecl . unLoc) . hsmodDecls+ where+ fromDecl = \case+ ValD _ b -> fromBind b+ SigD _ sig -> fromSig sig+ TyClD _ t -> fromTyCl t+ ForD _ f -> [opName (unLoc (fd_name f))]+ _ -> []++ fromBind = boundNames++ fromSig = \case+ FixSig _ (FixitySig _ ns _) -> map (opName . unLoc) ns+ sig -> signedNames sig++ fromTyCl = \case+ FamDecl _ (FamilyDecl {fdLName}) -> [opName (unLoc fdLName)]+ SynDecl {tcdLName} -> [opName (unLoc tcdLName)]+ d@DataDecl {tcdLName} -> opName (unLoc tcdLName) : membersOf d+ d@ClassDecl {tcdLName} -> opName (unLoc tcdLName) : membersOf d++-- | 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 names a signature is about, leaving fixity declarations aside.+signedNames :: Sig GhcPs -> [OpName]+signedNames = \case+ TypeSig _ ns _ -> map (opName . unLoc) ns+ ClassOpSig _ _ ns _ -> map (opName . unLoc) ns+ PatSynSig _ ns _ -> map (opName . unLoc) ns+ _ -> []++-- | The methods a class signature declares.+classMethods :: Sig GhcPs -> [OpName]+classMethods = \case+ TypeSig _ ns _ -> map (opName . unLoc) ns+ ClassOpSig _ _ ns _ -> map (opName . unLoc) ns+ _ -> []++-- | The names a declaration carries under the name it declares: a data+-- type's constructors and record fields, a class's methods and the+-- families it keeps.+--+-- These are what @T(..)@ stands for, and each of them can carry a fixity of+-- its own—@:|@ is a constructor and @infixr 5@ all the same.+membersOf :: TyClDecl GhcPs -> [OpName]+membersOf = \case+ DataDecl {tcdDataDefn} -> concatMap (fromCon . unLoc) (consOf (dd_cons tcdDataDefn))+ ClassDecl {tcdSigs, tcdATs} ->+ concatMap (classMethods . unLoc) tcdSigs+ <> [opName (unLoc (fdLName (unLoc f))) | f <- tcdATs]+ _ -> []+ where+ consOf :: DataDefnCons (LConDecl GhcPs) -> [LConDecl GhcPs]+ consOf = toList++ fromCon :: ConDecl GhcPs -> [OpName]+ fromCon = \case+ ConDeclGADT {con_names} -> map (opName . unLoc) (toList con_names)+ ConDeclH98 {con_name, con_args} ->+ opName (unLoc con_name) : fieldNames con_args++ -- A record field is a name the type carries too, and it may be an+ -- operator.+ fieldNames :: HsConDeclH98Details GhcPs -> [OpName]+ fieldNames = \case+ RecCon fields ->+ [ opName (unLoc (foLabel (unLoc n)))+ | f <- unLoc fields,+ n <- cdrf_names (unLoc f)+ ]+ _ -> []++-- | What each type or class a module declares carries with it.+--+-- What @T(..)@ stands for where the module declares @T@ itself. Where it+-- does not—a type it merely passes on—there is nothing here, and a caller+-- that finds nothing must not conclude that @T@ brings nothing.+declaredChildren :: HsModule GhcPs -> Map OpName (Set OpName)+declaredChildren =+ Map.fromListWith Set.union . concatMap (fromDecl . unLoc) . hsmodDecls+ where+ fromDecl = \case+ TyClD _ d@DataDecl {tcdLName} -> [entry tcdLName d]+ TyClD _ d@ClassDecl {tcdLName} -> [entry tcdLName d]+ _ -> []+ entry name d = (opName (unLoc name), Set.fromList (membersOf d))++-- | What a module offers under each name, as its export list offers it.+--+-- @T(..)@ in the list hands on everything the module has under @T@; @T(A,+-- B)@ hands on only what it names; no export list at all hands on every+-- member of everything the module declares. This is the answer to \"what+-- does @T(..)@ bring in\" asked of the module being imported from, which is+-- the only place the answer is.+moduleChildren :: HsModule GhcPs -> Map OpName (Set OpName)+moduleChildren hsModule = case hsmodExports hsModule of+ Nothing -> declared+ Just items -> Map.fromListWith Set.union (concatMap (fromIE . unLoc) (unLoc items))+ where+ declared = declaredChildren hsModule+ fromIE = \case+ IEThingAll _ n _ ->+ [(nameOf n, Map.findWithDefault Set.empty (nameOf n) declared)]+ IEThingWith _ n _ ns _ -> [(nameOf n, Set.fromList (map nameOf ns))]+ _ -> []+ nameOf = opName . ieWrappedName . unLoc++-- | Render a parsed name as an operator name.+opName :: RdrName -> OpName+opName = OpName . T.pack . occNameString . rdrNameOcc++fromGhcFixity :: GHC.Fixity -> Fixity+fromGhcFixity (GHC.Fixity prec dir) = Fixity (fromGhcDirection dir) prec++fromGhcDirection :: GHC.FixityDirection -> Direction+fromGhcDirection = \case+ GHC.InfixL -> LeftAssoc+ GHC.InfixR -> RightAssoc+ GHC.InfixN -> NoAssoc++-- | The module's own name, if it declares one.+moduleName :: HsModule GhcPs -> Maybe Text+moduleName = fmap (T.pack . moduleNameString . unLoc) . hsmodName++----------------------------------------------------------------------------+-- What a module passes on++-- | One entry of a module's export list.+data ExportItem+ = -- | A name, which may or may not be declared in this module, under the+ -- qualifier it was written with if it was written with one.+ ExportName (Maybe Text) OpName+ | -- | @T(..)@: the name, and with it whatever the module has to give+ -- under that name. Which names those are cannot be read off the list;+ -- it takes the declaration of @T@, or the module @T@ came from.+ ExportAll (Maybe Text) OpName+ | -- | @module M@, re-exporting everything that module brought in.+ ExportModule Text+ deriving (Eq, Show)++-- | The operators a module's export list names, where that list can be+-- enumerated without reading what the module passes on.+--+-- 'Nothing' is a module that keeps its own counsel: one whose export list+-- hands whole modules on, so that what it exports cannot be known without+-- reading them. A module with no export list at all exports what it+-- declares, and the fixities it declares are everything it could supply.+--+-- What this is for: an operator nobody could settle is blamed on the+-- imports that might have declared it, and a module that plainly exports no+-- such name is not one of them. See 'unreadFor'.+exportedOperators :: HsModule GhcPs -> Maybe (Set OpName)+exportedOperators hsModule = case moduleExports hsModule of+ Nothing -> Just (Set.fromList [op | (_, op) <- Map.keys (declaredFixities hsModule)])+ Just items+ | any beyondUs items -> Nothing+ | otherwise -> Just (Set.unions (map named items))+ where+ declared = declaredChildren hsModule+ beyondUs = \case+ ExportModule _ -> True+ ExportAll _ parent -> not (Map.member parent declared)+ ExportName _ _ -> False+ named = \case+ ExportName _ op -> Set.singleton op+ ExportAll _ parent ->+ Set.insert parent (Map.findWithDefault Set.empty parent declared)+ ExportModule _ -> Set.empty++-- | The qualifier a name was written under.+qualifierOf :: RdrName -> Maybe Text+qualifierOf = \case+ Qual m _ -> Just (T.pack (moduleNameString m))+ _ -> Nothing++-- | A module's export list, or 'Nothing' if it has none.+--+-- The distinction matters. A module with no export list exports exactly+-- what it defines, so its own declarations are the whole answer. A module+-- with one may be passing on names it never declared, and those are what+-- re-export resolution has to chase.+moduleExports :: HsModule GhcPs -> Maybe [ExportItem]+moduleExports =+ fmap (concatMap (fromIE . unLoc) . unLoc) . hsmodExports+ where+ fromIE = \case+ IEVar _ n _ -> [named n]+ IEThingAbs _ n _ -> [named n]+ IEThingAll _ n _ -> [as ExportAll n]+ -- The type itself and every member listed with it; a class exports+ -- its operators this way.+ IEThingWith _ n _ ns _ -> named n : map named ns+ IEModuleContents _ m -> [ExportModule (T.pack (moduleNameString (unLoc m)))]+ _ -> []+ named = as ExportName+ as item n =+ let rdr = ieWrappedName (unLoc n)+ in item (qualifierOf rdr) (opName rdr)++----------------------------------------------------------------------------+-- What a module can see++-- | One import declaration, reduced to what bears on fixity.+data Import = Import+ { -- | The module being imported.+ importModule :: Text,+ -- | Whether unqualified names are brought into scope. An import that is+ -- @qualified@ brings none.+ importQualified :: Bool,+ -- | The name qualified uses go through: the alias if there is one,+ -- otherwise the module's own name.+ importAlias :: Text,+ -- | The explicit list, if there is one, and whether it is a @hiding@+ -- list.+ --+ -- Kept as written rather than as a set of names, because @T(..)@ says+ -- what it brings in only once the module it comes from has been asked.+ importNames :: Maybe (Bool, [ImportItem])+ }+ deriving (Eq, Show)++-- | One entry of an import list.+data ImportItem+ = -- | A plain name.+ ImportedName OpName+ | -- | @T(..)@: the name, and everything the module offers under it.+ ImportedAll OpName+ | -- | @T(a, b)@: the name and the members written out beside it.+ ImportedSome OpName [OpName]+ deriving (Eq, Show)++-- | Could this list bring the operator in?+--+-- Told what the module keeps under each of its names, this is exact. Told+-- nothing about a @T(..)@'s @T@, it answers yes, because ruling the+-- operator out would mean knowing what @T@ has under it and we do not. Used+-- where being wrong the other way—deciding an operator could not have+-- arrived through a list that in fact brings it—would settle a fixity that+-- was never established.+mightBring :: Map OpName (Set OpName) -> OpName -> [ImportItem] -> Bool+mightBring carries op = any $ \case+ ImportedName n -> n == op+ ImportedSome parent ns -> parent == op || op `elem` ns+ ImportedAll parent -> maybe True (names parent) (Map.lookup parent carries)+ where+ names parent kids = parent == op || Set.member op kids++-- | Does this list certainly name the operator?+--+-- The other side of 'mightBring', for a @hiding@ list: a name is hidden+-- only where the list says so outright. Told what a @T(..)@ carries this+-- is again exact; told nothing, it still holds that @T(..)@ hides @T@.+surelyNames :: Map OpName (Set OpName) -> OpName -> [ImportItem] -> Bool+surelyNames carries op = any $ \case+ ImportedName n -> n == op+ ImportedSome parent ns -> parent == op || op `elem` ns+ ImportedAll parent -> maybe (parent == op) (names parent) (Map.lookup parent carries)+ where+ names parent kids = parent == op || Set.member op kids++-- | The imports of a module.+moduleImports ::+ -- | Whether @ImplicitPrelude@ is on+ Choice "implicitPrelude" ->+ HsModule GhcPs ->+ [Import]+moduleImports implicitPrelude hsModule = prelude <> written+ where+ written = map (fromDecl . unLoc) (hsmodImports hsModule)+ prelude+ | not (isTrue implicitPrelude) = []+ | any ((== "Prelude") . importModule) written = []+ | otherwise =+ [ Import+ { importModule = "Prelude",+ importQualified = False,+ importAlias = "Prelude",+ importNames = Nothing+ }+ ]++ fromDecl d =+ Import+ { importModule = modName (unLoc (ideclName d)),+ importQualified = ideclQualified d /= NotQualified,+ importAlias = maybe (modName (unLoc (ideclName d))) (modName . unLoc) (ideclAs d),+ importNames = fromList <$> ideclImportList d+ }+ fromList (interpretation, names) =+ ( interpretation == EverythingBut,+ mapMaybe (importedItem . unLoc) (unLoc names)+ )+ modName = T.pack . moduleNameString++-- | One entry of an import list, as written.+importedItem :: IE GhcPs -> Maybe ImportItem+importedItem = \case+ IEVar _ n _ -> Just (ImportedName (nameOf n))+ IEThingAbs _ n _ -> Just (ImportedName (nameOf n))+ IEThingAll _ n _ -> Just (ImportedAll (nameOf n))+ IEThingWith _ n _ ns _ -> Just (ImportedSome (nameOf n) (map nameOf ns))+ _ -> Nothing+ where+ nameOf :: LIEWrappedName GhcPs -> OpName+ nameOf = opName . ieWrappedName . unLoc++-- | An import whose module could not be read, and what is known about it+-- regardless.+--+-- Unread is not the same as unknown. Failing to establish a module's+-- fixities does not stop us reading its export list or its declarations,+-- and either can rule the module out as the source of an operator. Ruling+-- it out is what keeps one unreachable package from unsettling a whole+-- file.+data Unread = Unread+ { -- | The import as written.+ unreadImport :: Import,+ -- | The operators its export list names, where that list can be+ -- enumerated. 'Nothing' is a module that keeps its own counsel—one+ -- whose list passes whole modules on, or that could not be parsed—and+ -- which therefore has to be suspected of everything.+ unreadExports :: Maybe (Set OpName),+ -- | What it keeps under each of its names, for expanding a @T(..)@ in+ -- the import list. Empty is ignorance, and leaves such a list+ -- suspected of bringing in anything.+ unreadCarries :: Map OpName (Set OpName),+ -- | The modules below this one that reading went through, ending at+ -- the one that actually stopped it. Empty where the import is itself+ -- what could not be read. Diagnostic only.+ unreadBelow :: [Text]+ }+ deriving (Eq, Show)++-- | An import that could not be read, and the way down to the module that+-- actually stopped us. The head is the import as the file being formatted+-- writes it, and the last name is where reading gave up.+newtype ModuleChain = ModuleChain (NonEmpty Text)+ deriving (Eq, Show)++-- | A chain as it is shown, with the modules painted and arrows between+-- them.+spellModuleChain :: Palette -> ModuleChain -> Text+spellModuleChain palette (ModuleChain modules) =+ T.intercalate " → " (map (paint palette Place) (toList modules))++-- | Every fixity a module can see, and how.+data Scope = Scope+ { -- | What is in scope for an operator written among types.+ scopeInTypes :: Reach,+ -- | What is in scope for one written among terms.+ scopeInTerms :: Reach,+ -- | The imports whose modules could not be read, and what is+ -- nonetheless known about each.+ --+ -- These are what separate \"no declaration exists\" from \"we did not+ -- manage to look\". An operator that was not found is settled only if no+ -- unread import could have brought it in, and deciding that needs the+ -- whole import rather than the module's name: see 'unreadFor'.+ --+ -- One list for both namespaces: a module that could not be read could+ -- not be read for either.+ scopeUnread :: [Unread]+ }+ deriving (Eq, Show)++-- | What one namespace of a scope holds.+data Reach = Reach+ { -- | Reachable without qualification, with where it came from.+ reachUnqualified :: Map OpName (Fixity, Provenance),+ -- | Reachable as @M.op@, keyed by the alias actually written—or by the+ -- module's own name, under which its own declarations are reachable.+ reachQualified :: Map (Text, OpName) (Fixity, Provenance),+ -- | Operators the imports bring in with two different fixities, as they+ -- would have to be written to run into it: without a qualifier, or under+ -- the alias the disagreeing imports share.+ reachAmbiguous :: [(Maybe Text, OpName)]+ }+ deriving (Eq, Show)++-- | The half of a scope an operator written in this namespace is settled+-- against.+reachIn :: Namespace -> Scope -> Reach+reachIn = \case+ InTypes -> scopeInTypes+ InTerms -> scopeInTerms++-- | What is known about the modules a module imports.+--+-- Everything 'resolveScope' cannot read off the module in front of it,+-- gathered into one place. 'nothingKnown' answers none of them, which is+-- legitimate—it costs coverage, never correctness.+data Known = Known+ { -- | What a module exports, or 'Nothing' if that could not be+ -- determined. 'Nothing' means the module could not be read, which is+ -- not the same as its exporting nothing; see 'resolveScope'.+ knownFixities :: Text -> Maybe Fixities,+ -- | What a module keeps under each of its names, so that a @T(..)@ in+ -- an import list can be told what it brings in. An empty map is+ -- ignorance as much as it is emptiness, and understates a list rather+ -- than overstating it.+ knownChildren :: Text -> Map OpName (Set OpName),+ -- | The operators a module's export list names, where that list can be+ -- enumerated without reading what it passes on. Asked only about+ -- modules 'knownFixities' could not answer for, and only to decide+ -- which of them an unsettled operator can be blamed on.+ knownExportNames :: Text -> Maybe (Set OpName),+ -- | The modules reading a module went through before giving up, the one+ -- it gave up on last. Asked only about modules 'knownFixities' could+ -- not answer for, and only so that a message can name the module that+ -- is really in the way.+ knownChain :: Text -> [Text]+ }++-- | Knowing nothing about anything: every question answered with a shrug.+--+-- A scope built on this settles what the module itself declares and+-- nothing more. Fill in the fields that can be answered.+nothingKnown :: Known+nothingKnown =+ Known+ { knownFixities = const Nothing,+ knownChildren = const Map.empty,+ knownExportNames = const Nothing,+ knownChain = const []+ }++-- | Work out what a module can see.+--+-- The lookup function supplies what each imported module exports, and+-- 'Nothing' means it could not be determined—the package was not+-- downloaded, the source did not parse. That distinction is the whole point+-- of its type: an empty map is a fact about a module, whereas 'Nothing' is+-- an admission about us, and conflating them is how a formatter ends up+-- asserting a fixity it never established.+--+-- Not handled here: operators arriving through @T(..)@. That is syntactic+-- and so belongs to the lookup function, as re-export chains do—and those+-- "Tilia.Fixity.Plan" already follows, through export lists in source and+-- through the export section of an interface.+resolveScope ::+ -- | Whether @ImplicitPrelude@ is on+ Choice "implicitPrelude" ->+ -- | What is known about the modules this one imports+ Known ->+ HsModule GhcPs ->+ Scope+resolveScope implicitPrelude known hsModule =+ Scope+ { scopeInTypes = reachAmong InTypes,+ scopeInTerms = reachAmong InTerms,+ scopeUnread = unread+ }+ where+ Known {knownFixities = exportsOf, knownChildren, knownExportNames, knownChain} = known+ exportNamesOf = knownExportNames+ imports = moduleImports implicitPrelude hsModule+ declared = declaredFixities hsModule++ reachAmong namespace =+ Reach+ { reachUnqualified = Map.union own (Map.map fst unqualified),+ reachQualified = qualified,+ reachAmbiguous =+ [(Nothing, op) | op <- Map.keys (Map.filter snd unqualified)]+ <> [(Just alias, op) | (alias, op) <- Map.keys (Map.filter snd qualifiedFrom)]+ }+ where+ own = Map.map (,DeclaredHere) (fixitiesIn namespace declared)+ offered m = fixitiesIn namespace <$> exportsOf m+ unqualified =+ Map.unionsWith+ disagree+ [ Map.map (,False) (visible offered i)+ | i <- imports,+ not (importQualified i)+ ]+ qualified = Map.union ownQualified (Map.map fst qualifiedFrom)+ ownQualified =+ Map.fromList+ [ ((m, op), entry)+ | m <- toList (moduleName hsModule),+ (op, entry) <- Map.toList own+ ]+ qualifiedFrom =+ Map.unionsWith+ disagree+ [ Map.mapKeys (importAlias i,) (Map.map (,False) (visible offered i))+ | i <- imports+ ]++ unread =+ [ Unread+ { unreadImport = i,+ unreadExports = exportNamesOf (importModule i),+ unreadCarries = knownChildren (importModule i),+ unreadBelow = knownChain (importModule i)+ }+ | i <- imports,+ Nothing <- [exportsOf (importModule i)]+ ]++ -- Paired with a flag saying whether two imports disagreed about it.+ disagree (a, aBad) (b, bBad) = (a, aBad || bBad || fst a /= fst b)++ visible offered i =+ let exported =+ Map.map (,DeclaredIn (importModule i)) $+ fromMaybe Map.empty (offered (importModule i))+ carries = knownChildren (importModule i)+ in case importNames i of+ Nothing -> exported+ Just (True, hidden) ->+ Map.filterWithKey+ (\op _ -> not (surelyNames carries op hidden))+ exported+ Just (False, shown) ->+ Map.filterWithKey (\op _ -> mightBring carries op shown) exported++----------------------------------------------------------------------------+-- Answers++-- | Where a fixity came from.+--+-- Kept so that an answer can be explained, and so that+-- 'ReportDefault'—which is a real answer, not a guess—cannot be confused+-- with not having one.+data Provenance+ = -- | An @infix@ declaration in the module being formatted.+ DeclaredHere+ | -- | An @infix@ declaration in the named imported module.+ DeclaredIn Text+ | -- | No declaration exists anywhere in scope, and every module in scope+ -- was successfully consulted, so the Report's @infixl 9@ applies.+ ReportDefault+ deriving (Eq, Show)++-- | What is known about an operator at a use site.+data Resolution+ = -- | Established, and here is where from.+ Resolved Fixity Provenance+ | -- | Not established. Each chain is an import that could not be read,+ -- down to the module that actually stopped us, and the answer may be in+ -- any of them.+ --+ -- A printer that receives this must not restructure the operator chain:+ -- it has to lay it out as the input had it. Rearranging on a guess is+ -- exactly what this type exists to prevent.+ Unresolved (NonEmpty ModuleChain)+ deriving (Eq, Show)++-- | The fixity of an operator as this module sees it.+lookupFixity ::+ -- | The scope+ Scope ->+ -- | The namespace the operator is written in+ Namespace ->+ -- | The qualifier written at the use site, if any+ Maybe Text ->+ -- | Operator to resolve+ OpName ->+ -- | The resolution+ Resolution+lookupFixity scope namespace qualifier op =+ case settledFor scope namespace qualifier op of+ Just (_, (fixity, provenance)) -> Resolved fixity provenance+ Nothing -> case nonEmpty (unreadFor scope qualifier op) of+ Nothing -> Resolved defaultFixity ReportDefault+ Just missing -> Unresolved missing++-- | What settles a use, and the namespace that settled it.+settledFor ::+ Scope ->+ Namespace ->+ Maybe Text ->+ OpName ->+ Maybe (Namespace, (Fixity, Provenance))+settledFor scope namespace qualifier op =+ case mapMaybe found (namespace : promotedFrom namespace) of+ (answer : _) -> Just answer+ [] -> Nothing+ where+ promotedFrom = \case+ InTypes -> [InTerms]+ InTerms -> []+ found n =+ (n,) <$> case qualifier of+ Nothing -> Map.lookup op (reachUnqualified (reachIn n scope))+ Just q -> Map.lookup (q, op) (reachQualified (reachIn n scope))++-- | The modules of the unread imports that could have settled this use.+--+-- Empty means an operator that was not found really is undeclared, rather+-- than declared somewhere we failed to look. Getting this narrow matters:+-- an import that is @qualified as M@ has no bearing on an operator written+-- without a qualifier, and one with an import list has none on an operator+-- the list does not name. Were every unread import to count against every+-- operator, one unreachable package deep in a dependency tree would+-- unsettle a whole file.+unreadFor ::+ -- | The scope+ Scope ->+ -- | The qualifier written at the use site, if any+ Maybe Text ->+ -- | Operator being resolved+ OpName ->+ -- | The imports that could hold the answer, each down to the module that+ -- actually stopped us+ [ModuleChain]+unreadFor scope qualifier op =+ [ ModuleChain (importModule (unreadImport u) :| unreadBelow u)+ | u <- scopeUnread scope,+ reaches (unreadImport u),+ brings u,+ exports u+ ]+ where+ -- A module that says what it exports is taken at its word.+ exports u = maybe True (Set.member op) (unreadExports u)+ reaches i = case qualifier of+ Nothing -> not (importQualified i)+ Just q -> q == importAlias i+ -- What a @T(..)@ in the list stands for is often knowable even where+ -- the module's fixities are not: reading a module's declarations is+ -- one thing and settling every operator it passes on is another.+ brings u = case importNames (unreadImport u) of+ Nothing -> True+ Just (True, hidden) -> not (surelyNames (unreadCarries u) op hidden)+ Just (False, shown) -> mightBring (unreadCarries u) op shown++----------------------------------------------------------------------------+-- What could not be answered++-- | Why an operator's fixity could not be settled.+data Unknown+ = -- | These imports could not be read, each given down to the module that+ -- actually stopped us, and the declaration the answer depends on may be+ -- in any of them.+ NotRead (NonEmpty ModuleChain)+ | -- | Two modules in scope bring it in with different fixities, so which+ -- one applies cannot be read off the imports alone.+ Ambiguous+ deriving (Eq, Show)++-- | Every operator the module uses where its fixity decides the layout.+--+-- Only these positions. An operator chain in an expression and one in a type+-- are regrouped by precedence, so getting the precedence wrong changes what+-- the code means. Everywhere else—a section, the left-hand side of a+-- definition, an @infix@ declaration—the operator stands on its own and+-- nothing is regrouped around it.+operatorsUsed :: HsModule GhcPs -> [(Namespace, (Maybe Text, OpName))]+operatorsUsed hsModule =+ map (named InTerms) inExpressions <> map (named InTypes) inTypes+ where+ inExpressions =+ [ n+ | e :: HsExpr GhcPs <- listify (const True) hsModule,+ OpApp _ _ op _ <- [e],+ HsVar _ (L _ n) <- [unLoc op]+ ]+ inTypes =+ [ n+ | t :: HsType GhcPs <- listify (const True) hsModule,+ HsOpTy _ _ _ (L _ n) _ <- [t]+ ]+ named namespace n =+ (namespace, (qualifierOf n, OpName (T.pack (occNameString (rdrNameOcc n)))))++-- | The operators this module uses that the scope cannot settle, as the+-- module writes them.+--+-- Empty is the only acceptable answer: an operator whose fixity is not+-- known cannot be laid out, only guessed at.+unknownOperators :: Scope -> HsModule GhcPs -> [((Maybe Text, OpName), Unknown)]+unknownOperators scope hsModule =+ Map.toList (Map.fromList (mapMaybe unsettled (operatorsUsed hsModule)))+ where+ ambiguous namespace = Set.fromList (reachAmbiguous (reachIn namespace scope))+ unsettled (namespace, (qualifier, op)) =+ case settledFor scope namespace qualifier op of+ Just (answering, _)+ | Set.member (qualifier, op) (ambiguous answering) ->+ Just ((qualifier, op), Ambiguous)+ | otherwise -> Nothing+ Nothing -> case nonEmpty (unreadFor scope qualifier op) of+ Just missing -> Just ((qualifier, op), NotRead missing)+ Nothing -> Nothing++-- | An operator as a use site writes it, qualifier and all.+operatorSpelling :: Maybe Text -> OpName -> Text+operatorSpelling qualifier (OpName op) = maybe "" (<> ".") qualifier <> op++-- | Spell out where an unsettled operator may have come from, and the fact+-- that this run could not read any of it.+spellUnreadIn ::+ -- | Whether there is anybody there to see color+ Palette ->+ -- | The chains, as 'Unresolved' gives them+ NonEmpty ModuleChain ->+ Text+spellUnreadIn palette missing =+ T.intercalate " or " (map (spellModuleChain palette) (toList missing))+ <> ", "+ <> ofThose+ where+ ofThose = case toList missing of+ [_] -> "which this run could not read"+ [_, _] -> "neither of which this run could read"+ _ -> "none of which this run could read"++----------------------------------------------------------------------------+-- What reading a module established++-- | What reading a module established about its operators.+--+-- Declaring nothing is something a module did; being unreadable is+-- something that happened to us. Everything here turns on keeping those+-- apart, which is why this is two constructors rather than a map that+-- might be empty.+data Established+ = -- | It was read, and declares these.+ Declares Fixities+ | -- | It could not be read. The expensive answer of the two, because+ -- reaching it means exhausting every way of reading the module.+ --+ -- The name is the module below this one that stopped us, where the+ -- failure was not this module's own. One hop only: the module named+ -- carries its own, and following them is how a whole chain is got back.+ -- It is kept because it has to outlive the run that found it — a+ -- verdict of unreadable is cached, and a reason that were not cached+ -- with it would leave the second run with a worse account than the+ -- first.+ Unreadable (Maybe Text)+ deriving (Eq, Show)++-- | What reading a module established about its export list.+--+-- 'exportedOperators' answers the same question as @'Maybe' ('Set'+-- 'OpName')@, which is the shape 'resolveScope' wants. This is that answer+-- given a name, so that having one and never having asked can be told apart+-- where both have to be written down.+data Exported+ = -- | The list names these, and they are all the module can supply.+ Exports (Set OpName)+ | -- | Nothing that can be enumerated: the list hands whole modules on, or+ -- the source would not parse.+ Untellable+ deriving (Eq, Show)++-- | What 'resolveScope' makes of it.+exportedNames :: Exported -> Maybe (Set OpName)+exportedNames = \case+ Exports names -> Just names+ Untellable -> Nothing++-- | What to write down for an answer 'exportedOperators' gave.+asExported :: Maybe (Set OpName) -> Exported+asExported = maybe Untellable Exports
+ src/Tilia/Fixity/Builtin.hs view
@@ -0,0 +1,1182 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Fixities of the operators that ship with the compiler.+--+-- Generated by @generate-builtin-fixities.py@ in the root of the+-- repository, from GHC 9.14.1. Run that script again to update this table.+module Tilia.Fixity.Builtin+ ( builtinFixities,+ )+where++import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Tilia.Fixity++-- | Every module the boot packages expose, with the operators it exports.+builtinFixities :: Map Text Fixities+builtinFixities =+ Map.fromList+ [ entry+ "Control.Applicative"+ [("*>", [InTerms], LeftAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<$>", [InTerms], LeftAssoc, 4), ("<*", [InTerms], LeftAssoc, 4), ("<**>", [InTerms], LeftAssoc, 4), ("<*>", [InTerms], LeftAssoc, 4), ("<|>", [InTerms], LeftAssoc, 3)],+ entry "Control.Applicative.Backwards" [],+ entry "Control.Applicative.Lift" [],+ entry+ "Control.Arrow"+ [("&&&", [InTerms], RightAssoc, 3), ("***", [InTerms], RightAssoc, 3), ("+++", [InTerms], RightAssoc, 2), ("<+>", [InTerms], RightAssoc, 5), ("<<<", [InTerms], RightAssoc, 1), ("<<^", [InTerms], RightAssoc, 1), (">>>", [InTerms], RightAssoc, 1), (">>^", [InTerms], RightAssoc, 1), ("^<<", [InTerms], RightAssoc, 1), ("^>>", [InTerms], RightAssoc, 1), ("|||", [InTerms], RightAssoc, 2)],+ entry+ "Control.Category"+ [(".", [InTerms], RightAssoc, 9), ("<<<", [InTerms], RightAssoc, 1), (">>>", [InTerms], RightAssoc, 1)],+ entry "Control.Concurrent" [],+ entry "Control.Concurrent.Chan" [],+ entry "Control.Concurrent.MVar" [],+ entry "Control.Concurrent.QSem" [],+ entry "Control.Concurrent.QSemN" [],+ entry "Control.Concurrent.STM" [],+ entry "Control.Concurrent.STM.TArray" [],+ entry "Control.Concurrent.STM.TBQueue" [],+ entry "Control.Concurrent.STM.TChan" [],+ entry "Control.Concurrent.STM.TMVar" [],+ entry "Control.Concurrent.STM.TQueue" [],+ entry "Control.Concurrent.STM.TSem" [],+ entry "Control.Concurrent.STM.TVar" [],+ entry+ "Control.DeepSeq"+ [("$!!", [InTerms], RightAssoc, 0), ("<$!!>", [InTerms], LeftAssoc, 4), ("deepseq", [InTerms], RightAssoc, 0)],+ entry "Control.Exception" [],+ entry "Control.Exception.Annotation" [],+ entry "Control.Exception.Backtrace" [],+ entry "Control.Exception.Base" [],+ entry "Control.Exception.Context" [],+ entry+ "Control.Monad"+ [("<$", [InTerms], LeftAssoc, 4), ("<$!>", [InTerms], LeftAssoc, 4), ("<=<", [InTerms], RightAssoc, 1), ("=<<", [InTerms], RightAssoc, 1), (">=>", [InTerms], RightAssoc, 1), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1)],+ entry "Control.Monad.Accum" [],+ entry "Control.Monad.Catch" [],+ entry "Control.Monad.Catch.Pure" [],+ entry "Control.Monad.Cont" [],+ entry "Control.Monad.Cont.Class" [],+ entry "Control.Monad.Error.Class" [],+ entry "Control.Monad.Except" [],+ entry "Control.Monad.Fail" [],+ entry "Control.Monad.Fix" [],+ entry "Control.Monad.IO.Class" [],+ entry "Control.Monad.Identity" [],+ entry+ "Control.Monad.Instances"+ [("<$", [InTerms], LeftAssoc, 4), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1)],+ entry "Control.Monad.RWS" [],+ entry "Control.Monad.RWS.CPS" [],+ entry "Control.Monad.RWS.Class" [],+ entry "Control.Monad.RWS.Lazy" [],+ entry "Control.Monad.RWS.Strict" [],+ entry "Control.Monad.Reader" [],+ entry "Control.Monad.Reader.Class" [],+ entry "Control.Monad.ST" [],+ entry "Control.Monad.ST.Lazy" [],+ entry "Control.Monad.ST.Lazy.Safe" [],+ entry "Control.Monad.ST.Lazy.Unsafe" [],+ entry "Control.Monad.ST.Safe" [],+ entry "Control.Monad.ST.Strict" [],+ entry "Control.Monad.ST.Unsafe" [],+ entry "Control.Monad.STM" [],+ entry "Control.Monad.Select" [],+ entry "Control.Monad.Signatures" [],+ entry "Control.Monad.State" [],+ entry "Control.Monad.State.Class" [],+ entry "Control.Monad.State.Lazy" [],+ entry "Control.Monad.State.Strict" [],+ entry "Control.Monad.Trans" [],+ entry "Control.Monad.Trans.Accum" [],+ entry "Control.Monad.Trans.Class" [],+ entry "Control.Monad.Trans.Cont" [],+ entry "Control.Monad.Trans.Except" [],+ entry "Control.Monad.Trans.Identity" [],+ entry "Control.Monad.Trans.Maybe" [],+ entry "Control.Monad.Trans.RWS" [],+ entry "Control.Monad.Trans.RWS.CPS" [],+ entry "Control.Monad.Trans.RWS.Lazy" [],+ entry "Control.Monad.Trans.RWS.Strict" [],+ entry "Control.Monad.Trans.Reader" [],+ entry "Control.Monad.Trans.Select" [],+ entry "Control.Monad.Trans.State" [],+ entry "Control.Monad.Trans.State.Lazy" [],+ entry "Control.Monad.Trans.State.Strict" [],+ entry "Control.Monad.Trans.Writer" [],+ entry "Control.Monad.Trans.Writer.CPS" [],+ entry "Control.Monad.Trans.Writer.Lazy" [],+ entry "Control.Monad.Trans.Writer.Strict" [],+ entry "Control.Monad.Writer" [],+ entry "Control.Monad.Writer.CPS" [],+ entry "Control.Monad.Writer.Class" [],+ entry "Control.Monad.Writer.Lazy" [],+ entry "Control.Monad.Writer.Strict" [],+ entry "Control.Monad.Zip" [],+ entry+ "Data.Array"+ [("!", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)],+ entry+ "Data.Array.Base"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)],+ entry "Data.Array.Byte" [],+ entry+ "Data.Array.IArray"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)],+ entry "Data.Array.IO" [],+ entry "Data.Array.IO.Internals" [],+ entry "Data.Array.IO.Safe" [],+ entry "Data.Array.MArray" [],+ entry "Data.Array.MArray.Safe" [],+ entry "Data.Array.ST" [],+ entry "Data.Array.ST.Safe" [],+ entry "Data.Array.Storable" [],+ entry "Data.Array.Storable.Internals" [],+ entry "Data.Array.Storable.Safe" [],+ entry+ "Data.Array.Unboxed"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)],+ entry "Data.Array.Unsafe" [],+ entry "Data.Bifoldable" [],+ entry "Data.Bifoldable1" [],+ entry "Data.Bifunctor" [],+ entry "Data.Binary" [],+ entry "Data.Binary.Builder" [],+ entry "Data.Binary.Get" [],+ entry "Data.Binary.Get.Internal" [],+ entry "Data.Binary.Put" [],+ entry "Data.Bitraversable" [],+ entry+ "Data.Bits"+ [("!<<.", [InTerms], LeftAssoc, 8), ("!>>.", [InTerms], LeftAssoc, 8), (".&.", [InTerms], LeftAssoc, 7), (".<<.", [InTerms], LeftAssoc, 8), (".>>.", [InTerms], LeftAssoc, 8), (".^.", [InTerms], LeftAssoc, 6), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)],+ entry+ "Data.Bool"+ [("&&", [InTerms], RightAssoc, 3), ("||", [InTerms], RightAssoc, 2)],+ entry "Data.Bounded" [],+ entry+ "Data.ByteString"+ [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)],+ entry "Data.ByteString.Builder" [],+ entry "Data.ByteString.Builder.Extra" [],+ entry "Data.ByteString.Builder.Internal" [],+ entry+ "Data.ByteString.Builder.Prim"+ [(">$<", [InTerms], LeftAssoc, 4), (">*<", [InTerms], RightAssoc, 5)],+ entry+ "Data.ByteString.Builder.Prim.Internal"+ [(">$<", [InTerms], LeftAssoc, 4), (">*<", [InTerms], RightAssoc, 5)],+ entry "Data.ByteString.Builder.RealFloat" [],+ entry+ "Data.ByteString.Char8"+ [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)],+ entry "Data.ByteString.Internal" [],+ entry+ "Data.ByteString.Lazy"+ [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("cons'", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)],+ entry+ "Data.ByteString.Lazy.Char8"+ [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("cons'", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)],+ entry "Data.ByteString.Lazy.Internal" [],+ entry+ "Data.ByteString.Short"+ [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)],+ entry+ "Data.ByteString.Short.Internal"+ [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)],+ entry "Data.ByteString.Unsafe" [],+ entry "Data.Char" [],+ entry "Data.Coerce" [],+ entry+ "Data.Complex"+ [(":+", [InTerms], NoAssoc, 6)],+ entry "Data.Containers.ListUtils" [],+ entry+ "Data.Data"+ [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4)],+ entry "Data.Dynamic" [],+ entry "Data.Either" [],+ entry "Data.Enum" [],+ entry+ "Data.Eq"+ [("/=", [InTerms], NoAssoc, 4), ("==", [InTerms], NoAssoc, 4)],+ entry "Data.Fixed" [],+ entry+ "Data.Foldable"+ [("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)],+ entry "Data.Foldable1" [],+ entry+ "Data.Function"+ [("$", [InTerms], RightAssoc, 0), ("&", [InTerms], LeftAssoc, 1), (".", [InTerms], RightAssoc, 9), ("on", [InTerms], LeftAssoc, 0)],+ entry+ "Data.Functor"+ [("$>", [InTerms], LeftAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<$>", [InTerms], LeftAssoc, 4), ("<&>", [InTerms], LeftAssoc, 1)],+ entry "Data.Functor.Classes" [],+ entry+ "Data.Functor.Compose"+ [("Compose", [InTypes, InTerms], RightAssoc, 9)],+ entry "Data.Functor.Const" [],+ entry "Data.Functor.Constant" [],+ entry+ "Data.Functor.Contravariant"+ [("$<", [InTerms], LeftAssoc, 4), (">$", [InTerms], LeftAssoc, 4), (">$$<", [InTerms], LeftAssoc, 4), (">$<", [InTerms], LeftAssoc, 4)],+ entry "Data.Functor.Identity" [],+ entry "Data.Functor.Product" [],+ entry "Data.Functor.Reverse" [],+ entry "Data.Functor.Sum" [],+ entry "Data.Graph" [],+ entry "Data.IORef" [],+ entry "Data.Int" [],+ entry+ "Data.IntMap"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)],+ entry+ "Data.IntMap.Internal"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)],+ entry "Data.IntMap.Internal.Debug" [],+ entry+ "Data.IntMap.Lazy"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)],+ entry "Data.IntMap.Merge.Lazy" [],+ entry "Data.IntMap.Merge.Strict" [],+ entry+ "Data.IntMap.Strict"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)],+ entry+ "Data.IntMap.Strict.Internal"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)],+ entry+ "Data.IntSet"+ [("\\\\", [InTerms], LeftAssoc, 9)],+ entry+ "Data.IntSet.Internal"+ [("\\\\", [InTerms], LeftAssoc, 9)],+ entry "Data.IntSet.Internal.IntTreeCommons" [],+ entry "Data.Ix" [],+ entry "Data.Kind" [],+ entry+ "Data.List"+ [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("\\\\", [InTerms], NoAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)],+ entry+ "Data.List.NonEmpty"+ [("!!", [InTerms], LeftAssoc, 9), (":|", [InTypes, InTerms], RightAssoc, 5), ("<|", [InTerms], RightAssoc, 5)],+ entry+ "Data.Map"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)],+ entry+ "Data.Map.Internal"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)],+ entry "Data.Map.Internal.Debug" [],+ entry+ "Data.Map.Lazy"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)],+ entry "Data.Map.Merge.Lazy" [],+ entry "Data.Map.Merge.Strict" [],+ entry+ "Data.Map.Strict"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)],+ entry+ "Data.Map.Strict.Internal"+ [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)],+ entry "Data.Maybe" [],+ entry+ "Data.Monoid"+ [("<>", [InTerms], RightAssoc, 6)],+ entry+ "Data.Ord"+ [("<", [InTerms], NoAssoc, 4), ("<=", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4)],+ entry "Data.Proxy" [],+ entry+ "Data.Ratio"+ [("%", [InTerms], LeftAssoc, 7)],+ entry "Data.STRef" [],+ entry "Data.STRef.Lazy" [],+ entry "Data.STRef.Strict" [],+ entry+ "Data.Semigroup"+ [("<>", [InTerms], RightAssoc, 6)],+ entry+ "Data.Sequence"+ [("!?", [InTerms], LeftAssoc, 9), (":<", [InTerms], RightAssoc, 5), (":<|", [InTerms], RightAssoc, 5), (":>", [InTerms], LeftAssoc, 5), (":|>", [InTerms], LeftAssoc, 5), ("<|", [InTerms], RightAssoc, 5), ("><", [InTerms], RightAssoc, 5), ("|>", [InTerms], LeftAssoc, 5)],+ entry+ "Data.Sequence.Internal"+ [("!?", [InTerms], LeftAssoc, 9), (":<", [InTerms], RightAssoc, 5), (":<|", [InTerms], RightAssoc, 5), (":>", [InTerms], LeftAssoc, 5), (":|>", [InTerms], LeftAssoc, 5), ("<|", [InTerms], RightAssoc, 5), ("><", [InTerms], RightAssoc, 5), ("|>", [InTerms], LeftAssoc, 5)],+ entry+ "Data.Sequence.Internal.Sorting"+ [("IQCons", [InTypes, InTerms], RightAssoc, 8), ("ITQCons", [InTypes, InTerms], RightAssoc, 8), ("QCons", [InTerms], RightAssoc, 8), ("TQCons", [InTypes, InTerms], RightAssoc, 8)],+ entry+ "Data.Set"+ [("\\\\", [InTerms], LeftAssoc, 9)],+ entry+ "Data.Set.Internal"+ [("\\\\", [InTerms], LeftAssoc, 9)],+ entry "Data.String" [],+ entry+ "Data.Text"+ [(":<", [InTerms], RightAssoc, 5), (":>", [InTerms], LeftAssoc, 5), ("cons", [InTerms], RightAssoc, 5)],+ entry "Data.Text.Array" [],+ entry "Data.Text.Encoding" [],+ entry "Data.Text.Encoding.Error" [],+ entry "Data.Text.Foreign" [],+ entry "Data.Text.IO" [],+ entry "Data.Text.IO.Utf8" [],+ entry+ "Data.Text.Internal"+ [("mul", [InTerms], LeftAssoc, 7), ("mul32", [InTerms], LeftAssoc, 7), ("mul64", [InTerms], LeftAssoc, 7)],+ entry "Data.Text.Internal.ArrayUtils" [],+ entry "Data.Text.Internal.Builder" [],+ entry+ "Data.Text.Internal.Builder.Functions"+ [("<>", [InTerms], RightAssoc, 4)],+ entry "Data.Text.Internal.Builder.Int.Digits" [],+ entry "Data.Text.Internal.Builder.RealFloat.Functions" [],+ entry "Data.Text.Internal.ByteStringCompat" [],+ entry "Data.Text.Internal.Encoding" [],+ entry "Data.Text.Internal.Encoding.Fusion" [],+ entry "Data.Text.Internal.Encoding.Fusion.Common" [],+ entry "Data.Text.Internal.Encoding.Utf16" [],+ entry "Data.Text.Internal.Encoding.Utf32" [],+ entry "Data.Text.Internal.Encoding.Utf8" [],+ entry "Data.Text.Internal.Fusion" [],+ entry "Data.Text.Internal.Fusion.CaseMapping" [],+ entry "Data.Text.Internal.Fusion.Common" [],+ entry "Data.Text.Internal.Fusion.Size" [],+ entry+ "Data.Text.Internal.Fusion.Types"+ [(":*:", [InTerms], LeftAssoc, 2)],+ entry "Data.Text.Internal.IO" [],+ entry "Data.Text.Internal.Lazy" [],+ entry "Data.Text.Internal.Lazy.Encoding.Fusion" [],+ entry "Data.Text.Internal.Lazy.Fusion" [],+ entry "Data.Text.Internal.Lazy.Search" [],+ entry "Data.Text.Internal.PrimCompat" [],+ entry "Data.Text.Internal.Private" [],+ entry "Data.Text.Internal.Read" [],+ entry "Data.Text.Internal.Search" [],+ entry "Data.Text.Internal.StrictBuilder" [],+ entry "Data.Text.Internal.Unsafe" [],+ entry "Data.Text.Internal.Unsafe.Char" [],+ entry "Data.Text.Internal.Validate" [],+ entry "Data.Text.Internal.Validate.Native" [],+ entry+ "Data.Text.Lazy"+ [(":<", [InTerms], RightAssoc, 5), (":>", [InTerms], LeftAssoc, 5), ("cons", [InTerms], RightAssoc, 5)],+ entry "Data.Text.Lazy.Builder" [],+ entry "Data.Text.Lazy.Builder.Int" [],+ entry "Data.Text.Lazy.Builder.RealFloat" [],+ entry "Data.Text.Lazy.Encoding" [],+ entry "Data.Text.Lazy.IO" [],+ entry "Data.Text.Lazy.Internal" [],+ entry "Data.Text.Lazy.Read" [],+ entry "Data.Text.Read" [],+ entry "Data.Text.Unsafe" [],+ entry "Data.Time" [],+ entry "Data.Time.Calendar" [],+ entry "Data.Time.Calendar.Easter" [],+ entry "Data.Time.Calendar.Julian" [],+ entry "Data.Time.Calendar.Month" [],+ entry "Data.Time.Calendar.MonthDay" [],+ entry "Data.Time.Calendar.OrdinalDate" [],+ entry "Data.Time.Calendar.Quarter" [],+ entry "Data.Time.Calendar.WeekDate" [],+ entry "Data.Time.Clock" [],+ entry "Data.Time.Clock.POSIX" [],+ entry "Data.Time.Clock.System" [],+ entry "Data.Time.Clock.TAI" [],+ entry "Data.Time.Format" [],+ entry "Data.Time.Format.ISO8601" [],+ entry "Data.Time.LocalTime" [],+ entry "Data.Traversable" [],+ entry "Data.Tree" [],+ entry "Data.Tuple" [],+ entry+ "Data.Type.Bool"+ [("&&", [InTypes], RightAssoc, 3), ("||", [InTypes], RightAssoc, 2)],+ entry "Data.Type.Coercion" [],+ entry+ "Data.Type.Equality"+ [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4), ("==", [InTypes], NoAssoc, 4), ("~~", [InTypes], NoAssoc, 4)],+ entry+ "Data.Type.Ord"+ [("<", [InTypes], NoAssoc, 4), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("<?", [InTypes], NoAssoc, 4), (">", [InTypes], NoAssoc, 4), (">=", [InTypes], NoAssoc, 4), (">=?", [InTypes], NoAssoc, 4), (">?", [InTypes], NoAssoc, 4)],+ entry+ "Data.Typeable"+ [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4)],+ entry "Data.Unique" [],+ entry "Data.Version" [],+ entry "Data.Void" [],+ entry "Data.Word" [],+ entry "Debug.Trace" [],+ entry+ "Foreign"+ [("!<<.", [InTerms], LeftAssoc, 8), ("!>>.", [InTerms], LeftAssoc, 8), (".&.", [InTerms], LeftAssoc, 7), (".<<.", [InTerms], LeftAssoc, 8), (".>>.", [InTerms], LeftAssoc, 8), (".^.", [InTerms], LeftAssoc, 6), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)],+ entry "Foreign.C" [],+ entry "Foreign.C.ConstPtr" [],+ entry "Foreign.C.Error" [],+ entry "Foreign.C.String" [],+ entry "Foreign.C.Types" [],+ entry "Foreign.Concurrent" [],+ entry "Foreign.ForeignPtr" [],+ entry "Foreign.ForeignPtr.Safe" [],+ entry "Foreign.ForeignPtr.Unsafe" [],+ entry "Foreign.Marshal" [],+ entry "Foreign.Marshal.Alloc" [],+ entry "Foreign.Marshal.Array" [],+ entry "Foreign.Marshal.Error" [],+ entry "Foreign.Marshal.Pool" [],+ entry "Foreign.Marshal.Safe" [],+ entry "Foreign.Marshal.Unsafe" [],+ entry "Foreign.Marshal.Utils" [],+ entry "Foreign.Ptr" [],+ entry+ "Foreign.Safe"+ [("!<<.", [InTerms], LeftAssoc, 8), ("!>>.", [InTerms], LeftAssoc, 8), (".&.", [InTerms], LeftAssoc, 7), (".<<.", [InTerms], LeftAssoc, 8), (".>>.", [InTerms], LeftAssoc, 8), (".^.", [InTerms], LeftAssoc, 6), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)],+ entry "Foreign.StablePtr" [],+ entry "Foreign.Storable" [],+ entry+ "GHC.Arr"+ [("!", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)],+ entry "GHC.ArrayArray" [],+ entry+ "GHC.Base"+ [("$", [InTerms], RightAssoc, 0), ("$!", [InTerms], RightAssoc, 0), ("&&", [InTerms], RightAssoc, 3), ("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("*>", [InTerms], LeftAssoc, 4), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("++", [InTerms], RightAssoc, 5), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), (".", [InTerms], RightAssoc, 9), ("/##", [InTerms], LeftAssoc, 7), ("/=", [InTerms], NoAssoc, 4), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), (":|", [InTypes, InTerms], RightAssoc, 5), ("<", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<*", [InTerms], LeftAssoc, 4), ("<**>", [InTerms], LeftAssoc, 4), ("<*>", [InTerms], LeftAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("<>", [InTerms], RightAssoc, 6), ("<|>", [InTerms], LeftAssoc, 3), ("=<<", [InTerms], RightAssoc, 1), ("==", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1), ("seq", [InTerms], RightAssoc, 0), ("||", [InTerms], RightAssoc, 2), ("~~", [InTypes], NoAssoc, 4)],+ entry+ "GHC.Bits"+ [(".&.", [InTerms], LeftAssoc, 7), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)],+ entry "GHC.Boot.TH.Lib" [],+ entry "GHC.Boot.TH.Lib.Map" [],+ entry "GHC.Boot.TH.Lift" [],+ entry "GHC.Boot.TH.Ppr" [],+ entry+ "GHC.Boot.TH.PprLib"+ [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)],+ entry "GHC.Boot.TH.Quote" [],+ entry "GHC.Boot.TH.Syntax" [],+ entry "GHC.ByteOrder" [],+ entry "GHC.CString" [],+ entry "GHC.Char" [],+ entry+ "GHC.Classes"+ [("&&", [InTerms], RightAssoc, 3), ("/=", [InTerms], NoAssoc, 4), ("<", [InTerms], NoAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("==", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), ("||", [InTerms], RightAssoc, 2)],+ entry "GHC.Clock" [],+ entry+ "GHC.Conc"+ [("par", [InTerms], RightAssoc, 0), ("pseq", [InTerms], RightAssoc, 0)],+ entry "GHC.Conc.IO" [],+ entry "GHC.Conc.Signal" [],+ entry+ "GHC.Conc.Sync"+ [("par", [InTerms], RightAssoc, 0), ("pseq", [InTerms], RightAssoc, 0)],+ entry "GHC.ConsoleHandler" [],+ entry "GHC.Constants" [],+ entry "GHC.Debug" [],+ entry+ "GHC.Desugar"+ [(">>>", [InTerms], LeftAssoc, 9)],+ entry "GHC.Encoding.UTF8" [],+ entry "GHC.Enum" [],+ entry "GHC.Environment" [],+ entry "GHC.Err" [],+ entry "GHC.Event" [],+ entry "GHC.Event.TimeOut" [],+ entry "GHC.Exception" [],+ entry "GHC.Exception.Type" [],+ entry "GHC.ExecutionStack" [],+ entry+ "GHC.Exts"+ [("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), ("/##", [InTerms], LeftAssoc, 7), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), ("seq", [InTerms], RightAssoc, 0), ("~~", [InTypes], NoAssoc, 4)],+ entry "GHC.Fingerprint" [],+ entry "GHC.Fingerprint.Type" [],+ entry+ "GHC.Float"+ [("**", [InTerms], RightAssoc, 8)],+ entry "GHC.Float.ConversionUtils" [],+ entry "GHC.Float.RealFracMethods" [],+ entry "GHC.Foreign" [],+ entry "GHC.ForeignPtr" [],+ entry "GHC.ForeignSrcLang.Type" [],+ entry "GHC.GHCi" [],+ entry "GHC.GHCi.Helpers" [],+ entry+ "GHC.Generics"+ [(":*:", [InTypes, InTerms], RightAssoc, 6), (":+:", [InTypes], RightAssoc, 5), (":.:", [InTypes], RightAssoc, 7)],+ entry "GHC.IO" [],+ entry "GHC.IO.Buffer" [],+ entry "GHC.IO.BufferedIO" [],+ entry "GHC.IO.Device" [],+ entry "GHC.IO.Encoding" [],+ entry "GHC.IO.Encoding.CodePage" [],+ entry "GHC.IO.Encoding.Failure" [],+ entry "GHC.IO.Encoding.Iconv" [],+ entry "GHC.IO.Encoding.Latin1" [],+ entry "GHC.IO.Encoding.Types" [],+ entry "GHC.IO.Encoding.UTF16" [],+ entry "GHC.IO.Encoding.UTF32" [],+ entry "GHC.IO.Encoding.UTF8" [],+ entry "GHC.IO.Exception" [],+ entry "GHC.IO.FD" [],+ entry "GHC.IO.Handle" [],+ entry "GHC.IO.Handle.FD" [],+ entry "GHC.IO.Handle.Internals" [],+ entry "GHC.IO.Handle.Lock" [],+ entry "GHC.IO.Handle.Text" [],+ entry "GHC.IO.Handle.Types" [],+ entry "GHC.IO.IOMode" [],+ entry "GHC.IO.StdHandles" [],+ entry+ "GHC.IO.SubSystem"+ [("<!>", [InTerms], LeftAssoc, 7)],+ entry "GHC.IO.Unsafe" [],+ entry "GHC.IOArray" [],+ entry "GHC.IORef" [],+ entry "GHC.InfoProv" [],+ entry "GHC.Int" [],+ entry "GHC.Integer" [],+ entry "GHC.Integer.Logarithms" [],+ entry "GHC.Internal.AllocationLimitHandler" [],+ entry+ "GHC.Internal.Arr"+ [("!", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)],+ entry "GHC.Internal.ArrayArray" [],+ entry+ "GHC.Internal.Base"+ [("$", [InTerms], RightAssoc, 0), ("$!", [InTerms], RightAssoc, 0), ("&&", [InTerms], RightAssoc, 3), ("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("*>", [InTerms], LeftAssoc, 4), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("++", [InTerms], RightAssoc, 5), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), (".", [InTerms], RightAssoc, 9), ("/##", [InTerms], LeftAssoc, 7), ("/=", [InTerms], NoAssoc, 4), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), (":|", [InTypes, InTerms], RightAssoc, 5), ("<", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<*", [InTerms], LeftAssoc, 4), ("<**>", [InTerms], LeftAssoc, 4), ("<*>", [InTerms], LeftAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("<>", [InTerms], RightAssoc, 6), ("<|>", [InTerms], LeftAssoc, 3), ("=<<", [InTerms], RightAssoc, 1), ("==", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1), ("seq", [InTerms], RightAssoc, 0), ("||", [InTerms], RightAssoc, 2), ("~~", [InTypes], NoAssoc, 4)],+ entry "GHC.Internal.Bignum.Backend" [],+ entry "GHC.Internal.Bignum.Backend.Native" [],+ entry "GHC.Internal.Bignum.Backend.Selected" [],+ entry "GHC.Internal.Bignum.BigNat" [],+ entry "GHC.Internal.Bignum.Integer" [],+ entry "GHC.Internal.Bignum.Natural" [],+ entry+ "GHC.Internal.Bignum.Primitives"+ [("&&#", [InTerms], RightAssoc, 3), ("||#", [InTerms], RightAssoc, 2)],+ entry "GHC.Internal.Bignum.WordArray" [],+ entry+ "GHC.Internal.Bits"+ [(".&.", [InTerms], LeftAssoc, 7), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)],+ entry "GHC.Internal.ByteOrder" [],+ entry "GHC.Internal.CString" [],+ entry "GHC.Internal.Char" [],+ entry+ "GHC.Internal.Classes"+ [("&&", [InTerms], RightAssoc, 3), ("/=", [InTerms], NoAssoc, 4), ("<", [InTerms], NoAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("==", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), ("||", [InTerms], RightAssoc, 2)],+ entry "GHC.Internal.Clock" [],+ entry "GHC.Internal.ClosureTypes" [],+ entry "GHC.Internal.Conc.Bound" [],+ entry "GHC.Internal.Conc.IO" [],+ entry "GHC.Internal.Conc.Signal" [],+ entry+ "GHC.Internal.Conc.Sync"+ [("par", [InTerms], RightAssoc, 0), ("pseq", [InTerms], RightAssoc, 0)],+ entry "GHC.Internal.ConsoleHandler" [],+ entry+ "GHC.Internal.Control.Arrow"+ [("&&&", [InTerms], RightAssoc, 3), ("***", [InTerms], RightAssoc, 3), ("+++", [InTerms], RightAssoc, 2), ("<+>", [InTerms], RightAssoc, 5), ("<<<", [InTerms], RightAssoc, 1), ("<<^", [InTerms], RightAssoc, 1), (">>>", [InTerms], RightAssoc, 1), (">>^", [InTerms], RightAssoc, 1), ("^<<", [InTerms], RightAssoc, 1), ("^>>", [InTerms], RightAssoc, 1), ("|||", [InTerms], RightAssoc, 2)],+ entry+ "GHC.Internal.Control.Category"+ [(".", [InTerms], RightAssoc, 9), ("<<<", [InTerms], RightAssoc, 1), (">>>", [InTerms], RightAssoc, 1)],+ entry "GHC.Internal.Control.Concurrent.MVar" [],+ entry "GHC.Internal.Control.Exception" [],+ entry "GHC.Internal.Control.Exception.Base" [],+ entry+ "GHC.Internal.Control.Monad"+ [("<$", [InTerms], LeftAssoc, 4), ("<$!>", [InTerms], LeftAssoc, 4), ("<=<", [InTerms], RightAssoc, 1), ("=<<", [InTerms], RightAssoc, 1), (">=>", [InTerms], RightAssoc, 1), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1)],+ entry "GHC.Internal.Control.Monad.Fail" [],+ entry "GHC.Internal.Control.Monad.Fix" [],+ entry "GHC.Internal.Control.Monad.IO.Class" [],+ entry "GHC.Internal.Control.Monad.ST" [],+ entry "GHC.Internal.Control.Monad.ST.Imp" [],+ entry "GHC.Internal.Control.Monad.ST.Lazy" [],+ entry "GHC.Internal.Control.Monad.ST.Lazy.Imp" [],+ entry "GHC.Internal.Control.Monad.Zip" [],+ entry+ "GHC.Internal.Data.Bits"+ [("!<<.", [InTerms], LeftAssoc, 8), ("!>>.", [InTerms], LeftAssoc, 8), (".&.", [InTerms], LeftAssoc, 7), (".<<.", [InTerms], LeftAssoc, 8), (".>>.", [InTerms], LeftAssoc, 8), (".^.", [InTerms], LeftAssoc, 6), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)],+ entry+ "GHC.Internal.Data.Bool"+ [("&&", [InTerms], RightAssoc, 3), ("||", [InTerms], RightAssoc, 2)],+ entry "GHC.Internal.Data.Coerce" [],+ entry "GHC.Internal.Data.Data" [],+ entry "GHC.Internal.Data.Dynamic" [],+ entry "GHC.Internal.Data.Either" [],+ entry+ "GHC.Internal.Data.Eq"+ [("/=", [InTerms], NoAssoc, 4), ("==", [InTerms], NoAssoc, 4)],+ entry+ "GHC.Internal.Data.Foldable"+ [("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)],+ entry+ "GHC.Internal.Data.Function"+ [("$", [InTerms], RightAssoc, 0), ("&", [InTerms], LeftAssoc, 1), (".", [InTerms], RightAssoc, 9), ("on", [InTerms], LeftAssoc, 0)],+ entry+ "GHC.Internal.Data.Functor"+ [("$>", [InTerms], LeftAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<$>", [InTerms], LeftAssoc, 4), ("<&>", [InTerms], LeftAssoc, 1)],+ entry "GHC.Internal.Data.Functor.Const" [],+ entry "GHC.Internal.Data.Functor.Identity" [],+ entry+ "GHC.Internal.Data.Functor.Utils"+ [("#.", [InTypes, InTerms], LeftAssoc, 9)],+ entry "GHC.Internal.Data.IORef" [],+ entry "GHC.Internal.Data.Ix" [],+ entry+ "GHC.Internal.Data.List"+ [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("\\\\", [InTerms], NoAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)],+ entry+ "GHC.Internal.Data.List.NonEmpty"+ [(":|", [InTypes, InTerms], RightAssoc, 5)],+ entry "GHC.Internal.Data.Maybe" [],+ entry+ "GHC.Internal.Data.Monoid"+ [("<>", [InTerms], RightAssoc, 6)],+ entry+ "GHC.Internal.Data.NonEmpty"+ [(":|", [InTypes, InTerms], RightAssoc, 5)],+ entry+ "GHC.Internal.Data.OldList"+ [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("\\\\", [InTerms], NoAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)],+ entry+ "GHC.Internal.Data.Ord"+ [("<", [InTerms], NoAssoc, 4), ("<=", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4)],+ entry "GHC.Internal.Data.Proxy" [],+ entry "GHC.Internal.Data.STRef" [],+ entry "GHC.Internal.Data.STRef.Strict" [],+ entry "GHC.Internal.Data.Semigroup.Internal" [],+ entry "GHC.Internal.Data.String" [],+ entry "GHC.Internal.Data.Traversable" [],+ entry "GHC.Internal.Data.Tuple" [],+ entry+ "GHC.Internal.Data.Type.Bool"+ [("&&", [InTypes], RightAssoc, 3), ("||", [InTypes], RightAssoc, 2)],+ entry "GHC.Internal.Data.Type.Coercion" [],+ entry+ "GHC.Internal.Data.Type.Equality"+ [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4), ("==", [InTypes], NoAssoc, 4), ("~~", [InTypes], NoAssoc, 4)],+ entry+ "GHC.Internal.Data.Type.Ord"+ [("<", [InTypes], NoAssoc, 4), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("<?", [InTypes], NoAssoc, 4), (">", [InTypes], NoAssoc, 4), (">=", [InTypes], NoAssoc, 4), (">=?", [InTypes], NoAssoc, 4), (">?", [InTypes], NoAssoc, 4)],+ entry+ "GHC.Internal.Data.Typeable"+ [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4)],+ entry "GHC.Internal.Data.Unique" [],+ entry "GHC.Internal.Data.Version" [],+ entry "GHC.Internal.Data.Void" [],+ entry "GHC.Internal.Debug" [],+ entry "GHC.Internal.Debug.Trace" [],+ entry+ "GHC.Internal.Desugar"+ [(">>>", [InTerms], LeftAssoc, 9)],+ entry "GHC.Internal.Encoding.UTF8" [],+ entry "GHC.Internal.Enum" [],+ entry "GHC.Internal.Environment" [],+ entry "GHC.Internal.Err" [],+ entry "GHC.Internal.Event" [],+ entry "GHC.Internal.Event.TimeOut" [],+ entry "GHC.Internal.Exception" [],+ entry "GHC.Internal.Exception.Backtrace" [],+ entry "GHC.Internal.Exception.Context" [],+ entry "GHC.Internal.Exception.Type" [],+ entry "GHC.Internal.ExecutionStack" [],+ entry "GHC.Internal.ExecutionStack.Internal" [],+ entry+ "GHC.Internal.Exts"+ [("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), ("/##", [InTerms], LeftAssoc, 7), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), ("seq", [InTerms], RightAssoc, 0), ("~~", [InTypes], NoAssoc, 4)],+ entry "GHC.Internal.Fingerprint" [],+ entry "GHC.Internal.Fingerprint.Type" [],+ entry+ "GHC.Internal.Float"+ [("**", [InTerms], RightAssoc, 8)],+ entry "GHC.Internal.Float.ConversionUtils" [],+ entry "GHC.Internal.Float.RealFracMethods" [],+ entry "GHC.Internal.Foreign.C.ConstPtr" [],+ entry "GHC.Internal.Foreign.C.Error" [],+ entry "GHC.Internal.Foreign.C.String" [],+ entry "GHC.Internal.Foreign.C.String.Encoding" [],+ entry "GHC.Internal.Foreign.C.Types" [],+ entry "GHC.Internal.Foreign.Concurrent" [],+ entry "GHC.Internal.Foreign.ForeignPtr" [],+ entry "GHC.Internal.Foreign.ForeignPtr.Imp" [],+ entry "GHC.Internal.Foreign.ForeignPtr.Unsafe" [],+ entry "GHC.Internal.Foreign.Marshal.Alloc" [],+ entry "GHC.Internal.Foreign.Marshal.Array" [],+ entry "GHC.Internal.Foreign.Marshal.Error" [],+ entry "GHC.Internal.Foreign.Marshal.Pool" [],+ entry "GHC.Internal.Foreign.Marshal.Safe" [],+ entry "GHC.Internal.Foreign.Marshal.Unsafe" [],+ entry "GHC.Internal.Foreign.Marshal.Utils" [],+ entry "GHC.Internal.Foreign.Ptr" [],+ entry "GHC.Internal.Foreign.StablePtr" [],+ entry "GHC.Internal.Foreign.Storable" [],+ entry "GHC.Internal.ForeignPtr" [],+ entry "GHC.Internal.ForeignSrcLang" [],+ entry "GHC.Internal.Functor.ZipList" [],+ entry "GHC.Internal.GHCi" [],+ entry "GHC.Internal.GHCi.Helpers" [],+ entry+ "GHC.Internal.Generics"+ [(":*:", [InTypes, InTerms], RightAssoc, 6), (":+:", [InTypes], RightAssoc, 5), (":.:", [InTypes], RightAssoc, 7)],+ entry "GHC.Internal.Heap.Closures" [],+ entry "GHC.Internal.Heap.Constants" [],+ entry "GHC.Internal.Heap.InfoTable" [],+ entry "GHC.Internal.Heap.InfoTable.Types" [],+ entry "GHC.Internal.Heap.InfoTableProf" [],+ entry "GHC.Internal.Heap.ProfInfo.Types" [],+ entry "GHC.Internal.IO" [],+ entry "GHC.Internal.IO.Buffer" [],+ entry "GHC.Internal.IO.BufferedIO" [],+ entry "GHC.Internal.IO.Device" [],+ entry "GHC.Internal.IO.Encoding" [],+ entry "GHC.Internal.IO.Encoding.CodePage" [],+ entry "GHC.Internal.IO.Encoding.Failure" [],+ entry "GHC.Internal.IO.Encoding.Iconv" [],+ entry "GHC.Internal.IO.Encoding.Latin1" [],+ entry "GHC.Internal.IO.Encoding.Types" [],+ entry "GHC.Internal.IO.Encoding.UTF16" [],+ entry "GHC.Internal.IO.Encoding.UTF32" [],+ entry "GHC.Internal.IO.Encoding.UTF8" [],+ entry "GHC.Internal.IO.Exception" [],+ entry "GHC.Internal.IO.FD" [],+ entry "GHC.Internal.IO.Handle" [],+ entry "GHC.Internal.IO.Handle.FD" [],+ entry "GHC.Internal.IO.Handle.Internals" [],+ entry "GHC.Internal.IO.Handle.Lock" [],+ entry "GHC.Internal.IO.Handle.Text" [],+ entry "GHC.Internal.IO.Handle.Types" [],+ entry "GHC.Internal.IO.IOMode" [],+ entry "GHC.Internal.IO.StdHandles" [],+ entry+ "GHC.Internal.IO.SubSystem"+ [("<!>", [InTerms], LeftAssoc, 7)],+ entry "GHC.Internal.IO.Unsafe" [],+ entry "GHC.Internal.IOArray" [],+ entry "GHC.Internal.IORef" [],+ entry "GHC.Internal.InfoProv" [],+ entry "GHC.Internal.InfoProv.Types" [],+ entry "GHC.Internal.Int" [],+ entry "GHC.Internal.Integer" [],+ entry "GHC.Internal.Integer.Logarithms" [],+ entry "GHC.Internal.IsList" [],+ entry "GHC.Internal.Ix" [],+ entry "GHC.Internal.LanguageExtensions" [],+ entry "GHC.Internal.Lexeme" [],+ entry+ "GHC.Internal.List"+ [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)],+ entry "GHC.Internal.MVar" [],+ entry "GHC.Internal.Magic" [],+ entry "GHC.Internal.Magic.Dict" [],+ entry "GHC.Internal.Maybe" [],+ entry "GHC.Internal.Natural" [],+ entry+ "GHC.Internal.Num"+ [("*", [InTerms], LeftAssoc, 7), ("+", [InTerms], LeftAssoc, 6), ("-", [InTerms], LeftAssoc, 6)],+ entry+ "GHC.Internal.Numeric"+ [("**", [InTerms], RightAssoc, 8)],+ entry "GHC.Internal.Numeric.Natural" [],+ entry "GHC.Internal.OverloadedLabels" [],+ entry "GHC.Internal.Pack" [],+ entry+ "GHC.Internal.Prim"+ [("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), ("/##", [InTerms], LeftAssoc, 7), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), ("seq", [InTerms], RightAssoc, 0)],+ entry "GHC.Internal.Prim.Exception" [],+ entry "GHC.Internal.Prim.Ext" [],+ entry "GHC.Internal.Prim.Panic" [],+ entry "GHC.Internal.Prim.PtrEq" [],+ entry+ "GHC.Internal.PrimopWrappers"+ [("*#", [InTerms], LeftAssoc, 9), ("*##", [InTerms], LeftAssoc, 9), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 9), ("+##", [InTerms], LeftAssoc, 9), ("-#", [InTerms], LeftAssoc, 9), ("-##", [InTerms], LeftAssoc, 9), ("/##", [InTerms], LeftAssoc, 9), ("/=#", [InTerms], LeftAssoc, 9), ("/=##", [InTerms], LeftAssoc, 9), ("<#", [InTerms], LeftAssoc, 9), ("<##", [InTerms], LeftAssoc, 9), ("<=#", [InTerms], LeftAssoc, 9), ("<=##", [InTerms], LeftAssoc, 9), ("==#", [InTerms], LeftAssoc, 9), ("==##", [InTerms], LeftAssoc, 9), (">#", [InTerms], LeftAssoc, 9), (">##", [InTerms], LeftAssoc, 9), (">=#", [InTerms], LeftAssoc, 9), (">=##", [InTerms], LeftAssoc, 9)],+ entry "GHC.Internal.Profiling" [],+ entry "GHC.Internal.Ptr" [],+ entry "GHC.Internal.RTS.Flags" [],+ entry "GHC.Internal.RTS.Flags.Test" [],+ entry "GHC.Internal.Read" [],+ entry+ "GHC.Internal.Real"+ [("%", [InTerms], LeftAssoc, 7), ("/", [InTerms], LeftAssoc, 7), (":%", [InTerms], LeftAssoc, 9), ("^", [InTerms], RightAssoc, 8), ("^%^", [InTerms], LeftAssoc, 9), ("^^", [InTerms], RightAssoc, 8), ("^^%^^", [InTerms], LeftAssoc, 9), ("div", [InTerms], LeftAssoc, 7), ("mod", [InTerms], LeftAssoc, 7), ("quot", [InTerms], LeftAssoc, 7), ("rem", [InTerms], LeftAssoc, 7)],+ entry "GHC.Internal.Records" [],+ entry "GHC.Internal.ResponseFile" [],+ entry "GHC.Internal.ST" [],+ entry "GHC.Internal.STRef" [],+ entry "GHC.Internal.Show" [],+ entry "GHC.Internal.Stable" [],+ entry "GHC.Internal.StableName" [],+ entry "GHC.Internal.Stack" [],+ entry "GHC.Internal.Stack.Annotation" [],+ entry "GHC.Internal.Stack.CCS" [],+ entry "GHC.Internal.Stack.CloneStack" [],+ entry "GHC.Internal.Stack.Constants" [],+ entry "GHC.Internal.Stack.ConstantsProf" [],+ entry "GHC.Internal.Stack.Decode" [],+ entry "GHC.Internal.Stack.Types" [],+ entry "GHC.Internal.StaticPtr" [],+ entry "GHC.Internal.Stats" [],+ entry "GHC.Internal.Storable" [],+ entry "GHC.Internal.System.Environment" [],+ entry "GHC.Internal.System.Environment.Blank" [],+ entry "GHC.Internal.System.Exit" [],+ entry "GHC.Internal.System.IO" [],+ entry "GHC.Internal.System.IO.Error" [],+ entry "GHC.Internal.System.Mem" [],+ entry "GHC.Internal.System.Mem.StableName" [],+ entry "GHC.Internal.System.Posix.Internals" [],+ entry "GHC.Internal.System.Posix.Types" [],+ entry "GHC.Internal.TH.Lib" [],+ entry "GHC.Internal.TH.Lift" [],+ entry "GHC.Internal.TH.Quote" [],+ entry "GHC.Internal.TH.Syntax" [],+ entry+ "GHC.Internal.Text.ParserCombinators.ReadP"+ [("+++", [InTerms], RightAssoc, 5), ("<++", [InTerms], RightAssoc, 5)],+ entry+ "GHC.Internal.Text.ParserCombinators.ReadPrec"+ [("+++", [InTerms], LeftAssoc, 9), ("<++", [InTerms], LeftAssoc, 9)],+ entry+ "GHC.Internal.Text.Read"+ [("+++", [InTerms], LeftAssoc, 9), ("<++", [InTerms], LeftAssoc, 9)],+ entry "GHC.Internal.Text.Read.Lex" [],+ entry "GHC.Internal.Text.Show" [],+ entry "GHC.Internal.TopHandler" [],+ entry+ "GHC.Internal.Tuple"+ [("()", [InTypes, InTerms], LeftAssoc, 9), ("(,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9)],+ entry+ "GHC.Internal.Type.Reflection"+ [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4)],+ entry "GHC.Internal.Type.Reflection.Unsafe" [],+ entry+ "GHC.Internal.TypeError"+ [(":$$:", [InTerms], LeftAssoc, 5), (":<>:", [InTerms], LeftAssoc, 6)],+ entry+ "GHC.Internal.TypeLits"+ [("*", [InTypes], LeftAssoc, 7), ("+", [InTypes], LeftAssoc, 6), ("-", [InTypes], LeftAssoc, 6), (":$$:", [InTerms], LeftAssoc, 5), (":<>:", [InTerms], LeftAssoc, 6), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("Div", [InTypes], LeftAssoc, 7), ("Mod", [InTypes], LeftAssoc, 7), ("^", [InTypes], RightAssoc, 8)],+ entry "GHC.Internal.TypeLits.Internal" [],+ entry+ "GHC.Internal.TypeNats"+ [("*", [InTypes], LeftAssoc, 7), ("+", [InTypes], LeftAssoc, 6), ("-", [InTypes], LeftAssoc, 6), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("Div", [InTypes], LeftAssoc, 7), ("Mod", [InTypes], LeftAssoc, 7), ("^", [InTypes], RightAssoc, 8)],+ entry "GHC.Internal.TypeNats.Internal" [],+ entry+ "GHC.Internal.Types"+ [("~~", [InTypes], NoAssoc, 4)],+ entry "GHC.Internal.Unicode" [],+ entry "GHC.Internal.Unsafe.Coerce" [],+ entry "GHC.Internal.Weak" [],+ entry "GHC.Internal.Weak.Finalize" [],+ entry "GHC.Internal.Word" [],+ entry "GHC.IsList" [],+ entry "GHC.Ix" [],+ entry "GHC.LanguageExtensions.Type" [],+ entry "GHC.Lexeme" [],+ entry+ "GHC.List"+ [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)],+ entry "GHC.MVar" [],+ entry "GHC.Magic" [],+ entry "GHC.Magic.Dict" [],+ entry "GHC.Maybe" [],+ entry "GHC.Natural" [],+ entry+ "GHC.Num"+ [("*", [InTerms], LeftAssoc, 7), ("+", [InTerms], LeftAssoc, 6), ("-", [InTerms], LeftAssoc, 6)],+ entry "GHC.Num.Backend" [],+ entry "GHC.Num.Backend.Native" [],+ entry "GHC.Num.Backend.Selected" [],+ entry "GHC.Num.BigNat" [],+ entry "GHC.Num.Integer" [],+ entry "GHC.Num.Natural" [],+ entry+ "GHC.Num.Primitives"+ [("&&#", [InTerms], RightAssoc, 3), ("||#", [InTerms], RightAssoc, 2)],+ entry "GHC.Num.WordArray" [],+ entry+ "GHC.OldList"+ [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("\\\\", [InTerms], NoAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)],+ entry "GHC.OverloadedLabels" [],+ entry+ "GHC.Prim"+ [("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), ("/##", [InTerms], LeftAssoc, 7), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), ("seq", [InTerms], RightAssoc, 0)],+ entry "GHC.Prim.Exception" [],+ entry "GHC.Prim.Ext" [],+ entry "GHC.Prim.Panic" [],+ entry "GHC.Prim.PtrEq" [],+ entry+ "GHC.PrimopWrappers"+ [("*#", [InTerms], LeftAssoc, 9), ("*##", [InTerms], LeftAssoc, 9), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 9), ("+##", [InTerms], LeftAssoc, 9), ("-#", [InTerms], LeftAssoc, 9), ("-##", [InTerms], LeftAssoc, 9), ("/##", [InTerms], LeftAssoc, 9), ("/=#", [InTerms], LeftAssoc, 9), ("/=##", [InTerms], LeftAssoc, 9), ("<#", [InTerms], LeftAssoc, 9), ("<##", [InTerms], LeftAssoc, 9), ("<=#", [InTerms], LeftAssoc, 9), ("<=##", [InTerms], LeftAssoc, 9), ("==#", [InTerms], LeftAssoc, 9), ("==##", [InTerms], LeftAssoc, 9), (">#", [InTerms], LeftAssoc, 9), (">##", [InTerms], LeftAssoc, 9), (">=#", [InTerms], LeftAssoc, 9), (">=##", [InTerms], LeftAssoc, 9)],+ entry "GHC.Profiling" [],+ entry "GHC.Ptr" [],+ entry "GHC.RTS.Flags" [],+ entry "GHC.Read" [],+ entry+ "GHC.Real"+ [("%", [InTerms], LeftAssoc, 7), ("/", [InTerms], LeftAssoc, 7), (":%", [InTerms], LeftAssoc, 9), ("^", [InTerms], RightAssoc, 8), ("^%^", [InTerms], LeftAssoc, 9), ("^^", [InTerms], RightAssoc, 8), ("^^%^^", [InTerms], LeftAssoc, 9), ("div", [InTerms], LeftAssoc, 7), ("mod", [InTerms], LeftAssoc, 7), ("quot", [InTerms], LeftAssoc, 7), ("rem", [InTerms], LeftAssoc, 7)],+ entry "GHC.Records" [],+ entry "GHC.ResponseFile" [],+ entry "GHC.ST" [],+ entry "GHC.STRef" [],+ entry "GHC.Show" [],+ entry "GHC.Stable" [],+ entry "GHC.StableName" [],+ entry "GHC.Stack" [],+ entry "GHC.Stack.CCS" [],+ entry "GHC.Stack.CloneStack" [],+ entry "GHC.Stack.Types" [],+ entry "GHC.StaticPtr" [],+ entry "GHC.Stats" [],+ entry "GHC.Storable" [],+ entry "GHC.TopHandler" [],+ entry+ "GHC.Tuple"+ [("()", [InTypes, InTerms], LeftAssoc, 9), ("(,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9)],+ entry+ "GHC.TypeError"+ [(":$$:", [InTerms], LeftAssoc, 5), (":<>:", [InTerms], LeftAssoc, 6)],+ entry+ "GHC.TypeLits"+ [("*", [InTypes], LeftAssoc, 7), ("+", [InTypes], LeftAssoc, 6), ("-", [InTypes], LeftAssoc, 6), (":$$:", [InTerms], LeftAssoc, 5), (":<>:", [InTerms], LeftAssoc, 6), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("Div", [InTypes], LeftAssoc, 7), ("Mod", [InTypes], LeftAssoc, 7), ("^", [InTypes], RightAssoc, 8)],+ entry+ "GHC.TypeNats"+ [("*", [InTypes], LeftAssoc, 7), ("+", [InTypes], LeftAssoc, 6), ("-", [InTypes], LeftAssoc, 6), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("Div", [InTypes], LeftAssoc, 7), ("Mod", [InTypes], LeftAssoc, 7), ("^", [InTypes], RightAssoc, 8)],+ entry+ "GHC.Types"+ [("~~", [InTypes], NoAssoc, 4)],+ entry "GHC.Unicode" [],+ entry "GHC.Weak" [],+ entry "GHC.Weak.Finalize" [],+ entry "GHC.Word" [],+ entry "Language.Haskell.TH" [],+ entry+ "Language.Haskell.TH.CodeDo"+ [(">>", [InTerms], LeftAssoc, 9), (">>=", [InTerms], LeftAssoc, 9)],+ entry "Language.Haskell.TH.LanguageExtensions" [],+ entry "Language.Haskell.TH.Lib" [],+ entry "Language.Haskell.TH.Ppr" [],+ entry+ "Language.Haskell.TH.PprLib"+ [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)],+ entry "Language.Haskell.TH.Quote" [],+ entry "Language.Haskell.TH.Syntax" [],+ entry+ "Numeric"+ [("**", [InTerms], RightAssoc, 8)],+ entry "Numeric.Natural" [],+ entry+ "Prelude"+ [("!!", [InTerms], LeftAssoc, 9), ("$", [InTerms], RightAssoc, 0), ("$!", [InTerms], RightAssoc, 0), ("&&", [InTerms], RightAssoc, 3), ("*", [InTerms], LeftAssoc, 7), ("**", [InTerms], RightAssoc, 8), ("*>", [InTerms], LeftAssoc, 4), ("+", [InTerms], LeftAssoc, 6), ("++", [InTerms], RightAssoc, 5), ("-", [InTerms], LeftAssoc, 6), (".", [InTerms], RightAssoc, 9), ("/", [InTerms], LeftAssoc, 7), ("/=", [InTerms], NoAssoc, 4), (":", [InTerms], RightAssoc, 5), ("<", [InTerms], NoAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<$>", [InTerms], LeftAssoc, 4), ("<*", [InTerms], LeftAssoc, 4), ("<*>", [InTerms], LeftAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("<>", [InTerms], RightAssoc, 6), ("=<<", [InTerms], RightAssoc, 1), ("==", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1), ("^", [InTerms], RightAssoc, 8), ("^^", [InTerms], RightAssoc, 8), ("div", [InTerms], LeftAssoc, 7), ("elem", [InTerms], NoAssoc, 4), ("mod", [InTerms], LeftAssoc, 7), ("notElem", [InTerms], NoAssoc, 4), ("quot", [InTerms], LeftAssoc, 7), ("rem", [InTerms], LeftAssoc, 7), ("seq", [InTerms], RightAssoc, 0), ("||", [InTerms], RightAssoc, 2)],+ entry "System.CPUTime" [],+ entry "System.Cmd" [],+ entry "System.Console.GetOpt" [],+ entry "System.Directory" [],+ entry "System.Directory.Internal" [],+ entry+ "System.Directory.Internal.Prelude"+ [("!!", [InTerms], LeftAssoc, 9), ("$", [InTerms], RightAssoc, 0), ("$!", [InTerms], RightAssoc, 0), ("&&", [InTerms], RightAssoc, 3), ("*", [InTerms], LeftAssoc, 7), ("**", [InTerms], RightAssoc, 8), ("*>", [InTerms], LeftAssoc, 4), ("+", [InTerms], LeftAssoc, 6), ("++", [InTerms], RightAssoc, 5), ("-", [InTerms], LeftAssoc, 6), (".", [InTerms], RightAssoc, 9), (".&.", [InTerms], LeftAssoc, 7), (".|.", [InTerms], LeftAssoc, 5), ("/", [InTerms], LeftAssoc, 7), ("/=", [InTerms], NoAssoc, 4), ("<", [InTerms], NoAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<$>", [InTerms], LeftAssoc, 4), ("<*", [InTerms], LeftAssoc, 4), ("<*>", [InTerms], LeftAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("<=<", [InTerms], RightAssoc, 1), ("<>", [InTerms], RightAssoc, 6), ("=<<", [InTerms], RightAssoc, 1), ("==", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), (">=>", [InTerms], RightAssoc, 1), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1), ("^", [InTerms], RightAssoc, 8), ("^^", [InTerms], RightAssoc, 8), ("div", [InTerms], LeftAssoc, 7), ("elem", [InTerms], NoAssoc, 4), ("mod", [InTerms], LeftAssoc, 7), ("notElem", [InTerms], NoAssoc, 4), ("on", [InTerms], LeftAssoc, 0), ("quot", [InTerms], LeftAssoc, 7), ("rem", [InTerms], LeftAssoc, 7), ("seq", [InTerms], RightAssoc, 0), ("||", [InTerms], RightAssoc, 2)],+ entry "System.Directory.OsPath" [],+ entry "System.Environment" [],+ entry "System.Environment.Blank" [],+ entry "System.Exit" [],+ entry+ "System.FilePath"+ [("-<.>", [InTerms], RightAssoc, 7), ("<.>", [InTerms], RightAssoc, 7), ("</>", [InTerms], RightAssoc, 5)],+ entry+ "System.FilePath.Posix"+ [("-<.>", [InTerms], RightAssoc, 7), ("<.>", [InTerms], RightAssoc, 7), ("</>", [InTerms], RightAssoc, 5)],+ entry+ "System.FilePath.Windows"+ [("-<.>", [InTerms], RightAssoc, 7), ("<.>", [InTerms], RightAssoc, 7), ("</>", [InTerms], RightAssoc, 5)],+ entry "System.IO" [],+ entry "System.IO.Error" [],+ entry "System.IO.Unsafe" [],+ entry "System.Info" [],+ entry "System.Mem" [],+ entry "System.Mem.StableName" [],+ entry "System.Mem.Weak" [],+ entry+ "System.OsPath"+ [("-<.>", [InTerms], LeftAssoc, 9), ("<.>", [InTerms], LeftAssoc, 9), ("</>", [InTerms], LeftAssoc, 9)],+ entry "System.OsPath.Encoding" [],+ entry "System.OsPath.Internal" [],+ entry+ "System.OsPath.Posix"+ [("-<.>", [InTerms], LeftAssoc, 9), ("<.>", [InTerms], LeftAssoc, 9), ("</>", [InTerms], LeftAssoc, 9)],+ entry+ "System.OsPath.Posix.Internal"+ [("-<.>", [InTerms], RightAssoc, 7), ("<.>", [InTerms], RightAssoc, 7), ("</>", [InTerms], RightAssoc, 5)],+ entry "System.OsPath.Types" [],+ entry+ "System.OsPath.Windows"+ [("-<.>", [InTerms], LeftAssoc, 9), ("<.>", [InTerms], LeftAssoc, 9), ("</>", [InTerms], LeftAssoc, 9)],+ entry+ "System.OsPath.Windows.Internal"+ [("-<.>", [InTerms], RightAssoc, 7), ("<.>", [InTerms], RightAssoc, 7), ("</>", [InTerms], RightAssoc, 5)],+ entry+ "System.OsString"+ [("!?", [InTerms], LeftAssoc, 9)],+ entry+ "System.OsString.Data.ByteString.Short"+ [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)],+ entry "System.OsString.Data.ByteString.Short.Internal" [],+ entry+ "System.OsString.Data.ByteString.Short.Word16"+ [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)],+ entry "System.OsString.Encoding" [],+ entry "System.OsString.Encoding.Internal" [],+ entry+ "System.OsString.Internal"+ [("!?", [InTerms], LeftAssoc, 9)],+ entry "System.OsString.Internal.Exception" [],+ entry "System.OsString.Internal.Types" [],+ entry+ "System.OsString.Posix"+ [("!?", [InTerms], LeftAssoc, 9)],+ entry+ "System.OsString.Windows"+ [("!?", [InTerms], LeftAssoc, 9)],+ entry+ "System.Posix"+ [("addSignal", [InTerms], RightAssoc, 9), ("deleteSignal", [InTerms], RightAssoc, 9)],+ entry+ "System.Posix.ByteString"+ [("addSignal", [InTerms], RightAssoc, 9), ("deleteSignal", [InTerms], RightAssoc, 9)],+ entry "System.Posix.ByteString.FilePath" [],+ entry "System.Posix.Directory" [],+ entry "System.Posix.Directory.ByteString" [],+ entry "System.Posix.Directory.Fd" [],+ entry "System.Posix.Directory.Internals" [],+ entry "System.Posix.Directory.PosixPath" [],+ entry "System.Posix.DynamicLinker" [],+ entry "System.Posix.DynamicLinker.ByteString" [],+ entry "System.Posix.DynamicLinker.Module" [],+ entry "System.Posix.DynamicLinker.Module.ByteString" [],+ entry "System.Posix.DynamicLinker.Prim" [],+ entry "System.Posix.Env" [],+ entry "System.Posix.Env.ByteString" [],+ entry "System.Posix.Env.PosixString" [],+ entry "System.Posix.Error" [],+ entry "System.Posix.Fcntl" [],+ entry "System.Posix.Files" [],+ entry "System.Posix.Files.ByteString" [],+ entry "System.Posix.Files.PosixString" [],+ entry "System.Posix.IO" [],+ entry "System.Posix.IO.ByteString" [],+ entry "System.Posix.IO.PosixString" [],+ entry "System.Posix.Internals" [],+ entry "System.Posix.PosixPath.FilePath" [],+ entry+ "System.Posix.PosixString"+ [("addSignal", [InTerms], RightAssoc, 9), ("deleteSignal", [InTerms], RightAssoc, 9)],+ entry "System.Posix.Process" [],+ entry "System.Posix.Process.ByteString" [],+ entry "System.Posix.Process.Internals" [],+ entry "System.Posix.Process.PosixString" [],+ entry "System.Posix.Resource" [],+ entry "System.Posix.Semaphore" [],+ entry "System.Posix.SharedMem" [],+ entry+ "System.Posix.Signals"+ [("addSignal", [InTerms], RightAssoc, 9), ("deleteSignal", [InTerms], RightAssoc, 9)],+ entry+ "System.Posix.Signals.Exts"+ [("addSignal", [InTerms], RightAssoc, 9), ("deleteSignal", [InTerms], RightAssoc, 9)],+ entry "System.Posix.Temp" [],+ entry "System.Posix.Temp.ByteString" [],+ entry "System.Posix.Temp.PosixString" [],+ entry "System.Posix.Terminal" [],+ entry "System.Posix.Terminal.ByteString" [],+ entry "System.Posix.Terminal.PosixString" [],+ entry "System.Posix.Time" [],+ entry "System.Posix.Types" [],+ entry "System.Posix.Unistd" [],+ entry "System.Posix.User" [],+ entry "System.Posix.User.ByteString" [],+ entry "System.Process" [],+ entry "System.Process.CommunicationHandle" [],+ entry "System.Process.CommunicationHandle.Internal" [],+ entry "System.Process.Environment.OsString" [],+ entry "System.Process.Internals" [],+ entry "System.Timeout" [],+ entry+ "Text.Parsec"+ [("<?>", [InTerms], NoAssoc, 0), ("<|>", [InTerms], RightAssoc, 1)],+ entry "Text.Parsec.ByteString" [],+ entry "Text.Parsec.ByteString.Lazy" [],+ entry "Text.Parsec.Char" [],+ entry "Text.Parsec.Combinator" [],+ entry "Text.Parsec.Error" [],+ entry "Text.Parsec.Expr" [],+ entry "Text.Parsec.Language" [],+ entry+ "Text.Parsec.Perm"+ [("<$$>", [InTerms], LeftAssoc, 2), ("<$?>", [InTerms], LeftAssoc, 2), ("<|?>", [InTerms], LeftAssoc, 1), ("<||>", [InTerms], LeftAssoc, 1)],+ entry "Text.Parsec.Pos" [],+ entry+ "Text.Parsec.Prim"+ [("<?>", [InTerms], NoAssoc, 0), ("<|>", [InTerms], RightAssoc, 1)],+ entry "Text.Parsec.String" [],+ entry "Text.Parsec.Text" [],+ entry "Text.Parsec.Text.Lazy" [],+ entry "Text.Parsec.Token" [],+ entry+ "Text.ParserCombinators.Parsec"+ [("<?>", [InTerms], NoAssoc, 0), ("<|>", [InTerms], RightAssoc, 1)],+ entry "Text.ParserCombinators.Parsec.Char" [],+ entry "Text.ParserCombinators.Parsec.Combinator" [],+ entry "Text.ParserCombinators.Parsec.Error" [],+ entry "Text.ParserCombinators.Parsec.Expr" [],+ entry "Text.ParserCombinators.Parsec.Language" [],+ entry+ "Text.ParserCombinators.Parsec.Perm"+ [("<$$>", [InTerms], LeftAssoc, 2), ("<$?>", [InTerms], LeftAssoc, 2), ("<|?>", [InTerms], LeftAssoc, 1), ("<||>", [InTerms], LeftAssoc, 1)],+ entry "Text.ParserCombinators.Parsec.Pos" [],+ entry+ "Text.ParserCombinators.Parsec.Prim"+ [("<?>", [InTerms], NoAssoc, 0), ("<|>", [InTerms], RightAssoc, 1)],+ entry "Text.ParserCombinators.Parsec.Token" [],+ entry+ "Text.ParserCombinators.ReadP"+ [("+++", [InTerms], RightAssoc, 5), ("<++", [InTerms], RightAssoc, 5)],+ entry+ "Text.ParserCombinators.ReadPrec"+ [("+++", [InTerms], LeftAssoc, 9), ("<++", [InTerms], LeftAssoc, 9)],+ entry+ "Text.PrettyPrint"+ [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)],+ entry+ "Text.PrettyPrint.Annotated"+ [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)],+ entry+ "Text.PrettyPrint.Annotated.HughesPJ"+ [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)],+ entry+ "Text.PrettyPrint.Annotated.HughesPJClass"+ [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)],+ entry+ "Text.PrettyPrint.HughesPJ"+ [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)],+ entry+ "Text.PrettyPrint.HughesPJClass"+ [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)],+ entry "Text.Printf" [],+ entry+ "Text.Read"+ [("+++", [InTerms], LeftAssoc, 9), ("<++", [InTerms], LeftAssoc, 9)],+ entry "Text.Read.Lex" [],+ entry "Text.Show" [],+ entry "Text.Show.Functions" [],+ entry "Trace.Hpc.Mix" [],+ entry "Trace.Hpc.Reflect" [],+ entry "Trace.Hpc.Tix" [],+ entry "Trace.Hpc.Util" [],+ entry+ "Type.Reflection"+ [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4)],+ entry "Type.Reflection.Unsafe" [],+ entry "Unsafe.Coerce" []+ ]+ where+ entry name ops =+ ( name,+ Map.fromList+ [ ((namespace, OpName o), Fixity d p)+ | (o, governs, d, p) <- ops,+ namespace <- governs+ ]+ )
+ src/Tilia/Fixity/ByHand.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Fixities for the few modules whose source defeats us.+module Tilia.Fixity.ByHand+ ( byHandFixities,+ hscFixities,+ )+where++import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Tilia.Fixity++-- | The modules, and the operators they declare.+byHandFixities :: Map Text (Map OpName Fixity)+byHandFixities =+ Map.fromList+ [ -- @Test.QuickCheck.Property@ invokes a macro it defines:+ -- @WITNESSES(:: [Witness])@ stands in the middle of a record, and+ -- only @cpp@ can expand it. No configuration of the module is+ -- Haskell, so there is nothing to parse in any of them.+ entry+ "Test.QuickCheck.Property"+ [ ("==>", RightAssoc, 0),+ (".&.", RightAssoc, 1),+ (".&&.", RightAssoc, 1),+ (".||.", RightAssoc, 1),+ ("===", NoAssoc, 4),+ ("=/=", NoAssoc, 4)+ ],+ -- @network@ writes its system calls as @foreign import CALLCONV@,+ -- and @CALLCONV@ is a macro out of @HsNetDef.h@ standing where the+ -- calling convention goes. It has to be expanded for the line to be+ -- Haskell at all, so no configuration of these five parses.+ --+ -- Not one of them declares a fixity, defines an operator, or gives a+ -- constructor an operator name, in any version; every entry below is+ -- therefore empty. What that buys is not their own operators but+ -- everything downstream: @Network.Socket@ is perfectly readable and+ -- was only ever refused because these are what it passes on, and+ -- refusing it refused @wai@, @http-client@, @warp@ and in the end+ -- every @servant@ module that reaches one of them.+ entry "Network.Socket.If" [],+ entry "Network.Socket.Internal" [],+ entry "Network.Socket.Name" [],+ entry "Network.Socket.Shutdown" [],+ entry "Network.Socket.Syscall" [],+ -- @Data.HashMap.Internal.Array@ defines @CHECK_BOUNDS@ and calls it+ -- where an expression goes, with the guarded @case@ on the line+ -- below. Unexpanded it reads as a function applied to that @case@,+ -- and both branches of the @#if@ that defines it leave the call+ -- standing, so there is no configuration to fall back on.+ --+ -- It exports no operator and declares no fixity. What it costs to+ -- refuse is @Data.HashMap.Strict@, and after that @Data.Aeson.KeyMap@+ -- and everything that reads a JSON object.+ entry "Data.HashMap.Internal.Array" [],+ -- @monad-logger@ writes one method body once and hands it to sixteen+ -- instances: @#define DEF monadLoggerLog a b c d = …@, and then+ -- @instance … where DEF@ for each of them. A @where@ with a bare name+ -- after it is not Haskell, and the @#define@ sits outside every+ -- conditional, so there is no configuration in which it is.+ --+ -- It declares no fixity, and its export list is explicit throughout:+ -- no module is handed on whole, and none of the types it exports with+ -- @(..)@ keeps an operator. What refusing it costs is @Yesod.Core@,+ -- and after that every module of @yesod@ that reaches one.+ entry "Control.Monad.Logger" [],+ -- @cereal@ writes its generic sum instances through three macros, and+ -- the one that matters expands into a guard and its right-hand side+ -- at once: @gPut | PUTSUM(Word8) | …@. Unexpanded that is a guard+ -- with nothing after it.+ --+ -- It declares no fixity. It does hand @Data.Serialize.Get@, @.Put@+ -- and @.IEEE754@ on whole, so this claim is about those as well, and+ -- not one of the three declares a fixity or exports an operator+ -- either: what they supply has the Report's @infixl 9@, which is what+ -- an absence here already says.+ entry "Data.Serialize" [],+ -- @th-lift-instances@ has @LIFT_TYPED_DEFAULT@, defined three ways+ -- against the @template-haskell@ version and to nothing at all in the+ -- oldest of them, and written bare in five instance bodies.+ --+ -- Its export list is empty—the module exists for its orphan+ -- instances—so it supplies no operator whatever it declares. It is+ -- reached through eight modules of @persistent@, which is a long way+ -- to be refused from.+ entry "Instances.TH.Lift" []+ ]+ where+ entry name ops =+ (name, Map.fromList [(OpName o, Fixity d p) | (o, d, p) <- ops])++-- | What the modules written for @hsc2hs@ declare.+--+-- A different question from 'byHandFixities', and asked at a different+-- moment. That table is a last resort for a module nothing could be made+-- of; this one is the whole answer for an @.hsc@, given instead of reading+-- it, and a module absent from here declares nothing rather than being+-- unreadable.+--+-- The claim behind the absence is that @hsc2hs@ modules hardly ever declare+-- a fixity. Of three hundred @.hsc@ files across the packages this project+-- builds against, exactly one module declares one, and it is below. One+-- other defines operators at all — @regex-posix@'s @Text.Regex.Posix.Wrap@,+-- which gives @=~@ and @=~~@ and no fixity for either, so the Report's+-- @infixl 9@ is what they have and is what an absence here already says.+-- Neither module can be parsed even with the @hsc2hs@ constructs blanked+-- out, so there was never a reading that would have found them.+--+-- Being wrong here costs indentation and nothing else: a fixity decides+-- how a chain of operators is grouped when it is broken across lines, and+-- nothing in the renderer adds or removes a parenthesis. A module missing+-- from this table is laid out as though its operators were @infixl 9@.+hscFixities :: Map Text (Map OpName Fixity)+hscFixities =+ Map.fromList+ [ -- @addSignal@ and @deleteSignal@ take a signal on the left and a set+ -- on the right, so a chain of them only typechecks to the right, and+ -- the module says so with a bare @infixr@—precedence 9, as the+ -- Report has it when none is written.+ entry+ "System.Posix.Signals"+ [ ("addSignal", RightAssoc, 9),+ ("deleteSignal", RightAssoc, 9)+ ]+ ]+ where+ entry name ops =+ (name, Map.fromList [(OpName o, Fixity d p) | (o, d, p) <- ops])
+ src/Tilia/Fixity/Cabal.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Reading a package's exposed modules out of its @.cabal@ file.+module Tilia.Fixity.Cabal+ ( packageModules,+ cabalFileInArchive,+ 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 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 (lookupExtension)+import Tilia.Utils (quietly)++-- | The modules a package exposes, read from the @.cabal@ file in its+-- source tarball.+--+-- Nothing if the tarball cannot be read or holds no @.cabal@ file.+packageModules :: FilePath -> IO (Maybe [Text])+packageModules tarball = quietly Nothing $ do+ bytes <- BL.readFile tarball+ pure (containedModules <$> 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 = \case+ Tar.Next entry rest+ | cabalFileAtTop (entryPosixPath entry),+ Tar.NormalFile content _ <- Tar.entryContent entry ->+ Just (T.decodeUtf8Lenient (BL.toStrict content))+ | otherwise -> cabalFileInArchive rest+ Tar.Done -> Nothing+ Tar.Fail _ -> Nothing++-- | Where an entry sits in its archive, written the way a tar file writes+-- it.+entryPosixPath :: Tar.Entry -> FilePath+entryPosixPath = Tar.fromTarPathToPosixPath . Tar.entryTarPath++-- | Is this the path of a package's own @.cabal@ file?+cabalFileAtTop :: FilePath -> Bool+cabalFileAtTop path = ".cabal" `isSuffixOf` path && depth path == 2+ where+ depth = (1 +) . length . filter (== '/')++-- | Every module a package holds, whether it exposes it or not.+--+-- A package's internals are worth knowing about because its exposed modules+-- pass names on from them: @base@ re-exports from @GHC.Internal.*@, none of+-- which it exposes. Reading only the exposed list leaves those unreachable,+-- and a re-export that cannot be followed is an answer thrown away.+containedModules :: Text -> [Text]+containedModules t =+ modulesUnder "exposed-modules" t <> modulesUnder "other-modules" t++modulesUnder :: Text -> Text -> [Text]+modulesUnder field =+ concatMap moduleNames . fieldsNamed field . T.lines+ where+ moduleNames =+ filter looksLikeModule+ . concatMap (T.split (== ','))+ . T.words++ 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.+--+-- The current directory is always among them, whatever @hs-source-dirs@+-- says. This is deliberately more than cabal would look at: a package can+-- keep modules beside its @.cabal@ file and name other directories as well,+-- and a directory too many costs one @stat@ where a directory too few costs+-- a module we cannot resolve.+sourceDirs :: Text -> [Text]+sourceDirs contents = Data.List.nub (named <> ["."])+ where+ named =+ filter (not . T.null)+ . map T.strip+ . concatMap (T.split (== ','))+ . concatMap T.words+ . 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 apply baseline named+ where+ ls = T.lines contents+ baseline = case mapMaybe languageNamed (fieldsNamed "default-language" ls) of+ [] -> GHC.languageExtensions Nothing+ editions ->+ Data.List.nub (concatMap (GHC.languageExtensions . Just) editions)+ named =+ concatMap (T.split (== ',')) . concatMap T.words $+ fieldsNamed "default-extensions" ls+ apply acc written = case T.strip written of+ name+ | Just off <- T.stripPrefix "No" name,+ Just extension <- lookupExtension off ->+ filter (/= extension) acc+ | Just extension <- lookupExtension name,+ extension `notElem` acc ->+ acc <> [extension]+ | otherwise -> acc+ languageNamed written =+ lookup (T.unpack (T.strip written)) [(show e, e) | e <- [minBound .. maxBound]]++-- | 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 : map 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
+ src/Tilia/Fixity/Cache.hs view
@@ -0,0 +1,432 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Remembering what was read out of a package, between runs.+--+-- Reading a dependency means decompressing an archive and parsing a module,+-- which costs tens of milliseconds. Doing it once is fine. Doing it again+-- for every file of a project, on every save, is not—and that is the shape+-- of the work when a formatter is driven from an editor.+module Tilia.Fixity.Cache+ ( Cache,+ PlanToken (..),+ openCache,+ cachedModules,+ storeModules,+ cachedFixities,+ storeFixities,+ cachedExportNames,+ storeExportNames,+ cachedChildren,+ storeChildren,+ cachedInstalled,+ storeInstalled,+ cachedFutileSolve,+ storeFutileSolve,+ cachedFutileFetch,+ storeFutileFetch,+ )+where++import Control.Monad (join)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Set (Set)+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.Read qualified as T+import System.Directory+ ( XdgDirectory (XdgCache),+ createDirectoryIfMissing,+ doesFileExist,+ getModificationTime,+ getXdgDirectory,+ renameFile,+ )+import System.FilePath (takeDirectory, (</>))+import Tilia.Fixity+import Tilia.Fixity.PackageDb (Installed (..), InstalledPackage (..))+import Tilia.Utils (quietly)++-- | Where cached answers are kept together with a token unique to this+-- build plan, read in this environment.+data Cache = Cache FilePath PlanToken++-- | A token that is unique to this plan, read in this environment. It is+-- needed in order to be able to cache the expensive class of lookup+-- failures that are related to chasing module re-export chains. Rather than+-- track what each failure leaned on, all of them are tied to the pair as a+-- whole: anything that could turn a failure into an answer changes one or+-- the other, and failures are few enough that re-deriving them when it does+-- costs little.+--+-- The environment belongs in it because a module the plan names is+-- unreadable where the compiler cannot be asked about its package and+-- readable where it can, and that is settled outside the project. See+-- 'Tilia.Fixity.PackageDb.compilerIdentity'.+newtype PlanToken = PlanToken Text+ deriving (Eq, Show)++-- | Bumped whenever what is written changes shape, so that entries from an+-- older Tilia are ignored rather than misread.+formatVersion :: FilePath+formatVersion = "v1"++-- | Open, creating the directory if need be.+--+-- 'Nothing' if there is nowhere to write, in which case everything still+-- works and is merely slower.+--+-- The token is what a failure written through this cache is tied to, and+-- what one read back out of it has to match. See 'PlanToken'.+openCache :: PlanToken -> IO (Maybe Cache)+openCache token = quietly Nothing $ do+ root <- (</> formatVersion) <$> getXdgDirectory XdgCache "tilia"+ createDirectoryIfMissing True (root </> "modules")+ createDirectoryIfMissing True (root </> "fixities")+ createDirectoryIfMissing True (root </> "installed")+ pure (Just (Cache root token))++-- | The modules a package exposes, if that was worked out before.+cachedModules :: Cache -> Text -> IO (Maybe [Text])+cachedModules cache package =+ readIfPresent (modulesPath cache package) $+ filter (not . T.null) . T.lines++-- | Remember what a package exposes.+storeModules :: Cache -> Text -> [Text] -> IO ()+storeModules cache package =+ writeAtomically (modulesPath cache package) . T.unlines++-- | What was established about a module before, if anything was.+--+-- An 'Unreadable' answer is offered back only under the 'PlanToken' it was+-- written under.+cachedFixities ::+ -- | Where to look+ Cache ->+ -- | The package the module belongs to. Opaque here: whatever the caller+ -- uses to tell one package from another is what an answer is filed under,+ -- and answers filed under different keys never meet.+ Text ->+ -- | The module, by its full dotted name+ Text ->+ -- | What was established, or 'Nothing' if nothing was+ IO (Maybe Established)+cachedFixities cache@(Cache _ (PlanToken token)) package modName =+ fmap join . readIfPresent (fixitiesPath cache package modName) $ \contents ->+ case T.lines contents of+ ("read" : entries) -> Declares . Map.fromList <$> traverse parseEntry entries+ [unread] | Just rest <- T.stripPrefix ("unread\t" <> token) unread ->+ case T.uncons rest of+ Nothing -> Just (Unreadable Nothing)+ Just ('\t', below) | not (T.null below) -> Just (Unreadable (Just below))+ _ -> Nothing+ _ -> Nothing++-- | Remember what reading a module established.+storeFixities ::+ -- | Where to write+ Cache ->+ -- | The package the module belongs to, as 'cachedFixities' takes it+ Text ->+ -- | The module, by its full dotted name+ Text ->+ -- | What was established about it+ Established ->+ IO ()+storeFixities cache package modName answer = do+ quietly () (createDirectoryIfMissing True (packageDir cache package))+ writeAtomically (fixitiesPath cache package modName) $+ case answer of+ Unreadable below ->+ T.unlines ["unread\t" <> token <> foldMap ("\t" <>) below]+ Declares fixities ->+ T.unlines ("read" : map renderEntry (Map.toList fixities))+ where+ Cache _ (PlanToken token) = cache++----------------------------------------------------------------------------+-- Export names++-- | What a module's export list was found to say, if it was ever read.+--+-- Wanted for the modules whose fixities could not be established, and asked+-- exactly then: a warm cache answers those from 'cachedFixities' without+-- opening the archive at all, and without this the archive would be opened+-- anyway to ask this instead.+cachedExportNames ::+ -- | Where to look+ Cache ->+ -- | The package the module belongs to, as 'cachedFixities' takes it+ Text ->+ -- | The module, by its full dotted name+ Text ->+ -- | What its export list said, or 'Nothing' if it was never read+ IO (Maybe Exported)+cachedExportNames cache package modName =+ fmap join . readIfPresent (exportsPath cache package modName) $ \contents ->+ case T.lines contents of+ ("names" : entries) -> Just (Exports (Set.fromList (map OpName entries)))+ ["untellable"] -> Just Untellable+ _ -> Nothing++-- | Remember what a module's export list said.+storeExportNames ::+ -- | Where to write+ Cache ->+ -- | The package the module belongs to, as 'cachedFixities' takes it+ Text ->+ -- | The module, by its full dotted name+ Text ->+ -- | What its export list said+ Exported ->+ IO ()+storeExportNames cache package modName answer = do+ quietly () (createDirectoryIfMissing True (exportsDir cache package))+ writeAtomically (exportsPath cache package modName) $+ case answer of+ Untellable -> T.unlines ["untellable"]+ Exports names -> T.unlines ("names" : [op | OpName op <- Set.toAscList names])++----------------------------------------------------------------------------+-- What a name carries with it++-- | What a module keeps under each of its names, if it was ever read for+-- it.+--+-- Wanted wherever an import list writes @T(..)@, and got at by reading the+-- module's interface or its source—which on a warm cache is work that+-- would otherwise not be done at all.+cachedChildren ::+ -- | Where to look+ Cache ->+ -- | The package the module belongs to, as 'cachedFixities' takes it+ Text ->+ -- | The module, by its full dotted name+ Text ->+ -- | What it keeps under each name, or 'Nothing' if it was never read+ IO (Maybe (Map OpName (Set OpName)))+cachedChildren cache package modName =+ fmap join . readIfPresent (childrenPath cache package modName) $ \contents ->+ case T.lines contents of+ ("children" : entries) -> Just (Map.fromList (mapMaybe childEntry entries))+ _ -> Nothing+ where+ childEntry line = case T.splitOn "\t" line of+ (parent : kids) -> Just (OpName parent, Set.fromList (map OpName kids))+ [] -> Nothing++-- | Remember what a module keeps under each of its names.+storeChildren ::+ -- | Where to write+ Cache ->+ -- | The package the module belongs to, as 'cachedFixities' takes it+ Text ->+ -- | The module, by its full dotted name+ Text ->+ -- | What it keeps under each name+ Map OpName (Set OpName) ->+ IO ()+storeChildren cache package modName children = do+ quietly () (createDirectoryIfMissing True (childrenDir cache package))+ writeAtomically (childrenPath cache package modName) $+ T.unlines ("children" : map entry (Map.toList children))+ where+ entry (OpName parent, kids) =+ T.intercalate "\t" (parent : [kid | OpName kid <- Set.toAscList kids])++----------------------------------------------------------------------------+-- The package database++-- | What the compiler could see when last asked, if it can still see it.+--+-- Whose answer this is, is settled by the path it was found at rather than+-- by anything written inside it. See 'installedPath'.+cachedInstalled :: Cache -> IO (Maybe [InstalledPackage])+cachedInstalled cache = quietly Nothing $ do+ readIfPresent (installedPath cache) T.lines >>= \case+ Nothing -> pure Nothing+ Just ls -> do+ let written =+ [(T.unpack path, stamp) | ["db", path, stamp] <- map fields ls]+ still <- traverse unchanged written+ pure $+ if not (null written) && and still+ then Just (mapMaybe installedFrom ls)+ else Nothing+ where+ unchanged (path, stamp) =+ quietly False ((== stamp) . T.pack . show <$> getModificationTime path)+ installedFrom l = case fields l of+ ("pkg" : name : version : modules : dirs) ->+ Just+ InstalledPackage+ { ipName = name,+ ipVersion = version,+ ipModules = T.words modules,+ ipImportDirs = map T.unpack dirs+ }+ _ -> Nothing+ fields = T.splitOn "\t"++-- | Remember what the compiler can see, stamped so that a later run can+-- tell whether it still does.+--+-- Nothing is written when there is no database to stamp: an answer nothing+-- can invalidate is worse than no answer, because it never stops being+-- given.+storeInstalled :: Cache -> Installed -> IO ()+storeInstalled cache found+ | null (installedDatabases found) = pure ()+ | otherwise = quietly () $ do+ stamps <- traverse stamped (installedDatabases found)+ writeAtomically (installedPath cache) . T.unlines $+ [T.intercalate "\t" ["db", T.pack path, stamp] | (path, stamp) <- stamps]+ <> [ T.intercalate "\t" $+ ["pkg", ipName p, ipVersion p, T.unwords (ipModules p)]+ <> map T.pack (ipImportDirs p)+ | p <- installedPackages found+ ]+ where+ stamped path = do+ stamp <- T.pack . show <$> getModificationTime path+ pure (path, stamp)++----------------------------------------------------------------------------+-- Solves that came to nothing++-- | Whether asking @cabal@ to solve this plan again has already been tried+-- and left the plan saying exactly what it said before.+cachedFutileSolve :: Cache -> IO Bool+cachedFutileSolve cache =+ quietly False (doesFileExist (futileSolvePath cache))++-- | Remember that solving again did not widen the plan.+storeFutileSolve :: Cache -> IO ()+storeFutileSolve cache = quietly () $ do+ createDirectoryIfMissing True (takeDirectory (futileSolvePath cache))+ writeAtomically (futileSolvePath cache) ""++-- | The packages an earlier run was still short of after asking @cabal@ to+-- fetch them, and which asking again will therefore not bring in.+cachedFutileFetch :: Cache -> IO [Text]+cachedFutileFetch cache =+ fromMaybe []+ <$> readIfPresent+ (futileFetchPath cache)+ (filter (not . T.null) . T.lines)++-- | Remember what fetching left missing.+storeFutileFetch :: Cache -> [Text] -> IO ()+storeFutileFetch cache packages = quietly () $ do+ createDirectoryIfMissing True (takeDirectory (futileFetchPath cache))+ writeAtomically (futileFetchPath cache) (T.unlines packages)++----------------------------------------------------------------------------+-- Entries++renderEntry :: ((Namespace, OpName), Fixity) -> Text+renderEntry ((namespace, OpName op), Fixity direction precedence) =+ T.intercalate+ "\t"+ [op, renderNamespace namespace, renderDirection direction, T.pack (show precedence)]+ where+ renderNamespace = \case+ InTypes -> "t"+ InTerms -> "v"+ renderDirection = \case+ LeftAssoc -> "l"+ RightAssoc -> "r"+ NoAssoc -> "n"++parseEntry :: Text -> Maybe ((Namespace, OpName), Fixity)+parseEntry line = case T.splitOn "\t" line of+ [op, namespace, direction, precedence] -> do+ n <- parseNamespace namespace+ d <- parseDirection direction+ p <- readPrecedence precedence+ pure ((n, OpName op), Fixity d p)+ _ -> Nothing+ where+ parseNamespace = \case+ "t" -> Just InTypes+ "v" -> Just InTerms+ _ -> Nothing+ parseDirection = \case+ "l" -> Just LeftAssoc+ "r" -> Just RightAssoc+ "n" -> Just NoAssoc+ _ -> Nothing+ readPrecedence t = case T.signed T.decimal t of+ Right (p, rest) | T.null rest -> Just p+ _ -> Nothing++----------------------------------------------------------------------------+-- Paths and files++packageDir :: Cache -> Text -> FilePath+packageDir (Cache root _) package = root </> "fixities" </> T.unpack package++-- | Under the token, as everything else here is filed under the key that+-- decides it.+--+-- One file shared by every token could only ever carry a check saying whose+-- it was, which answers \"is this mine?\" and never \"where is mine?\": two+-- environments formatting the same project would take turns discarding each+-- other's answer and asking @ghc-pkg@ again.+installedPath :: Cache -> FilePath+installedPath (Cache root (PlanToken token)) =+ root </> "installed" </> T.unpack token++futileSolvePath :: Cache -> FilePath+futileSolvePath (Cache root (PlanToken token)) =+ root </> "solves" </> T.unpack token++futileFetchPath :: Cache -> FilePath+futileFetchPath (Cache root (PlanToken token)) =+ root </> "fetches" </> T.unpack token++modulesPath :: Cache -> Text -> FilePath+modulesPath (Cache root _) package = root </> "modules" </> T.unpack package++fixitiesPath :: Cache -> Text -> Text -> FilePath+fixitiesPath cache package modName =+ packageDir cache package </> T.unpack modName++exportsDir :: Cache -> Text -> FilePath+exportsDir (Cache root _) package = root </> "exports" </> T.unpack package++exportsPath :: Cache -> Text -> Text -> FilePath+exportsPath cache package modName =+ exportsDir cache package </> T.unpack modName++childrenDir :: Cache -> Text -> FilePath+childrenDir (Cache root _) package = root </> "children" </> T.unpack package++childrenPath :: Cache -> Text -> Text -> FilePath+childrenPath cache package modName =+ childrenDir cache package </> T.unpack modName++readIfPresent :: FilePath -> (Text -> a) -> IO (Maybe a)+readIfPresent path parse = quietly Nothing $ do+ there <- doesFileExist path+ if there then Just . parse <$> T.readFile path else pure Nothing++-- | Write via a temporary file and a rename.+--+-- Two formatters may run at once—an editor saving while a pre-commit hook+-- runs—and a half-written entry read by the other would be worse than no+-- entry at all. A rename is atomic, so a reader sees the old file or the+-- new one and never a partial one.+--+-- If anything fails the write is abandoned. A stray temporary left in a+-- cache directory costs nothing; a wrong answer would cost a great deal.+writeAtomically :: FilePath -> Text -> IO ()+writeAtomically path contents = quietly () $ do+ let temporary = path <> ".tmp"+ T.writeFile temporary contents+ renameFile temporary path
+ src/Tilia/Fixity/Debug.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | An account of how a module's fixities were determined.+module Tilia.Fixity.Debug+ ( FixityNotes (..),+ ImportNote (..),+ OperatorNote (..),+ fixityNotes,+ renderFixityNotes,+ )+where++import Data.Choice (Choice)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Hs (HsModule)+import GHC.Hs.Extension (GhcPs)+import Tilia.Fixity+ ( Direction (..),+ Fixities,+ Fixity (..),+ Import (..),+ OpName (..),+ Provenance (..),+ Resolution (..),+ Scope (..),+ lookupFixity,+ moduleImports,+ operatorSpelling,+ operatorsUsed,+ reachAmbiguous,+ reachIn,+ reachUnqualified,+ spellUnreadIn,+ )+import Tilia.Palette (Color (Operator, Place), Palette, paint)+import Tilia.Utils (indent, lineWidth, wrapTo)++-- | Everything that decided one module's fixities.+data FixityNotes = FixityNotes+ { -- | What each import brought, in the order the module writes them.+ notedImports :: [ImportNote],+ -- | What became of every operator the module uses, one entry per+ -- operator.+ notedOperators :: [OperatorNote],+ -- | What the module declares for itself.+ notedDeclarations :: [(Text, Fixity)]+ }+ deriving (Eq, Show)++-- | One import.+data ImportNote = ImportNote+ { -- | The module imported.+ noteModule :: Text,+ -- | The name it goes under here, when that differs from its own.+ noteAlias :: Maybe Text,+ -- | Whether it was imported qualified.+ noteQualified :: Bool,+ -- | How many operators it was read for, or 'Nothing' when it could not+ -- be read at all.+ noteBrought :: Maybe Int,+ -- | Where reading it went before giving up, ending at the module that+ -- actually stopped it. Empty for an import that was read, and for one+ -- unread on its own account.+ noteChain :: [Text]+ }+ deriving (Eq, Show)++-- | One operator the module uses.+data OperatorNote = OperatorNote+ { -- | The operator as the module writes it, qualifier and all.+ noteSpelling :: Text,+ -- | What the scope answered for it.+ noteResolution :: Resolution,+ -- | Whether two modules in scope disagree about it.+ noteAmbiguous :: Bool+ }+ deriving (Eq, Show)++-- | Record everything that decided one module's fixities.+fixityNotes ::+ -- | Whether @ImplicitPrelude@ is on, so that the Prelude is listed+ -- among the imports exactly when the module actually has it+ Choice "implicitPrelude" ->+ -- | What each module in scope exports, as the resolver answers it+ (Text -> IO (Maybe (Fixities))) ->+ -- | Where reading a module went before giving up, asked only of the ones+ -- the line above gave up on+ (Text -> IO [Text]) ->+ -- | The scope the module was formatted under+ Scope ->+ -- | The module+ HsModule GhcPs ->+ IO FixityNotes+fixityNotes implicitPrelude resolve chainOf scope hsModule = do+ brought <- traverse alongside (moduleImports implicitPrelude hsModule)+ pure+ FixityNotes+ { notedImports = brought,+ notedOperators = map aboutOperator used,+ notedDeclarations = here+ }+ where+ alongside i = do+ answer <- resolve (importModule i)+ below <- case answer of+ Just _ -> pure []+ Nothing -> chainOf (importModule i)+ pure+ ImportNote+ { noteModule = importModule i,+ noteAlias =+ if importAlias i == importModule i+ then Nothing+ else Just (importAlias i),+ noteQualified = importQualified i,+ noteBrought = Set.size . Set.fromList . map snd . Map.keys <$> answer,+ noteChain = below+ }++ used =+ Map.elems+ ( Map.fromList+ [ ((namespace, uncurry operatorSpelling u), (namespace, u))+ | (namespace, u) <- operatorsUsed hsModule+ ]+ )++ here =+ [ (op, fixity)+ | (OpName op, (fixity, DeclaredHere)) <- Map.toList declaredHere+ ]+ declaredHere =+ Map.union+ (reachUnqualified (scopeInTerms scope))+ (reachUnqualified (scopeInTypes scope))++ aboutOperator (namespace, (qualifier, op)) =+ OperatorNote+ { noteSpelling = operatorSpelling qualifier op,+ noteResolution = lookupFixity scope namespace qualifier op,+ noteAmbiguous =+ (qualifier, op) `elem` reachAmbiguous (reachIn namespace scope)+ }++-- | Set out all the 'FixityNotes' per file.+renderFixityNotes :: Palette -> Map FilePath FixityNotes -> [Text]+renderFixityNotes palette notes =+ concat+ [ (indent 1 <> "fixities for " <> paint palette Place (T.pack path))+ : aboutFile palette told+ | (path, told) <- Map.toList notes+ ]++-- | One file's account, in reading order.+aboutFile :: Palette -> FixityNotes -> [Text]+aboutFile palette notes =+ concat+ [ section "imports" fromImport (notedImports notes),+ section "operators" fromOperator (notedOperators notes),+ section "declared here" fromOwn (notedDeclarations notes)+ ]+ where+ section what render items+ | null items = []+ | 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) : map (indent 4 <>) rest++ fromImport i =+ named (noteModule i)+ <> qualification i+ <> ": "+ <> case noteBrought i of+ Nothing -> "could not be read" <> through (noteChain i)+ Just n -> operators n++ through = \case+ [] -> ""+ below -> ", through " <> T.intercalate " → " (map named below)++ qualification i = case (noteQualified i, noteAlias i) of+ (True, Just alias) -> " qualified as " <> named alias+ (True, Nothing) -> " qualified"+ (False, Just alias) -> " as " <> named alias+ (False, Nothing) -> ""++ fromOwn (op, fixity) = operator op <> " " <> spelled fixity++ fromOperator o =+ operator (noteSpelling o)+ <> " "+ <> case noteResolution o of+ Resolved fixity provenance ->+ spelled fixity <> ", " <> from provenance <> ambiguously o+ Unresolved missing ->+ "unknown: may be declared in " <> spellUnreadIn palette missing++ from = \case+ DeclaredHere -> "declared in this module"+ DeclaredIn m -> "declared in " <> named m+ ReportDefault -> "the Report's default, nothing in scope declaring it"++ ambiguously o+ | noteAmbiguous o = ", and two modules in scope disagree about it"+ | otherwise = ""++ named = paint palette Place+ operator = paint palette Operator++ operators = \case+ 1 -> "1 operator"+ n -> T.pack (show n) <> " operators"++-- | A fixity, written the way it would be declared.+spelled :: Fixity -> Text+spelled (Fixity direction precedence) =+ which direction <> " " <> T.pack (show precedence)+ where+ which = \case+ LeftAssoc -> "infixl"+ RightAssoc -> "infixr"+ NoAssoc -> "infix"
+ src/Tilia/Fixity/Interface.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Reading a module's operators out of interface files.+module Tilia.Fixity.Interface+ ( Interface (..),+ readInterface,+ parseInterface,+ )+where++import Data.Char (isUpper)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe)+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Read qualified as T+import Tilia.Fixity+import Tilia.Process (readProgramOutput)+import Tilia.Utils (quietly)++-- | What an interface says about the operators a module offers.+data Interface = Interface+ { -- | The fixities the module declares itself, by the namespace each+ -- governs.+ interfaceDeclares :: Fixities,+ -- | The names it exports that some other module declared, each with the+ -- module that did. Not only the operators: a plain function can be+ -- given a fixity and used in backticks, and one of these is where the+ -- declaration would be.+ interfacePassedOn :: [(Text, OpName)],+ -- | What it exports under each name, for the names that carry others+ -- with them. This is what @T(..)@ in an import list stands for, and the+ -- compiler has already worked it out: an export entry wears its members+ -- in braces.+ interfaceChildren :: Map OpName (Set OpName)+ }+ deriving (Eq, Show)++-- | Read a module's interface file, if the compiler will show it to us.+--+-- 'Nothing' where it will not, which covers a file that is not there, one+-- built by another compiler, and @ghc@ not being on the path at all. None+-- of those is fatal; they only mean this module has nothing to add.+readInterface ::+ -- | The module the file is supposed to hold+ Text ->+ -- | The file+ FilePath ->+ IO (Maybe Interface)+readInterface modName path =+ quietly Nothing $+ readProgramOutput "ghc" ["--show-iface", path] >>= \case+ Nothing -> pure Nothing+ Just out -> pure (parseInterface modName out)++-- | Read what @ghc --show-iface@ printed, if it is this module's interface.+parseInterface :: Text -> Text -> Maybe Interface+parseInterface modName out+ | not (any holdsModule (T.lines out)) = Nothing+ | otherwise =+ Just+ Interface+ { interfaceDeclares =+ namespaced+ (typeNamesIn out)+ (Map.fromList (concatMap declared (sectionsNamed "fixities"))),+ interfacePassedOn = concatMap passedOn (sectionsNamed "exports:"),+ interfaceChildren =+ Map.unionsWith Set.union (map childrenIn (sectionsNamed "exports:"))+ }+ where+ holdsModule l = case T.words l of+ ("interface" : m : _) -> m == modName+ _ -> False+ sectionsNamed name = [body | (heading, body) <- sections out, heading == name]+ declared = mapMaybe fixityEntry . T.splitOn ","+ passedOn = concatMap fromExport . T.words+ childrenIn section =+ Map.fromListWith+ Set.union+ [ (nameOnly parent, Set.fromList (map nameOnly kids))+ | (parent, kids@(_ : _)) <- exportEntries section+ ]++-- | The names an interface declares as types.+--+-- The compiler writes each declaration out, and a type is written as one:+-- @data (:~:) a b where@, @type (==) :: …@, @class Eq a where@. A name+-- that turns up in none of those is a value, which is the other namespace.+typeNamesIn :: Text -> Set OpName+typeNamesIn out =+ Set.fromList+ [ nameOnly (T.dropWhileEnd (== ')') (T.dropWhile (== '(') name))+ | l <- T.lines out,+ indented l,+ (keyword : rest) <- [T.words l],+ 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.+--+-- A fixity for a name the interface declares as a type governs types; one+-- for any other name governs terms. A name that is both—rare, and legal—+-- gets the fixity in both, which is what the interface says: it records+-- one fixity for the name and no namespace of its own.+namespaced :: Set OpName -> Map OpName Fixity -> Fixities+namespaced types declared =+ Map.fromList+ [ ((namespace, op), fixity)+ | (op, fixity) <- Map.toList declared,+ namespace <- if Set.member op types then [InTypes] else [InTerms]+ ]++-- | 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)++-- | One entry of a @fixities@ line: @infixl 9 !@ and the like.+fixityEntry :: Text -> Maybe (OpName, Fixity)+fixityEntry entry = case T.words entry of+ [direction, precedence, op] -> do+ d <- case direction of+ "infixl" -> Just LeftAssoc+ "infixr" -> Just RightAssoc+ "infix" -> Just NoAssoc+ _ -> Nothing+ p <- readPrecedence precedence+ pure (OpName op, Fixity d p)+ _ -> Nothing+ where+ -- Not one digit: GHC gives @->@ a precedence of -1, below anything the+ -- report allows anyone to write, and drops it into a fixities line like+ -- any other.+ readPrecedence t = case T.signed T.decimal t of+ Right (p, rest) | T.null rest -> Just p+ _ -> Nothing++-- | Split an exports section into its entries, keeping the members an entry+-- wears in braces with the name they belong to.+--+-- An entry is @Some.Module.T@, or @Some.Module.T{Some.Module.A+-- Some.Module.B}@ where @T@ carries names with it. A partial export writes+-- the name as @T|@, which says that not all of them are there; the ones in+-- the braces are still exactly what @T(..)@ would bring in.+exportEntries :: Text -> [(Text, [Text])]+exportEntries = go+ where+ go text = case T.uncons (T.dropWhile (== ' ') text) of+ Nothing -> []+ Just _ ->+ let trimmed = T.dropWhile (== ' ') text+ (name, rest) = T.break (\c -> c == ' ' || c == '{') trimmed+ 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+ bare = T.dropWhileEnd (`elem` ("|," :: String))++-- | 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 passes on, with the module that declared each.+--+-- An entry is a name, and a type or class is followed by its members in+-- braces. A name written bare was declared by the module whose interface+-- this is, and is left out: its fixity is in the @fixities@ line already.+fromExport :: Text -> [(Text, OpName)]+fromExport = 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)+moduleOf = go []+ where+ go seen t = case component t of+ Just (c, rest) -> go (c : seen) rest+ Nothing+ | null seen -> Nothing+ | otherwise -> Just (T.intercalate "." (reverse seen), t)+ component t = do+ (c, _) <- T.uncons t+ if isUpper c+ then case T.break (== '.') t of+ (before, rest)+ | Just after <- T.stripPrefix "." rest,+ not (T.null before) ->+ Just (before, after)+ _ -> Nothing+ else Nothing
+ src/Tilia/Fixity/PackageDb.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Which package exposes a module, according to the compiler.+--+-- The other way of answering this — reading @exposed-modules@ from a+-- @.cabal@ file inside a source tarball — only works where tarballs are.+-- Under Nix they are not: dependencies arrive already built, and a plan+-- solved there calls almost all of them @pre-existing@, so nothing is ever+-- looked for.+--+-- The compiler always knows, though, because it is what compiles against+-- them. Asking @ghc-pkg@ works in both worlds and is the faster of the two.+--+-- What this does /not/ give is fixities. A package database records what+-- was built, not what it was built from, so the source is still read from a+-- tarball; this only decides which tarball to look for.+module Tilia.Fixity.PackageDb+ ( InstalledPackage (..),+ Installed (..),+ readInstalledPackages,+ compilerIdentity,+ fromFields,+ )+where++import Control.Monad (filterM)+import Data.Char (isSpace)+import Data.List (nub)+import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import System.Directory (doesDirectoryExist, findExecutable)+import System.FilePath ((</>))+import Tilia.Process (readProgramOutput)+import Tilia.Utils (quietly)++-- | A package the compiler can see.+data InstalledPackage = InstalledPackage+ { -- | Package name+ ipName :: Text,+ -- | Package version+ ipVersion :: Text,+ -- | Every module it holds, hidden ones included, with re-export clauses+ -- dropped: those name modules belonging to another package, and looking+ -- there is that package's business.+ ipModules :: [Text],+ -- | Where its compiled interfaces are.+ ipImportDirs :: [FilePath]+ }+ deriving (Eq, Show)++-- | What the compiler can see, and where it is.+data Installed = Installed+ { -- | Every package it can see.+ installedPackages :: [InstalledPackage],+ installedDatabases :: [FilePath]+ }+ deriving (Eq, Show)++-- | Everything the compiler can see, and where it read it from.+--+-- Empty if @ghc-pkg@ cannot be run, which is not fatal.+--+-- @ghc-pkg@ is invoked rather than a database read off disk because where+-- the databases are is not knowable from outside: under Nix the wrapper+-- carries the paths, and @GHC_PACKAGE_PATH@ is not set. The records name+-- them, though, so having asked once we need not ask again to find out+-- whether the answer still holds.+readInstalledPackages :: IO Installed+readInstalledPackages =+ quietly (Installed [] []) $+ readProgramOutput "ghc-pkg" ["dump", "--global", "--user"] >>= \case+ Nothing -> pure (Installed [] [])+ Just out -> do+ let fields = map parseFields (records out)+ databases <- filterM doesDirectoryExist (databasesIn fields)+ pure+ Installed+ { installedPackages = mapMaybe fromFields fields,+ installedDatabases = databases+ }++-- | What tells one compiler environment from another.+--+-- The resolved path of the @ghc-pkg@ that 'readInstalledPackages' will run.+-- Which packages a run can see is settled by that program and by nothing in+-- the project, so it is what an answer about them has to be filed under.+-- Under Nix the path is a store path, and it changes exactly when the+-- environment does; elsewhere it is stable, which is the same thing said of+-- an environment that does not change.+--+-- Hashing the databases themselves would be more exact, but they cannot be+-- named without running @ghc-pkg dump@—the very thing being remembered.+--+-- Empty where there is no @ghc-pkg@ to find, which is a state a run can be+-- in and has to be told apart from the others.+compilerIdentity :: IO Text+compilerIdentity =+ quietly "" (maybe "" T.pack <$> findExecutable "ghc-pkg")++-- | The databases a set of records came out of.+databasesIn :: [Map.Map Text Text] -> [FilePath]+databasesIn fields =+ nub+ [ T.unpack (unquote root) </> "package.conf.d"+ | f <- fields,+ Just root <- [Map.lookup "pkgroot" f]+ ]++-- | Strip the quotes a path is written in when it has none needing them.+unquote :: Text -> Text+unquote = T.dropAround (== '"') . T.strip++-- | Split @ghc-pkg dump@ output into its records.+records :: Text -> [Text]+records = map T.unlines . go . T.lines+ where+ go ls = case break (== "---") ls of+ (record, []) -> [record | not (null record)]+ (record, _ : rest) -> record : go rest++-- | Read one record's fields, if they name a package.+fromFields :: Map.Map Text Text -> Maybe InstalledPackage+fromFields fields = do+ name <- Map.lookup "name" fields+ version <- Map.lookup "version" fields+ pure+ InstalledPackage+ { ipName = T.strip name,+ ipVersion = T.strip version,+ ipModules =+ concatMap+ (maybe [] moduleNames . (`Map.lookup` fields))+ ["exposed-modules", "hidden-modules"],+ ipImportDirs =+ maybe+ []+ (map (T.unpack . rooted fields . unquote) . T.words)+ (Map.lookup "import-dirs" fields)+ }++-- | Put the package's root where its registration only left a variable.+rooted :: Map.Map Text Text -> Text -> Text+rooted fields path = case Map.lookup "pkgroot" fields of+ Nothing -> path+ Just root -> T.replace "${pkgroot}" (unquote root) path++-- | The module names in an @exposed-modules@ field.+moduleNames :: Text -> [Text]+moduleNames = go . filter (not . T.null) . concatMap (T.split (== ',')) . T.words+ where+ go = \case+ (_ : "from" : _ : rest) -> go rest+ (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++-- | Split a record into its fields.+--+-- A field is @name: value@, and its value continues onto any following+-- indented lines.+parseFields :: Text -> Map.Map Text Text+parseFields = Map.fromList . mapMaybe field . groups . 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+ (key, value)+ | not (T.null value) ->+ Just (T.strip key, T.unwords (T.drop 1 value : map T.strip rest))+ _ -> Nothing
+ src/Tilia/Fixity/Plan.hs view
@@ -0,0 +1,1937 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | "Tilia.Fixity" resolves a module's operators exactly, given a function+-- that says what each imported module exports. This is that function, built+-- from what the project itself is compiled against.+module Tilia.Fixity.Plan+ ( -- * Build plans+ PlanPackage (..),+ PackageSource (..),+ isFetchable,+ sourceHashOf,+ BuildPlan (..),+ readBuildPlan,+ planToken,+ tokenFor,+ macrosOf,++ -- * Readiness+ Readiness (..),+ PlanComponent (..),+ spellComponent,+ plannedComponents,+ planPathFor,+ checkReadiness,+ plannedTarballs,+ packageCacheRoot,+ guessedPackageCacheRoot,+ Solves (..),+ forgetfulSolves,+ prepareWith,+ loadPlan,++ -- * Resolving+ Route (..),+ Resolver (..),+ newResolver,+ newResolverVia,+ withReexports,+ scopeFor,+ )+where++import Codec.Archive.Tar qualified as Tar+import Codec.Compression.GZip qualified as GZip+import Control.Applicative ((<|>))+import Control.Monad (filterM, foldM, join)+import Crypto.Hash.SHA256 qualified as SHA256+import Data.Aeson+ ( FromJSON (..),+ Value,+ decodeStrict,+ eitherDecodeFileStrict,+ withObject,+ (.:),+ (.:?),+ )+import Data.Aeson.Types (parseMaybe)+import Data.ByteString qualified as BS+import Data.ByteString.Base16 qualified as B16+import Data.ByteString.Lazy qualified as BL+import Data.Choice (Choice, fromBool)+import Data.Foldable (toList, traverse_)+import Data.IORef+import Data.List (isSuffixOf)+import Data.List qualified+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.List.NonEmpty qualified as NE+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (catMaybes, fromMaybe, listToMaybe, mapMaybe)+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Text.Read qualified as T+import GHC.Hs (HsModule)+import GHC.Hs.Extension (GhcPs)+import GHC.IO.Handle (hDuplicate)+import GHC.LanguageExtensions.Type (Extension (ImplicitPrelude))+import System.Directory+ ( XdgDirectory (XdgCache),+ doesFileExist,+ getAppUserDataDirectory,+ getModificationTime,+ getXdgDirectory,+ listDirectory,+ )+import System.Environment (lookupEnv)+import System.Exit (ExitCode (..))+import System.FilePath (takeDirectory, (</>))+import System.IO (hFlush, stderr)+import System.Info qualified+import System.Process+ ( StdStream (Inherit, UseHandle),+ createProcess,+ cwd,+ proc,+ std_err,+ std_out,+ waitForProcess,+ )+import Tilia.Cpp (branchLeaves, withoutRuledOut)+import Tilia.Cpp.Macros (Macros (..))+import Tilia.Fixity+import Tilia.Fixity.Builtin (builtinFixities)+import Tilia.Fixity.ByHand (byHandFixities, hscFixities)+import Tilia.Fixity.Cabal+ ( cabalFileAtTop,+ cabalFileInArchive,+ containedModules,+ declaredExtensions,+ entryPosixPath,+ packageModules,+ sourceDirs,+ )+import Tilia.Fixity.Cache+import Tilia.Fixity.Interface+import Tilia.Fixity.PackageDb+import Tilia.Package (newPackageReader)+import Tilia.Parser+import Tilia.Pragma (effectiveExtensions)+import Tilia.Process (readProgramOutput)+import Tilia.Utils (quietly)++----------------------------------------------------------------------------+-- The plan++-- | One package of a build plan.+data PlanPackage = PlanPackage+ { -- | Package name+ ppName :: Text,+ -- | Package version+ ppVersion :: Text,+ -- | Package source+ ppSource :: PackageSource,+ -- | Which components of the package the entry is about.+ --+ -- Usually one, because @cabal@ configures a package one component at a+ -- time and gives each its own entry. A package it cannot take apart—one+ -- with a @Custom@ build type, whose @Setup.hs@ is entitled to do as it+ -- pleases—is planned whole instead, and its entry is about every+ -- component at once. Empty where the entry is about none of them.+ ppComponents :: [Text]+ }+ deriving (Eq, Show)++-- | Where a package's source is, if anywhere.+--+-- A plan contains exactly three kinds of entry and they are mutually+-- exclusive, which two independent flags could not say: a package cannot be+-- both shipped with the compiler and fetched from Hackage. Each carries+-- what is peculiar to it and nothing else, so there is no hash to consult+-- on a package that has no tarball, and no tarball to look for on one that+-- is a directory.+data PackageSource+ = -- | Already installed, so @cabal@ will not build it.+ --+ -- Not the same as "ships with the compiler", though it includes those.+ PreExisting+ | -- | A directory on this machine—the project being formatted, or a+ -- sibling of it in the same repository.+ LocalPackage FilePath+ | -- | Fetched from a repository as a tarball, with the SHA-256 the plan+ -- expects it to have and where it was fetched from.+ --+ -- Hackage is one such repository and not a special one. A company that+ -- runs its own has packages here exactly as Hackage does, and the only+ -- difference that reaches us is where the tarball landed.+ RepoPackage (Maybe Text) Repository+ | -- | A @source-repository-package@ we have not found the sources of.+ --+ -- The plan says where the repository is, which is of no use: what is+ -- wanted is where @cabal@ put the clone, and the plan does not say. A+ -- package that stays this way is one nothing can be read from, which is+ -- what every one of them was before 'checkedOutIn' went looking.+ SourceRepo+ | -- | The same, found unpacked under the project's own @dist-newstyle@.+ --+ -- A directory of sources like 'LocalPackage', and read the same way.+ -- Kept apart from it because a dependency is not one of the project's+ -- own packages: its components are not components a run formats, and+ -- its @.cabal@ file being newer than the plan says nothing about+ -- whether the plan is stale.+ CheckedOut FilePath+ deriving (Eq, Show)++-- | Which repository a package was fetched from, as far as it bears on+-- finding the tarball afterwards.+data Repository+ = -- | One @cabal@ downloads from, named by its URI. The tarball goes into+ -- the package cache, in a directory named after the repository as the+ -- configuration spells it.+ Downloaded Text+ | -- | A directory of tarballs, named by @file+noindex@. Nothing is+ -- downloaded and nothing is cached: the tarball is already sitting+ -- there, beside the index @cabal@ wrote for it.+ ADirectory FilePath+ | -- | A plan that does not say. Older @cabal@ wrote nothing here, and+ -- Hackage is the only guess worth making.+ Unsaid+ deriving (Eq, Show)++-- | Is there a tarball to go and read?+isFetchable :: PlanPackage -> Bool+isFetchable p = case ppSource p of+ RepoPackage _ _ -> True+ _ -> False++-- | Every package the compiler can see.+whatTheCompilerSees :: Maybe Cache -> IO [InstalledPackage]+whatTheCompilerSees cache =+ remembered >>= \case+ Just packages -> pure packages+ Nothing -> do+ found <- readInstalledPackages+ traverse_ (`storeInstalled` found) cache+ pure (installedPackages found)+ where+ remembered = maybe (pure Nothing) cachedInstalled cache++-- | Summarize a 'BuildPlan', and the environment it will be read in, by+-- hashing over both.+--+-- The plan alone would not do. What a failure to read a module leans on is+-- partly the plan and partly the compiler this run can ask: a package the+-- plan names is unreadable where @ghc-pkg@ does not expose it and readable+-- where it does, and one shell can differ from another in that while+-- solving the very same plan. Tying failures to the plan alone would let+-- one shell's \"could not be read\" be handed to a shell that can.+tokenFor :: BuildPlan -> IO PlanToken+tokenFor plan = flip planToken plan <$> compilerIdentity++-- | 'tokenFor' without the asking, so that what goes into the token is+-- visible in one place.+planToken :: Text -> BuildPlan -> PlanToken+planToken environment plan =+ PlanToken+ . T.take 16+ . T.decodeUtf8Lenient+ . B16.encode+ . SHA256.hash+ . T.encodeUtf8+ $ T.intercalate+ "\n"+ (environment : bpCompiler plan : Data.List.sort (map cacheKey (bpPackages plan)))++-- | The SHA-256 the plan expects this package's tarball to have.+sourceHashOf :: PlanPackage -> Maybe Text+sourceHashOf p = case ppSource p of+ RepoPackage hash _ -> hash+ _ -> Nothing++-- | A resolved build plan.+data BuildPlan = BuildPlan+ { bpCompiler :: Text,+ bpPackages :: [PlanPackage]+ }+ deriving (Eq, Show)++instance FromJSON BuildPlan where+ parseJSON = withObject "BuildPlan" $ \o ->+ BuildPlan+ <$> o .: "compiler-id"+ <*> o .: "install-plan"++instance FromJSON PlanPackage where+ parseJSON = withObject "PlanPackage" $ \o -> do+ name <- o .: "pkg-name"+ version <- o .: "pkg-version"+ kind <- o .:? "type"+ sourceKind <- o .:? "pkg-src" >>= traverse (.: "type")+ sourcePath <- o .:? "pkg-src" >>= traverse (.:? "path")+ sourceHash <- o .:? "pkg-src-sha256"+ repo <- o .:? "pkg-src" >>= traverse (.:? "repo")+ repoKind <- traverse (traverse (.:? "type")) repo+ repoUri <- traverse (traverse (.:? "uri")) repo+ repoPath <- traverse (traverse (.:? "path")) repo+ named <- o .:? "component-name"+ whole <- o .:? "components"+ pure+ PlanPackage+ { ppName = name,+ ppVersion = version,+ ppComponents = componentsOf named whole,+ ppSource = case (kind :: Maybe Text, sourceKind :: Maybe Text) of+ (Just "pre-existing", _) -> PreExisting+ (_, Just "repo-tar") ->+ RepoPackage+ sourceHash+ ( case (join (join repoKind) :: Maybe Text, join (join repoPath), join (join repoUri)) of+ (Just "local-repo-no-index", Just dir, _) -> ADirectory (T.unpack dir)+ (_, _, Just uri) -> Downloaded uri+ _ -> Unsaid+ )+ (_, Just "local") -> LocalPackage (maybe "" T.unpack (join sourcePath))+ (_, Just "source-repo") -> SourceRepo+ -- Anything else is treated as already present.+ _ -> PreExisting+ }++-- | The components one plan entry is about.+--+-- @cabal@ writes this two ways. An entry for a single component names it in+-- @component-name@; an entry for a package planned whole carries a+-- @components@ object instead, keyed by the very same spellings. Reading+-- only the first would leave every @Custom@ package looking like one the+-- plan says nothing about, and a run would keep asking @cabal@ to solve+-- again for components a fresh solve would file exactly where this one did.+--+-- @setup@ is dropped. It is the @Setup.hs@ program @cabal@ builds in order+-- to build the package, not a component of the package, and nothing in the+-- project will ever be formatted as part of it.+componentsOf :: Maybe Text -> Maybe (Map Text Value) -> [Text]+componentsOf named whole = case named of+ Just component -> [component]+ Nothing -> filter (/= "setup") (Map.keys (fromMaybe Map.empty whole))++-- | Read @plan.json@.+readBuildPlan :: FilePath -> IO (Either Text BuildPlan)+readBuildPlan path =+ doesFileExist path >>= \case+ False -> pure (Left ("no build plan at " <> T.pack path))+ True ->+ eitherDecodeFileStrict path >>= \case+ Left why -> pure (Left (T.pack why))+ Right plan -> Right <$> checkedOutIn (takeDirectory (takeDirectory path)) plan++-- | Find where @cabal@ unpacked each @source-repository-package@.+checkedOutIn :: FilePath -> BuildPlan -> IO BuildPlan+checkedOutIn distDir plan = do+ packages <- traverse locate (bpPackages plan)+ pure plan {bpPackages = packages}+ where+ locate p = case ppSource p of+ SourceRepo ->+ clonesOf p >>= \case+ (dir : _) -> pure p {ppSource = CheckedOut dir}+ [] -> pure p+ _ -> pure p+ clonesOf p = quietly [] $ do+ entries <- listDirectory (distDir </> "src")+ filterM+ (isThePackage p)+ [ distDir </> "src" </> e+ | 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++-- | The version macros a plan settles.+macrosOf :: BuildPlan -> Macros+macrosOf plan =+ Macros+ { macroVersions =+ Map.fromList+ ( [ ("MIN_VERSION_" <> underscored name, version)+ | (name, [version]) <- Map.toList (Map.map Set.toList versions)+ ]+ <> [("MIN_VERSION_GLASGOW_HASKELL", v) | v <- toList compiler]+ ),+ macroNumbers =+ Map.fromList+ [ entry+ | (major : minor : patches) <- toList compiler,+ entry <-+ [ ("__GLASGOW_HASKELL__", major * 100 + minor),+ ("__GLASGOW_HASKELL_PATCHLEVEL1__", nth 0 patches),+ ("__GLASGOW_HASKELL_PATCHLEVEL2__", nth 1 patches)+ ]+ ]+ }+ where+ versions =+ Map.fromListWith+ Set.union+ [ (ppName p, Set.singleton v)+ | p <- bpPackages plan,+ Just v <- [numberedVersion (ppVersion p)]+ ]+ compiler = do+ version <- T.stripPrefix "ghc-" (bpCompiler plan)+ parts <- numberedVersion version+ case parts of+ _ : _ : _ -> Just (take 4 (parts <> repeat 0))+ _ -> Nothing+ nth i xs = if i < length xs then xs !! i else 0++-- | The modules @cabal@ writes itself for a plan's packages, and which are+-- therefore in nobody's sources.+generatedModules :: BuildPlan -> Set Text+generatedModules plan =+ Set.fromList+ [ prefix <> underscored (ppName p)+ | p <- bpPackages plan,+ prefix <- ["Paths_", "PackageInfo_"]+ ]++-- | A package's name as a module name spells it, which is with the hyphens+-- turned into underscores. @cabal@ does this for the version macros and for+-- the modules it generates alike.+underscored :: Text -> Text+underscored = T.map (\c -> if c == '-' then '_' else c)++-- | A version as its numbers, or 'Nothing' where any of them is not one.+numberedVersion :: Text -> Maybe [Integer]+numberedVersion = traverse number . T.splitOn "."+ where+ number part = case T.decimal part of+ Right (n, rest) | T.null rest -> Just n+ _ -> Nothing++----------------------------------------------------------------------------+-- Readiness++-- | A component of the project, named the way a build plan names one.+data PlanComponent = PlanComponent+ { -- | The package it belongs to.+ pcPackage :: Text,+ -- | @lib@, @exe:name@, @test:name@, @bench:name@.+ pcName :: Text+ }+ deriving (Eq, Ord, Show)++-- | A component as it would be written on the command line.+spellComponent :: PlanComponent -> Text+spellComponent c = pcPackage c <> ":" <> pcName c++-- | The components of the project's own packages that a plan covers.+plannedComponents :: BuildPlan -> [PlanComponent]+plannedComponents plan =+ [ PlanComponent (ppName p) component+ | p <- bpPackages plan,+ LocalPackage _ <- [ppSource p],+ component <- ppComponents p+ ]++-- | Whether everything the resolver needs is on disk.+data Readiness+ = -- | Nothing to do.+ Ready+ | -- | No build plan; @cabal@ has not solved this project yet.+ PlanMissing+ | -- | The plan is older than the files that determine it.+ 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 answer everything the+ -- source would have been read for, so a package the compiler already+ -- holds is not missing however absent its tarball is.+ SourcesMissing [Text]+ deriving (Eq, Show)++-- | Where @cabal@ writes the plan for a project.+planPathFor :: FilePath -> FilePath+planPathFor projectDir = projectDir </> "dist-newstyle" </> "cache" </> "plan.json"++-- | Check what is missing, cheaply.+--+-- One read of the plan and one @stat@ per package, so this is fast enough+-- to run before every format without anyone noticing.+checkReadiness :: [PlanComponent] -> FilePath -> IO Readiness+checkReadiness wanted projectDir =+ readBuildPlan (planPathFor projectDir) >>= \case+ Left _ -> pure PlanMissing+ Right plan -> do+ newer <- filesNewerThanPlan plan projectDir+ let covered = plannedComponents plan+ missing = [spellComponent c | c <- wanted, c `notElem` covered]+ case (newer, missing) of+ (_ : _, _) -> pure (PlanStale newer)+ ([], _ : _) -> pure (PlanNarrow missing)+ ([], []) ->+ sourcesShortOf plan >>= \case+ [] -> pure Ready+ ns -> pure (SourcesMissing ns)++-- | The packages the plan expects to fetch whose sources are not here.+--+-- Asked apart from the rest of 'checkReadiness' because it is a different+-- question with a different answer. Whether the plan covers the components+-- a run is about to format is about the plan; whether the sources it names+-- are on this machine is about the machine, and a plan that will never+-- cover everything—one component of the project does not build, and the+-- solver leaves it out—must not stop the sources for the rest being+-- fetched.+sourcesShortOf :: BuildPlan -> IO [Text]+sourcesShortOf plan = do+ tarballs <- filter (isFetchable . fst) <$> plannedTarballs plan+ absent <- map fst <$> filterM (fmap not . doesFileExist . snd) tarballs+ short <-+ if null absent+ then pure []+ else do+ cache <- openCache =<< tokenFor plan+ installed <- whatTheCompilerSees cache+ pure (filter (not . builtAlready installed) absent)+ pure (map ppName short)++-- | Has the compiler got this package already?+builtAlready :: [InstalledPackage] -> PlanPackage -> Bool+builtAlready installed p = any matches installed+ where+ matches i = ipName i == ppName p && ipVersion i == ppVersion p++-- | The project files that have changed since the plan was written.+--+-- A plan describes the dependencies as they were when @cabal@ last solved.+-- Edit a @build-depends@ and the plan on disk is about a different project,+-- and resolving fixities against it would answer for packages that are no+-- longer in play. Comparing modification times is one @stat@ each, so this+-- costs nothing to check every time.+filesNewerThanPlan :: BuildPlan -> FilePath -> IO [FilePath]+filesNewerThanPlan plan projectDir = quietly [] $ do+ planTime <- getModificationTime (planPathFor projectDir)+ atRoot <- quietly [] (listDirectory projectDir)+ inPackages <- concat <$> traverse cabalFilesIn (localDirs plan)+ let candidates =+ [projectDir </> f | f <- atRoot, f `elem` projectFiles]+ <> [projectDir </> f | f <- atRoot, ".cabal" `isSuffixOf` f]+ <> inPackages+ newer <- traverse (isNewerThan planTime) candidates+ pure [f | Just f <- newer]+ where+ projectFiles =+ ["cabal.project", "cabal.project.local", "cabal.project.freeze"]+ localDirs p =+ Data.List.nub [dir | LocalPackage dir <- map ppSource (bpPackages p)]+ cabalFilesIn dir = quietly [] $ do+ entries <- listDirectory dir+ pure [dir </> f | f <- entries, ".cabal" `isSuffixOf` f]+ isNewerThan planTime path = quietly Nothing $ do+ t <- getModificationTime path+ pure (if t > planTime then Just path else Nothing)++-- | Do whatever is missing, by asking @cabal@.+--+-- Neither of these builds anything: a dry run only solves, and+-- @--only-download@ only fetches. Both are one-time costs, and @cabal@'s+-- package cache is shared between projects, so a machine that has seen a+-- dependency once never fetches it again.+--+-- This runs a subprocess and may reach the network, so it is a separate+-- call rather than something 'newResolver' does behind the caller's back.+-- An editor formatting on save must not block on it.+prepare :: [PlanComponent] -> FilePath -> Readiness -> IO (Either Text ())+prepare wanted projectDir readiness =+ prepareWith (runCabal projectDir) (solvesFor projectDir) wanted projectDir readiness++-- | What a run knows about the asking earlier runs did, and how to add to+-- it.+--+-- Both halves are the same idea: @cabal@ was asked for something, it did+-- not help, and asking again will not help either. A run that formats on+-- save would otherwise ask on every save.+data Solves = Solves+ { -- | Has solving this plan already been tried and left it as narrow?+ solveWasFutile :: IO Bool,+ -- | Remember that it has.+ rememberFutileSolve :: IO (),+ -- | The packages an earlier fetch was still short of afterwards.+ fetchWasFutileFor :: IO [Text],+ -- | Remember what a fetch left missing.+ rememberFutileFetch :: [Text] -> IO ()+ }++-- | Solves remembered nowhere, for a caller with nothing to remember them+-- in.+forgetfulSolves :: Solves+forgetfulSolves =+ Solves+ { solveWasFutile = pure False,+ rememberFutileSolve = pure (),+ fetchWasFutileFor = pure [],+ rememberFutileFetch = const (pure ())+ }++-- | Solves remembered in the cache, under the plan the project has now.+--+-- A project with no readable plan has no token to file anything under, and+-- nothing to remember either: a solve is exactly what it needs.+solvesFor :: FilePath -> Solves+solvesFor projectDir =+ Solves+ { solveWasFutile = withCache False cachedFutileSolve,+ rememberFutileSolve = withCache () storeFutileSolve,+ fetchWasFutileFor = withCache [] cachedFutileFetch,+ rememberFutileFetch = \packages -> withCache () (`storeFutileFetch` packages)+ }+ where+ withCache fallback use =+ readBuildPlan (planPathFor projectDir) >>= \case+ Left _ -> pure fallback+ Right plan -> do+ opened <- openCache =<< tokenFor plan+ maybe (pure fallback) use opened++-- | 'prepare', given a way to run @cabal@ and a memory of earlier solves.+prepareWith ::+ -- | Run @cabal@ with these arguments+ ([String] -> IO (Either Text ())) ->+ -- | What is known about solves already asked for+ Solves ->+ -- | The components the run is about to format+ [PlanComponent] ->+ -- | The project being prepared+ FilePath ->+ -- | What it was found to be short of+ Readiness ->+ IO (Either Text ())+prepareWith cabal solves wanted projectDir = \case+ Ready -> pure (Right ())+ SourcesMissing _ -> fetch+ PlanMissing -> solveThenFetch+ PlanStale _ -> solveThenFetch+ PlanNarrow _ ->+ solveWasFutile solves >>= \case+ True -> fetchWhatIsShort+ False -> solveThenFetch+ where+ wholeProject = ["--enable-tests", "--enable-benchmarks"]+ tryWholeProject args =+ cabal (args <> wholeProject) >>= \case+ Right () -> pure (Right ())+ Left _ -> cabal args+ fetch = tryWholeProject ["build", "all", "--only-download"]+ fetchWhatIsShort =+ readBuildPlan (planPathFor projectDir) >>= \case+ Left _ -> pure (Right ())+ Right plan -> do+ short <- sourcesShortOf plan+ refused <- fetchWasFutileFor solves+ if null short || all (`elem` refused) short+ then pure (Right ())+ else+ fetch >>= \case+ Left err -> pure (Left err)+ Right () -> do+ left <- sourcesShortOf plan+ rememberFutileFetch solves left+ pure (Right ())+ solveThenFetch =+ tryWholeProject ["build", "all", "--dry-run"] >>= \case+ Left err -> pure (Left err)+ Right () ->+ checkReadiness wanted projectDir >>= \case+ SourcesMissing _ -> fetch+ PlanNarrow _ -> rememberFutileSolve solves >> fetchWhatIsShort+ _ -> pure (Right ())++-- | Run @cabal@ in a project directory, letting it speak for itself.+runCabal :: FilePath -> [String] -> IO (Either Text ())+runCabal projectDir args = quietly (Left "could not run cabal") $ do+ hFlush stderr+ -- A duplicate because 'createProcess' closes the handle it is given once+ -- the child has it, and closing the real standard error would leave+ -- nothing to report the failure on.+ passed <- hDuplicate stderr+ (_, _, _, running) <-+ createProcess+ (proc "cabal" args)+ { cwd = Just projectDir,+ std_out = UseHandle passed,+ std_err = Inherit+ }+ code <- waitForProcess running+ pure $ case code of+ ExitSuccess -> Right ()+ _ -> Left ("cabal " <> T.unwords (map T.pack args) <> " failed; see above")++-- | Get a plan that is safe to use, doing whatever @cabal@ work is needed.+--+-- This is the call most users want. It checks, asks @cabal@ if anything is+-- missing or possibly out of date, and then reads the plan. 'prepare' does+-- at most one solve and one fetch however much is missing, so a project+-- whose files are merely newer than its plan cannot send this into a loop,+-- and the plan is read once at the end rather than judged again.+loadPlan :: [PlanComponent] -> FilePath -> IO (Either Text BuildPlan)+loadPlan wanted projectDir = do+ readiness <- checkReadiness wanted projectDir+ prepare 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.+--+-- Not only the ones the plan will fetch. A package already installed still+-- has a tarball in the cache if anything ever downloaded it, and under Nix+-- that is the normal case for every dependency. A package with no tarball+-- costs one @stat@ and falls through.+--+-- Local packages are excluded: they are directories, not archives.+plannedTarballs :: BuildPlan -> IO [(PlanPackage, FilePath)]+plannedTarballs plan = do+ cacheRoot <- packageCacheRoot+ -- Listed once rather than once per package: a plan holds hundreds of+ -- these and the answer is the same for every one of them.+ repos <- quietly [] (Data.List.sort <$> listDirectory cacheRoot)+ traverse+ (\p -> (,) p <$> tarballFor cacheRoot repos p)+ [p | p <- bpPackages plan, not (isLocal p)]+ where+ isLocal p = case ppSource p of+ LocalPackage _ -> True+ CheckedOut _ -> True+ _ -> False++-- | Where @cabal@ keeps downloaded package sources, one directory per+-- repository it downloads from.+packageCacheRoot :: IO FilePath+packageCacheRoot =+ readProgramOutput "cabal" ["path", "--remote-repo-cache", "--output-format=json"] >>= \case+ Just said | Just dir <- remoteRepoCacheIn said -> pure dir+ _ -> guessedPackageCacheRoot++-- | The package cache directory, out of what @cabal path@ printed.+remoteRepoCacheIn :: Text -> Maybe FilePath+remoteRepoCacheIn said = do+ spoken <- listToMaybe (reverse (filter (not . T.null) (map T.strip (T.lines said))))+ value <- decodeStrict (T.encodeUtf8 spoken)+ parseMaybe (withObject "cabal path" (.: "remote-repo-cache")) value++-- | Where @cabal@ probably keeps them, for a @cabal@ that will not say.+guessedPackageCacheRoot :: IO FilePath+guessedPackageCacheRoot =+ lookupEnv "CABAL_DIR" >>= \case+ Just dir -> pure (dir </> "packages")+ Nothing -> do+ places <- cabalDirs+ found <- filterM holdsAnIndex (toList places)+ pure (fromMaybe (NE.head places) (listToMaybe found))+ where+ holdsAnIndex dir =+ quietly False (doesFileExist (dir </> hackage </> "01-index.tar"))+ hackage = "hackage.haskell.org"++-- | Every directory @cabal@ could be keeping a package cache in, the+-- platform's own default first.+cabalDirs :: IO (NonEmpty FilePath)+cabalDirs = do+ appData <- getAppUserDataDirectory "cabal"+ xdg <- quietly Nothing (Just <$> getXdgDirectory XdgCache "cabal")+ pure . fmap (</> "packages") $ case xdg of+ Just dir | not onWindows -> dir :| [appData]+ Just dir -> appData :| [dir]+ Nothing -> appData :| []++-- | Whether this is a Windows build, for the places that differ there.+onWindows :: Bool+onWindows = System.Info.os == "mingw32"++-- | The repository @cabal@ would have kept a package's sources under.+hackageByDefault :: FilePath+hackageByDefault = "hackage.haskell.org"++-- | Where a package's source tarball is, or where fetching would put it.+tarballFor :: FilePath -> [FilePath] -> PlanPackage -> IO FilePath+tarballFor cacheRoot repos p = case repositoryOf p of+ ADirectory dir -> pure (dir </> flat)+ Downloaded uri -> searched (hostOf uri)+ Unsaid -> searched Nothing+ where+ flat = T.unpack (ppName p <> "-" <> ppVersion p <> ".tar.gz")+ under repo =+ cacheRoot </> repo </> T.unpack (ppName p) </> T.unpack (ppVersion p) </> flat+ searched preferred = do+ let first' = fromMaybe hackageByDefault preferred+ rest = filter (/= first') repos+ found <- filterM doesFileExist (map under (first' : rest))+ pure (fromMaybe (under first') (listToMaybe found))++-- | Which repository a package came from, where it came from one.+repositoryOf :: PlanPackage -> Repository+repositoryOf p = case ppSource p of+ RepoPackage _ repo -> repo+ _ -> Unsaid++-- | The host a URI names, which is what @cabal@ conventionally calls the+-- repository that lives there.+hostOf :: Text -> Maybe FilePath+hostOf uri = case T.breakOn "//" uri of+ (_, rest)+ | not (T.null rest),+ host <- T.takeWhile (/= '/') (T.drop 2 rest),+ not (T.null host) ->+ Just (T.unpack host)+ _ -> Nothing++----------------------------------------------------------------------------+-- Resolving++-- | Where a module's fixities can be read from.+data Route+ = -- | The compiled interface the package database points at. Cheap, and+ -- authoritative where it exists, since it is the compiler's own account+ -- of what it settled on.+ FromInterface+ | -- | The module's source, out of the package's tarball in Cabal's+ -- package cache. Slower, and the only route for a package that is+ -- planned but not built.+ FromSource+ deriving (Eq, Show)++-- | What can be asked about a module, once a plan says where to look.+--+-- The three questions "Tilia.Fixity" has, answered against the outside+-- world. They come back together because they share everything—the module+-- index, the cache, the packages the compiler holds, the memo of what has+-- been read—and answering them apart would settle all of it three times.+data Resolver = Resolver+ { -- | What a module exports, with 'Nothing' for one that could not be+ -- read, which is not the same as its having no operators; see+ -- 'Tilia.Fixity.resolveScope' for why the difference has to survive.+ askFixities :: Text -> IO (Maybe (Fixities)),+ -- | What a module keeps under each of its names, for the sake of a+ -- @T(..)@ in an import list.+ askChildren :: Text -> IO (Map OpName (Set OpName)),+ -- | The operators an unread module's export list names, asked only of+ -- the modules 'askFixities' gave up on, and what keeps a module that+ -- plainly has no such operator from being blamed for one.+ askExportNames :: Text -> IO (Maybe (Set OpName)),+ -- | The modules reading a module went through before giving up, the one+ -- it gave up on last. Asked only of the modules 'askFixities' gave up+ -- on, and only so that a message can name the module really in the way+ -- rather than the import that happens to sit above it.+ askChain :: Text -> IO [Text]+ }++-- | Build the answers to what "Tilia.Fixity" asks.+--+-- Answers are remembered on disk between runs by "Tilia.Fixity.Cache", so a+-- package is decompressed and parsed once per machine rather than once per+-- file.+newResolver ::+ -- | The build plan to use+ BuildPlan ->+ IO Resolver+newResolver = newResolverVia [FromInterface, FromSource]++-- | 'newResolver', restricted to the routes given.+newResolverVia ::+ -- | Which readings to try, in order+ [Route] ->+ -- | The build plan to use+ BuildPlan ->+ IO Resolver+newResolverVia routes plan = do+ tarballs <- plannedTarballs plan+ cache <- openCache =<< tokenFor plan+ installed <- whatTheCompilerSees cache+ index <- buildModuleIndex cache installed tarballs+ let interfaces = interfaceIndex installed+ local <- localModules plan+ memo <- newIORef Map.empty+ childrenRead <- newIORef Map.empty+ askPackage <- newPackageReader+ extensionsRead <- newIORef Map.empty+ exportsRead <- newIORef Map.empty+ interfacesRead <- newIORef Map.empty+ let interfaceOf modName = do+ seen <- readIORef interfacesRead+ case Map.lookup modName seen of+ Just interface -> pure interface+ Nothing -> do+ found <- case Map.lookup modName interfaces of+ Nothing -> pure Nothing+ Just (_, path) -> readInterface modName path+ -- Being listed is not the same as being readable: @ghc-pkg@+ -- names @GHC.Prim@ among @ghc-prim@'s modules and there is no+ -- file at the path that implies. So the table answers for a+ -- module with nothing to read, however it came to have nothing.+ let interface = case found of+ Just _ -> found+ Nothing -> asInterface <$> Map.lookup modName builtinFixities+ atomicModifyIORef' interfacesRead (\m -> (Map.insert modName interface m, ()))+ pure interface+ let workings =+ Workings+ { wkRoutes = routes,+ wkCache = cache,+ wkLocal = local,+ wkIndex = index,+ wkInterfaces = interfaces,+ wkInterfaceOf = interfaceOf,+ wkReach = reach,+ wkReachChildren = children,+ wkReachExports = exports,+ wkExtensionsOf = extensionsOf,+ wkMacros = macrosOf plan,+ wkGenerated = generatedModules plan+ }+ resolved visiting modName = do+ known <- readIORef memo+ case Map.lookup modName known of+ Just answer -> pure answer+ Nothing -> do+ answer <- resolveModule workings visiting modName+ atomicModifyIORef' memo (\m -> (Map.insert modName answer m, ()))+ pure answer+ reach visiting modName+ | modName `Set.member` visiting = pure Nothing+ | otherwise = fixitiesEstablished <$> resolved visiting modName+ chain visiting = go Set.empty+ where+ go seen modName+ | modName `Set.member` seen = pure []+ | otherwise =+ resolved visiting modName >>= \case+ Unreadable (Just below) ->+ (below :) <$> go (Set.insert modName seen) below+ _ -> pure []+ exports visiting modName+ | modName `Set.member` visiting = pure Nothing+ | otherwise = do+ seen <- readIORef exportsRead+ case Map.lookup modName seen of+ Just names -> pure names+ Nothing -> do+ names <- exportNamesOfModule workings visiting modName+ atomicModifyIORef' exportsRead (\m -> (Map.insert modName names m, ()))+ pure names+ extensionsOf modName+ | Just path <- Map.lookup modName local =+ either (const []) id <$> askPackage path+ | Just (package, tarball) <- Map.lookup modName index = do+ seen <- readIORef extensionsRead+ case Map.lookup package seen of+ Just extensions -> pure extensions+ Nothing -> do+ extensions <- fromTarball tarball+ atomicModifyIORef' extensionsRead (\m -> (Map.insert package extensions m, ()))+ pure extensions+ | otherwise = pure []+ fromTarball tarball =+ quietly [] $ do+ bytes <- BL.readFile tarball+ pure (foldMap declaredExtensions (cabalFileInArchive (Tar.read (GZip.decompress bytes))))+ children visiting modName+ | modName `Set.member` visiting = pure Map.empty+ | otherwise = do+ seen <- readIORef childrenRead+ case Map.lookup modName seen of+ Just kept -> pure kept+ Nothing -> do+ kept <- childrenOfModule workings visiting modName+ atomicModifyIORef' childrenRead (\m -> (Map.insert modName kept m, ()))+ pure kept+ pure+ Resolver+ { askFixities = reach Set.empty,+ askChildren = children Set.empty,+ askExportNames = exports Set.empty,+ askChain = chain Set.empty+ }++-- | The operators a module's export list names, where that list can be+-- enumerated without reading what it passes on.+--+-- Asked only about modules whose fixities could not be established, and+-- only to decide which of them an unsettled operator can be blamed on. A+-- module that exports whole modules keeps its own counsel and answers+-- 'Nothing'; one with no export list exports what it declares, which is+-- every fixity it could supply.+exportNamesOfModule :: Workings -> Set Text -> Text -> IO (Maybe (Set OpName))+exportNamesOfModule+ Workings {wkCache, wkLocal, wkIndex, wkReachChildren, wkReachExports, wkMacros}+ visiting+ modName+ | Just path <- Map.lookup modName wkLocal,+ writtenForHsc path =+ pure (Just (hscSupplies modName))+ | Just path <- Map.lookup modName wkLocal = namesIn =<< readFileText path+ | Just (package, tarball) <- Map.lookup modName wkIndex =+ remembered package >>= \case+ Just answer -> pure (exportedNames answer)+ Nothing ->+ readModule tarball modName >>= \case+ Nothing -> pure Nothing+ Just ForHsc -> do+ let names = Just (hscSupplies modName)+ store package (asExported names)+ pure names+ Just (Haskell text) -> do+ names <- namesIn (Just text)+ store package (asExported names)+ pure names+ | otherwise = pure Nothing+ where+ remembered package = case wkCache of+ Nothing -> pure Nothing+ Just c -> cachedExportNames c package modName+ store package answer = case wkCache of+ Nothing -> pure ()+ Just c -> storeExportNames c package modName answer+ namesIn text = case parsedLeaves =<< text of+ Nothing -> pure Nothing+ Just modules ->+ fmap Set.unions . sequence <$> traverse readOne modules+ readOne (implicitPrelude, hsModule) =+ exportNamesWithReexports+ implicitPrelude+ (wkReachExports visiting')+ (wkReachChildren visiting')+ modName+ hsModule+ visiting' = Set.insert modName visiting+ parsedLeaves = configurationsOf wkMacros Nothing modName++-- | What a module keeps under each of its names, so that a @T(..)@ in an+-- import list can be told what it brings in.+childrenOfModule :: Workings -> Set Text -> Text -> IO (Map OpName (Set OpName))+childrenOfModule+ Workings+ { wkRoutes,+ wkCache,+ wkLocal,+ wkIndex,+ wkInterfaces,+ wkInterfaceOf,+ wkReachChildren,+ wkExtensionsOf,+ wkMacros+ }+ visiting+ modName+ | Just path <- Map.lookup modName wkLocal,+ writtenForHsc path =+ pure Map.empty+ | Just path <- Map.lookup modName wkLocal =+ readFileText path >>= \case+ Nothing -> pure Map.empty+ Just text -> inSource text+ | otherwise = firstAnswer (map taking wkRoutes)+ where+ taking = \case+ FromInterface -> case Map.lookup modName wkInterfaces of+ Nothing -> pure Nothing+ Just (key, _) -> keptUnder key outOfInterface+ FromSource -> case Map.lookup modName wkIndex of+ Nothing -> pure Nothing+ Just (package, tarball) ->+ keptUnder package $+ readModule tarball modName >>= \case+ Nothing -> pure Nothing+ Just ForHsc -> pure (Just Map.empty)+ Just (Haskell text) -> Just <$> inSource text+ firstAnswer [] = pure Map.empty+ firstAnswer (route : rest) =+ route >>= \case+ Just kept -> pure kept+ Nothing -> firstAnswer rest+ keptUnder package readIt =+ remembered package >>= \case+ Just kept -> pure (Just kept)+ Nothing -> do+ kept <- readIt+ traverse_ (store package) kept+ pure kept+ remembered package = case wkCache of+ Nothing -> pure Nothing+ Just c -> cachedChildren c package modName+ store package kept = case wkCache of+ Nothing -> pure ()+ Just c -> storeChildren c package modName kept+ outOfInterface = fmap interfaceChildren <$> wkInterfaceOf modName+ inSource text = do+ extensions <- wkExtensionsOf modName+ case parsedLeaves extensions text of+ Nothing -> pure Map.empty+ Just modules ->+ Map.unionsWith Set.union+ <$> traverse readOne modules+ readOne (implicitPrelude, hsModule) =+ childrenWithReexports+ implicitPrelude+ (wkReachChildren visiting')+ modName+ hsModule+ visiting' = Set.insert modName visiting+ parsedLeaves extensions = configurationsOf wkMacros (Just extensions) modName++-- | Work out what a module can see, using a resolver to reach its imports.+--+-- This is the join between the pure half of "Tilia.Fixity" and the half+-- that touches the disk: the imports are resolved first, and the scope is+-- then computed from the answers. Note that an import the resolver could+-- not read arrives as 'Nothing' and stays 'Nothing', which is what lets+-- 'Tilia.Fixity.lookupFixity' distinguish a conclusion from a guess.+scopeFor ::+ -- | What can be asked about the modules it imports+ Resolver ->+ -- | Whether @ImplicitPrelude@ is on, which the module's own pragmas+ -- and its package's @default-extensions@ decide between them+ Choice "implicitPrelude" ->+ -- | The module whose scope is wanted, already parsed+ HsModule GhcPs ->+ -- | Everything that module can see, and what it could not find out+ IO Scope+scopeFor resolver implicitPrelude hsModule = do+ let imports = moduleImports implicitPrelude hsModule+ answers <- traverse (\m -> (m,) <$> askFixities resolver m) (map importModule imports)+ let table = Map.fromList answers+ unread = [m | (m, Nothing) <- answers]+ names <- Map.fromList <$> traverse (\m -> (m,) <$> askExportNames resolver m) unread+ chains <- Map.fromList <$> traverse (\m -> (m,) <$> askChain resolver m) unread+ kept <-+ Map.fromList+ <$> traverse+ (\m -> (m,) <$> askChildren resolver m)+ (Set.toList (Set.fromList (map importModule (filter expands imports))))+ pure $+ resolveScope+ implicitPrelude+ Known+ { knownFixities = \m -> Map.findWithDefault Nothing m table,+ knownChildren = \m -> Map.findWithDefault Map.empty m kept,+ knownExportNames = \m -> Map.findWithDefault Nothing m names,+ knownChain = \m -> Map.findWithDefault [] m chains+ }+ hsModule+ where+ expands i = case importNames i of+ Nothing -> False+ Just (_, items) -> any isAll items+ isAll = \case+ ImportedAll _ -> True+ _ -> False++-- | Everything a resolver consults, and the way back into it.+--+-- None of it changes from one module to the next, which is why+-- 'newResolverVia' builds it once and hands it over whole. What comes back+-- out of that is the 'Resolver'; this is what is behind it.+data Workings = Workings+ { -- | Which readings to try, in the order given.+ wkRoutes :: [Route],+ -- | Where to remember answers between runs.+ wkCache :: Maybe Cache,+ -- | The modules of the project's own packages, which are read straight+ -- from disk rather than out of an archive.+ wkLocal :: Map Text FilePath,+ -- | Which package holds each module, and the tarball to find it in; the+ -- package is the cache key, which carries the hash the tarball was+ -- verified against.+ wkIndex :: Map Text (Text, FilePath),+ -- | What to file an answer read out of each module's interface under.+ wkInterfaces :: Map Text (Text, FilePath),+ -- | A module's interface, read at most once a run.+ wkInterfaceOf :: Text -> IO (Maybe Interface),+ -- | How to reach another module. Tied back on itself by+ -- 'newResolverVia', so that the memo it keeps covers the recursive+ -- calls too.+ wkReach :: Set Text -> Text -> IO (Maybe (Fixities)),+ -- | How to reach another module for what its names carry with them,+ -- tied back the same way and against a visiting set of its own.+ wkReachChildren :: Set Text -> Text -> IO (Map OpName (Set OpName)),+ -- | How to reach another module for what its export list names, tied+ -- back the same way again.+ wkReachExports :: Set Text -> Text -> IO (Maybe (Set OpName)),+ -- | What the package a module belongs to puts in force. A module that+ -- leans on its package's @default-extensions@ does not parse without+ -- them, and one that does not parse cannot be read for anything.+ wkExtensionsOf :: Text -> IO [Extension],+ -- | What the plan settles about the questions a module's conditionals+ -- ask, so that a branch written for another version of a dependency is+ -- not read as part of it.+ wkMacros :: Macros,+ -- | The modules @cabal@ writes itself, which are therefore in no+ -- package's sources. See 'generatedModules'.+ wkGenerated :: Set Text+ }++-- | Where a module's fixities come from, in order of cost.+resolveModule ::+ -- | Where to look, and how to get back to the resolver.+ Workings ->+ -- | Modules currently being resolved further up the call chain.+ --+ -- Only passed through, so that a chase started here carries where it came+ -- from. What is done about a module already in it belongs to+ -- 'newResolverVia', which decides it before anything is remembered.+ Set Text ->+ -- | The module to resolve.+ Text ->+ -- | Its operator fixities, or, where they could not be established, the+ -- module below it that stopped us if there was one.+ IO Established+resolveModule+ Workings+ { wkRoutes,+ wkCache,+ wkLocal,+ wkIndex,+ wkInterfaces,+ wkInterfaceOf,+ wkReach,+ wkReachChildren,+ wkExtensionsOf,+ wkMacros,+ wkGenerated+ }+ visiting+ modName+ | Just builtin <- Map.lookup modName builtinFixities = pure (Declares builtin)+ | Just path <- Map.lookup modName wkLocal,+ writtenForHsc path =+ pure (hscDeclares modName)+ | Just path <- Map.lookup modName wkLocal =+ readFileText path >>= \case+ Nothing -> pure (Unreadable Nothing)+ Just source -> do+ extensions <- wkExtensionsOf modName+ fromText+ wkMacros+ extensions+ (wkReach visiting')+ (wkReachChildren visiting')+ visiting'+ source+ modName+ | otherwise = answered <$> firstAnswer (map taking wkRoutes)+ where+ visiting' = Set.insert modName visiting++ taking = \case+ FromInterface -> viaInterface+ FromSource -> viaArchive++ firstAnswer = go Nothing+ where+ go blamed [] = pure (Unreadable blamed)+ go blamed (route : rest) =+ route >>= \case+ Just (Declares fixities) -> pure (Declares fixities)+ Just (Unreadable below) -> go (blamed <|> below) rest+ Nothing -> go blamed rest++ viaInterface = case Map.lookup modName wkInterfaces of+ Nothing -> pure Nothing+ Just (key, _) ->+ cachedFor key >>= \case+ Just remembered -> pure (Just remembered)+ Nothing -> do+ established <- fromInterface wkInterfaceOf modName+ storeFor key established+ pure (Just established)++ viaArchive = case Map.lookup modName wkIndex of+ Nothing -> pure Nothing+ Just (package, tarball) ->+ cachedFor package >>= \case+ Just remembered -> pure (Just remembered)+ Nothing -> do+ extensions <- wkExtensionsOf modName+ fromSource+ wkMacros+ extensions+ (wkReach visiting')+ (wkReachChildren visiting')+ visiting'+ tarball+ modName+ >>= \case+ NoArchive -> pure Nothing+ FromArchive established -> do+ storeFor package established+ pure (Just established)++ answered = \case+ Declares fixities -> Declares fixities+ Unreadable below+ | Set.member modName wkGenerated -> Declares Map.empty+ | otherwise -> maybe (Unreadable below) Declares (byHand modName)+ byHand = fmap inBothNamespaces . (`Map.lookup` byHandFixities)+ cachedFor package = case wkCache of+ Nothing -> pure Nothing+ Just c -> cachedFixities c package modName+ storeFor package fixities = case wkCache of+ Nothing -> pure ()+ Just c -> storeFixities c package modName fixities++-- | Which package and tarball holds each module.+--+-- The module list of a package is itself cached: it comes from a @.cabal@+-- file inside an archive, and reading seventy of those is the bulk of what+-- starting up costs.+--+-- Where two packages expose the same module the first is kept. A plan that+-- builds cannot contain such a pair for any module the project imports, so+-- the choice only ever falls on a module nothing will ask about.+buildModuleIndex ::+ -- | Where to remember each package's module list, if anywhere.+ Maybe Cache ->+ -- | What the compiler says is installed. Empty if @ghc-pkg@ could not be+ -- run, in which case every package falls back to its @.cabal@ file.+ [InstalledPackage] ->+ -- | Every package that might have a tarball, and where it would be.+ [(PlanPackage, FilePath)] ->+ -- | For each module, the package that exposes it (as a cache key) and+ -- the tarball holding its source.+ IO (Map Text (Text, FilePath))+buildModuleIndex cache installed tarballs =+ Map.fromListWith (\_ first' -> first') . concat <$> traverse one tarballs+ where+ byNameVersion =+ Map.fromList [((ipName i, ipVersion i), ipModules i) | i <- installed]+ 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]++-- | Where each installed module's compiled interface is.+--+-- Filed under the directory it was found in rather than under the package's+-- name and version, because those do not say which build: the same version+-- compiled with different flags can declare different fixities, and under+-- Nix a different build is a different directory.+interfaceIndex :: [InstalledPackage] -> Map Text (Text, FilePath)+interfaceIndex installed =+ Map.fromListWith+ (\_ first' -> first')+ [ (m, (key, dir </> T.unpack (T.replace "." "/" m) <> ".hi"))+ | i <- installed,+ dir <- ipImportDirs i,+ -- Bound out here so that the directory is hashed once rather than+ -- once for each of the modules found in it.+ let key = keyFor dir,+ m <- ipModules i+ ]+ where+ keyFor dir =+ "interface-"+ <> T.take 24 (T.decodeUtf8Lenient (B16.encode (SHA256.hash (T.encodeUtf8 (T.pack dir)))))++-- | Present a fixity map as an 'Interface'.+asInterface :: Fixities -> Interface+asInterface fixities =+ Interface+ { interfaceDeclares = fixities,+ interfacePassedOn = [],+ interfaceChildren = Map.empty+ }++-- | The fixities a compiled interface reports, and those it passes on.+fromInterface ::+ -- | A module's interface, if it has one+ (Text -> IO (Maybe Interface)) ->+ -- | The module to read+ Text ->+ IO Established+fromInterface interfaceOf modName =+ interfaceOf modName >>= \case+ Nothing -> pure (Unreadable Nothing)+ Just iface -> do+ declarers <- traverse asked (distinct (map fst (interfacePassedOn iface)))+ pure $ case [m | (m, Nothing) <- declarers] of+ (m : _) -> Unreadable (Just m)+ [] ->+ Declares . Map.union (interfaceDeclares iface) . Map.unions $+ [ Map.filterWithKey (\(_, o) _ -> o == op) (interfaceDeclares declarer)+ | (m, op) <- interfacePassedOn iface,+ Just (Just declarer) <- [lookup m declarers]+ ]+ where+ asked m = do+ interface <- interfaceOf m+ pure (m, interface)+ distinct = Map.keys . Map.fromList . map (,())++-- | A package's module list from the @.cabal@ file in its tarball.+fromCabalFile ::+ -- | Where to remember the answer, if anywhere.+ Maybe 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.+ PlanPackage ->+ -- | The modules it exposes, or 'Nothing' if the tarball is absent, fails+ -- verification, or holds no @.cabal@ file.+ IO (Maybe [Text])+fromCabalFile cache key tarball p = do+ remembered <- case cache of+ Nothing -> pure Nothing+ Just c -> cachedModules c key+ case remembered of+ -- A cached entry was written after the tarball was verified, and the+ -- key it is filed under contains the hash it was verified against, so a+ -- changed tarball simply misses rather than matching the wrong data.+ Just ms -> pure (Just ms)+ Nothing ->+ verified p tarball >>= \case+ False -> pure Nothing+ True ->+ packageModules tarball >>= \case+ Nothing -> pure Nothing+ Just ms -> do+ case cache of+ Nothing -> pure ()+ Just c -> storeModules c key ms+ pure (Just ms)++-- | How a package's cached answers are filed.+--+-- The expected hash is part of the key, so everything derived from a+-- tarball is bound to the exact bytes it was derived from. A package with+-- no hash in the plan is keyed by name and version alone.+cacheKey :: PlanPackage -> Text+cacheKey p =+ ppName p <> "-" <> ppVersion p <> maybe "" (("-" <>) . T.take 16) (sourceHashOf p)++-- | Does the tarball hash to what the plan says it should?+--+-- Hashing a few megabytes is not free, which is why it happens only on a+-- cache miss: once per package version per machine.+verified :: PlanPackage -> FilePath -> IO Bool+verified p tarball = case sourceHashOf p of+ Nothing -> pure True+ Just expected ->+ quietly False $ do+ 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 a module's fixities out of a tarball, following re-exports.+fromSource ::+ -- | What the plan settles about its conditionals.+ Macros ->+ -- | What the module's package puts in force, before its own pragmas.+ [Extension] ->+ -- | How to reach another module, for chasing re-exports. This is+ -- 'resolveModule' tied back on itself, with the visiting set already+ -- extended.+ (Text -> IO (Maybe (Fixities))) ->+ -- | How to reach another module for what its names carry with them.+ (Text -> IO (Map OpName (Set OpName))) ->+ -- | Modules currently being resolved, passed through so that a+ -- re-export chain cannot loop.+ Set Text ->+ -- | The tarball holding this module's source.+ FilePath ->+ -- | The module to read.+ Text ->+ -- | What it declares, including what it only passes on, and whether that+ -- is worth remembering.+ IO Reading+fromSource macros extensions reach reachChildren visiting tarball modName =+ doesFileExist tarball >>= \case+ False -> pure NoArchive+ True ->+ readModule tarball modName >>= \case+ Nothing -> pure (FromArchive (Unreadable Nothing))+ Just ForHsc -> pure (FromArchive (hscDeclares modName))+ Just (Haskell source) ->+ FromArchive+ <$> fromText macros extensions reach reachChildren visiting source modName++-- | What came of looking for a module in an archive.+data Reading+ = -- | The archive was there, and this is what reading it established.+ FromArchive Established+ | -- | There was no archive to open. That is a fact about this machine and+ -- not about the module—the plan can stay exactly as it is while+ -- somebody downloads the sources—so it is never remembered.+ NoArchive++-- | The fixities a module's text declares and passes on.+fromText ::+ -- | What the plan settles about its conditionals.+ Macros ->+ -- | What the module's package puts in force, before its own pragmas.+ [Extension] ->+ -- | How to reach another module, for chasing re-exports. This is+ -- 'resolveModule' tied back on itself, with the visiting set already+ -- extended.+ (Text -> IO (Maybe (Fixities))) ->+ -- | How to reach another module for what its names carry with them.+ (Text -> IO (Map OpName (Set OpName))) ->+ -- | Modules currently being resolved, passed through so that a+ -- re-export chain cannot loop.+ Set Text ->+ -- | The module's source.+ Text ->+ -- | Its name.+ Text ->+ IO Established+fromText macros extensions reach reachChildren visiting source modName =+ case configurationsOf macros (Just extensions) modName source of+ Nothing -> pure (Unreadable Nothing)+ Just modules ->+ agreeing <$> traverse readOne modules+ where+ readOne (implicitPrelude, hsModule) =+ withReexports+ implicitPrelude+ reach+ reachChildren+ visiting+ modName+ hsModule++-- | One answer from every configuration that could be read, if they agree.+--+-- A module may declare a fixity in one configuration and a different one in+-- another. Which of them holds depends on how the module is compiled, which+-- is not ours to decide, so disagreement is not an answer. Agreement across+-- the ones we could read is one, and a stronger one than the blanked text+-- could give: it is a fact about the module rather than about a reading.+--+-- A configuration whose imports could not be resolved is passed over rather+-- than counted against the rest, because almost every one of those is a+-- branch meant for somewhere else. @System.IO.CodePage@ imports+-- @System.Win32.CodePage@ under @#ifdef WINDOWS@, and no plan solved on+-- Linux has Win32 anywhere in it. Refusing the whole module over a branch+-- that will never be compiled here would be letting a fact about this+-- machine stand as a fact about the module.+--+-- Every configuration unresolvable is still no answer. There is nothing+-- left to agree, and saying the module declares nothing would be a guess+-- rather than the silence it deserves. What is passed on then is the first+-- reason any configuration gave, which is as good as any: they are branches+-- of one module, and whichever of them is reported the reader is being sent+-- to a real module that really could not be read.+agreeing :: NonEmpty Established -> Established+agreeing answers = case [fixities | Declares fixities <- toList answers] of+ [] -> Unreadable (listToMaybe (catMaybes [below | Unreadable below <- toList answers]))+ readable ->+ maybe (Unreadable Nothing) Declares (foldM together Map.empty readable)+ where+ together settled found+ | and (Map.intersectionWith (==) settled found) = Just (Map.union settled found)+ | otherwise = Nothing++-- | 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))+ where+ directoryOf p = case ppSource p of+ LocalPackage dir -> [dir]+ CheckedOut dir -> [dir]+ _ -> []+ forPackage dir = quietly Map.empty $ do+ entries <- listDirectory dir+ case filter (".cabal" `isSuffixOf`) entries of+ [] -> pure Map.empty+ (cabalFile : _) -> do+ contents <- readFileText (dir </> cabalFile)+ case contents of+ Nothing -> pure Map.empty+ Just text ->+ Map.fromList . concat+ <$> traverse (locate dir (sourceDirs text)) (containedModules text)++ -- A package may list several source directories and the @.cabal@ file+ -- does not say which one holds which module, so they are tried in turn+ -- and the first that has the file wins.+ locate dir dirs m = do+ found <-+ filterM+ doesFileExist+ [ dir </> T.unpack d </> modulePath m ending+ | d <- dirs,+ ending <- moduleEndings+ ]+ pure [(m, path) | path <- take 1 found]++ modulePath m ending = T.unpack (T.replace "." "/" m) <> ending++-- | Read a file, if it is there and is text.+readFileText :: FilePath -> IO (Maybe Text)+readFileText path = quietly Nothing $ do+ there <- doesFileExist path+ if there+ then Just . T.decodeUtf8Lenient <$> BS.readFile path+ else pure Nothing++-- | What a module passes on, as well as what it declares.+--+-- A module that exports an operator it did not declare carries no fixity of+-- its own for it, so the declaration is chased through the export list into+-- whichever module the name came from.+withReexports ::+ -- | Whether @ImplicitPrelude@ is on in the module being read.+ Choice "implicitPrelude" ->+ -- | How to reach another module, for names this one only passes on.+ (Text -> IO (Maybe (Fixities))) ->+ -- | How to reach another module for what its names carry with them,+ -- which is what a @T(..)@ this module hands on amounts to.+ (Text -> IO (Map OpName (Set OpName))) ->+ -- | Modules currently being resolved. A candidate already in here is+ -- skipped rather than followed.+ Set Text ->+ -- | The name this module was looked up under, used to recognise a+ -- @module M@ export that refers to the module itself.+ Text ->+ -- | The module, already parsed.+ HsModule GhcPs ->+ -- | What it declares together with what it re-exports, or the module it+ -- passes names on from that could not be read.+ IO Established+withReexports implicitPrelude reach reachChildren visiting modName hsModule =+ case moduleExports hsModule of+ Nothing -> pure (Declares own)+ Just items -> do+ carried <- carriedNames implicitPrelude reachChildren hsModule items+ let wanted = wantedNames items <> fromCarried carried+ visible <-+ if null wanted+ then pure []+ else+ traverse+ (\i -> (,) i <$> fromModule (importModule i))+ (moduleImports implicitPrelude hsModule)+ let handedOnWhole =+ wantedModules implicitPrelude modName hsModule items+ wholeModules <- traverse (\m -> (,) m <$> fromModule m) handedOnWhole+ pure $ case stoppedAt visible wholeModules of+ Just below -> Unreadable (Just below)+ Nothing ->+ let seen = [(i, exported) | (i, Just exported) <- visible]+ whole = [exported | (_, Just exported) <- wholeModules]+ passedOn =+ Map.unions+ [ found+ | (qualifier, op) <- wanted,+ found <- take 1 (from qualifier op seen)+ ]+ in Declares (Map.unions (own : passedOn : whole))+ where+ stoppedAt visible wholeModules =+ listToMaybe $+ [importModule i | (i, Nothing) <- visible]+ <> [m | (m, Nothing) <- wholeModules]+ own = declaredFixities hsModule+ defined = declaredNames hsModule+ wantedNames items =+ [(qualifier, op) | ExportName qualifier op <- items, not (Set.member op defined)]+ <> [(qualifier, op) | ExportAll qualifier op <- items, not (Set.member op defined)]+ fromCarried carried =+ [ (qualifier, op)+ | ((qualifier, _), Just ops) <- carried,+ op <- Set.toList ops,+ not (Set.member op defined)+ ]+ from qualifier op seen =+ [ found+ | (i, exported) <- seen,+ canSupply qualifier op i,+ let found = Map.filterWithKey (\(_, o) _ -> o == op) exported,+ not (Map.null found)+ ]+ fromModule m+ | m `Set.member` visiting = pure (Just Map.empty)+ | otherwise = reach m++-- | What each name a module's export list hands on carries with it.+childrenWithReexports ::+ -- | Whether @ImplicitPrelude@ is on in the module being read.+ Choice "implicitPrelude" ->+ -- | How to reach another module for what its names carry+ (Text -> IO (Map OpName (Set OpName))) ->+ -- | The name this module was looked up under+ Text ->+ -- | The module, already parsed+ HsModule GhcPs ->+ IO (Map OpName (Set OpName))+childrenWithReexports implicitPrelude reachChildren modName hsModule =+ case moduleExports hsModule of+ Nothing -> pure (moduleChildren hsModule)+ Just items -> do+ carried <- carriedNames implicitPrelude reachChildren hsModule items+ let handedOnWhole =+ wantedModules implicitPrelude modName hsModule items+ wholes <- traverse reachChildren handedOnWhole+ pure . Map.unionsWith Set.union $+ moduleChildren hsModule+ : Map.fromListWith Set.union [(parent, ops) | ((_, parent), Just ops) <- carried]+ : wholes++-- | The operators a module's export list names, following what it hands on.+--+-- 'exportedOperators' answers for a list that names everything outright.+-- Where the list hands a whole module on, or a @T(..)@ for a type declared+-- elsewhere, the answer is in another module and this goes and gets it.+--+-- 'Nothing' where any part of the list stays beyond us, since a set that+-- leaves names out would clear a module of carrying an operator it may+-- well carry. Everything or nothing: this answer is only ever used to rule+-- a module out.+exportNamesWithReexports ::+ -- | Whether @ImplicitPrelude@ is on in the module being read.+ Choice "implicitPrelude" ->+ -- | How to reach another module for what its export list names+ (Text -> IO (Maybe (Set OpName))) ->+ -- | How to reach another module for what its names carry+ (Text -> IO (Map OpName (Set OpName))) ->+ -- | The name this module was looked up under+ Text ->+ -- | The module, already parsed+ HsModule GhcPs ->+ IO (Maybe (Set OpName))+exportNamesWithReexports+ implicitPrelude+ reachNames+ reachChildren+ modName+ hsModule =+ case moduleExports hsModule of+ Nothing -> pure (Just (Set.fromList [op | (_, op) <- Map.keys (declaredFixities hsModule)]))+ Just items -> do+ carried <- carriedNames implicitPrelude reachChildren hsModule items+ let handedOnWhole =+ wantedModules implicitPrelude modName hsModule items+ wholes <- traverse reachNames handedOnWhole+ pure $ do+ fromWholes <- sequence wholes+ fromCarried <-+ traverse (\((_, parent), kids) -> Set.insert parent <$> kids) carried+ pure (Set.unions (named items : declaredHere items : fromCarried <> fromWholes))+ where+ declared = declaredChildren hsModule+ named items = Set.fromList [op | ExportName _ op <- items]+ declaredHere items =+ Set.unions+ [ Set.insert parent kids+ | ExportAll _ parent <- items,+ Just kids <- [Map.lookup parent declared]+ ]++-- | What the types a module hands on but does not declare carry with them,+-- asked of the modules they could have come from.+carriedNames ::+ -- | Whether @ImplicitPrelude@ is on in the module being read.+ Choice "implicitPrelude" ->+ -- | How to reach another module for what its export list names+ (Text -> IO (Map OpName (Set OpName))) ->+ -- | The module, already parsed+ HsModule GhcPs ->+ -- | Export items+ [ExportItem] ->+ -- | For each handed-on name, what it carries, or 'Nothing' where no+ -- module that could have supplied it had anything to say about it.+ IO [((Maybe Text, OpName), Maybe (Set OpName))]+carriedNames implicitPrelude reachChildren hsModule items =+ traverse (\(qualifier, parent) -> ((qualifier, parent),) <$> carriedBy qualifier parent) handedOn+ where+ declared = declaredChildren hsModule+ imports = moduleImports implicitPrelude hsModule+ handedOn =+ [ (qualifier, parent)+ | ExportAll qualifier parent <- items,+ not (Map.member parent declared)+ ]+ carriedBy qualifier parent = do+ answers <- traverse (reachChildren . importModule) (filter (canSupply qualifier parent) imports)+ pure $ case mapMaybe (Map.lookup parent) answers of+ [] -> Nothing+ kids -> Just (Set.unions kids)++-- | Could this import have supplied a name an export list hands on?+canSupply :: Maybe Text -> OpName -> Import -> Bool+canSupply qualifier op i =+ reaches && case importNames i of+ Nothing -> True+ Just (True, hidden) -> not (surelyNames Map.empty op hidden)+ Just (False, shown) -> mightBring Map.empty op shown+ where+ reaches = case qualifier of+ Nothing -> not (importQualified i)+ Just q -> importAlias i == q++-- | The modules a @module M@ export hands on whole, by their own names.+wantedModules ::+ Choice "implicitPrelude" ->+ Text ->+ HsModule GhcPs ->+ [ExportItem] ->+ [Text]+wantedModules implicitPrelude modName hsModule items =+ Set.toList . Set.fromList $+ concat [under m | ExportModule m <- items, not (isSelf m)]+ where+ under m = case [importModule i | i <- imports, importAlias i == m] of+ [] -> [m]+ aliased -> aliased+ imports = moduleImports implicitPrelude hsModule+ isSelf m = Just m == moduleName hsModule || m == modName++-- | What to parse a module with: what its package puts in force, and then+-- whatever its own pragmas say about that.+configFor :: [Extension] -> Text -> ParserConfig+configFor extensions source = parserConfigFor (effectiveExtensions extensions source)++-- | What a parse produced, where only having it or not matters.+whatParsed :: Either e a -> Maybe a+whatParsed = either (const Nothing) Just++-- | Every configuration the preprocessor allows of a module's text that is+-- Haskell, parsed, each with whether it has the Prelude without importing+-- it.+configurationsOf ::+ -- | What the plan settles about the questions its conditionals ask.+ Macros ->+ -- | What the module's package puts in force, or 'Nothing' where nothing+ -- is known about it. Then it is parsed under the most generous edition+ -- rather than the narrowest, and taken to have the Prelude unless it+ -- says otherwise—both being the way to be wrong that costs least.+ Maybe [Extension] ->+ -- | The module's name, for the parser to put in its errors+ Text ->+ -- | Its text+ Text ->+ Maybe (NonEmpty (Choice "implicitPrelude", HsModule GhcPs))+configurationsOf macros extensions modName text =+ NE.nonEmpty . mapMaybe parsed+ =<< whatParsed (branchLeaves (withoutRuledOut macros text))+ where+ parsed leaf =+ (,) (hasImplicitPrelude (fromMaybe [] extensions) leaf) . pmModule+ <$> whatParsed (parseModule (configOf leaf) named leaf)+ configOf leaf = maybe defaultParserConfig (`configFor` leaf) extensions+ named = T.unpack modName++-- | Does this module see the Prelude without importing it?+hasImplicitPrelude :: [Extension] -> Text -> Choice "implicitPrelude"+hasImplicitPrelude extensions source =+ fromBool (ImplicitPrelude `elem` effectiveExtensions extensions source)++-- | Find a module inside a tarball and say what was found.+--+-- Looked for under each of the endings a package may write a module with,+-- Haskell first. An @.hsc@ is reported rather than read: it is not Haskell+-- until @hsc2hs@ has been over it, and what it declares is answered out of+-- 'hscFixities' instead.+readModule :: FilePath -> Text -> IO (Maybe InArchive)+readModule tarball modName = quietly Nothing $ do+ bytes <- BL.readFile tarball+ let (cabal, candidates) = sweep Nothing [] (Tar.read (GZip.decompress bytes))+ dirs = maybe [] sourceDirs cabal+ pure (listToMaybe (mapMaybe (pick dirs candidates) moduleEndings))+ where+ suffix ending = "/" <> T.unpack (T.replace "." "/" modName) <> ending+ suffixes = map suffix moduleEndings+ sweep cabal found = \case+ Tar.Next entry rest+ | Tar.NormalFile content _ <- Tar.entryContent entry,+ cabalFileAtTop (entryPosixPath entry),+ Nothing <- cabal ->+ sweep (Just (decode content)) found rest+ | Tar.NormalFile content _ <- Tar.entryContent entry,+ any (`isSuffixOf` entryPosixPath entry) suffixes ->+ sweep cabal ((entryPosixPath entry, decode content) : found) rest+ | otherwise -> sweep cabal found rest+ _ -> (cabal, reverse found)+ pick dirs candidates ending =+ inArchive ending . snd+ <$> listToMaybe (under sfx dirs matching <> matching)+ where+ sfx = suffix ending+ matching = [c | c <- candidates, sfx `isSuffixOf` fst c]+ under sfx dirs matching = [e | d <- dirs, e <- matching, inDir sfx d (fst e)]+ inDir sfx d path+ | d == "." = takeWhile (/= '/') path <> sfx == path+ | otherwise = ("/" <> T.unpack d <> sfx) `isSuffixOf` path+ decode = T.decodeUtf8Lenient . BL.toStrict++-- | The endings a package may write a module under, in the order they are+-- tried.+--+-- Plain Haskell first: a package that ships both has generated the one from+-- the other, and the generated one is the module as it will be compiled.+moduleEndings :: [String]+moduleEndings = [".hs", ".hsc"]++-- | What an archive holds for a module.+data InArchive+ = -- | Haskell, as the package wrote it.+ Haskell Text+ | -- | A module written for @hsc2hs@. Its text is not kept: there is+ -- nothing to be done with it, and 'hscFixities' answers for it.+ ForHsc++-- | What was found under one ending amounts to.+inArchive :: String -> Text -> InArchive+inArchive ending text+ | writtenForHsc ending = ForHsc+ | otherwise = Haskell text++-- | Is this a module @hsc2hs@ writes rather than one anybody compiles?+writtenForHsc :: FilePath -> Bool+writtenForHsc = isSuffixOf ".hsc"++-- | What an @.hsc@ module declares, which is nothing unless it is named.+--+-- See 'hscFixities' for why an absence is an answer here and not a refusal+-- to give one.+hscDeclares :: Text -> Established+hscDeclares modName =+ Declares (maybe Map.empty inBothNamespaces (Map.lookup modName hscFixities))++-- | The fixities an 'Established' holds, where it holds any.+fixitiesEstablished :: Established -> Maybe (Fixities)+fixitiesEstablished = \case+ Declares fixities -> Just fixities+ Unreadable _ -> Nothing++-- | The operators an @.hsc@ module can supply, on the same reasoning.+hscSupplies :: Text -> Set OpName+hscSupplies modName =+ maybe Set.empty Map.keysSet (Map.lookup modName hscFixities)
+ src/Tilia/Format.hs view
@@ -0,0 +1,425 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Formatting a file, with everything the project can tell us about it.+module Tilia.Format+ ( FormatError (..),+ describeFormatError,+ formatErrorExitCode,+ refused,+ Session,+ newSession,+ fixityNotesOf,+ formatSource,+ )+where++import Control.Applicative ((<|>))+import Control.Monad (when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)+import Data.Choice (Choice, fromBool, isTrue)+import Data.Foldable (traverse_)+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import GHC.LanguageExtensions.Type (Extension (ImplicitPrelude))+import Tilia.Cpp+ ( CppError (..),+ blankCpp,+ branchLeaves,+ describeCppError,+ formatWithCpp,+ usesCpp,+ withoutRuledOut,+ )+import Tilia.Cpp.Macros (Macros)+import Tilia.Doc (defaultRenderOptions, printDoc)+import Tilia.Equivalence (commentDifference, syntaxDifference)+import Tilia.Fixity (OpName, Unknown (..), operatorSpelling, spellUnreadIn, unknownOperators)+import Tilia.Fixity.Debug (FixityNotes, fixityNotes)+import Tilia.Fixity.Plan+ ( PlanComponent,+ Resolver (..),+ loadPlan,+ macrosOf,+ newResolver,+ scopeFor,+ )+import Tilia.Package+ ( PackageProblem (..),+ PackageReader,+ describePackageProblem,+ newPackageReader,+ )+import Tilia.Palette (Color (Operator, Place), Palette, paint)+import Tilia.Parser+ ( ParseError,+ ParsedModule,+ ParserConfig,+ describeParseError,+ parseModule,+ parserConfigFor,+ pmModule,+ pmSource,+ )+import Tilia.Pragma (effectiveExtensions, movesPositions)+import Tilia.Project (ProjectRoot (..), findProjectRoot)+import Tilia.Render (RenderConfig (..), defaultRenderConfig, renderModule)+import Tilia.Source (comments)++-- | Why a file could not be formatted.+data FormatError+ = -- | No @cabal.project@ or @.cabal@ file above it.+ NoProject FilePath+ | -- | A project, but no build plan we could read or produce. The text is+ -- whatever @cabal@ had to say about it.+ NoBuildPlan FilePath Text+ | -- | We failed to read .cabal file.+ NoPackage FilePath PackageProblem+ | -- | The file is not Haskell we can parse.+ NotParsed ParseError+ | -- | The file carries @{-# LINE #-}@ or @{-# COLUMN #-}@ pragmas.+ PositionPragmas FilePath+ | -- | The file uses the preprocessor in a way we cannot handle.+ CppUnsupported FilePath CppError+ | -- | An operator the file uses has a fixity we could not establish, as+ -- the file writes it.+ UnknownFixity FilePath [((Maybe Text, OpName), Unknown)]+ | -- | The file could not be read at all.+ Unreadable FilePath Text+ | -- | Formatting the file changed its AST.+ NotEquivalent FilePath Text+ | -- | Formatting is not idempotent.+ NotIdempotent FilePath Text++-- | Say what went wrong, in one line.+describeFormatError :: Palette -> FormatError -> Text+describeFormatError palette = \case+ NoProject path ->+ "no project above " <> file path <> ": expected a cabal.project or a .cabal file"+ NoBuildPlan root reason ->+ "no build plan for " <> file root <> ": " <> reason+ NoPackage path problem ->+ "cannot tell what "+ <> file path+ <> " is written in: "+ <> 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"+ CppUnsupported path why ->+ "will not format " <> file path <> ": " <> describeCppError why+ Unreadable path why -> "cannot read " <> file path <> ": " <> why+ NotEquivalent path why ->+ "formatting " <> file path <> " changed the program: " <> why+ NotIdempotent path why ->+ "formatting " <> file path <> " is not idempotent: " <> why+ UnknownFixity path unknown ->+ "will not format "+ <> file path+ <> ": "+ <> T.intercalate ", and " (map saying (together unknown))+ where+ saying (why, ops) =+ (if length ops == 1 then "the fixity of " else "the fixities of ")+ <> listing ops+ <> " "+ <> because why+ because = \case+ NotRead missing -> "may be declared in " <> spellUnreadIn palette missing+ Ambiguous -> "is declared differently by two modules in scope"+ together = foldl put []+ where+ put seen ((qualifier, op), why) =+ let named = paint palette Operator (operatorSpelling qualifier op)+ in case break ((== why) . fst) seen of+ (before, (_, ops) : after) ->+ before <> [(why, ops <> [named])] <> after+ _ -> seen <> [(why, [named])]+ listing ops = case reverse ops of+ [] -> ""+ [one] -> one+ [second, first'] -> first' <> " and " <> second+ (final : rest) -> T.intercalate ", " (reverse rest) <> ", and " <> final+ where+ file = paint palette Place . T.pack+ located t = case T.breakOn ":" t of+ (where', rest) -> paint palette Place where' <> rest++-- | The exit status a failure should leave behind.+formatErrorExitCode :: FormatError -> Int+formatErrorExitCode = \case+ NoProject {} -> 2+ NoBuildPlan {} -> 3+ NotParsed {} -> 4+ PositionPragmas {} -> 5+ NoPackage _ problem -> case problem of+ NoPackageFile -> 6+ PackageUnreadable {} -> 6+ PackageMalformed {} -> 7+ FileUnclaimed {} -> 8+ UnknownFixity {} -> 15+ Unreadable {} -> 16+ NotEquivalent {} -> 17+ NotIdempotent {} -> 18+ CppUnsupported _ why -> case why of+ UnhandledDirective {} -> 9+ UnsplittableConditional -> 10+ TooManyConfigurations -> 11+ ConfigurationNotParsed {} -> 12+ DirectiveUnplaceable {} -> 13+ DirectiveInQuotedText {} -> 14++-- | Did we decline to format the file, rather than fail to?+refused :: FormatError -> Bool+refused = \case+ PositionPragmas {} -> True+ CppUnsupported {} -> True+ UnknownFixity {} -> True+ NotParsed {} -> False+ NoPackage {} -> False+ Unreadable {} -> False+ NotEquivalent {} -> False+ NotIdempotent {} -> 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+ { -- | What can be asked about the modules a file imports.+ sessionResolver :: Resolver,+ -- | What the plan settles about the questions a file's conditionals+ -- ask, so that a branch it rules out is not read as part of the file.+ sessionMacros :: Macros,+ -- | What each file's package puts in force.+ sessionPackage :: PackageReader,+ -- | Whether to check AST equivalence.+ 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.+ sessionFixityNotes :: Maybe (IORef (Map FilePath FixityNotes))+ }++-- | Settle everything that does not depend on the file being formatted.+newSession ::+ -- | Where to start looking for the project+ FilePath ->+ -- | The components about to be formatted, so that a plan which says+ -- nothing about them can be solved again rather than trusted+ [PlanComponent] ->+ -- | Check AST equivalence.+ Choice "checkAst" ->+ -- | Check idempotence.+ Choice "checkIdempotence" ->+ -- | Record how every file's fixities were settled, to be read afterwards+ -- with 'fixityNotesOf'.+ Choice "debugFixity" ->+ IO (Either FormatError Session)+newSession start components checkAst checkIdempotence debugFixity = runExceptT $ do+ root <- prPath <$> (need (NoProject start) =<< liftIO (findProjectRoot start))+ plan <- orElse (NoBuildPlan root) =<< liftIO (loadPlan components root)+ resolver <- liftIO (newResolver plan)+ askPackage <- liftIO newPackageReader+ notes <-+ if isTrue debugFixity+ then Just <$> liftIO (newIORef Map.empty)+ else pure Nothing+ pure+ Session+ { sessionResolver = resolver,+ sessionMacros = macrosOf plan,+ sessionPackage = askPackage,+ sessionCheckAst = checkAst,+ sessionCheckIdempotence = checkIdempotence,+ sessionFixityNotes = notes+ }+ where+ need :: FormatError -> Maybe a -> ExceptT FormatError IO a+ need e = maybe (throwE e) pure++-- | 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.+fixityNotesOf :: Session -> IO (Map FilePath FixityNotes)+fixityNotesOf session = case sessionFixityNotes session of+ Nothing -> pure Map.empty+ Just ref -> readIORef ref++-- | Format source that has already been read.+--+-- The text is passed in rather than read here because a caller that means+-- to compare the two needs the original anyway, and reading a file twice to+-- format it once is the sort of thing this is trying to stop doing.+formatSource ::+ -- | What the run has worked out already+ Session ->+ -- | The file the source came from, for reporting and for its package+ FilePath ->+ -- | The source+ Text ->+ -- | Result+ IO (Either FormatError Text)+formatSource session path source = runExceptT $ do+ when (movesPositions source) $+ throwE (PositionPragmas path)+ package <- orElse (NoPackage path) =<< liftIO (sessionPackage session path)+ let resolver = sessionResolver session+ config = parserConfigFor package+ reading = blankCpp . withoutRuledOut (sessionMacros session)+ extensionsAndCpp text =+ let declared = effectiveExtensions package text+ in (Set.fromList declared, usesCpp declared text)+ renderConfigFor extensions hsModule = do+ let implicitPrelude =+ fromBool (Set.member ImplicitPrelude extensions)+ scope <- liftIO (scopeFor resolver implicitPrelude hsModule)+ liftIO $ case sessionFixityNotes session of+ Nothing -> pure ()+ Just ref -> do+ told <-+ fixityNotes+ implicitPrelude+ (askFixities resolver)+ (askChain resolver)+ scope+ hsModule+ atomicModifyIORef' ref (\m -> (Map.insertWith (\_ old -> old) path told m, ()))+ case unknownOperators scope hsModule of+ [] ->+ pure+ defaultRenderConfig+ { rcExtensions = extensions,+ rcScope = Just scope+ }+ unknown -> throwE (UnknownFixity path unknown)+ formatting (extensions, cpp) already text+ | cpp = do+ render <- case parseModule config path (reading text) of+ Left _ -> pure defaultRenderConfig {rcExtensions = extensions}+ Right whole -> renderConfigFor extensions (pmModule whole)+ printed <-+ orElse+ (CppUnsupported path)+ (formatWithCpp config render path text)+ pure (printed, Nothing)+ | otherwise = do+ parsed <-+ maybe (orElse NotParsed (parseModule config path text)) pure already+ render <- renderConfigFor extensions (pmModule parsed)+ pure+ ( printDoc defaultRenderOptions (renderModule render parsed),+ Just parsed+ )+ let inForce@(_, cpp) = extensionsAndCpp source+ (formatted, tree) <- formatting inForce Nothing source+ printedTree <-+ if isTrue (sessionCheckAst session)+ then do+ let (changed, parsed) = rewritten config cpp path (source, tree) formatted+ traverse_ (throwE . NotEquivalent path) changed+ pure parsed+ else pure Nothing+ when (isTrue (sessionCheckIdempotence session)) $ do+ (settled, _) <- formatting (extensionsAndCpp formatted) printedTree formatted+ when (settled /= formatted) $+ throwE (NotIdempotent path (whereTheyDiffer formatted settled))+ pure formatted++-- | Where two spellings of the same file first disagree.+whereTheyDiffer :: Text -> Text -> Text+whereTheyDiffer before after =+ case [n | (n, one, two) <- zip3 [1 :: Int ..] first second, one /= two] of+ (n : _) -> "line " <> tshow n <> " differs"+ [] ->+ "the second pass came out "+ <> tshow (length second)+ <> " lines long where the first came out "+ <> tshow (length first)+ where+ first = T.lines before+ second = T.lines after+ tshow :: Int -> Text+ tshow = T.pack . show++-- | What formatting changed about the program.+--+-- A file with conditionals is compared one configuration at a time, because+-- the text as it stands is not a program: the branches only make one once+-- the preprocessor has chosen between them.+rewritten ::+ -- | How to parse both sides+ ParserConfig ->+ -- | Whether the file uses the preprocessor+ Bool ->+ -- | The file, for the parser's messages+ FilePath ->+ -- | What was read, and the tree it was printed from where it has one+ (Text, Maybe ParsedModule) ->+ -- | What was printed+ Text ->+ -- | What formatting changed, and the tree of what was printed+ (Maybe Text, Maybe ParsedModule)+rewritten config cpp path (before, printedFrom') after+ | not cpp = case parseModule config path after of+ Left e ->+ ( Just ("the formatted output does not parse: " <> describeParseError e),+ Nothing+ )+ Right a' -> case printedFrom' <|> whatParsed (parseModule config path before) of+ -- The input parsed once already, or there would be nothing to+ -- compare.+ Nothing -> (Nothing, Just a')+ Just b' -> (comparing b' a', Just a')+ | otherwise = (underCpp, Nothing)+ where+ comparing b' a' =+ syntaxDifference (pmModule b') (pmModule a')+ <|> commentDifference+ (pmModule b', pmModule a')+ (comments (pmSource b'))+ (comments (pmSource a'))+ whatParsed = either (const Nothing) Just+ underCpp = case (branchLeaves before, branchLeaves after) of+ -- Neither can really happen: a source that would not split never got+ -- as far as being formatted. Saying so beats saying nothing.+ (Left _, _) -> Just "the input could not be split into configurations"+ (_, Left _) -> Just "the output could not be split into configurations"+ (Right went, Right came)+ | length went /= length came ->+ Just+ ( "the output has "+ <> tshow (length came)+ <> " configurations where the input had "+ <> tshow (length went)+ )+ | otherwise ->+ firstJust+ [ ("in one configuration, " <>) <$> difference b a+ | (b, a) <- zip went came+ ]+ difference b a = case (parseModule config path b, parseModule config path a) of+ -- The input parsed once already, or there would be nothing to compare.+ (Left _, _) -> Nothing+ (_, Left e) ->+ Just ("the formatted output does not parse: " <> describeParseError e)+ (Right b', Right a') -> comparing b' a'+ firstJust = foldr (<|>) Nothing+ tshow :: Int -> Text+ tshow = T.pack . show++-- | Give up with the given error where there is one to give up over.+orElse :: (e -> FormatError) -> Either e a -> ExceptT FormatError IO a+orElse f = either (throwE . f) pure
+ src/Tilia/Imports.hs view
@@ -0,0 +1,306 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++-- | Putting a module's imports in order.+module Tilia.Imports+ ( normalizeImports,+ )+where++import Data.Char (isAlphaNum)+import Data.Choice (Choice, isTrue)+import Data.Function (on, (&))+import Data.List (groupBy, sortOn)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Data.FastString (unpackFS)+import GHC.Hs+import GHC.Types.Name.Occurrence (occNameString)+import GHC.Types.Name.Reader (RdrName, rdrNameOcc)+import GHC.Types.PkgQual (RawPkgQual (..))+import GHC.Types.SourceText (StringLiteral (..))+import GHC.Types.SrcLoc+import Tilia.Comments (Comment (..), commentTrailing, commentsWithin)+import Tilia.Span (endPoint, startPoint)+import Tilia.Span.Ghc (spanOf, spanOfSrcSpan)++-- | Whether an explicit @import Prelude@ is telling the reader anything.+data PreludeImport+ = -- | @ImplicitPrelude@ is on, so the module has the Prelude whatever it+ -- says, and the line only trims what it already takes.+ Refines+ | -- | @ImplicitPrelude@ is off, so the line is the only reason the module+ -- has a Prelude at all, and it is an import like any other.+ Provides+ deriving (Eq, Show)++-- | Sort a module's imports and fold together the ones that say the same+-- thing.+normalizeImports ::+ -- | Whether @ImplicitPrelude@ is on+ Choice "implicitPrelude" ->+ -- | Source lines the block must not be sorted across+ [Int] ->+ -- | The module's comments+ [Comment] ->+ -- | Original imports+ [LImportDecl GhcPs] ->+ -- | Normalized imports+ [LImportDecl GhcPs]+normalizeImports implicitPrelude barriers written imports =+ concatMap stretch (segmented (dividing imports barriers) tidied)+ where+ prelude = if isTrue implicitPrelude then Refines else Provides+ tidied = map (fmap (tidyList written)) imports+ stretch is = foldRuns (fuse written) [((identity prelude i, alone i), i) | i <- is]+ alone i+ | any strands (spanOf i) = startLineOf i+ | otherwise = 0+ where+ strands s =+ any (unanchored (itemStarts i)) (filter loose (commentsWithin s written))+ loose = not . commentTrailing+ unanchored starts c = not (any (> endPoint (commentSpan c)) starts)+ startLineOf i = case srcSpanStart (getLocA i) of+ RealSrcLoc l _ -> srcLocLine l+ _ -> 0++-- | Where every name an import lists begins, the names inside a thing's own+-- brackets among them.+itemStarts :: LImportDecl GhcPs -> [(Int, Int)]+itemStarts (L _ decl) = case ideclImportList decl of+ Nothing -> []+ Just (_, L _ items) -> concatMap starts items+ where+ starts item = foldMap ((: []) . startPoint) (spanOf item) <> inside (unLoc item)+ inside = \case+ IEThingWith _ _ _ members _ ->+ concatMap (foldMap ((: []) . startPoint) . spanOf) members+ _ -> []++-- | The lines that fall between imports, out of the lines that must not be+-- sorted across.+dividing :: [LImportDecl GhcPs] -> [Int] -> [Int]+dividing imports = filter (not . within)+ where+ within l = any (\(from, to) -> from <= l && l <= to) spans'+ spans' = [(srcLocLine from, srcLocLine to) | i <- imports, Just (from, to) <- [endsOf i]]+ endsOf i = case (srcSpanStart (getLocA i), srcSpanEnd (getLocA i)) of+ (RealSrcLoc from _, RealSrcLoc to _) -> Just (from, to)+ _ -> Nothing++-- | Cut a list of imports into the stretches the barriers leave between+-- them, in order.+segmented :: [Int] -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]+segmented [] imports = [imports]+segmented barriers imports =+ groupBy ((==) `on` fst) [(between i, i) | i <- imports] & map (map snd)+ where+ between i = length (takeWhile (< lineOf i) barriers)+ lineOf i = case srcSpanStart (getLocA i) of+ RealSrcLoc l _ -> srcLocLine l+ _ -> 0++----------------------------------------------------------------------------+-- Runs++-- | Sort by the keys, then replace each run of equal keys by one value+-- folded out of it.+--+-- The sort is stable, so a run holds its values in the order they were+-- written and the fold sees them that way round. That is worth having:+-- folding keeps the first one's identity, and \"first\" should mean first+-- in the file.+foldRuns :: (Ord k) => (a -> a -> a) -> [(k, a)] -> [a]+foldRuns fold' =+ map (foldl1 fold' . map snd) . groupBy ((==) `on` fst) . sortOn fst++----------------------------------------------------------------------------+-- Which imports are the same import++-- | What has to agree before two imports may be folded together, in the+-- order imports should be printed in.+--+-- The two leading keys are about reading rather than about identity. A+-- @Prelude@ that only refines what the module already has goes at the end,+-- since looking for it among the @D@s would be looking for the least+-- interesting line in the block. The package goes before the module name so+-- that the imports from one package stay in one run; sorting by module+-- first would interleave them and hide who provides what.+identity ::+ PreludeImport ->+ LImportDecl GhcPs ->+ (Bool, (Int, Text), Text, Bool, Bool, Bool, Maybe Text, Maybe Bool, Maybe Bool)+identity prelude (L _ decl) =+ ( prelude == Refines && named (ideclName decl) == T.pack "Prelude",+ package (ideclPkgQual decl),+ named (ideclName decl),+ ideclSource decl == IsBoot,+ ideclSafe decl,+ isImportDeclQualified (ideclQualified decl),+ named <$> ideclAs decl,+ hides . fst <$> ideclImportList decl,+ lifted (ideclLevelSpec decl)+ )+ where+ named = T.pack . moduleNameString . unLoc+ package = \case+ NoRawPkgQual -> (0, T.empty)+ RawPkgQual (sl_fs -> fs)+ | name == T.pack "this" -> (2, T.empty)+ | otherwise -> (1, name)+ where+ name = T.pack (unpackFS fs)+ hides = \case+ Exactly -> False+ EverythingBut -> True+ lifted = \case+ NotLevelled -> Nothing+ LevelStylePre l -> Just (quoted l)+ LevelStylePost l -> Just (quoted l)+ quoted = \case+ ImportDeclSplice -> False+ ImportDeclQuote -> True++----------------------------------------------------------------------------+-- Folding two imports into one++-- | Keep the first import and give it everything the second named.+--+-- The result covers both of their spans. That matters for comments: one+-- written between the two has to land inside the declaration that replaces+-- them, and a folded import claiming only the first one's span would leave+-- it nowhere to go.+fuse :: [Comment] -> LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs+fuse written (L ann kept) (L other folded) =+ L+ ann {entry = EpaSpan (combineSrcSpans (locA ann) (locA other))}+ kept {ideclImportList = both (ideclImportList kept) (ideclImportList folded)}+ where+ both (Just (interpretation, L l xs)) (Just (_, L l' ys)) =+ Just (interpretation, L (widened written l l') (tidyItems written (xs <> ys)))+ both _ _ = Nothing++----------------------------------------------------------------------------+-- The names inside an import list++tidyList :: [Comment] -> ImportDecl GhcPs -> ImportDecl GhcPs+tidyList written decl =+ decl {ideclImportList = fmap (fmap (tidyItems written)) <$> ideclImportList decl}++-- | Sort an import list and fold together the entries naming one thing.+--+-- @import M (T (A), T (B))@ names one type twice and comes out as @import M+-- (T (A, B))@.+tidyItems :: [Comment] -> [LIE GhcPs] -> [LIE GhcPs]+tidyItems written items+ -- An import list should hold nothing but names, and the parser will accept+ -- things there that the compiler goes on to reject—@import M (module N)@+ -- among them. Sorting a list we cannot read would be guessing.+ | any (unnameable . unLoc) items = items+ | otherwise = foldRuns (wider written) [(nameOf (unLoc i), fmap sortSubnames i) | i <- items]+ where+ unnameable = \case+ IEVar {} -> False+ IEThingAbs {} -> False+ IEThingAll {} -> False+ IEThingWith {} -> False+ _ -> True++-- | Cover both of these regions, if anything was written between them.+--+-- A region says two things at once: where a comment written inside it+-- belongs, and how the construct was laid out. What comes out of folding was+-- never written, so it has no layout of its own, and taking the region that+-- covers everything folded in would have it laid out across all the lines+-- those names were spread over—several lines for a name or two.+--+-- So the region grows only where growing it is the point: when a comment+-- falls between the two, and would otherwise be left outside the entry that+-- now holds the names it was written among.+widened :: [Comment] -> EpAnn ann -> EpAnn ann -> EpAnn ann+widened written a b+ | any holdsComment (spanOfSrcSpan combined) = a {entry = EpaSpan combined}+ | otherwise = a+ where+ combined = combineSrcSpans (locA a) (locA b)+ holdsComment s = not (null (commentsWithin s written))++-- | Of two entries naming one thing, the one that brings in more of it.+--+-- Naming all of a type beats naming some of its pieces, which beats naming+-- the type alone. Where both name some, the two lists go together. The+-- documentation is dropped whenever two entries are folded: it was written+-- against one of them and would become a claim about both.+wider :: [Comment] -> LIE GhcPs -> LIE GhcPs -> LIE GhcPs+wider written (L ann kept) (L other folded) =+ L (widened written ann other) (combine kept folded)+ where+ combine a b = case (a, b) of+ (IEThingAll x n _, _) -> IEThingAll x n Nothing+ (_, IEThingAll x n _) -> IEThingAll x n Nothing+ (IEThingWith x n wildcard subs _, IEThingWith _ _ wildcard' subs' _) ->+ IEThingWith+ x+ n+ (eitherWildcard wildcard wildcard')+ (dedupeSubnames (subs <> subs'))+ Nothing+ (IEThingWith x n wildcard subs _, _) ->+ IEThingWith x n wildcard subs Nothing+ (_, IEThingWith x n wildcard subs _) ->+ IEThingWith x n wildcard subs Nothing+ (IEVar _ n _, _) -> IEVar Nothing n Nothing+ _ -> a++ eitherWildcard a b = case (a, b) of+ (NoIEWildcard, NoIEWildcard) -> NoIEWildcard+ _ -> IEWildcard 0++sortSubnames :: IE GhcPs -> IE GhcPs+sortSubnames = \case+ IEThingWith x n wildcard subs doc ->+ IEThingWith x n wildcard (dedupeSubnames subs) doc+ other -> other++-- | The same name written twice in a sub-list is written once here. Which+-- of the two survives cannot matter: they name the same thing.+dedupeSubnames :: [LIEWrappedName GhcPs] -> [LIEWrappedName GhcPs]+dedupeSubnames subs = foldRuns const [(nameKey (unLoc s), s) | s <- subs]++----------------------------------------------------------------------------+-- Ordering names++nameOf :: IE GhcPs -> (Int, Bool, String)+nameOf = \case+ IEVar _ x _ -> nameKey (unLoc x)+ IEThingAbs _ x _ -> nameKey (unLoc x)+ IEThingAll _ x _ -> nameKey (unLoc x)+ IEThingWith _ x _ _ _ -> nameKey (unLoc x)+ -- 'tidyItems' has already refused to touch a list holding anything else.+ _ -> (maxBound, True, "")++-- | Where a name sorts.+--+-- Grouped first by what kind of thing is named, so that the @pattern@s and+-- the @type@s of an import list stay together. Then the names spelled with+-- letters before the ones spelled with punctuation, which gathers the+-- operators at the end where they are easy to find; ordering by character+-- code would scatter them, some before the letters and some after.+nameKey :: IEWrappedName GhcPs -> (Int, Bool, String)+nameKey = \case+ IEName _ x -> spelled 0 x+ IEDefault _ x -> spelled 1 x+ IEPattern _ x -> spelled 2 x+ IEType _ x -> spelled 3 x+ IEData _ x -> spelled 4 x+ where+ spelled :: Int -> LocatedN RdrName -> (Int, Bool, String)+ spelled kind (unLoc -> name) = (kind, punctuation text, text)+ where+ text = occNameString (rdrNameOcc name)+ punctuation = \case+ (c : _) -> not (isAlphaNum c)+ [] -> False
+ src/Tilia/Newline.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Handling of newlines.+module Tilia.Newline+ ( NewlineStyle (..),+ getNewlineStyle,+ setNewlineStyle,+ )+where++import Data.Text (Text)+import Data.Text qualified as T++-- | The two ways a line can end.+data NewlineStyle+ = -- | @\\n@, as everything but Windows writes them.+ Lf+ | -- | @\\r\\n@, as Windows writes them.+ CrLf+ deriving (Eq, Show)++-- | Which of the two a text is written with, by the first ending in it.+getNewlineStyle :: Text -> NewlineStyle+getNewlineStyle t = case T.breakOn "\n" t of+ (before, rest)+ | not (T.null rest),+ "\r" `T.isSuffixOf` before ->+ CrLf+ _ -> Lf++-- | Set every line ending in a text the given way.+setNewlineStyle :: NewlineStyle -> Text -> Text+setNewlineStyle style = case style of+ Lf -> toNewlines+ CrLf -> T.replace "\n" "\r\n" . toNewlines+ where+ toNewlines = T.replace "\r\n" "\n"
+ src/Tilia/Package.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Information coming from .cabal files.+module Tilia.Package+ ( PackageProblem (..),+ describePackageProblem,+ PackageReader,+ newPackageReader,+ )+where++import Data.ByteString qualified as BS+import Data.IORef+import Data.List (isSuffixOf, sortOn)+import Data.List.NonEmpty qualified as NE+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Ord (Down (..))+import Data.Text (Text)+import Data.Text qualified as T+import Distribution.Fields.ParseResult (runParseResult)+import Distribution.PackageDescription+ ( Benchmark (..),+ BuildInfo (..),+ CondTree (..),+ Executable (..),+ GenericPackageDescription (..),+ Library (..),+ TestSuite (..),+ )+import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)+import Distribution.Parsec (showPError)+import Distribution.Utils.Path (getSymbolicPath)+import GHC.Driver.Session qualified as GHC+import GHC.LanguageExtensions.Type (Extension)+import Language.Haskell.Extension qualified as Cabal+import System.Directory (canonicalizePath, doesDirectoryExist, listDirectory)+import System.FilePath (equalFilePath, splitDirectories, takeDirectory, (</>))+import Tilia.Pragma (lookupExtension)+import Tilia.Utils (attempted, quietly)++-- | Why a file's extensions could not be settled.+data PackageProblem+ = -- | No @.cabal@ file at or above the module.+ NoPackageFile+ | -- | A @.cabal@ file that could not be read at all, and what went wrong.+ PackageUnreadable FilePath Text+ | -- | A @.cabal@ file that was read but did not parse, and everything the+ -- parser had to say about it. One message per line, each already+ -- carrying the position it refers to.+ PackageMalformed FilePath [Text]+ | -- | A @.cabal@ file naming no component whose @hs-source-dirs@ holds+ -- the module.+ FileUnclaimed FilePath+ deriving (Eq, Show)++-- | Say what went wrong, in one line.+describePackageProblem :: PackageProblem -> Text+describePackageProblem = \case+ NoPackageFile -> "no .cabal file above it"+ PackageUnreadable file why -> T.pack file <> " could not be read: " <> why+ PackageMalformed file complaints ->+ T.pack file <> " does not parse:" <> foldMap ("\n " <>) complaints+ FileUnclaimed file ->+ 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])++-- | A 'PackageReader' that remembers what it has already worked out.+newPackageReader :: IO PackageReader+newPackageReader = do+ covering <- newIORef Map.empty+ described <- newIORef Map.empty+ pure $ \path -> quietly (Left NoPackageFile) $ do+ file <- canonicalizePath path+ from <- startingDirectory file+ findCabalFile covering from >>= \case+ Nothing -> pure (Left NoPackageFile)+ Just cabalFile ->+ componentsOf described cabalFile >>= \case+ Left problem -> pure (Left problem)+ Right components -> 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)++-- | A component of a package, with everything about it already worked out.+data Component = Component+ { -- | Its source directories, absolute and canonical.+ componentDirs :: [FilePath],+ -- | The extensions it puts in force.+ componentExtensions :: [Extension]+ }++-- | Which component holds the file, of those whose directories cover it.+claiming :: FilePath -> [Component] -> Maybe Component+claiming file components =+ case sortOn (Down . fst) [(nearness c, c) | c <- components, covered c] of+ ((_, c) : _) -> Just c+ [] -> Nothing+ where+ covered = not . null . covering+ nearness = maximum . map length . covering+ covering c = [d | d <- componentDirs c, d `covers` file]++-- | 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+ -- 'Nothing' for one with no @.cabal@ anywhere above it. Read before the+ -- walk and added to after it, for every directory the walk passed through+ -- rather than only the one asked about—none of the others held a @.cabal@+ -- either, which is why the walk went through them, so the answer is+ -- theirs as well.+ IORef (Map FilePath (Maybe FilePath)) ->+ -- | Where to start, which is walked upwards until a @.cabal@ file turns+ -- up or the filesystem root is reached.+ FilePath ->+ IO (Maybe FilePath)+findCabalFile ref = climb []+ where+ climb passed directory = do+ known <- readIORef ref+ case Map.lookup directory known of+ Just answer -> settle passed answer+ Nothing -> do+ entries <- quietly [] (listDirectory directory)+ case filter (".cabal" `isSuffixOf`) entries of+ (named : _) -> settle (directory : passed) (Just (directory </> named))+ [] ->+ let parent = takeDirectory directory+ in if parent == directory+ then settle (directory : passed) Nothing+ else climb (directory : passed) parent+ settle passed answer = do+ modifyIORef' ref (\m -> foldl' (\acc d -> Map.insert d answer acc) m passed)+ pure answer++-- | What a @.cabal@ file amounts to.+componentsOf ::+ IORef (Map FilePath (Either PackageProblem [Component])) ->+ FilePath ->+ IO (Either PackageProblem [Component])+componentsOf ref cabalFile = do+ known <- readIORef ref+ case Map.lookup cabalFile known of+ Just answer -> pure answer+ Nothing -> do+ answer <- settle+ modifyIORef' ref (Map.insert cabalFile answer)+ pure answer+ where+ settle =+ attempted (BS.readFile cabalFile) >>= \case+ Left why -> pure (Left (PackageUnreadable cabalFile why))+ Right bytes ->+ case snd (runParseResult (parseGenericPackageDescription bytes)) of+ Left (_, complaints) ->+ pure (Left (PackageMalformed cabalFile (map said (NE.toList complaints))))+ Right description ->+ Right+ <$> traverse+ (component (takeDirectory cabalFile))+ (buildInfos description)+ said = T.pack . showPError cabalFile++-- | One component, with its directories resolved and its extensions settled.+component :: FilePath -> BuildInfo -> IO Component+component root bi = do+ dirs <- traverse (quietlyCanonical . (root </>)) (sourceDirsOf bi)+ pure+ Component+ { componentDirs = concat dirs,+ componentExtensions = extensionsInForce bi+ }+ where+ sourceDirsOf b = case map getSymbolicPath (hsSourceDirs b) of+ [] -> ["."]+ ds -> ds+ quietlyCanonical d =+ quietly [] $+ doesDirectoryExist d >>= \case+ True -> pure <$> canonicalizePath d+ False -> pure []++-- | Every component's build settings, in the order they are declared.+buildInfos :: GenericPackageDescription -> [BuildInfo]+buildInfos described =+ concat+ [ foldMap (pure . libBuildInfo . condTreeData) (condLibrary described),+ named (libBuildInfo . condTreeData) (condSubLibraries described),+ named (buildInfo . condTreeData) (condExecutables described),+ named (testBuildInfo . condTreeData) (condTestSuites described),+ named (benchmarkBuildInfo . condTreeData) (condBenchmarks described)+ ]+ where+ named f = map (f . snd)++-- | The extensions a component puts in force, before any module's pragmas.+extensionsInForce :: BuildInfo -> [Extension]+extensionsInForce bi =+ foldl apply (GHC.languageExtensions edition) (defaultExtensions bi)+ where+ edition = ghcLanguage =<< defaultLanguage bi+ apply acc = \case+ Cabal.EnableExtension e+ | Just on <- named e, on `notElem` acc -> acc <> [on]+ Cabal.DisableExtension e+ | Just off <- named e -> filter (/= off) acc+ _ -> acc+ named = lookupExtension . T.pack . show++-- | GHC's name for a language edition, when it has one.+ghcLanguage :: Cabal.Language -> Maybe GHC.Language+ghcLanguage l = lookup (show l) [(show e, e) | e <- [minBound .. maxBound]]
+ src/Tilia/Palette.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | The color palette abstraction for printing to color-capable terminals.+module Tilia.Palette+ ( Palette (..),+ paletteFor,+ Color (..),+ paint,+ marker,+ )+where++import Data.Maybe (isJust)+import Data.Text (Text)+import System.Environment (lookupEnv)+import System.IO (hIsTerminalDevice, stdout)++-- | Whether to color the output.+data Palette = Colors | Plain+ deriving (Eq, Show)++-- | Color output when there is somebody there to see it.+paletteFor :: IO Palette+paletteFor = do+ refused <- lookupEnv "NO_COLOR"+ terminal <- hIsTerminalDevice stdout+ pure $+ if terminal && not (isJust refused)+ then Colors+ else Plain++-- | Different kinds of colors, classified semantically.+data Color+ = -- | A diff's hunk headings and its asides.+ Meta+ | -- | A line a change removes.+ Gone+ | -- | A line a change adds.+ New+ | -- | A line a change leaves alone.+ Unchanged+ | -- | Something that went well.+ Good+ | -- | Something that did not, without being wrong.+ Middling+ | -- | Something wrong.+ Bad+ | -- | An operator.+ Operator+ | -- | Somewhere a message points at—a file, a module, the heading over a+ -- file's diff.+ Place+ | -- | A heading over what follows it.+ Header Color+ deriving (Eq, Show)++-- | Color one piece of text, and only that piece.+paint :: Palette -> Color -> Text -> Text+paint Plain _ t = t+paint Colors color t = code color <> t <> "\ESC[0m"+ where+ code = \case+ Meta -> "\ESC[36m"+ Gone -> "\ESC[31m"+ New -> "\ESC[32m"+ Unchanged -> "\ESC[39m"+ Good -> "\ESC[32m"+ Middling -> "\ESC[33m"+ Bad -> "\ESC[31m"+ Operator -> "\ESC[36m"+ Place -> "\ESC[1m"+ Header i -> "\ESC[1m" <> code i++-- | A marker in brackets, as the summary lines wear one.+marker :: Palette -> Color -> Text -> Text+marker palette color mark = "[" <> paint palette color mark <> "]"
+ src/Tilia/Parser.hs view
@@ -0,0 +1,263 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Turning source text into a syntax tree and a comment stream.+module Tilia.Parser+ ( ParsedModule (..),+ parseModule,+ parseConfiguration,+ ParseError (..),+ describeParseError,+ ParserConfig (..),+ defaultParserConfig,+ parserConfigFor,+ ghcLibParserVersion,+ )+where++import Data.Foldable (toList)+import Data.List (isSuffixOf, nub, sortOn)+import Data.Text (Text)+import Data.Text 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.Extension (GhcPs)+import GHC.LanguageExtensions.Type (Extension)+import GHC.Parser qualified as GHC+import GHC.Parser.Annotation (getLocA)+import GHC.Parser.Lexer qualified as GHC+import GHC.Types.Error qualified as GHC+import GHC.Types.SrcLoc qualified as GHC+import GHC.Unit.Module.Warnings (emptyWarningCategorySet)+import GHC.Utils.Error qualified as GHC+import GHC.Utils.Outputable qualified as GHC+import Tilia.Pragma (effectiveExtensions)+import Tilia.Source (Lines, Source, SourceType (..), Written (..), lineTexts, linesOf, sourceOf)+import Tilia.Span (Span (..))+import Tilia.Span.Ghc (spanOfReal)++-- | A module that parsed, together with the comments found in it.+data ParsedModule = ParsedModule+ { -- | The syntax tree, exactly as GHC produced it.+ pmModule :: HsModule GhcPs,+ -- | The module as its author wrote it.+ pmSource :: Source,+ -- | Whether GHC read this as a module or as a Backpack signature.+ pmSourceType :: SourceType,+ -- | The lines above the module that the parser never sees.+ --+ -- The lexer skips a @#!@ line, which puts it in no annotation and no+ -- node, so nothing downstream could put it back. Whatever empty line+ -- follows the last of them is kept too: it is what holds the module off+ -- the interpreter line, and it is the author's to decide.+ pmPrologue :: [Text],+ -- | Where the file header stops and the module proper begins, if the+ -- module has anything after its 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+ -- written below it has no effect on compilation, and hoisting it to the+ -- top of the module would change its meaning.+ pmHeaderEnd :: Maybe Span+ }++-- | Parse a module.+parseModule ::+ ParserConfig ->+ -- | Path, used only in positions reported back+ FilePath ->+ -- | The source+ Text ->+ Either ParseError ParsedModule+parseModule config path source =+ parseConfiguration config path (linesOf (Written source)) source++-- | Parse one configuration of a module.+--+-- The text to parse is one configuration of the module; the 'Written' text+-- is the module the author wrote, which is what every question about the+-- source is answered against. Without the preprocessor the two are the same+-- text and this is 'parseModule'.+parseConfiguration ::+ ParserConfig ->+ -- | Path, used only in positions reported back+ FilePath ->+ -- | The lines of the module as written, except for the lines that do not+ -- belong to this configuration+ Lines ->+ -- | The configuration of it to parse+ Text ->+ Either ParseError ParsedModule+parseConfiguration config path written source =+ case GHC.unP entryPoint initialState of+ GHC.PFailed pstate -> Left (whyNot pstate)+ GHC.POk pstate (GHC.L _ hsModule)+ | not (GHC.isEmptyMessages (GHC.getPsErrorMessages pstate)) ->+ Left (whyNot pstate)+ | otherwise ->+ Right+ ParsedModule+ { pmModule = hsModule,+ pmSource = sourceOf written (headerComments pstate) hsModule,+ pmSourceType = sourceType,+ pmPrologue = prologueOf (lineTexts written),+ pmHeaderEnd = headerEndOf hsModule+ }+ where+ -- Everything above the @signature@ keyword: the parser leaves those+ -- here rather than in the tree. A module's are in both.+ headerComments = concat . GHC.header_comments++ sourceType = sourceTypeOf path++ entryPoint = case sourceType of+ ModuleSource -> GHC.parseModule+ SignatureSource -> GHC.parseSignature++ whyNot pstate =+ case sortOn at (toList (GHC.getMessages (GHC.getPsErrorMessages pstate))) of+ m : _ -> ParseError {peSpan = GHC.errMsgSpan m, peProblem = saying m}+ [] ->+ ParseError+ { peSpan = GHC.mkSrcSpanPs (GHC.last_loc pstate),+ peProblem = "parse error"+ }++ at m = case GHC.srcSpanToRealSrcSpan (GHC.errMsgSpan m) of+ Just s -> (GHC.srcSpanStartLine s, GHC.srcSpanStartCol s)+ Nothing -> (maxBound, maxBound)++ saying =+ T.pack+ . GHC.showSDocUnsafe+ . GHC.vcat+ . GHC.unDecorated+ . GHC.diagnosticMessage GHC.NoDiagnosticOpts+ . GHC.errMsgDiagnostic++ config' =+ config+ { pcExtensions = withImplied (effectiveExtensions (pcExtensions config) source)+ }++ initialState =+ GHC.initParserState+ (parserOpts config')+ (GHC.stringToStringBuffer (T.unpack source))+ (GHC.mkRealSrcLoc (mkFastString path) 1 1)++-- | 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]++-- | Options to parse with.+parserOpts :: ParserConfig -> GHC.ParserOpts+parserOpts ParserConfig {pcExtensions} =+ GHC.mkParserOpts+ (EnumSet.fromList pcExtensions)+ quietDiagnostics+ False -- safe imports+ True -- keep Haddock tokens+ True -- keep ordinary comment tokens+ True -- let @LINE@ and @COLUMN@ pragmas move the source position++-- | Diagnostics are not reported, so the settings only have to be+-- well-formed.+quietDiagnostics :: GHC.DiagOpts+quietDiagnostics =+ GHC.DiagOpts+ { GHC.diag_warning_flags = EnumSet.empty,+ GHC.diag_fatal_warning_flags = EnumSet.empty,+ GHC.diag_custom_warning_categories = emptyWarningCategorySet,+ GHC.diag_fatal_custom_warning_categories = emptyWarningCategorySet,+ GHC.diag_warn_is_error = False,+ GHC.diag_reverse_errors = False,+ GHC.diag_max_errors = Nothing,+ GHC.diag_ppr_ctx = GHC.defaultSDocContext+ }++-- | The @#!@ lines a file begins with, and the empty line after them.+--+-- At most one empty line is taken: the rest would only be collapsed+-- wherever they were reproduced, so keeping them would be keeping a+-- distinction that cannot survive.+prologueOf :: [Text] -> [Text]+prologueOf ls = case span isShebang ls of+ ([], _) -> []+ (shebangs, rest) -> shebangs <> filter T.null (take 1 rest)+ where+ isShebang = T.isPrefixOf "#!"++-- | The start of the first thing that is not part of the header.+--+-- Imports and declarations are the only things that can end a header, and+-- either may come first, so both are consulted.+headerEndOf :: HsModule GhcPs -> Maybe Span+headerEndOf hsModule =+ foldl' earliest Nothing $+ map getLocA (hsmodImports hsModule)+ <> map getLocA (hsmodDecls hsModule)+ where+ earliest acc l = case GHC.srcSpanToRealSrcSpan l of+ Nothing -> acc+ Just s ->+ let this = spanOfReal s+ in Just (maybe this (keepEarlier this) acc)+ keepEarlier a b+ | (spanStartLine a, spanStartColumn a) <= (spanStartLine b, spanStartColumn b) = a+ | otherwise = b++-- | Why a module did not parse.+data ParseError = ParseError+ { -- | Where the parser gave up.+ peSpan :: GHC.SrcSpan,+ -- | GHC's rendered error message.+ peProblem :: Text+ }++-- | Present 'ParseError' in a human-friendly form.+describeParseError :: ParseError -> Text+describeParseError e =+ T.pack (GHC.showSDocUnsafe (GHC.ppr (peSpan e))) <> ": " <> peProblem e++-- | What the parser is allowed to accept.+newtype ParserConfig = ParserConfig+ { -- | Extensions to enable before parsing.+ pcExtensions :: [Extension]+ }++-- | What to parse with when there is no package to ask.+defaultParserConfig :: ParserConfig+defaultParserConfig = parserConfigFor []++-- | What to parse with, given whatever the package had to say.+parserConfigFor ::+ -- | What the package puts in force, or nothing if there is no package+ [Extension] ->+ -- | The resulting parser config+ ParserConfig+parserConfigFor package =+ ParserConfig+ { pcExtensions =+ if null package+ then GHC.languageExtensions (Just GHC.GHC2021)+ else package+ }++-- | What a file's name says it holds.+sourceTypeOf :: FilePath -> SourceType+sourceTypeOf path+ | ".hsig" `isSuffixOf` path = SignatureSource+ | otherwise = ModuleSource++-- | The version of @ghc-lib-parser@ this was built against.+ghcLibParserVersion :: String+ghcLibParserVersion = VERSION_ghc_lib_parser
+ src/Tilia/Pragma.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Pragma-related helpers.+module Tilia.Pragma+ ( movesPositions,+ effectiveExtensions,+ lookupExtension,+ )+where++import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Driver.Session qualified as GHC+import GHC.LanguageExtensions.Type (Extension (..))++-- | Recognize @{-# LINE #-}@ and @{-# COLUMN #-}@ pragmas.+movesPositions :: Text -> Bool+movesPositions = any positional . pragmaBodies+ where+ positional body =+ T.toUpper (T.takeWhile (/= ' ') body) `elem` ["LINE", "COLUMN"]++-- | The extensions actually in force in a module.+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.+ Text ->+ [Extension]+effectiveExtensions package+ | null package = pragmasOver onUnlessRefused+ | otherwise = pragmasOver package++-- | The extensions that are on until something says otherwise.+onUnlessRefused :: [Extension]+onUnlessRefused = [ImplicitPrelude]++-- | Apply a module's @LANGUAGE@ pragmas to a starting set.+pragmasOver :: [Extension] -> Text -> [Extension]+pragmasOver initial = foldl' apply initial . concatMap pragmaNames . pragmaBodies+ where+ apply 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+ pragmaNames body =+ let (keyword, names) = T.break (== ' ') body+ in if T.toUpper keyword == "LANGUAGE"+ then filter (not . T.null) (map T.strip (T.splitOn "," names))+ else []++-- | The extension one writes this name for, if any compiler knows it.+lookupExtension :: Text -> Maybe Extension+lookupExtension name = Map.lookup name extensionsByName++-- | 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]++-- | What every @{-# … #-}@ in a module has between its braces, each on one+-- line.+pragmaBodies :: Text -> [Text]+pragmaBodies = go+ where+ go = step . T.dropWhile (\c -> c /= '{' && c /= '-' && c /= '"')++ step 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)+ | 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)++ opensLineComment t = case T.stripPrefix "--" t of+ Nothing -> False+ Just rest -> maybe True (not . symbolic . fst) (T.uncons rest)++ symbolic c = c `elem` ("!#$%&*+./<=>?@\\^|-~:" :: String)++ skipBlock 0 t = t+ skipBlock n t0 = inBlock n (T.dropWhile (\c -> c /= '{' && c /= '-') t0)++ inBlock n 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)
+ src/Tilia/Process.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE LambdaCase #-}++-- | Running a program and reading its output.+module Tilia.Process (readProgramOutput) where++import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)+import Data.ByteString qualified as BS+import Data.Foldable (traverse_)+import Data.Text (Text)+import Data.Text.Encoding qualified as T+import System.Exit (ExitCode (..))+import System.IO (Handle, hClose, hSetBinaryMode)+import System.Process+ ( StdStream (CreatePipe),+ proc,+ std_err,+ std_in,+ std_out,+ waitForProcess,+ withCreateProcess,+ )+import Tilia.Newline (NewlineStyle (Lf), setNewlineStyle)+import Tilia.Utils (quietly)++-- | Run a program and read what it printed on standard output.+--+-- 'Nothing' where it could not be run at all or did not succeed, which the+-- callers treat alike: both mean this program has nothing to tell them.+-- Whatever it printed on its error stream is read but not kept—see 'drain'+-- for why it has to be read—because the one thing worse than a tool that+-- cannot answer is a tool that says so over the formatter's own output.+--+-- Line endings come back as newlines however the program wrote them. A+-- child writing to a pipe on Windows ends its lines the Windows way, and+-- every caller here goes on to split what it gets into lines and compare+-- them against something.+readProgramOutput :: FilePath -> [String] -> IO (Maybe Text)+readProgramOutput program args = quietly Nothing $+ withCreateProcess spec $ \toChild fromChild childErrors running -> do+ traverse_ hClose toChild+ waitForErrors <- forked (drain childErrors)+ out <- drain fromChild+ _ <- waitForErrors+ waitForProcess running >>= \case+ ExitSuccess -> pure (Just (setNewlineStyle Lf (T.decodeUtf8Lenient out)))+ _ -> pure Nothing+ where+ spec =+ (proc program args)+ { std_in = CreatePipe,+ std_out = CreatePipe,+ std_err = CreatePipe+ }++-- | Read a pipe to its end.+drain :: Maybe Handle -> IO BS.ByteString+drain = \case+ Nothing -> pure BS.empty+ Just h -> quietly BS.empty (hSetBinaryMode h True >> BS.hGetContents h)++-- | Start an action now and hand back the waiting callback for it.+forked :: IO a -> IO (IO a)+forked action = do+ done <- newEmptyMVar+ _ <- forkIO (action >>= putMVar done)+ pure (takeMVar done)
+ src/Tilia/Project.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Finding the project a file belongs to.+--+-- A formatter is usually handed a file, not a project. An editor may run it+-- with the working directory set to the file's own directory, or to the+-- editor's, or to wherever the user happened to start it. None of those is+-- reliably the root, and the root is what the build plan and the package+-- cache are found relative to.+module Tilia.Project+ ( ProjectRoot (..),+ Marker (..),+ markerFile,+ findProjectRoot,+ )+where++import Data.List (isSuffixOf)+import Data.Maybe (listToMaybe)+import System.Directory+ ( canonicalizePath,+ doesDirectoryExist,+ listDirectory,+ )+import System.FilePath (takeDirectory)+import Tilia.Utils (quietly)++-- | A project, and what marked it out.+data ProjectRoot = ProjectRoot+ { -- | The directory.+ prPath :: FilePath,+ -- | What identified it.+ prMarker :: Marker+ }+ deriving (Eq, Show)++-- | What a project was recognised by.+--+-- The two are read differently—one names the packages of a build, the+-- other is a package—so which it was has to survive being found.+data Marker+ = -- | A @cabal.project@, which names the packages.+ ProjectFile+ | -- | A @.cabal@ file, by its name: a package with no project around it.+ PackageFile FilePath+ deriving (Eq, Show)++-- | The file a marker stands for, for reporting.+markerFile :: Marker -> FilePath+markerFile = \case+ ProjectFile -> "cabal.project"+ PackageFile named -> named++-- | Walk upwards from a file or directory looking for a project.+--+-- A @cabal.project@ anywhere above wins over a @.cabal@ file nearer to+-- hand, so that a package inside a multi-package repository resolves to the+-- repository rather than to itself. That is where @cabal@ solves the build+-- and writes the plan, and a run rooted at the package would go looking for+-- a plan that is one directory up.+--+-- Only what @cabal@ reads counts. A @stack.yaml@ is not a project here: it+-- would stop the climb at a directory @cabal@ cannot solve in, whereas+-- passing over it settles on a @.cabal@ that @cabal@ can, which is the+-- difference between formatting a stack project and refusing it.+--+-- Stops at the filesystem root and returns 'Nothing' rather than guessing.+-- Formatting a file that belongs to no project is a perfectly ordinary+-- thing to do; it simply cannot have its fixities resolved.+findProjectRoot :: FilePath -> IO (Maybe ProjectRoot)+findProjectRoot start = quietly Nothing $ do+ from <- startingDirectory+ 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+ pure+ ( [ProjectRoot directory ProjectFile | "cabal.project" `elem` entries],+ [ ProjectRoot directory (PackageFile named)+ | named <- take 1 (filter (".cabal" `isSuffixOf`) entries)+ ]+ )
+ src/Tilia/Render.hs view
@@ -0,0 +1,188 @@+-- | Turning a parsed module into a document.+module Tilia.Render+ ( RenderConfig (..),+ defaultRenderConfig,+ renderModule,+ )+where++import Data.Choice (fromBool)+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 GHC.Hs (HsModule (..), XModulePs (..))+import GHC.Hs.Extension (GhcPs)+import GHC.LanguageExtensions.Type (Extension (..))+import GHC.Types.SrcLoc (getLoc)+import Tilia.Comments+ ( Comment (..),+ bracketed,+ closesItself,+ commentTrailing,+ escapeTrigger,+ widenTrigger,+ )+import Tilia.Comments.Attach (attachComments)+import Tilia.Doc.Combinators+import Tilia.Fixity (Scope)+import Tilia.Imports (normalizeImports)+import Tilia.Parser (ParsedModule (..))+import Tilia.Render.Context+import Tilia.Render.Declaration (decls, declsKeepingGroups)+import Tilia.Render.Expression (hsCmd, hsExprIn, untypedSplice)+import Tilia.Render.Haddock (haddockSpans)+import Tilia.Render.Header (HeaderPragma (..), hsModule, takeHeaderPragmas, takeStackHeader)+import Tilia.Render.Signature (sigDecl)+import Tilia.Source (comments)+import Tilia.Span+import Tilia.Span.Ghc (spanOf, spanOfSrcSpan)++-- | What the printer needs to know about the module beyond its text.+data RenderConfig = RenderConfig+ { -- | Extensions in force, from the module's own pragmas and from the+ -- package it belongs to.+ rcExtensions :: Set Extension,+ -- | What the module can see, if it could be worked out.+ rcScope :: Maybe Scope,+ -- | Source lines the import block must not be sorted across.+ rcImportBarriers :: [Int]+ }++-- | A configuration that asserts nothing.+defaultRenderConfig :: RenderConfig+defaultRenderConfig =+ RenderConfig+ { rcExtensions = Set.empty,+ rcScope = Nothing,+ rcImportBarriers = []+ }++-- | Render a parsed module, comments and all.+renderModule :: RenderConfig -> ParsedModule -> Doc+renderModule settings parsed =+ prologue (pmPrologue parsed)+ <> stackHeader+ <> attachComments loose (hsModule ctx pragmas (sorted hsMod))+ where+ hsMod = pmModule parsed+ (haddocks, loose') = splitHaddocks hsMod (comments (pmSource parsed))+ plain = heldOff haddocks loose'+ (stackHeader, rest) = takeStackHeader (pmHeaderEnd parsed) plain+ (pragmas, uncovered) = takeHeaderPragmas (pmSource parsed) (pmHeaderEnd parsed) rest+ loose = heldOffModuleDoc hsMod haddocks pragmas uncovered++ implicitPrelude =+ fromBool (Set.member ImplicitPrelude (rcExtensions settings))++ sorted m =+ m+ { hsmodImports =+ normalizeImports+ implicitPrelude+ (rcImportBarriers settings)+ (comments (pmSource parsed))+ (hsmodImports m)+ }+ ctx =+ Ctx+ { ctxExtensions = rcExtensions settings,+ ctxSourceType = pmSourceType parsed,+ ctxScope = rcScope settings,+ ctxSource = pmSource parsed,+ ctxLineComments = indexOn (filter (not . closesItself) loose),+ ctxHaddocks = indexOn haddocks,+ ctxKnot = knot+ }++-- | Keep a comment from running into a Haddock.+heldOff :: [Comment] -> [Comment] -> [Comment]+heldOff haddocks = map holdOff+ where+ written = filter (not . bracketed) haddocks+ ends = Set.fromList (map (spanEndLine . commentSpan) written)+ starts =+ Set.fromList+ [ spanStartLine (commentSpan h)+ | h <- written,+ not (commentTrailing h)+ ]+ holdOff c+ | bracketed c = c+ | otherwise =+ c+ { commentGapAbove =+ commentGapAbove c || Set.member (spanStartLine s - 1) ends,+ commentGapBelow =+ commentGapBelow c || Set.member (spanEndLine s + 1) starts+ }+ where+ s = commentSpan c++-- | Hold the first comment of the header off the module's own Haddock.+heldOffModuleDoc ::+ HsModule GhcPs ->+ -- | The Haddocks of the module, the module's own among them+ [Comment] ->+ -- | The pragmas the header is about to hoist+ [HeaderPragma] ->+ [Comment] ->+ [Comment]+heldOffModuleDoc hsMod haddocks pragmas cs+ | Just ended <- endOfModuleDoc,+ Just began <- startOfModuleLine,+ (before', c : after') <- break (uncoveredBetween ended began) cs =+ before' <> (c {commentGapAbove = True} : after')+ | otherwise = cs+ where+ uncoveredBetween ended began c =+ ended < spanStartLine here+ && spanStartLine here < began+ && not (Set.member (spanEndLine here + 1) travellers)+ where+ here = commentSpan c+ travellers = Set.fromList (map (spanStartLine . hpSpan) pragmas)+ endOfModuleDoc = do+ s <- moduleDoc+ c <- lookup (startPoint s) [(startPoint (commentSpan h), h) | h <- haddocks]+ if bracketed c then Nothing else Just (spanEndLine s)+ moduleDoc = case hsmodExt hsMod of+ XModulePs {hsmodHaddockModHeader = Just d} -> spanOfSrcSpan (getLoc d)+ _ -> Nothing+ startOfModuleLine = spanStartLine <$> (spanOf =<< hsmodName hsMod)++-- | The lines above the module, put back exactly as they were written.+prologue :: [Text] -> Doc+prologue = foldMap (\l -> txt l <> hardBreak)++-- | The knot: the printers that a module below their definition needs.+knot :: Knot+knot =+ Knot+ { knotExpr = hsExprIn,+ knotCmd = hsCmd,+ knotSplice = untypedSplice,+ knotSig = sigDecl,+ knotDecls = decls,+ knotDeclsGrouped = declsKeepingGroups+ }++-- | Separate the comments the syntax tree also knows about from the rest.+splitHaddocks ::+ HsModule GhcPs ->+ -- | Every comment in the module+ [Comment] ->+ -- | The ones the tree carries, and the ones it does not+ ([Comment], [Comment])+splitHaddocks hsMod = foldr sort' ([], [])+ where+ inTree = Set.fromList (map startPoint (haddockSpans hsMod))+ sort' c (docs, rest)+ | startPoint (commentSpan c) `Set.member` inTree =+ (widenTrigger c : docs, rest)+ | otherwise = (docs, escapeTrigger c : rest)++-- | Index comments by where they begin.+indexOn :: [Comment] -> Map (Int, Int) Comment+indexOn cs = Map.fromList [(startPoint (commentSpan c), c) | c <- cs]
+ src/Tilia/Render/Body.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE LambdaCase #-}++-- | Which constructs absorb the line break that introduces them.+--+-- A body is a node together with the site it stands at, and the one question+-- an enclosing construct has to ask of it is where to put it: on the line it+-- has already started, or on the next one indented. "Tilia.Doc.Body"+-- states that question as a class; this module answers it, for the two kinds+-- of node that can stand as a body.+--+-- The answers are a table, not an argument. Threading a @body -> Placement@+-- callback through every construct that has a body—equations, guards, @if@,+-- @let@, @case@, lambdas, statements—spreads one small piece of knowledge+-- across a dozen signatures and makes each of them carry a second parameter+-- that only ever has two possible values. Here it is written down once, and+-- what the constructs pass around is the body itself.+module Tilia.Render.Body+ ( -- * Bodies+ ExprBody (..),+ CmdBody (..),+ CmdTopBody (..),++ -- * The table+ exprHangs,+ operatorName,+ cmdTopHangs,+ )+where++import GHC.Hs+import GHC.Types.Name.Occurrence (occNameString)+import GHC.Types.Name.Reader (RdrName, rdrNameOcc)+import GHC.Types.SrcLoc (GenLocated (..), unLoc)+import Tilia.Doc.Body+import Tilia.Doc.Combinators+import Tilia.Render.Context+import Tilia.Span+import Tilia.Span.Ghc++----------------------------------------------------------------------------+-- Bodies++-- | An expression standing as the body of an enclosing construct.+data ExprBody = ExprBody Ctx Site (LHsExpr GhcPs)++instance Body ExprBody where+ printBody (ExprBody ctx site e) = knotExpr (ctxKnot ctx) ctx site e+ bodyPlacement (ExprBody _ _ e) = exprHangs (unLoc e)++-- | A command standing as the body of an enclosing construct.+data CmdBody = CmdBody Ctx Site (LHsCmd GhcPs)++instance Body CmdBody where+ printBody (CmdBody ctx site c) = knotCmd (ctxKnot ctx) ctx site c+ bodyPlacement (CmdBody _ _ c) = cmdHangs (unLoc c)++-- | A command at the top of an arrow form.+data CmdTopBody = CmdTopBody Ctx Site (LHsCmdTop GhcPs)++instance Body CmdTopBody where+ printBody (CmdTopBody ctx site l) =+ at ctx l (\(HsCmdTop _ cmd) -> knotCmd (ctxKnot ctx) ctx site cmd)+ bodyPlacement (CmdTopBody _ _ l) = cmdTopHangs (unLoc l)++----------------------------------------------------------------------------+-- The table++-- | Does this expression absorb the line break that introduces it?+--+-- A @do@ block, a @case@ and a lambda all begin with a keyword and continue+-- on the lines below, so @f = do@ costs nothing and saves a line. Everything+-- not named here has to start on a line of its own.+exprHangs :: HsExpr GhcPs -> Placement+exprHangs = \case+ HsDo _ (DoExpr _) _ -> Hanging+ HsDo _ (MDoExpr _) _ -> Hanging+ HsCase {} -> Hanging+ HsLam _ lamVariant mg -> case lamVariant of+ LamCase -> Hanging+ LamCases -> Hanging+ -- A lambda whose parameters ran over several lines leaves its body+ -- indented under nothing legible, so only a compact one hangs.+ LamSingle -> case mg of+ MG _ (L _ [L _ (Match _ _ (L _ ps@(_ : _)) _)])+ | maybe False isSingleLine (spansOf ps) -> Hanging+ _ -> Normal+ HsProc _ p _+ -- The indentation breaks when the pattern runs over more than one line,+ -- so hanging is only safe when it does not.+ | maybe False isSingleLine (spanOf p) -> Hanging+ | otherwise -> Normal+ -- An application hangs on its last argument, and a chain through @$@ on+ -- its right operand: both of those are the thing that would be introduced.+ -- No other operator qualifies, @$@ being the one whose whole purpose is to+ -- hand a block to what precedes it.+ HsApp _ _ y -> exprHangs (unLoc y)+ OpApp _ _ op y+ | Just n <- operatorName op,+ occNameString (rdrNameOcc n) == "$" ->+ exprHangs (unLoc y)+ _ -> Normal++-- | Does this command absorb the line break that introduces it?+cmdHangs :: HsCmd GhcPs -> Placement+cmdHangs = \case+ HsCmdDo {} -> Hanging+ HsCmdCase {} -> Hanging+ HsCmdLam {} -> Hanging+ _ -> Normal++cmdTopHangs :: HsCmdTop GhcPs -> Placement+cmdTopHangs (HsCmdTop _ c) = cmdHangs (unLoc c)++-- | The name of an operator, when the expression standing as one is a name.+operatorName :: LHsExpr GhcPs -> Maybe RdrName+operatorName e = case unLoc e of+ HsVar _ (L _ n) -> Just n+ _ -> Nothing
+ src/Tilia/Render/Class.hs view
@@ -0,0 +1,353 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Classes, instances and families.+--+-- What these have in common is a head followed by a body of declarations,+-- and a recurring difficulty: the syntax tree keeps the body's declarations+-- in several lists—signatures here, bindings there, associated families+-- somewhere else—so the order the author wrote them in survives only in+-- their spans. Every body in this module has to be put back in order before+-- it can be printed.+module Tilia.Render.Class+ ( classDecl,+ clsInstDecl,+ tyFamInstDecl,+ dataFamInstDecl,+ standaloneDerivDecl,+ famDecl,+ roleAnnot,+ )+where++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 Tilia.Doc.Combinators+import Tilia.Render.Context+import Tilia.Render.Data (dataDecl)+import Tilia.Render.Name+import Tilia.Render.Pragma+import Tilia.Render.Type+import Tilia.Span.Ghc++----------------------------------------------------------------------------+-- Classes++-- | A type class declaration.+classDecl ::+ Ctx ->+ AnnClassDecl ->+ Maybe (LHsContext GhcPs) ->+ LocatedN RdrName ->+ LHsQTyVars GhcPs ->+ LexicalFixity ->+ [LHsFunDep GhcPs] ->+ [LSig GhcPs] ->+ LHsBinds GhcPs ->+ [LFamilyDecl GhcPs] ->+ [LTyFamDefltDecl GhcPs] ->+ [LDocDecl GhcPs] ->+ Doc+classDecl ctx anns ctxt tyCon HsQTvs {..} fixity fdeps sigs binds families defaults docs =+ txt "class" <> layoutFrom ctx wholeHeadSpan head' <> body+ where+ headSpan = spanOf tyCon <> spansOf hsq_explicit+ whereSpan = tokenSpan (acd_where anns)+ wholeHeadSpan = foldMap spanOf ctxt <> headSpan <> spansOf fdeps++ head' =+ breakOrSpace+ <> indent+ ( foldMap (classContext ctx) ctxt+ <> layoutFrom ctx headSpan classHead+ <> indent (funDeps ctx fdeps)+ <> includeUnless+ (null members)+ (breakOrSpace <> keywordAt ctx whereSpan "where")+ )++ classHead+ | isCTuple (unLoc tyCon) (length hsq_explicit) =+ layoutWithin ctx (spanOf tyCon) (spansOf hsq_explicit) $+ parens+ ( insideBrackets+ (spanOf tyCon)+ (commaSep (map (align . at_ ctx (tyVarBndr ctx)) hsq_explicit))+ )+ | otherwise =+ defHead+ (fixity == Infix)+ True+ (name ctx tyCon)+ (map (at_ ctx (tyVarBndr ctx)) hsq_explicit)++ body =+ includeUnless+ (null members)+ (breakOrSpace <> indent (knotDeclsGrouped (ctxKnot ctx) ctx Associated members))++ members =+ inSourceOrder+ [ map (fmap (SigD NoExtField)) sigs,+ map (fmap (ValD NoExtField)) binds,+ map (fmap (TyClD NoExtField . FamDecl NoExtField)) families,+ map (fmap (InstD NoExtField . TyFamInstD NoExtField)) defaults,+ map (fmap (DocD NoExtField)) docs+ ]++-- | Is this the constraint tuple of the given arity?+isCTuple :: RdrName -> Int -> Bool+isCTuple (Exact n) arity = isCTupleTyConName n && n == cTupleTyConName arity+isCTuple _ _ = False++-- | A context on a class head, with the @=>@ that follows it.+classContext :: Ctx -> LHsContext GhcPs -> Doc+classContext ctx ctxt+ | null (unLoc ctxt) = mempty+ | otherwise = context ctx ctxt <> joinedBy "=>"++-- | The functional dependencies of a class.+funDeps :: Ctx -> [LHsFunDep GhcPs] -> Doc+funDeps _ [] = mempty+funDeps ctx fdeps =+ breakOrSpace+ <> txt "|"+ <> space+ <> indent (commaSep (map (align . at_ ctx (funDep ctx)) fdeps))++funDep :: Ctx -> FunDep GhcPs -> Doc+funDep ctx (FunDep _ before after) =+ hsep (map (name ctx) before)+ <> space+ <> txt "->"+ <> space+ <> hsep (map (name ctx) after)++----------------------------------------------------------------------------+-- Instances++-- | A class instance.+clsInstDecl :: Ctx -> ClsInstDecl GhcPs -> Doc+clsInstDecl ctx ClsInstDecl {cid_ext = (warning, anns, _), ..} =+ txt "instance" <> layoutFrom ctx headSpan head' <> body+ where+ headSpan = foldMap spanOf warning <> spanOf cid_poly_ty+ whereSpan = tokenSpan (acid_where anns)++ head' =+ foldMap (\w -> breakOrSpace <> at ctx w warningTxt) warning+ <> breakOrSpace+ <> at+ ctx+ cid_poly_ty+ ( \sigTy ->+ indent $+ foldMap (<> breakOrSpace) (overlapMode cid_overlap_mode)+ <> hsSigTypeBody ctx sigTy+ <> includeUnless+ (null members)+ (breakOrSpace <> keywordAt ctx whereSpan "where")+ )++ body =+ includeUnless (null members) . indent $+ breakOrSpace <> knotDeclsGrouped (ctxKnot ctx) ctx Associated members++ members =+ inSourceOrder+ [ map (fmap (SigD NoExtField)) cid_sigs,+ map (fmap (ValD NoExtField)) cid_binds,+ map (fmap (InstD NoExtField . TyFamInstD NoExtField)) cid_tyfam_insts,+ map (fmap (InstD NoExtField . DataFamInstD NoExtField)) cid_datafam_insts+ ]++-- | A standalone @deriving@ declaration.+standaloneDerivDecl :: Ctx -> DerivDecl GhcPs -> Doc+standaloneDerivDecl ctx DerivDecl {deriv_ext = (warning, _), ..} =+ txt "deriving" <> space <> strategy+ where+ instanceHead indented =+ indent $+ txt "instance"+ <> foldMap (\w -> breakOrSpace <> at ctx w warningTxt) warning+ <> breakOrSpace+ <> foldMap (<> breakOrSpace) (overlapMode deriv_overlap_mode)+ <> nest (if indented then 1 else 0) (hsSigType ctx (hswc_body deriv_type))++ strategy = case deriv_strategy of+ Nothing -> instanceHead False+ Just (L _ s) -> case s of+ StockStrategy _ -> txt "stock " <> instanceHead False+ AnyclassStrategy _ -> txt "anyclass " <> instanceHead False+ NewtypeStrategy _ -> txt "newtype " <> instanceHead False+ ViaStrategy (XViaStrategyPs _ sigTy) ->+ txt "via"+ <> breakOrSpace+ <> indent (hsSigType ctx sigTy)+ <> breakOrSpace+ <> instanceHead True++-- | A type family instance.+tyFamInstDecl :: Ctx -> FamilyStyle -> TyFamInstDecl GhcPs -> Doc+tyFamInstDecl ctx style TyFamInstDecl {..} =+ txt keyword <> breakOrSpace <> indent (tyFamInstEqn ctx tfid_eqn)+ where+ keyword = case style of+ Associated -> "type"+ Free -> "type instance"++-- | A data family instance.+dataFamInstDecl :: Ctx -> FamilyStyle -> DataFamInstDecl GhcPs -> Doc+dataFamInstDecl ctx style (DataFamInstDecl FamEqn {..}) =+ dataDecl+ ctx+ style+ feqn_tycon+ feqn_pats+ typeArgSpan+ (typeArgument ctx)+ feqn_fixity+ outerBinders+ feqn_rhs+ where+ -- @data instance forall k (a :: k). D a = …@ binds its variables ahead+ -- of the head, exactly as a type family instance does.+ outerBinders = case feqn_bndrs of+ HsOuterImplicit NoExtField -> mempty+ HsOuterExplicit _ bndrs ->+ forallBndrs ctx Invisible (tyVarBndr ctx) bndrs <> breakOrSpace++----------------------------------------------------------------------------+-- Families++-- | A @data family@ or @type family@ declaration.+famDecl :: Ctx -> FamilyStyle -> FamilyDecl GhcPs -> Doc+famDecl ctx style FamilyDecl {fdTyVars = HsQTvs {..}, ..} =+ txt keyword <> txt familyWord <> head' <> equations+ where+ (keyword, closedEqns) = case fdInfo of+ DataFamily -> ("data", Nothing)+ OpenTypeFamily -> ("type", Nothing)+ ClosedTypeFamily eqs -> ("type", Just eqs)+ familyWord = case style of+ Associated -> ""+ Free -> " family"++ headSpan = spanOf fdLName <> spansOf hsq_explicit+ headAndSigSpan = spanOf fdResultSig <> headSpan++ head' =+ indent . layoutFrom ctx headAndSigSpan $+ breakOrSpace+ <> layoutFrom+ ctx+ headSpan+ ( defHead+ (fdFixity == Infix)+ True+ (name ctx fdLName)+ (map (at_ ctx (tyVarBndr ctx)) hsq_explicit)+ )+ <> includeUnless+ (isNothing resultSig && isNothing fdInjectivityAnn)+ space+ <> indent+ ( sequence_' resultSig+ <> space+ <> foldMap (at_ ctx (injectivityAnn ctx)) fdInjectivityAnn+ )++ sequence_' = maybe mempty id+ resultSig = familyResultSig ctx fdResultSig++ equations = case closedEqns of+ Nothing -> mempty+ Just eqs ->+ indent (layoutFrom ctx headAndSigSpan (breakOrSpace <> txt "where"))+ <> case eqs of+ -- @where ..@ is how a closed family says that its equations are+ -- not being given here.+ Nothing -> space <> txt ".."+ -- A closed family may be given no equations at all, and then+ -- the @where@ is the whole of it. Breaking the line anyway+ -- leaves the next thing along hanging under a @where@ that+ -- opened a block nothing was put in.+ Just given ->+ includeUnless (null given) $+ hardBreak <> indent (vsep (map (at_ ctx (tyFamInstEqn ctx)) given))++familyResultSig :: Ctx -> LFamilyResultSig GhcPs -> Maybe Doc+familyResultSig ctx (L _ sig) = case sig of+ NoSig NoExtField -> Nothing+ KindSig NoExtField k ->+ Just (txt "::" <> breakOrSpace <> hsType ctx k)+ TyVarSig NoExtField bndr ->+ Just (txt "=" <> breakOrSpace <> at ctx bndr (tyVarBndr ctx))++injectivityAnn :: Ctx -> InjectivityAnn GhcPs -> Doc+injectivityAnn ctx (InjectivityAnn _ from to) =+ txt "|"+ <> space+ <> name ctx from+ <> space+ <> txt "->"+ <> space+ <> hsep (map (name ctx) to)++-- | One equation of a type family.+tyFamInstEqn :: Ctx -> TyFamInstEqn GhcPs -> Doc+tyFamInstEqn ctx FamEqn {..} =+ binders <> nest (if hasBinders then 1 else 0) (lhs <> rhs)+ where+ (binders, hasBinders) = case feqn_bndrs of+ HsOuterImplicit NoExtField -> (mempty, False)+ HsOuterExplicit _ bndrs ->+ ( forallBndrs ctx Invisible (tyVarBndr ctx) bndrs <> breakOrSpace,+ not (null bndrs)+ )++ lhs =+ layoutFrom ctx (spanOf feqn_tycon <> foldMap typeArgSpan feqn_pats) $+ defHead+ (feqn_fixity == Infix)+ True+ (name ctx feqn_tycon)+ (map (typeArgument ctx) feqn_pats)++ rhs =+ indent (joinedBy "=" <> hsType ctx feqn_rhs)++----------------------------------------------------------------------------+-- Role annotations++-- | A @type role@ declaration.+roleAnnot :: Ctx -> RoleAnnotDecl GhcPs -> Doc+roleAnnot ctx (RoleAnnotDecl _ tyCon roles) =+ txt "type role"+ <> breakOrSpace+ <> indent+ ( name ctx tyCon+ <> breakOrSpace+ <> indent (align (sepBy breakOrSpace (map (align . at_ ctx role) roles)))+ )+ where+ role = maybe (txt "_") $ \case+ Nominal -> txt "nominal"+ Representational -> txt "representational"+ Phantom -> txt "phantom"++----------------------------------------------------------------------------+-- Helpers++-- | 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
+ src/Tilia/Render/Context.hs view
@@ -0,0 +1,398 @@+-- | What the syntax walk needs to know that the syntax tree does not say.+--+-- Printing a Haskell module is very nearly a fold over its syntax tree, but+-- not quite: a handful of decisions need facts from outside the node being+-- printed. Which extensions are on decides whether @(#foo)@ needs spaces+-- inside its parentheses; which operators are in scope decides how a chain+-- of them may be regrouped; where the comments are decides which constructs+-- may be put on one line.+--+-- The record also carries the knot ('Knot'). Rendering is mutually+-- recursive—a type may contain a splice, which contains an expression,+-- which contains declarations, which contain types—and rather than break+-- the cycle with @hs-boot@ files the few backward edges are held in this+-- record and tied once, in "Tilia.Render". That is what lets the modules+-- below be ordered by syntactic category instead of by what happens to+-- import what.+module Tilia.Render.Context+ ( -- * The context+ Ctx (..),+ SourceType (..),+ Knot (..),+ FamilyStyle (..),++ -- * Where a node stands+ Site (..),+ plainSite,+ withBracing,+ underSite,+ closingFor,++ -- * Extensions+ extensionOn,++ -- * Fixities+ operatorFixity,++ -- * What lies between two spans+ commentBetween,+ separatedByBlank,++ -- * Entering the tree+ at,+ at_,+ atSpan,+ keywordAt,+ fenceWithin,+ layoutFrom,+ layoutWithin,+ layoutAcross,+ insideBrackets,++ -- * Haddocks+ writtenHaddock,+ )+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)+import GHC.Types.Name.Occurrence (occNameString)+import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc)+import GHC.Types.SrcLoc (GenLocated (..))+import GHC.Types.SrcLoc qualified as GHC+import Tilia.Comments (Comment (..), CommentStyle (..), commentTrailing)+import Tilia.Doc.Combinators+import Tilia.Fixity+ ( Fixity,+ Namespace (..),+ OpName (..),+ Resolution (..),+ Scope,+ lookupFixity,+ )+import Tilia.Render.Layout (Bracing (..))+import Tilia.Source (Source, SourceType (..), blankAt, sourceLines)+import Tilia.Span+import Tilia.Span.Ghc++----------------------------------------------------------------------------+-- The context++-- | Whether a family or data declaration stands on its own or inside a+-- class.+--+-- An associated declaration drops the @family@ and @instance@ keywords its+-- free-standing counterpart needs, which is the only thing the printer has+-- to know about the difference.+data FamilyStyle+ = Associated+ | Free+ deriving (Eq, Show)++-- | The backward edges of the rendering knot.+--+-- Each field is a printer defined in a module that the module needing it+-- comes before. Nothing else belongs here: a forward edge is an ordinary+-- import and should stay one.+data Knot = Knot+ { -- | Expressions, needed by types, patterns and bodies.+ knotExpr :: Ctx -> Site -> LHsExpr GhcPs -> Doc,+ -- | Commands, needed by bodies.+ knotCmd :: Ctx -> Site -> LHsCmd GhcPs -> Doc,+ -- | Splices, needed by types and patterns, defined with expressions.+ knotSplice :: Ctx -> SpliceDecoration -> HsUntypedSplice GhcPs -> Doc,+ -- | 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,+ -- | A run of declarations that keeps the author's blank lines, needed by+ -- class and instance bodies.+ knotDeclsGrouped :: Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc+ }++-- | Everything a printer may need beyond the node it is given.+data Ctx = Ctx+ { -- | Extensions in force.+ ctxExtensions :: Set Extension,+ -- | Module or signature.+ ctxSourceType :: SourceType,+ -- | What the module can see, if that could be worked out.+ --+ -- 'Nothing' is not the same as an empty scope: it means no answer was+ -- established, and an operator chain whose fixities are unknown is left+ -- exactly as the author arranged it. See "Tilia.Fixity".+ ctxScope :: Maybe Scope,+ -- | The comments that take whole lines, by starting position.+ --+ -- Only these are here, because only these bear on layout: a construct+ -- with one written inside it cannot be put on one line, since the+ -- comment would swallow whatever followed it.+ ctxLineComments :: Map (Int, Int) Comment,+ -- | The module as its author wrote it.+ ctxSource :: Source,+ -- | The author's own text for each Haddock, by starting position.+ ctxHaddocks :: Map (Int, Int) Comment,+ -- | The knot.+ ctxKnot :: Knot+ }++----------------------------------------------------------------------------+-- Extensions++-- | Is the extension on?+extensionOn :: Ctx -> Extension -> Bool+extensionOn ctx e = Set.member e (ctxExtensions ctx)++----------------------------------------------------------------------------+-- Fixities++-- | The fixity of an operator, if one was established.+--+-- 'Nothing' means the question was not answered, and the caller must not+-- rearrange anything on the strength of it.+--+-- The namespace is the caller's to say, and it matters: @:>@ written among+-- types is servant's, written among terms it is text's, and they do not+-- agree about how it binds.+operatorFixity :: Ctx -> Namespace -> RdrName -> Maybe Fixity+operatorFixity ctx namespace name = do+ scope <- ctxScope ctx+ case lookupFixity scope namespace qualifier op 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++----------------------------------------------------------------------------+-- Where a node stands++-- | What the surroundings of a node oblige it to do.+--+-- None of this can be read off the node itself, and all of it changes how+-- the node is laid out, which is why it travels alongside. It lives here+-- rather than with the expression printer because the knot has to mention+-- it: a body is a node together with the site it stands at, and the printers+-- that turn one into a document are reached through the knot.+data Site = Site+ { -- | Is this the function of an application, as @f@ is in @f a@?+ siteApplicand :: Bool,+ -- | Is this an item of a layout block?+ --+ -- Such an item may not leave a bracket open for the block's own layout+ -- to close, so a list comprehension standing as a statement is arranged+ -- differently from one standing anywhere else.+ siteInBlock :: Bool,+ -- | May a block inside this node put braces round itself?+ siteBracing :: Bracing+ }+ deriving (Eq, Show)++-- | A node standing on its own.+plainSite :: Site+plainSite =+ Site+ { siteApplicand = False,+ siteInBlock = False,+ siteBracing = NoBrace+ }++-- | The same site, with a different answer about braces.+withBracing :: Bracing -> Site -> Site+withBracing bracing site = site {siteBracing = bracing}++-- | Indent a hanging body, one step further when it hangs off an applicand.+underSite :: Site -> Doc -> Doc+underSite site = nest (if siteApplicand site then 2 else 1)++-- | Where a bracket opened here has to close.+closingFor :: Site -> ClosingIndent+closingFor site = if siteInBlock site then Indented else Outdented++----------------------------------------------------------------------------+-- What lies between two spans++-- | Where the next thing to be printed begins. It is either the third+-- argument or a comment, if there is any between the two spans.+nextPrinted ::+ Ctx ->+ -- | What has just been printed+ Maybe Span ->+ -- | What follows it, if nothing comes between+ Maybe Span ->+ Maybe Span+nextPrinted ctx (Just a) mb@(Just b) =+ case filter (not . commentTrailing) (Map.elems inTheGap) of+ (c : _) -> Just (commentSpan c)+ [] -> mb+ where+ inTheGap =+ Map.takeWhileAntitone (< startPoint b) $+ Map.dropWhileAntitone (< endPoint a) (ctxLineComments ctx)+nextPrinted _ _ mb = mb++-- | Is a comment going to be printed between the two spans?+commentBetween :: Ctx -> Maybe Span -> Maybe Span -> Bool+commentBetween ctx a b = nextPrinted ctx a b /= b++-- | Did the author leave an empty line directly after the first of these?+separatedByBlank :: Ctx -> Maybe Span -> Maybe Span -> Bool+separatedByBlank ctx ma@(Just a) mb = case nextPrinted ctx ma mb of+ Just s -> any (writtenBlank ctx) [spanEndLine a + 1 .. spanStartLine s - 1]+ Nothing -> False+separatedByBlank _ _ _ = False++-- | Did the author leave this line empty?+--+-- Asked of the module as written, so that a line the preprocessor support+-- emptied to make one configuration does not read as one the author left+-- blank.+writtenBlank :: Ctx -> Int -> Bool+writtenBlank ctx n = blankAt n (sourceLines (ctxSource ctx))++----------------------------------------------------------------------------+-- Entering the tree++-- | Enter a located node.+--+-- This is the counterpart of every @L@ in the syntax tree: it records where+-- the output came from, so that comments can be attached to it later, and+-- it settles the node's layout from the region it occupied. A printer that+-- pattern-matches through a located wrapper without going through here has+-- dropped a comment's only anchor.+at :: (HasLoc l) => Ctx -> GenLocated l a -> (a -> Doc) -> Doc+at ctx l f = atSpan ctx (spanOf l) (f (GHC.unLoc l))++-- | 'at' with the arguments the other way round, for use in sections.+at_ :: (HasLoc l) => Ctx -> (a -> Doc) -> GenLocated l a -> Doc+at_ ctx f l = at ctx l f++-- | Lay a region out as it was written, and claim it.+--+-- Claiming is the difference between this and 'layoutFrom': a comment+-- written anywhere inside the region attaches to this document. So it is+-- for the handful of things a comment can be written against that the+-- syntax tree gives no node for—the @where@ that opens a body, the @then@+-- of an @if@—and for nothing else. Claiming a region merely because its+-- layout is being decided would hand every comment inside it to whatever+-- happens to be printed first.+atSpan :: Ctx -> Maybe Span -> Doc -> Doc+atSpan _ Nothing d = d+atSpan ctx (Just s) d = located s (grouped ctx s d)++-- | A keyword, claiming the span it was written on.+--+-- A keyword is one of the things an author writes a comment against that+-- the syntax tree gives no node for. Unless it claims its own span there is+-- no region on that line for such a comment to trail, and it falls through+-- to whatever construct begins next, to be printed above that on a line its+-- author did not choose.+keywordAt :: Ctx -> Maybe Span -> Text -> Doc+keywordAt ctx s = atSpan ctx s . txt++-- | Prevent comments inside the given region to float out of it and attach+-- to elements outside.+fenceWithin :: Ctx -> Maybe Span -> Doc -> Doc+fenceWithin _ Nothing d = d+fenceWithin _ (Just s) d = fence s d++-- | Lay a region out as it was written, and claim nothing.+--+-- The region decides one thing—whether what is printed here goes on one+-- line or several—and says nothing about where the output came from. That+-- is the whole difference from 'atSpan', and it is why this is the one to+-- reach for by default.+--+-- Given no span at all it lays the document out flat, which is what a+-- construct the printer synthesised rather than read deserves.+layoutFrom :: Ctx -> Maybe Span -> Doc -> Doc+layoutFrom _ Nothing d = flat d+layoutFrom ctx (Just s) d = grouped ctx s d++-- | Lay a construct out from the region its contents occupy rather than the+-- region it occupies.+--+-- Delimiters are not contents. @[\n Int\n]@ is a list of one thing written+-- on one line, held apart by brackets that happen to sit on lines of their+-- own, and breaking it because the brackets are spread out would be+-- following the punctuation rather than the code. What the author spread+-- out is what decides, and that is the elements.+--+-- Comments are still looked for across the whole construct, brackets and+-- all: one written between a bracket and what it holds still owns the rest+-- of its line, so the construct still cannot be put on one.+layoutWithin ::+ Ctx ->+ -- | The whole construct, delimiters included+ Maybe Span ->+ -- | What it holds+ Maybe Span ->+ Doc ->+ Doc+layoutWithin ctx whole contents d+ | any (holdsLineComment ctx) whole = broken d+ | otherwise = maybe (flat d) (`group` d) contents++-- | 'layoutFrom' over the region several located things cover.+layoutAcross :: (HasLoc l) => Ctx -> [GenLocated l a] -> Doc -> Doc+layoutAcross ctx xs = layoutFrom ctx (spansOf xs)++-- | Give the inside of a bracketed construct an anchor at its far end.+--+-- The last element of a list is not the last thing inside its brackets: a+-- comment may be written after it and before the closing bracket, and it+-- belongs inside. Nothing in the syntax tree stands there, so a zero-width+-- anchor at the construct's own end is put there for such a comment to+-- attach to—and it is the only thing a comment written between the brackets+-- of an /empty/ construct has to attach to at all.+--+-- Without it those comments have nothing to hold them and are emitted after+-- the closing bracket, which moves them out of the construct they were+-- written in.+insideBrackets :: Maybe Span -> Doc -> Doc+insideBrackets here d = d <> foldMap (emptyAnchor . endOf) here++-- | Lay a document out according to a span, and to the comments inside it.+--+-- Layout follows the input, except that a comment taking a whole line+-- overrules it. Such a comment owns the rest of its line, so a construct+-- holding one cannot be put on one line however the author wrote it; the+-- closing bracket would end up commented out.+grouped :: Ctx -> Span -> Doc -> Doc+grouped ctx s d+ | holdsLineComment ctx s = broken d+ | otherwise = group s d++-- | Does a comment that takes whole lines begin inside this span?+holdsLineComment :: Ctx -> Span -> Bool+holdsLineComment ctx s =+ case Map.lookupGE (startPoint s) (ctxLineComments ctx) of+ Just (start, _) -> start < endPoint s+ Nothing -> False++----------------------------------------------------------------------------+-- Haddocks++-- | The author's own text for the Haddock at this position, if we kept it.+--+-- Rebuilding a Haddock from the doc string the syntax tree carries cannot+-- reproduce a @{- | … -}@ or an empty @-- |@, so the text is taken from the+-- comment stream whenever the Haddock is going to come back out in the style+-- it went in as. Deciding that is the caller's business; all this does is+-- find the text.+writtenHaddock :: Ctx -> Maybe Span -> Maybe (NonEmpty Text)+writtenHaddock ctx ms = do+ s <- ms+ c <- Map.lookup (spanStartLine s, spanStartColumn s) (ctxHaddocks ctx)+ case commentStyle c of+ DocComment -> Just (commentBody c)+ _ -> Nothing
+ src/Tilia/Render/Data.hs view
@@ -0,0 +1,397 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Data types and type synonyms.+--+-- One declaration form covers a great deal of ground here—@data@,+-- @newtype@, @type data@, ordinary constructors, record constructors, GADT+-- constructors, and instances of all of them—which is why this reads as a+-- series of decisions rather than as a single shape. The decisions are:+-- whether the constructors are written in GADT style, whether there is+-- exactly one and it is a record, and whether anything is documented with a+-- Haddock that takes whole lines.+module Tilia.Render.Data+ ( dataDecl,+ synDecl,+ )+where++import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE+import Data.Maybe (isJust, isNothing, mapMaybe, maybeToList)+import GHC.Hs+import GHC.Types.Fixity (LexicalFixity (..))+import GHC.Types.ForeignCall (CType (..), Header (..))+import GHC.Types.Name.Reader (RdrName)+import GHC.Types.SrcLoc (GenLocated (..), unLoc)+import Tilia.Doc.Combinators+import Tilia.Render.Context+import Tilia.Render.Haddock+import Tilia.Render.Layout+import Tilia.Render.Name+import Tilia.Render.Type+import Tilia.Span+import Tilia.Span.Ghc++-- | A @data@, @newtype@ or @type data@ declaration, or an instance of one.+--+-- The type variables are left abstract because a data instance is applied to+-- types rather than to variables, and the two are otherwise printed+-- identically.+dataDecl ::+ Ctx ->+ FamilyStyle ->+ -- | The type constructor+ LocatedN RdrName ->+ -- | What it is applied to+ [tyVar] ->+ -- | Where each of those was+ (tyVar -> Maybe Span) ->+ -- | How to print one+ (tyVar -> Doc) ->+ -- | Was the head written infix?+ LexicalFixity ->+ -- | The @forall@ a family instance may bind its variables with, which an+ -- ordinary declaration does not have and passes as 'mempty'.+ Doc ->+ HsDataDefn GhcPs ->+ Doc+dataDecl ctx style tyCon tyVars tyVarSpan renderTyVar fixity outerBinders HsDataDefn {..} =+ txt keyword <> txt instanceWord <> header <> constructors <> derivings+ where+ keyword = case dd_cons of+ NewTypeCon _ -> "newtype"+ DataTypeCons False _ -> "data"+ DataTypeCons True _ -> "type data"+ instanceWord = case style of+ Associated -> ""+ Free -> " instance"++ headSpan = spanOf tyCon <> foldMap tyVarSpan tyVars+ wholeHeadSpan =+ headSpan+ <> foldMap spanOf dd_kindSig+ <> foldMap spanOf dd_ctxt+ <> foldMap spanOf dd_cType++ header =+ layoutFrom ctx wholeHeadSpan . indent $+ foreignType+ <> breakOrSpace+ <> outerBinders+ <> foldMap (leftContext ctx) dd_ctxt+ <> layoutFrom+ ctx+ headSpan+ (defHead (fixity == Infix) True (name ctx tyCon) (map renderTyVar tyVars))+ <> foldMap kindSignature dd_kindSig++ kindSignature k =+ joinedBy "::" <> indent (hsType ctx k)++ -- The @{-# CTYPE … #-}@ pragma of a foreign data type.+ foreignType = case unLoc <$> dd_cType of+ Nothing -> mempty+ Just (CType prag header' (type_, _)) ->+ breakOrSpace+ <> sourceText prag+ <> foldMap (\(Header h _) -> space <> sourceText h) header'+ <> space+ <> sourceText type_+ <> txt " #-}"++ cons = case dd_cons of+ NewTypeCon c -> [c]+ DataTypeCons _ cs -> cs++ -- A kind signature on the head, or any constructor written with a+ -- signature of its own, means the whole declaration is in GADT style.+ isGadt = isJust dd_kindSig || any (isGadtCon . unLoc) cons++ constructors = case cons of+ [] -> mempty+ (firstCon : _)+ | isGadt ->+ indent $+ layoutFrom ctx wholeHeadSpan (breakOrSpace <> txt "where")+ <> breakOrSpace+ -- Braces once there is a semicolon to protect: written flat+ -- the @where@ block has no column to end at, so anything+ -- after the declaration would be read as another+ -- constructor. One constructor needs no separator and so no+ -- braces.+ <> items+ (if null (drop 1 cons) then NoBrace else MayBrace)+ (map (at_ ctx (conDecl ctx False)) cons)+ | otherwise ->+ layoutFrom ctx (spanOf tyCon <> spansOf cons) . indent $+ beforeEquals <> txt "=" <> space <> alternatives+ where+ -- A single record constructor is laid out as one thing with the+ -- @=@, since there is no choice of constructor to present.+ singleRecCon = case cons of+ [L _ ConDeclH98 {con_args = RecCon {}}] -> True+ _ -> False+ compactAroundEquals =+ sameLine (spanOf tyCon) (conNamesSpan (unLoc firstCon))+ conNamesSpan = \case+ ConDeclGADT {..} -> spansOf (NE.toList con_names)+ ConDeclH98 {..} -> spanOf con_name++ -- Documentation written as @--@ lines owns the rest of the line+ -- it starts, so nothing can follow it and the constructors go one+ -- to a line. Written as @{- | … -}@ it closes itself and asks+ -- nothing of the layout.+ lineHaddocks = any (printsWholeLineDocs ctx . visibleDocs . unLoc) cons++ beforeEquals+ | lineHaddocks = hardBreak+ | singleRecCon && compactAroundEquals = space+ | otherwise = breakOrSpace++ separator+ | lineHaddocks = hardBreak <> txt "|" <> space+ | otherwise = breakOrSpace <> txt "|" <> space++ keepTogether+ | lineHaddocks || not singleRecCon = align+ | otherwise = id++ alternatives =+ sepBy separator (map (keepTogether . at_ ctx (conDecl ctx singleRecCon)) cons)++ derivings =+ includeUnless (null dd_derivs) beforeDerivings+ <> indent (vsep (map (at_ ctx (derivingClause ctx)) dd_derivs))+ beforeDerivings+ | length dd_derivs > 1 = hardBreak+ | otherwise = breakOrSpace++-- | The documentation a constructor's own layout has to make room for.+--+-- Which is its Haddock and the ones on its prefix arguments, and nothing+-- deeper. A field of a record gets a line of its own wherever the @=@ ends+-- up, so a Haddock on one of those settles nothing about the constructor+-- around it and is left out of the question.+visibleDocs :: ConDecl GhcPs -> [LHsDoc GhcPs]+visibleDocs = \case+ ConDeclH98 {..} ->+ maybeToList con_doc <> case con_args of+ PrefixCon xs -> mapMaybe cdf_doc xs+ _ -> []+ ConDeclGADT {} -> []++isGadtCon :: ConDecl GhcPs -> Bool+isGadtCon = \case+ ConDeclGADT {} -> True+ ConDeclH98 {} -> False++----------------------------------------------------------------------------+-- Constructors++-- | One constructor.+conDecl :: Ctx -> Bool -> ConDecl GhcPs -> Doc+conDecl ctx _ ConDeclGADT {..} =+ foldMap (haddock ctx Pipe Closed) con_doc+ <> layoutFrom ctx declSpan (brokenIfDocumented ctx documented body)+ where+ -- Every part of the signature shares one layout decision, so a Haddock+ -- anywhere in it puts the whole of it on several lines.+ documented = (con_g_args, con_res_ty)++ c :| cs = con_names+ body =+ name ctx c+ <> includeUnless+ (null cs)+ (indent (comma <> breakOrSpace <> commaSep (map (name ctx) cs)))+ <> joinedBy "::"+ <> indent (layoutFrom ctx sigSpan (brokenIfDocumented ctx documented signature))++ signature =+ outerBndrs ctx (unLoc con_outer_bndrs)+ <> ( case unLoc con_outer_bndrs of+ HsOuterImplicit {} -> mempty+ HsOuterExplicit {} -> breakOrSpace+ )+ <> foldMap (\tele -> forallTelescope ctx tele <> breakOrSpace) con_inner_bndrs+ <> foldMap+ (\qs -> context ctx qs <> joinedBy "=>")+ con_mb_cxt+ <> layoutFrom ctx argResSpan (brokenIfDocumented ctx documented argsAndResult)++ 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.+ resultType = case unLoc con_res_ty of+ HsKindSig {} -> parens (hsType ctx con_res_ty)+ HsForAllTy {} | standsAlone -> parens (hsType ctx con_res_ty)+ HsQualTy {} | standsAlone -> parens (hsType ctx con_res_ty)+ _ -> hsType ctx con_res_ty+ standsAlone = case (unLoc con_outer_bndrs, con_g_args) of+ (HsOuterImplicit {}, PrefixConGADT _ []) ->+ null con_inner_bndrs && null con_mb_cxt+ _ -> False+ arguments = case con_g_args of+ PrefixConGADT NoExtField xs -> foldMap argument xs+ RecConGADT _ x ->+ recordFieldsAt ctx x <> joinedBy "->"+ argument x =+ documentedConDeclField ctx x+ <> space+ <> multiplicity (hsType ctx) (cdf_multiplicity x)+ <> joinedBy "->"++ declSpan = spansOf (NE.toList con_names) <> sigSpan+ sigSpan = spanOf con_outer_bndrs <> foldMap spanOf con_mb_cxt <> argResSpan+ argResSpan =+ spanOf con_res_ty <> case con_g_args of+ PrefixConGADT NoExtField xs -> spansOf (map cdf_type xs)+ RecConGADT _ x -> spanOf x+conDecl ctx singleRecCon ConDeclH98 {..} = case con_args of+ PrefixCon xs ->+ ownDoc+ <> existentials+ <> layoutFrom+ ctx+ declSpan+ ( brokenIfDocumented ctx xs $+ name ctx con_name+ <> includeUnless (null xs) breakOrSpace+ <> indent (align (sepBy breakOrSpace (map (align . documentedConDeclField ctx) xs)))+ )+ RecCon l ->+ ownDoc+ <> existentials+ <> layoutFrom+ ctx+ declSpan+ ( name ctx con_name+ <> breakOrSpace+ <> nest (if singleRecCon then 0 else 1) (recordFieldsAt ctx l)+ )+ InfixCon l r ->+ -- The constructor's own Haddock can only go above the whole constructor+ -- when neither argument has one of its own; otherwise it goes between+ -- them, next to the name.+ includeWhen docOnTop ownDoc+ <> existentials+ <> layoutFrom+ ctx+ declSpan+ ( leftArgument l+ <> indent+ ( includeUnless docOnTop ownDoc+ <> name ctx con_name+ <> rightDoc r+ <> conDeclField ctx r+ )+ )+ where+ docOnTop = isNothing (cdf_doc l) && isNothing (cdf_doc r)+ -- The left argument's Haddock may use pipe style only when the+ -- constructor itself is documented, since otherwise there is nothing+ -- above it for the pipe to point at.+ leftArgument x+ | isJust con_doc =+ foldMap (haddock ctx Pipe Closed) (cdf_doc x)+ <> conDeclField ctx x+ <> breakOrSpace+ | otherwise =+ conDeclField ctx x+ <> case cdf_doc x of+ Just d -> space <> haddock ctx Caret Closed d+ Nothing -> breakOrSpace+ rightDoc x = case cdf_doc x of+ Just d -> hardBreak <> haddock ctx Pipe Closed d+ Nothing -> breakOrSpace+ where+ ownDoc = foldMap (haddock ctx Pipe Closed) con_doc++ existentials =+ layoutFrom ctx contextSpan $+ includeWhen+ con_forall+ (forallBndrs ctx Invisible (tyVarBndr ctx) con_ex_tvs <> breakOrSpace)+ <> foldMap (leftContext ctx) con_mb_cxt++ contextSpan =+ spanOfSrcSpan (getHasLoc (acdh_forall con_ext))+ <> spansOf con_ex_tvs+ <> foldMap spanOf con_mb_cxt+ <> spanOf con_name++ declSpan = spanOf con_name <> argSpans+ argSpans = case con_args of+ PrefixCon xs -> spansOf (map cdf_type xs)+ RecCon l -> spanOf l+ InfixCon x y -> spansOf (map cdf_type [x, y])++-- | A context standing to the left of a @=>@, with the arrow and the break+-- after it.+leftContext :: Ctx -> LHsContext GhcPs -> Doc+leftContext ctx = \case+ L _ [] -> mempty+ ctxt -> context ctx ctxt <> joinedBy "=>"++----------------------------------------------------------------------------+-- Deriving clauses++derivingClause :: Ctx -> HsDerivingClause GhcPs -> Doc+derivingClause ctx HsDerivingClause {..} =+ brokenIfDocumented ctx deriv_clause_tys $+ txt "deriving" <> space <> strategy+ where+ what =+ at ctx deriv_clause_tys $ \tys ->+ brokenIfDocumented ctx tys $ case tys of+ DctSingle NoExtField sigTy -> parens (hsSigType ctx sigTy)+ DctMulti NoExtField sigTys ->+ parens (commaSep (map (align . hsSigType ctx) sigTys))++ strategy = case deriv_clause_strategy of+ Nothing -> breakOrSpace <> indent what+ Just (L _ s) -> case s of+ StockStrategy _ -> named "stock"+ AnyclassStrategy _ -> named "anyclass"+ NewtypeStrategy _ -> named "newtype"+ ViaStrategy (XViaStrategyPs _ sigTy) ->+ breakOrSpace+ <> indent+ ( what+ <> breakOrSpace+ <> txt "via"+ <> space+ <> hsSigType ctx sigTy+ )+ where+ named kw = txt kw <> breakOrSpace <> indent what++----------------------------------------------------------------------------+-- Type synonyms++-- | @type T a = …@.+synDecl ::+ Ctx ->+ LocatedN RdrName ->+ LexicalFixity ->+ LHsQTyVars GhcPs ->+ LHsType GhcPs ->+ Doc+synDecl ctx tyCon fixity HsQTvs {..} rhs =+ txt "type"+ <> space+ <> layoutFrom+ ctx+ (spanOf tyCon <> spansOf hsq_explicit)+ (defHead (fixity == Infix) True (name ctx tyCon) (map (at_ ctx (tyVarBndr ctx)) hsq_explicit))+ <> indent (space <> txt "=" <> separator <> hsType ctx rhs)+ where+ separator+ | typeIsDocumented (unLoc rhs) = hardBreak+ | otherwise = breakOrSpace
+ src/Tilia/Render/Declaration.hs view
@@ -0,0 +1,394 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Declarations: dispatching to the right printer, and grouping.+--+-- Two jobs live here. The first is a case over every kind of declaration,+-- which is mostly a matter of handing the work on; the few forms with no+-- module of their own—foreign imports, annotations, @default@ declarations,+-- top-level splices—are printed here rather than in four files of a dozen+-- lines each.+--+-- The second is grouping, which is the interesting one. A blank line between+-- declarations is meaningful to a reader, so a signature and the function it+-- describes should stay together while unrelated declarations are kept+-- apart. Nothing in the syntax tree says which declarations belong together,+-- so it is worked out from what they are and what they name.+module Tilia.Render.Declaration+ ( decls,+ declsKeepingGroups,+ )+where++import Data.List (sort)+import Data.List.NonEmpty (NonEmpty (..), (<|))+import Data.List.NonEmpty qualified as NE+import GHC.Data.FastString (unpackFS)+import GHC.Hs+import GHC.Types.ForeignCall (CExportSpec (..))+import GHC.Types.Name.Occurrence (occNameFS)+import GHC.Types.Name.Reader (RdrName, rdrNameOcc)+import GHC.Types.SourceText+import GHC.Types.SrcLoc (GenLocated (..), isGoodSrcSpan, unLoc)+import Tilia.Doc.Combinators+import Tilia.Render.Class+import Tilia.Render.Context+import Tilia.Render.Data+import Tilia.Render.Expression+import Tilia.Render.Haddock+import Tilia.Render.Layout+import Tilia.Render.Literal (stringLiteral)+import Tilia.Render.Name+import Tilia.Render.Pragma+import Tilia.Render.Signature+import Tilia.Render.Type+import Tilia.Span+import Tilia.Span.Ghc++----------------------------------------------------------------------------+-- Runs of declarations++-- | 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 that keeps the author's grouping.+--+-- Where the author ran declarations together we run them together too, and+-- where they left a blank line we leave one. The exception is documentation:+-- a documented declaration always gets air around it, since a Haddock that+-- butts up against the declaration above reads as belonging to that one.+declsKeepingGroups :: Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc+declsKeepingGroups = declRun Respect++-- | Whether the author's own blank lines are consulted.+data Grouping+ = Disregard+ | Respect+ deriving (Eq, Show)++declRun :: Grouping -> Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc+declRun grouping ctx style ds =+ items NoBrace $ case groups of+ [] -> []+ (firstGroup : rest) ->+ render firstGroup <> concat (zipWith withGap groups rest)+ where+ isSignatureFile = ctxSourceType ctx == SignatureSource+ groups = groupDecls ctx isSignatureFile ds+ render = NE.toList . fmap (at_ ctx (hsDecl ctx style))++ withGap previous current+ | separate previous current = breakOrSpace : render current+ | otherwise = render current++ separate previous current = case grouping of+ Disregard -> True+ Respect ->+ separatedByBlank ctx ended began+ || commentBetween ctx ended began+ || isDocumented previous+ || isDocumented current+ where+ ended = spanOf (NE.last previous)+ began = spanOf (NE.head current)++ isDocumented = any (isDocNext . unLoc)+ isDocNext = \case+ DocD _ (DocCommentNext _) -> True+ DocD _ (DocCommentPrev _) -> True+ _ -> False++-- | Gather declarations that belong together.+groupDecls :: Ctx -> Bool -> [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)]+groupDecls _ _ [] = []+groupDecls ctx isSignatureFile (d : ds)+ -- A Haddock documenting what follows belongs to the group that follows,+ -- not to a group of its own—unless what follows is another Haddock, which+ -- documents nothing either. Those two have to be kept apart: run+ -- together they are not two doc comments but one.+ | isDocNext (unLoc d) = case groupDecls ctx isSignatureFile ds of+ [] -> [d :| []]+ (g : gs)+ | isDoc (unLoc (NE.head g)) -> (d :| []) : g : gs+ | otherwise -> (d <| g) : gs+ | otherwise =+ let (together, rest) = span belongs (zip (d : ds) ds)+ in (d :| map snd together) : groupDecls ctx isSignatureFile (map snd rest)+ where+ isDocNext = \case+ DocD _ (DocCommentNext _) -> True+ _ -> False+ isDoc = \case+ DocD _ _ -> True+ _ -> False+ belongs (previous, current) =+ (not isSignatureFile && isSignatureSeries ctx previous current)+ || isDerivingSeries ctx previous current+ || relatedDecls d current+ || relatedDecls previous current++-- | A run of type signatures with nothing between them is a list, and a+-- list reads better without gaps in it.+isSignatureSeries :: Ctx -> LHsDecl GhcPs -> LHsDecl GhcPs -> Bool+isSignatureSeries ctx x@(L _ a) y@(L _ b) = case (a, b) of+ (SigD _ TypeSig {}, SigD _ TypeSig {}) ->+ not (commentBetween 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))+ _ -> False++----------------------------------------------------------------------------+-- What a declaration is about++-- | The kinds of declaration that grouping distinguishes.+--+-- Anything not named here groups with nothing, which is the right default:+-- an unrecognised declaration standing on its own is merely a missed+-- opportunity, whereas one wrongly attached to its neighbour is a mistake.+data Kind+ = TypeSignature+ | DefaultSignature+ | FunctionBody+ | PatternSignature+ | PatternDefinition+ | DataDeclaration+ | ClassDeclaration+ | KindSignature+ | FamilyDeclaration+ | TypeSynonym+ | PragmaDeclaration+ | TopLevelSplice+ | DocumentsNext+ | DocumentsPrevious+ | Unremarkable+ deriving (Eq, Show)++-- | What a declaration is, and what it names.+declKind :: HsDecl GhcPs -> (Kind, [RdrName])+declKind = \case+ SigD _ (TypeSig _ ns _) -> (TypeSignature, map unLoc ns)+ SigD _ (ClassOpSig _ True ns _) -> (DefaultSignature, map unLoc ns)+ SigD _ (ClassOpSig _ False ns _) -> (TypeSignature, map unLoc ns)+ SigD _ (PatSynSig _ ns _) -> (PatternSignature, map unLoc ns)+ SigD _ (InlineSig _ (L _ n) _) -> (PragmaDeclaration, [n])+ SigD _ (SCCFunSig _ (L _ n) _) -> (PragmaDeclaration, [n])+ SigD _ sig+ | Just n <- specialisedName sig -> (PragmaDeclaration, [n])+ ValD _ (FunBind _ (L _ n) _) -> (FunctionBody, [n])+ ValD _ (PatBind _ p _ _) -> (FunctionBody, boundNames p)+ ValD _ (PatSynBind _ (PSB _ (L _ n) _ _ _)) -> (PatternDefinition, [n])+ AnnD _ (HsAnnotation _ (ValueAnnProvenance (L _ n)) _) -> (PragmaDeclaration, [n])+ AnnD _ (HsAnnotation _ (TypeAnnProvenance (L _ n)) _) -> (PragmaDeclaration, [n])+ WarningD _ (Warnings _ ws) ->+ (PragmaDeclaration, [unLoc n | L _ (Warning _ ns _) <- ws, n <- ns])+ TyClD _ (DataDecl _ (L _ n) _ _ _) -> (DataDeclaration, [n])+ TyClD _ (ClassDecl {tcdLName = L _ n}) -> (ClassDeclaration, [n])+ 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+ -- Splices name nothing, so the only evidence they belong together is that+ -- the author wrote them together.+ (TopLevelSplice, TopLevelSplice) -> not (blankBetween (spanOf a) (spanOf b))+ pair | pair `elem` relatedKinds -> shareAName namesA namesB+ _ -> False+ where+ (kindA, namesA) = declKind (unLoc a)+ (kindB, namesB) = declKind (unLoc b)++-- | The pairs of declaration kinds that group when they name something in+-- common.+--+-- Reading this as a list rather than as nested cases is the point: what+-- belongs with what is a policy, and a policy is easier to check when it is+-- written out.+relatedKinds :: [(Kind, Kind)]+relatedKinds =+ [ (TypeSignature, FunctionBody),+ (TypeSignature, DefaultSignature),+ (DefaultSignature, TypeSignature),+ (DefaultSignature, FunctionBody),+ (TypeSignature, PragmaDeclaration),+ (PragmaDeclaration, TypeSignature),+ (PragmaDeclaration, FunctionBody),+ (FunctionBody, PragmaDeclaration),+ (PragmaDeclaration, DataDeclaration),+ (DataDeclaration, PragmaDeclaration),+ (PragmaDeclaration, PragmaDeclaration),+ (PatternSignature, PatternDefinition),+ (KindSignature, DataDeclaration),+ (KindSignature, ClassDeclaration),+ (KindSignature, FamilyDeclaration),+ (KindSignature, TypeSynonym)+ ]++-- | Do the two declarations name anything in common?+--+-- Names are compared as text rather than as parsed names, since a pragma+-- may name a constructor where the declaration names the type, and the two+-- are different parsed names for the same spelling.+shareAName :: [RdrName] -> [RdrName] -> Bool+shareAName xs ys = overlaps (sort (map spelling xs)) (sort (map spelling ys))+ where+ spelling :: RdrName -> String+ spelling = unpackFS . occNameFS . rdrNameOcc+ overlaps (a : as) (b : bs)+ | a < b = overlaps as (b : bs)+ | a > b = overlaps (a : as) bs+ | otherwise = True+ overlaps _ _ = False++----------------------------------------------------------------------------+-- One declaration++-- | Print one declaration.+hsDecl :: Ctx -> FamilyStyle -> HsDecl GhcPs -> Doc+hsDecl ctx style = \case+ TyClD _ x -> tyClDecl ctx style x+ ValD _ x -> valDecl ctx NoBrace x+ SigD _ x -> sigDecl ctx x+ InstD _ x -> instDecl ctx style x+ DerivD _ x -> standaloneDerivDecl ctx x+ DefD _ x -> defaultDecl ctx x+ ForD _ x -> foreignDecl ctx x+ WarningD _ x -> warnDecls ctx x+ AnnD _ x -> annDecl ctx x+ RuleD _ x -> ruleDecls ctx x+ SpliceD _ (SpliceDecl NoExtField splice deco) ->+ at ctx splice (untypedSplice ctx deco)+ RoleAnnotD _ x -> roleAnnot ctx x+ KindSigD _ x -> standaloneKindSig ctx x+ DocD _ x -> case x of+ DocCommentNext str -> haddock ctx Pipe Open str+ DocCommentPrev str -> haddock ctx Caret Open str+ DocCommentNamed n str -> haddock ctx (Chunk n) Open str+ DocGroup n str -> haddock ctx (Section n) Open str++tyClDecl :: Ctx -> FamilyStyle -> TyClDecl GhcPs -> Doc+tyClDecl ctx style = \case+ FamDecl _ x -> famDecl ctx style x+ SynDecl {..} -> synDecl ctx tcdLName tcdFixity tcdTyVars tcdRhs+ DataDecl {..} ->+ dataDecl+ ctx+ Associated+ tcdLName+ (hsq_explicit tcdTyVars)+ spanOf+ (at_ ctx (tyVarBndr ctx))+ tcdFixity+ mempty+ tcdDataDefn+ ClassDecl {tcdCExt = (anns, _, _), ..} ->+ classDecl+ ctx+ anns+ tcdCtxt+ tcdLName+ tcdTyVars+ tcdFixity+ tcdFDs+ tcdSigs+ tcdMeths+ tcdATs+ tcdATDefs+ tcdDocs++instDecl :: Ctx -> FamilyStyle -> InstDecl GhcPs -> Doc+instDecl ctx style = \case+ ClsInstD _ x -> clsInstDecl ctx x+ TyFamInstD _ x -> tyFamInstDecl ctx style x+ DataFamInstD _ x -> dataFamInstDecl ctx style x++----------------------------------------------------------------------------+-- The declarations with nowhere else to live++-- | A @default@ declaration.+defaultDecl :: Ctx -> DefaultDecl GhcPs -> Doc+defaultDecl ctx (DefaultDecl _ className types) =+ txt "default"+ <> foldMap (\c -> breakOrSpace <> name ctx c) className+ <> breakOrSpace+ <> indent (parens (commaSep (map (align . hsType ctx) types)))++-- | An @ANN@ pragma.+annDecl :: Ctx -> AnnDecl GhcPs -> Doc+annDecl ctx (HsAnnotation _ provenance e) =+ pragma "ANN" . indent $+ subject <> breakOrSpace <> hsExpr ctx e+ where+ subject = case provenance of+ ValueAnnProvenance n -> name ctx n+ TypeAnnProvenance n -> txt "type" <> space <> name ctx n+ ModuleAnnProvenance -> txt "module"++-- | A foreign import or export.+foreignDecl :: Ctx -> ForeignDecl GhcPs -> Doc+foreignDecl ctx = \case+ fd@ForeignImport {fd_fi} -> foreignImport ctx fd_fi <> foreignSig ctx fd+ fd@ForeignExport {fd_fe} -> foreignExport ctx fd_fe <> foreignSig ctx fd++-- | The name and type that end a foreign declaration.+foreignSig :: Ctx -> ForeignDecl GhcPs -> Doc+foreignSig ctx fd =+ breakOrSpace+ <> indent+ ( layoutFrom ctx (spanOf (fd_name fd) <> spanOf (fd_sig_ty fd)) $+ name ctx (fd_name fd) <> typeAscription ctx (fd_sig_ty fd)+ )++-- | The head of a foreign import.+foreignImport :: Ctx -> ForeignImport GhcPs -> Doc+foreignImport ctx (CImport src callConv safety _ _) =+ txt "foreign import"+ <> space+ <> at ctx callConv outputable+ <> includeWhen (isGoodSrcSpan (getLocA safety)) (space <> outputable safety)+ <> indent+ ( at ctx src $ \case+ NoSourceText -> mempty+ SourceText lit -> breakOrSpace <> stringLiteral lit+ )++foreignExport :: Ctx -> ForeignExport GhcPs -> Doc+foreignExport ctx (CExport src (L loc (CExportStatic _ _ callConv))) =+ txt "foreign export"+ <> space+ <> at ctx (L loc callConv) outputable+ <> space+ <> at ctx src sourceText
+ src/Tilia/Render/Expression.hs view
@@ -0,0 +1,1328 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++-- | Expressions, and the equations and blocks built out of them.+--+-- These are together because they are genuinely one thing: an equation is a+-- pattern and an expression, a @do@ block is a run of expressions, and a+-- @where@ clause is a run of equations. Splitting them would only move the+-- recursion into a knot without making either half easier to read.+--+-- The recurring question here is /placement/: whether a body begins on the+-- line that introduces it or on the next one, indented. Some expressions+-- have a hanging form—a @do@ block, a @case@, a lambda—and can absorb the+-- line break themselves, which is why @f = do@ reads better than @f =@ with+-- @do@ alone on the line below. Everything else has to be pushed down.+-- 'Placement' is the answer, and most of what looks like special-casing+-- below is working out which one applies.+module Tilia.Render.Expression+ ( -- * Expressions+ hsExpr,+ hsExprIn,+ hsCmd,++ -- * Bindings+ valDecl,+ MatchStyle (..),+ GuardStyle (..),++ -- * Splices+ untypedSplice,+ )+where++import Data.Function (on)+import Data.Generics.Schemes (listify)+import Data.List (sortBy, unsnoc)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Data.FastString (unpackFS)+import GHC.Hs hiding (Fixity)+import GHC.LanguageExtensions.Type (Extension (..))+import GHC.Types.Basic (Boxity (..))+import GHC.Types.Fixity (LexicalFixity (..))+import GHC.Types.Name.Occurrence (isVarOcc)+import GHC.Types.Name.Reader (RdrName, mkVarUnqual, rdrNameOcc)+import GHC.Types.SourceText+import GHC.Types.SrcLoc+ ( GenLocated (..),+ isZeroWidthSpan,+ leftmost_smallest,+ noSrcSpan,+ unLoc,+ )+import Language.Haskell.Syntax.Basic (field_label)+import Tilia.Doc.Body+import Tilia.Doc.Combinators+import Tilia.Fixity+ ( Fixity,+ Namespace (..),+ )+import Tilia.Render.Body+import Tilia.Render.Context+import Tilia.Render.Layout+import Tilia.Render.Literal (stringLiteral)+import Tilia.Render.Name+import Tilia.Render.Operator+import Tilia.Render.Pattern+import Tilia.Render.Type+import Tilia.Span+import Tilia.Span.Ghc++----------------------------------------------------------------------------+-- Bracing++-- | Let a block brace itself when the surrounding layout is flat.+--+-- Whether braces are wanted is a question about the layout, and the layout+-- is not known while the document is being built. Both answers are prepared+-- and the engine picks; the one it does not pick is never forced.+whenFlat :: Bracing -> (Bracing -> Doc) -> Doc+whenFlat whenBroken render = variant (render MayBrace) (render whenBroken)++-- | A @case@ or lambda standing as a block item has to delimit itself when+-- the block is flat, unless it is the function of an application, where the+-- argument that follows already does so.+bracedForSite :: Site -> (Bracing -> Doc) -> Doc+bracedForSite site render+ | siteInBlock site && not (siteApplicand site) = whenFlat (siteBracing site) render+ | otherwise = render (siteBracing site)++----------------------------------------------------------------------------+-- Expressions++-- | An expression.+hsExpr :: Ctx -> LHsExpr GhcPs -> Doc+hsExpr ctx = hsExprIn ctx plainSite++-- | An expression that knows where it stands.+hsExprIn :: Ctx -> Site -> LHsExpr GhcPs -> Doc+hsExprIn ctx site l = at ctx l (exprBody ctx site (spanOf l))++-- | The body of an equation, as the enclosing construct will hand it on.+--+-- Neither the site nor the placement is known when the body is passed in:+-- the site depends on the layout the group of equations settles on, and the+-- placement is the body's own business. So what travels is a way of making+-- a body from a site, and 'Tilia.Doc.Body.Body' answers the rest.+type BodyOf body b = Site -> LocatedA body -> b++-- | A body standing on its own, with the given bracing.+bodyIn :: BodyOf body b -> Bracing -> LocatedA body -> b+bodyIn mkBody bracing = mkBody (withBracing bracing plainSite)++exprBody :: Ctx -> Site -> Maybe Span -> HsExpr GhcPs -> Doc+exprBody ctx site here = \case+ HsVar _ n -> name ctx n+ 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+ HsLam _ variant' mg -> lambda ctx site variant' (ExprBody ctx) mg+ HsApp _ f x -> application ctx site f x+ HsAppType at' e a ->+ hsExpr ctx e+ <> breakOrSpace+ <> indent+ ( atSpan+ ctx+ (tokenSpan at' <> spanOf (hswc_body a))+ (txt "@" <> hsTypeBody ctx (spanOf (hswc_body a)) (unLoc (hswc_body a)))+ )+ OpApp _ x op y -> exprChain ctx site x op y+ NegApp _ e _ -> txt "-" <> negationGap ctx e <> hsExpr ctx e+ HsPar _ e ->+ layoutWithin ctx here (spanOf e) $+ parensWith (closingFor site) (insideBrackets here (hsExpr ctx e))+ SectionL _ x op -> hsExpr ctx x <> breakOrSpace <> indent (hsExpr ctx op)+ SectionR _ op x -> hsExpr ctx op <> breakOrSpace <> indent (hsExpr ctx x)+ ExplicitTuple _ args boxity -> tuple ctx here (closingFor site) boxity args+ ExplicitSum _ tag arity e -> unboxedSum (closingFor site) tag arity (hsExpr ctx e)+ HsCase _ e mg -> caseOf ctx site (ExprBody ctx) e mg+ HsIf anns c t e -> ifThenElse ctx (bodyIn (ExprBody ctx) (siteBracing site)) anns c t e+ HsMultiIf _ guards ->+ txt "if"+ <> breakOrSpace+ <> underSite site (sepBy breakOrSpace (map alternative (NE.toList guards)))+ where+ alternative g =+ atSpan+ ctx+ (grhsSpan (unLoc g))+ (guardedRhs ctx Normal (siteBracing site) (ExprBody ctx) RightArrow (unLoc g))+ HsLet _ binds e -> letIn ctx (bodyIn (ExprBody ctx) (siteBracing site)) binds e+ HsDo anns flavour es -> case flavour of+ DoExpr moduleName -> doBlock moduleName "do"+ MDoExpr moduleName -> doBlock moduleName "mdo"+ ListComp -> comprehension ctx site es+ MonadComp -> comprehension ctx site es+ GhciStmtCtxt -> error "Tilia: GhciStmtCtxt cannot occur in a source file"+ where+ doBlock moduleName word =+ foldMap (\m -> outputable m <> txt ".") moduleName+ <> keywordAt ctx (doKeywordSpan anns) word+ <> statements ctx site (ExprBody ctx) es+ ExplicitList _ xs ->+ bracketsWith+ (closingFor site)+ (insideBrackets here (commaSep (map (align . hsExpr ctx) xs)))+ RecordCon {..} ->+ name ctx rcon_con+ <> breakOrSpace+ <> indent (braces (insideBrackets here (commaSep (map align (fields <> wildcard)))))+ where+ HsRecFields {..} = rcon_flds+ fields = map (at_ ctx (fieldBind ctx (at_ ctx (name ctx . foLabel)))) rec_flds+ -- The @..@ has a location of its own, and needs it: a comment written+ -- against it has nothing else to attach to.+ wildcard = case rec_dotdot of+ Just l -> [at ctx l (const (txt ".."))]+ Nothing -> []+ RecordUpd {..} ->+ hsExpr ctx rupd_expr <> breakOrSpace <> indent (braces (insideBrackets here updates))+ where+ updates = case rupd_flds of+ RegularRecUpdFields {..} ->+ commaSep (map (align . at_ ctx (fieldBind ctx (at_ ctx (fieldOcc ctx)))) recUpdFields)+ OverloadedRecUpdFields {..} ->+ commaSep (map (align . at_ ctx (fieldBind ctx (at_ ctx labelChain))) olRecUpdFields)+ labelChain (FieldLabelStrings flss) = dotFields ctx (unLoc <$> flss)+ HsGetField {..} ->+ hsExpr ctx gf_expr <> txt "." <> at ctx gf_field (dotField ctx)+ HsProjection {..} -> parens (txt "." <> dotFields ctx proj_flds)+ ExprWithTySig _ x HsWC {hswc_body} ->+ align $+ hsExpr ctx x+ <> joinedBy "::"+ <> indent (hsSigType ctx hswc_body)+ ArithSeq _ _ range -> arithSeq ctx (closingFor site) range+ HsTypedBracket (bracketAnn, _) e ->+ txt opener <> breakOrNothing <> hsExpr ctx e <> breakOrNothing <> txt "||]"+ where+ -- @[e|| … ||]@ and @[|| … ||]@ are the same bracket written two ways,+ -- and which one the author reached for is theirs to keep.+ opener = case bracketAnn of+ BracketNoE {} -> "[||"+ BracketHasE {} -> "[e||"+ HsUntypedBracket _ q -> quotation ctx q+ HsTypedSplice _ (HsTypedSpliceExpr _ e) -> spliceTH ctx True e DollarSplice+ HsUntypedSplice _ splice -> untypedSplice ctx DollarSplice splice+ HsProc _ p e ->+ txt "proc"+ <> layoutFrom ctx (spanOf p) (breakOrSpace <> indent (hsPat ctx p) <> breakOrSpace)+ <> txt "->"+ <> attachBody (CmdTopBody ctx plainSite e)+ HsStatic _ e -> txt "static" <> breakOrSpace <> indent (hsExpr ctx e)+ HsPragE _ prag x -> case prag of+ HsPragSCC _ n ->+ txt "{-# SCC "+ <> outputable n+ <> txt " #-}"+ <> breakOrSpace+ <> nest (if siteInBlock site then 1 else 0) (hsExpr ctx x)+ HsEmbTy _ HsWC {hswc_body} -> txt "type" <> space <> hsType ctx hswc_body+ HsHole holeKind -> case holeKind of+ HoleVar n -> name ctx n+ HoleError -> error "Tilia: a nameless hole cannot come from a successful parse"+ -- The three that follow mirror their counterparts in types: a quoted+ -- signature is an expression until it is elaborated.+ HsForAll _ tele e -> forallTelescope ctx tele <> breakOrSpace <> hsExpr ctx e+ HsQual _ qs e ->+ at ctx qs (contextOf loneVariableExpr (hsExpr ctx) . map unbracketed)+ <> joinedBy "=>"+ <> hsExpr ctx e+ HsFunArr _ multAnn x y ->+ hsExpr ctx x+ <> space+ <> multiplicity (hsExpr ctx) multAnn+ <> joinedBy "->"+ <> case unLoc y of+ HsFunArr {} -> exprBody ctx plainSite (spanOf y) (unLoc y)+ _ -> hsExpr ctx y++-- | @-@ in front of a literal needs a space when @NegativeLiterals@ is on,+-- since @- 1@ and @-1@ then parse differently.+negationGap :: Ctx -> LHsExpr GhcPs -> Doc+negationGap ctx e = includeWhen (extensionOn ctx NegativeLiterals && isLiteral) space+ where+ isLiteral = case unLoc e of+ HsLit {} -> True+ HsOverLit {} -> True+ _ -> False++-- | A function applied to arguments.+--+-- The last argument is held apart from the rest because it is the only one+-- that may hang: @f x $ do …@ puts the block after the arguments rather than+-- indenting everything under @f@. It may only hang when the function and the+-- earlier arguments fit on one line, since otherwise there is nothing left+-- of that line for it to hang from.+application :: Ctx -> Site -> LHsExpr GhcPs -> LHsExpr GhcPs -> Doc+application ctx site f x =+ case placement of+ Normal ->+ whenFlat (siteBracing site) headAndInit+ <> indent (includeUnless (null initArgs) breakOrSpace <> hsExpr ctx lastArg)+ Hanging ->+ layoutFrom ctx initSpan (headAndInit MayBrace)+ <> attach Hanging (hsExpr ctx lastArg)+ where+ (func, args) = gatherArgs f (x :| [])+ initArgs = NE.init args+ lastArg = NE.last args+ initSpan = spanOf f <> (startOf <$> spanOf lastArg)+ placement+ | maybe False isSingleLine initSpan = exprHangs (unLoc lastArg)+ | otherwise = Normal+ headAndInit bracing =+ hsExprIn ctx site {siteApplicand = True, siteBracing = bracing} func+ <> breakOrSpace+ <> nest+ (if placement == Hanging then 0 else 1)+ (sepBy breakOrSpace (map (hsExprIn ctx (withBracing bracing plainSite)) initArgs))++gatherArgs ::+ LHsExpr GhcPs ->+ NonEmpty (LHsExpr GhcPs) ->+ (LHsExpr GhcPs, NonEmpty (LHsExpr GhcPs))+gatherArgs f known = case unLoc f of+ HsApp _ l r -> gatherArgs l (NE.cons r known)+ _ -> (f, known)++-- | A tuple, or a tuple section.+--+-- A section has holes in it, and a hole cannot carry a line break, so a+-- section is laid out flat however it was written.+tuple :: Ctx -> Maybe Span -> ClosingIndent -> Boxity -> [HsTupArg GhcPs] -> Doc+tuple ctx here closing boxity args+ | any isMissing args = flat (brackets' (sepBy comma (map arg args)))+ | otherwise = brackets' (insideBrackets here (commaSep (map arg args)))+ where+ brackets' = case boxity of+ Boxed -> parensWith closing+ Unboxed -> unboxedWith closing+ isMissing = \case+ Missing _ -> True+ _ -> False+ arg =+ align . \case+ Present _ e -> hsExpr ctx e+ Missing _ -> mempty++-- | An arithmetic sequence, in whichever of its four forms.+arithSeq :: Ctx -> ClosingIndent -> ArithSeqInfo GhcPs -> Doc+arithSeq ctx closing = \case+ From from -> wrap (hsExpr ctx from <> breakOrSpace <> txt "..")+ FromThen from next ->+ wrap (commaSep (map (hsExpr ctx) [from, next]) <> breakOrSpace <> txt "..")+ FromTo from to ->+ wrap (hsExpr ctx from <> breakOrSpace <> txt ".." <> space <> hsExpr ctx to)+ FromThenTo from next to ->+ wrap $+ commaSep (map (hsExpr ctx) [from, next])+ <> breakOrSpace+ <> txt ".."+ <> space+ <> hsExpr ctx to+ where+ wrap = bracketsWith closing++-- | One field of a record construction or update.+fieldBind ::+ (HasLoc l) =>+ Ctx ->+ (GenLocated l a -> Doc) ->+ HsFieldBind (GenLocated l a) (LHsExpr GhcPs) ->+ Doc+fieldBind ctx label HsFieldBind {..} =+ label hfbLHS+ <> includeUnless hfbPun (space <> txt "=" <> attach placement (hsExpr ctx hfbRHS))+ where+ placement+ | sameLine (spanOf hfbLHS) (spanOf hfbRHS) = exprHangs (unLoc hfbRHS)+ | otherwise = Normal++dotField :: Ctx -> DotFieldOcc GhcPs -> Doc+dotField ctx = name ctx . fmap (mkVarUnqual . field_label) . dfoLabel++dotFields :: Ctx -> NonEmpty (DotFieldOcc GhcPs) -> Doc+dotFields ctx = sepBy (txt ".") . map (dotField ctx) . NE.toList++----------------------------------------------------------------------------+-- Operator chains++-- | A chain of operators applied to expressions.+--+-- Two layouts are possible once such a chain has to break. The leading one+-- puts each operator at the start of a line with its operand:+--+-- > foo+-- > <> bar+-- > <> baz+--+-- The trailing one leaves the operator at the end of the line above:+--+-- > foo $ do+-- > …+--+-- Trailing is only right when every operator is a separator+-- ('isSeparator') and the chain ends in something with a hanging form, or+-- when there is a single operator. Otherwise it builds a staircase of+-- ever-deeper indentation and gains nothing by it.+exprChain :: Ctx -> Site -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> Doc+exprChain ctx site x op y =+ renderExprChain ctx site (uncurry (associate (fixityOf ctx)) chain)+ where+ chain = flattenAround splitOpApp x op y++splitOpApp :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, LHsExpr GhcPs, LHsExpr GhcPs)+splitOpApp e = case unLoc e of+ OpApp _ l o r -> Just (l, o, r)+ _ -> Nothing++fixityOf :: Ctx -> LHsExpr GhcPs -> Maybe Fixity+fixityOf ctx o = operatorName o >>= operatorFixity ctx InTerms++renderExprChain :: Ctx -> Site -> OpChain (LHsExpr GhcPs) (LHsExpr GhcPs) -> Doc+renderExprChain ctx site = \case+ Operand e -> hsExprIn ctx site e+ chain@(Chain operands@(firstOne :| rest) operators) ->+ layoutFrom ctx (chainSpan spanOf chain) $+ if trailing+ then laidOut MayBrace+ else whenFlat (if placement == Hanging then MayBrace else NoBrace) laidOut+ where+ placement = chainPlacement exprHangs firstOne (NE.last operands)++ laidOut bracing =+ renderExprChain ctx (withBracing bracing site) firstOne+ <> pieces bracing firstOne operators rest++ pieces bracing previous (o : os) (operand : more) =+ let isLast = null more+ operandSite =+ withBracing (if isLast then siteBracing site else bracing) plainSite+ rendered = renderExprChain ctx operandSite operand+ rest' = pieces bracing operand os more+ in if trailing+ then space <> hsExpr ctx o <> attach (tailPlacement isLast previous operand) (rendered <> rest')+ else attach placement (hsExpr ctx o <> space <> rendered) <> rest'+ pieces _ _ _ _ = mempty++ -- In a staircase of trailing operators the operand at the very end is+ -- the one that may hang, since it is the block the whole chain exists+ -- to introduce.+ tailPlacement isLast previous operand+ | isLast,+ not (maybe True isSingleLine (chainSpan spanOf operand)) =+ chainPlacement exprHangs previous operand+ | otherwise = Normal++ -- A comment written on its own line in front of an operator would be+ -- carried to the end of the line above along with it, and a @$@ at the+ -- start of a line inside a @do@ block reads as a new statement rather+ -- than as a continuation. The leading layout indents instead, so it+ -- keeps the meaning.+ commentedOperators =+ or (zipWith commentedBefore (NE.toList operands) operators)+ commentedBefore operand o =+ commentBetween ctx (chainSpan spanOf operand) (spanOf o)++ trailing =+ (length operators == 1 || endsHanging)+ && not commentedOperators+ && and (zipWith couldTrail (NE.toList operands) operators)++ endsHanging = exprHangs (unLoc (lastOperand chain)) == Hanging++ couldTrail previous o =+ isSeparator (fixityOf ctx o)+ && maybe False isSingleLine (chainSpan spanOf previous)+ && placement == Normal+ -- An operator cannot trail a @do@ block: the block would swallow+ -- it and read it as part of its last statement.+ && not (isDoBlock (lastOperand previous))++isDoBlock :: LHsExpr GhcPs -> Bool+isDoBlock e = case unLoc e of+ HsDo _ (DoExpr _) _ -> True+ HsDo _ (MDoExpr _) _ -> True+ _ -> False++-- | Whether the operands of a chain hang.+--+-- They may when the first and the last operand begin on the same line—so+-- that there is a line for the last one to hang from—and the last operand is+-- itself something with a hanging form.+chainPlacement ::+ (HasLoc l) =>+ (a -> Placement) ->+ OpChain (GenLocated l a) op ->+ OpChain (GenLocated l a) op ->+ Placement+chainPlacement placer firstOne lastOne = case lastOne of+ Operand (L _ n) | startsTogether -> placer n+ _ -> Normal+ where+ startsTogether =+ case (chainSpan spanOf firstOne, chainSpan spanOf lastOne) of+ (Just a, Just b) -> spanStartLine a == spanStartLine b+ _ -> False++-- | Is this quoted constraint nothing but a variable?+loneVariableExpr :: LHsExpr GhcPs -> Bool+loneVariableExpr e = case unLoc e of+ HsVar _ (L _ n) -> isVarOcc (rdrNameOcc n)+ _ -> False++unbracketed :: LHsExpr GhcPs -> LHsExpr GhcPs+unbracketed e = case unLoc e of+ HsPar _ inner -> unbracketed inner+ _ -> e++----------------------------------------------------------------------------+-- Commands++-- | An arrow-notation command.+hsCmd :: Ctx -> Site -> LHsCmd GhcPs -> Doc+hsCmd ctx site l = at ctx l (cmdBody ctx site)++cmdBody :: Ctx -> Site -> HsCmd GhcPs -> Doc+cmdBody ctx site = \case+ -- Which of the two operands is written first is what the arrow's+ -- direction says: @a -< b@ feeds the input on the right to the command on+ -- the left, and @b >- a@ says the same thing the other way round.+ HsCmdArrApp _ body input arrow rightToLeft ->+ let writtenFirst = if rightToLeft then body else input+ writtenSecond = if rightToLeft then input else body+ in hsExprIn ctx site {siteApplicand = False} writtenFirst+ <> breakOrSpace+ <> indent+ ( txt (arrowText arrow rightToLeft)+ <> attach (exprHangs (unLoc input)) (hsExpr ctx writtenSecond)+ )+ HsCmdArrForm _ form Prefix cmds ->+ bananaWith (closingFor site) $+ hsExpr ctx form+ <> includeUnless+ (null cmds)+ (breakOrSpace <> indent (sepBy breakOrSpace (map (printBody . CmdTopBody ctx plainSite) cmds)))+ HsCmdArrForm _ form Infix [l, r] -> cmdChain ctx site l form r+ HsCmdArrForm _ _ Infix _ ->+ error "Tilia: an infix command form always has exactly two operands"+ HsCmdApp _ cmd e ->+ hsCmd ctx site {siteApplicand = True} cmd+ <> breakOrSpace+ <> indent (hsExpr ctx e)+ HsCmdLam _ variant' mg -> lambda ctx site variant' (CmdBody ctx) mg+ HsCmdPar _ c -> parens (hsCmd ctx plainSite c)+ HsCmdCase _ e mg -> caseOf ctx site (CmdBody ctx) e mg+ HsCmdIf anns _ c t e ->+ ifThenElse ctx (bodyIn (CmdBody ctx) (siteBracing site)) anns c t e+ HsCmdLet _ binds c -> letIn ctx (bodyIn (CmdBody ctx) (siteBracing site)) binds c+ HsCmdDo anns es ->+ keywordAt ctx (doKeywordSpan anns) "do"+ <> statements ctx site (CmdBody ctx) es++arrowText :: HsArrAppType -> Bool -> Text+arrowText arrow rightToLeft = case (arrow, rightToLeft) of+ (HsFirstOrderApp, True) -> "-<"+ (HsHigherOrderApp, True) -> "-<<"+ (HsFirstOrderApp, False) -> ">-"+ (HsHigherOrderApp, False) -> ">>-"++-- | A command at the top of an arrow form.+cmdTop :: Ctx -> Site -> HsCmdTop GhcPs -> Doc+cmdTop ctx site (HsCmdTop _ cmd) = hsCmd ctx site cmd++-- | A chain of operators applied to commands.+--+-- Commands have no trailing layout: an arrow form is already delimited, so+-- there is nothing for a trailing operator to introduce.+cmdChain ::+ Ctx ->+ Site ->+ LHsCmdTop GhcPs ->+ LHsExpr GhcPs ->+ LHsCmdTop GhcPs ->+ Doc+cmdChain ctx site l op r =+ render (uncurry (associate (fixityOf ctx)) (flattenAround splitCmd l op r))+ where+ splitCmd c = case unLoc c of+ HsCmdTop _ (L _ (HsCmdArrForm _ o Infix [a, b])) -> Just (a, o, b)+ _ -> Nothing++ render = \case+ Operand c -> at ctx c (cmdTop ctx site)+ chain@(Chain operands@(firstOne :| rest) operators) ->+ layoutFrom ctx (chainSpan spanOf chain) $+ whenFlat (if placement == Hanging then MayBrace else NoBrace) laidOut+ where+ placement = chainPlacement cmdTopHangs firstOne (NE.last operands)+ laidOut bracing =+ renderIn bracing firstOne <> pieces bracing operators rest+ -- Every operand but the last has to delimit itself when the chain+ -- is flat, or a block inside it would swallow the operator.+ pieces bracing (o : os) (operand : more) =+ attach+ placement+ (hsExpr ctx o <> space <> renderIn (if null more then siteBracing site else bracing) operand)+ <> pieces bracing os more+ pieces _ _ _ = mempty+ renderIn bracing = \case+ Operand c -> at ctx c (cmdTop ctx (withBracing bracing site))+ inner -> render inner++----------------------------------------------------------------------------+-- Statements++-- | A statement of a comprehension or a guard.+hsStmt :: Ctx -> ExprLStmt GhcPs -> Doc+hsStmt ctx = at_ ctx (stmtBody ctx plainSite (ExprBody ctx))++stmtBody ::+ ( Body b,+ Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW,+ Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA,+ Anno body ~ SrcSpanAnnA+ ) =>+ Ctx ->+ Site ->+ BodyOf body b ->+ Stmt GhcPs (XRec GhcPs body) ->+ Doc+stmtBody ctx site mkBody = \case+ LastStmt _ body _ _ -> printBody (mkBody site body)+ BodyStmt _ body _ _ -> printBody (mkBody site body)+ BindStmt _ p f ->+ hsPat ctx p+ -- Indented in case it does not stay on the line the pattern is on. A+ -- comment that owns its line ends it, and an arrow starting a line at+ -- the statement's own column would begin a new statement instead of+ -- continuing this one.+ <> nest 1 (space <> txt "<-")+ <> layoutFrom ctx (spanOf p <> spanOf f) (attach placement (printBody bound))+ where+ bound = mkBody plainSite f+ placement+ | sameLine (spanOf p) (spanOf f) = bodyPlacement bound+ | otherwise = Normal+ -- A @let@ opens a layout block of its own, so when something follows it+ -- in a flat block the semicolon meant to end the statement is taken for+ -- one separating two bindings, and the rest of the @do@ disappears into+ -- the @let@. The site already knows whether anything follows: it carries+ -- 'MayBrace' for every statement but the last.+ LetStmt _ binds -> txt "let" <> space <> align (bound binds)+ where+ -- @let@ with nothing after it is not a statement whatever the layout,+ -- so an empty group is written out rather than left to the bracing.+ bound = \case+ EmptyLocalBinds _ -> txt "{}"+ bs -> localBinds ctx (siteBracing site) bs+ ParStmt {} ->+ -- Parallel blocks are unpacked before any statement is printed; see+ -- 'comprehensionSections'.+ error "Tilia: ParStmt should have been unpacked"+ TransStmt {..} -> case (trS_form, trS_by) of+ (ThenForm, Nothing) ->+ txt "then" <> breakOrSpace <> indent (hsExpr ctx trS_using)+ (ThenForm, Just e) ->+ txt "then"+ <> breakOrSpace+ <> indent (hsExpr ctx trS_using)+ <> breakOrSpace+ <> txt "by"+ <> breakOrSpace+ <> indent (hsExpr ctx e)+ (GroupForm, Nothing) ->+ txt "then group using" <> breakOrSpace <> indent (hsExpr ctx trS_using)+ (GroupForm, Just e) ->+ txt "then group by"+ <> breakOrSpace+ <> indent (hsExpr ctx e)+ <> breakOrSpace+ <> txt "using"+ <> 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+ ]+ )++-- | The statements of a block, with the break that introduces them.+statements ::+ ( 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+statements ctx site mkBody es =+ breakOrSpace <> underSite site (at ctx es block)+ where+ block xs =+ items (siteBracing site) $+ keepBlanks (separatedByBlank ctx) [(spanOf stmt, item place stmt) | (place, stmt) <- places xs]++ -- Every statement but the last has to delimit itself when the block is+ -- flat, or a block nested inside it would run on into the next one.+ item place stmt = case place of+ Last -> rendered (siteBracing site)+ Only -> rendered (siteBracing site)+ _ -> whenFlat (siteBracing site) rendered+ where+ rendered bracing =+ at_ ctx (stmtBody ctx (blockSite bracing) mkBody) stmt++ blockSite bracing =+ plainSite {siteInBlock = True, siteBracing = bracing}++----------------------------------------------------------------------------+-- List comprehensions++-- | A list comprehension.+--+-- Standing as a statement of a @do@ block, the closing bracket has to line+-- up under the opening one: the block's own layout would otherwise end the+-- statement before the bracket was closed.+comprehension :: Ctx -> Site -> XRec GhcPs [ExprLStmt GhcPs] -> Doc+comprehension ctx site es = align (variant onOneLine acrossLines)+ where+ onOneLine = txt "[" <> body <> txt "]"+ acrossLines = txt "[" <> space <> keepInside (body <> hardBreak <> txt "]")+ keepInside = if siteInBlock site then align else id+ body = at ctx es sections+ sections xs = case unsnoc xs of+ Nothing -> error "Tilia: a comprehension always yields something"+ Just (stmts, yield) ->+ align (hsStmt ctx yield)+ <> breakOrSpace+ <> sepBy breakOrSpace (map section (comprehensionSections stmts))+ section stmts =+ located'+ (spansOf stmts)+ (txt "|" <> space <> align (commaSep (map (align . hsStmt ctx) stmts)))+ located' = maybe id located++-- | Split the statements of a comprehension into its parallel sections.+--+-- With @ParallelListComp@ a comprehension may have several runs of+-- statements separated by bars, and the parser wraps those in a single+-- statement holding blocks. Everywhere else there is exactly one run. Both+-- come back from here as a list of runs, so nothing downstream has to know+-- which it was given.+comprehensionSections :: [ExprLStmt GhcPs] -> [[ExprLStmt GhcPs]]+comprehensionSections = map unnest . branches+ where+ -- One run of statements, unless the comprehension was written with @|@+ -- between several, in which case each run is a section of its own.+ branches = \case+ [L _ (ParStmt _ blocks _ _)] ->+ [run | ParStmtBlock _ run _ _ <- NE.toList blocks]+ run -> [run]++ -- A @then@ carries the statements it transforms. They are printed, and+ -- then it is, in that order.+ unnest = concatMap $ \case+ L _ ParStmt {} -> error "Tilia: parallel blocks do not nest"+ stmt@(L _ TransStmt {trS_stmts}) -> unnest trS_stmts <> [stmt]+ stmt -> [stmt]++----------------------------------------------------------------------------+-- Case, lambda, if and let++-- | A @case@ expression or command.+caseOf ::+ ( Body b,+ Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,+ Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA+ ) =>+ Ctx ->+ Site ->+ BodyOf body b ->+ LHsExpr GhcPs ->+ MatchGroup GhcPs (LocatedA body) ->+ Doc+caseOf ctx site mkBody scrutinee mg =+ txt "case"+ <> space+ <> hsExpr ctx scrutinee+ <> joinedBy "of"+ <> bracedForSite site alternatives+ where+ alternatives b = underSite site (matchGroup ctx b mkBody CaseStyle mg)++-- | A lambda, in any of its three spellings.+lambda ::+ ( Body b,+ Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,+ Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA+ ) =>+ Ctx ->+ Site ->+ HsLamVariant ->+ BodyOf body b ->+ MatchGroup GhcPs (LocatedA body) ->+ Doc+lambda ctx site variant' mkBody mg = case keyword of+ Nothing -> matchGroup ctx (siteBracing site) mkBody LambdaStyle mg+ Just kw -> txt kw <> breakOrSpace <> bracedForSite site alternatives+ where+ alternatives b = underSite site (matchGroup ctx b mkBody LambdaCaseStyle mg)+ keyword = case variant' of+ LamSingle -> Nothing+ LamCase -> Just "\\case"+ LamCases -> Just "\\cases"++-- | An @if@ expression or command.+ifThenElse ::+ (Body b) =>+ Ctx ->+ (LocatedA body -> b) ->+ AnnsIf ->+ LHsExpr GhcPs ->+ LocatedA body ->+ LocatedA body ->+ Doc+ifThenElse ctx bodyOf AnnsIf {aiThen, aiElse} condition thenBody elseBody =+ txt "if"+ <> space+ <> hsExpr ctx condition+ <> breakOrSpace+ <> indent+ ( branch (locA aiThen) "then" thenBody+ <> breakOrSpace+ <> branch (locA aiElse) "else" elseBody+ )+ where+ branch written word body =+ keywordAt ctx keywordSpan word+ <> space+ <> layoutFrom+ ctx+ (keywordSpan <> spanOf body)+ (attach placement (printBody (bodyOf body)))+ where+ keywordSpan = spanOfSrcSpan written+ placement+ | commentBetween ctx keywordSpan (spanOf body) = Normal+ | otherwise = bodyPlacement (bodyOf body)++-- | A @let@ expression or command.+--+-- The @in@ is indented by one column rather than by one step, which keeps it+-- clear of the bindings above without making it look like one of them.+letIn ::+ (Body b) =>+ Ctx ->+ (LocatedA body -> b) ->+ HsLocalBinds GhcPs ->+ LocatedA body ->+ Doc+letIn ctx bodyOf binds body =+ align $+ -- Neither keyword claims its span, unlike the @do@ of a block. Both have+ -- something printed after them on their own line—the first binding, the+ -- body—so a comment either of them claimed would be held back over that+ -- and come out against it, which is further from where it was written+ -- than where it lands by falling through.+ txt "let"+ <> space+ <> align (localBinds ctx NoBrace binds)+ <> variant space (hardBreak <> txt " ")+ <> txt "in"+ <> space+ <> align (printBody (bodyOf body))++----------------------------------------------------------------------------+-- Bindings++-- | A value binding.+valDecl :: Ctx -> Bracing -> HsBind GhcPs -> Doc+valDecl ctx bracing = \case+ FunBind _ funId funMatches ->+ matchGroup ctx bracing (ExprBody ctx) (FunctionStyle funId) funMatches+ PatBind _ p multAnn grhss ->+ match ctx bracing (ExprBody ctx) PatternBindStyle False multAnn NoSrcStrict [p] grhss+ PatSynBind _ psb -> patSynBind ctx psb+ VarBind {} -> error "Tilia: VarBind is introduced by the type checker"++-- | Which shape a group of equations takes.+data MatchStyle+ = -- | @f x = …@+ FunctionStyle (LocatedN RdrName)+ | -- | @(x, y) = …@+ PatternBindStyle+ | -- | An alternative of a @case@+ CaseStyle+ | -- | The body of a @\\@+ LambdaStyle+ | -- | An alternative of a @\\case@ or @\\cases@+ LambdaCaseStyle++-- | What separates a guard from what it guards.+data GuardStyle+ = EqualsSign+ | RightArrow+ deriving (Eq, Show)++-- | A group of equations.+matchGroup ::+ ( Body b,+ Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO,+ Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA+ ) =>+ Ctx ->+ Bracing ->+ BodyOf body b ->+ MatchStyle ->+ MatchGroup GhcPs (LocatedA body) ->+ Doc+matchGroup ctx bracing mkBody style MG {..} =+ items blockBracing (map rendered (places (unLoc mg_alts)))+ where+ blockBracing = case style of+ CaseStyle -> ifEmpty+ LambdaCaseStyle -> ifEmpty+ _ -> NoBrace+ ifEmpty = if null (unLoc mg_alts) then MayBrace else bracing+ rendered (place, m) = case place of+ Last -> written bracing+ Only -> written bracing+ _ -> whenFlat bracing written+ where+ written b = at_ ctx (renderMatch b) m++ renderMatch b m@Match {..} =+ match+ ctx+ b+ mkBody+ (adjustStyle m style)+ (isInfixMatch m)+ (HsUnannotated EpPatBind)+ (bangBeforeName m)+ (unLoc m_pats)+ m_grhss++-- | The name to print an equation with.+--+-- The name on the binding as a whole is not usable: the equations may spell+-- it differently, one writing @x \`f\` y@ and the next @f x y@, and each+-- carries its own decorations. So the name comes from the equation.+adjustStyle :: Match GhcPs body -> MatchStyle -> MatchStyle+adjustStyle m = \case+ FunctionStyle _ | FunRhs {mc_fun = f} <- m_ctxt m -> FunctionStyle f+ style -> style++-- | Was a @!@ written in front of the name this equation defines?+bangBeforeName :: Match id body -> SrcStrictness+bangBeforeName = \case+ Match {m_ctxt = FunRhs {mc_strictness}} -> mc_strictness+ _ -> NoSrcStrict++-- | One equation: a head, a body, and possibly a @where@.+match ::+ (Body b, Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO) =>+ Ctx ->+ Bracing ->+ BodyOf body b ->+ MatchStyle ->+ -- | Written infix?+ Bool ->+ HsMultAnn GhcPs ->+ SrcStrictness ->+ [LPat GhcPs] ->+ GRHSs GhcPs (LocatedA body) ->+ Doc+match ctx bracing mkBody style isInfix multAnn strict pats GRHSs {..} =+ multiplicity (hsType ctx) multAnn+ <> multAnnGap+ <> strictness strict+ <> head'+ <> nest+ (if indentBody then 1 else 0)+ ( separator+ <> layoutFrom ctx bodySpan (attach placement body)+ <> indent whereClause+ )+ where+ multAnnGap = case multAnn of+ HsUnannotated {} -> mempty+ _ -> space++ -- Patterns may be spread over several lines, in which case they have to+ -- be indented past the name, and then the body has to be indented too or+ -- it would line up with them. When they fit on one line neither+ -- indentation is wanted: the body would sit two steps in for no reason.+ indentBody = case pats of+ [] -> False+ _ ->+ not (maybe True isSingleLine headSpan)+ && not (isCaseStyle style && any containsOrPat pats)++ headSpan = case style of+ FunctionStyle n -> spanOf n <> patSpans+ _ -> patSpans+ patSpans = spansOf pats++ head' = case pats of+ [] -> case style of+ FunctionStyle n -> name ctx n+ _ -> mempty+ (headPat : tailPats) -> layoutFrom ctx headSpan $ case style of+ FunctionStyle n -> defHead isInfix indentBody (name ctx n) rendered+ PatternBindStyle -> sepBy breakOrSpace rendered+ CaseStyle -> sepBy breakOrSpace rendered+ LambdaStyle -> txt "\\" <> lambdaGap headPat <> align (sepBy breakOrSpace rendered)+ LambdaCaseStyle ->+ hsPat ctx headPat+ <> includeUnless+ (null tailPats)+ (breakOrSpace <> indent (sepBy breakOrSpace (map (hsPat ctx) tailPats)))+ where+ rendered = map (hsPat ctx) pats++ -- A @~@, @!@ or splice immediately after the backslash would be taken+ -- for an operator section.+ lambdaGap p = includeWhen (needsGap (unLoc p)) space+ needsGap = \case+ LazyPat {} -> True+ BangPat {} -> True+ SplicePat {} -> True+ InvisPat {} -> True+ _ -> False++ endOfPats = case pats of+ [] -> case style of+ FunctionStyle n -> spanOf n+ _ -> Nothing+ _ -> spanOf (last pats)++ hasGuards = any (not . null . guardsOf . unLoc) grhssGRHSs++ rhsSpan = foldr1 (<>) (fmap (grhsSpan . unLoc) grhssGRHSs)+ bodySpan = fmap endOf endOfPats <> rhsSpan++ placement = case endOfPats of+ Just spn+ | any (longGuard . unLoc) grhssGRHSs || not (sameLine (Just spn) rhsSpan) ->+ Normal+ _ -> blockPlacement (bodyIn mkBody bracing) grhssGRHSs+ -- A guard that does not fit on one line, or a run of them, has to be+ -- followed by a break: the body would otherwise trail off the end of a+ -- guard rather than following the whole condition.+ longGuard grhs = case guardsOf grhs of+ [] -> False+ [g] -> not (maybe True isSingleLine (spanOf g))+ _ -> True++ -- With more than one guarded alternative there is nothing to put the @=@+ -- after: each alternative carries its own.+ separator+ | length grhssGRHSs > 1 = 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 (map alternative (NE.toList grhssGRHSs))+ -- The region an alternative owns runs from its guards to its body. The+ -- annotation would have it start at the @->@, which puts a comment+ -- written after the pattern inside the alternative rather than at the+ -- end of the pattern's line, where the author wrote it.+ alternative g =+ fenceWithin ctx (spanOf g) $+ atSpan+ ctx+ (grhsSpan (unLoc g))+ (guardedRhs ctx placement bracing mkBody groupStyle (unLoc g))+ groupStyle+ | isCaseStyle style && hasGuards = RightArrow+ | otherwise = EqualsSign++ -- A @where@ the author wrote and put nothing under is kept. Only the+ -- absence of the keyword altogether prints nothing: the two are+ -- different trees, and an empty @where@ is usually somewhere its author+ -- was about to write something.+ whereClause = case grhssLocalBinds of+ EmptyLocalBinds _ -> mempty+ binds ->+ breakOrSpace+ <> keywordAt ctx (whereKeywordSpan binds) "where"+ <> includeUnless+ (isEmptyLocalBinds binds)+ (breakOrSpace <> indent (localBinds ctx bracing binds))++isCaseStyle :: MatchStyle -> Bool+isCaseStyle = \case+ CaseStyle -> True+ LambdaCaseStyle -> True+ _ -> False++containsOrPat :: LPat GhcPs -> Bool+containsOrPat = any isOrPat . listify (const True :: Pat GhcPs -> Bool)+ where+ isOrPat = \case+ OrPat {} -> True+ _ -> False++grhsSpan :: GRHS GhcPs (LocatedA body) -> Maybe Span+grhsSpan (GRHS _ guards body) = spanOf body <> spansOf guards++-- | The guards of an alternative.+guardsOf :: GRHS GhcPs body -> [GuardLStmt GhcPs]+guardsOf (GRHS _ guards _) = guards++-- | The placement of a body that is the whole of an equation.+--+-- Only an unguarded equation with a single alternative can hang: with+-- guards, what follows the @=@ is a guard rather than the body.+blockPlacement ::+ (Body b) =>+ (LocatedA body -> b) ->+ NonEmpty (LGRHS GhcPs (LocatedA body)) ->+ Placement+blockPlacement bodyOf = \case+ L _ (GRHS _ _ body) :| [] -> bodyPlacement (bodyOf body)+ _ -> Normal++-- | One alternative of an equation: its guards, and what they guard.+guardedRhs ::+ (Body b) =>+ Ctx ->+ -- | How the equation as a whole is placed+ Placement ->+ -- | Bracing the body inherits+ Bracing ->+ BodyOf body b ->+ GuardStyle ->+ GRHS GhcPs (LocatedA body) ->+ Doc+guardedRhs ctx parentPlacement bracing mkBody style (GRHS _ guards body) = case guards of+ [] -> printBody bound+ _ ->+ txt "|"+ <> space+ <> align (commaSep (map (align . hsStmt ctx) guards))+ <> space+ <> indent (txt separator)+ -- A guard laid out normally has its body indented one step further, so+ -- that the body is clear of the guard. With everything on one line+ -- that step would be indentation for its own sake.+ <> nest+ (if parentPlacement == Normal then 1 else 0)+ (attach placement (printBody bound))+ where+ bound = bodyIn mkBody bracing body+ separator = case style of+ EqualsSign -> "="+ RightArrow -> "->"+ placement+ | maybe True (\g -> sameLine (Just g) (spanOf body)) endOfGuards =+ bodyPlacement bound+ | otherwise = Normal+ endOfGuards = case guards of+ [] -> Nothing+ _ -> spanOf (last guards)++-- | A pattern synonym binding.+patSynBind :: Ctx -> PatSynBind GhcPs GhcPs -> Doc+patSynBind ctx PSB {..} =+ txt "pattern" <> case psb_args of+ PrefixCon args ->+ space+ <> name ctx psb_id+ <> indent+ ( layoutAcross ctx args (argsAfterName (map (name ctx) args) (null args))+ <> definition (spansOf args)+ )+ RecCon args ->+ space+ <> name ctx psb_id+ <> indent+ ( layoutAcross+ ctx+ (vars args)+ ( includeUnless (null args) breakOrSpace+ <> braces (commaSep (map (name ctx) (vars args)))+ )+ <> definition (spansOf (vars args))+ )+ where+ vars = map recordPatSynPatVar+ InfixCon l r ->+ layoutFrom+ ctx+ (spanOf l <> spanOf r)+ (space <> name ctx l <> breakOrSpace <> indent (name ctx psb_id <> space <> name ctx r))+ <> indent (definition (spanOf l <> spanOf r))+ where+ argsAfterName rendered isEmpty =+ includeUnless isEmpty breakOrSpace <> align (sepBy breakOrSpace rendered)++ definition argSpans =+ space <> case psb_dir of+ Unidirectional -> rhs "<-"+ ImplicitBidirectional -> rhs "="+ ExplicitBidirectional mg ->+ rhs "<-"+ <> breakOrSpace+ <> txt "where"+ <> breakOrSpace+ <> indent (matchGroup ctx NoBrace (ExprBody ctx) (FunctionStyle psb_id) mg)+ where+ rhs arrow =+ layoutFrom ctx (spanOf psb_id <> spanOf psb_def <> argSpans) $+ txt arrow <> breakOrSpace <> hsPat ctx psb_def++----------------------------------------------------------------------------+-- Local bindings++-- | The bindings of a @let@ or a @where@.+--+-- The bindings and the signatures arrive in separate lists, because that is+-- how the syntax tree keeps them, and they have to be put back into the+-- order the author wrote them in before anything is printed.+localBinds :: Ctx -> Bracing -> HsLocalBinds GhcPs -> Doc+localBinds ctx bracing = \case+ HsValBinds ann (ValBinds _ binds sigs) ->+ anchored ann . align . items bracing $+ keepBlanks (separatedByBlank ctx) [(spanOf item, rendered place item) | (place, item) <- places sorted]+ where+ sorted =+ sortBy+ (leftmost_smallest `on` getLocA)+ (map (fmap Left) binds <> map (fmap Right) sigs)+ rendered place item = case place of+ Last -> render NoBrace+ Only -> render NoBrace+ _ -> whenFlat NoBrace render+ where+ render b =+ at_ ctx (either (valDecl ctx b) (knotSig (ctxKnot ctx) ctx)) item+ HsValBinds _ _ -> error "Tilia: renamer-only local bindings"+ HsIPBinds ann (IPBinds _ xs) ->+ anchored ann (items bracing (map (at_ ctx implicitBind) xs))+ EmptyLocalBinds _ -> mempty+ where+ implicitBind (IPBind _ (L _ n) e) =+ outputable n+ <> joinedBy "="+ <> indent (hsExprIn ctx (withBracing MayBrace plainSite) e)++ -- The bindings have no wrapper of their own, so the annotation's anchor+ -- is the only record of where they were, and the layout depends on it.+ anchored ann d = case ann of+ EpAnn {anns = AnnList {al_anchor}}+ | not (isZeroWidthSpan (locA al_anchor)) ->+ atSpan ctx (spanOfSrcSpan (locA al_anchor)) d+ _ -> d++-- | Where a @do@ or @mdo@ was written.+doKeywordSpan :: AnnList EpaLocation -> Maybe Span+doKeywordSpan = spanOfSrcSpan . locA . al_rest++-- | Where the @where@ keyword of a group of local bindings was.+whereKeywordSpan :: HsLocalBinds GhcPs -> Maybe Span+whereKeywordSpan =+ spanOfSrcSpan . \case+ HsValBinds EpAnn {anns = AnnList {al_rest}} _ -> locA al_rest+ HsIPBinds EpAnn {anns = AnnList {al_rest}} _ -> locA al_rest+ EmptyLocalBinds _ -> noSrcSpan++isEmptyLocalBinds :: HsLocalBinds GhcPs -> Bool+isEmptyLocalBinds = \case+ EmptyLocalBinds _ -> True+ HsValBinds _ (ValBinds _ binds sigs) -> null binds && null sigs+ _ -> False++----------------------------------------------------------------------------+-- Splices++-- | An untyped splice, either @$x@ or a quasi-quotation.+untypedSplice :: Ctx -> SpliceDecoration -> HsUntypedSplice GhcPs -> Doc+untypedSplice ctx deco = \case+ HsUntypedSpliceExpr _ e -> spliceTH ctx False e deco+ HsQuasiQuote _ quoter str ->+ txt "["+ <> name ctx quoter+ <> txt "|"+ -- A quoter is handed the text exactly as written; laying it out would+ -- change what the quoter receives.+ <> at ctx str (verbatim . T.pack . unpackFS)+ <> txt "|]"++spliceTH :: Ctx -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> Doc+spliceTH ctx isTyped e = \case+ DollarSplice -> txt (if isTyped then "$$" else "$") <> spliced+ BareSplice -> spliced+ where+ spliced = at ctx e (align . exprBody ctx plainSite (spanOf e))++-- | A Template Haskell quotation.+quotation :: Ctx -> HsQuote GhcPs -> Doc+quotation ctx = \case+ ExpBr (bracketAnn, _) e -> quoted (flavour bracketAnn) (hsExpr ctx e)+ where+ flavour = \case+ BracketNoE {} -> ""+ BracketHasE {} -> "e"+ PatBr _ p -> quoted "p" (hsPat ctx p)+ DecBrL _ decls ->+ quoted "d" (starGuard decls (knotDecls (ctxKnot ctx) ctx Free decls))+ DecBrG _ _ -> error "Tilia: DecBrG is produced by the renamer"+ TypBr _ ty -> quoted "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 (body <> breakOrNothing <> txt "|]")++ -- A quotation whose last token is punctuation runs into the @|@ that+ -- closes it and the two lex as one operator: with @StarIsType@ it may+ -- end in a @*@, giving @*|@, and an abstract closed type family ends in+ -- @..@, giving @..|@. The test is deliberately coarse: either one+ -- anywhere inside costs a space at each end and nothing else.+ starGuard x body+ | risky = space <> body <> space+ | otherwise = body+ where+ risky =+ any isStar (listify (const True :: HsType GhcPs -> Bool) x)+ || any isAbstract (listify (const True :: FamilyInfo GhcPs -> Bool) x)+ isStar = \case+ HsStarTy {} -> True+ _ -> False+ isAbstract = \case+ ClosedTypeFamily Nothing -> True+ _ -> False
+ src/Tilia/Render/Haddock.hs view
@@ -0,0 +1,325 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Documentation comments.+--+-- A Haddock is a comment that the syntax tree also knows about, which makes+-- it the one comment the printer places itself rather than leaving to+-- attachment. It has to: @-- ^ x@ documents what precedes it and @-- | x@+-- what follows, so moving the construct moves the Haddock, and where it ends+-- up cannot be worked out from where it started.+--+-- What the author wrote is reused whenever it can be, because rebuilding a+-- Haddock from the doc string the tree carries loses things the tree never+-- had: a @{- | … -}@ comes back as @-- |@ lines, and an empty @-- |@ comes+-- back as nothing at all. It cannot always be reused, since a trailing+-- @-- ^ x@ that is being moved in front of what it documents has to become+-- @-- | x@ or it will point at the wrong thing.+module Tilia.Render.Haddock+ ( DocStyle (..),+ Ending (..),+ haddock,+ haddockInline,+ docSectionName,+ brokenIfDocumented,+ printsWholeLineDocs,+ haddockSpans,+ )+where++import Control.Applicative ((<|>))+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.Doc.Combinators+import Tilia.Render.Context+import Tilia.Span+import Tilia.Span.Ghc++-- | Which kind of Haddock is being printed.+data DocStyle+ = -- | @-- |@, documenting what follows+ Pipe+ | -- | @-- ^@, documenting what precedes+ Caret+ | -- | @-- *@, a section heading, at the given depth+ Section Int+ | -- | @-- $name@, a named chunk+ Chunk String+ deriving (Eq, Show)++-- | Whether the Haddock ends the line it is on.+data Ending+ = -- | The caller will end the line itself.+ Open+ | -- | End it here.+ Closed+ deriving (Eq, Show)++-- | Print a Haddock.+haddock :: Ctx -> DocStyle -> Ending -> LHsDoc GhcPs -> Doc+haddock ctx style ending doc = fst (docBody ctx style doc) <> close+ where+ close = case ending of+ Open -> mempty+ Closed -> hardBreak++-- | A Haddock inside a construct that may legitimately stay on one line.+--+-- A @{- | … -}@ delimits itself, so @data A = A {- | a number -} Int@ is+-- left as written. A @--@ Haddock owns the rest of its line and still has to+-- end it.+haddockInline :: Ctx -> DocStyle -> LHsDoc GhcPs -> Doc+haddockInline ctx style doc =+ body <> (if isSelfClosing then breakOrSpace else hardBreak)+ where+ (body, isSelfClosing) = docBody ctx style doc++-- | The Haddock itself, and whether the form it took delimits itself.+docBody :: Ctx -> DocStyle -> LHsDoc GhcPs -> (Doc, Bool)+docBody ctx style doc@(L l str) =+ case reusableText ctx style doc of+ Just written ->+ ( maybe id located (spanOfSrcSpan l) $+ align (sepBy (verbatimBreak AtIndent) (map txt (NE.toList written))),+ selfClosing written+ )+ Nothing+ | null written' -> (emptyBlock, True)+ | blockForm -> (rebuiltBlock, False)+ | otherwise -> (rebuilt, False)+ where+ emptyBlock = txt (blockOpener style) <> space <> txt "-}"++ -- No provenance on a rebuilt Haddock, unlike one whose text is reused.+ -- Rebuilding is what happens when the author wrote it in another style,+ -- and the commonest of those is a @-- ^@ being printed as @-- |@, which+ -- moves it from after what it documents to before. Offering where it+ -- used to be as somewhere a comment may attach would put that comment+ -- ahead of comments that were written above it.+ rebuilt =+ sepBy hardBreak (zipWith line' (True : repeat False) written')+ <> mconcat (replicate trailingBlanks (hardBreak <> txt "--"))+ trailingBlanks = case writtenHaddock ctx (spanOfSrcSpan l) of+ Nothing -> 0+ Just ls -> length (takeWhile isBlankLine (reverse (NE.toList ls)))+ isBlankLine t = T.null (T.strip (fromMaybe t (T.stripPrefix "--" (T.strip t))))++ line' isFirst t =+ (if isFirst then txt (opener style) else txt "--")+ <> space+ <> txt t++ -- One the author wrote as a block comment over several lines is+ -- rebuilt as one. Cut into @--@ lines it would stop being a single+ -- comment: the lexer reads the first line as documentation and every+ -- line after it as an ordinary comment, so a Haddock of two lines would+ -- come back as a Haddock of one and a comment saying half a sentence.+ -- A block of one line has no such lines to lose and is rebuilt as+ -- @-- |@ like any other.+ rebuiltBlock =+ align $+ txt (blockOpener style)+ <> space+ <> sepBy (verbatimBreak AtIndent) (map txt written')+ <> space+ <> txt "-}"++ asBlock = writtenAsBlock ctx doc+ written' = docLines asBlock str+ blockForm = asBlock && length written' > 1++-- | How a rebuilt Haddock begins.+opener :: DocStyle -> Text+opener = \case+ Pipe -> "-- |"+ Caret -> "-- ^"+ Section n -> "-- " <> T.replicate n "*"+ Chunk n -> docSectionName n++-- | How a rebuilt Haddock that stays a block comment begins.+blockOpener :: DocStyle -> Text+blockOpener = \case+ Pipe -> "{- |"+ Caret -> "{- ^"+ Section n -> "{- " <> T.replicate n "*"+ Chunk n -> "{- $" <> T.pack n++-- | 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)))++-- | The anchor of a named documentation chunk.+--+-- Unlike a Haddock this carries no text of its own, so there is nothing to+-- reuse and nothing to report a position for.+docSectionName :: String -> Text+docSectionName n = "-- $" <> T.pack n++-- | The author's own text, when it may be used.+--+-- It may not when the Haddock is about to be printed in a style other than+-- the one it was written in, since the text carries the style in its first+-- characters.+reusableText :: Ctx -> DocStyle -> LHsDoc GhcPs -> Maybe (NonEmpty Text)+reusableText ctx style doc = do+ written <- writtenHaddock ctx (spanOfSrcSpan (getLoc doc))+ if openedInStyle style (NE.head written) then Just written else Nothing++-- | Was the Haddock written in the style it is about to come back out in?+openedInStyle :: DocStyle -> Text -> Bool+openedInStyle style firstLine = case afterOpener firstLine of+ Nothing -> False+ Just inside -> case style of+ -- A chunk's name is the compiler's to delimit, and it may have stopped+ -- somewhere the line carries on: @-- $Id: …@ names the chunk @Id@ and+ -- then goes on with a colon that is no part of it. So the name is+ -- matched as a prefix and where it ends is left to the compiler.+ Chunk _ -> triggerFor style `T.isPrefixOf` inside+ -- The rest are a run of characters that ends where the run ends, so the+ -- run is read off the line and compared whole. Matching a prefix would+ -- take @** x@ for a @* x@ that happens to be followed by a star.+ _ -> triggerOn inside == Just (triggerFor style)++-- | The trigger a style is written with.+triggerFor :: DocStyle -> Text+triggerFor = \case+ Pipe -> "|"+ Caret -> "^"+ Section n -> T.replicate n "*"+ Chunk n -> "$" <> T.pack n++-- | What follows the @--@ or @{-@ that opens a comment, with the spaces+-- after it removed.+afterOpener :: Text -> Maybe Text+afterOpener firstLine = T.stripStart <$> opened (T.stripStart firstLine)+ where+ opened t = T.stripPrefix "--" t <|> T.stripPrefix "{-" t++-- | The trigger an opened comment carries, for the triggers that are a run+-- of one character.+triggerOn :: Text -> Maybe Text+triggerOn inside = do+ (c, rest) <- T.uncons inside+ case c of+ '|' -> Just "|"+ '^' -> Just "^"+ '*' -> Just (T.cons c (T.takeWhile (== '*') rest))+ _ -> Nothing++-- | 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)++----------------------------------------------------------------------------+-- Documentation and layout++-- | Lay the document out on several lines if printing this fragment will+-- emit a Haddock that takes whole lines.+brokenIfDocumented :: (Data a) => Ctx -> a -> Doc -> Doc+brokenIfDocumented ctx x d+ | printsWholeLineDocs ctx x = broken d+ | otherwise = d++-- | Will printing this fragment emit a Haddock as @--@ lines?+--+-- Every site that asks prints in 'Pipe' style, which is what decides+-- whether the author's text can be reused.+printsWholeLineDocs :: (Data a) => Ctx -> a -> Bool+printsWholeLineDocs ctx x = case docsIn x of+ [] -> not (null (docStringsIn x))+ docs -> any takesWholeLines docs+ where+ takesWholeLines doc = case reusableText ctx Pipe doc of+ Just written -> not (selfClosing written)+ Nothing -> not (null (docLines (writtenAsBlock ctx doc) (unLoc doc)))++-- | The spans of every Haddock in a fragment.+--+-- Attachment must not place these: the printer has already put them where+-- they belong, and a comment placed twice is worse than one placed badly.+haddockSpans :: (Data a) => a -> [Span]+haddockSpans x = mapMaybe (spanOfSrcSpan . getLoc) (docsIn x) <> namedSections x++docsIn :: (Data a) => a -> [LHsDoc GhcPs]+docsIn = listify (const True :: LHsDoc GhcPs -> Bool)++-- | The spans of the @-- $name@ anchors in an export list.+--+-- These are the one kind of Haddock the syntax tree records without a doc+-- string: an anchor carries only its name, so there is no 'LHsDoc' to find+-- it by, and the item that holds it is the only record of where it was.+-- Without this the anchor is printed once from the tree and once more by+-- attachment, and each pass adds another copy.+namedSections :: (Data a) => a -> [Span]+namedSections =+ mapMaybe anchorSpan . listify (const True :: LIE GhcPs -> Bool)+ where+ anchorSpan l = case unLoc l of+ IEDocNamed {} -> spanOfSrcSpan (getHasLoc (getLoc l))+ _ -> Nothing++docStringsIn :: (Data a) => a -> [HsDocString]+docStringsIn = listify (const True :: HsDocString -> Bool)++----------------------------------------------------------------------------+-- Doc strings++-- | The lines of a doc string, normalised the way Haddock reads them.+docLines ::+ -- | Was it written as a block comment?+ Bool ->+ WithHsDocIdentifiers HsDocString GhcPs ->+ [Text]+docLines blockForm str+ | null body = []+ | otherwise = map guardDollar (dedent (map unpad body))+ where+ body =+ dropWhileEnd T.null+ . map (T.stripEnd . T.pack)+ . lines+ . renderHsDocString+ $ hsDocString str++ unpad t+ | padded, Just (' ', rest) <- T.uncons t = rest+ | otherwise = t+ padded = case dropWhile T.null body of+ (t : _) -> " " `T.isPrefixOf` t+ [] -> False++ -- Written as @{- | … -}@, the lines after the first are indented to sit+ -- under the opening bracket, and that indentation is measured from a+ -- column the text is about to leave: printed back as @--@ lines it+ -- would show up as a run of spaces the author never typed. Only the+ -- part they all share goes, so anything indented further—an example, a+ -- code block—keeps the shape it was given.+ dedent ls+ | not blockForm = ls+ | otherwise = case ls of+ [] -> []+ (first' : rest) -> first' : map (T.drop (shared rest)) rest++ shared ls = case map indentation (filter (not . T.null) ls) of+ [] -> 0+ ns -> minimum ns+ indentation = T.length . T.takeWhile (== ' ')++ -- A line may not begin with a dollar: that is the spelling of a named+ -- chunk, and one appearing by accident is a parse error.+ guardDollar t+ | "$" `T.isPrefixOf` t = T.cons '\\' t+ | otherwise = t
+ src/Tilia/Render/Header.hs view
@@ -0,0 +1,428 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | The module header, and the module as a whole.+--+-- The header is the one part of a module that is reordered rather than+-- merely re-laid-out: language pragmas are sorted, and a @{-# LANGUAGE A, B+-- #-}@ is split into one pragma per extension. That is safe because the+-- compiler reads the header as a set, with one exception—some extensions+-- turn others on, so the order within a few groups is load-bearing, and+-- 'pragmaOrder' is where that is written down.+module Tilia.Render.Header+ ( -- * Pragmas+ HeaderPragma (..),+ takeHeaderPragmas,+ takeStackHeader,++ -- * The module+ hsModule,+ )+where++import Data.Function (on)+import Data.List (sortOn)+import Data.List.NonEmpty qualified as NE+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Driver.Flags (Language)+import GHC.Hs+import GHC.LanguageExtensions.Type (Extension (..))+import GHC.Types.PkgQual (RawPkgQual (..))+import GHC.Types.SrcLoc (GenLocated (..), unLoc)+import Tilia.Comments (Comment (..), Pragma (..), commentPragma)+import Tilia.Doc.Combinators+import Tilia.Render.Context+import Tilia.Render.Declaration (decls)+import Tilia.Render.Haddock+import Tilia.Render.Layout+import Tilia.Render.Name+import Tilia.Render.Pragma (warningTxt)+import Tilia.Source (Source, directiveAt, sourceLines)+import Tilia.Span+import Tilia.Span.Ghc++----------------------------------------------------------------------------+-- Pragmas++-- | A pragma of the file header.+data HeaderPragma = HeaderPragma+ { -- | The region it was written in.+ hpSpan :: Span,+ -- | How many preprocessor directives the header has above it.+ hpRun :: Int,+ -- | Where it sorts.+ hpOrder :: PragmaOrder,+ -- | @LANGUAGE@, @OPTIONS_GHC@ or @OPTIONS_HADDOCK@.+ hpName :: Text,+ -- | One extension, or the whole of an options string.+ hpBody :: 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.+data PragmaOrder+ = LanguageOrder ExtensionClass+ | 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.+--+-- What comes back is the pragmas, in the order they were written, and the+-- comments that were not pragmas. A @{-# … #-}@ below the header is not a+-- pragma at all—the compiler never reads it—so hoisting it would give it a+-- meaning it did not have, and it is left in the stream as the comment it+-- is.+takeHeaderPragmas ::+ -- | The module as written+ Source ->+ -- | Where the header ends+ Maybe Span ->+ [Comment] ->+ ([HeaderPragma], [Comment])+takeHeaderPragmas src headerEnd comments = (pragmas, plain)+ where+ recognised = [(c, headerPragma c) | c <- comments]+ pragmas = [entry c p | (c, Just p) <- recognised]+ plain =+ [ if rightAbovePragma c then airless c else c+ | (c, Nothing) <- recognised+ ]+ rightAbovePragma c =+ Set.member (below (spanEndLine (commentSpan c) + 1)) pragmaStarts+ below n = if directiveAt n (sourceLines src) then below (n + 1) else n+ pragmaStarts =+ Set.fromList [spanStartLine (commentSpan c) | (c, Just _) <- recognised]+ airless c = c {commentGapAbove = False, commentGapBelow = False}+ directivesAbove n =+ length [k | k <- [1 .. n - 1], directiveAt k (sourceLines src)]+ entry c p =+ HeaderPragma+ { hpSpan = commentSpan c,+ hpRun = directivesAbove (spanStartLine (commentSpan c)),+ hpOrder = orderOf p,+ hpName = pragmaName p,+ hpBody = pragmaBody p+ }+ headerPragma c = do+ p <- commentPragma c+ _ <- lookupOrder (pragmaName p)+ if inHeader headerEnd (commentSpan c) then Just p else Nothing+ orderOf p = case pragmaName p of+ "LANGUAGE" -> LanguageOrder (classifyExtension (pragmaBody p))+ other -> maybe OptionsGhcOrder id (lookupOrder other)+ lookupOrder = \case+ "LANGUAGE" -> Just (LanguageOrder Enabling)+ "OPTIONS_GHC" -> 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+ Maybe Span ->+ [Comment] ->+ (Doc, [Comment])+takeStackHeader headerEnd = \case+ (c : cs) | isStackHeader c -> (reproduce c <> blankLine, cs)+ cs -> (mempty, cs)+ where+ -- Being the first comment is not enough: @stack@ reads the header off+ -- the top of the file, so a @-- stack …@ written further down is an+ -- ordinary comment that happens to start with a word.+ isStackHeader c =+ inHeader headerEnd (commentSpan c)+ && T.isPrefixOf "stack" (T.stripStart (T.drop 2 (NE.head (commentBody c))))+ reproduce c =+ sepBy (verbatimBreak AtMargin) (map txt (NE.toList (commentBody c)))++-- | The pragmas of a header, one per line, sorted.+pragmaBlock :: [HeaderPragma] -> Doc+pragmaBlock = foldMap render . dedupe . sortOn key . concatMap split+ where+ key p = (hpRun p, hpOrder p, hpBody p)+ dedupe = map NE.head . NE.groupBy ((==) `on` key)+ split p+ | hpName p == "LANGUAGE" =+ [ p {hpBody = body, hpOrder = LanguageOrder (classifyExtension body)}+ | body <- map T.strip (T.splitOn "," (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++-- | Does this name a whole edition of the language rather than one+-- extension of it?+namesAnEdition :: Text -> Bool+namesAnEdition t = any spelledTheSame [minBound .. maxBound]+ where+ spelledTheSame edition = t == T.pack (show (edition :: Language))++----------------------------------------------------------------------------+-- The module++-- | A whole module.+hsModule :: Ctx -> [HeaderPragma] -> HsModule GhcPs -> Doc+hsModule ctx pragmas HsModule {hsmodExt = XModulePs {..}, ..} =+ headerLayout $+ pragmaBlock pragmas+ <> hardBreak+ <> moduleLine+ <> hardBreak+ <> foldMap (\i -> at_ ctx (importDecl ctx) i <> hardBreak) hsmodImports+ <> hardBreak+ <> layoutFrom ctx (spansOf hsmodDecls) (decls ctx Free hsmodDecls)+ where+ exports = maybe [] unLoc hsmodExports+ headerSpan = foldMap spanOf hsmodDeprecMessage <> foldMap spanOf hsmodExports++ headerLayout+ | any (isDocEntry . unLoc) exports = broken+ | otherwise = layoutFrom ctx headerSpan++ moduleLine = case hsmodName of+ Nothing -> mempty+ Just modName ->+ documentation+ <> at ctx modName (moduleHeadName ctx)+ <> breakOrSpace+ <> foldMap (\w -> at ctx w warningTxt <> breakOrSpace) hsmodDeprecMessage+ <> foldMap exports' hsmodExports+ <> txt "where"+ <> hardBreak++ documentation = foldMap (haddock ctx Pipe Closed) hsmodHaddockModHeader++ exports' l =+ at ctx l (\xs -> indent (exportList ctx (spanOf l) xs)) <> breakOrSpace++----------------------------------------------------------------------------+-- Export lists++-- | The parenthesised list after a module name.+exportList :: Ctx -> Maybe Span -> [LIE GhcPs] -> Doc+exportList ctx enclosing xs =+ layoutHere . parens . insideBrackets enclosing $+ importExportItems ctx xs+ where+ layoutHere+ | any (isDocEntry . unLoc) xs = broken+ | otherwise = layoutFrom ctx enclosing++-- | The items of an import or export list.+--+-- The comma travels with the item rather than sitting between two of them,+-- because a list that has been broken ends with one: adding an entry then+-- touches one line rather than two.+importExportItems :: Ctx -> [LIE GhcPs] -> Doc+importExportItems ctx xs = variant (laidOut False) (laidOut True)+ where+ laidOut broken' =+ sepBy breakOrSpace (zipWith (item broken') (Nothing : map Just xs) (places xs))+ item broken' previous (place, x) =+ gapAbove place (unLoc <$> previous) (unLoc x)+ <> align (at ctx (widenToDoc x) (ieItem ctx (spanOf x) (comma' broken' place)))+ gapAbove place previous here+ | place == First || place == Only = mempty+ | isSection here = hardBreak+ | isPipe here, maybe False runsOn previous = hardBreak+ | otherwise = mempty+ isSection = \case+ IEGroup {} -> True+ _ -> False+ isPipe = \case+ IEDoc {} -> True+ _ -> False+ -- Documentation that takes in whatever is written directly under it.+ runsOn = \case+ IEDoc {} -> True+ IEDocNamed {} -> True+ _ -> False+ comma' broken' place+ | broken' = True+ | otherwise = place == First || place == Middle++-- | Widen an item's span to take in the documentation printed with it, so+-- that a documented item is laid out as one thing.+widenToDoc :: LIE GhcPs -> LIE GhcPs+widenToDoc l@(L ann ie) = case itemDoc ie of+ Nothing -> l+ Just (L docSpan _) -> L (ann <> noAnnSrcSpan docSpan) ie++-- | One item of an import or export list.+ieItem :: Ctx -> Maybe Span -> Bool -> IE GhcPs -> Doc+ieItem ctx here withComma = \case+ IEVar warning n doc ->+ exportWarning warning+ <> at ctx n (wrappedName ctx)+ <> comma'+ <> itemDocumentation doc+ IEThingAbs warning n doc ->+ exportWarning warning+ <> at ctx n (wrappedName ctx)+ <> comma'+ <> itemDocumentation doc+ IEThingAll (warning, _) n doc ->+ exportWarning warning+ <> at ctx n (wrappedName ctx)+ <> space+ <> txt "(..)"+ <> comma'+ <> itemDocumentation doc+ IEThingWith (warning, _) n wildcard members doc ->+ align+ ( exportWarning warning+ <> at ctx n (wrappedName ctx)+ <> breakOrSpace+ <> indent (parens (insideBrackets here (commaSep (align <$> withWildcard))))+ <> comma'+ )+ <> itemDocumentation doc+ where+ rendered = map (at_ ctx (wrappedName ctx)) members+ withWildcard = case wildcard of+ NoIEWildcard -> rendered+ IEWildcard n' ->+ let (before, after) = splitAt n' rendered+ in before <> [txt ".."] <> after+ IEModuleContents (warning, _) m ->+ exportWarning warning <> at ctx m (moduleHeadName ctx) <> comma'+ 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) (map txt (NE.toList written))+ Nothing -> txt (docSectionName n)+ where+ comma' = includeWhen withComma comma+ exportWarning =+ foldMap (\w -> at ctx w warningTxt <> breakOrSpace)+ itemDocumentation =+ foldMap (\d -> breakOrSpace <> haddock ctx Caret Open d)++itemDoc :: IE GhcPs -> Maybe (ExportDoc GhcPs)+itemDoc = \case+ IEVar _ _ doc -> doc+ IEThingAbs _ _ doc -> doc+ IEThingAll _ _ doc -> doc+ IEThingWith _ _ _ _ doc -> doc+ _ -> Nothing++-- | Does this export list entry carry documentation?+--+-- A list holding one cannot go on one line: the entry would swallow the rest+-- of it, closing bracket and all.+isDocEntry :: IE GhcPs -> Bool+isDocEntry = \case+ IEDoc {} -> True+ IEGroup {} -> True+ IEDocNamed {} -> True+ _ -> False++----------------------------------------------------------------------------+-- Imports++-- | One import declaration.+importDecl :: Ctx -> ImportDecl GhcPs -> Doc+importDecl ctx ImportDecl {..} =+ txt "import"+ <> space+ <> includeWhen (ideclSource == IsBoot) (txt "{-# SOURCE #-}")+ <> space+ <> includeWhen ideclSafe (txt "safe")+ <> space+ <> levelBefore+ <> space+ <> includeWhen (isQualified && not qualifiedLast) (txt "qualified")+ <> space+ <> packageQualifier+ <> space+ <> indent+ ( at ctx ideclName outputable+ <> space+ <> levelAfter+ <> includeWhen (isQualified && qualifiedLast) (space <> txt "qualified")+ <> foldMap (\a -> space <> txt "as" <> space <> at ctx a outputable) ideclAs+ <> space+ <> importList+ )+ where+ qualifiedLast = extensionOn ctx ImportQualifiedPost+ isQualified = isImportDeclQualified ideclQualified++ packageQualifier = case ideclPkgQual of+ NoRawPkgQual -> mempty+ RawPkgQual literal -> outputable literal++ levelBefore = case ideclLevelSpec of+ LevelStylePre l -> declLevel l+ _ -> mempty+ levelAfter = case ideclLevelSpec of+ LevelStylePost l -> declLevel l+ _ -> mempty++ importList = case ideclImportList of+ Nothing -> mempty+ Just (interpretation, L listLoc xs) ->+ hidden+ <> breakOrSpace+ <> parens+ ( insideBrackets+ (spanOfSrcSpan (locA listLoc))+ (importExportItems ctx xs)+ )+ where+ hidden = case interpretation of+ Exactly -> mempty+ EverythingBut -> txt "hiding"++declLevel :: ImportDeclLevel -> Doc+declLevel = \case+ ImportDeclSplice -> txt "splice"+ ImportDeclQuote -> txt "quote"
+ src/Tilia/Render/Layout.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Runs of things: statements, bindings, equations, list elements.+module Tilia.Render.Layout+ ( -- * Blocks+ Bracing (..),+ items,+ itemsSepBy,++ -- * Blank lines+ keepBlanks,++ -- * Positions in a run+ Place (..),+ places,+ )+where++import Tilia.Doc.Combinators+import Tilia.Span++----------------------------------------------------------------------------+-- Blocks++-- | May a block put braces around itself when it is laid out on one line?+--+-- It may not when something outside it is already doing so: nested braces+-- would be correct but unreadable, and more to the point the outer block+-- has already made the items unambiguous.+data Bracing+ = MayBrace+ | NoBrace+ deriving (Eq, Show)++-- | A block: one item per line when broken, semicolons when flat.+items :: Bracing -> [Doc] -> Doc+items = itemsSepBy False++-- | 'items', with control over whether the broken form carries semicolons+-- too.+--+-- It has to when the block is standing in for something that would+-- otherwise be read as continuing: an or-pattern inside an as-pattern, for+-- instance, where a bare line break would let the next alternative be taken+-- for a new argument.+itemsSepBy ::+ -- | Semicolons in the broken layout as well?+ Bool ->+ Bracing ->+ [Doc] ->+ Doc+itemsSepBy semisWhenBroken bracing xs = variant flatForm brokenForm+ where+ flatForm = case (bracing, xs) of+ (MayBrace, []) -> txt "{}"+ (NoBrace, []) -> mempty+ (MayBrace, _) -> txt "{" <> space <> joined <> space <> txt "}"+ (NoBrace, _) -> joined+ joined = sepBy (semi <> space) xs+ brokenForm =+ sepBy (includeWhen semisWhenBroken semi <> hardBreak) xs++----------------------------------------------------------------------------+-- Blank lines++-- | Put back the empty lines the author left between items.+keepBlanks ::+ -- | Was there an empty line between two items?+ (Maybe Span -> Maybe Span -> Bool) ->+ -- | Where each item was, and what it prints as+ [(Maybe Span, Doc)] ->+ [Doc]+keepBlanks blank xs = zipWith gap (Nothing : map fst xs) xs+ where+ gap previous (here, d) = includeWhen (blank previous here) hardBreak <> d++----------------------------------------------------------------------------+-- Positions in a run++-- | Where an item sits among its siblings.+data Place+ = Only+ | First+ | Middle+ | Last+ deriving (Eq, Show)++-- | Label each item of a list with its position.+places :: [a] -> [(Place, a)]+places [] = []+places [x] = [(Only, x)]+places (x : xs) = (First, x) : go xs+ where+ go [] = []+ go [y] = [(Last, y)]+ go (y : ys) = (Middle, y) : go ys
+ src/Tilia/Render/Literal.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- | String literals.+module Tilia.Render.Literal+ ( stringLiteral,+ )+where++import Control.Applicative ((<|>))+import Control.Monad ((>=>))+import Data.List (find)+import Data.Semigroup (Min (..))+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Data.FastString (FastString, unpackFS)+import GHC.Parser.CharClass (is_space)+import Tilia.Doc.Combinators+import Tilia.Render.Layout (Place (..), places)++-- | A string literal, from the text the author wrote.+stringLiteral :: FastString -> Doc+stringLiteral src = case takeApart (T.pack (unpackFS src)) of+ Nothing -> error ("Tilia: unparsable string literal: " <> show src)+ Just literal -> align (renderLiteral literal)++renderLiteral :: Literal -> Doc+renderLiteral literal =+ txt (litOpen literal) <> body <> txt (litClose literal)+ where+ body = case litKind literal of+ Regular -> variant onOneLine acrossLines+ Multiline -> sepBy (verbatimBreak AtIndent) (map txt (litParts literal))+ onOneLine = txt (joinParts (litParts literal))+ acrossLines =+ sepBy breakOrSpace (map continued (places (litParts literal)))+ continued (place, s) = case place of+ Only -> txt s+ First -> txt s <> txt "\\"+ Middle -> txt "\\" <> txt s <> txt "\\"+ Last -> txt "\\" <> txt s++----------------------------------------------------------------------------+-- Taking a literal apart++-- | A literal split into the bits that may be laid out separately.+data Literal = Literal+ { litOpen :: Text,+ litClose :: Text,+ litKind :: LiteralKind,+ -- | For a regular literal, the runs between string gaps; for a+ -- multi-line one, the lines.+ litParts :: [Text]+ }+ deriving (Eq, Show)++data LiteralKind+ = Regular+ | Multiline+ deriving (Eq, Show)++takeApart :: Text -> Maybe Literal+takeApart s = do+ literal <-+ stripMarkers Multiline "\"\"\"" s+ <|> stripMarkers Regular "\"" s+ let split = case litKind literal of+ Regular -> runsBetweenGaps+ Multiline -> splitMultiline+ pure literal {litParts = concatMap split (litParts literal)}++-- | Peel the quotes off, allowing for the @#@ that marks an unlifted+-- literal.+stripMarkers :: LiteralKind -> Text -> Text -> Maybe Literal+stripMarkers litKind marker s = do+ inner <- T.stripPrefix marker s+ litClose <- find (`T.isSuffixOf` inner) [marker <> "#", marker]+ body <- T.stripSuffix litClose inner+ pure Literal {litOpen = marker, litParts = [body], ..}++-- | The runs of a literal either side of its string gaps.+runsBetweenGaps :: Text -> [Text]+runsBetweenGaps s = case gapAt 0 s of+ Nothing -> [s]+ Just (before, after) -> T.take before s : runsBetweenGaps after+ where+ -- How much comes before the first gap, and what comes after it.+ gapAt n t = case T.uncons t of+ Nothing -> Nothing+ Just ('\\', rest) -> case afterGap rest of+ Just resumes -> Just (n, resumes)+ Nothing -> let taken = 1 + escapedWidth rest in gapAt (n + taken) (T.drop taken t)+ Just (_, rest) -> gapAt (n + 1) rest++ -- Where the literal picks up again, if this backslash opened a gap.+ afterGap t = case T.span is_space t of+ (blank, rest)+ | not (T.null blank), Just ('\\', resumes) <- T.uncons rest -> Just resumes+ _ -> Nothing++ -- How much follows the backslash of an escape that is not a gap. Only+ -- @\\^X@ reaches past the character after the backslash; the numeric+ -- escapes run on further, but their digits are not backslashes and do+ -- not need skipping.+ escapedWidth t = case T.uncons t of+ Just ('^', _) -> 2+ Just _ -> 1+ Nothing -> 0++-- | Split a multi-line literal the way GHC's lexer reads one, so that what+-- comes back out means what went in.+splitMultiline :: Text -> [Text]+splitMultiline =+ dropCommonIndent+ . map expandTabs+ . splitLines+ . joinParts+ . runsBetweenGaps++-- | The line terminators the Report recognises, not merely @\\n@.+splitLines :: Text -> [Text]+splitLines = T.splitOn "\r\n" >=> T.split newlineish+ where+ newlineish c = c == '\n' || c == '\r' || c == '\f'++-- | Tabs advance to the next multiple of eight.+expandTabs :: Text -> Text+expandTabs = T.concat . go 0+ where+ go column s = case T.breakOn "\t" s of+ (before, T.uncons -> Just (_, after)) ->+ let reached = column + T.length before+ fill = 8 - (reached `mod` 8)+ in before : T.replicate fill " " : go (reached + fill) after+ _ -> [s]++-- | Take the common indentation off every line but the first, and blank the+-- lines that were nothing but whitespace.+dropCommonIndent :: [Text] -> [Text]+dropCommonIndent = \case+ [] -> []+ firstLine : rest -> firstLine : trimmed+ where+ (indents, trimmed) = unzip (map measure rest)+ common = maybe 0 getMin (mconcat indents)+ measure l+ | T.all is_space l = (Nothing, "")+ | otherwise = (Just (Min (T.length (T.takeWhile is_space l))), T.drop common l)++-- | Rejoin runs with the smallest gap that keeps them apart.+--+-- The gap cannot simply be dropped: it is what stops the end of one run and+-- the start of the next from lexing as a single escape sequence, so+-- @\"\\65\\ \\0\"@ and @\"\\650\"@ are different strings.+joinParts :: [Text] -> Text+joinParts = T.intercalate "\\ \\"
+ src/Tilia/Render/Name.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++-- | Names, and the decorations the author put around them.+module Tilia.Render.Name+ ( -- * Rendering anything GHC can show+ outputable,+ showGhc,+ sourceText,++ -- * Names+ name,+ moduleHeadName,+ wrappedName,+ namespaceSpec,+ multiplicity,++ -- * Definition heads+ defHead,+ )+where++import Data.Text (Text)+import Data.Text qualified as T+import GHC.Hs+import GHC.LanguageExtensions.Type (Extension (..))+import GHC.Types.Name.Occurrence (OccName, occNameString)+import GHC.Types.Name.Reader+import GHC.Types.SourceText+import GHC.Types.SrcLoc (getLoc)+import GHC.Utils.Outputable (Outputable, ppr, showSDocUnsafe)+import Tilia.Doc.Combinators+import Tilia.Render.Context+import Tilia.Span+import Tilia.Span.Ghc++-- | Anything GHC knows how to show.+--+-- For the leaves that have no structure worth walking—numeric literals,+-- occurrence names, calling conventions. Never for anything that might need+-- a line break inside it, since the result is emitted as one fragment.+outputable :: (Outputable a) => a -> Doc+outputable = txt . showGhc++-- | The text GHC would show for something.+showGhc :: (Outputable a) => a -> Text+showGhc = T.pack . showSDocUnsafe . ppr++-- | The text the author wrote, when GHC kept it.+sourceText :: SourceText -> Doc+sourceText = \case+ NoSourceText -> mempty+ SourceText s -> outputable s++----------------------------------------------------------------------------+-- Names++-- | A name, with whatever the author wrapped it in.+name :: Ctx -> LocatedN RdrName -> Doc+name ctx l = at ctx l $ \x -> adorn ctx (spanOf l) x (getLoc l) (bareName x)++-- | The name itself, with nothing around it.+bareName :: RdrName -> Doc+bareName = \case+ Unqual occName -> outputable occName+ Qual mname occName -> qualifiedName mname occName+ Orig _ occName -> outputable occName+ Exact n -> outputable n++-- | Put back whatever brackets, backticks or ticks the author used.+adorn :: Ctx -> Maybe Span -> RdrName -> EpAnn NameAnn -> Doc -> Doc+adorn ctx here x = go+ where+ go EpAnn {anns} = case anns of+ -- A promotion tick, with whatever the name carries under it.+ NameAnnQuote {nann_quoted} -> (txt "'" <>) . go nann_quoted+ -- The empty unboxed sum and the empty list are written out whole:+ -- there is no name under the brackets to print.+ NameAnnOnly {nann_adornment = NameParensHash {}} -> const (txt "(# #)")+ NameAnnOnly {nann_adornment = NameSquare {}} ->+ const (txt "[" <> insideBrackets here mempty <> txt "]")+ -- @->@ is the one name that is a keyword as well, and the parentheses+ -- are recorded on their own rather than as an adornment.+ NameAnnRArrow {nann_mopen = Just _} -> inParens+ -- The name inside the brackets is claimed separately from the+ -- brackets themselves, so that a comment written against it—@( {-+ -- here -} :+: )@—is put where it was written rather than after the+ -- closing bracket.+ NameAnn {nann_adornment, nann_name} -> case nann_adornment of+ NameParens {} -> inParens . spaceOutHash . itsOwn nann_name+ NameBackquotes {} -> backticks . itsOwn nann_name+ _ -> itsOwn nann_name+ _ -> id++ itsOwn = atSpan ctx . annSpan++ inParens d = txt "(" <> d <> txt ")"++ -- With UnboxedSums on, @(#@ lexes as one token, so an operator starting+ -- with @#@ cannot sit against its opening bracket.+ spaceOutHash d+ | extensionOn ctx UnboxedSums,+ -- A qualified name never begins with a @#@.+ Unqual (occNameString -> '#' : _) <- x =+ space <> d <> space+ | otherwise = d++-- | A name written with its module.+qualifiedName :: ModuleName -> OccName -> Doc+qualifiedName mname occName = outputable mname <> txt "." <> outputable occName++-- | The name in a module header, with the keyword that introduces it.+moduleHeadName :: Ctx -> ModuleName -> Doc+moduleHeadName ctx mname =+ txt keyword <> space <> outputable mname+ where+ keyword = case ctxSourceType ctx of+ ModuleSource -> "module"+ SignatureSource -> "signature"++-- | A name as it appears in an import or export list.+wrappedName :: Ctx -> IEWrappedName GhcPs -> Doc+wrappedName ctx = \case+ IEName _ x -> name ctx x+ IEDefault _ x -> keyed "default" x+ IEPattern _ x -> keyed "pattern" x+ IEType _ x -> keyed "type" x+ IEData _ x -> keyed "data" x+ where+ keyed kw x = txt kw <> space <> name ctx x++-- | The @type@ or @data@ that disambiguates which namespace is meant.+namespaceSpec :: NamespaceSpecifier -> Doc+namespaceSpec = \case+ NoNamespaceSpecifier -> mempty+ TypeNamespaceSpecifier _ -> txt "type" <> space+ DataNamespaceSpecifier _ -> txt "data" <> space++-- | A multiplicity annotation on an arrow or a field.+multiplicity :: (mult -> Doc) -> HsMultAnnOf mult GhcPs -> Doc+multiplicity render = \case+ HsUnannotated _ -> mempty+ HsLinearAnn _ -> txt "%1"+ HsExplicitMult _ mult -> txt "%" <> render mult++----------------------------------------------------------------------------+-- Definition heads++-- | The left-hand side of a definition: a name and the things it is applied+-- to.+--+-- Written infix, the first two arguments straddle the name and any further+-- ones force the whole of that into parentheses, which is the only way the+-- source could have been written. Written prefix, the arguments simply+-- follow. The indentation flag is for the callers whose body is going to be+-- indented anyway, so that the arguments do not end up two steps in.+defHead ::+ -- | Written infix?+ Bool ->+ -- | Indent the arguments?+ Bool ->+ -- | The name+ Doc ->+ -- | The arguments+ [Doc] ->+ Doc+defHead True indentArgs nameDoc (a0 : a1 : rest) =+ wrap (a0 <> breakOrSpace <> indent (align (nameDoc <> space <> a1)))+ <> includeUnless (null rest) (nest (steps indentArgs) (breakOrSpace <> spread rest))+ where+ wrap = if null rest then id else parens+defHead _ indentArgs nameDoc args =+ nameDoc+ <> includeUnless (null args) (nest (steps indentArgs) (breakOrSpace <> spread args))++-- | Arguments, each aligned under itself, one per line when broken.+spread :: [Doc] -> Doc+spread = align . sepBy breakOrSpace . map align++steps :: Bool -> Int+steps b = if b then 1 else 0
+ src/Tilia/Render/Operator.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE LambdaCase #-}++-- | Regrouping a chain of infix operators by precedence.+module Tilia.Render.Operator+ ( -- * Chains+ OpChain (..),+ flatten,+ flattenAround,+ associate,++ -- * Asking about a chain+ chainSpan,+ lastOperand,+ isSeparator,+ )+where++import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE+import Data.Maybe (isNothing, mapMaybe)+import Tilia.Fixity (Direction (..), Fixity (..))+import Tilia.Span++-- | A chain of operator applications.+--+-- A branch holds @n + 1@ operands and @n@ operators, all of which bind+-- equally tightly. This is the shape layout wants: the operators of one+-- level are siblings, so the printer can decide once how that level breaks+-- rather than rediscovering it at every binary node.+data OpChain a op+ = Operand a+ | Chain (NonEmpty (OpChain a op)) [op]+ deriving (Eq, Show)++-- | Take a binary application tree apart into one flat run.+--+-- The decomposition function returns the two operands and the operator of a+-- node that is an application of an infix operator, and nothing for a node+-- that is a leaf.+flatten ::+ -- | Take one node apart, if it comes apart+ (a -> Maybe (a, op, a)) ->+ a ->+ (NonEmpty a, [op])+flatten split = go+ where+ go x = case split x of+ Nothing -> (x :| [], [])+ Just (l, op, r) ->+ let (ls, lops) = go l+ (rs, rops) = go r+ in (ls <> rs, lops <> [op] <> rops)++-- | 'flatten' for a node the caller has already taken apart.+--+-- The printers match on the operator application in order to reach its+-- parts, so by the time a chain is being built the outermost node has+-- already been destructured and there is nothing left to hand to 'flatten'.+flattenAround ::+ (a -> Maybe (a, op, a)) ->+ a ->+ op ->+ a ->+ (NonEmpty a, [op])+flattenAround split l op r =+ let (ls, lops) = flatten split l+ (rs, rops) = flatten split r+ in (ls <> rs, lops <> (op : rops))++-- | Regroup a flat run by precedence.+--+-- The loosest-binding operators of the run become the operators of the top+-- branch, and everything between two of them becomes a subtree, regrouped+-- the same way. When any operator in the run has no known precedence the run+-- is left as one flat branch: nothing is asserted about how it associates,+-- so nothing is rearranged.+associate ::+ -- | The fixity of an operator, if it was established+ (op -> Maybe Fixity) ->+ NonEmpty a ->+ [op] ->+ OpChain a op+associate fixityOf = build+ where+ build (x :| []) _ = Operand x+ build operands ops+ | any (isNothing . precedenceOf) ops = flatBranch operands ops+ | otherwise =+ case splitOn ((== Just loosest) . precedenceOf) operands ops of+ (groups, splitters) -> Chain (fmap (uncurry build) groups) splitters+ where+ loosest = minimum (mapMaybe precedenceOf ops)++ flatBranch operands ops = Chain (Operand <$> operands) ops+ precedenceOf = fmap fixityPrecedence . fixityOf++-- | Cut a run wherever the operator satisfies the predicate.+splitOn ::+ (op -> Bool) ->+ NonEmpty a ->+ [op] ->+ (NonEmpty (NonEmpty a, [op]), [op])+splitOn cuts (x0 :| xs) ops = go (x0 :| []) [] (zip ops xs)+ where+ go current currentOps [] = ((NE.reverse current, reverse currentOps) :| [], [])+ go current currentOps ((op, y) : rest)+ | cuts op =+ let (groups, splitters) = go (y :| []) [] rest+ in (NE.cons (NE.reverse current, reverse currentOps) groups, op : splitters)+ | otherwise = go (NE.cons y current) (op : currentOps) rest++----------------------------------------------------------------------------+-- Asking about a chain++-- | The region of the input a chain came from.+chainSpan :: (a -> Maybe Span) -> OpChain a op -> Maybe Span+chainSpan spanOfOperand = \case+ Operand x -> spanOfOperand x+ Chain xs _ -> foldr1 join' (chainSpan spanOfOperand <$> xs)+ where+ join' (Just a) (Just b) = Just (a <> b)+ join' a b = maybe b Just a++-- | The rightmost operand of a chain.+lastOperand :: OpChain a op -> a+lastOperand = \case+ Operand x -> x+ Chain xs _ -> lastOperand (NE.last xs)++-- | Is this operator one of the ones that exist to separate rather than to+-- combine?+isSeparator :: Maybe Fixity -> Bool+isSeparator = \case+ Just (Fixity RightAssoc 0) -> True+ _ -> False
+ src/Tilia/Render/Pattern.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- | Patterns.+module Tilia.Render.Pattern+ ( hsPat,+ fieldOcc,+ unboxedSum,+ )+where++import Data.List.NonEmpty qualified as NE+import Data.Maybe (isJust)+import GHC.Hs+import GHC.LanguageExtensions.Type (Extension (..))+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.Name+import Tilia.Render.Type+import Tilia.Span+import Tilia.Span.Ghc++-- | A pattern.+hsPat :: Ctx -> LPat GhcPs -> Doc+hsPat ctx = hsPatIn ctx NoBrace False++-- | A pattern that knows where it stands.+--+-- Two things about the surroundings reach into a pattern. The first is+-- whether an alternative of an or-pattern may be brace-delimited, which is+-- the same question every block faces. The second is whether we are inside+-- an @as@-pattern, where an or-pattern's alternatives must keep their+-- semicolons even when they go on separate lines, since a bare line break+-- would let the next alternative be read as a new argument.+hsPatIn :: Ctx -> Bracing -> Bool -> LPat GhcPs -> Doc+hsPatIn ctx bracing inAsPat l = at ctx l (patBody ctx bracing inAsPat (spanOf l))++patBody :: Ctx -> Bracing -> Bool -> Maybe Span -> Pat GhcPs -> Doc+patBody ctx bracing inAsPat here = \case+ WildPat _ -> txt "_"+ VarPat _ n -> name ctx n+ LazyPat _ p -> txt "~" <> recur p+ AsPat _ n p -> name ctx n <> txt "@" <> hsPatIn ctx bracing True p+ -- A pattern is nearly always an item of a layout block—an alternative of a+ -- @case@, the left of a @<-@ in a @do@ block—so its brackets close one+ -- step in. Where it is not, the extra step costs nothing.+ ParPat _ p -> parensWith Indented (insideBrackets here (recur p))+ BangPat _ p -> txt "!" <> recur p+ ListPat _ ps -> bracketsWith Indented (insideBrackets here (commaSep (map recur ps)))+ TuplePat _ ps boxity ->+ tupleBrackets boxity (insideBrackets here (commaSep (map (align . recur) ps)))+ OrPat _ ps ->+ itemsSepBy inAsPat bracing (map recur (NE.toList ps))+ SumPat _ p tag arity -> unboxedSum Indented tag arity (recur p)+ ConPat _ con details -> conPattern ctx bracing 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+ NPat _ v (isJust -> negated) _ ->+ includeWhen negated (txt "-" <> negativeGap ctx)+ <> at ctx v (outputable . ol_val)+ NPlusKPat _ n k _ _ _ ->+ align $+ name ctx n+ <> breakOrSpace+ <> indent (txt "+" <> space <> at ctx k (outputable . ol_val))+ SigPat _ p HsPS {..} ->+ recur p <> typeAscription ctx (asSigType hsps_body)+ EmbTyPat _ (HsTP _ ty) -> txt "type" <> space <> hsType ctx ty+ InvisPat _ (HsTP _ ty) -> txt "@" <> hsType ctx ty+ where+ recur = hsPatIn ctx bracing inAsPat++-- | A constructor pattern, in whichever of its three forms.+conPattern ::+ Ctx ->+ Bracing ->+ Bool ->+ Maybe Span ->+ LocatedN RdrName ->+ HsConPatDetails GhcPs ->+ Doc+conPattern ctx bracing inAsPat here con = \case+ PrefixCon args ->+ align $+ name ctx con+ <> includeUnless (null args) breakOrSpace+ <> indent (align (sepBy breakOrSpace (map (align . recur) args)))+ RecCon (HsRecFields _ fields dotdot) ->+ name ctx con+ <> breakOrSpace+ <> indent (braces (insideBrackets here (commaSep (map field (visibleFields dotdot fields)))))+ InfixCon l r ->+ layoutFrom ctx (spanOf l <> spanOf r) $+ recur l+ <> breakOrSpace+ <> indent (name ctx con <> space <> recur r)+ where+ recur = hsPatIn ctx bracing inAsPat+ field = either wildcard (at_ ctx (patFieldBind ctx))+ -- The @..@ has a location of its own, and needs it: a comment written+ -- against it has nothing else to attach to.+ wildcard l = at ctx l (const (txt ".."))+ -- A @..@ stands for the fields that were not written out, so it goes+ -- after the ones that were.+ visibleFields dotdot fields = case dotdot of+ Nothing -> Right <$> fields+ Just l@(L _ (RecFieldsDotDot n)) ->+ (Right <$> take n fields) <> [Left l]++patFieldBind :: Ctx -> HsRecField GhcPs (LPat GhcPs) -> Doc+patFieldBind ctx HsFieldBind {..} =+ at ctx hfbLHS (fieldOcc ctx)+ <> includeUnless+ hfbPun+ (joinedBy "=" <> indent (hsPat ctx hfbRHS))++-- | The name of a record field.+fieldOcc :: Ctx -> FieldOcc GhcPs -> Doc+fieldOcc ctx FieldOcc {..} = name ctx foLabel++----------------------------------------------------------------------------+-- Shapes shared with expressions++-- | An unboxed sum: the one alternative that is present, with a bar for each+-- one that is not.+unboxedSum :: ClosingIndent -> ConTag -> Arity -> Doc -> Doc+unboxedSum closing tag arity d =+ unboxedWith closing (sepBy (txt "|") (before <> [space <> d <> space] <> after))+ where+ before = replicate (tag - 1) space+ after = replicate (arity - tag) space++tupleBrackets :: Boxity -> Doc -> Doc+tupleBrackets = \case+ Boxed -> parensWith Indented+ Unboxed -> unboxedWith Indented++-- | With @NegativeLiterals@ on, @- 1@ and @-1@ are different expressions, so+-- the minus of a negated literal has to keep its distance.+negativeGap :: Ctx -> Doc+negativeGap ctx = includeWhen (extensionOn ctx NegativeLiterals) space
+ src/Tilia/Render/Pragma.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- | The @{-# … #-}@ annotations that appear among declarations.+--+-- These look like comments and are not: the compiler reads them, so their+-- content is not ours to reflow and their placement is not ours to change.+-- What is ours is where the braces break, which is all this module decides.+--+-- The @LANGUAGE@ and @OPTIONS_GHC@ pragmas of the file header are not here.+-- They are part of the header rather than of any declaration, they are+-- sorted rather than left where they were, and they are handled in+-- "Tilia.Render.Header".+module Tilia.Render.Pragma+ ( -- * Braces+ pragmaBrackets,+ pragma,++ -- * Inlining and rules+ activation,+ inlineSpec,++ -- * Instances+ overlapMode,++ -- * Warnings+ warnDecls,+ warningTxt,+ )+where++import Data.Text (Text)+import GHC.Hs+import GHC.Types.Basic hiding (overlapMode)+import GHC.Types.SourceText+import GHC.Types.SrcLoc (GenLocated (..), unLoc)+import GHC.Unit.Module.Warnings+import Tilia.Doc.Combinators+import Tilia.Render.Context+import Tilia.Render.Name++----------------------------------------------------------------------------+-- Braces++-- | Wrap a body in pragma braces.+--+-- The closing brace is indented when the pragma breaks, which keeps it from+-- being mistaken for the start of a new declaration.+pragmaBrackets :: Doc -> Doc+pragmaBrackets body =+ align (txt "{-#" <> space <> body <> breakOrSpace <> indent (txt "#-}"))++-- | A named pragma with a body.+pragma :: Text -> Doc -> Doc+pragma pragmaName body =+ pragmaBrackets (txt pragmaName <> breakOrSpace <> body)++----------------------------------------------------------------------------+-- Inlining and rules++-- | The phase control of an @INLINE@ or @RULES@ pragma.+activation :: Activation -> Doc+activation = \case+ NeverActive -> txt "[~]"+ AlwaysActive -> mempty+ ActiveBefore _ n -> txt "[~" <> outputable n <> txt "]"+ ActiveAfter _ n -> txt "[" <> outputable n <> txt "]"+ FinalActive -> error "Tilia: FinalActive is not expected in parsed source"++-- | Which flavour of inlining was asked for.+inlineSpec :: InlineSpec -> Doc+inlineSpec = \case+ Inline _ -> txt "INLINE"+ Inlinable _ -> txt "INLINEABLE"+ NoInline _ -> txt "NOINLINE"+ Opaque _ -> txt "OPAQUE"+ NoUserInlinePrag -> mempty++----------------------------------------------------------------------------+-- Instances++-- | The overlap pragma of an instance, and the separator after it.+overlapMode :: Maybe (LocatedP OverlapMode) -> Maybe Doc+overlapMode mode = txt . braced <$> (spelled . unLoc =<< mode)+ where+ -- Written out whole rather than built with 'pragmaBrackets': an overlap+ -- mode is one word and must never be broken across lines.+ braced keyword = "{-# " <> keyword <> " #-}"++ spelled = \case+ Overlappable {} -> Just "OVERLAPPABLE"+ Overlapping {} -> Just "OVERLAPPING"+ Overlaps {} -> Just "OVERLAPS"+ Incoherent {} -> Just "INCOHERENT"+ -- The rest are what an instance means when it says nothing about+ -- overlapping, so nothing is what they are written as.+ _ -> Nothing++----------------------------------------------------------------------------+-- Warnings++-- | A @WARNING@ or @DEPRECATED@ declaration.+warnDecls :: Ctx -> WarnDecls GhcPs -> Doc+warnDecls ctx (Warnings _ warnings) = case warnings of+ [] -> mempty+ (L _ (Warning _ _ wtxt) : _) ->+ layoutAcross ctx warnings+ . pragma (keywordOf wtxt)+ . indent+ $ sepBy (txt ";" <> breakOrSpace) (map (at_ ctx (warned ctx)) warnings)+ where+ keywordOf wtxt = let (keyword, _, _) = warningParts wtxt in keyword++-- | One of the things a warning declaration names.+warned :: Ctx -> WarnDecl GhcPs -> Doc+warned ctx (Warning (namespace, _) names wtxt) =+ category+ <> namespaceSpec namespace+ <> commaSep (map (name ctx) names)+ <> breakOrSpace+ <> literalList literals+ where+ (_, category, literals) = warningParts wtxt++-- | A warning attached to a name in an export list or to an instance.+warningTxt :: WarningTxt GhcPs -> Doc+warningTxt wtxt =+ indent (pragma keyword (indent (category <> literalList literals)))+ where+ (keyword, category, literals) = warningParts wtxt++-- | Which keyword introduces a warning, which category it is filed under,+-- and what it says.+--+-- The keyword is written once for a whole declaration even when it names+-- several things, whereas the category belongs to each of them separately.+-- That is why the two do not come back as one piece of text.+warningParts :: WarningTxt GhcPs -> (Text, Doc, [LocatedE StringLiteral])+warningParts = \case+ DeprecatedTxt _ literals -> ("DEPRECATED", mempty, said literals)+ WarningTxt category _ literals ->+ ("WARNING", foldMap named category, said literals)+ where+ said = map (fmap hsDocString)+ named (unLoc -> InWarningCategory {..}) =+ txt ("in \"" <> showGhc (unLoc iwc_wc) <> "\"") <> space++-- | One message is written bare; several go in a list.+literalList :: [LocatedE StringLiteral] -> Doc+literalList = \case+ [l] -> outputable l+ ls -> brackets (commaSep (map outputable ls))
+ src/Tilia/Render/Signature.hs view
@@ -0,0 +1,280 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Signatures, and the pragmas that are written like them.+module Tilia.Render.Signature+ ( sigDecl,+ standaloneKindSig,+ ruleDecls,+ specialisedName,+ )+where++import Data.Maybe (maybeToList)+import GHC.Data.BooleanFormula+import GHC.Hs+import GHC.Types.Basic+ ( Activation (..),+ InlinePragma (..),+ InlineSpec (..),+ RuleMatchInfo (..),+ RuleName,+ )+import GHC.Types.Fixity (Fixity (..), FixityDirection (..))+import GHC.Types.Name.Reader (RdrName)+import GHC.Types.SourceText+import GHC.Types.SrcLoc (GenLocated (..), unLoc)+import Tilia.Doc.Combinators+import Tilia.Render.Context+import Tilia.Render.Expression (hsExpr)+import Tilia.Render.Name+import Tilia.Render.Pragma+import Tilia.Render.Type+import Tilia.Span (startOf)+import Tilia.Span.Ghc (tokenSpan)++-- | A signature declaration.+sigDecl :: Ctx -> Sig GhcPs -> Doc+sigDecl ctx = \case+ TypeSig _ names hswc -> typeSig ctx True names (hswc_body hswc)+ PatSynSig _ names sigType -> patSynSig ctx names sigType+ ClassOpSig _ isDefault names sigType ->+ includeWhen isDefault (txt "default" <> space) <> typeSig ctx True names sigType+ FixSig _ sig -> fixitySig ctx sig+ InlineSig _ n prag -> inlineSig ctx n prag+ SpecSig _ n types prag ->+ specialiseSig ctx Nothing (noLocA (HsVar NoExtField n)) types prag+ SpecSigE _ binders e prag -> specialiseSigE ctx binders e prag+ SpecInstSig _ sigType ->+ pragma "SPECIALIZE instance" (indent (hsSigType ctx sigType))+ MinimalSig _ formula ->+ at ctx formula (pragma "MINIMAL" . indent . booleanFormula ctx)+ CompleteMatchSig _ names ty -> completeSig ctx names ty+ SCCFunSig _ n literal -> sccSig ctx n literal++-- | @f, g :: t@.+--+-- Only the first name sits on the line the signature starts on; the rest+-- are indented under it, unless the caller says not to, which is what a+-- pattern synonym signature wants so that its names line up after+-- @pattern@.+typeSig ::+ Ctx ->+ -- | Indent the names after the first?+ Bool ->+ [LocatedN RdrName] ->+ LHsSigType GhcPs ->+ Doc+typeSig _ _ [] _ = mempty+typeSig ctx indentTail (n : ns) sigType+ | null ns = name ctx n <> typeAscription ctx sigType+ | otherwise =+ name ctx n+ <> nest+ (if indentTail then 1 else 0)+ ( comma+ <> breakOrSpace+ <> commaSep (map (name ctx) ns)+ <> typeAscription ctx sigType+ )++patSynSig :: Ctx -> [LocatedN RdrName] -> LHsSigType GhcPs -> Doc+patSynSig ctx names sigType+ | length names > 1 = txt "pattern" <> breakOrSpace <> indent body+ | otherwise = txt "pattern" <> space <> body+ where+ body = typeSig ctx False names sigType++fixitySig :: Ctx -> FixitySig GhcPs -> Doc+fixitySig ctx (FixitySig namespace names (Fixity precedence direction)) =+ txt keyword+ <> space+ <> outputable precedence+ <> space+ <> namespaceSpec namespace+ <> align (commaSep (map (name ctx) names))+ where+ keyword = case direction of+ InfixL -> "infixl"+ InfixR -> "infixr"+ InfixN -> "infix"++inlineSig :: Ctx -> LocatedN RdrName -> InlinePragma -> Doc+inlineSig ctx n InlinePragma {..} =+ pragmaBrackets $+ inlineSpec inl_inline+ <> space+ <> conLike+ <> space+ <> includeUnless (inl_act == NeverActive) (activation inl_act)+ <> space+ <> name ctx n+ where+ conLike = case inl_rule of+ ConLike -> txt "CONLIKE"+ FunLike -> mempty++-- | A @SPECIALIZE@ pragma.+specialiseSig ::+ Ctx ->+ Maybe (RuleBndrs GhcPs) ->+ LHsExpr GhcPs ->+ [LHsSigType GhcPs] ->+ InlinePragma ->+ Doc+specialiseSig ctx binders target types InlinePragma {..} =+ pragmaBrackets $+ txt "SPECIALIZE"+ <> space+ <> inlineSpec inl_inline+ <> space+ <> phase+ <> indent+ ( space+ <> foldMap (\bs -> ruleBinders ctx bs <> space) binders+ <> hsExpr ctx target+ <> includeUnless+ (null types)+ (joinedBy "::" <> commaSep (map (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 @[~]@.+ phase = case (inl_inline, inl_act) of+ (NoInline _, NeverActive) -> mempty+ _ -> activation inl_act++specialiseSigE ::+ Ctx ->+ RuleBndrs GhcPs ->+ LHsExpr GhcPs ->+ InlinePragma ->+ Doc+specialiseSigE ctx binders e =+ specialiseSig ctx (Just binders) target (maybeToList sigTy)+ where+ (_, target, sigTy) = takeApartSpecExpr e++-- | Pull a @SPECIALIZE@ expression apart into the name, the application and+-- the signature.+--+-- The expression in this position can only be a variable applied to+-- arguments, optionally with a type ascription, so the name is always+-- reachable by walking down the left spine.+takeApartSpecExpr ::+ LHsExpr GhcPs ->+ (LocatedN RdrName, LHsExpr GhcPs, Maybe (LHsSigType GhcPs))+takeApartSpecExpr expr = (specHead applied, applied, signature)+ where+ (applied, signature) = specBody expr++-- | A @SPECIALIZE@ expression without the type ascription it may carry.+--+-- Everything else here works on the expression under the ascription: that+-- is what the pragma is about, and the ascription is printed separately.+specBody :: LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe (LHsSigType GhcPs))+specBody = \case+ L _ (ExprWithTySig _ e HsWC {hswc_body}) -> (e, Just hswc_body)+ e -> (e, Nothing)++-- | The function a @SPECIALIZE@ expression applies.+--+-- Whatever else the expression does, it is an application, and the pragma+-- names whatever sits at the head of it.+specHead :: LHsExpr GhcPs -> LocatedN RdrName+specHead (L _ e) = case e of+ HsVar _ n -> n+ HsApp _ f _ -> specHead f+ HsAppType _ f _ -> specHead f+ _ -> error "Tilia: a SPECIALIZE expression always has a head variable"++-- | The name a @SPECIALIZE@ pragma is about, for grouping declarations.+specialisedName :: Sig GhcPs -> Maybe RdrName+specialisedName = \case+ SpecSig _ (L _ n) _ _ -> Just n+ SpecSigE _ _ e _ -> Just (unLoc (specHead (fst (specBody e))))+ _ -> Nothing++booleanFormula :: Ctx -> BooleanFormula GhcPs -> Doc+booleanFormula ctx = \case+ Var n -> name ctx n+ And xs -> align (commaSep (map (at_ ctx (booleanFormula ctx)) xs))+ Or xs ->+ align (sepBy (breakOrSpace <> txt "|" <> space) (map (at_ ctx (booleanFormula ctx)) xs))+ Parens l -> at ctx l (parens . booleanFormula ctx)++completeSig :: Ctx -> [LIdP GhcPs] -> Maybe (LocatedN RdrName) -> Doc+completeSig ctx names ty =+ layoutAcross ctx names . pragma "COMPLETE" . indent $+ commaSep (map (name ctx) names)+ <> foldMap+ (\t -> joinedBy "::" <> indent (name ctx t))+ ty++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++-- | @type T :: k@.+standaloneKindSig :: Ctx -> StandaloneKindSig GhcPs -> Doc+standaloneKindSig ctx (StandaloneKindSig _ n sigTy) =+ txt "type"+ <> indent+ ( space+ <> name ctx n+ <> joinedBy "::"+ <> hsSigType ctx sigTy+ )++----------------------------------------------------------------------------+-- Rewrite rules++-- | A @RULES@ block.+--+-- The closing @#-\}@ is given an anchor of its own, so that a comment+-- written after the last rule and before it stays inside the pragma. There+-- is nothing else down there for such a comment to attach to, and outside+-- the braces it would read as a remark on whatever follows the block.+ruleDecls :: Ctx -> RuleDecls GhcPs -> Doc+ruleDecls ctx (HsRules ((_, close), _) rules) =+ pragma "RULES" $+ sepBy breakOrSpace (map (align . at_ ctx (ruleDecl ctx)) rules)+ <> foldMap (emptyAnchor . startOf) (tokenSpan close)++ruleDecl :: Ctx -> RuleDecl GhcPs -> Doc+ruleDecl ctx (HsRule _ ruleName phase binders lhs rhs) =+ at ctx ruleName ruleNameLiteral+ <> space+ <> activation phase+ <> space+ <> ruleBinders ctx binders+ <> breakOrSpace+ <> indent+ ( hsExpr ctx lhs+ <> space+ <> 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+ruleBinders ctx (RuleBndrs HsRuleBndrsAnn {..} tyvars binders) =+ foldMap+ (\xs -> forallBndrs ctx Invisible (tyVarBndr ctx) xs <> space)+ tyvars+ <> case rb_tmanns of+ Nothing -> mempty+ Just _ -> forallBndrs ctx Invisible (ruleBinder ctx) binders++ruleBinder :: Ctx -> RuleBndr GhcPs -> Doc+ruleBinder ctx = \case+ RuleBndr _ n -> name ctx n+ RuleBndrSig _ n HsPS {..} ->+ parens (name ctx n <> typeAscription ctx (asSigType hsps_body))
+ src/Tilia/Render/Type.hs view
@@ -0,0 +1,479 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++-- | Types.+module Tilia.Render.Type+ ( -- * Types+ hsType,+ hsTypeBody,+ hsSigType,+ hsSigTypeBody,+ typeAscription,++ -- * Contexts+ context,+ contextOf,++ -- * Binders+ TyVarBndrFlag (..),+ tyVarBndr,+ Visibility (..),+ forallBndrs,+ forallTelescope,+ outerBndrs,++ -- * Record fields+ recordFieldsAt,+ conDeclField,+ documentedConDeclField,+ strictness,++ -- * Arguments+ typeArgument,+ typeArgSpan,++ -- * Asking about a type+ typeIsDocumented,++ -- * Conversions+ asSigType,+ )+where++import Data.List.NonEmpty (NonEmpty (..))+import Data.Text qualified as T+import GHC.Hs+import GHC.Types.Name.Occurrence (isTvOcc)+import GHC.Types.Name.Reader (RdrName, rdrNameOcc)+import GHC.Types.SourceText+import GHC.Types.SrcLoc (GenLocated (..), getLoc, unLoc)+import GHC.Types.Var (Specificity (..))+import Tilia.Doc.Combinators+import Tilia.Fixity (Namespace (..))+import Tilia.Render.Context+import Tilia.Render.Haddock+import Tilia.Render.Literal (stringLiteral)+import Tilia.Render.Name+import Tilia.Render.Operator+import Tilia.Span+import Tilia.Span.Ghc++----------------------------------------------------------------------------+-- Types++-- | A type.+hsType :: Ctx -> LHsType GhcPs -> Doc+hsType ctx l = at ctx l (hsTypeBody ctx (spanOf l))++-- | A type whose location the caller has already entered.+hsTypeBody :: Ctx -> Maybe Span -> HsType GhcPs -> Doc+hsTypeBody ctx here t = typeBody ctx (typeIsDocumented t) here t++-- | The body of a type, with the decision about its arguments handed down.+--+-- A type one of whose arguments carries documentation cannot keep its arrows+-- on one line: the Haddock takes the rest of the line with it. So the+-- question is settled once, at the outermost type, and passed inwards—a+-- nested arrow has to know what the whole signature decided rather than what+-- its own subtree would have decided on its own.+typeBody :: Ctx -> Bool -> Maybe Span -> HsType GhcPs -> Doc+typeBody ctx documented here = \case+ HsForAllTy _ tele t ->+ forallTelescope ctx tele <> betweenArgs <> hsType ctx t+ HsQualTy _ qs t ->+ context ctx qs+ <> space+ <> txt "=>"+ <> betweenArgs+ <> case unLoc t of+ -- A nested context or arrow inherits the outer type's decision+ -- rather than making a fresh one, so a signature breaks all of its+ -- arrows or none of them.+ HsQualTy {} -> recur (unLoc t)+ HsFunTy {} -> hsType ctx t+ _ -> at ctx t recur+ HsTyVar _ promoted n -> promotion promoted n <> name ctx n+ HsAppTy _ f x ->+ let (func, args) = gatherAppArgs f [x]+ in layoutFrom ctx (spanOf f <> spansOf args) . align $+ hsType ctx func+ <> breakOrSpace+ <> indent (sepBy breakOrSpace (map (hsType ctx) args))+ HsAppKindTy _ ty kd ->+ align (hsType ctx ty <> breakOrSpace <> indent (txt "@" <> hsType ctx kd))+ HsFunTy _ multAnn x y ->+ hsType ctx x+ <> space+ <> multiplicity (at_ ctx recur) multAnn+ <> space+ <> txt "->"+ <> betweenArgs+ <> case unLoc y of+ HsFunTy {} -> recur (unLoc y)+ _ -> at ctx y recur+ HsListTy _ t ->+ layoutWithin ctx here (spanOf t) $+ brackets (insideBrackets here (hsType ctx t))+ HsTupleTy _ sort xs ->+ layoutWithin ctx here (spansOf xs) $+ tupleBrackets sort (insideBrackets here (commaSep (map (align . hsType ctx) xs)))+ HsSumTy _ xs ->+ unboxed (sepBy (joinedBy "|") (map (align . hsType ctx) xs))+ HsOpTy _ _ x op y -> typeChain ctx x op y+ HsParTy _ t ->+ layoutWithin ctx here (spanOf t) (parens (insideBrackets here (hsType ctx t)))+ HsIParamTy _ n t ->+ align (at ctx n outputable <> joinedBy "::" <> indent (hsType ctx t))+ HsStarTy _ _ -> txt "*"+ HsKindSig _ t k ->+ align (hsType ctx t <> joinedBy "::" <> indent (hsType ctx k))+ HsSpliceTy _ splice -> knotSplice (ctxKnot ctx) ctx DollarSplice splice+ HsDocTy _ t str -> haddockInline ctx Pipe str <> hsType ctx t+ HsExplicitListTy _ promoted xs ->+ tick promoted+ <> brackets (insideBrackets here (quoteGap promoted xs <> commaSep (map (align . hsType ctx) xs)))+ HsExplicitTupleTy _ promoted xs ->+ tick promoted+ <> parens (insideBrackets here (quoteGap promoted xs <> commaSep (map (hsType ctx) xs)))+ HsTyLit _ t -> case t of+ HsStrTy (SourceText s) _ -> stringLiteral s+ other -> outputable other+ HsWildCardTy _ -> txt "_"+ XHsType ext -> case ext of+ HsCoreTy t -> outputable t+ HsBangTy _ (HsSrcBang _ unpacked strict) t ->+ unpackPragma unpacked <> strictness strict <> hsType ctx t+ -- A bare record type has no wrapper of its own, so there is no span to+ -- anchor a comment written inside empty braces to.+ HsRecTy _ fields -> recordFields ctx Nothing fields+ where+ recur = typeBody ctx documented Nothing+ betweenArgs = if documented then hardBreak else breakOrSpace++----------------------------------------------------------------------------+-- Operator chains++-- | A chain of type operators, regrouped by precedence.+typeChain :: Ctx -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> Doc+typeChain ctx x op y =+ renderChain ctx (uncurry (associate fixity) (flattenAround split x op y))+ where+ split t = case unLoc t of+ HsOpTy _ _ l o r -> Just (l, o, r)+ _ -> Nothing+ fixity o = operatorFixity ctx InTypes (unLoc o)++renderChain :: Ctx -> OpChain (LHsType GhcPs) (LocatedN RdrName) -> Doc+renderChain ctx = \case+ Operand t -> hsType ctx t+ chain@(Chain (firstOne :| rest) operators) ->+ layoutFrom ctx (chainSpan spanOf chain) $+ renderChain ctx firstOne <> mconcat (zipWith piece operators rest)+ where+ -- Type operators have no hanging form: no type absorbs a line break the+ -- way a @do@ block does, so a broken chain always indents.+ piece op operand =+ attach Normal (name ctx op <> space <> renderChain ctx operand)++----------------------------------------------------------------------------+-- Pieces of a type++-- | Gather a nest of applications into a head and its arguments.+--+-- The tree is built one argument at a time, which would lay @F a b c@ out as+-- though each application were a separate decision. Collecting them first+-- lets the whole application break as one.+gatherAppArgs :: LHsType GhcPs -> [LHsType GhcPs] -> (LHsType GhcPs, [LHsType GhcPs])+gatherAppArgs f known = case unLoc f of+ HsAppTy _ l r -> gatherAppArgs l (r : known)+ _ -> (f, known)++tupleBrackets :: HsTupleSort -> Doc -> Doc+tupleBrackets = \case+ HsUnboxedTuple -> unboxed+ HsBoxedOrConstraintTuple -> parens++tick :: PromotionFlag -> Doc+tick = \case+ 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.+promotion :: PromotionFlag -> LocatedN RdrName -> Doc+promotion NotPromoted _ = mempty+promotion IsPromoted n = txt "'" <> includeWhen (beginsWithTick (showGhc (unLoc n))) space+ where+ beginsWithTick shown = case T.uncons (T.drop 1 shown) of+ Just ('\'', _) -> True+ _ -> False++-- | A promoted list or tuple whose first element is itself promoted needs a+-- space, or @'['a]@ would begin with a character literal.+quoteGap :: PromotionFlag -> [LHsType GhcPs] -> Doc+quoteGap IsPromoted (t : _) | startsWithTick (unLoc t) = space+quoteGap _ _ = mempty++startsWithTick :: HsType GhcPs -> Bool+startsWithTick = \case+ HsAppTy _ (L _ f) _ -> startsWithTick f+ HsTyVar _ IsPromoted _ -> True+ HsExplicitTupleTy {} -> True+ HsExplicitListTy {} -> True+ HsTyLit _ HsCharTy {} -> True+ _ -> False++-- | The pragma asking for a field to be unpacked, or not to be.+unpackPragma :: SrcUnpackedness -> Doc+unpackPragma = \case+ SrcUnpack -> txt "{-# UNPACK #-}" <> space+ SrcNoUnpack -> txt "{-# NOUNPACK #-}" <> space+ NoSrcUnpack -> mempty++-- | The @!@ or @~@ in front of a field.+strictness :: SrcStrictness -> Doc+strictness = \case+ SrcLazy -> txt "~"+ SrcStrict -> txt "!"+ NoSrcStrict -> mempty++-- | Does any argument of this type carry documentation?+typeIsDocumented :: HsType GhcPs -> Bool+typeIsDocumented = any documented . spine+ where+ documented = \case+ HsDocTy {} -> True+ _ -> False++-- | The pieces of a type that a signature would put on lines of their own:+-- the argument and result types, and whatever a @forall@ or a context is+-- wrapped around.+--+-- Not the types nested inside those. A Haddock written on an element of a+-- list argument documents the element and says nothing about how the+-- signature it sits in should be laid out.+spine :: HsType GhcPs -> [HsType GhcPs]+spine t =+ t : case t of+ HsFunTy _ _ a b -> spine (unLoc a) <> spine (unLoc b)+ HsForAllTy _ _ b -> spine (unLoc b)+ HsQualTy _ _ b -> spine (unLoc b)+ _ -> []++----------------------------------------------------------------------------+-- Contexts++-- | A class context, as it appears before a @=>@.+context :: Ctx -> LHsContext GhcPs -> Doc+context ctx = at_ ctx (contextOf loneVariable (hsType ctx) . map unbracket)++-- | Is this constraint nothing but a type variable?+loneVariable :: LHsType GhcPs -> Bool+loneVariable t = case unLoc t of+ HsTyVar _ _ (L _ n) -> isTvOcc (rdrNameOcc n)+ _ -> False++-- | A constraint without the brackets a context puts around it anyway.+--+-- Stripped before the context writes its own, or formatting would add a+-- layer every time it ran.+unbracket :: LHsType GhcPs -> LHsType GhcPs+unbracket t = case unLoc t of+ HsParTy _ inner -> unbracket inner+ _ -> t++-- | A context over anything that can stand as a constraint.+contextOf ::+ -- | Is this constraint nothing but a variable?+ (a -> Bool) ->+ (a -> Doc) ->+ [a] ->+ Doc+contextOf lone render = \case+ [] -> txt "()"+ [x] | lone x -> render x+ xs -> parens (commaSep (map (align . render) xs))++----------------------------------------------------------------------------+-- Binders++-- | The flags a type variable binder may carry.+--+-- Three kinds of binder exist with three different flag types, and each+-- decides both whether the binder is inferred—which is what braces around it+-- mean—and whether anything is printed in front of it.+class TyVarBndrFlag flag where+ flagIsInferred :: flag -> Bool+ flagPrefix :: flag -> Doc+ flagPrefix _ = mempty++instance TyVarBndrFlag () where+ flagIsInferred () = False++instance TyVarBndrFlag Specificity where+ flagIsInferred = \case+ InferredSpec -> True+ SpecifiedSpec -> False++instance TyVarBndrFlag (HsBndrVis GhcPs) where+ flagIsInferred _ = False+ flagPrefix = \case+ HsBndrRequired NoExtField -> mempty+ HsBndrInvisible _ -> txt "@"++-- | One type variable binder.+tyVarBndr :: (TyVarBndrFlag flag) => Ctx -> HsTyVarBndr flag GhcPs -> Doc+tyVarBndr ctx HsTvb {..} = flagPrefix tvb_flag <> enclosed (binder <> kind)+ where+ binder = case tvb_var of+ HsBndrVar _ x -> name ctx x+ HsBndrWildCard _ -> txt "_"++ -- Whether a kind is written and whether brackets are needed are the same+ -- question, so they are answered together.+ (kind, kinded) = case tvb_kind of+ HsBndrNoKind _ -> (mempty, False)+ HsBndrKind _ k ->+ (joinedBy "::" <> indent (hsType ctx k), True)++ enclosed+ | flagIsInferred tvb_flag = braces+ | kinded = parens+ | otherwise = id++-- | Whether a @forall@ binds visibly.+data Visibility+ = -- | @forall a.@+ Invisible+ | -- | @forall a ->@+ Visible+ deriving (Eq, Show)++-- | The variables of a @forall@, with the punctuation that closes it.+forallBndrs ::+ (HasLoc l) =>+ Ctx ->+ Visibility ->+ (a -> Doc) ->+ [GenLocated l a] ->+ Doc+forallBndrs _ Invisible _ [] = txt "forall."+forallBndrs _ Visible _ [] = txt "forall ->"+forallBndrs ctx visibility render bndrs =+ layoutAcross ctx bndrs $+ txt "forall"+ <> breakOrSpace+ <> indent (align (sepBy breakOrSpace (map (align . at_ ctx render) bndrs)) <> close)+ where+ close = case visibility of+ Invisible -> txt "."+ Visible -> space <> txt "->"++-- | The @forall@ that opens a type.+forallTelescope :: Ctx -> HsForAllTelescope GhcPs -> Doc+forallTelescope ctx = \case+ HsForAllInvis _ bndrs -> forallBndrs ctx Invisible (tyVarBndr ctx) bndrs+ HsForAllVis _ bndrs -> forallBndrs ctx Visible (tyVarBndr ctx) bndrs++-- | The binders a signature quantifies over, when it names them.+outerBndrs :: Ctx -> HsOuterTyVarBndrs Specificity GhcPs -> Doc+outerBndrs ctx = \case+ HsOuterImplicit _ -> mempty+ HsOuterExplicit _ bndrs -> forallTelescope ctx (mkHsForAllInvisTele noAnn bndrs)++----------------------------------------------------------------------------+-- Signatures++-- | A type together with whatever it quantifies over.+hsSigType :: Ctx -> LHsSigType GhcPs -> Doc+hsSigType ctx = at_ ctx (hsSigTypeBody ctx)++-- | A signature type whose location the caller has already entered.+hsSigTypeBody :: Ctx -> HsSigType GhcPs -> Doc+hsSigTypeBody ctx HsSig {..} =+ outerBndrs ctx sig_bndrs+ <> ( case sig_bndrs of+ HsOuterImplicit {} -> mempty+ HsOuterExplicit {} -> afterBinders+ )+ <> hsType ctx sig_body+ where+ afterBinders+ | typeIsDocumented (unLoc sig_body) = hardBreak+ | otherwise = breakOrSpace++-- | The @:: t@ that follows a name.+--+-- A signature with documentation in it breaks unconditionally, since a+-- Haddock on the first argument would otherwise take the @::@ with it.+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++-- | Give a plain type the shape of a signature type.+asSigType :: LHsType GhcPs -> LHsSigType GhcPs+asSigType ty = L (getLoc ty) (HsSig NoExtField (HsOuterImplicit NoExtField) ty)++----------------------------------------------------------------------------+-- Record fields++-- | The braces of a record, and the fields inside them.+recordFieldsAt :: Ctx -> XRec GhcPs [LHsConDeclRecField GhcPs] -> Doc+recordFieldsAt ctx l = at ctx l (recordFields ctx (spanOf l))++-- | The fields of a record.+--+-- A record with no fields still needs something between its braces for a+-- comment written there to attach to, or the comment would be pushed outside+-- them and end up documenting the constructor.+recordFields :: Ctx -> Maybe Span -> [LHsConDeclRecField GhcPs] -> Doc+recordFields ctx enclosing xs =+ brokenIfDocumented ctx xs . braces . insideBrackets enclosing $+ commaSep (map (align . at_ ctx (recordField ctx)) xs)++recordField :: Ctx -> HsConDeclRecField GhcPs -> Doc+recordField ctx HsConDeclRecField {..} =+ foldMap (haddockInline ctx Pipe) (cdf_doc cdrf_spec)+ <> align (commaSep (map (at_ ctx (name ctx . foLabel)) cdrf_names))+ <> space+ <> multiplicity (hsType ctx) (cdf_multiplicity cdrf_spec)+ <> joinedBy "::"+ <> align (indent (conDeclField ctx cdrf_spec))++-- | A constructor field, without its documentation or its multiplicity.+--+-- Those two are left to the caller because there is no one place they+-- belong: a record field puts the multiplicity before the @::@ and a GADT+-- argument puts it before the arrow.+conDeclField :: Ctx -> HsConDeclField GhcPs -> Doc+conDeclField ctx CDF {..} =+ unpackPragma cdf_unpack+ <> at ctx cdf_type (\ty -> strictness cdf_bang <> hsTypeBody ctx (spanOf cdf_type) ty)++-- | A constructor field with its documentation in front of it.+documentedConDeclField :: Ctx -> HsConDeclField GhcPs -> Doc+documentedConDeclField ctx cdf =+ foldMap (haddockInline ctx Pipe) (cdf_doc cdf) <> conDeclField ctx cdf++----------------------------------------------------------------------------+-- Arguments++-- | One argument on the left of a family or data instance.+typeArgument :: Ctx -> LHsTypeArg GhcPs -> Doc+typeArgument ctx = \case+ HsValArg NoExtField ty -> hsType ctx ty+ -- The annotation holds the span of the @\@@, which is always immediately+ -- in front of the type, so nothing is lost by not entering it.+ HsTypeArg _ ty -> txt "@" <> hsType ctx ty+ HsArgPar _ -> error "Tilia: HsArgPar is not expected in parsed source"++-- | Where an argument was.+typeArgSpan :: LHsTypeArg GhcPs -> Maybe Span+typeArgSpan = spanOfSrcSpan . lhsTypeArgSrcSpan
+ src/Tilia/Run.hs view
@@ -0,0 +1,262 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Running the formatter over a set of files.+module Tilia.Run+ ( -- * Outcomes+ Outcome (..),+ declined,+ failed,+ differs,+ exitCodeOf,++ -- * Execution+ runOver,+ readAsUtf8,+ formattingOutcome,+ writeBack,+ inParallel,++ -- * Report+ Report (..),+ inplaceReport,+ checkReport,+ noted,+ )+where++import Control.Concurrent (forkIO, getNumCapabilities, newEmptyMVar, putMVar, takeMVar)+import Control.Monad (replicateM)+import Data.ByteString qualified as BS+import Data.Foldable (for_, traverse_)+import Data.IORef+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),+ Session,+ describeFormatError,+ formatErrorExitCode,+ formatSource,+ refused,+ )+import Tilia.Newline (NewlineStyle (Lf), getNewlineStyle, setNewlineStyle)+import Tilia.Palette (Color (Bad, Good, Middling, Place), Palette, marker, paint)+import Tilia.Utils (attempted, indent, lineWidth, wrapTo)++----------------------------------------------------------------------------+-- Outcomes++-- | What became of one file.+data Outcome+ = -- | Formatted, and it was already in that shape.+ Unchanged+ | -- | Formatted, and this is what it should say instead.+ Changed Text Text+ | -- | Declined.+ Declined FormatError+ | -- | Failed to format.+ Failed FormatError++-- | Was the file left alone because we would not touch it?+declined :: Outcome -> Bool+declined = \case+ Declined {} -> True+ _ -> False++-- | Was the file left alone because something is wrong with it?+failed :: Outcome -> Bool+failed = \case+ Failed {} -> True+ _ -> False++-- | Would formatting change the file?+differs :: Outcome -> Bool+differs = \case+ Changed {} -> True+ _ -> False++-- | What a run that met a failure should exit with.+--+-- 'Nothing' where nothing failed. Where several did, the lowest of their+-- codes: they are all true, and one of them has to be picked, so it may as+-- well be picked the same way every time.+exitCodeOf :: [(FilePath, Outcome)] -> Maybe Int+exitCodeOf outcomes =+ case [formatErrorExitCode e | (_, Failed e) <- outcomes] of+ [] -> Nothing+ codes -> Just (minimum codes)++----------------------------------------------------------------------------+-- Execution++-- | Format every file, as many at a time as the machine allows.+runOver :: Session -> [FilePath] -> IO [(FilePath, Outcome)]+runOver session = inParallel one+ where+ one path = do+ !outcome <-+ readAsUtf8 path >>= \case+ Left why -> pure (Failed (Unreadable path why))+ Right before ->+ formatSource session path (setNewlineStyle Lf before) >>= \case+ Left e -> pure (if refused e then Declined e else Failed e)+ Right formatted -> pure (formattingOutcome before formatted)+ pure (path, outcome)++-- | Read a source file as UTF-8.+readAsUtf8 :: FilePath -> IO (Either Text Text)+readAsUtf8 path =+ attempted (BS.readFile path) >>= \case+ Left why -> pure (Left why)+ Right bytes -> pure $ case T.decodeUtf8' bytes of+ Right text -> Right text+ Left _ -> Left "it is not valid UTF-8"++-- | Formatting outcome for a file.+formattingOutcome ::+ -- | The file, as it is+ Text ->+ -- | Its formatted text, in newlines+ Text ->+ Outcome+formattingOutcome before formatted+ | after == before = Unchanged+ | otherwise = Changed before after+ where+ after = setNewlineStyle (getNewlineStyle before) formatted++-- | 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)+ _ -> pure ()++-- | Run an action over every element at once, as far as the machine allows.+inParallel :: (a -> IO b) -> [a] -> IO [b]+inParallel act xs = do+ capabilities <- getNumCapabilities+ queue <- newIORef (zip [0 :: Int ..] xs)+ answers <- newIORef Map.empty+ let worker =+ atomicModifyIORef' queue (\case [] -> ([], Nothing); (y : ys) -> (ys, Just y)) >>= \case+ Nothing -> pure ()+ Just (i, x) -> do+ y <- act x+ atomicModifyIORef' answers (\m -> (Map.insert i y m, ()))+ worker+ done <- replicateM (max 1 (min capabilities (length xs))) newEmptyMVar+ for_ done $ \signal -> forkIO (worker >> putMVar signal ())+ traverse_ takeMVar done+ Map.elems <$> readIORef answers++----------------------------------------------------------------------------+-- Report++-- | What to print when a run is over, and on which stream.+data Report = Report+ { -- | For standard output.+ reportOut :: [Text],+ -- | For standard error.+ reportErr :: [Text]+ }+ deriving (Eq, Show)++-- | The summary an @inplace@ run prints.+inplaceReport :: Palette -> [(FilePath, Outcome)] -> Report+inplaceReport palette outcomes =+ Report+ { reportOut = tally palette ("✓", Good) "Formatted" (not . skipped) outcomes,+ reportErr = asides palette outcomes+ }+ where+ skipped o = declined o || failed o++-- | The diffs a @check@ run prints, and what it could not or would not do.+checkReport :: Palette -> [(FilePath, Outcome)] -> Report+checkReport palette outcomes =+ Report+ { reportOut =+ [ diffInFull palette path before after+ | (path, Changed before after) <- outcomes+ ],+ reportErr = asides palette outcomes+ }++-- | Everything said about the files that were not formatted.+asides :: Palette -> [(FilePath, Outcome)] -> [Text]+asides palette outcomes =+ concat+ [ tally palette ("=", Middling) "Declined" declined outcomes,+ reasons declined,+ tally palette ("✗", Bad) "Failed" failed outcomes,+ reasons failed+ ]+ where+ reasons wanted =+ [ line+ | (_, outcome) <- sortOn fst outcomes,+ wanted outcome,+ e <- why outcome,+ line <- bulleted palette e+ ]+ why = \case+ Declined e -> [e]+ Failed e -> [e]+ _ -> []++-- | One line per extension, for the files a test picks out.+tally ::+ Palette ->+ -- | The mark to set the line under, and the color to set it in+ (Text, Color) ->+ -- | What became of the files being counted+ Text ->+ (Outcome -> Bool) ->+ [(FilePath, Outcome)] ->+ [Text]+tally palette (mark, color) what wanted outcomes =+ [ indent 1 <> marker palette color mark <> " " <> what <> " " <> count palette n extension+ | (extension, n) <- countedBy (wanted . snd) outcomes+ ]++-- | How many files of each extension, among the ones a test picks out.+countedBy :: ((FilePath, Outcome) -> Bool) -> [(FilePath, Outcome)] -> [(Text, Int)]+countedBy wanted =+ Map.toList+ . Map.fromListWith (+)+ . map (\(path, _) -> (T.pack (takeExtension path), 1 :: Int))+ . filter wanted++-- | Render the number of files.+count :: Palette -> Int -> Text -> Text+count palette n extension =+ T.pack (show 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) : map (indent 3 <>) rest++-- | Something to say under a mark of its own, wrapped to fit beneath it.+noted ::+ Palette ->+ -- | The mark to set it under, and the color to set that in+ (Text, Color) ->+ Text ->+ [Text]+noted palette (mark, color) text = case wrapTo (lineWidth - 6) text of+ [] -> []+ (opening : rest) ->+ (indent 1 <> marker palette color mark <> " " <> opening)+ : map (indent 3 <>) rest
+ src/Tilia/Source.hs view
@@ -0,0 +1,74 @@+-- | The module as its author wrote it.+--+-- Almost everything the formatter decides about layout is a question about+-- the source: what is on the line above a comment, whether two constructs+-- had an empty line between them, whether a directive stands between a+-- comment and the pragma under it. All these questions are asked in a+-- single place here, or in "Tilia.Source.Lines" for the ones that can be+-- asked before the module has been parsed.+module Tilia.Source+ ( -- * The source+ SourceType (..),+ Written (..),+ Source,+ sourceOf,++ -- * Its lines+ Lines,+ linesOf,+ dropping,+ lineTexts,+ sourceLines,+ lineAt,+ blankAt,+ blankBelow,+ closesABranch,+ directiveAt,++ -- * Its comments+ comments,+ )+where++import GHC.Hs (HsModule)+import GHC.Hs.Extension (GhcPs)+import GHC.Parser.Annotation (LEpaComment)+import Tilia.Comments (Comment, commentsOf)+import Tilia.Source.Lines++-- | Whether a file is a module or a Backpack signature.+data SourceType+ = ModuleSource+ | SignatureSource+ deriving (Eq, Show)++-- | A module's source in a form that facilitates querying.+data Source = Source+ { -- | The lines, numbered from one as the compiler numbers them.+ srcLines :: !Lines,+ -- | Every comment in the module, in source order.+ srcComments :: [Comment]+ }++-- | The lines of a source.+sourceLines :: Source -> Lines+sourceLines = srcLines++-- | Read a module's source.+sourceOf ::+ -- | The lines of the module, as this configuration has them+ Lines ->+ -- | Comments the syntax tree does not carry. See 'commentsOf'.+ [LEpaComment] ->+ -- | The result of parsing+ HsModule GhcPs ->+ Source+sourceOf ls loose hsModule =+ Source+ { srcLines = ls,+ srcComments = commentsOf ls loose hsModule+ }++-- | Every comment in a module, in source order.+comments :: Source -> [Comment]+comments = srcComments
+ src/Tilia/Source/Lines.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE OverloadedStrings #-}++-- | The lines of a module, and the questions that can be asked of them+-- without a parse.+--+-- Apart from "Tilia.Source" because a 'Tilia.Source.Source' cannot be had+-- until the module has been parsed, and two things need these answers+-- earlier than that: the preprocessor support, which asks what the author+-- wrote on a line while it is still deciding what to hand the parser, and+-- the comment machinery, which "Tilia.Source" itself is built on top of.+module Tilia.Source.Lines+ ( -- * The lines+ Written (..),+ Lines,+ linesOf,+ dropping,+ lineTexts,+ lineAt,+ blankAt,+ directiveAt,+ blankBelow,+ closesABranch,+ )+where++import Data.Char (isAsciiLower, isSpace)+import Data.IntMap.Strict (IntMap)+import Data.IntMap.Strict qualified as IntMap+import Data.IntSet (IntSet)+import Data.IntSet qualified as IntSet+import Data.Text (Text)+import Data.Text qualified as T++-- | The text of a module as its author wrote it.+--+-- Distinguished from the text handed to the parser because the two are the+-- same only when the preprocessor is not involved.+newtype Written = Written Text+ deriving (Eq, Show)++-- | The lines of a source, numbered from one as the compiler numbers them,+-- but also the lines that a particular CPP configuration does not contain.+data Lines = Lines+ { -- | Every line of the module as written.+ lnWritten :: !(IntMap Text),+ -- | The ones this configuration does not contain.+ lnDropped :: !IntSet+ }++-- | Read the lines of a module, every one of which it has.+linesOf :: Written -> Lines+linesOf (Written text) =+ Lines+ { lnWritten = IntMap.fromList (zip [1 ..] (T.lines text)),+ lnDropped = IntSet.empty+ }++-- | Drop the given ranges from the 'Lines'.+dropping :: [(Int, Int)] -> Lines -> Lines+dropping ranges ls =+ ls+ { lnDropped =+ IntSet.union+ (lnDropped ls)+ (IntSet.fromList (concat [[from .. to] | (from, to) <- ranges]))+ }++-- | Every line of the module as written, in order, whatever this+-- configuration has of them.+lineTexts :: Lines -> [Text]+lineTexts = IntMap.elems . lnWritten++-- | The text of a line, if this configuration of the module has one.+lineAt :: Int -> Lines -> Maybe Text+lineAt n ls+ | IntSet.member n (lnDropped ls) = Nothing+ | otherwise = IntMap.lookup n (lnWritten ls)++-- | Was this line empty?+blankAt :: Int -> Lines -> Bool+blankAt n = maybe False (T.all isSpace) . lineAt n++-- | Does this line hold a preprocessor directive?+directiveAt :: Int -> Lines -> Bool+directiveAt n = maybe False opensWithHash . lineAt n+ where+ opensWithHash l = case T.uncons (T.stripStart l) of+ Just ('#', rest) ->+ maybe False (isAsciiLower . fst) (T.uncons (T.stripStart rest))+ _ -> False++-- | Did the author leave an empty line below this line?+blankBelow :: Int -> Lines -> Bool+blankBelow start ls = go (start + 1)+ where+ go n+ | n > IntMap.size (lnWritten ls) = False+ | Nothing <- lineAt n ls = go (n + 1)+ | leadsOut n = go (n + 1)+ | otherwise = blankAt n ls+ leadsOut n = case lineAt n ls of+ Just l | directiveAt n ls -> keywordOf l `elem` leavingKeywords+ _ -> False+ keywordOf l = T.takeWhile isAsciiLower (T.stripStart (T.drop 1 (T.stripStart l)))++-- | Does the empty line under this one stand at the end of a branch?+closesABranch :: Int -> Lines -> Bool+closesABranch n ls = go False (n + 1)+ where+ go crossed k+ | k > IntMap.size (lnWritten ls) = False+ | otherwise = case lineAt k ls of+ Nothing -> go crossed (k + 1)+ Just l+ | T.null (T.strip l) -> go True (k + 1)+ | directiveAt k ls -> crossed && keywordOf l `elem` leavingKeywords+ | otherwise -> False+ keywordOf l = T.takeWhile isAsciiLower (T.stripStart (T.drop 1 (T.stripStart l)))++-- | The directives that lead out of the region the line below them is in,+-- rather than into one it is not.+leavingKeywords :: [Text]+leavingKeywords = ["elif", "elifdef", "elifndef", "else", "endif"]
+ src/Tilia/Span.hs view
@@ -0,0 +1,118 @@+-- | Regions of the input, and the questions asked about them.+--+-- Deliberately not GHC's @RealSrcSpan@. Almost everything here wants to ask+-- one of a handful of questions—did this occupy a single line, did that+-- begin on the line this ended on, was there an empty line between them—and+-- a type of our own keeps the modules that ask them free of the compiler's+-- libraries. Conversion happens at the edge, in "Tilia.Span.Ghc", which is+-- the only place that has to know what GHC's positions look like.+module Tilia.Span+ ( -- * Spans+ Span (..),+ mkSpan,++ -- * Asking about one+ isSingleLine,++ -- * Asking about two+ sameLine,+ blankBetween,+ meets,+ covers,++ -- * Narrowing+ startOf,+ endOf,++ -- * Positions+ startPoint,+ endPoint,+ )+where++-- | A region of the input.+data Span = Span+ { spanStartLine :: !Int,+ spanStartColumn :: !Int,+ spanEndLine :: !Int,+ spanEndColumn :: !Int+ }+ deriving (Eq, Ord, Show)++-- | Build a 'Span' from start and end positions, each a line and a column.+mkSpan :: (Int, Int) -> (Int, Int) -> Span+mkSpan (sl, sc) (el, ec) = Span sl sc el ec++-- | The smallest span covering both arguments.+--+-- Printing code needs this often enough—a construct the syntax tree has no+-- single node for still has to be laid out as a unit—that it is worth having+-- as an instance rather than as a function each caller reimplements.+instance Semigroup Span where+ a <> b =+ Span+ { spanStartLine = min (spanStartLine a) (spanStartLine b),+ spanStartColumn = case compare (spanStartLine a) (spanStartLine b) of+ LT -> spanStartColumn a+ GT -> spanStartColumn b+ EQ -> min (spanStartColumn a) (spanStartColumn b),+ spanEndLine = max (spanEndLine a) (spanEndLine b),+ spanEndColumn = case compare (spanEndLine a) (spanEndLine b) of+ GT -> spanEndColumn a+ LT -> spanEndColumn b+ EQ -> max (spanEndColumn a) (spanEndColumn b)+ }++-- | Did this occupy a single line of the input?+--+-- The question the whole formatter turns on: what was written on one line+-- stays on one line, and what was spread out stays spread out.+isSingleLine :: Span -> Bool+isSingleLine s = spanStartLine s == spanEndLine s++-- | Did the second thing begin on the line the first thing ended on?+--+-- This is the question behind almost every hanging decision: a body may only+-- hang off what precedes it when the author had them starting together.+sameLine :: Maybe Span -> Maybe Span -> Bool+sameLine (Just a) (Just b) = spanEndLine a == spanStartLine b+sameLine _ _ = False++-- | Was there an empty line between the two?+blankBetween :: Maybe Span -> Maybe Span -> Bool+blankBetween (Just a) (Just b) = spanStartLine b > spanEndLine a + 1+blankBetween _ _ = False++-- | Do the two cover any of the same input?+--+-- Touching counts: a span ending where the next begins shares that position,+-- and the callers that ask this are asking whether the two are looking at+-- one thing, not whether either strictly contains the other.+meets :: Span -> Span -> Bool+meets a b = startPoint a <= endPoint b && startPoint b <= endPoint a++-- | Does the first cover all of the second?+--+-- Reflexive, so a span covers itself. Callers wanting one thing to be+-- strictly inside another want this and inequality.+covers :: Span -> Span -> Bool+covers a b = startPoint a <= startPoint b && endPoint b <= endPoint a++-- | A zero-width span at the start of the given one.+startOf :: Span -> Span+startOf s = at (spanStartLine s, spanStartColumn s)++-- | A zero-width span at the end of the given one.+endOf :: Span -> Span+endOf s = at (spanEndLine s, spanEndColumn s)++at :: (Int, Int) -> Span+at position = mkSpan position position++-- | Where a span begins, as a position two of them may be compared by.+startPoint :: Span -> (Int, Int)+startPoint s = (spanStartLine s, spanStartColumn s)++-- | Where a span ends.+endPoint :: Span -> (Int, Int)+endPoint s = (spanEndLine s, spanEndColumn s)
+ src/Tilia/Span/Ghc.hs view
@@ -0,0 +1,45 @@+-- | Turning the compiler's positions into ours.+module Tilia.Span.Ghc+ ( spanOfReal,+ spanOfSrcSpan,+ spanOf,+ spansOf,+ tokenSpan,+ annSpan,+ )+where++import Data.Maybe (mapMaybe)+import GHC.Parser.Annotation (EpToken, HasLoc, getEpTokenSrcSpan, getHasLoc)+import GHC.Types.SrcLoc (GenLocated)+import GHC.Types.SrcLoc qualified as GHC+import Tilia.Span (Span, mkSpan)++-- | Convert a span the compiler knows to be real.+spanOfReal :: GHC.RealSrcSpan -> Span+spanOfReal s =+ mkSpan+ (GHC.srcSpanStartLine s, GHC.srcSpanStartCol s)+ (GHC.srcSpanEndLine s, GHC.srcSpanEndCol s)++-- | Convert a span that may not be real.+spanOfSrcSpan :: GHC.SrcSpan -> Maybe Span+spanOfSrcSpan = fmap spanOfReal . GHC.srcSpanToRealSrcSpan++-- | The span of a located thing.+spanOf :: (HasLoc l) => GenLocated l a -> Maybe Span+spanOf = spanOfSrcSpan . getHasLoc++-- | Where a keyword or a piece of punctuation was written.+tokenSpan :: EpToken sym -> Maybe Span+tokenSpan = spanOfSrcSpan . getEpTokenSrcSpan++-- | Where an annotation says something was written.+annSpan :: (HasLoc l) => l -> Maybe Span+annSpan = spanOfSrcSpan . getHasLoc++-- | The span covering every located thing in the list.+spansOf :: (HasLoc l) => [GenLocated l a] -> Maybe Span+spansOf xs = case mapMaybe spanOf xs of+ [] -> Nothing+ (s : ss) -> Just (foldr (<>) s ss)
+ src/Tilia/Target.hs view
@@ -0,0 +1,352 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Working out which files a run was asked to format.+module Tilia.Target+ ( Target (..),+ Kind (..),+ parseTarget,+ Component (..),+ TargetProblem (..),+ describeTargetProblem,+ componentsOfTarget,+ componentInPlan,+ filesOfComponents,+ )+where++import Control.Monad (filterM)+import Data.ByteString qualified as BS+import Data.ByteString.Char8 qualified as BS8+import Data.Char (toLower)+import Data.List (isPrefixOf, isSuffixOf, sort)+import Data.List.NonEmpty qualified as NE+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Distribution.Fields.Field (Field (..), FieldLine (..), Name (..))+import Distribution.Fields.ParseResult (runParseResult)+import Distribution.Fields.Parser (readFields)+import Distribution.PackageDescription+ ( Benchmark (..),+ BuildInfo (..),+ CondTree (..),+ Executable (..),+ GenericPackageDescription (..),+ Library (..),+ PackageDescription (..),+ TestSuite (..),+ unPackageName,+ unUnqualComponentName,+ )+import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)+import Distribution.Parsec (showPError)+import Distribution.Types.PackageId (PackageIdentifier (..))+import Distribution.Utils.Path (getSymbolicPath)+import System.Directory+ ( doesDirectoryExist,+ doesFileExist,+ listDirectory,+ )+import System.FilePath (normalise, takeDirectory, takeExtension, (</>))+import Tilia.Fixity.Plan (PlanComponent (..))+import Tilia.Project (Marker (..), ProjectRoot (..), markerFile)+import Tilia.Utils (attempted, quietly)++-- | Which components a run was asked for.+data Target+ = -- | @all@, or nothing given at all: every component of every package.+ Everything+ | -- | One bare word, which may name a package or a component.+ Called Text+ | -- | @kind:name@, or @package:kind:name@.+ Qualified (Maybe Text) Kind Text+ deriving (Eq, Show)++-- | The kinds of component a @.cabal@ file can declare.+data Kind = Lib | Exe | Test | Bench+ 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+ [""] -> Left "an empty target"+ ["all"] -> Right Everything+ [one] -> Right (Called one)+ [k, name] | Just kind <- kindNamed k -> Right (Qualified Nothing kind name)+ [package, k, name] | Just kind <- kindNamed k -> Right (Qualified (Just package) kind name)+ _ -> Left unrecognised+ where+ unrecognised =+ "unrecognised target "+ <> T.pack (show written)+ <> ": expected all, a package or component name, or one of\+ \ lib:, exe:, test:, bench: followed by a name"+ kindNamed = \case+ "lib" -> Just Lib+ "exe" -> Just Exe+ "test" -> Just Test+ "bench" -> Just Bench+ "benchmark" -> Just Bench+ _ -> Nothing++-- | Does a target ask for this component?+targetSelectsComponent :: Target -> Component -> Bool+targetSelectsComponent target c = case target of+ Everything -> True+ Called name -> name == componentName c || name == componentPackage c+ Qualified package kind name ->+ all (== componentPackage c) package+ && kind == componentKind c+ && name == componentName c++-- | One component of one package, as far as formatting cares.+data Component = Component+ { -- | The package it belongs to.+ componentPackage :: Text,+ -- | Which kind it is.+ componentKind :: Kind,+ -- | Its name, which for a library is the package's own.+ componentName :: Text,+ -- | The directory its @.cabal@ file sits in.+ componentRoot :: FilePath,+ -- | Its @hs-source-dirs@, relative to 'componentRoot'.+ componentDirs :: [FilePath]+ }+ deriving (Eq, Show)++-- | Why a run could not work out what to format.+data TargetProblem+ = -- | A @cabal.project@ naming packages, none of which could be found.+ NoPackages FilePath+ | -- | A @.cabal@ file that would not parse, and what the parser said.+ Unparseable FilePath [Text]+ | -- | A target naming no component the project holds.+ NoSuchTarget Text [Text]+ deriving (Eq, Show)++-- | Say what went wrong, in one line.+describeTargetProblem :: TargetProblem -> Text+describeTargetProblem = \case+ NoPackages file ->+ T.pack file <> " names no packages that exist"+ Unparseable file complaints ->+ T.pack file <> " does not parse:" <> foldMap ("\n " <>) complaints+ NoSuchTarget asked available ->+ "no component matches "+ <> asked+ <> ", and the targets this project takes are"+ <> foldMap ("\n " <>) ("all" : available)++-- | Every component of the project that the target asks for.+componentsOfTarget :: ProjectRoot -> Target -> IO (Either TargetProblem [Component])+componentsOfTarget root target = do+ files <- packageFilesOf root+ if null files+ then pure (Left (NoPackages (prPath root </> markerFile (prMarker root))))+ else+ traverse componentsInCabalFile files >>= \case+ results+ | (problem : _) <- [p | Left p <- results] -> pure (Left problem)+ | otherwise -> do+ let found = concat [cs | Right cs <- results]+ pure $ case filter (targetSelectsComponent target) found of+ [] | Everything <- target -> Right []+ [] -> Left (NoSuchTarget (spellTarget target) (map spellComponent found))+ wanted -> Right wanted++-- | How a component would have to be named to be asked for on its own.+spellComponent :: Component -> Text+spellComponent c =+ componentPackage c+ <> ":"+ <> spellKind (componentKind c)+ <> ":"+ <> componentName c++-- | How a build plan names this component.+--+-- 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'.+componentInPlan :: Component -> PlanComponent+componentInPlan c =+ PlanComponent+ { pcPackage = componentPackage c,+ pcName = case componentKind c of+ Lib -> "lib"+ kind -> spellKind kind <> ":" <> componentName c+ }++-- | Render 'Kind' the way it would be accepted on the command line.+spellKind :: Kind -> Text+spellKind = \case+ Lib -> "lib"+ Exe -> "exe"+ Test -> "test"+ Bench -> "bench"++-- | A target, written the way it would have been given.+spellTarget :: Target -> Text+spellTarget = \case+ Everything -> "all"+ Called name -> name+ Qualified package kind name ->+ T.intercalate ":" (foldMap pure package <> [spellKind kind, name])++-- | Every Haskell file in a component, in a settled order.+filesOfComponent :: Component -> IO [FilePath]+filesOfComponent c =+ sort . Set.toList . Set.fromList . map normalise . concat+ <$> traverse (walk . (componentRoot c </>)) (componentDirs c)+ where+ walk directory =+ quietly [] $+ doesDirectoryExist directory >>= \case+ False -> pure []+ True -> do+ entries <- listDirectory directory+ concat <$> traverse (below directory) (sort entries)+ below directory entry+ | "." `isPrefixOf` entry = pure []+ | entry == "dist-newstyle" = pure []+ | otherwise = do+ let path = directory </> entry+ isDirectory <- quietly False (doesDirectoryExist path)+ if isDirectory+ then walk path+ else pure [path | takeExtension path `elem` formattableFileExtensions]++-- | Every Haskell file a set of components holds, each named once.+filesOfComponents :: [Component] -> IO [FilePath]+filesOfComponents components =+ sort . Set.toList . Set.fromList . concat <$> traverse filesOfComponent components++-- | The extensions a Haskell source file can have.+formattableFileExtensions :: [String]+formattableFileExtensions = [".hs", ".hs-boot", ".hsig"]++-- | The @.cabal@ files the project is made of.+--+-- A @cabal.project@ names them, possibly through globs; anything else means+-- the marker found by the walk upwards is itself the only package.+packageFilesOf :: ProjectRoot -> IO [FilePath]+packageFilesOf root = case prMarker root of+ PackageFile named -> pure [prPath root </> named]+ ProjectFile -> do+ contents <-+ quietly BS.empty (BS.readFile (prPath root </> "cabal.project"))+ found <-+ traverse+ (packageToCabalFile (prPath root))+ (packagesInCabalProjectContents contents)+ pure (Set.toList (Set.fromList (concat found)))++-- | The entries of a @cabal.project@'s @packages@ field.+packagesInCabalProjectContents :: BS.ByteString -> [Text]+packagesInCabalProjectContents contents = case readFields contents of+ Left _ -> []+ Right fields -> concatMap entries (packagesIn fields)+ where+ packagesIn = concatMap $ \case+ Field (Name _ name) ls+ | BS8.map toLower name == "packages" ->+ [T.unwords [T.decodeUtf8Lenient value | FieldLine _ value <- ls]]+ | otherwise -> []+ Section _ _ inner -> packagesIn inner++ entries = filter (not . T.null) . map T.strip . concatMap (T.split (== ',')) . T.words++-- | Turn one entry of a @packages@ field into the @.cabal@ files it names.+packageToCabalFile :: FilePath -> Text -> IO [FilePath]+packageToCabalFile root entry = do+ paths <-+ packageGlobToCabalFiles+ root+ (map T.unpack (T.split (== '/') (T.dropWhile (== '.') stripped)))+ concat <$> traverse asPackage paths+ where+ stripped = T.dropWhile (== '/') (T.strip entry)+ asPackage path+ | ".cabal" `isSuffixOf` path = do+ there <- quietly False (doesFileExist path)+ pure [path | there]+ | otherwise = cabalFilesIn path++-- | Resolve a path whose components may contain @*@.+packageGlobToCabalFiles :: FilePath -> [String] -> IO [FilePath]+packageGlobToCabalFiles here = \case+ [] -> pure [here]+ ("" : rest) -> packageGlobToCabalFiles here rest+ ("." : rest) -> packageGlobToCabalFiles here rest+ (component : rest)+ | '*' `elem` component -> do+ entries <- quietly [] (listDirectory here)+ concat+ <$> traverse+ (\e -> packageGlobToCabalFiles (here </> e) rest)+ (sort (filter (globMatching component) entries))+ | otherwise -> packageGlobToCabalFiles (here </> component) rest++-- | Does a name match a pattern with @*@ in it?+globMatching :: String -> String -> Bool+globMatching pattern name = case break (== '*') pattern of+ (before, []) -> before == name+ (before, _ : after) ->+ before `isPrefixOf` name+ && after `isSuffixOf` drop (length before) name++-- | The @.cabal@ files sitting directly in a directory.+cabalFilesIn :: FilePath -> IO [FilePath]+cabalFilesIn directory = quietly [] $ do+ entries <- listDirectory directory+ let named = sort (filter (".cabal" `isSuffixOf`) entries)+ filterM doesFileExist (map (directory </>) named)++-- | Every component one @.cabal@ file declares.+componentsInCabalFile :: FilePath -> IO (Either TargetProblem [Component])+componentsInCabalFile cabalFile =+ attempted (BS.readFile cabalFile) >>= \case+ Left why -> pure (Left (Unparseable cabalFile [why]))+ Right bytes ->+ case snd (runParseResult (parseGenericPackageDescription bytes)) of+ Left (_, complaints) ->+ pure (Left (Unparseable cabalFile (map said (NE.toList complaints))))+ where+ said = T.pack . showPError cabalFile+ Right described ->+ pure (Right (declaredComponents (takeDirectory cabalFile) described))++-- | The components of a parsed @.cabal@ file, in the order declared.+declaredComponents :: FilePath -> GenericPackageDescription -> [Component]+declaredComponents root described =+ concat+ [ foldMap (pure . made Lib package . libBuildInfo . condTreeData) (condLibrary described),+ [ made Lib (nameOf n) (libBuildInfo (condTreeData t))+ | (n, t) <- condSubLibraries described+ ],+ [ made Exe (nameOf n) (buildInfo (condTreeData t))+ | (n, t) <- condExecutables described+ ],+ [ made Test (nameOf n) (testBuildInfo (condTreeData t))+ | (n, t) <- condTestSuites described+ ],+ [ made Bench (nameOf n) (benchmarkBuildInfo (condTreeData t))+ | (n, t) <- condBenchmarks described+ ]+ ]+ where+ package =+ T.pack (unPackageName (pkgName (package' described)))+ package' = Distribution.PackageDescription.package . packageDescription+ nameOf = T.pack . unUnqualComponentName+ made kind name bi =+ Component+ { componentPackage = package,+ componentKind = kind,+ componentName = name,+ componentRoot = root,+ componentDirs = case map getSymbolicPath (hsSourceDirs bi) of+ [] -> ["."]+ ds -> ds+ }
+ src/Tilia/Utils.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Miscellaneous utilities.+module Tilia.Utils+ ( quietly,+ attempted,+ lineWidth,+ indent,+ wrapTo,+ visibleLength,+ )+where++import Control.Exception (SomeException, displayException, try)+import Data.Text (Text)+import Data.Text qualified as T++-- | Run an action, falling back on the given value if it throws.+quietly :: a -> IO a -> IO a+quietly fallback action =+ try action >>= \case+ Left (_ :: SomeException) -> pure fallback+ Right a -> pure a++-- | Run an action, keeping what it threw rather than a fallback.+attempted :: IO a -> IO (Either Text a)+attempted action =+ try action >>= \case+ Left (e :: SomeException) -> pure (Left (T.pack (displayException e)))+ Right a -> pure (Right a)++-- | The widest line this program will print of its own accord.+lineWidth :: Int+lineWidth = 76++-- | Two spaces per level, which is what everything here is set in.+indent :: Int -> Text+indent level = T.replicate (2 * level) " "++-- | Break text into lines that fit the room given, at spaces.+wrapTo :: Int -> Text -> [Text]+wrapTo room = concatMap (go . T.words) . T.lines+ where+ go [] = []+ go (w : ws) = let (line, rest) = fill w ws in line : go rest+ fill line (w : ws)+ | visibleLength line + 1 + visibleLength w <= room = fill (line <> " " <> w) ws+ fill line ws = (line, ws)++-- | How wide a piece of text is once printed.+visibleLength :: Text -> Int+visibleLength = go 0+ where+ go !n t = case T.uncons t of+ Nothing -> n+ Just ('\ESC', rest)+ | Just after <- T.stripPrefix "[" rest -> go n (T.drop 1 (T.dropWhile (/= 'm') after))+ Just (_, rest) -> go (n + 1) rest
+ tests/Main.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE LambdaCase #-}++-- | Running the suite, or the share of it a run is for.+--+-- On CI all tests are divided in two classes: those that exercise something+-- about the compiler and those that do not. The first group is run on every+-- compiler\/shard, the second group is split up between compilers\/shards.+--+-- Set @TILIA_SHARD@ to @i/n@ — @1/3@, @2/3@, @3/3@ — to take the @i@th+-- share of @n@. Unset, which is what @cabal test@ gives you, runs+-- everything.+module Main (main) where++import Data.Bits (xor)+import Data.Char (ord)+import Data.List (intercalate, isPrefixOf)+import Data.Word (Word64)+import Spec qualified+import System.Environment (lookupEnv)+import Test.Hspec.Runner (Config (..), Path, defaultConfig, hspecWith)+import Text.Read (readMaybe)++main :: IO ()+main =+ shardFrom <$> lookupEnv "TILIA_SHARD" >>= \case+ Everything -> Spec.main+ Share i n ->+ hspecWith defaultConfig {configFilterPredicate = Just (taking i n)} Spec.spec++-- | Which share of the suite a run is for.+data Shard+ = Everything+ | -- | The @i@th share of @n@, counting from one.+ Share Int Int++-- | Read a share, or take the whole suite when nothing sensible is asked+-- for. Being wrong here runs too much rather than too little.+shardFrom :: Maybe String -> Shard+shardFrom = \case+ Just asked+ | (i, '/' : n) <- span (/= '/') asked,+ Just i' <- readMaybe i,+ Just n' <- readMaybe n,+ n' > 0,+ i' >= 1,+ i' <= n' ->+ Share i' n'+ _ -> Everything++-- | Which tests the @i@th share of @n@ takes: every one that leans on the+-- compiler, and its own share of the rest.+taking :: Int -> Int -> Path -> Bool+taking i n path = leansOnCompiler path || share path == i - 1+ where+ share = fromIntegral . (`mod` fromIntegral n) . fingerprint . spell++-- | A test's path, written out, so that a share is decided by what the test+-- is rather than by where it happens to fall in the order.+spell :: Path -> String+spell (groups, requirement) = intercalate "/" (groups <> [requirement])++-- | FNV-1a, so that a test lands in the same share on every machine and+-- every run, and adding one test does not move the others.+fingerprint :: String -> Word64+fingerprint = foldl' step 14695981039346656037+ where+ step h c = (h `xor` fromIntegral (ord c)) * 1099511628211++-- | Is this test one whose answer the compiler can change?+leansOnCompiler :: Path -> Bool+leansOnCompiler (groups, _) = case groups of+ group : _ -> any (`isPrefixOf` group) compilerBound+ [] -> False++-- | The groups that ask the compiler, or its package database, or the plan+-- it solved, and could therefore fail on one compiler and pass on another.+compilerBound :: [String]+compilerBound =+ [ "Tilia.Fixity.Dependencies",+ "Tilia.Fixity.PackageDb",+ "Tilia.Fixity.Plan"+ ]
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}
+ tests/Tilia/Comments/PlaceSpec.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Which region each comment is given to, and which side of it.+module Tilia.Comments.PlaceSpec (spec) where++import Data.Text (Text)+import Test.Hspec+import Tilia.Comments (Comment (..), renderComment)+import Tilia.Comments.Place+import Tilia.Parser+import Tilia.Source (comments)+import Tilia.Span++spec :: Spec+spec = do+ describe "a comment written after code" $ do+ it "goes to the region that ends where that code stops" $+ placedIn [foo, theOne] [] "foo = 1 -- note\n"+ `shouldBe` [("-- note", Just (After, theOne))]++ it "goes to the nearest region before it when it ends its line" $+ placedIn [foo] [] "foo = 1 -- note\n"+ `shouldBe` [("-- note", Just (After, foo))]++ it "is left to what follows when code follows it too" $+ placedIn [foo, lastOfLineOne] [] "foo = {- note -} 1\n"+ `shouldBe` [("{- note -}", Just (Before, lastOfLineOne))]++ it "is taken back even so when it was written against a region" $+ placedIn [foo, upToTheEquals, lastOfLineOne] [] "foo = {- note -} 1\n"+ `shouldBe` [("{- note -}", Just (After, upToTheEquals))]++ describe "choosing between the regions on a line" $ do+ it "takes the one ending latest" $+ placedIn [foo, theOne] [] "foo = 1 -- note\n"+ `shouldBe` [("-- note", Just (After, theOne))]++ it "takes the outermost of those ending together" $+ placedIn [theOne, wholeOfLineOne] [] "foo = 1 -- note\n"+ `shouldBe` [("-- note", Just (After, wholeOfLineOne))]++ it "passes over one that has not ended when the comment begins" $+ placedIn [foo, pastTheComment] [] "foo = 1 -- note\n"+ `shouldBe` [("-- note", Just (After, foo))]++ describe "a region the comment was not written inside" $ do+ it "may not have it" $+ placedIn [foo, bar, rhsOfLineOne] [] "foo = 1 -- note\nbar = 2\n"+ `shouldBe` [("-- note", Just (Before, bar))]++ it "may when the comment is inside it too" $+ placedIn [foo, bar] [] "foo = 1 -- note\nbar = 2\n"+ `shouldBe` [("-- note", Just (After, foo))]++ describe "a fence" $ do+ it "keeps a comment printed in place from crossing it" $+ placedIn [foo, bar] [rhsOfLineOne] "foo = 1 {- note -}\nbar = 2\n"+ `shouldBe` [("{- note -}", Just (Before, bar))]++ it "leaves the same comment alone when there is no fence" $+ placedIn [foo, bar] [] "foo = 1 {- note -}\nbar = 2\n"+ `shouldBe` [("{- note -}", Just (After, foo))]++ it "says nothing about a comment held back to the end of a line" $+ placedIn [foo, bar] [rhsOfLineOne] "foo = 1 -- note\nbar = 2\n"+ `shouldBe` [("-- note", Just (After, foo))]++ describe "a comment carrying on a remark from the line above" $ do+ it "goes where that remark went" $+ placedIn [operand, bar'] [] carriedOn+ `shouldBe` [ ("-- said once", Just (After, operand)),+ ("-- and again", Just (After, operand))+ ]++ it "does not when it is not lined up with that line" $+ placedIn [operand, bar'] [] indentedFurther+ `shouldBe` [ ("-- said once", Just (After, operand)),+ ("-- and again", Just (Before, bar'))+ ]++ it "does not when that line ended in code" $+ placedIn [operand, bar'] [] nothingAbove+ `shouldBe` [("-- and again", Just (Before, bar'))]++ it "does not when what follows lines up with it as well" $+ placedIn [operand, continuation] [] carriedOnThenMore+ `shouldBe` [ ("-- said once", Just (After, operand)),+ ("-- and again", Just (Before, continuation))+ ]++ describe "a comment with nothing written against it" $ do+ it "goes above the region that starts first after it" $+ placedIn [bar, laterStill] [] "-- note\nbar = 2\n"+ `shouldBe` [("-- note", Just (Before, bar))]++ it "goes above the outermost of those starting together" $+ placedIn [bar, wholeOfLineTwo] [] "-- note\nbar = 2\n"+ `shouldBe` [("-- note", Just (Before, wholeOfLineTwo))]++ it "goes nowhere at all when nothing follows it" $+ placedIn [foo] [] "foo = 1\n-- note\n"+ `shouldBe` [("-- note", Nothing)]++ describe "what a comment will look like" $ do+ it "sits in the line before a region when code was written after it" $+ shapeOf Before (firstComment "foo = {- note -} 1\n") `shouldBe` InPlace++ it "ends the line before a region when it trailed something" $+ shapeOf Before (firstComment "foo = 1 -- note\n") `shouldBe` EndsTheLine++ it "takes lines of its own before a region otherwise" $+ shapeOf Before (firstComment "-- note\nfoo = 1\n") `shouldBe` OnItsOwnLines++ it "sits in the line after a region when it closes itself" $+ shapeOf After (firstComment "foo = 1 {- note -}\n") `shouldBe` InPlace++ it "is held back after a region when it is one line of dashes" $+ shapeOf After (firstComment "foo = 1 -- note\n") `shouldBe` HeldBack++ it "ends the line after a region when it runs over several" $+ shapeOf After (firstComment "foo = 1 {- one\ntwo -}\n") `shouldBe` EndsTheLine++----------------------------------------------------------------------------+-- The regions the snippets are placed against++-- | @foo@, and the @1@ it is bound to, in @foo = 1@.+foo, theOne :: Span+foo = mkSpan (1, 1) (1, 4)+theOne = mkSpan (1, 7) (1, 8)++-- | Everything on the first line, ending where @theOne@ does.+wholeOfLineOne :: Span+wholeOfLineOne = mkSpan (1, 1) (1, 8)++-- | Up to and including the @=@ of @foo = {- note -} 1@, which is where the+-- code before that comment stops.+upToTheEquals :: Span+upToTheEquals = mkSpan (1, 5) (1, 6)++-- | The @1@ at the end of @foo = {- note -} 1@.+lastOfLineOne :: Span+lastOfLineOne = mkSpan (1, 18) (1, 19)++-- | A region that has not finished by the time the comment starts.+pastTheComment :: Span+pastTheComment = mkSpan (1, 1) (1, 16)++-- | Everything after the @=@ of the first line, comment included.+--+-- Wide enough to hold the comment and narrow enough to leave 'foo' outside+-- it, which is what it takes to keep the two apart.+rhsOfLineOne :: Span+rhsOfLineOne = mkSpan (1, 5) (1, 20)++-- | @bar@ on the second line, and everything on that line.+bar, wholeOfLineTwo :: Span+bar = mkSpan (2, 1) (2, 4)+wholeOfLineTwo = mkSpan (2, 1) (2, 8)++-- | A region further down than anything a test needs.+laterStill :: Span+laterStill = mkSpan (9, 1) (9, 4)++-- | The @a + b@ of the snippets below, and the @bar@ under them.+operand, bar' :: Span+operand = mkSpan (2, 3) (2, 8)+bar' = mkSpan (4, 1) (4, 4)++-- | The @+ c@ that carries the expression on, lined up with the comment.+continuation :: Span+continuation = mkSpan (4, 3) (4, 6)++----------------------------------------------------------------------------+-- The snippets that take more than one line++carriedOn, indentedFurther, nothingAbove, carriedOnThenMore :: Text+carriedOn =+ "foo =\n\+ \ a + b -- said once\n\+ \ -- and again\n\+ \bar = 2\n"+indentedFurther =+ "foo =\n\+ \ a + b -- said once\n\+ \ -- and again\n\+ \bar = 2\n"+nothingAbove =+ "foo =\n\+ \ a + b\n\+ \ -- and again\n\+ \bar = 2\n"+carriedOnThenMore =+ "foo =\n\+ \ a + b -- said once\n\+ \ -- and again\n\+ \ + c\n"++----------------------------------------------------------------------------+-- Running the rules++-- | Where each comment of a snippet was put, in the order they were+-- written.+--+-- 'Nothing' is a comment nothing came for, which the printer writes after+-- the whole document.+placedIn ::+ -- | The regions a comment may be given to+ [Span] ->+ -- | The boundaries a comment printed in place may not be carried across+ [Span] ->+ -- | A module for the comments to be read out of+ Text ->+ [(Text, Maybe (Position, Span))]+placedIn regions fences src =+ [(renderComment c, lookup (commentSpan c) gathered) | c <- cs]+ where+ cs = commentsIn src+ gathered = fst (foldl collect ([], placeComments regions fences cs) regions)+ collect (found, placements) r = case takePlaced r placements of+ (mine, rest) -> (found <> [(commentSpan c, (p, r)) | (p, c) <- mine], rest)++firstComment :: Text -> Comment+firstComment src = case commentsIn src of+ (c : _) -> c+ [] -> error "the test input had no comments"++commentsIn :: Text -> [Comment]+commentsIn src = case parseModule defaultParserConfig "test.hs" src of+ Left _ -> error "the test input did not parse"+ Right pm -> comments (pmSource pm)
+ tests/Tilia/CommentsSpec.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Extraction of the comment stream from real source text, and the+-- normalizations applied on the way.+module Tilia.CommentsSpec (spec) where++import Data.List.NonEmpty qualified as NE+import Data.Text (Text)+import Data.Text qualified as T+import Test.Hspec+import Tilia.Comments+import Tilia.Comments.Attach+import Tilia.Doc+import Tilia.Doc.Combinators+import Tilia.Parser+import Tilia.Source (comments)+import Tilia.Span++spec :: Spec+spec = do+ describe "extraction" $ do+ it "finds a comment on its own line" $+ bodies "module M where\n-- a comment\nx = 1\n"+ `shouldBe` [["-- a comment"]]++ it "finds several, in source order" $+ bodies "module M where\n-- one\nx = 1\n-- two\ny = 2\n"+ `shouldBe` [["-- one"], ["-- two"]]++ it "finds a block comment and keeps its lines" $+ bodies "module M where\n{- one\n two -}\nx = 1\n"+ `shouldBe` [["{- one", " two -}"]]++ it "reports no comments when there are none" $+ bodies "module M where\nx = 1\n" `shouldBe` []++ describe "trailing" $ do+ it "marks a comment that follows code on its line" $+ trailings "module M where\nx = 1 -- here\n" `shouldBe` [True]+ it "does not mark one on a line of its own" $+ trailings "module M where\n-- here\nx = 1\n" `shouldBe` [False]+ it "does not mark one indented on a line of its own" $+ trailings "module M where\nx =\n -- here\n 1\n" `shouldBe` [False]++ -- The lexer counts a tab as advancing to the next multiple of eight, so a+ -- line holding one has more columns than characters. Everything here works+ -- by cutting the source at a column the compiler reported, and cutting at+ -- the wrong place is not a crash but a comment that quietly believes it+ -- has nothing after it.+ describe "lines indented with tabs" $ do+ it "sees the code before a comment" $+ trailings "module M where\n\tx = 1 -- here\n" `shouldBe` [True]++ it "sees that a comment has the line to itself" $+ trailings "module M where\n\t-- here\n\tx = 1\n" `shouldBe` [False]++ it "sees the code after a block comment" $+ followeds "module M where\n\tx = f {- here -} 1\n" `shouldBe` [True]++ it "sees that nothing follows a block comment" $+ followeds "module M where\n\tx = f 1 {- here -}\n" `shouldBe` [False]++ it "takes the comment's text and no more" $+ bodies "module M where\n\tx = f {- here -} 1\n" `shouldBe` [["{- here -}"]]++ it "dedents a block comment by what precedes it" $+ bodies "module M where\n\t{- one\n\t two -}\nx = 1\n"+ `shouldBe` [["{- one", " two -}"]]++ describe "normalization: space after dashes" $ do+ it "adds a missing space" $+ bodies "module M where\n--tight\nx = 1\n" `shouldBe` [["-- tight"]]+ it "leaves an existing space alone" $+ bodies "module M where\n-- loose\nx = 1\n" `shouldBe` [["-- loose"]]+ it "leaves a divider alone" $+ bodies "module M where\n-------\nx = 1\n" `shouldBe` [["-------"]]+ it "does not touch dashes inside a block comment" $+ bodies "module M where\n{--tight-}\nx = 1\n" `shouldBe` [["{--tight-}"]]++ describe "normalization: trailing whitespace"+ $ it "strips it from every line"+ $ bodies "module M where\n{- one \n two \n three -}\nx = 1\n"+ `shouldBe` [["{- one", " two", " three -}"]]++ describe "normalization: dedent" $ do+ it "drops the comment\'s own start column, not all indentation" $+ bodies "module M where\nx =\n {- one\n two\n three -}\n 1\n"+ `shouldBe` [["{- one", " two", " three -}"]]+ it "keeps relative indentation between continuation lines" $+ bodies "module M where\nx =\n {- one\n two\n three -}\n 1\n"+ `shouldBe` [["{- one", " two", " three -}"]]+ it "leaves an unindented comment alone" $+ bodies "module M where\n{- one\n two -}\nx = 1\n"+ `shouldBe` [["{- one", " two -}"]]++ -- Widening is not part of extraction: whether a doc comment's trigger is+ -- tidied or escaped depends on whether the syntax tree turned out to+ -- carry it, which nothing here knows. So it is asked for.+ describe "normalization: doc trigger" $ do+ it "widens a tight trigger" $+ widened "module M where\n-- |Foo\nx = 1\n" `shouldBe` [["-- | Foo"]]+ it "leaves an already spaced trigger alone" $+ widened "module M where\n-- | Foo\nx = 1\n" `shouldBe` [["-- | Foo"]]+ it "widens a caret trigger" $+ widened "module M where\nx = 1\n-- ^Foo\n" `shouldBe` [["-- ^ Foo"]]+ it "widens a section trigger, keeping its stars" $+ widened "module M where\n-- **Foo\nx = 1\n" `shouldBe` [["-- ** Foo"]]+ it "leaves a named anchor alone" $+ widened "module M where\n-- $section\nx = 1\n" `shouldBe` [["-- $section"]]+ it "leaves a trigger with nothing after it alone" $+ widened "module M where\n-- |\nx = 1\n" `shouldBe` [["-- |"]]+ it "shifts continuation lines to match" $+ widened "module M where\n{-|Foo\n bar\n-}\nx = 1\n"+ `shouldBe` [["{-| Foo", " bar", " -}"]]+ it "does not widen an ordinary line comment" $+ widened "module M where\n-- x|y\nz = 1\n" `shouldBe` [["-- x|y"]]++ describe "pragmas" $ do+ it "recognises one" $+ (commentPragma <$> commentsIn "{-# LANGUAGE CPP #-}\nmodule M where\nx = 1\n")+ `shouldBe` [Just (Pragma "LANGUAGE" "CPP")]+ it "upper-cases the name" $+ (fmap pragmaName . commentPragma <$> commentsIn "{-# language CPP #-}\nmodule M where\nx = 1\n")+ `shouldBe` [Just "LANGUAGE"]+ it "is not fooled by an ordinary block comment" $+ (commentPragma <$> commentsIn "module M where\n{- not a pragma -}\nx = 1\n")+ `shouldBe` [Nothing]+ it "reports the header boundary" $+ headerLine "{-# LANGUAGE CPP #-}\nmodule M where\nimport Data.List\nx = 1\n"+ `shouldBe` Just 3+ it "reports no boundary for a module with only a header" $+ headerLine "{-# LANGUAGE CPP #-}\nmodule M where\n" `shouldBe` Nothing++ describe "what is deliberately not normalized" $ do+ it "keeps blank lines inside a comment" $+ bodies "module M where\n{- one\n\n\n two -}\nx = 1\n"+ `shouldBe` [["{- one", "", "", " two -}"]]+ it "does not escape a Haddock trigger" $+ bodies "module M where\nx = 1\n\n-- | not attached to anything\n"+ `shouldBe` [["-- | not attached to anything"]]++ describe "renderComment"+ $ it "joins the lines back with newlines"+ $ renderComment <$> commentsIn "module M where\n{- one\n two -}\nx = 1\n"+ `shouldBe` ["{- one\n two -}"]++ describe "attachment" $ do+ it "puts a comment before the node it precedes" $+ let c = one "module M where\n-- note\nx = 1\n"+ d = located (mkSpan (3, 1) (3, 5)) (txt "x = 1")+ in render (attachComments [c] d) `shouldBe` "-- note\nx = 1\n"++ it "keeps a trailing comment on the same line" $+ let c = one "module M where\nx = 1 -- note\n"+ d = located (mkSpan (2, 1) (2, 6)) (txt "x = 1")+ in render (attachComments [c] d) `shouldBe` "x = 1 -- note\n"++ it "descends into the node that contains the comment" $+ let c = one "module M where\nx =\n -- note\n 1\n"+ inner = located (mkSpan (4, 3) (4, 4)) (txt "1")+ d = located (mkSpan (2, 1) (4, 4)) (txt "x =" <> indent (hardBreak <> inner))+ in render (attachComments [c] d) `shouldBe` "x =\n -- note\n 1\n"++ it "appends a comment that follows every node rather than dropping it" $+ let c = one "module M where\nx = 1\n-- after\n"+ d = located (mkSpan (2, 1) (2, 6)) (txt "x = 1")+ in+ -- The blank line is added: a comment after everything is about the+ -- file rather than about the line it happens to follow.+ render (attachComments [c] d) `shouldBe` "x = 1\n\n-- after\n"++ it "reaches inside a variant, whichever branch renders" $+ let c = one "module M where\nx = 1 -- note\n"+ n = located (mkSpan (2, 1) (2, 6)) (txt "x = 1")+ d = variant n (txt "(" <> n <> txt ")")+ in ( countOf "-- note" (render (flat (attachComments [c] d))),+ countOf "-- note" (render (broken (attachComments [c] d)))+ )+ `shouldBe` (1, 1)++ it "places a comment inside an empty construct" $+ let c = one "module M where\nx = [ -- note\n ]\n"+ d =+ located (mkSpan (2, 5) (3, 4)) $+ txt "[" <> emptyAnchor (mkSpan (3, 4) (3, 4)) <> txt "]"+ in render (attachComments [c] d) `shouldBe` "[ -- note\n]\n"++ it "emits every comment exactly once" $+ let cs = commentsIn "module M where\n-- a\nx = 1 -- b\n-- c\ny = 2\n"+ d = located (mkSpan (3, 1) (5, 6)) (txt "code")+ out = render (attachComments cs d)+ in (length cs, countOf "-- a" out, countOf "-- b" out, countOf "-- c" out)+ `shouldBe` (3, 1, 1, 1)++----------------------------------------------------------------------------+-- Helpers++render :: Doc -> Text+render = printDoc defaultRenderOptions++one :: Text -> Comment+one src = case commentsIn src of+ (c : _) -> c+ [] -> error "the test input had no comments"++countOf :: Text -> Text -> Int+countOf needle = length . T.breakOnAll needle++commentsIn :: Text -> [Comment]+commentsIn src =+ case parseModule defaultParserConfig "test.hs" src of+ Left _ -> error "the test input did not parse"+ Right pm -> comments (pmSource pm)++bodies :: Text -> [[Text]]+bodies = map (NE.toList . commentBody) . commentsIn++-- | The bodies a doc comment comes out with once its trigger is tidied.+widened :: Text -> [[Text]]+widened = map (NE.toList . commentBody . widenTrigger) . commentsIn++trailings :: Text -> [Bool]+trailings = map commentTrailing . commentsIn++followeds :: Text -> [Bool]+followeds = map commentFollowed . commentsIn++headerLine :: Text -> Maybe Int+headerLine src = case parseModule defaultParserConfig "test.hs" src of+ Left _ -> error "the test input did not parse"+ Right pm -> spanStartLine <$> pmHeaderEnd pm
+ tests/Tilia/Corpus.hs view
@@ -0,0 +1,1030 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Corpora of Haskell to run the formatter over.+module Tilia.Corpus+ ( -- * Corpora+ Corpus (..),+ Source (..),+ Reference (..),+ Expectations (..),+ Lists (..),+ vendoredExamples,+ ormoluExamples,+ ghcTestSuite,+ hackagePackages,++ -- * Obtaining one+ Example (..),+ obtain,+ )+where++import Codec.Archive.Tar qualified as Tar+import Codec.Compression.GZip qualified as GZip+import Control.Exception (SomeException, try)+import Control.Monad (forM)+import Data.ByteString.Lazy qualified as BL+import Data.List (isPrefixOf, isSuffixOf, sort, stripPrefix)+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe, maybeToList)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import GHC.LanguageExtensions.Type (Extension)+import Network.HTTP.Client qualified as HTTP+import Network.HTTP.Req+import System.Directory+ ( XdgDirectory (..),+ createDirectoryIfMissing,+ doesDirectoryExist,+ doesFileExist,+ getXdgDirectory,+ listDirectory,+ removePathForcibly,+ renameDirectory,+ renameFile,+ )+import System.Environment (lookupEnv)+import System.FilePath (splitDirectories, takeDirectory, (</>))+import Tilia.Package (newPackageReader)++----------------------------------------------------------------------------+-- Corpora++-- | Whether a corpus says what the formatted result should look like.+data Reference+ = -- | It does not, so only the properties that hold of any input can be+ -- checked.+ NoReference+ | -- | It does, in a file whose name is the input's with the given mark+ -- put before the extension.+ ReferenceMarked String+ deriving (Eq, Show)++-- | Where the examples of a corpus come from.+data Source+ = -- | Fetched from the network and unpacked into a cache, once per+ -- machine.+ Fetched (Url 'Https, Option 'Https) FilePath+ | -- | Hackage releases, each unpacked beside the others under one root.+ HackageReleases [String]+ | -- | Checked into this repository, so always at hand and never fetched.+ Vendored FilePath++-- | What a corpus says it expects of the formatter.+data Expectations+ = -- | Named by hand, here. Every example not named is expected to format.+ Listed Lists+ | -- | Recorded in a file, one line per example, holding what each of them+ -- does today.+ Recorded FilePath++-- | The exceptions a 'Listed' corpus makes, named in full.+data Lists = Lists+ { -- | Examples to leave alone, named relative to the root of the corpus.+ -- A name with no extension stands for a directory and takes everything+ -- under it.+ expectSkip :: [FilePath],+ -- | Examples the formatter is supposed to refuse.+ expectDeclined :: [FilePath]+ }++-- | Where a corpus comes from and what is in it.+data Corpus = Corpus+ { -- | Used for the cache directory and in test names.+ corpusName :: String,+ -- | Where its examples come from.+ corpusSource :: Source,+ -- | Whether the corpus says what the formatted result should look like.+ corpusReference :: Reference,+ -- | What it expects the formatter to make of them.+ corpusExpectations :: Expectations,+ -- | Are these modules of the package around them?+ --+ -- True for a corpus of releases, where a module is compiled with its+ -- package's @default-extensions@ and does not parse without them.+ corpusInPackages :: Bool+ }++-- | Our own examples.+vendoredExamples :: Corpus+vendoredExamples =+ Corpus+ { corpusName = "tilia",+ corpusSource = Vendored ("corpora" </> "vendored"),+ corpusReference = ReferenceMarked "-out",+ corpusExpectations =+ Listed+ Lists+ { expectSkip = [],+ expectDeclined =+ [ "other" </> "position-pragmas.hs",+ "other" </> "cpp" </> "unbalanced.hs",+ "other" </> "cpp" </> "define-in-a-quasiquote.hs"+ ]+ },+ corpusInPackages = False+ }++-- | Ormolu's examples.+ormoluExamples :: Corpus+ormoluExamples =+ Corpus+ { corpusName = "ormolu-0.9.0.0",+ corpusSource =+ Fetched+ ( https "hackage.haskell.org"+ /: "package"+ /: "ormolu-0.9.0.0"+ /: "ormolu-0.9.0.0.tar.gz",+ mempty+ )+ ("data" </> "examples"),+ corpusReference = ReferenceMarked "-out",+ corpusExpectations =+ Listed Lists {expectSkip = ormoluSkip, expectDeclined = []},+ corpusInPackages = False+ }++-- | GHC's test suite.+ghcTestSuite :: Corpus+ghcTestSuite =+ Corpus+ { corpusName = "ghc-9.10.1-testsuite",+ corpusSource =+ Fetched+ ( https "codeload.github.com"+ /: "ghc"+ /: "ghc"+ /: "tar.gz"+ /: "refs"+ /: "tags"+ /: "ghc-9.10.1-release",+ mempty+ )+ ("testsuite" </> "tests"),+ corpusReference = NoReference,+ corpusExpectations =+ Listed+ Lists+ { expectSkip =+ ["perf" </> "compiler" </> "parsing001.hs"] <> ghcUnreadable,+ expectDeclined = ghcDeclined+ },+ corpusInPackages = False+ }++-- | GHC test suite files the formatter is right to refuse.+ghcDeclined :: [FilePath]+ghcDeclined =+ [ "ghci.debugger" </> "HappyTest.hs",+ "parser" </> "should_compile" </> "ColumnPragma.hs",+ "parser" </> "should_compile" </> "T7118.hs",+ "perf" </> "compiler" </> "T20261.hs",+ "perf" </> "compiler" </> "T5631.hs",+ "programs" </> "joao-circular" </> "Funcs_Parser_Lazy.hs",+ "quasiquotation" </> "T4150.hs"+ ]++-- | Packages from Hackage.+hackagePackages :: Corpus+hackagePackages =+ Corpus+ { corpusName = "hackage",+ corpusSource = HackageReleases hackageReleases,+ corpusReference = NoReference,+ corpusExpectations = Recorded ("corpora" </> "hackage" </> "hackage.manifest"),+ corpusInPackages = True+ }++hackageReleases :: [String]+hackageReleases =+ [ "Agda-2.8.0",+ "HUnit-1.6.2.0",+ "QuickCheck-2.18.0.0",+ "ShellCheck-0.11.0",+ "adjunctions-4.4.4",+ "aeson-2.3.1.0",+ "ansi-terminal-1.1.5",+ "async-2.2.6",+ "attoparsec-0.14.4",+ "aws-0.25.3",+ "base64-bytestring-1.2.1.0",+ "bifunctors-5.6.3",+ "blaze-html-0.9.2.0",+ "blaze-markup-0.8.3.0",+ "brick-2.13",+ "brittany-0.14.0.2",+ "capability-0.5.0.1",+ "cassava-0.5.5.0",+ "comonad-5.0.10",+ "conduit-1.3.6.1",+ "contravariant-1.5.6",+ "criterion-1.6.5.0",+ "cryptonite-0.30",+ "diagrams-core-1.5.1.2",+ "distributed-process-0.7.8",+ "dlist-1.0",+ "esqueleto-3.6.0.3",+ "exceptions-0.10.12",+ "fay-0.24.2.0",+ "free-5.2",+ "hakyll-4.17.0.0",+ "hashable-1.5.1.0",+ "haxl-2.5.1.1",+ "hedgehog-1.7",+ "hledger-1.52.1",+ "hlint-3.10",+ "hspec-core-2.11.17",+ "http-client-0.7.19",+ "http-types-0.12.6",+ "idris-1.3.4",+ "intero-0.1.40",+ "leksah-0.16.2.2",+ "lens-5.3.6",+ "megaparsec-9.8.1",+ "microlens-0.5.0.0",+ "mtl-2.3.2",+ "optics-0.4.2.1",+ "optparse-applicative-0.19.0.0",+ "pandoc-3.10.2",+ "pandoc-types-1.23.1.2",+ "parsec3-1.0.1.8",+ "parser-combinators-1.3.1",+ "persistent-2.18.1.0",+ "pipes-4.3.16",+ "postgrest-9.0.1",+ "profunctors-5.6.3",+ "purescript-0.15.15",+ "raaz-0.3.11",+ "random-1.3.1",+ "recursion-schemes-5.2.3",+ "resourcet-1.3.0",+ "retry-0.9.3.1",+ "safe-exceptions-0.1.7.4",+ "scientific-0.3.8.1",+ "scotty-0.30",+ "semigroupoids-6.0.2",+ "servant-0.20.3.0",+ "servant-server-0.20.3.0",+ "shake-0.19.9",+ "split-0.2.5",+ "stack-9.9.9",+ "statistics-0.16.5.0",+ "stm-2.5.3.1",+ "swagger2-2.9.1",+ "tasty-1.5.4",+ "tensorflow-0.2.0.1",+ "text-2.1.4",+ "th-abstraction-0.7.2.0",+ "time-1.16.0.1",+ "tls-2.4.3",+ "transformers-0.6.3.0",+ "typed-process-0.2.13.0",+ "unliftio-0.2.25.1",+ "unordered-containers-0.2.21",+ "unpacked-containers-0",+ "uuid-types-1.0.6.1",+ "vector-0.13.2.0",+ "vector-algorithms-0.9.1.0",+ "wai-3.2.5",+ "warp-3.4.15",+ "xmonad-0.18.1",+ "yesod-core-1.7.0.0"+ ]++-- | Ormolu examples we do not format the way Ormolu does.+ormoluSkip :: [FilePath]+ormoluSkip =+ [ "other" </> "disabling",+ "declaration" </> "value" </> "function" </> "required-type-arguments-2.hs",+ "declaration" </> "data" </> "comment-in-empty-record.hs",+ "import" </> "comment-inside-empty-import-list.hs",+ "other" </> "comment-two-blocks.hs",+ "other" </> "comment-glued-together.hs",+ "other" </> "multiple-blank-line-comment.hs",+ "declaration" </> "type" </> "parens-comments.hs",+ "declaration" </> "value" </> "function" </> "parens-comments.hs",+ "import" </> "comments-inside-imports.hs",+ "import" </> "comment-between-merged-imports.hs",+ "declaration" </> "data" </> "with-comment.hs",+ "declaration" </> "data" </> "record-empty-haddock.hs",+ "other" </> "empty-haddock.hs",+ "declaration" </> "value" </> "function" </> "arrow" </> "proc-do-complex.hs",+ "declaration" </> "value" </> "function" </> "comprehension" </> "transform-multi-line2.hs",+ "declaration" </> "value" </> "function" </> "if-with-comment-next-to-keyword.hs",+ "declaration" </> "value" </> "function" </> "operator-comments-2.hs",+ "declaration" </> "value" </> "function" </> "record" </> "wildcard-comments-0.hs",+ "declaration" </> "value" </> "function" </> "record" </> "wildcard-comments-1.hs",+ "other" </> "pragma-comments-after.hs",+ "declaration" </> "value" </> "function" </> "infix" </> "esqueleto-0.hs",+ "declaration" </> "value" </> "function" </> "infix" </> "esqueleto-1.hs",+ "declaration" </> "class" </> "default-signatures.hs",+ "declaration" </> "type-families" </> "closed-type-family" </> "with-comments.hs",+ "declaration" </> "deriving" </> "singleline.hs",+ "declaration" </> "deriving" </> "multiline.hs",+ "declaration" </> "deriving" </> "overlapping.hs",+ "declaration" </> "warning" </> "warning-single-line.hs"+ ]+ <> ormoluUnreadable++-- | Ormolu examples GHC's own parser cannot read.+ormoluUnreadable :: [FilePath]+ormoluUnreadable =+ [ "declaration" </> "class" </> "type-operators3.hs",+ "declaration" </> "data" </> "datatype-contexts.hs",+ "declaration" </> "foreign" </> "foreign-import-multiline.hs",+ "declaration" </> "value" </> "function" </> "application-1.hs",+ "declaration" </> "value" </> "function" </> "application-2.hs",+ "declaration" </> "value" </> "function" </> "arrow" </> "proc-cases.hs",+ "declaration" </> "value" </> "function" </> "arrow" </> "proc-do-simple1.hs",+ "declaration" </> "value" </> "function" </> "block-arguments.hs",+ "declaration" </> "value" </> "function" </> "case-empty.hs",+ "declaration" </> "value" </> "function" </> "do-single-line-lambda-case.hs",+ "declaration" </> "value" </> "function" </> "if-multi-line.hs",+ "declaration" </> "value" </> "function" </> "infix" </> "hanging.hs",+ "declaration" </> "value" </> "function" </> "let-multi-line.hs",+ "declaration" </> "value" </> "function" </> "let-single-line.hs",+ "declaration" </> "value" </> "function" </> "negation.hs",+ "declaration" </> "value" </> "function" </> "negative-literals.hs",+ "declaration" </> "value" </> "function" </> "pattern" </> "or-patterns.hs",+ "declaration" </> "value" </> "function" </> "type-applications.hs",+ "other" </> "comment-before-hanging.hs",+ "other" </> "cpp" </> "continuation.hs",+ "other" </> "cpp" </> "cpp-and-imports.hs",+ "other" </> "cpp" </> "lonely-hash.hs",+ "other" </> "cpp" </> "separation-0a.hs",+ "other" </> "cpp" </> "separation-0b.hs",+ "other" </> "cpp" </> "separation-1a.hs",+ "other" </> "cpp" </> "separation-1b.hs",+ "other" </> "cpp" </> "separation-2a.hs",+ "other" </> "cpp" </> "separation-2b.hs",+ "other" </> "cpp" </> "shifted.hs",+ "other" </> "cpp" </> "simple-import.hs",+ "other" </> "necessary-brackets.hs"+ ]++-- | GHC test suite files GHC's own parser cannot read.+ghcUnreadable :: [FilePath]+ghcUnreadable =+ [ "cabal" </> "sigcabal01" </> "p" </> "Map.hsig",+ "driver" </> "dynamicToo" </> "dynamicToo005" </> "A005.hsig",+ "annotations" </> "should_fail" </> "T19374b.hs",+ "annotations" </> "should_fail" </> "T19374c.hs",+ "annotations" </> "should_fail" </> "annfail13.hs",+ "arrows" </> "should_fail" </> "T2111.hs",+ "arrows" </> "should_fail" </> "arrowfail003.hs",+ "cabal" </> "fileStatus.hs",+ "codeGen" </> "should_run" </> "CheckBoundsOK.hs",+ "codeGen" </> "should_run" </> "T10245.hs",+ "codeGen" </> "should_run" </> "T12855.hs",+ "codeGen" </> "should_run" </> "T2080.hs",+ "codeGen" </> "should_run" </> "T7600.hs",+ "codeGen" </> "should_run" </> "cas_int.hs",+ "codeGen" </> "should_run" </> "cgrun044.hs",+ "codeGen" </> "should_run" </> "cgrun071.hs",+ "codeGen" </> "should_run" </> "cgrun072.hs",+ "codeGen" </> "should_run" </> "cgrun075.hs",+ "codeGen" </> "should_run" </> "cgrun076.hs",+ "codeGen" </> "should_run" </> "cgrun077.hs",+ "codeGen" </> "should_run" </> "cgrun079.hs",+ "codeGen" </> "should_run" </> "cgrun080.hs",+ "concurrent" </> "should_run" </> "T5611.hs",+ "concurrent" </> "should_run" </> "T5611a.hs",+ "concurrent" </> "should_run" </> "conc036.hs",+ "concurrent" </> "should_run" </> "conc037.hs",+ "concurrent" </> "should_run" </> "conc038.hs",+ "concurrent" </> "should_run" </> "foreignInterruptible.hs",+ "corelint" </> "T21115.hs",+ "deSugar" </> "should_run" </> "T5742.hs",+ "dependent" </> "should_fail" </> "RenamingStar.hs",+ "dmdanal" </> "should_compile" </> "T9208.hs",+ "driver" </> "FullGHCVersion.hs",+ "driver" </> "T10869.hs",+ "driver" </> "T10869A.hs",+ "driver" </> "T10970.hs",+ "driver" </> "T11763.hs",+ "driver" </> "T12135.hs",+ "driver" </> "T12674" </> "-T12674.hs",+ "driver" </> "T12752pass.hs",+ "driver" </> "T16167.hs",+ "driver" </> "T16476a.hs",+ "driver" </> "T16476b.hs",+ "driver" </> "T16521" </> "A.hs",+ "driver" </> "T17786.hs",+ "driver" </> "T2464.hs",+ "driver" </> "T3389.hs",+ "driver" </> "T8526" </> "A.hs",+ "driver" </> "bug1677" </> "Foo.hs",+ "driver" </> "multipleHomeUnits" </> "c-file" </> "C.hs",+ "driver" </> "multipleHomeUnits" </> "cpp-includes" </> "CPPIncludes.hs",+ "driver" </> "multipleHomeUnits" </> "cpp-includes" </> "CPPIncludes_Down.hs",+ "driver" </> "recomp011" </> "Main.hs",+ "driver" </> "recomp021" </> "A.hs",+ "driver" </> "should_fail" </> "T12752.hs",+ "eyeball" </> "inline2.hs",+ "ffi" </> "should_fail" </> "capi_wrapper.hs",+ "ffi" </> "should_fail" </> "ccall_value.hs",+ "ffi" </> "should_run" </> "T22159.hs",+ "gadt" </> "records-fail1.hs",+ "generics" </> "Uniplate" </> "GUniplate.hs",+ "ghci.debugger" </> "mdo.hs",+ "ghci.debugger" </> "scripts" </> "TupleN.hs",+ "ghci.debugger" </> "scripts" </> "break015.hs",+ "ghci.debugger" </> "scripts" </> "dynbrk005.hs",+ "ghci" </> "prog009" </> "A3.hs",+ "ghci" </> "prog013" </> "Bad.hs",+ "ghci" </> "scripts" </> "ghci022.hs",+ "ghci" </> "scripts" </> "ghci044a.hs",+ "ghci" </> "should_run" </> "PackedDataCon" </> "ByteCode.hs",+ "ghci" </> "should_run" </> "PackedDataCon" </> "Obj.hs",+ "ghci" </> "should_run" </> "UnboxedTuples" </> "ByteCode.hs",+ "ghci" </> "should_run" </> "UnboxedTuples" </> "Obj.hs",+ "ghci" </> "should_run" </> "UnliftedDataTypeInterp" </> "ByteCode.hs",+ "ghci" </> "should_run" </> "UnliftedDataTypeInterp" </> "Obj.hs",+ "haddock" </> "should_compile_flag_haddock" </> "haddockA004.hs",+ "haddock" </> "should_compile_flag_haddock" </> "haddockA011.hs",+ "haddock" </> "should_compile_flag_haddock" </> "haddockA041.hs",+ "haddock" </> "should_compile_noflag_haddock" </> "haddockC004.hs",+ "haddock" </> "should_compile_noflag_haddock" </> "haddockC011.hs",+ "haddock" </> "should_fail_flag_haddock" </> "haddockE003.hs",+ "hiefile" </> "should_compile" </> "CPP.hs",+ "hiefile" </> "should_compile" </> "T22416.hs",+ "hiefile" </> "should_compile" </> "hie002.hs",+ "indexed-types" </> "should_compile" </> "T12538.hs",+ "javascript" </> "T23346.hs",+ "lib" </> "integer" </> "IntegerConversionRules.hs",+ "linear" </> "should_fail" </> "LinearNoExt.hs",+ "linear" </> "should_fail" </> "LinearNoExtU.hs",+ "linear" </> "should_fail" </> "T20083.hs",+ "mdo" </> "should_compile" </> "mdo001.hs",+ "mdo" </> "should_compile" </> "mdo002.hs",+ "mdo" </> "should_compile" </> "mdo003.hs",+ "mdo" </> "should_compile" </> "mdo004.hs",+ "mdo" </> "should_compile" </> "mdo005.hs",+ "mdo" </> "should_compile" </> "mdo006.hs",+ "mdo" </> "should_fail" </> "mdofail001.hs",+ "mdo" </> "should_fail" </> "mdofail002.hs",+ "mdo" </> "should_fail" </> "mdofail003.hs",+ "mdo" </> "should_fail" </> "mdofail004.hs",+ "mdo" </> "should_fail" </> "mdofail005.hs",+ "mdo" </> "should_fail" </> "mdofail006.hs",+ "mdo" </> "should_run" </> "mdorun001.hs",+ "mdo" </> "should_run" </> "mdorun002.hs",+ "mdo" </> "should_run" </> "mdorun003.hs",+ "mdo" </> "should_run" </> "mdorun005.hs",+ "module" </> "Mod178_2.hs",+ "module" </> "T11432.hs",+ "module" </> "T11432a.hs",+ "module" </> "T12026.hs",+ "module" </> "mod183.hs",+ "module" </> "mod69.hs",+ "module" </> "mod70.hs",+ "module" </> "mod76.hs",+ "module" </> "mod89.hs",+ "module" </> "mod98.hs",+ "numeric" </> "should_run" </> "T12136.hs",+ "numeric" </> "should_run" </> "T20291.hs",+ "numeric" </> "should_run" </> "foundation.hs",+ "parser" </> "should_compile" </> "T10582.hs",+ "parser" </> "should_compile" </> "T15279.hs",+ "parser" </> "should_compile" </> "read023.hs",+ "parser" </> "should_compile" </> "read039.hs",+ "parser" </> "should_compile" </> "read046.hs",+ "parser" </> "should_compile" </> "read058.hs",+ "parser" </> "should_fail" </> "ExportCommaComma.hs",+ "parser" </> "should_fail" </> "InfixAppPatErr.hs",+ "parser" </> "should_fail" </> "NoBlockArgumentsFail.hs",+ "parser" </> "should_fail" </> "NoBlockArgumentsFail2.hs",+ "parser" </> "should_fail" </> "NoBlockArgumentsFail3.hs",+ "parser" </> "should_fail" </> "NoBlockArgumentsFailArrowCmds.hs",+ "parser" </> "should_fail" </> "NoDoAndIfThenElse.hs",+ "parser" </> "should_fail" </> "NoNumericUnderscores0.hs",+ "parser" </> "should_fail" </> "NoNumericUnderscores1.hs",+ "parser" </> "should_fail" </> "NoPatternSynonyms.hs",+ "parser" </> "should_fail" </> "OpaqueParseFail1.hs",+ "parser" </> "should_fail" </> "OpaqueParseFail2.hs",+ "parser" </> "should_fail" </> "OpaqueParseFail3.hs",+ "parser" </> "should_fail" </> "ParserNoLambdaCase.hs",+ "parser" </> "should_fail" </> "ParserNoMultiWayIf.hs",+ "parser" </> "should_fail" </> "ParserNoTH1.hs",+ "parser" </> "should_fail" </> "ParserNoTH2.hs",+ "parser" </> "should_fail" </> "RecordDotSyntaxFail0.hs",+ "parser" </> "should_fail" </> "RecordDotSyntaxFail1.hs",+ "parser" </> "should_fail" </> "RecordDotSyntaxFail2.hs",+ "parser" </> "should_fail" </> "RecordDotSyntaxFail3.hs",+ "parser" </> "should_fail" </> "RecordDotSyntaxFail4.hs",+ "parser" </> "should_fail" </> "RecordDotSyntaxFail6.hs",+ "parser" </> "should_fail" </> "RecordDotSyntaxFail7.hs",+ "parser" </> "should_fail" </> "SuffixAtFail.hs",+ "parser" </> "should_fail" </> "T10196Fail1.hs",+ "parser" </> "should_fail" </> "T10196Fail2.hs",+ "parser" </> "should_fail" </> "T10498a.hs",+ "parser" </> "should_fail" </> "T10498b.hs",+ "parser" </> "should_fail" </> "T12045d.hs",+ "parser" </> "should_fail" </> "T12051.hs",+ "parser" </> "should_fail" </> "T12429.hs",+ "parser" </> "should_fail" </> "T12610.hs",+ "parser" </> "should_fail" </> "T13260.hs",+ "parser" </> "should_fail" </> "T1344a.hs",+ "parser" </> "should_fail" </> "T1344b.hs",+ "parser" </> "should_fail" </> "T1344c.hs",+ "parser" </> "should_fail" </> "T13450.hs",+ "parser" </> "should_fail" </> "T13450TH.hs",+ "parser" </> "should_fail" </> "T15730.hs",+ "parser" </> "should_fail" </> "T15730b.hs",+ "parser" </> "should_fail" </> "T15849.hs",+ "parser" </> "should_fail" </> "T16270.hs",+ "parser" </> "should_fail" </> "T16270h.hs",+ "parser" </> "should_fail" </> "T16999.hs",+ "parser" </> "should_fail" </> "T17865.hs",+ "parser" </> "should_fail" </> "T17879a.hs",+ "parser" </> "should_fail" </> "T17879b.hs",+ "parser" </> "should_fail" </> "T18251a.hs",+ "parser" </> "should_fail" </> "T18251b.hs",+ "parser" </> "should_fail" </> "T18251f.hs",+ "parser" </> "should_fail" </> "T19504.hs",+ "parser" </> "should_fail" </> "T19928.hs",+ "parser" </> "should_fail" </> "T20609.hs",+ "parser" </> "should_fail" </> "T20609a.hs",+ "parser" </> "should_fail" </> "T20609b.hs",+ "parser" </> "should_fail" </> "T20609c.hs",+ "parser" </> "should_fail" </> "T20609d.hs",+ "parser" </> "should_fail" </> "T21843a.hs",+ "parser" </> "should_fail" </> "T21843b.hs",+ "parser" </> "should_fail" </> "T21843c.hs",+ "parser" </> "should_fail" </> "T21843d.hs",+ "parser" </> "should_fail" </> "T21843e.hs",+ "parser" </> "should_fail" </> "T21843f.hs",+ "parser" </> "should_fail" </> "T22070.hs",+ "parser" </> "should_fail" </> "T3095.hs",+ "parser" </> "should_fail" </> "T3153.hs",+ "parser" </> "should_fail" </> "T3751.hs",+ "parser" </> "should_fail" </> "T3811.hs",+ "parser" </> "should_fail" </> "T3811b.hs",+ "parser" </> "should_fail" </> "T3811d.hs",+ "parser" </> "should_fail" </> "T3811e.hs",+ "parser" </> "should_fail" </> "T3811f.hs",+ "parser" </> "should_fail" </> "T5425.hs",+ "parser" </> "should_fail" </> "T8431.hs",+ "parser" </> "should_fail" </> "T8501a.hs",+ "parser" </> "should_fail" </> "T8501b.hs",+ "parser" </> "should_fail" </> "T8506.hs",+ "parser" </> "should_fail" </> "T9225.hs",+ "parser" </> "should_fail" </> "T984.hs",+ "parser" </> "should_fail" </> "cmdFail001.hs",+ "parser" </> "should_fail" </> "cmdFail002.hs",+ "parser" </> "should_fail" </> "cmdFail003.hs",+ "parser" </> "should_fail" </> "cmdFail004.hs",+ "parser" </> "should_fail" </> "cmdFail005.hs",+ "parser" </> "should_fail" </> "cmdFail006.hs",+ "parser" </> "should_fail" </> "cmdFail007.hs",+ "parser" </> "should_fail" </> "cmdFail008.hs",+ "parser" </> "should_fail" </> "cmdFail009.hs",+ "parser" </> "should_fail" </> "patFail001.hs",+ "parser" </> "should_fail" </> "patFail002.hs",+ "parser" </> "should_fail" </> "patFail003.hs",+ "parser" </> "should_fail" </> "patFail004.hs",+ "parser" </> "should_fail" </> "patFail005.hs",+ "parser" </> "should_fail" </> "patFail006.hs",+ "parser" </> "should_fail" </> "patFail007.hs",+ "parser" </> "should_fail" </> "patFail008.hs",+ "parser" </> "should_fail" </> "patFail009.hs",+ "parser" </> "should_fail" </> "position001.hs",+ "parser" </> "should_fail" </> "position002.hs",+ "parser" </> "should_fail" </> "proposal-229c.hs",+ "parser" </> "should_fail" </> "readFail002.hs",+ "parser" </> "should_fail" </> "readFail004.hs",+ "parser" </> "should_fail" </> "readFail005.hs",+ "parser" </> "should_fail" </> "readFail006.hs",+ "parser" </> "should_fail" </> "readFail007.hs",+ "parser" </> "should_fail" </> "readFail009.hs",+ "parser" </> "should_fail" </> "readFail011.hs",+ "parser" </> "should_fail" </> "readFail012.hs",+ "parser" </> "should_fail" </> "readFail013.hs",+ "parser" </> "should_fail" </> "readFail014.hs",+ "parser" </> "should_fail" </> "readFail015.hs",+ "parser" </> "should_fail" </> "readFail017.hs",+ "parser" </> "should_fail" </> "readFail018.hs",+ "parser" </> "should_fail" </> "readFail019.hs",+ "parser" </> "should_fail" </> "readFail020.hs",+ "parser" </> "should_fail" </> "readFail022.hs",+ "parser" </> "should_fail" </> "readFail024.hs",+ "parser" </> "should_fail" </> "readFail025.hs",+ "parser" </> "should_fail" </> "readFail026.hs",+ "parser" </> "should_fail" </> "readFail027.hs",+ "parser" </> "should_fail" </> "readFail031.hs",+ "parser" </> "should_fail" </> "readFail033.hs",+ "parser" </> "should_fail" </> "readFail034.hs",+ "parser" </> "should_fail" </> "readFail040.hs",+ "parser" </> "should_fail" </> "readFail047.hs",+ "parser" </> "should_fail" </> "readFailTraditionalRecords1.hs",+ "parser" </> "should_fail" </> "readFailTraditionalRecords2.hs",+ "parser" </> "should_fail" </> "readFailTraditionalRecords3.hs",+ "parser" </> "should_fail" </> "strictnessDataCon_A.hs",+ "parser" </> "should_fail" </> "strictnessDataCon_B.hs",+ "parser" </> "should_fail" </> "typeopsDataCon_A.hs",+ "parser" </> "should_fail" </> "typeopsDataCon_B.hs",+ "parser" </> "should_fail" </> "typeops_A.hs",+ "parser" </> "should_fail" </> "typeops_B.hs",+ "parser" </> "should_fail" </> "typeops_C.hs",+ "parser" </> "should_fail" </> "typeops_D.hs",+ "parser" </> "should_fail" </> "unpack_before_opr.hs",+ "parser" </> "should_fail" </> "unpack_empty_type.hs",+ "parser" </> "unicode" </> "T10907.hs",+ "parser" </> "unicode" </> "T1744.hs",+ "parser" </> "unicode" </> "T18158b.hs",+ "parser" </> "unicode" </> "T18225B.hs",+ "parser" </> "unicode" </> "utf8_001.hs",+ "parser" </> "unicode" </> "utf8_002.hs",+ "parser" </> "unicode" </> "utf8_003.hs",+ "parser" </> "unicode" </> "utf8_004.hs",+ "parser" </> "unicode" </> "utf8_005.hs",+ "parser" </> "unicode" </> "utf8_010.hs",+ "parser" </> "unicode" </> "utf8_011.hs",+ "parser" </> "unicode" </> "utf8_020.hs",+ "parser" </> "unicode" </> "utf8_021.hs",+ "parser" </> "unicode" </> "utf8_022.hs",+ "parser" </> "unicode" </> "utf8_023.hs",+ "partial-sigs" </> "should_compile" </> "T14217.hs",+ "patsyn" </> "should_fail" </> "T10426.hs",+ "patsyn" </> "should_fail" </> "export-syntax.hs",+ "patsyn" </> "should_fail" </> "import-syntax.hs",+ "perf" </> "compiler" </> "T12234.hs",+ "perf" </> "compiler" </> "T14683.hs",+ "perf" </> "compiler" </> "T18698" </> "T18698.hs",+ "perf" </> "should_run" </> "T13623.hs",+ "plugins" </> "T20803a.hs",+ "plugins" </> "plugin-recomp" </> "Common.hs",+ "primops" </> "should_run" </> "T4442.hs",+ "primops" </> "should_run" </> "UnalignedAddrPrimOps.hs",+ "printer" </> "Ppr010.hs",+ "printer" </> "Ppr027.hs",+ "profiling" </> "should_compile" </> "T19894" </> "Fold.hs",+ "profiling" </> "should_compile" </> "T19894" </> "Operations.hs",+ "profiling" </> "should_compile" </> "T19894" </> "Step.hs",+ "profiling" </> "should_compile" </> "T19894" </> "StreamD.hs",+ "profiling" </> "should_compile" </> "T19894" </> "StreamK.hs",+ "profiling" </> "should_compile" </> "T19894" </> "Unfold.hs",+ "profiling" </> "should_compile" </> "T19894" </> "inline.hs",+ "profiling" </> "should_fail" </> "T17916.hs",+ "profiling" </> "should_fail" </> "proffail001.hs",+ "programs" </> "barton-mangler-bug" </> "Bug.hs",+ "programs" </> "joao-circular" </> "Funcs_Lexer.hs",+ "programs" </> "joao-circular" </> "LrcPrelude.hs",+ "qualifieddo" </> "should_fail" </> "qdofail002.hs",+ "qualifieddo" </> "should_fail" </> "qdofail005.hs",+ "quasiquotation" </> "T5204.hs",+ "quotes" </> "T20893.hs",+ "quotes" </> "T3572.hs",+ "quotes" </> "T4056.hs",+ "quotes" </> "T4169.hs",+ "quotes" </> "T4170.hs",+ "quotes" </> "T8455.hs",+ "quotes" </> "T8759a.hs",+ "quotes" </> "T9824.hs",+ "quotes" </> "TH_abstractFamily.hs",+ "quotes" </> "TH_bracket1.hs",+ "quotes" </> "TH_bracket2.hs",+ "quotes" </> "TH_bracket3.hs",+ "quotes" </> "TH_ppr1.hs",+ "quotes" </> "TH_scope.hs",+ "quotes" </> "TH_spliceViewPat" </> "A.hs",+ "rename" </> "should_fail" </> "T12879.hs",+ "rename" </> "should_fail" </> "T14907a.hs",+ "rename" </> "should_fail" </> "T9032.hs",+ "rename" </> "should_fail" </> "T9437.hs",+ "rename" </> "should_fail" </> "rnfail016.hs",+ "rename" </> "should_fail" </> "rnfail016a.hs",+ "roles" </> "should_fail" </> "Roles7.hs",+ "rts" </> "T12497.hs",+ "rts" </> "linker" </> "T20494.hs",+ "rts" </> "linker" </> "T5435.hs",+ "rts" </> "stack002.hs",+ "runghc" </> "T6132.hs",+ "safeHaskell" </> "flags" </> "Flags01.hs",+ "safeHaskell" </> "safeLanguage" </> "SafeLang18.hs",+ "saks" </> "should_fail" </> "saks_fail007.hs",+ "saks" </> "should_fail" </> "saks_fail024.hs",+ "saks" </> "should_fail" </> "saks_fail025.hs",+ "simplCore" </> "T9646" </> "Main.hs",+ "simplCore" </> "T9646" </> "StrictPrim.hs",+ "simplCore" </> "T9646" </> "Type.hs",+ "simplCore" </> "should_compile" </> "T13658.hs",+ "simplCore" </> "should_compile" </> "T21694.hs",+ "simplCore" </> "should_compile" </> "T8832.hs",+ "simplCore" </> "should_run" </> "T21575.hs",+ "stage1" </> "T2632.hs",+ "th" </> "T10279.hs",+ "th" </> "T10638.hs",+ "th" </> "T10819.hs",+ "th" </> "T10891.hs",+ "th" </> "T11484.hs",+ "th" </> "T16180.hs",+ "th" </> "T16326_TH.hs",+ "th" </> "T16980a.hs",+ "th" </> "T23309A.hs",+ "th" </> "T23378A.hs",+ "th" </> "T2817.hs",+ "th" </> "T3177.hs",+ "th" </> "T3177a.hs",+ "th" </> "T4436.hs",+ "th" </> "T5217.hs",+ "th" </> "T6018th.hs",+ "th" </> "T8807.hs",+ "th" </> "T9209.hs",+ "th" </> "TH_ExplicitForAllRules_a.hs",+ "th" </> "TH_class1.hs",+ "th" </> "TH_dataD1.hs",+ "th" </> "TH_foreignCallingConventions.hs",+ "th" </> "TH_implicitParams.hs",+ "th" </> "TH_lookupName.hs",+ "th" </> "TH_raiseErr1.hs",+ "th" </> "TH_recover.hs",+ "th" </> "TH_recursiveDo.hs",+ "th" </> "TH_recursiveDoImport.hs",+ "th" </> "TH_reifyDecl1.hs",+ "th" </> "TH_reifyDecl2.hs",+ "th" </> "TH_reifyExplicitForAllFams.hs",+ "th" </> "TH_reifyInstances.hs",+ "th" </> "TH_reifyLinear.hs",+ "th" </> "TH_reifyLocalDefs.hs",+ "th" </> "TH_reifyMkName.hs",+ "th" </> "TH_repE2.hs",+ "th" </> "TH_repGuard.hs",+ "th" </> "TH_repGuardOutput.hs",+ "th" </> "TH_repPatSig.hs",+ "th" </> "TH_repPatSigTVar.hs",+ "th" </> "TH_repPrim.hs",+ "th" </> "TH_repPrim2.hs",+ "th" </> "TH_repPrimOutput.hs",+ "th" </> "TH_repPrimOutput2.hs",+ "th" </> "TH_sections.hs",+ "th" </> "TH_spliceD2.hs",+ "th" </> "TH_spliceDecl1.hs",+ "th" </> "TH_spliceDecl2.hs",+ "th" </> "TH_spliceDecl3.hs",+ "th" </> "TH_spliceE1.hs",+ "th" </> "TH_spliceE3.hs",+ "th" </> "TH_spliceE4.hs",+ "th" </> "TH_spliceExpr1.hs",+ "th" </> "TH_spliceGuard.hs",+ "th" </> "TH_tf1.hs",+ "th" </> "TH_tf3.hs",+ "th" </> "TH_unresolvedInfix.hs",+ "th" </> "TH_unresolvedInfix2.hs",+ "typecheck" </> "should_compile" </> "FloatFDs.hs",+ "typecheck" </> "should_compile" </> "tc134.hs",+ "typecheck" </> "should_fail" </> "ExplicitSpecificity3.hs",+ "typecheck" </> "should_fail" </> "ExplicitSpecificity8.hs",+ "typecheck" </> "should_fail" </> "T13446.hs",+ "typecheck" </> "should_fail" </> "T14761b.hs",+ "typecheck" </> "should_fail" </> "T2126.hs",+ "typecheck" </> "should_fail" </> "T3102.hs",+ "typecheck" </> "should_fail" </> "T9634.hs",+ "typecheck" </> "should_fail" </> "tcfail089.hs",+ "typecheck" </> "should_run" </> "T1735.hs",+ "typecheck" </> "should_run" </> "T1735_Help" </> "Main.hs",+ "typecheck" </> "should_run" </> "T4809.hs",+ "unboxedsums" </> "UnboxedSumsTH_Fail.hs",+ "unboxedsums" </> "unboxedsums4.hs",+ "warnings" </> "should_fail" </> "CaretDiagnostics2.hs",+ "wcompat-warnings" </> "WCompatWarningsOff.hs",+ "wcompat-warnings" </> "WCompatWarningsOn.hs",+ "wcompat-warnings" </> "WCompatWarningsOnOff.hs"+ ]++----------------------------------------------------------------------------+-- Obtaining one++-- | One thing to format, and what it should come out as if that is known.+data Example = Example+ { -- | Where the corpus puts it, relative to the corpus root, which is+ -- what names the test: the absolute path runs through a cache directory+ -- that differs on every machine.+ exampleName :: FilePath,+ -- | The file to format, as an absolute path on this machine.+ exampleInput :: FilePath,+ -- | The file holding what the corpus says formatting should produce, if+ -- it says. 'Nothing' for a corpus that ships no expected outputs, and+ -- for an example within one that happens to have none.+ exampleReference :: Maybe FilePath,+ -- | What the package around it puts in force, already resolved from its+ -- @.cabal@ file. Empty for a corpus whose examples are not modules of a+ -- package; see 'corpusInPackages'.+ exampleExtensions :: [Extension]+ }+ deriving (Eq, Show)++-- | Get a corpus, fetching and unpacking it if this machine does not have+-- it yet.+--+-- Fetching happens once: an unpacked corpus is left in place and found+-- again, and a download interrupted half way leaves nothing behind to be+-- mistaken for a complete one. 'Left' is for the machine that cannot reach+-- the network rather than for a defect, and callers are expected to say so+-- and carry on rather than fail. A vendored corpus is already here and can+-- never fail this way.+obtain :: Corpus -> IO (Either Text [Example])+obtain corpus = case corpusSource corpus of+ Vendored dir -> Right <$> examplesIn corpus dir+ Fetched url root -> do+ home <- corpusCache+ let unpacked = home </> corpusName corpus+ createDirectoryIfMissing True home+ fetch url (home </> corpusName corpus <> ".tar.gz") unpacked >>= \case+ Left problem -> pure (Left problem)+ Right () -> Right <$> examplesIn corpus (unpacked </> root)+ HackageReleases releases -> do+ home <- corpusCache+ let root = home </> corpusName corpus+ createDirectoryIfMissing True root+ inTurn root releases >>= \case+ Left problem -> pure (Left problem)+ Right () -> Right <$> examplesIn corpus root+ where+ inTurn _ [] = pure (Right ())+ inTurn root (name : rest) =+ fetch (hackage name) (root </> name <> ".tar.gz") (root </> name) >>= \case+ Left problem -> pure (Left problem)+ Right () -> inTurn root rest++-- | Put an archive's contents where they are wanted, if they are not there.+--+-- Fetching happens once and unpacking happens once, and either step already+-- done is skipped.+fetch :: (Url 'Https, Option 'Https) -> FilePath -> FilePath -> IO (Either Text ())+fetch url archive unpacked =+ doesDirectoryExist unpacked >>= \case+ True -> pure (Right ())+ False -> do+ have <- doesFileExist archive+ got <- if have then pure (Right ()) else download url archive+ either (pure . Left) (const (unpackTo archive unpacked)) got++-- | Where Hackage keeps a release's sources.+hackage :: String -> (Url 'Https, Option 'Https)+hackage name =+ ( https "hackage.haskell.org"+ /: "package"+ /: T.pack name+ /: T.pack (name <> ".tar.gz"),+ mempty+ )++-- | Where corpora are kept.+--+-- Beside the fixity cache, and for the same reason: it is data about the+-- outside world that is expensive to obtain and cheap to keep.+corpusCache :: IO FilePath+corpusCache =+ lookupEnv "TILIA_CORPUS_DIR" >>= \case+ Just dir -> pure dir+ Nothing -> (</> "corpus") <$> getXdgDirectory XdgCache "tilia"++----------------------------------------------------------------------------+-- Fetching++-- | Fetch an archive.+--+-- Written to a temporary name and moved into place. Anything that leaves a+-- partial file under the real name would be taken for a complete download+-- on the next run and never fetched again.+--+-- 'Left' is for the machine that cannot reach the network rather than for a+-- defect, and callers are expected to say so and carry on. Only the fetch+-- is caught: a file that cannot be written is a fault worth hearing about.+download :: (Url 'Https, Option 'Https) -> FilePath -> IO (Either Text ())+download (url, query) dest =+ try get >>= \case+ Left (e :: HttpException) -> pure (Left (explain e))+ Right bytes+ | not (gzipped bytes) -> pure (Left "the answer was not an archive")+ | otherwise -> do+ BL.writeFile partial bytes+ Right <$> renameFile partial dest+ where+ partial = dest <> ".part"+ -- The two bytes every gzip stream opens with.+ gzipped = (== [0x1f, 0x8b]) . BL.unpack . BL.take 2+ get =+ runReq defaultHttpConfig $+ responseBody <$> req GET url NoReqBody lbsResponse query+ explain = \case+ VanillaHttpException (HTTP.HttpExceptionRequest _ reason) -> flatten reason+ other -> flatten other+ flatten :: (Show a) => a -> Text+ flatten = T.take 200 . T.unwords . T.words . T.pack . show++-- | Unpack the Haskell files of an archive, dropping its top-level+-- directory.+unpackTo :: FilePath -> FilePath -> IO (Either Text ())+unpackTo archive dest = do+ removePathForcibly staging+ outcome <- quietly (Left "could not unpack") $ do+ bytes <- BL.readFile archive+ Tar.foldEntries write (pure ()) (const (pure ())) (Tar.read (GZip.decompress bytes))+ pure (Right ())+ case outcome of+ Left problem -> do+ removePathForcibly staging+ pure (Left (problem <> " " <> T.pack archive))+ Right () -> do+ there <- doesDirectoryExist staging+ if there+ then Right <$> renameDirectory staging dest+ else pure (Left ("nothing to unpack in " <> T.pack archive))+ where+ staging = dest <> ".part"++ write entry rest = do+ case Tar.entryContent entry of+ Tar.NormalFile content _+ | Just path <- beneathTop (Tar.entryPath entry),+ any (`isSuffixOf` path) (".cabal" : haskellExtensions) -> do+ createDirectoryIfMissing True (takeDirectory (staging </> path))+ BL.writeFile (staging </> path) content+ _ -> pure ()+ rest+ beneathTop path = case splitDirectories path of+ (_ : rest@(_ : _)) | all safe rest -> Just (foldr1 (</>) rest)+ _ -> Nothing+ safe part = part /= ".." && not ("/" `isPrefixOf` part)++----------------------------------------------------------------------------+-- Enumerating++-- | Every example in an unpacked corpus, in a settled order.+examplesIn :: Corpus -> FilePath -> IO [Example]+examplesIn corpus root = do+ found <- sort <$> haskellFilesIn root+ reader <- packageReaderFor corpus+ let present = Set.fromList found+ files = filter (not . skipped) found+ example f reference = Example (nameOf f) f reference <$> reader f+ case corpusReference corpus of+ NoReference -> traverse (`example` Nothing) files+ ReferenceMarked mark ->+ forM (filter (not . answerTo mark present) files) $ \f ->+ if mark `isSuffixOf` stemOf f+ then example f (Just f)+ else do+ let reference = stemOf f <> mark <> extensionOf f+ there <- doesFileExist reference+ example f (if there then Just reference else Nothing)+ where+ nameOf f = fromMaybe f (stripPrefix (root <> "/") f)+ answerTo mark present f = case withoutSuffix mark (stemOf f) of+ Just stem -> Set.member (stem <> extensionOf f) present+ Nothing -> False+ skipped f = any listed (nameOf f : maybeToList (inputFor (nameOf f)))+ listed name = any covers skips+ where+ covers entry = entry == name || (entry <> "/") `isPrefixOf` name+ skips = case corpusExpectations corpus of+ Listed lists -> expectSkip lists+ Recorded _ -> []+ inputFor name = case corpusReference corpus of+ ReferenceMarked mark+ | Just stem <- withoutSuffix mark (stemOf name) ->+ Just (stem <> extensionOf name)+ _ -> Nothing+ withoutSuffix suffix name+ | suffix `isSuffixOf` name = Just (take (length name - length suffix) name)+ | otherwise = Nothing+ stemOf f =+ fromMaybe f (listToMaybe (mapMaybe (`withoutSuffix` f) haskellExtensions))+ extensionOf f =+ fromMaybe "" (listToMaybe (filter (`isSuffixOf` f) haskellExtensions))++-- | What each of a corpus's examples has in force before its own pragmas.+packageReaderFor :: Corpus -> IO (FilePath -> IO [Extension])+packageReaderFor corpus+ | not (corpusInPackages corpus) = pure (const (pure []))+ | otherwise = do+ reader <- newPackageReader+ pure (fmap (either (const []) id) . reader)++-- | The extensions an example may be written with.+haskellExtensions :: [String]+haskellExtensions = [".hs", ".hs-boot", ".hsig"]++haskellFilesIn :: FilePath -> IO [FilePath]+haskellFilesIn dir = do+ isDir <- doesDirectoryExist dir+ if not isDir+ then pure [dir | any (`isSuffixOf` dir) haskellExtensions]+ else do+ entries <- quietly [] (listDirectory dir)+ concat <$> traverse (haskellFilesIn . (dir </>)) entries++----------------------------------------------------------------------------+-- Helpers++quietly :: a -> IO a -> IO a+quietly fallback action =+ try action >>= \case+ Left (_ :: SomeException) -> pure fallback+ Right a -> pure a
+ tests/Tilia/Corpus/Manifest.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | What a corpus too large to argue about example by example is expected to+-- do.+module Tilia.Corpus.Manifest+ ( -- * What an example does+ Outcome (..),+ outcomeName,++ -- * Records of it+ Entry (..),+ digestOf,+ noDigest,+ Manifest,+ readManifest,+ writeManifest,+ writeReport,+ accepting,+ )+where++import Control.Exception (SomeException, try)+import Crypto.Hash.SHA256 qualified as SHA256+import Data.ByteString.Base16 qualified as B16+import Data.List (sortOn)+import Data.Map.Strict (Map)+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 Data.Text.IO qualified as T+import System.Directory (createDirectoryIfMissing)+import System.Environment (lookupEnv)+import System.FilePath (takeDirectory)++----------------------------------------------------------------------------+-- What an example does++-- | What running the formatter over one example established, coarsely enough+-- to write down and compare.+data Outcome+ = -- | Nothing was found wrong with it.+ Formatted+ | -- | Nothing was found wrong with it, and one of the things worth asking+ -- went unasked because it could not be afforded. See+ -- 'Tilia.CorpusSpec.checkCpp'.+ PartlyChecked+ | -- | The input is Haskell, and the formatter refuses to rewrite it.+ Declined+ | -- | GHC's own parser could not read it. Common in a corpus of real+ -- releases, which carry files that are Haskell templates, files written+ -- for compilers other than GHC, and files whose @CPP@ we do not expand.+ DoesNotParse+ | -- | The bytes are not UTF-8, so there was nothing to parse.+ NotUtf8+ | -- | A property does not hold. The work list.+ Broken+ deriving (Eq, Ord, Show, Enum, Bounded)++-- | What an outcome is called in a manifest.+outcomeName :: Outcome -> Text+outcomeName = \case+ Formatted -> "formatted"+ PartlyChecked -> "partly-checked"+ Declined -> "declined"+ DoesNotParse -> "does-not-parse"+ NotUtf8 -> "not-utf8"+ Broken -> "broken"++-- | Reading one back, by the name it was written under.+outcomeNamed :: Text -> Maybe Outcome+outcomeNamed name =+ lookup name [(outcomeName o, o) | o <- [minBound .. maxBound]]++----------------------------------------------------------------------------+-- Records of it++-- | What one example did, and what it produced.+data Entry = Entry+ { -- | Expected outcome+ entryOutcome :: Outcome,+ -- | A digest of what the formatter wrote, or 'noDigest' where it wrote+ -- nothing.+ entryDigest :: Text+ }+ deriving (Eq, Show)++-- | A short digest of an example's output.+digestOf :: Text -> Text+digestOf = T.take 12 . T.decodeUtf8 . B16.encode . SHA256.hash . T.encodeUtf8++-- | What stands in the digest's place where the formatter wrote nothing.+noDigest :: Text+noDigest = "-"++type Manifest = Map FilePath Entry++-- | Read a manifest.+--+-- A missing one is an empty one rather than an error, so that a corpus added+-- to this repository before its manifest has been generated says which+-- examples it does not know about, one line each, instead of failing once+-- with a message about a file.+readManifest :: FilePath -> IO Manifest+readManifest path =+ try (T.readFile path) >>= \case+ Left (_ :: SomeException) -> pure Map.empty+ Right text -> pure (Map.fromList (concatMap entry (T.lines text)))+ where+ entry line = case T.words line of+ (what : digest : rest)+ | not ("#" `T.isPrefixOf` what),+ Just outcome <- outcomeNamed what,+ not (null rest) ->+ [(T.unpack (T.unwords rest), Entry outcome digest)]+ _ -> []++-- | Write a manifest, sorted by name so that a regeneration diff shows what+-- changed rather than what moved.+writeManifest :: FilePath -> Manifest -> IO ()+writeManifest path manifest = do+ createDirectoryIfMissing True (takeDirectory path)+ T.writeFile path (T.unlines (header <> map line (Map.toAscList manifest)))+ where+ header =+ [ "# What each example of this corpus does today, one line each.",+ "# Generated: run the test suite with TILIA_CORPUS_ACCEPT=1.",+ "# See Tilia.Corpus.Manifest for what the outcomes mean, and the",+ "# matching .report for why each example that is not `formatted` is",+ "# not.",+ ""+ ]+ line (name, entry) =+ T.justifyLeft width ' ' (outcomeName (entryOutcome entry))+ <> T.justifyLeft 14 ' ' (entryDigest entry)+ <> T.pack name+ width =+ 2 + maximum (1 : map (T.length . outcomeName . entryOutcome) (Map.elems manifest))++-- | Write the reasons beside the record.+writeReport :: FilePath -> [(FilePath, Outcome, Text)] -> IO ()+writeReport path entries = do+ createDirectoryIfMissing True (takeDirectory path)+ T.writeFile path (T.unlines (header <> concatMap section grouped))+ where+ interesting = [e | e@(_, outcome, _) <- entries, outcome /= Formatted]+ grouped =+ [ (outcome, [(name, why) | (name, o, why) <- sortOn first interesting, o == outcome])+ | outcome <- sections+ ]+ first (name, _, _) = name+ sections = [Broken, DoesNotParse, PartlyChecked, Declined, NotUtf8]+ header =+ [ "Why every example of this corpus that is not `formatted` is not.",+ "",+ "Generated beside the manifest, and compared against nothing: this",+ "file is the work list, and it is free to say as much as it likes.",+ "",+ T.pack (show (length entries))+ <> " examples, "+ <> T.pack (show (length entries - length interesting))+ <> " formatted.",+ ""+ ]+ section (_, []) = []+ section (outcome, es) =+ [ T.replicate 74 "=",+ outcomeName outcome <> " (" <> T.pack (show (length es)) <> ")",+ T.replicate 74 "=",+ ""+ ]+ <> concatMap entry es+ entry (name, why) =+ [T.pack name] <> map (" " <>) (T.lines (T.strip why)) <> [""]++-- | Is this run supposed to write the records rather than check against+-- them?+accepting :: IO Bool+accepting =+ lookupEnv "TILIA_CORPUS_ACCEPT" >>= \case+ Just s | s `notElem` ["", "0", "no", "false"] -> pure True+ _ -> pure False
+ tests/Tilia/CorpusSpec.hs view
@@ -0,0 +1,479 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Formatting other people's Haskell.+module Tilia.CorpusSpec (spec) where++import Control.Exception (SomeException, evaluate, try)+import Control.Monad (join, unless)+import Data.ByteString qualified as BS+import Data.Foldable (for_)+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding (decodeUtf8')+import GHC.LanguageExtensions.Type (Extension)+import System.FilePath (replaceExtension)+import Test.Hspec hiding (Example, after, before, example)+import Tilia.Corpus+import Tilia.Corpus.Manifest+import Tilia.Cpp+ ( answeredLeaves,+ answeredLinearLeaves,+ blankCpp,+ countLeaves,+ describeCppError,+ formatWithCpp,+ usesCpp,+ )+import Tilia.Diff (diff)+import Tilia.Doc (defaultRenderOptions, printDoc)+import Tilia.Equivalence (commentDifference, syntaxDifference)+import Tilia.Palette (Palette, paletteFor)+import Tilia.Parser+ ( ParseError (..),+ ParsedModule (..),+ ParserConfig,+ parseModule,+ parserConfigFor,+ )+import Tilia.Pragma (effectiveExtensions, movesPositions)+import Tilia.Render (RenderConfig, defaultRenderConfig, renderModule)+import Tilia.Source (comments)+import Tilia.Span (spanStartColumn, spanStartLine)+import Tilia.Span.Ghc (spanOfSrcSpan)+import Tilia.TestConfig (exampleRenderConfig)++spec :: Spec+spec = do+ corpusSpec vendoredExamples+ corpusSpec ormoluExamples+ corpusSpec ghcTestSuite+ corpusSpec hackagePackages++-- | Every example of one corpus.+corpusSpec :: Corpus -> Spec+corpusSpec corpus =+ describe (corpusName corpus) $+ runIO (obtain corpus) >>= \case+ Left problem ->+ it "is available" . pendingWith $+ "corpus not on this machine and could not be fetched: " <> T.unpack problem+ Right examples -> do+ palette <- runIO paletteFor+ let run = check palette+ case corpusExpectations corpus of+ Listed lists -> againstLists lists run examples+ Recorded path -> againstRecord path run examples++-- | A corpus small enough to name its exceptions in "Tilia.Corpus".+againstLists :: Lists -> (Example -> IO Result) -> [Example] -> Spec+againstLists listed run examples =+ parallel $ for_ examples $ \example ->+ it (exampleName example) $ do+ result <- run example+ case verdict (Set.member (exampleName example) declines) result of+ Passes -> pure ()+ Fails why -> expectationFailure (T.unpack why)+ Reserved why -> pendingWith (T.unpack why)+ where+ declines = Set.fromList (expectDeclined listed)++-- | A corpus checked against a generated record of what it does.+againstRecord :: FilePath -> (Example -> IO Result) -> [Example] -> Spec+againstRecord path run examples = do+ accept <- runIO accepting+ if accept then accepted else checked+ where+ reportPath = replaceExtension path ".report"++ accepted = do+ seen <- runIO (newIORef [])+ afterAll_ (record seen) $+ parallel $+ for_ examples $ \example ->+ it (exampleName example) $ do+ Result outcome why digest <- run example+ note seen (exampleName example, Entry outcome digest, T.take reasonLength why)++ record seen = do+ noted <- readIORef seen+ if length noted /= length examples+ then+ putStrLn $+ "not writing "+ <> path+ <> ": "+ <> show (length noted)+ <> " of "+ <> show (length examples)+ <> " examples ran, so this run does not know what the rest do."+ <> " Regenerate without --match."+ else do+ writeManifest path (Map.fromList [(n, e) | (n, e, _) <- noted])+ writeReport reportPath [(n, entryOutcome e, w) | (n, e, w) <- noted]++ note :: IORef [a] -> a -> IO ()+ note seen entry = atomicModifyIORef' seen (\es -> (entry : es, ()))++ checked = do+ manifest <- runIO (readManifest path)+ parallel $ for_ examples $ \example ->+ it (exampleName example) $ do+ Result outcome why digest <- run example+ case Map.lookup (exampleName example) manifest of+ Nothing -> expectationFailure (T.unpack (unrecorded outcome))+ Just expected+ | entryOutcome expected /= outcome ->+ expectationFailure (T.unpack (moved (entryOutcome expected) outcome why))+ | entryDigest expected /= digest ->+ expectationFailure (T.unpack (rewritten (entryDigest expected) digest))+ | otherwise -> case outcome of+ Formatted -> pure ()+ Declined -> pure ()+ DoesNotParse -> pure ()+ NotUtf8 -> pure ()+ PartlyChecked -> pendingWith (T.unpack why)+ Broken -> pendingWith (T.unpack (T.take reasonLength why))+ it "records nothing it does not have" $ do+ let had = Set.fromList (map exampleName examples)+ gone = [n | n <- Map.keys manifest, not (Set.member n had)]+ unless (null gone) . expectationFailure $+ show (length gone)+ <> " entries name examples this corpus does not have, starting with "+ <> unwords (take 5 gone)+ <> regenerate++ unrecorded outcome =+ "this is not in "+ <> T.pack path+ <> ", and it "+ <> outcomeName outcome+ <> T.pack regenerate++ rewritten was now =+ T.pack path+ <> " says this comes out as "+ <> was+ <> ", and it comes out as "+ <> now+ <> T.pack regenerate++ moved expected outcome why =+ T.pack path+ <> " says this "+ <> outcomeName expected+ <> ", and it "+ <> outcomeName outcome+ <> (if T.null why then "" else ": " <> why)+ <> T.pack regenerate++ regenerate =+ "\n\nIf that is the intended change, regenerate the record:"+ <> "\n TILIA_CORPUS_ACCEPT=1 cabal test"++-- | How much of an example's reason a record keeps.+reasonLength :: Int+reasonLength = 2000++----------------------------------------------------------------------------+-- Checking one example++-- | What running the formatter over one example established, and why.+data Result = Result+ { -- | The outcome.+ resultOutcome :: Outcome,+ -- | Explanation in text.+ resultWhy :: Text,+ -- | A digest of what the formatter wrote, or+ -- 'Tilia.Corpus.Manifest.noDigest' where it wrote nothing.+ resultDigest :: Text+ }++-- | What the runner should do about what one example produced.+data Verdict+ = -- | Nothing to report.+ Passes+ | -- | Something is wrong, and this is what.+ Fails Text+ | -- | Neither: everything that was asked of it held, and something worth+ -- asking went unasked. Reported rather than passed over, so that the+ -- number of examples whose properties were only partly established is+ -- visible in the summary instead of implied by its absence.+ Reserved Text++-- | What is to be said about what one example produced.+verdict ::+ -- | Does the corpus say this one should be declined?+ Bool ->+ Result ->+ Verdict+verdict declines (Result outcome why _) = case outcome of+ Broken -> Fails why+ NotUtf8 -> Fails (unlisted "is not UTF-8")+ DoesNotParse -> Fails (unlisted ("does not parse, at " <> why))+ Declined+ | declines -> Passes+ | otherwise -> Fails "the formatter declined this, and the corpus does not say it should"+ PartlyChecked+ | declines -> Fails wasNotDeclined+ | otherwise -> Reserved why+ Formatted+ | declines -> Fails wasNotDeclined+ | otherwise -> Passes+ where+ wasNotDeclined = "the corpus says this should be declined, and it was not"+ unlisted what =+ "this " <> what <> ", and the corpus does not list it under expectSkip"++check :: Palette -> Example -> IO Result+check palette example = do+ source <- readUtf8 (exampleInput example)+ expected <- traverse readUtf8 (exampleReference example)+ case source of+ Nothing -> pure (Result NotUtf8 "" noDigest)+ Just text ->+ guarded (checkPure palette (exampleName example) (exampleExtensions example) text (join expected))++-- | Read a file that is supposed to be a Haskell module.+readUtf8 :: FilePath -> IO (Maybe Text)+readUtf8 path = either (const Nothing) Just . decodeUtf8' <$> BS.readFile path++-- | Run a check, turning a crash into a failure rather than into a dead test+-- run.+guarded :: Result -> IO Result+guarded result =+ try (evaluate (forced result)) >>= \case+ Left (e :: SomeException) ->+ pure (Result Broken ("the formatter raised an error: " <> firstLine (T.pack (show e))) noDigest)+ Right settled -> pure settled+ where+ forced r =+ resultOutcome r+ `seq` T.length (resultWhy r)+ `seq` T.length (resultDigest r)+ `seq` r+ firstLine = T.strip . T.takeWhile (/= '\n')++-- | Everything that can be established about one example without doing any+-- more input or output.+checkPure :: Palette -> FilePath -> [Extension] -> Text -> Maybe Text -> Result+checkPure palette path package source expected+ | movesPositions source =+ Result Declined "a pragma that moves positions, which we do not rewrite" noDigest+ | usesCpp inForce source = checkCpp palette path package source expected+ | otherwise = case parseModule config path source of+ Left problem -> Result DoesNotParse (parseProblem problem) noDigest+ Right before ->+ let formatted = render before+ against name = diff palette ("input", name) source formatted+ in case parse formatted of+ Nothing ->+ told+ formatted+ Broken+ ( "the formatted output does not parse\n"+ <> against "output (does not parse)"+ )+ Just after+ | Just difference <- syntaxDifference (pmModule before) (pmModule after) ->+ told+ formatted+ Broken+ ( "a different program: "+ <> difference+ <> "\n"+ <> against "output"+ )+ | Just difference <-+ commentDifference+ (pmModule before, pmModule after)+ (comments (pmSource before))+ (comments (pmSource after)) ->+ told+ formatted+ Broken+ ( "comments: "+ <> difference+ <> "\n"+ <> against "output"+ )+ | settled <- render after,+ settled /= formatted ->+ told+ formatted+ Broken+ ( "formatting is non-idempotent\n"+ <> diff palette ("first pass", "second pass") formatted settled+ )+ | Just reference <- expected,+ reference /= formatted ->+ told+ formatted+ Broken+ ( "does not match the corpus's expected output\n"+ <> diff palette ("expected", "ours") reference formatted+ )+ | otherwise -> told formatted Formatted ""+ where+ told formatted outcome why = Result outcome why (digestOf formatted)+ config = parserConfigFor package+ inForce = effectiveExtensions package source+ parse = either (const Nothing) Just . parseModule config path+ render parsed =+ printDoc+ defaultRenderOptions+ (renderModule (exampleRenderConfig package source (pmModule parsed)) parsed)++----------------------------------------------------------------------------+-- Checking an example that involved the preprocessor++-- | Everything that can be established about an example with conditionals in+-- it.+checkCpp :: Palette -> FilePath -> [Extension] -> Text -> Maybe Text -> Result+checkCpp palette path package source expected = case formatWithCpp parser render path source of+ Left why -> Result Declined (describeCppError why) noDigest+ Right formatted -> case (countLeaves source, countLeaves formatted) of+ (Left why, _) ->+ told formatted Broken ("the input's configurations: " <> describeCppError why)+ (_, Left why) ->+ told formatted Broken ("the output's configurations: " <> describeCppError why <> "\n" <> against formatted)+ (Right went, Right came)+ | went /= came ->+ told+ formatted+ Broken+ ( "formatting changed how many configurations there are, from "+ <> count went+ <> " to "+ <> count came+ <> "\n"+ <> against formatted+ )+ | went <= configurationsToCheck -> quantified answeredLeaves Nothing formatted+ | otherwise ->+ quantified+ answeredLinearLeaves+ ( Just+ ( count went+ <> " configurations is more than the "+ <> count configurationsToCheck+ <> " this checks, so only the ones varying a single"+ <> " conditional were compared"+ )+ )+ formatted+ where+ told formatted outcome why = Result outcome why (digestOf formatted)+ count :: Integer -> Text+ count = T.pack . show+ against formatted = diff palette ("input", "output") source formatted+ quantified enumerate reservation formatted =+ case (enumerate source, enumerate formatted) of+ (Left why, _) ->+ told formatted Broken ("the input's configurations: " <> describeCppError why)+ (_, Left why) ->+ told formatted Broken ("the output's configurations: " <> describeCppError why <> "\n" <> against formatted)+ (Right went, Right came)+ | (why : _) <- alongside went came ->+ told formatted Broken (why <> "\n" <> against formatted)+ | otherwise -> case formatWithCpp parser render path formatted of+ Left why ->+ told formatted Broken ("the output cannot be formatted again: " <> describeCppError why)+ Right settled+ | settled /= formatted ->+ told+ formatted+ Broken+ ( "formatting is non-idempotent\n"+ <> diff palette ("first pass", "second pass") formatted settled+ )+ | Just reference <- expected,+ reference /= formatted ->+ told+ formatted+ Broken+ ( "does not match the corpus's expected output\n"+ <> diff palette ("expected", "ours") reference formatted+ )+ | otherwise ->+ maybe (told formatted Formatted "") (told formatted PartlyChecked) reservation+ alongside went came =+ [ why+ | (answers, before) <- went,+ why <- case Map.lookup answers output of+ Nothing -> ["a configuration of the input the output does not have"]+ Just after -> maybe [] pure (sameProgram before after)+ ]+ <> [ "a configuration of the output the input does not have"+ | any (\(answers, _) -> not (Map.member answers input)) came+ ]+ where+ output = Map.fromList came+ input = Map.fromList went++ sameProgram went came = case (parse went, parse came) of+ (Left problem, _) ->+ Just ("a configuration of the input does not parse: " <> parseProblem problem)+ (_, Left problem) ->+ Just+ ( "a configuration of the output does not parse: "+ <> parseProblem problem+ <> "\n"+ <> linesAround came problem+ )+ (Right before, Right after)+ | Just difference <- syntaxDifference (pmModule before) (pmModule after) ->+ Just ("a different program, in one configuration: " <> difference)+ | Just difference <-+ commentDifference+ (pmModule before, pmModule after)+ (comments (pmSource before))+ (comments (pmSource after)) ->+ Just ("comments, in one configuration: " <> difference)+ | otherwise -> Nothing++ parse = parseModule parser path++ parser = parserConfigFor package+ render = renderConfigFor parser path package source++-- | Why a parse failed, and where in the file, but not which file.+--+-- The example being reported already names it, and 'describeParseError'+-- opens with the path in full.+parseProblem :: ParseError -> Text+parseProblem problem = at <> peProblem problem+ where+ at = case spanOfSrcSpan (peSpan problem) of+ Nothing -> T.empty+ Just s ->+ T.pack (show (spanStartLine s))+ <> ":"+ <> T.pack (show (spanStartColumn s))+ <> ": "++-- | The lines of a configuration around the one a parse error names.+linesAround :: Text -> ParseError -> Text+linesAround text problem = case spanStartLine <$> spanOfSrcSpan (peSpan problem) of+ Nothing -> T.empty+ Just line ->+ T.unlines+ [ (if n == line then "> " else " ") <> T.pack (show n) <> " " <> l+ | (n, l) <- zip [1 :: Int ..] (T.lines text),+ abs (n - line) <= 4+ ]++-- | How many configurations one example gets compared over.+configurationsToCheck :: Integer+configurationsToCheck = 64++-- | What to print an example's configurations with.+renderConfigFor :: ParserConfig -> FilePath -> [Extension] -> Text -> RenderConfig+renderConfigFor parser path package source =+ case parseModule parser path (blankCpp source) of+ Right whole -> exampleRenderConfig package source (pmModule whole)+ Left _ -> defaultRenderConfig
+ tests/Tilia/Cpp/MacrosSpec.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE OverloadedStrings #-}++-- | What a build plan settles about a module's conditionals.+module Tilia.Cpp.MacrosSpec (spec) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Test.Hspec+import Tilia.Cpp (withoutRuledOut)+import Tilia.Cpp.Macros++-- | A plan with one dependency at 1.2.3 and a compiler at 9.10.3.+macros :: Macros+macros =+ Macros+ { macroVersions =+ Map.fromList+ [ ("MIN_VERSION_thing", [1, 2, 3]),+ ("MIN_VERSION_GLASGOW_HASKELL", [9, 10, 3, 0])+ ],+ macroNumbers =+ Map.fromList+ [ ("__GLASGOW_HASKELL__", 910),+ ("__GLASGOW_HASKELL_PATCHLEVEL1__", 3),+ ("__GLASGOW_HASKELL_PATCHLEVEL2__", 0)+ ]+ }++-- | What this guard comes to, given the plan above.+answer :: Text -> Maybe Bool+answer = answerTo macros++spec :: Spec+spec = do+ describe "a guard about a version the plan fixed" $ do+ it "is true where the plan is at least what it asks for" $+ map answer ["if MIN_VERSION_thing(1,2,3)", "if MIN_VERSION_thing(1,0,0)"]+ `shouldBe` [Just True, Just True]++ it "is false where the plan is short of it" $+ map answer ["if MIN_VERSION_thing(1,2,4)", "if MIN_VERSION_thing(2,0,0)"]+ `shouldBe` [Just False, Just False]++ it "compares the parts as numbers and not as text" $+ answer "if MIN_VERSION_thing(1,10,0)" `shouldBe` Just False++ it "pads the shorter side with zeros" $+ map answer ["if MIN_VERSION_thing(1,2)", "if MIN_VERSION_thing(1,2,3,1)"]+ `shouldBe` [Just True, Just False]++ it "says nothing about a package the plan does not name" $+ answer "if MIN_VERSION_other(1,0,0)" `shouldBe` Nothing++ describe "a guard about the compiler" $ do+ it "reads its version as the compiler spells it" $+ map answer ["if __GLASGOW_HASKELL__ >= 902", "if __GLASGOW_HASKELL__ >= 912"]+ `shouldBe` [Just True, Just False]++ it "takes the four-part macro apart the same way" $+ map+ answer+ [ "if MIN_VERSION_GLASGOW_HASKELL(9,10,1,0)",+ "if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)",+ "if MIN_VERSION_GLASGOW_HASKELL(9,12,1,0)"+ ]+ `shouldBe` [Just True, Just True, Just False]++ describe "an answer that needs more than one question settled" $ do+ it "carries a false through a conjunction whatever else is in it" $+ answer "if defined(SOMETHING) && MIN_VERSION_thing(2,0,0)"+ `shouldBe` Just False++ it "carries a true through a disjunction the same way" $+ answer "if defined(SOMETHING) || MIN_VERSION_thing(1,0,0)"+ `shouldBe` Just True++ it "gives up where what is left over decides it" $+ map+ answer+ [ "if defined(SOMETHING) && MIN_VERSION_thing(1,0,0)",+ "if defined(SOMETHING) || MIN_VERSION_thing(2,0,0)"+ ]+ `shouldBe` [Nothing, Nothing]++ it "answers a version test behind a defined of the same macro" $+ answer "if defined(MIN_VERSION_thing) && MIN_VERSION_thing(1,0,0)"+ `shouldBe` Just True++ it "negates what it knows and nothing else" $+ map answer ["if !MIN_VERSION_thing(2,0,0)", "if !defined(SOMETHING)"]+ `shouldBe` [Just True, Nothing]++ it "reads brackets" $+ answer "if (MIN_VERSION_thing(1,0,0) || defined(X)) && !MIN_VERSION_thing(9,0,0)"+ `shouldBe` Just True++ describe "a guard that is not about a version at all" $ do+ it "answers a bare number, which is how a branch is turned off" $+ map answer ["if 0", "if 1"] `shouldBe` [Just False, Just True]++ it "says nothing about a flag" $+ map answer ["ifdef FOO", "ifndef FOO", "if defined FOO"]+ `shouldBe` [Nothing, Nothing, Nothing]++ it "says a macro it has a value for is defined" $+ map answer ["ifdef MIN_VERSION_thing", "ifndef MIN_VERSION_thing"]+ `shouldBe` [Just True, Just False]++ it "says nothing about arithmetic, which it does not read" $+ answer "if __GLASGOW_HASKELL__ + 1 > 900" `shouldBe` Nothing++ it "says nothing about a guard whose keyword asks nothing" $+ map answer ["else", "endif", "define FOO 1"]+ `shouldBe` [Nothing, Nothing, Nothing]++ describe "blanking the branches a plan rules out" $ do+ it "leaves the taken branch and blanks the rest" $+ ruledOut+ [ "#if MIN_VERSION_thing(1,0,0)",+ "import New",+ "#else",+ "import Old",+ "#endif"+ ]+ `shouldBe` ["", "import New", "", "", ""]++ it "takes the #else where the condition fails" $+ ruledOut+ [ "#if MIN_VERSION_thing(2,0,0)",+ "import New",+ "#else",+ "import Old",+ "#endif"+ ]+ `shouldBe` ["", "", "", "import Old", ""]++ it "leaves nothing where the condition fails and there is no #else" $+ ruledOut+ [ "#if MIN_VERSION_thing(2,0,0)",+ "import New",+ "#endif"+ ]+ `shouldBe` ["", "", ""]++ it "takes the first branch of an #elif chain that holds" $+ ruledOut+ [ "#if MIN_VERSION_thing(2,0,0)",+ "import Newest",+ "#elif MIN_VERSION_thing(1,0,0)",+ "import New",+ "#else",+ "import Old",+ "#endif"+ ]+ `shouldBe` ["", "", "", "import New", "", "", ""]++ it "leaves a conditional it cannot answer exactly as it was" $+ ruledOut+ [ "#ifdef FOO",+ "import One",+ "#else",+ "import Two",+ "#endif"+ ]+ `shouldBe` ["#ifdef FOO", "import One", "#else", "import Two", "#endif"]++ it "leaves a chain alone from the first question it cannot answer" $+ ruledOut+ [ "#if defined(FOO)",+ "import One",+ "#elif MIN_VERSION_thing(1,0,0)",+ "import Two",+ "#endif"+ ]+ `shouldBe` ["#if defined(FOO)", "import One", "#elif MIN_VERSION_thing(1,0,0)", "import Two", "#endif"]++ it "leaves the branches before a question it cannot answer as well" $+ ruledOut+ [ "#if MIN_VERSION_thing(2,0,0)",+ "import One",+ "#elif defined(FOO)",+ "import Two",+ "#endif"+ ]+ `shouldBe` [ "#if MIN_VERSION_thing(2,0,0)",+ "import One",+ "#elif defined(FOO)",+ "import Two",+ "#endif"+ ]++ it "rules out a shim defining a macro the plan already has" $+ ruledOut+ [ "#ifndef MIN_VERSION_thing",+ "#define MIN_VERSION_thing(a,b,c) 1",+ "#endif"+ ]+ `shouldBe` ["", "", ""]++ it "reaches a conditional nested inside the branch that is taken" $+ ruledOut+ [ "#if MIN_VERSION_thing(1,0,0)",+ "#if MIN_VERSION_thing(2,0,0)",+ "import Newest",+ "#else",+ "import New",+ "#endif",+ "#endif"+ ]+ `shouldBe` ["", "", "", "", "import New", "", ""]++ it "keeps every line where it was written" $+ let source = T.unlines ["module M where", "#if MIN_VERSION_thing(2,0,0)", "x = 1", "#endif"]+ in length (T.lines (withoutRuledOut macros source))+ `shouldBe` length (T.lines source)++ it "leaves a module with no conditionals in it alone" $+ withoutRuledOut macros "module M where\n" `shouldBe` "module M where\n"++-- | The lines of a module once the plan has ruled out what it can.+ruledOut :: [Text] -> [Text]+ruledOut = T.lines . withoutRuledOut macros . T.unlines
+ tests/Tilia/Cpp/PropertiesSpec.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Properties that should hold of every module the preprocessor is+-- involved in.+module Tilia.Cpp.PropertiesSpec (spec) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Test.Hspec hiding (after, before)+import Test.Hspec.QuickCheck (modifyMaxSuccess)+import Test.QuickCheck+import Tilia.Cpp (answeredLeaves, formatWithCpp, withoutRuledOut)+import Tilia.Cpp.Macros (Macros (..))+import Tilia.Equivalence (syntaxDifference)+import Tilia.Parser (defaultParserConfig, parseModule, pmModule)+import Tilia.Render (defaultRenderConfig)++spec :: Spec+spec = modifyMaxSuccess (const 5000) $+ describe "a module the preprocessor runs over" $ do+ xit "reaches its answer in one pass" $+ property $ \m -> formatted m $ \out ->+ case format out of+ Left why -> counterexample (T.unpack ("re-formatting refused: " <> why)) False+ Right settled ->+ counterexample (T.unpack (diffed out settled)) (settled == out)++ it "comes out parseable in every configuration" $+ property $ \m -> formatted m $ \out ->+ case answeredLeaves out of+ Left _ -> property Discard+ Right configurations ->+ conjoin+ [ counterexample (T.unpack ("this configuration does not parse:\n" <> t)) (parses t)+ | (_, t) <- configurations+ ]++ it "is read as configurations it already had, once a plan rules some out" $+ property $ \m ->+ let source = sourceOf m+ in case (answeredLeaves source, answeredLeaves (withoutRuledOut macros source)) of+ (Right went, Right came) ->+ let had = Set.fromList (map snd went)+ in conjoin $+ counterexample "nothing was left to read" (not (null came))+ : [ counterexample+ (T.unpack ("not a configuration the module had:\n" <> t))+ (Set.member t had)+ | (_, t) <- came+ ]+ _ -> property Discard++ xit "is the same program in every configuration it went in as" $+ property $ \m -> formatted m $ \out ->+ case (answeredLeaves (sourceOf m), answeredLeaves out) of+ (Right went, Right came) ->+ conjoin+ [ counterexample (T.unpack (T.unlines [before, "became", after, why])) False+ | (answers, before) <- went,+ Just after <- [lookup answers came],+ Just why <- [difference before after]+ ]+ _ -> property Discard++----------------------------------------------------------------------------+-- Running the formatter++-- | A plan that settles the version the generator asks about and nothing+-- else, so that a module comes out with some of its conditionals answered+-- and some of them left open.+macros :: Macros+macros =+ Macros+ { macroVersions = Map.fromList [("MIN_VERSION_thing", [1, 2, 3])],+ macroNumbers = Map.empty+ }++format :: Text -> Either Text Text+format source = case formatWithCpp defaultParserConfig defaultRenderConfig "M.hs" source of+ Left _ -> Left "declined"+ Right out -> Right out++-- | Whatever holds of a module the formatter did not decline.+--+-- Declining is an answer the formatter is allowed to give—a @#include@ it+-- cannot expand, a module with more configurations than its budget—and says+-- nothing about the properties below, so those runs are thrown away rather+-- than counted as passes.+formatted :: (Testable p) => CppModule -> (Text -> p) -> Property+formatted m k = case format (sourceOf m) of+ Left _ -> property Discard+ Right out -> property (k out)++parses :: Text -> Bool+parses t = case parseModule defaultParserConfig "M.hs" t of+ Left _ -> False+ Right _ -> True++difference :: Text -> Text -> Maybe Text+difference before after = do+ b <- either (const Nothing) Just (parseModule defaultParserConfig "M.hs" before)+ a <- either (const Nothing) Just (parseModule defaultParserConfig "M.hs" after)+ syntaxDifference (pmModule b) (pmModule a)++diffed :: Text -> Text -> Text+diffed a b = T.unlines ["first pass:", a, "second pass:", b]++----------------------------------------------------------------------------+-- Generating a module++-- | One line, or one run of lines, of a generated module.+data Item+ = -- | A declaration, named after the number so that a counterexample can+ -- be read.+ Decl Int+ | -- | A comment written on a line of its own.+ Note Text+ | -- | An empty line, which is the point of half of these properties.+ Blank+ | -- | A directive that introduces no configuration of its own—@#define@+ -- and the rest of what "Tilia.Cpp" calls opaque.+ Opaque Text+ | -- | A conditional, and what it holds either side of the @#else@.+ Cond Text [Item] [Item]+ deriving (Eq, Show)++-- | A module that uses the preprocessor.+--+-- Conditionals wrap whole items and nothing smaller, which is what keeps+-- every configuration of the module a module: a branch that took half a+-- declaration away would leave the other half behind.+newtype CppModule = CppModule [Item]+ deriving (Eq)++-- | Shown as the source, since that is what a counterexample is read as.+instance Show CppModule where+ show m = T.unpack ("\n" <> sourceOf m)++instance Arbitrary CppModule where+ arbitrary = CppModule <$> sized (items 2)+ shrink (CppModule xs) = CppModule <$> smaller xs++-- | The items of a module, given how deep a conditional may still nest.+items :: Int -> Int -> Gen [Item]+items depth size' = do+ n <- choose (1, max 1 (min 6 size'))+ mapM (const (item depth)) [1 .. n :: Int]++item :: Int -> Gen Item+item depth =+ frequency $+ [ (4, Decl <$> choose (1, 9)),+ (3, Note <$> elements ["-- a remark", "-- | documentation", "{- a block -}", "-- * a heading"]),+ (3, pure Blank),+ (1, Opaque <$> elements ["define WIDE 1", "error \"no\"", "undef WIDE"])+ ]+ <> [(3, conditional depth) | depth > 0]++conditional :: Int -> Gen Item+conditional depth = do+ guard' <-+ elements+ [ "if FLAG",+ "ifdef OTHER",+ "if FLAG",+ "if MIN_VERSION_thing(1,0,0)",+ "if MIN_VERSION_thing(9,0,0)"+ ]+ yes <- items (depth - 1) 3+ no <- frequency [(1, pure []), (1, items (depth - 1) 2)]+ pure (Cond guard' yes no)++-- | Every way of making a module smaller: drop an item, or replace a+-- conditional by one of the branches it was holding.+smaller :: [Item] -> [[Item]]+smaller xs =+ [take i xs <> drop (i + 1) xs | i <- positions]+ <> [take i xs <> branch <> drop (i + 1) xs | (i, Cond _ a b) <- indexed, branch <- [a, b]]+ <> [take i xs <> [x'] <> drop (i + 1) xs | (i, x) <- indexed, x' <- inside x]+ where+ positions = [0 .. length xs - 1]+ indexed = zip positions xs+ inside = \case+ Cond g a b -> [Cond g a' b | a' <- smaller a] <> [Cond g a b' | b' <- smaller b]+ _ -> []++-- | The module as it is written out.+sourceOf :: CppModule -> Text+sourceOf (CppModule xs) =+ T.unlines (["{-# LANGUAGE CPP #-}", "", "module M where", ""] <> concatMap written xs)++written :: Item -> [Text]+written = \case+ Decl n -> ["f" <> tshow n <> " = " <> tshow n]+ Note t -> [t]+ Blank -> [""]+ Opaque t -> ["#" <> t]+ Cond g yes no ->+ ["#" <> g]+ <> concatMap written yes+ <> (if null no then [] else "#else" : concatMap written no)+ <> ["#endif"]++tshow :: Int -> Text+tshow = T.pack . show
+ tests/Tilia/CppSpec.hs view
@@ -0,0 +1,827 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Whether documents printed from different configurations line up.+module Tilia.CppSpec (spec) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Test.Hspec+import Tilia.Cpp+import Tilia.Doc.Internal (Doc)+import Tilia.Equivalence (syntaxDifference)+import Tilia.Parser (defaultParserConfig, parseModule, pmModule)+import Tilia.Render (defaultRenderConfig, renderModule)+import Tilia.Span (Span)++-- | Format a module which uses the C preprocessor, configured with nothing.+formatCpp :: Text -> Either Text Text+formatCpp = said . formatWithCpp defaultParserConfig defaultRenderConfig "example.hs"++spec :: Spec+spec = do+ describe "splitting a module on its conditional" $ do+ it "keeps the directive as written, keyword and all" $+ cfgGuards <$> configurations atDeclarations+ `shouldBe` Just (map Guard ["ifdef FOO"])++ it "keeps every line where it was" $+ let sameLength c = all ((== length (T.lines atDeclarations)) . length . T.lines) (cfgTexts c)+ in (sameLength <$> configurations atDeclarations) `shouldBe` Just True++ it "has one more configuration than it has directives" $+ let balanced c = length (cfgTexts c) == length (cfgGuards c) + 1+ in map (fmap balanced . configurations) [atDeclarations, withoutElse, withElif]+ `shouldBe` [Just True, Just True, Just True]++ it "finds every directive of an #elif chain, in order" $+ cfgGuards <$> configurations withElif+ `shouldBe` Just (map Guard ["if A", "elif B"])++ it "takes only the outermost conditional, leaving the nested one alone" $+ cfgGuards <$> configurations nested+ `shouldBe` Just (map Guard ["if OUTER"])++ it "takes only the first of two conditionals side by side" $+ cfgGuards <$> configurations twoConditionals+ `shouldBe` Just (map Guard ["if FIRST"])++ it "declines a module with no conditional at all" $+ configurations "module M where\nf = 1\n" `shouldBe` Nothing++ describe "the regions the conditional does not touch" $ do+ it "are most of the module, so the comparison is not vacuous" $+ overlap atDeclarations `shouldSatisfy` either (const False) (> 10)++ it "print identically in every configuration, at a declaration boundary" $+ disagreements atDeclarations `shouldBe` Right []++ it "print identically when the branches are of different lengths" $+ disagreements unevenBranches `shouldBe` Right []++ it "print identically when a comment sits next to the conditional" $+ disagreements withComments `shouldBe` Right []++ it "print identically when a comment lives inside one branch" $+ disagreements commentInsideBranch `shouldBe` Right []++ it "print identically with nothing to separate the conditional" $+ disagreements packedTogether `shouldBe` Right []++ it "print identically when the conditional has no alternative" $+ disagreements withoutElse `shouldBe` Right []++ it "print identically across all three branches of an #elif" $+ disagreements withElif `shouldBe` Right []++ describe "every configuration of the output"+ $ it "is the same program as that configuration of the input"+ $ mapM_ (`shouldBe` Right ()) (map roundTrip everyFixture)++ describe "formatting an already formatted module"+ $ it "changes nothing, for every module the prototype handles"+ $ mapM_ (`shouldBe` Right ()) (map settles everyFixture)++ describe "an #elif chain" $ do+ it "is printed back as one conditional rather than as nested ones" $+ formatCpp withElif+ `shouldBe` Right+ ( T.unlines+ [ "module M where",+ "",+ "before = 1",+ "",+ "#if A",+ "mid = 1",+ "#elif B",+ "mid = 2",+ "#else",+ "mid = 3",+ "#endif",+ "",+ "after = 4"+ ]+ )++ it "keeps its shape when the chain has no #else" $+ formatCpp elifWithoutElse+ `shouldBe` Right+ ( T.unlines+ [ "module M where",+ "",+ "#if A",+ "mid = 1",+ "#elif B",+ "mid = 2",+ "#endif",+ "",+ "after = 4"+ ]+ )++ describe "conditionals nested inside one another" $ do+ it "are printed back nested, not flattened into compound conditions" $+ formatCpp nested+ `shouldBe` Right+ ( T.unlines+ [ "module M where",+ "",+ "#if OUTER",+ "a = 1",+ "",+ "#if INNER",+ "b = 2",+ "#endif",+ "#else",+ "a = 3",+ "#endif",+ "",+ "after = 4"+ ]+ )++ it "reach three leaf configurations rather than four" $+ said (length <$> leaves nested) `shouldBe` Right 3++ describe "several conditionals side by side" $ do+ it "each end up around what they were written around" $+ formatCpp twoConditionals+ `shouldBe` Right+ ( T.unlines+ [ "module M where",+ "",+ "#if FIRST",+ "a = 1",+ "#else",+ "a = 2",+ "#endif",+ "",+ "between = 0",+ "",+ "#if SECOND",+ "b = 1",+ "#endif",+ "",+ "after = 4"+ ]+ )++ it "multiply, as configurations" $+ said (length <$> leaves twoConditionals) `shouldBe` Right 4++ it "add, as formattings: twenty of them are twenty-one, not a million" $+ formatCpp (sideBySide 20) `shouldSatisfy` isRight++ it "are refused once even the sum is more than the budget allows" $+ formatCpp (sideBySide 100) `shouldSatisfy` isLeft++ describe "counting the configurations" $ do+ it "agrees with enumerating them, where enumerating them is possible" $+ let counted m = (said (countLeaves m), said (toInteger . length <$> leaves m))+ in map+ counted+ [ atDeclarations,+ withElif,+ elifWithoutElse,+ withoutElse,+ nested,+ twoConditionals,+ sideBySide 8+ ]+ `shouldSatisfy` all (uncurry (==))++ it "does not enumerate them, where enumerating them is not" $+ said (countLeaves (sideBySide 63)) `shouldBe` Right (2 ^ (63 :: Int))++ it "counts two conditionals behind one guard as one conditional" $+ said (countLeaves (sameGuard 20)) `shouldBe` Right 2++ describe "one guard asked at two depths" $ do+ it "is one question, however deep the second asking is" $+ said (countLeaves guardAtTwoDepths) `shouldBe` Right 4++ it "counts what enumerating them produces" $+ (said (countLeaves guardAtTwoDepths), said (toInteger . length <$> leaves guardAtTwoDepths))+ `shouldSatisfy` uncurry (==)++ it "is never answered one way at the top and the other way inside" $+ said (leaves guardAtTwoDepths)+ `shouldSatisfy` either+ (const False)+ (all (\l -> not ("inner" `T.isInfixOf` l) || "outer" `T.isInfixOf` l))++ describe "covering every branch" $ do+ it "gives a module with no conditionals one configuration, its own" $+ said (length <$> branchLeaves "module M where\nx = 1\n") `shouldBe` Right 1++ it "gives one per branch of a conditional" $ do+ said (length <$> branchLeaves "module M where\n#if A\nx = 1\n#endif\n") `shouldBe` Right 2+ said (length <$> branchLeaves "module M where\n#if A\nx = 1\n#else\nx = 2\n#endif\n")+ `shouldBe` Right 2++ -- A module written on Windows ends every line with a carriage return,+ -- @#endif@ included, and one that closes no group leaves the whole+ -- module unsplittable. Every module of @crypton-pem@ is written this+ -- way, and refusing them refused everything that reads a certificate.+ it "gives one per branch when the lines end in a carriage return" $+ said (length <$> branchLeaves "module M where\r\n#if A\r\nx = 1\r\n#else\r\nx = 2\r\n#endif\r\n")+ `shouldBe` Right 2++ it "is their sum where enumerating them would be their product" $+ (said (length <$> branchLeaves (sideBySide 20)), said (countLeaves (sideBySide 20)))+ `shouldBe` (Right 21, Right (2 ^ (20 :: Int)))++ describe "varying one conditional at a time" $ do+ it "is the baseline and one configuration per further branch" $+ said (length <$> linearLeaves (sideBySide 63)) `shouldBe` Right 64++ it "agrees with enumerating them where a module has one conditional" $+ (said (linearLeaves atDeclarations), said (leaves atDeclarations))+ `shouldSatisfy` uncurry (==)++ describe "conditionals that reach into the same construct" $ do+ it "are still formatted, by varying them together" $+ roundTrip twoInOneExpression `shouldBe` Right ()++ it "come back nested, still covering all four configurations" $+ (formatCpp twoInOneExpression >>= said . leaves) `shouldSatisfy` either (const False) ((== 4) . length)++ it "still settle" $+ settles twoInOneExpression `shouldBe` Right ()++ describe "a conditional the construct around it straddles" $ do+ it "comes to rest on the context, with nothing written out twice" $+ formatCpp conditionalContext+ `shouldBe` Right+ ( T.unlines+ [ "module M where",+ "",+ "f ::",+ "#ifdef A",+ " (Ord a) =>",+ "#endif",+ " a -> [(String, Int)] -> Maybe String -> Either String Int -> IO ()",+ "f x pairs fallback outcome = print (x, pairs, fallback, outcome)"+ ]+ )++ it "gives back what was written" $+ formatCpp conditionalContext `shouldBe` Right conditionalContext++ it "settles on the first pass" $+ settles conditionalContext `shouldBe` Right ()++ it "reads back as the same program in every configuration" $+ roundTrip conditionalContext `shouldBe` Right ()++ describe "a conditional inside an expression" $ do+ it "is left exactly where it was written" $+ formatCpp splitExpression+ `shouldBe` Right "module M where\n\nf x =\n g x\n#ifdef FOO\n + 1\n#endif\n"++ it "still reads back as the same program in every configuration" $+ roundTrip splitExpression `shouldBe` Right ()++ describe "a conditional whose branches say the same thing"+ $ it "is kept, because the branches are not at the same spans"+ $ formatCpp sameEitherWay+ `shouldBe` Right "module M where\n\n#ifdef FOO\nmid = 2\n#else\nmid = 2\n#endif\n"++ describe "a directive that asks nothing" $ do+ it "comes back at the line it was written on" $+ formatCpp withDefine+ `shouldBe` Right "module M where\n\n#define N 1\nf = N\n"++ it "settles" $+ settles withDefine `shouldBe` Right ()++ it "still reads back as the same program" $+ roundTrip withDefine `shouldBe` Right ()++ it "is refused when the module is not Haskell without expanding it" $+ formatCpp macroDeclaration `shouldSatisfy` isLeft++ xit "does not run a Haddock into the comment under it" $+ roundTrip defineBetweenConditionals `shouldBe` Right ()++ describe "directives the prototype cannot read" $ do+ it "refuses a module whose conditionals do not balance" $+ formatCpp unbalanced `shouldSatisfy` isLeft++ it "refuses an #else that comes before an #elif" $+ formatCpp elseBeforeElif `shouldSatisfy` isLeft++ it "refuses a conditional no configuration can be parsed out of" $+ formatCpp unparseableAlone `shouldSatisfy` isLeft++----------------------------------------------------------------------------+-- The modules the question is asked of++-- | Everything that is meant to come out the other side, for the properties+-- that should hold of all of it.+everyFixture :: [Text]+everyFixture =+ [ atDeclarations,+ unevenBranches,+ withComments,+ commentInsideBranch,+ packedTogether,+ differingImports,+ withoutElse,+ withElif,+ elifWithoutElse,+ nested,+ twoConditionals,+ twoInOneExpression,+ splitExpression+ ]++-- | A directive that asks nothing, between two conditionals that ask the+-- same question.+--+-- The merge has no answer for this and wraps the module in a conditional+-- rather than the conditionals in the module. See the held-back example that+-- names it.+defineBetweenConditionals :: Text+defineBetweenConditionals =+ T.unlines+ [ "module M where",+ "",+ "-- | documentation",+ "#if FLAG",+ "-- a remark",+ "f9 = 9",+ "#endif",+ "#define WIDE 1",+ "#if FLAG",+ "-- a remark",+ "#endif"+ ]++-- | A conditional between two whole declarations, which is the case the+-- design is meant to handle.+atDeclarations :: Text+atDeclarations =+ T.unlines+ [ "module M where",+ "",+ "before :: Int",+ "before = 1",+ "",+ "#ifdef FOO",+ "mid :: Int",+ "mid = 2",+ "#else",+ "mid :: Int",+ "mid = 3",+ "#endif",+ "",+ "after :: Int",+ "after = 4"+ ]++-- | Branches that print to different numbers of lines, so that anything+-- downstream of them would shift if positions were being followed.+unevenBranches :: Text+unevenBranches =+ T.unlines+ [ "module M where",+ "",+ "before = 1",+ "",+ "#ifdef FOO",+ "mid = case x of",+ " A -> 1",+ " B -> 2",+ "#else",+ "mid = 3",+ "#endif",+ "",+ "after = 4"+ ]++-- | A comment inside one branch and not the other. Comment placement reads+-- every region in the document, so the declarations outside the conditional+-- are being asked about under two different comment streams.+commentInsideBranch :: Text+commentInsideBranch =+ T.unlines+ [ "module M where",+ "",+ "before = 1",+ "",+ "#ifdef FOO",+ "-- a note only this branch has",+ "mid = 2 -- and a trailing one",+ "#else",+ "mid = 3",+ "#endif",+ "",+ "after = 4"+ ]++-- | No blank lines anywhere, so that whether one is printed between+-- declarations is decided by what lies between their spans.+packedTogether :: Text+packedTogether =+ T.unlines+ [ "module M where",+ "before = 1",+ "#ifdef FOO",+ "mid = 2",+ "#else",+ "mid = 3",+ "#endif",+ "after = 4"+ ]++-- | A comment on either side of the conditional. Comment attachment reads+-- the whole document, so this is where context-sensitivity would show.+withComments :: Text+withComments =+ T.unlines+ [ "module M where",+ "",+ "-- above",+ "before = 1 -- trailing",+ "",+ "#ifdef FOO",+ "mid = 2",+ "#else",+ "mid = 3",+ "#endif",+ "",+ "-- below",+ "after = 4"+ ]++-- | Branches that import different modules, which is the commonest thing a+-- real conditional does.+differingImports :: Text+differingImports =+ T.unlines+ [ "module M where",+ "",+ "#ifdef FOO",+ "import Data.Map",+ "#else",+ "import Data.Set",+ "#endif",+ "",+ "f = 1"+ ]++-- | A conditional with no alternative, which is what most conditionals in+-- real Haskell source are: a @MIN_VERSION@ test around a definition that+-- newer or older compilers do not want.+withoutElse :: Text+withoutElse =+ T.unlines+ [ "module M where",+ "",+ "before = 1",+ "",+ "#if MIN_VERSION_base(4,19,0)",+ "mid = 2",+ "#endif",+ "",+ "after = 4"+ ]++-- | Three branches, so that the choice is genuinely n-ary and not a pair+-- with extra steps.+withElif :: Text+withElif =+ T.unlines+ [ "module M where",+ "",+ "before = 1",+ "",+ "#if A",+ "mid = 1",+ "#elif B",+ "mid = 2",+ "#else",+ "mid = 3",+ "#endif",+ "",+ "after = 4"+ ]++-- | An @#elif@ chain that stops without an @#else@, so that the last+-- configuration is the one where nothing at all is taken.+elifWithoutElse :: Text+elifWithoutElse =+ T.unlines+ [ "module M where",+ "",+ "#if A",+ "mid = 1",+ "#elif B",+ "mid = 2",+ "#endif",+ "",+ "after = 4"+ ]++-- | A conditional inside a branch of another, which the splitter must leave+-- to the recursion rather than read as a chain.+nested :: Text+nested =+ T.unlines+ [ "module M where",+ "",+ "#if OUTER",+ "a = 1",+ "#if INNER",+ "b = 2",+ "#endif",+ "#else",+ "a = 3",+ "#endif",+ "",+ "after = 4"+ ]++-- | Two conditionals with a declaration between them, neither inside the+-- other.+twoConditionals :: Text+twoConditionals =+ T.unlines+ [ "module M where",+ "",+ "#if FIRST",+ "a = 1",+ "#else",+ "a = 2",+ "#endif",+ "",+ "between = 0",+ "",+ "#if SECOND",+ "b = 1",+ "#endif",+ "",+ "after = 4"+ ]++-- | A module with @n@ conditionals in a row, for asking where the budget+-- stops.+sideBySide :: Int -> Text+sideBySide n =+ T.unlines $+ ["module M where", ""]+ <> concat+ [ [ "#if C" <> T.pack (show i),+ "x" <> T.pack (show i) <> " = 1",+ "#else",+ "x" <> T.pack (show i) <> " = 2",+ "#endif"+ ]+ | i <- [1 .. n]+ ]++-- | A module with @n@ conditionals in a row, all asking the same question.+--+-- Which makes them one question, however many times it is written down. The+-- shape a module reaches by being formatted, since aligning the alternatives+-- can leave one conditional printed as several.+sameGuard :: Int -> Text+sameGuard n =+ T.unlines $+ ["module M where", ""]+ <> concat+ [ [ "#if C",+ "x" <> T.pack (show i) <> " = 1",+ "#else",+ "x" <> T.pack (show i) <> " = 2",+ "#endif"+ ]+ | i <- [1 .. n]+ ]++-- | One guard asked twice, once at the top level and once inside another+-- conditional's branch.+--+-- Untied this has six configurations where it has four, and one of the two+-- extra ones answers @A@ both ways at once.+guardAtTwoDepths :: Text+guardAtTwoDepths =+ T.unlines+ [ "module M where",+ "",+ "#if A",+ "outer = 1",+ "#endif",+ "",+ "#ifdef B",+ "beside = 2",+ "#if A",+ "inner = 3",+ "#endif",+ "#endif"+ ]++-- | A conditional around a signature's context, which the signature straddles.+--+-- The branches are of unequal length, so the construct the conditional is+-- inside occupies different lines in the two configurations — which is the+-- one case where a span honestly differs without anything having gone wrong.+-- The type is written long enough not to fit on a line once the context is+-- there and to fit comfortably once it is not, so the two configurations also+-- disagree about how to lay the group out.+conditionalContext :: Text+conditionalContext =+ T.unlines+ [ "module M where",+ "",+ "f ::",+ "#ifdef A",+ " (Ord a) =>",+ "#endif",+ " a -> [(String, Int)] -> Maybe String -> Either String Int -> IO ()",+ "f x pairs fallback outcome = print (x, pairs, fallback, outcome)"+ ]++-- | A conditional in the middle of an expression, which every configuration+-- can be parsed out of, but which no span survives.+splitExpression :: Text+splitExpression =+ T.unlines+ [ "module M where",+ "",+ "f x =",+ " g x",+ "#ifdef FOO",+ " + 1",+ "#endif"+ ]++-- | Two conditionals reaching into one expression, so that their+-- differences land in the same place and cannot be applied side by side.+twoInOneExpression :: Text+twoInOneExpression =+ T.unlines+ [ "module M where",+ "",+ "f =",+ " a",+ "#if X",+ " + b",+ "#endif",+ "#if Y",+ " + c",+ "#endif"+ ]++-- | A conditional whose two branches say the same thing.+sameEitherWay :: Text+sameEitherWay =+ T.unlines+ [ "module M where",+ "",+ "#ifdef FOO",+ "mid = 2",+ "#else",+ "mid = 2",+ "#endif"+ ]++-- | A conditional that opens a bracket it does not close, so that dropping+-- the branch leaves something that is not a Haskell module at all.+--+-- Harder to come by than it looks. A conditional holding the only statement+-- of a @do@ block, or the only alternative of a @case@, still leaves both+-- configurations parsing, since GHC2021 has @EmptyCase@ and takes an empty+-- @do@. It is unbalanced delimiters that no blanking can rescue.+unparseableAlone :: Text+unparseableAlone =+ T.unlines+ [ "module M where",+ "",+ "#ifdef FOO",+ "f = (1",+ "#endif",+ " + 2)"+ ]++-- | An @#if@ with nothing to close it.+unbalanced :: Text+unbalanced = T.unlines ["module M where", "", "#ifdef FOO", "f = 1"]++-- | A directive that is not a conditional, and so cannot be blanked away.+withDefine :: Text+withDefine = T.unlines ["module M where", "", "#define N 1", "f = N"]++-- | A macro standing for a piece of syntax rather than for a piece of+-- program.+--+-- @CLOSE@ is a bracket, so the module is only balanced once the macro has+-- been expanded. Nothing short of expanding it makes this Haskell, no+-- configuration of it parses, and there is no document to build. The same+-- shape as a conditional that opens a bracket it does not close, and refused+-- for the same reason.+macroDeclaration :: Text+macroDeclaration =+ T.unlines+ [ "module M where",+ "",+ "#define CLOSE )",+ "f = (1 CLOSE"+ ]++-- | An @#else@ with an @#elif@ after it, which no preprocessor would accept+-- and which the splitter must not quietly reorder into something it would.+elseBeforeElif :: Text+elseBeforeElif =+ T.unlines+ [ "module M where",+ "",+ "#if A",+ "f = 1",+ "#else",+ "f = 2",+ "#elif B",+ "f = 3",+ "#endif"+ ]++----------------------------------------------------------------------------+-- Asking it++isLeft, isRight :: Either a b -> Bool+isLeft = either (const True) (const False)+isRight = either (const False) (const True)++-- | Format a module, then check that every configuration of what came out is+-- the same program as that configuration of what went in.+--+-- The variational form of the check the corpus already makes of every+-- example, with a @forall cfg@ in front of it. The conditionals come back in+-- the order they were written, so the two enumerations line up leaf for leaf+-- — and if they did not, the count would say so first.+roundTrip :: Text -> Either Text ()+roundTrip source = do+ formatted <- formatCpp source+ went <- said (leaves source)+ came <- said (leaves formatted)+ if length went == length came+ then mapM_ (uncurry sameProgram) (zip went came)+ else Left ("the number of configurations changed: " <> T.pack (show (length went, length came)))+ where+ sameProgram before' after' = do+ a <- moduleOf before'+ b <- moduleOf after'+ case syntaxDifference a b of+ Nothing -> Right ()+ Just difference -> Left ("a different program: " <> difference)+ moduleOf text = case parseModule defaultParserConfig "<cpp>" text of+ Left _ -> Left ("did not parse:\n" <> text)+ Right parsed -> Right (pmModule parsed)++-- | Whether formatting what was formatted changes anything.+--+-- The property the corpus makes of every ordinary example. It is worth+-- asking separately here because the merge is the one part of the printer+-- whose input is its own output: directives go into the text, and the second+-- pass has to split on the very ones the first pass wrote.+settles :: Text -> Either Text ()+settles source = do+ once <- formatCpp source+ twice <- formatCpp once+ if once == twice+ then Right ()+ else Left ("did not settle:\n" <> once <> "\nbecame:\n" <> twice)++-- | A refusal as words, which is the only place these tests want one.+said :: Either CppError a -> Either Text a+said = either (Left . describeCppError) Right++-- | The spans every configuration printed, but did not all print alike.+--+-- 'Left' when a configuration did not parse or the module had no+-- conditional, so that a broken fixture is not mistaken for agreement.+disagreements :: Text -> Either String [Span]+disagreements = fmap (Map.keys . Map.filter not) . agreement++-- | How many spans every configuration printed.+overlap :: Text -> Either String Int+overlap = fmap Map.size . agreement++-- | The spans every configuration of a module's first conditional printed,+-- and whether they all printed them alike.+agreement :: Text -> Either String (Map.Map Span Bool)+agreement source = do+ c <- maybe (Left "no conditional") Right (configurations source)+ docs <- traverse documentOf (cfgTexts c)+ case map regions docs of+ [] -> Left "a conditional with no branches"+ (first' : rest) -> Right (foldl' (narrow first') (True <$ first') rest)+ where+ narrow first' acc other =+ Map.intersectionWith (&&) acc (Map.intersectionWith (==) first' other)++documentOf :: Text -> Either String Doc+documentOf source = case parseModule defaultParserConfig "<cpp>" source of+ Left _ -> Left ("did not parse:\n" <> T.unpack source)+ Right parsed -> Right (renderModule defaultRenderConfig parsed)
+ tests/Tilia/Doc/BodySpec.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Placement, attachment, and the 'Body' class.+module Tilia.Doc.BodySpec (spec) where++import Data.Text (Text)+import Test.Hspec+import Tilia.Doc+import Tilia.Doc.Body+import Tilia.Doc.Combinators+import Tilia.Span++-- | A stand-in for a real body type, enough to exercise the class: one+-- construct that hangs, one that does not, and one that takes its answer+-- from another.+data Toy+ = Call Text Text+ | Block [Text]+ | Apply Toy Toy++instance Body Toy where+ printBody = \case+ Call f x -> txt f <> space <> txt x+ Block ss -> txt "do" <> indent (hardBreak <> sepBy hardBreak (map txt ss))+ Apply f x -> printBody f <> space <> printBody x++ bodyPlacement = \case+ Call _ _ -> Normal+ Block _ -> Hanging+ Apply _ x -> bodyPlacement x++spec :: Spec+spec = do+ describe "attach" $ do+ it "hands over the line when hanging" $+ out (broken (txt "=" <> attach Hanging (txt "do" <> indent (hardBreak <> txt "s"))))+ `shouldBe` "= do\n s\n"+ it "breaks and indents when normal" $+ out (broken (txt "=" <> attach Normal (txt "f" <> space <> txt "x")))+ `shouldBe` "=\n f x\n"+ it "stays on one line when flat, either way" $ do+ out (flat (txt "=" <> attach Normal (txt "x"))) `shouldBe` "= x\n"+ out (flat (txt "=" <> attach Hanging (txt "x"))) `shouldBe` "= x\n"++ describe "hangingIfSingleLine" $ do+ it "hangs for a single-line span" $+ hangingIfSingleLine (mkSpan (1, 1) (1, 9)) `shouldBe` Hanging+ it "does not hang for a multi-line span" $+ hangingIfSingleLine (mkSpan (1, 1) (2, 9)) `shouldBe` Normal++ describe "Body" $ do+ it "attaches a hanging body" $+ out (broken (txt "=" <> attachBody (Block ["a", "b"])))+ `shouldBe` "= do\n a\n b\n"+ it "attaches a normal body" $+ out (broken (txt "=" <> attachBody (Call "f" "x")))+ `shouldBe` "=\n f x\n"+ it "propagates placement through an application" $+ bodyPlacement (Apply (Call "f" "x") (Block ["a"])) `shouldBe` Hanging+ it "stops propagating at a non-hanging tail" $+ bodyPlacement (Apply (Block ["a"]) (Call "f" "x")) `shouldBe` Normal+ it "propagates through nesting" $+ bodyPlacement (Apply (Call "f" "x") (Apply (Call "g" "y") (Block ["a"])))+ `shouldBe` Hanging++out :: Doc -> Text+out = printDoc defaultRenderOptions
+ tests/Tilia/Doc/CombinatorsSpec.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}++-- | The vocabulary printing code is written in.+module Tilia.Doc.CombinatorsSpec (spec) where++import Data.Text (Text)+import Test.Hspec+import Tilia.Doc+import Tilia.Doc.Combinators+import Tilia.Span++spec :: Spec+spec = do+ describe "groups" $ do+ it "becomes a space when flat" $+ out (flat (txt "a" <> breakOrSpace <> txt "b")) `shouldBe` "a b\n"+ it "becomes a break when broken" $+ out (broken (txt "a" <> breakOrSpace <> txt "b")) `shouldBe` "a\nb\n"+ it "leaves nothing when flat" $+ out (flat (txt "a" <> breakOrNothing <> txt "b")) `shouldBe` "ab\n"+ it "becomes a break when broken, leaving nothing behind" $+ out (broken (txt "a" <> breakOrNothing <> txt "b")) `shouldBe` "a\nb\n"+ it "follows a single-line span" $+ out (group (mkSpan (1, 1) (1, 9)) (txt "a" <> breakOrSpace <> txt "b"))+ `shouldBe` "a b\n"+ it "follows a multi-line span" $+ out (group (mkSpan (1, 1) (2, 9)) (txt "a" <> breakOrSpace <> txt "b"))+ `shouldBe` "a\nb\n"+ it "lets an inner group override the enclosing layout" $+ out (flat (txt "a" <> broken (breakOrSpace <> txt "b")))+ `shouldBe` "a\nb\n"+ it "ignores a hard line's enclosing layout" $+ out (flat (txt "a" <> hardBreak <> txt "b")) `shouldBe` "a\nb\n"++ describe "variant" $ do+ it "takes the first branch when flat" $+ out (flat (variant (txt "one") (txt "many"))) `shouldBe` "one\n"+ it "takes the second branch when broken" $+ out (broken (variant (txt "one") (txt "many"))) `shouldBe` "many\n"+ it "follows the span like any other group" $ do+ let v = variant (txt "one") (txt "many")+ out (group (mkSpan (1, 1) (1, 9)) v) `shouldBe` "one\n"+ out (group (mkSpan (1, 1) (2, 9)) v) `shouldBe` "many\n"++ describe "provenance" $+ it "does not affect layout" $ do+ let d = txt "a" <> breakOrSpace <> txt "b"+ s = mkSpan (1, 1) (1, 9)+ out (flat (located s d)) `shouldBe` out (flat d)++ describe "combining" $ do+ it "separates with commaSep when flat" $+ out (flat (commaSep [txt "a", txt "b", txt "c"]))+ `shouldBe` "a, b, c\n"+ it "keeps commas on the line above when broken" $+ out (broken (commaSep [txt "a", txt "b"]))+ `shouldBe` "a,\nb\n"+ it "punctuates all but the last" $+ out (flat (hsep (punctuate comma [txt "a", txt "b", txt "c"])))+ `shouldBe` "a, b, c\n"+ it "handles an empty list" $+ out (flat (commaSep [])) `shouldBe` ""+ it "handles a single element" $+ out (broken (commaSep [txt "a"])) `shouldBe` "a\n"+ it "joins with hsep" $+ out (flat (hsep [txt "a", txt "b"])) `shouldBe` "a b\n"+ it "joins with vsep" $+ out (flat (vsep [txt "a", txt "b"])) `shouldBe` "a\nb\n"++ describe "brackets" $ do+ it "adds nothing when flat" $+ out (flat (parens (commaSep [txt "a", txt "b"])))+ `shouldBe` "(a, b)\n"+ it "keeps the opening bracket company when broken" $+ out (broken (parens (commaSep [txt "a", txt "b"])))+ `shouldBe` "( a,\n b\n)\n"+ it "lines the body up under itself" $+ out (broken (brackets (commaSep [txt "a", txt "b", txt "c"])))+ `shouldBe` "[ a,\n b,\n c\n]\n"+ it "keeps the closing bracket in when asked" $+ out (broken (parensWith Indented (commaSep [txt "a", txt "b"])))+ `shouldBe` "( a,\n b\n )\n"+ it "renders an empty bracket pair flat" $+ out (flat (brackets mempty)) `shouldBe` "[]\n"+ it "spaces the unboxed pair" $+ out (flat (unboxed (commaSep [txt "a", txt "b"])))+ `shouldBe` "(# a, b #)\n"+ it "gives a spaced pair its own lines when broken" $+ out (broken (unboxed (commaSep [txt "a", txt "b"])))+ `shouldBe` "(#\n a,\n b\n#)\n"+ it "wraps in backticks" $+ out (flat (backticks (txt "div"))) `shouldBe` "`div`\n"++ describe "conditionals" $ do+ it "includes when the condition holds" $+ out (flat (txt "a" <> includeWhen True (space <> txt "b")))+ `shouldBe` "a b\n"+ it "omits when it does not" $+ out (flat (txt "a" <> includeWhen False (space <> txt "b")))+ `shouldBe` "a\n"+ it "inverts with includeUnless" $+ out (flat (includeUnless True (txt "a"))) `shouldBe` ""++out :: Doc -> Text+out = printDoc defaultRenderOptions
+ tests/Tilia/Doc/InternalSpec.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}++-- | The span algebra and the rendering engine's primitives.+module Tilia.Doc.InternalSpec (spec) where++import Data.Text (Text)+import Test.Hspec+import Tilia.Doc+import Tilia.Doc.Combinators+import Tilia.Doc.Internal (groupLayout)+import Tilia.Span++spec :: Spec+spec = do+ describe "Span" $ do+ it "recognises a single-line span" $+ isSingleLine (mkSpan (3, 1) (3, 40)) `shouldBe` True+ it "recognises a multi-line span" $+ isSingleLine (mkSpan (3, 1) (4, 1)) `shouldBe` False+ it "unions to cover both operands" $+ mkSpan (1, 5) (1, 9) <> mkSpan (3, 2) (4, 1)+ `shouldBe` mkSpan (1, 5) (4, 1)+ it "takes the earlier start column when starts share a line" $+ mkSpan (1, 9) (1, 20) <> mkSpan (1, 3) (1, 5)+ `shouldBe` mkSpan (1, 3) (1, 20)++ describe "groupLayout" $ do+ it "goes flat with no span" $+ groupLayout Nothing `shouldBe` Flat+ it "goes flat for a single-line span" $+ groupLayout (Just (mkSpan (1, 1) (1, 9))) `shouldBe` Flat+ it "goes broken for a multi-line span" $+ groupLayout (Just (mkSpan (1, 1) (2, 9))) `shouldBe` Broken++ describe "atoms" $ do+ it "renders nothing for an empty document" $+ out mempty `shouldBe` ""+ it "terminates output with a newline" $+ out (txt "x") `shouldBe` "x\n"+ it "collapses repeated spaces" $+ out (txt "a" <> space <> space <> txt "b") `shouldBe` "a b\n"+ it "drops a space before a line break" $+ out (txt "a" <> space <> hardBreak <> txt "b") `shouldBe` "a\nb\n"+ it "drops a leading space" $+ out (space <> txt "a") `shouldBe` "a\n"+ it "ignores an empty fragment" $+ out (txt "a" <> txt "" <> txt "b") `shouldBe` "ab\n"++ describe "blank lines" $ do+ it "collapses runs" $+ out (txt "a" <> blankLine <> blankLine <> txt "b")+ `shouldBe` "a\n\nb\n"+ it "drops a leading blank line" $+ out (blankLine <> txt "a") `shouldBe` "a\n"+ it "drops a trailing blank line" $+ out (txt "a" <> blankLine) `shouldBe` "a\n"+ it "separates when there is content on both sides" $+ out (txt "a" <> blankLine <> txt "b") `shouldBe` "a\n\nb\n"+ it "caps a run of hard breaks at one blank line" $ do+ out (txt "a" <> hardBreak <> hardBreak <> txt "b")+ `shouldBe` "a\n\nb\n"+ out (txt "a" <> hardBreak <> hardBreak <> hardBreak <> txt "b")+ `shouldBe` "a\n\nb\n"+ out (txt "a" <> mconcat (replicate 8 hardBreak) <> txt "b")+ `shouldBe` "a\n\nb\n"+ it "caps a mixture of hard breaks and blank lines" $+ out (txt "a" <> hardBreak <> blankLine <> hardBreak <> blankLine <> txt "b")+ `shouldBe` "a\n\nb\n"+ it "still breaks once for a single hard break" $+ out (txt "a" <> hardBreak <> txt "b") `shouldBe` "a\nb\n"++ describe "indentation" $ do+ it "indents by one step" $+ out (broken (txt "a" <> indent (breakOrSpace <> txt "b")))+ `shouldBe` "a\n b\n"+ it "nests relative to the enclosing level" $+ out (broken (txt "a" <> indent (breakOrSpace <> txt "b" <> indent (breakOrSpace <> txt "c"))))+ `shouldBe` "a\n b\n c\n"+ it "aligns to the current column" $+ out (broken (txt "ab" <> space <> align (txt "c" <> breakOrSpace <> txt "d")))+ `shouldBe` "ab c\n d\n"+ it "leaves no trailing whitespace on an empty line" $+ out (broken (indent (txt "a" <> hardBreak <> hardBreak <> txt "b")))+ `shouldBe` " a\n\n b\n"+ it "does not indent a line with nothing on it" $+ out (broken (indent (txt "a" <> hardBreak)))+ `shouldBe` " a\n"++out :: Doc -> Text+out = printDoc defaultRenderOptions
+ tests/Tilia/Doc/PropertiesSpec.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Properties that should hold of every document the engine renders.+module Tilia.Doc.PropertiesSpec (spec) where++import Data.Char (isSpace)+import Data.Text (Text)+import Data.Text qualified as T+import Test.Hspec+import Test.QuickCheck+import Tilia.Doc+import Tilia.Doc.Combinators+import Tilia.Gen+import Tilia.Span++spec :: Spec+spec = do+ describe "output shape" $ do+ it "never leaves trailing whitespace on a line" $+ property $ \(AnyDoc d) ->+ let ls = T.lines (out d)+ in counterexample (show ls) (all (\l -> l == T.stripEnd l) ls)++ it "is empty or ends in exactly one newline" $+ property $ \(AnyDoc d) ->+ let t = out d+ in T.null t || (T.isSuffixOf "\n" t && not (T.isSuffixOf "\n\n" t))++ it "never begins with a blank line" $+ property $ \(AnyDoc d) ->+ let t = out d+ in not (T.isPrefixOf "\n" t)++ it "never carries two blank lines in a row" $+ property $ \(AnyDoc d) ->+ let ls = T.lines (out d)+ pairs = zip ls (drop 1 ls)+ in counterexample (show ls) (not (any (\(a, b) -> T.null a && T.null b) pairs))++ describe "content" $+ it "emits exactly the text it was given, and nothing else" $+ property $ \(PlainDoc d) ->+ let expected = squash (T.concat (docTexts d))+ actual = squash (out d)+ in counterexample (show (expected, actual)) (expected == actual)++ describe "layout" $ do+ it "keeps a flat document on one line" $+ property $ \(FlatSafeDoc d) ->+ let t = out (flat d)+ in counterexample (show t) (length (T.lines t) <= 1)++ it "renders a group with a single-line span as flat" $+ property $ \(FlatSafeDoc d) (SingleLineSpan s) ->+ out (group s d) === out (flat d)++ it "renders a group with a multi-line span as broken" $+ property $ \(FlatSafeDoc d) (MultiLineSpan s) ->+ out (group s d) === out (broken d)++ describe "provenance" $+ it "does not affect the output" $+ property $ \(AnyDoc d) (AnySpan s) ->+ out (located s d) === out d++ describe "monoid" $ do+ it "renders associatively" $+ property $ \(AnyDoc a) (AnyDoc b) (AnyDoc c) ->+ out (broken ((a <> b) <> c)) === out (broken (a <> (b <> c)))++ it "has mempty as a rendering identity" $+ property $ \(AnyDoc d) -> do+ out (broken (mempty <> d)) === out (broken d)+ .&&. out (broken (d <> mempty)) === out (broken d)++ describe "Span" $ do+ it "unions associatively" $+ property $ \(AnySpan a) (AnySpan b) (AnySpan c) ->+ (a <> b) <> c === a <> (b <> c)++ it "unions to something covering both operands" $+ property $ \(AnySpan a) (AnySpan b) ->+ let u = a <> b+ in counterexample (show u) (covers u a && covers u b)++ it "is idempotent under union" $+ property $+ \(AnySpan a) -> a <> a === a++-- | Everything that is not whitespace, in order.+--+-- Whitespace is exactly what the engine is entitled to add, move and+-- remove; what remains is what it must not touch.+squash :: Text -> Text+squash = T.filter (not . isSpace)++out :: Doc -> Text+out = printDoc defaultRenderOptions
+ tests/Tilia/EquivalenceSpec.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Whether formatting changed what a module says.+module Tilia.EquivalenceSpec (spec) where++import Data.Maybe (isJust)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Hs (HsModule)+import GHC.Hs.Extension (GhcPs)+import Test.Hspec+import Tilia.Comments (Comment)+import Tilia.Equivalence+import Tilia.Parser+ ( ParsedModule,+ defaultParserConfig,+ describeParseError,+ parseModule,+ pmModule,+ pmSource,+ )+import Tilia.Source (comments)++spec :: Spec+spec = do+ describe "what a formatter is allowed to do" $ do+ it "sees past layout" $+ "module M where\nf x = x\n" `saysTheSameAs` "module M where\n\nf x = x\n"++ it "sees past a line broken in a different place" $+ "module M where\nf x = x + 1\n"+ `saysTheSameAs` "module M where\nf x =\n x\n + 1\n"++ it "sees past the two spellings of a qualified import" $+ "module M where\nimport qualified Data.Map as M\n"+ `saysTheSameAs` "module M where\nimport Data.Map qualified as M\n"++ it "sees past the order the imports were written in" $+ "module M where\nimport Data.Set\nimport Data.Map\n"+ `saysTheSameAs` "module M where\nimport Data.Map\nimport Data.Set\n"++ it "sees past the brackets around a deriving clause" $+ "module M where\ndata T = T deriving Eq\n"+ `saysTheSameAs` "module M where\ndata T = T deriving (Eq)\n"++ it "sees past an empty context" $+ "module M where\nclass () => C a where\n m :: a\n"+ `saysTheSameAs` "module M where\nclass C a where\n m :: a\n"++ it "sees past the brackets around one constraint" $+ "module M where\nf :: (Show a) => a -> a\nf x = x\n"+ `saysTheSameAs` "module M where\nf :: Show a => a -> a\nf x = x\n"++ it "sees past a documentation comment set differently" $+ "module M where\n\n-- | Says something.\nf :: Int\nf = 1\n"+ `saysTheSameAs` "module M where\n\n-- | Says something.\nf :: Int\nf = 1\n"++ it "sees past a documentation comment that says nothing at all" $+ "module M where\n\n-- |\nf :: Int\nf = 1\n"+ `saysTheSameAs` "module M where\n\nf :: Int\nf = 1\n"++ it "sees past comments, which are not the tree's business" $+ "module M where\n\n-- a remark\nf :: Int\nf = 1\n"+ `saysTheSameAs` "module M where\n\nf :: Int\nf = 1\n"++ describe "what it must not let through" $ do+ it "catches a changed literal" $+ "module M where\nf = 1\n" `saysSomethingElseThan` "module M where\nf = 2\n"++ it "catches a changed name" $+ "module M where\nf x = x\n" `saysSomethingElseThan` "module M where\nf x = y\n"++ it "catches an operator regrouped" $+ "module M where\nf = a + b * c\n"+ `saysSomethingElseThan` "module M where\nf = (a + b) * c\n"++ it "catches a declaration dropped" $+ "module M where\nf = 1\ng = 2\n" `saysSomethingElseThan` "module M where\nf = 1\n"++ it "catches an import dropped" $+ "module M where\nimport Data.Map\nimport Data.Set\n"+ `saysSomethingElseThan` "module M where\nimport Data.Map\n"++ it "catches an import list losing an entry" $+ "module M where\nimport Data.List (sort, nub)\n"+ `saysSomethingElseThan` "module M where\nimport Data.List (sort)\n"++ it "catches an import that stopped being qualified" $+ "module M where\nimport qualified Data.Map as M\n"+ `saysSomethingElseThan` "module M where\nimport Data.Map as M\n"++ it "catches an export list losing an entry" $+ "module M (f, g) where\nf = 1\ng = 2\n"+ `saysSomethingElseThan` "module M (f) where\nf = 1\ng = 2\n"++ it "catches a documentation comment losing a word" $+ "module M where\n\n-- | Says something.\nf :: Int\nf = 1\n"+ `saysSomethingElseThan` "module M where\n\n-- | Says.\nf :: Int\nf = 1\n"++ it "says where the difference is, not merely that there is one" $+ case syntaxDifference (treeOf "module M where\nf = 1\n") (treeOf "module M where\nf = 2\n") of+ Nothing -> expectationFailure "found no difference"+ Just why -> do+ why `shouldSatisfy` T.isInfixOf "HsOverLit"+ why `shouldSatisfy` T.isInfixOf "1 became 2"++ describe "the comments a formatter must carry over" $ do+ it "is content when they all came through" $+ "module M where\n\n-- a remark\nf = 1\n"+ `keepsTheCommentsOf` "module M where\n\n-- a remark\nf = 1\n"++ it "notices one that went missing" $+ "module M where\n\n-- a remark\nf = 1\n"+ `losesTheCommentsOf` "module M where\n\nf = 1\n"++ it "notices one that was invented" $+ "module M where\n\nf = 1\n"+ `losesTheCommentsOf` "module M where\n\n-- a remark\nf = 1\n"++ it "notices a pragma that went missing, and names it" $+ case difference "{-# LANGUAGE LambdaCase #-}\nmodule M where\nf = 1\n" "module M where\nf = 1\n" of+ Nothing -> expectationFailure "let the pragma go"+ Just why -> do+ why `shouldSatisfy` T.isInfixOf "lost the pragma"+ why `shouldSatisfy` T.isInfixOf "LambdaCase"++ it "notices a pragma that was invented" $+ case difference "module M where\nf = 1\n" "{-# LANGUAGE LambdaCase #-}\nmodule M where\nf = 1\n" of+ Nothing -> expectationFailure "let the pragma through"+ Just why -> why `shouldSatisfy` T.isInfixOf "invented the pragma"++ it "does not mind the order of what stands above the module header" $+ "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TupleSections #-}\nmodule M where\nf = 1\n"+ `keepsTheCommentsOf` "{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE LambdaCase #-}\nmodule M where\nf = 1\n"++ it "does not mind a comment that moved with the import it belongs to" $+ "module M where\n\n-- about Set\nimport Data.Set\n\n-- about Map\nimport Data.Map\n"+ `keepsTheCommentsOf` "module M where\n\n-- about Map\nimport Data.Map\n\n-- about Set\nimport Data.Set\n"++----------------------------------------------------------------------------+-- Helpers++-- | Two modules that a formatter could turn one into the other.+saysTheSameAs :: Text -> Text -> Expectation+saysTheSameAs went came =+ syntaxDifference (treeOf went) (treeOf came) `shouldBe` Nothing++-- | Two modules that no formatter may turn one into the other.+saysSomethingElseThan :: Text -> Text -> Expectation+saysSomethingElseThan went came =+ syntaxDifference (treeOf went) (treeOf came) `shouldSatisfy` isJust++keepsTheCommentsOf :: Text -> Text -> Expectation+keepsTheCommentsOf went came = difference went came `shouldBe` Nothing++losesTheCommentsOf :: Text -> Text -> Expectation+losesTheCommentsOf went came =+ difference went came `shouldSatisfy` isJust++-- | What 'commentDifference' makes of two spellings of a module.+difference :: Text -> Text -> Maybe Text+difference went came =+ commentDifference+ (treeOf went, treeOf came)+ (commentsOf went)+ (commentsOf came)++treeOf :: Text -> HsModule GhcPs+treeOf = pmModule . parsed++commentsOf :: Text -> [Comment]+commentsOf = comments . pmSource . parsed++parsed :: Text -> ParsedModule+parsed source = case parseModule defaultParserConfig "Test.hs" source of+ Left problem -> error (T.unpack (describeParseError problem))+ Right m -> m
+ tests/Tilia/Fixity/CabalSpec.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Reading a @.cabal@ file's fields without a cabal parser.+module Tilia.Fixity.CabalSpec (spec) where++import Codec.Archive.Tar qualified as Tar+import Codec.Archive.Tar.Entry qualified as Tar+import Data.ByteString.Lazy qualified as BL+import Data.Text (Text)+import Data.Text.Encoding qualified as T+import GHC.LanguageExtensions.Type (Extension (..))+import Test.Hspec+import Tilia.Fixity.Cabal++spec :: Spec+spec = do+ describe "finding the cabal file in an archive" $ do+ it "spells an entry's path the way the archive holds it" $+ entryPosixPath (entryFor "hspec-2.11.17/hspec.cabal" "")+ `shouldBe` "hspec-2.11.17/hspec.cabal"++ it "is the same spelling on every machine" $+ entryPosixPath (entryFor "hspec-2.11.17/hspec.cabal" "")+ `shouldBe` Tar.fromTarPathToPosixPath+ (Tar.entryTarPath (entryFor "hspec-2.11.17/hspec.cabal" ""))++ it "knows a package's own cabal file from one further down" $+ map+ cabalFileAtTop+ [ "hspec-2.11.17/hspec.cabal",+ "hspec-2.11.17/vendor/other.cabal",+ "hspec.cabal"+ ]+ `shouldBe` [True, False, False]++ it "reads only a path written with the separator a tar file uses" $+ cabalFileAtTop "hspec-2.11.17\\hspec.cabal" `shouldBe` False++ it "takes the modules out of an archive's cabal file" $+ cabalFileInArchive+ ( archiveOf+ [ ("hspec-2.11.17/Setup.lhs", "main = undefined\n"),+ ("hspec-2.11.17/hspec.cabal", "library\n exposed-modules: Test.Hspec, Test.Hspec.Runner\n")+ ]+ )+ `shouldSatisfy` maybe False (elem "Test.Hspec.Runner" . containedModules)++ describe "plain fields" $ do+ it "reads a one-line field" $+ exposed "library\n exposed-modules: A.B, C.D\n"+ `shouldMatchList` ["A.B", "C.D"]++ it "reads a field spread over indented lines" $+ exposed "library\n exposed-modules:\n A.B\n C.D\n E\n"+ `shouldMatchList` ["A.B", "C.D", "E"]++ it "reads a mixture of commas and lines" $+ exposed "library\n exposed-modules: A.B,\n C.D\n"+ `shouldMatchList` ["A.B", "C.D"]++ it "is not confused by the field name's case" $+ exposed "library\n Exposed-Modules: A.B\n" `shouldMatchList` ["A.B"]++ it "finds nothing when there is no such field" $+ exposed "library\n build-depends: base\n" `shouldBe` []++ describe "what must not be picked up" $ do+ it "takes other-modules too, which a re-export may lead into" $+ exposed "library\n exposed-modules: A\n other-modules: B\n"+ `shouldMatchList` ["A", "B"]++ it "ignores reexported-modules" $+ exposed "library\n exposed-modules: A\n reexported-modules: B\n"+ `shouldMatchList` ["A"]++ it "stops at the next field" $+ exposed "library\n exposed-modules:\n A\n build-depends: base\n"+ `shouldMatchList` ["A"]++ it "ignores anything that is not a module name" $+ exposed "library\n exposed-modules: A, base >=4, -Wall\n"+ `shouldMatchList` ["A"]++ describe "conditionals" $ do+ it "takes a branch nested inside an if" $+ exposed+ "library\n\+ \ exposed-modules: A\n\+ \ if flag(fancy)\n\+ \ exposed-modules: B\n"+ `shouldMatchList` ["A", "B"]++ it "takes both branches of an if/else" $+ exposed+ "library\n\+ \ if os(windows)\n\+ \ exposed-modules: W\n\+ \ else\n\+ \ exposed-modules: U\n"+ `shouldMatchList` ["W", "U"]++ it "takes a branch nested two deep" $+ exposed+ "library\n\+ \ if flag(a)\n\+ \ if flag(b)\n\+ \ exposed-modules: Deep\n"+ `shouldMatchList` ["Deep"]++ it "takes every library stanza, including named ones" $+ exposed+ "library\n\+ \ exposed-modules: Main.Lib\n\+ \\n\+ \library internal\n\+ \ exposed-modules: Internal.Lib\n"+ `shouldMatchList` ["Main.Lib", "Internal.Lib"]++ describe "comments" $ do+ it "does not let one at the margin cut a module list short" $+ exposed "library\n exposed-modules:\n A\n-- B\n C\n"+ `shouldMatchList` ["A", "C"]++ it "does not count a module somebody commented out" $+ exposed "library\n exposed-modules:\n A\n -- B\n C\n"+ `shouldMatchList` ["A", "C"]++ it "keeps reading source directories past one" $+ sourceDirs "library\n hs-source-dirs: src\n-- a comment\ntest-suite t\n hs-source-dirs: tests\n"+ `shouldBe` ["src", "tests", "."]++ describe "where a component with no hs-source-dirs lives" $ do+ it "offers the package directory even when other components name one" $+ sourceDirs "library\n build-depends: base\ntest-suite t\n hs-source-dirs: tests\n"+ `shouldBe` ["tests", "."]++ it "offers it last, so a named directory is tried first" $+ last (sourceDirs "library\n hs-source-dirs: src\n") `shouldBe` "."++ it "offers it once when it is named as well" $+ sourceDirs "library\n hs-source-dirs: .\n" `shouldBe` ["."]++ it "offers it when nothing names anything" $+ sourceDirs "library\n build-depends: base\n" `shouldBe` ["."]++ describe "what the package puts in force" $ do+ it "reads an extension the .cabal turns on" $+ extensions "library\n default-extensions: LambdaCase\n"+ `shouldSatisfy` elem LambdaCase++ it "reads several, however they are written" $ do+ let found = extensions "library\n default-extensions:\n LambdaCase\n MultiWayIf, BlockArguments\n"+ found `shouldSatisfy` elem LambdaCase+ found `shouldSatisfy` elem MultiWayIf+ found `shouldSatisfy` elem BlockArguments++ it "takes one back that the .cabal turns off" $+ extensions "library\n default-extensions: ImplicitPrelude, NoImplicitPrelude\n"+ `shouldSatisfy` notElem ImplicitPrelude++ it "starts from what the language edition puts in force" $ do+ extensions "library\n default-language: GHC2021\n"+ `shouldSatisfy` elem TypeOperators+ extensions "library\n default-language: Haskell2010\n"+ `shouldSatisfy` notElem TypeOperators++ it "takes what every edition in the file puts in force" $+ extensions+ "library\n\+ \ default-language: Haskell2010\n\+ \test-suite spec\n\+ \ default-language: GHC2021\n"+ `shouldSatisfy` elem TypeOperators++ it "still has the earlier edition's own extensions" $+ extensions+ "library\n\+ \ default-language: Haskell2010\n\+ \test-suite spec\n\+ \ default-language: GHC2021\n"+ `shouldSatisfy` elem ImplicitPrelude++ it "passes over a name no compiler knows" $+ extensions "library\n default-extensions: LambdaCase, NotAnExtension\n"+ `shouldSatisfy` elem LambdaCase++ it "takes every component's, since it does not know which one asks" $ do+ let found =+ extensions+ "library\n default-extensions: LambdaCase\ntest-suite t\n default-extensions: MultiWayIf\n"+ found `shouldSatisfy` elem LambdaCase+ found `shouldSatisfy` elem MultiWayIf++ describe "the union is deliberate" $+ it "does not need to know which branch a build would take" $ do+ let both =+ exposed+ "library\n\+ \ if impl(ghc >= 9.6)\n\+ \ exposed-modules: New\n\+ \ else\n\+ \ exposed-modules: Old\n"+ both `shouldMatchList` ["New", "Old"]++-- | The modules a @.cabal@ of this shape holds.+exposed :: Text -> [Text]+exposed = containedModules++-- | What a @.cabal@ of this shape puts in force.+extensions :: Text -> [Extension]+extensions = declaredExtensions++-- | A tar entry at the given path, holding the given text.+entryFor :: FilePath -> Text -> Tar.Entry+entryFor path contents = case Tar.toTarPath False path of+ Left why -> error why+ Right tarPath -> Tar.fileEntry tarPath (BL.fromStrict (T.encodeUtf8 contents))++-- | An archive of those entries, in order.+archiveOf :: [(FilePath, Text)] -> Tar.Entries e+archiveOf = foldr (Tar.Next . uncurry entryFor) Tar.Done
+ tests/Tilia/Fixity/CacheSpec.hs view
@@ -0,0 +1,321 @@+{-# LANGUAGE OverloadedStrings #-}++-- | The on-disk cache of what was read out of a package.+module Tilia.Fixity.CacheSpec (spec) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import System.Directory (getModificationTime, setModificationTime)+import System.Environment (setEnv, unsetEnv)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Tilia.Fixity+import Tilia.Fixity.Cache+import Tilia.Fixity.PackageDb (Installed (..), InstalledPackage (..))++spec :: Spec+spec = do+ tokens+ database+ around withIsolatedCache $ do+ describe "modules" $ do+ it "remembers a package's module list" $ \cache -> do+ storeModules cache "thing-1.0-abc" ["A.B", "C"]+ cachedModules cache "thing-1.0-abc" `shouldReturn` Just ["A.B", "C"]++ it "knows nothing about a package it was never told about" $ \cache ->+ cachedModules cache "absent-1.0" `shouldReturn` Nothing++ it "remembers an empty list as a fact, not as absence" $ \cache -> do+ storeModules cache "empty-1.0" []+ cachedModules cache "empty-1.0" `shouldReturn` Just []++ describe "fixities" $ do+ it "round-trips every direction" $ \cache -> do+ let fixities =+ Map.fromList+ [ ((InTerms, OpName "<+>"), Fixity LeftAssoc 6),+ ((InTerms, OpName ">>="), Fixity RightAssoc 1),+ ((InTerms, OpName "==="), Fixity NoAssoc 4)+ ]+ storeFixities cache "thing-1.0" "A.B" (Declares fixities)+ cachedFixities cache "thing-1.0" "A.B" `shouldReturn` Just (Declares fixities)++ it "round-trips the extremes of precedence" $ \cache -> do+ let fixities =+ Map.fromList+ [ ((InTerms, OpName "!"), Fixity LeftAssoc 0),+ ((InTerms, OpName "?"), Fixity LeftAssoc 9),+ ((InTerms, OpName "->"), Fixity RightAssoc (-1))+ ]+ storeFixities cache "thing-1.0" "Edges" (Declares fixities)+ cachedFixities cache "thing-1.0" "Edges" `shouldReturn` Just (Declares fixities)++ it "remembers that a module declares nothing" $ \cache -> do+ storeFixities cache "thing-1.0" "Quiet" (Declares Map.empty)+ cachedFixities cache "thing-1.0" "Quiet" `shouldReturn` Just (Declares Map.empty)++ it "remembers that a module could not be read" $ \cache -> do+ storeFixities cache "thing-1.0" "Opaque" (Unreadable Nothing)+ cachedFixities cache "thing-1.0" "Opaque" `shouldReturn` Just (Unreadable Nothing)++ it "remembers which module below it stopped the reading" $ \cache -> do+ storeFixities cache "thing-1.0" "Opaque" (Unreadable (Just "Deep.Down"))+ cachedFixities cache "thing-1.0" "Opaque"+ `shouldReturn` Just (Unreadable (Just "Deep.Down"))++ it "tells one stopped below it from one stopped on its own account" $ \cache -> do+ storeFixities cache "thing-1.0" "Blamed" (Unreadable (Just "Deep.Down"))+ storeFixities cache "thing-1.0" "Itself" (Unreadable Nothing)+ blamed <- cachedFixities cache "thing-1.0" "Blamed"+ itself <- cachedFixities cache "thing-1.0" "Itself"+ (blamed, itself)+ `shouldBe` (Just (Unreadable (Just "Deep.Down")), Just (Unreadable Nothing))++ it "tells an unread module from one it was never told about" $ \cache -> do+ storeFixities cache "thing-1.0" "Opaque" (Unreadable Nothing)+ unread <- cachedFixities cache "thing-1.0" "Opaque"+ never <- cachedFixities cache "thing-1.0" "Absent"+ (unread, never) `shouldBe` (Just (Unreadable Nothing), Nothing)++ it "tells an unread module from one that declares nothing" $ \cache -> do+ storeFixities cache "thing-1.0" "Opaque" (Unreadable Nothing)+ storeFixities cache "thing-1.0" "Quiet" (Declares Map.empty)+ opaque <- cachedFixities cache "thing-1.0" "Opaque"+ quiet <- cachedFixities cache "thing-1.0" "Quiet"+ (opaque, quiet) `shouldBe` (Just (Unreadable Nothing), Just (Declares Map.empty))++ it "replaces an unread answer once the module can be read" $ \cache -> do+ storeFixities cache "thing-1.0" "M" (Unreadable Nothing)+ storeFixities cache "thing-1.0" "M" (Declares (Map.fromList [((InTerms, OpName "!"), Fixity LeftAssoc 9)]))+ cachedFixities cache "thing-1.0" "M"+ `shouldReturn` Just (Declares (Map.fromList [((InTerms, OpName "!"), Fixity LeftAssoc 9)]))++ it "knows nothing about a module it was never told about" $ \cache ->+ cachedFixities cache "thing-1.0" "Absent" `shouldReturn` Nothing++ it "keeps packages apart" $ \cache -> do+ let ops = Map.fromList [((InTerms, OpName "<>"), Fixity RightAssoc 6)]+ storeFixities cache "a-1.0" "M" (Declares ops)+ storeFixities cache "b-1.0" "M" (Declares Map.empty)+ a <- cachedFixities cache "a-1.0" "M"+ b <- cachedFixities cache "b-1.0" "M"+ (a, b) `shouldBe` (Just (Declares ops), Just (Declares Map.empty))++ it "treats a different hash in the key as a different package" $ \cache -> do+ storeFixities cache "thing-1.0-aaaa" "M" (Declares (Map.fromList [((InTerms, OpName "!"), Fixity LeftAssoc 9)]))+ cachedFixities cache "thing-1.0-bbbb" "M" `shouldReturn` Nothing++ it "overwrites a previous answer for the same key" $ \cache -> do+ storeFixities cache "thing-1.0" "M" (Declares (Map.fromList [((InTerms, OpName "!"), Fixity LeftAssoc 9)]))+ storeFixities cache "thing-1.0" "M" (Declares (Map.fromList [((InTerms, OpName "!"), Fixity RightAssoc 3)]))+ cachedFixities cache "thing-1.0" "M"+ `shouldReturn` Just (Declares (Map.fromList [((InTerms, OpName "!"), Fixity RightAssoc 3)]))++ describe "export names" $ do+ it "round-trips the names an export list gave" $ \cache -> do+ let names = Exports (Set.fromList [OpName "<+>", OpName ":|", OpName "f"])+ storeExportNames cache "thing-1.0" "M" names+ cachedExportNames cache "thing-1.0" "M" `shouldReturn` Just names++ it "remembers a module that keeps its own counsel" $ \cache -> do+ storeExportNames cache "thing-1.0" "M" Untellable+ cachedExportNames cache "thing-1.0" "M" `shouldReturn` Just Untellable++ it "tells one that keeps its own counsel from one never asked about" $ \cache -> do+ storeExportNames cache "thing-1.0" "Quiet" Untellable+ cachedExportNames cache "thing-1.0" "Quiet" `shouldReturn` Just Untellable+ cachedExportNames cache "thing-1.0" "Unasked" `shouldReturn` Nothing++ it "tells one that exports nothing from one that will not say" $ \cache -> do+ storeExportNames cache "thing-1.0" "Bare" (Exports Set.empty)+ storeExportNames cache "thing-1.0" "Quiet" Untellable+ cachedExportNames cache "thing-1.0" "Bare"+ `shouldReturn` Just (Exports Set.empty)+ cachedExportNames cache "thing-1.0" "Quiet" `shouldReturn` Just Untellable++ it "keeps packages apart" $ \cache -> do+ storeExportNames cache "one-1.0" "M" (Exports (Set.singleton (OpName "<+>")))+ storeExportNames cache "two-1.0" "M" (Exports (Set.singleton (OpName "<?>")))+ cachedExportNames cache "one-1.0" "M"+ `shouldReturn` Just (Exports (Set.singleton (OpName "<+>")))++ it "keeps them apart from the fixities of the same module" $ \cache -> do+ storeFixities cache "thing-1.0" "M" (Unreadable Nothing)+ storeExportNames cache "thing-1.0" "M" (Exports (Set.singleton (OpName "<+>")))+ cachedFixities cache "thing-1.0" "M" `shouldReturn` Just (Unreadable Nothing)+ cachedExportNames cache "thing-1.0" "M"+ `shouldReturn` Just (Exports (Set.singleton (OpName "<+>")))++ it "overwrites a previous answer for the same key" $ \cache -> do+ storeExportNames cache "thing-1.0" "M" Untellable+ storeExportNames cache "thing-1.0" "M" (Exports (Set.singleton (OpName "<+>")))+ cachedExportNames cache "thing-1.0" "M"+ `shouldReturn` Just (Exports (Set.singleton (OpName "<+>")))++ describe "what a name carries with it" $ do+ it "round-trips what each name carries" $ \cache -> do+ let kept =+ Map.fromList+ [ (OpName "NonEmpty", Set.fromList [OpName ":|"]),+ (OpName "Seq", Set.fromList [OpName ":<|", OpName ":|>"])+ ]+ storeChildren cache "thing-1.0" "M" kept+ cachedChildren cache "thing-1.0" "M" `shouldReturn` Just kept++ it "remembers a module that carries nothing anywhere" $ \cache -> do+ storeChildren cache "thing-1.0" "Bare" Map.empty+ cachedChildren cache "thing-1.0" "Bare" `shouldReturn` Just Map.empty++ it "tells that from a module it was never told about" $ \cache -> do+ storeChildren cache "thing-1.0" "Bare" Map.empty+ cachedChildren cache "thing-1.0" "Unasked" `shouldReturn` Nothing++ it "remembers a name that carries nothing among ones that do" $ \cache -> do+ let kept =+ Map.fromList+ [ (OpName "Empty", Set.empty),+ (OpName "NonEmpty", Set.singleton (OpName ":|"))+ ]+ storeChildren cache "thing-1.0" "M" kept+ cachedChildren cache "thing-1.0" "M" `shouldReturn` Just kept++ it "keeps packages apart" $ \cache -> do+ storeChildren cache "one-1.0" "M" (Map.singleton (OpName "T") (Set.singleton (OpName ":|")))+ cachedChildren cache "two-1.0" "M" `shouldReturn` Nothing++ describe "module names with dots" $+ it "files a deeply qualified module without confusion" $ \cache -> do+ storeFixities cache "thing-1.0" "A.B.C.D" (Declares (Map.fromList [((InTerms, OpName "%"), Fixity NoAssoc 5)]))+ cachedFixities cache "thing-1.0" "A.B.C.D"+ `shouldReturn` Just (Declares (Map.fromList [((InTerms, OpName "%"), Fixity NoAssoc 5)]))++-- | What the compiler can see, and what it takes to stop believing it.+--+-- The database stands in for @ghc-pkg@ here: what is under test is that a+-- change to it is noticed, not what @ghc-pkg@ would have said about it.+database :: Spec+database = around withIsolatedCache $ do+ it "gives back what it was told, while the database sits still" $ \cache ->+ withDatabase $ \db -> do+ storeInstalled cache (Installed [containers] [db])+ cachedInstalled cache `shouldReturn` Just [containers]++ it "gives back nothing once a package has been registered" $ \cache ->+ withDatabase $ \db -> do+ storeInstalled cache (Installed [containers] [db])+ writeFile (db </> "new-1.0.conf") ""+ cachedInstalled cache `shouldReturn` Nothing++ it "gives back nothing once the database is gone" $ \cache -> do+ db <- withDatabase pure+ storeInstalled cache (Installed [containers] [db])+ cachedInstalled cache `shouldReturn` Nothing++ it "remembers nothing it has no way to stop believing" $ \cache -> do+ storeInstalled cache (Installed [containers] [])+ cachedInstalled cache `shouldReturn` Nothing++ it "gives back nothing to a token it was not written under" $ \_ ->+ withIsolatedDirectory $ \dir ->+ withDatabase $ \db -> do+ before' <- open dir (PlanToken "one")+ storeInstalled before' (Installed [containers] [db])+ after' <- open dir (PlanToken "two")+ cachedInstalled after' `shouldReturn` Nothing++ it "gives it back under the token it was written under" $ \_ ->+ withIsolatedDirectory $ \dir ->+ withDatabase $ \db -> do+ before' <- open dir (PlanToken "one")+ storeInstalled before' (Installed [containers] [db])+ again <- open dir (PlanToken "one")+ cachedInstalled again `shouldReturn` Just [containers]++ it "keeps one token's answer when another writes its own" $ \_ ->+ withIsolatedDirectory $ \dir ->+ withDatabase $ \db -> do+ one <- open dir (PlanToken "one")+ storeInstalled one (Installed [containers] [db])+ two <- open dir (PlanToken "two")+ storeInstalled two (Installed [quiet] [db])+ cachedInstalled one `shouldReturn` Just [containers]+ cachedInstalled two `shouldReturn` Just [quiet]++ it "carries a package that exposes nothing" $ \cache ->+ withDatabase $ \db -> do+ storeInstalled cache (Installed [containers, quiet] [db])+ cachedInstalled cache `shouldReturn` Just [containers, quiet]+ where+ containers =+ InstalledPackage+ { ipName = "containers",+ ipVersion = "0.7",+ ipModules = ["Data.Map", "Data.Map.Strict", "Data.Set"],+ ipImportDirs = ["/nowhere/containers-0.7"]+ }+ quiet =+ InstalledPackage+ { ipName = "rts",+ ipVersion = "1.0",+ ipModules = [],+ ipImportDirs = []+ }++-- | A directory standing in for a package database, with a timestamp that+-- can be set rather than waited for.+withDatabase :: (FilePath -> IO a) -> IO a+withDatabase action =+ withSystemTempDirectory "tilia-db" $ \db -> do+ -- Something long ago, so that anything happening to the directory+ -- afterwards is a change whatever the clock's resolution.+ setModificationTime db =<< getModificationTime "/"+ action db++-- | What an answer of \"could not be read\" is tied to, and what it is not.+tokens :: Spec+tokens = around withIsolatedDirectory $ do+ it "does not offer an unread answer written under another token" $ \dir -> do+ before' <- open dir (PlanToken "one")+ storeFixities before' "thing-1.0" "M" (Unreadable Nothing)+ after' <- open dir (PlanToken "two")+ cachedFixities after' "thing-1.0" "M" `shouldReturn` Nothing++ it "still offers one written under the same token" $ \dir -> do+ before' <- open dir (PlanToken "one")+ storeFixities before' "thing-1.0" "M" (Unreadable Nothing)+ again <- open dir (PlanToken "one")+ cachedFixities again "thing-1.0" "M" `shouldReturn` Just (Unreadable Nothing)++ it "keeps an answer that was read, whatever the token" $ \dir -> do+ let fixities = Map.fromList [((InTerms, OpName "<+>"), Fixity RightAssoc 6)]+ before' <- open dir (PlanToken "one")+ storeFixities before' "thing-1.0" "M" (Declares fixities)+ after' <- open dir (PlanToken "two")+ cachedFixities after' "thing-1.0" "M" `shouldReturn` Just (Declares fixities)++ it "keeps what an export list said, whatever the token" $ \dir -> do+ before' <- open dir (PlanToken "one")+ storeExportNames before' "thing-1.0" "M" Untellable+ after' <- open dir (PlanToken "two")+ cachedExportNames after' "thing-1.0" "M" `shouldReturn` Just Untellable++-- | Give each test its own cache directory, so nothing leaks between them+-- or into the developer's real cache.+withIsolatedCache :: (Cache -> IO ()) -> IO ()+withIsolatedCache action =+ withIsolatedDirectory (\dir -> open dir (PlanToken "plan") >>= action)++withIsolatedDirectory :: (FilePath -> IO ()) -> IO ()+withIsolatedDirectory = withSystemTempDirectory "tilia-cache"++-- | Open a cache in a given directory, under a given token.+open :: FilePath -> PlanToken -> IO Cache+open dir token = do+ setEnv "XDG_CACHE_HOME" dir+ opened <- openCache token+ unsetEnv "XDG_CACHE_HOME"+ case opened of+ Nothing -> fail "could not open a cache in a temporary directory"+ Just cache -> pure cache
+ tests/Tilia/Fixity/DebugSpec.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}++-- | The account a run gives of how it settled a module's operators.+module Tilia.Fixity.DebugSpec (spec) where++import Data.Choice (pattern Is)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Test.Hspec+import Tilia.Fixity+ ( Direction (..),+ Fixity (..),+ Known (..),+ OpName (..),+ inBothNamespaces,+ nothingKnown,+ resolveScope,+ )+import Tilia.Fixity.Debug (fixityNotes, renderFixityNotes)+import Tilia.Palette (Palette (Plain))+import Tilia.Parser (defaultParserConfig, describeParseError, parseModule, pmModule)+import Tilia.Utils (lineWidth, visibleLength)++spec :: Spec+spec = do+ describe "what each import brought" $ do+ it "counts the operators a module was read for" $+ notesFor [("Prelude", Just []), ("Data.Map", Just [("!", infixl' 9)])] "import Data.Map\n"+ >>= (`shouldContain'` "· Data.Map: 1 operator")++ it "says so when a module could not be read" $+ notesFor [("Prelude", Just [])] "import Criterion.Main\n"+ >>= (`shouldContain'` "· Criterion.Main: could not be read")++ it "keeps the alias a qualified import goes under" $+ notesFor [("Prelude", Just []), ("Data.Map", Just [])] "import qualified Data.Map as M\n"+ >>= (`shouldContain'` "· Data.Map qualified as M: 0 operators")++ it "names the Prelude, which nobody wrote but everybody imports" $+ notesFor [("Prelude", Just [("+", infixl' 6)])] "f = 1\n"+ >>= (`shouldContain'` "· Prelude: 1 operator")++ describe "what became of each operator" $ do+ it "names the import that carried the fixity" $+ notesFor+ [("Prelude", Just []), ("Data.Map", Just [("!", infixl' 9)])]+ "import Data.Map\nf m = m ! 1\n"+ >>= (`shouldContain'` "· ! infixl 9, declared in Data.Map")++ it "says when the module declared it itself" $+ notesFor [("Prelude", Just [])] "infixr 5 <+>\nf a b = a <+> b\n"+ >>= (`shouldContain'` "· <+> infixr 5, declared in this module")++ it "says when nothing in scope declares it and everything was read" $+ notesFor [("Prelude", Just [])] "f a b = a <?> b\n"+ >>= (`mentions` "<?> infixl 9, the Report's default")++ it "says which unread module the answer might have been in" $+ notesFor [("Prelude", Just [])] "import Criterion.Main\nf a b = a <?> b\n"+ >>= ( `shouldContain'`+ "· <?> unknown: may be declared in Criterion.Main, which this run could not read"+ )++ it "counts the unread modules when there is more than one" $+ notesFor+ [("Prelude", Just [])]+ "import Criterion.Main\nimport Test.Tasty\nf a b = a <?> b\n"+ >>= ( `mentions`+ "may be declared in Criterion.Main or Test.Tasty, neither of which this run could read"+ )++ it "keeps the qualifier an operator was written under" $+ notesFor+ [("Prelude", Just []), ("Data.Map", Just [("!", infixl' 9)])]+ "import qualified Data.Map as M\nf m = m M.! 1\n"+ >>= (`shouldContain'` "· M.! infixl 9, declared in Data.Map")++ it "says when two imports disagree about one" $+ notesFor+ [ ("Prelude", Just []),+ ("Left", Just [("<+>", infixl' 6)]),+ ("Right", Just [("<+>", Fixity RightAssoc 5)])+ ]+ "import Left\nimport Right\nf a b = a <+> b\n"+ >>= (`mentions` "two modules in scope disagree about it")++ it "gives an operator one line however often it is written" $ do+ told <- notesFor [("Prelude", Just [])] "f a b c = a <?> b <?> c <?> a\n"+ length (filter (T.isInfixOf "<?>") told) `shouldBe` 1++ describe "how far reading an import got" $ do+ it "names the module that stopped it rather than the import above it" $+ throughHspec+ >>= ( `mentions`+ "may be declared in Test.Hspec → Test.Hspec.Core.Spec \+ \→ Test.QuickCheck.Property, which this run could not read"+ )++ it "says what an import that could not be read was reached through" $+ throughHspec+ >>= ( `mentions`+ "Test.Hspec: could not be read, through Test.Hspec.Core.Spec \+ \→ Test.QuickCheck.Property"+ )++ it "adds nothing for an import unread on its own account" $+ notesFor [("Prelude", Just [])] "import Criterion.Main\nf a b = a <?> b\n"+ >>= (`shouldContain'` "· Criterion.Main: could not be read")++ describe "the shape of it" $ do+ it "keeps every line it prints inside the width" $ do+ told <- throughHspec+ filter ((> lineWidth) . visibleLength) told `shouldBe` []++ it "sets a line it had to break further in than the entry it belongs to" $ do+ told <- throughHspec+ let indentOf = T.length . T.takeWhile (== ' ')+ opens l = "·" `T.isPrefixOf` T.stripStart l+ case break (T.isInfixOf "Test.QuickCheck.Property") told of+ (above, broken : _)+ | not (opens broken),+ (entry : _) <- filter opens (reverse above) ->+ indentOf broken `shouldSatisfy` (> indentOf entry)+ _ -> expectationFailure (show told)++ it "sets out under headings" $ do+ told <- notesFor [("Prelude", Just [("+", infixl' 6)])] "f a b = a + b\n"+ map T.stripStart told `shouldContain` ["· imports"]+ map T.stripStart told `shouldContain` ["· operators"]++ it "leaves out a heading it would have nothing to put under" $+ notesFor [("Prelude", Just [])] "f = 1\n"+ >>= (`shouldSatisfy` all ((/= "· operators") . T.stripStart))++ it "indents an entry further than the heading it sits under" $ do+ told <- notesFor [("Prelude", Just [])] "import Data.Map\n"+ let indentOf = T.length . T.takeWhile (== ' ')+ under heading = [indentOf l | l <- told, heading `T.isInfixOf` l]+ case (under "· imports", under "· Data.Map") of+ ([heading], [there]) -> there `shouldSatisfy` (> heading)+ (headings, entries) ->+ expectationFailure (show (headings, entries))++ it "says nothing about declarations a module does not make" $+ notesFor [("Prelude", Just [])] "f = 1\n"+ >>= (`shouldSatisfy` all (not . T.isInfixOf "declared here"))++ it "lists what the module declares for itself" $+ notesFor [("Prelude", Just [])] "infixr 5 <+>\nf a b = a <+> b\n"+ >>= (`shouldContain'` "· <+> infixr 5")++----------------------------------------------------------------------------+-- Helpers++-- | The account given of a module, against a world of imports that could be+-- read and imports that could not.+--+-- A module named in the world is readable and exports what is listed; a+-- module absent from it is one the resolver could not read at all.+notesFor :: [(Text, Maybe [(Text, Fixity)])] -> Text -> IO [Text]+notesFor = notesThrough []++-- | The same, told how far reading got below each import it could not read.+notesThrough ::+ -- | What lies below an import, ending at the module that stopped it+ [(Text, [Text])] ->+ [(Text, Maybe [(Text, Fixity)])] ->+ Text ->+ IO [Text]+notesThrough chains world source =+ renderFixityNotes Plain . Map.singleton "M.hs"+ <$> fixityNotes (Is #implicitPrelude) (pure . exportsOf) chainOf scope hsModule+ where+ scope =+ resolveScope+ (Is #implicitPrelude)+ nothingKnown {knownFixities = exportsOf, knownChain = chainFor}+ hsModule+ chainFor m = maybe [] id (lookup m chains)+ chainOf = pure . chainFor+ hsModule = pmModule parsed+ parsed = case parseModule defaultParserConfig "M.hs" ("module M where\n" <> source) of+ Left problem -> error (T.unpack (describeParseError problem))+ Right m -> m+ exportsOf m = do+ declared <- lookup m world+ inBothNamespaces . Map.fromList . map (\(op, fixity) -> (OpName op, fixity))+ <$> declared++infixl' :: Int -> Fixity+infixl' = Fixity LeftAssoc++-- | A module whose one import could not be read, and whose reading stopped+-- two modules further down. The real shape, and long enough to have to be+-- broken to fit the width.+throughHspec :: IO [Text]+throughHspec =+ notesThrough+ [("Test.Hspec", ["Test.Hspec.Core.Spec", "Test.QuickCheck.Property"])]+ [("Prelude", Just [])]+ "import Test.Hspec\nf a b = a <?> b\n"++-- | Is this line among them, whatever it was indented by?+shouldContain' :: [Text] -> Text -> Expectation+shouldContain' told wanted =+ map T.stripStart (rejoined told) `shouldContain` [wanted]++-- | Does some line say this much, whatever else it goes on to say?+mentions :: [Text] -> Text -> Expectation+mentions told wanted = rejoined told `shouldSatisfy` any (T.isInfixOf wanted)++-- | The entries as they read before they were broken to fit the width.+rejoined :: [Text] -> [Text]+rejoined = foldl add []+ where+ add seen l+ | null seen || "·" `T.isPrefixOf` T.stripStart l = seen <> [l]+ | otherwise = case unsnoc seen of+ Just (earlier, one) -> earlier <> [one <> " " <> T.stripStart l]+ Nothing -> [l]+ unsnoc xs = case reverse xs of+ [] -> Nothing+ (x : rest) -> Just (reverse rest, x)
+ tests/Tilia/Fixity/DependenciesSpec.hs view
@@ -0,0 +1,374 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TupleSections #-}++-- | The fixity machinery, run over every dependency this project has.+--+-- "Tilia.Fixity.PlanSpec" checks the pipeline on a handful of modules+-- picked for what each one exercises. This checks it on all of them. Every+-- module of every package in this project's build plan is read out of the+-- package's source tarball and compared against what the compiler recorded+-- when it built that same package: two independent readings of one fact,+-- one by us and one by GHC.+module Tilia.Fixity.DependenciesSpec (spec) where++import Control.Monad (filterM)+import Data.ByteString qualified as BS+import Data.Choice (pattern Is)+import Data.Foldable (for_)+import Data.List (isSuffixOf, sort)+import Data.Map.Strict qualified as Map+import Data.Maybe (listToMaybe)+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 System.Directory (doesDirectoryExist, doesFileExist, listDirectory)+import System.FilePath (takeDirectory, (</>))+import Test.Hspec+import Tilia.Fixity+import Tilia.Fixity.Builtin (builtinFixities)+import Tilia.Fixity.Interface (Interface (..), readInterface)+import Tilia.Fixity.PackageDb+import Tilia.Fixity.Plan+import Tilia.Parser++spec :: Spec+spec = do+ plan <- runIO (readBuildPlan (planPathFor "."))+ case plan of+ Left _ ->+ it "needs a built project" $+ pendingWith "no build plan; run cabal build first"+ Right p -> withPlan p++withPlan :: BuildPlan -> Spec+withPlan plan = do+ installed <- runIO readInstalledPackages+ fromSource <- runIO (askFixities <$> newResolverVia [FromSource] plan)+ fromInterface <- runIO (askFixities <$> newResolverVia [FromInterface] plan)+ resolver <- runIO (newResolver plan)+ let resolve = askFixities resolver+ own <- runIO ownModules+ let isShippedModule m = Map.member m builtinFixities+ dependencies <- runIO (dependenciesOf (not . isShippedModule) plan installed)+ preloaded <- runIO (dependenciesOf isShippedModule plan installed)+ let modules = concatMap depModules dependencies+ compilerDir =+ listToMaybe+ [ takeDirectory dir+ | p <- installedPackages installed,+ ipName p == "ghc",+ dir <- take 1 (ipImportDirs p)+ ]+ shippedPackages =+ Set.fromList+ [ ipName p+ | p <- installedPackages installed,+ dir <- take 1 (ipImportDirs p),+ Just (takeDirectory dir) == compilerDir+ ]+ readFromSourcePackages =+ Set.fromList (map depPackage dependencies)+ `Set.difference` shippedPackages+ missing <-+ runIO $+ filterM (fmap not . doesFileExist . snd)+ . filter ((`Set.member` readFromSourcePackages) . ppName . fst)+ =<< plannedTarballs plan+ describe "the tree this project is built against" $ do+ it "is a real dependency tree and not an empty plan" $+ length dependencies `shouldSatisfy` (>= 30)++ it "holds modules the compiler does not ship a fixity table for" $+ length modules `shouldSatisfy` (>= 500)++ -- What every comparison below reads one of its two sides out of. A+ -- source that is not here contradicts nothing, so the comparisons would+ -- pass without having compared anything: this is where that is caught,+ -- rather than in a hundred quietly hollow ticks.+ it "has the source of every package it reads" $+ case map (T.unpack . ppName . fst) missing of+ [] -> pure ()+ names ->+ expectationFailure $+ "no source for "+ <> unwords names+ <> "; fetch them with nix run .#sources"++ describe "the operators the compiler ships with" $+ parallel $+ for_ (concatMap testsFor preloaded) $ \(label, chunk) ->+ it label $ do+ wrong <- traverse contradicts chunk+ concat wrong `shouldBe` []++ describe "every dependency declares what the compiler recorded" $+ parallel $+ for_ (concatMap testsFor dependencies) $ \(label, chunk) ->+ it label $ do+ wrong <- traverse (undeclared fromSource) chunk+ concat wrong `shouldBe` []++ describe "every dependency reads the same both ways" $+ parallel $+ for_ (concatMap testsFor dependencies) $ \(label, chunk) ->+ it label $ do+ wrong <- traverse (conflicting fromSource fromInterface . fst) chunk+ concat wrong `shouldBe` []++ describe "how much of the tree it reaches" $ do+ it "answers for every module of every dependency" $ do+ answers <- traverse (\(m, _) -> (m,) <$> resolve m) modules+ [m | (m, Nothing) <- answers] `shouldBe` []++ it "answers for every one of them out of the interfaces alone" $ do+ answers <- traverse (\(m, _) -> (m,) <$> fromInterface m) modules+ [m | (m, Nothing) <- answers] `shouldBe` []++ -- A loose floor on purpose. How much of the tree source alone reaches+ -- depends on the order the modules are asked for: a module in a+ -- re-export cycle is answered with what the cycle held when the chase+ -- reached it, and which module of the cycle gives way is whichever was+ -- entered first. Measured over ghc-lib-parser's 450 modules, sweeping+ -- them forwards, backwards and from twelve threads moved two of them+ -- either way, and over the whole tree the figure has been seen between+ -- 74% and 80%. The check is here to catch the route collapsing, not to+ -- pin a number that is not pinned.+ it "reads most of them out of source alone" $ do+ answers <- traverse (fromSource . fst) modules+ let reached = length [() | Just _ <- answers]+ percent reached (length modules) `shouldSatisfy` (>= 70)++ it "finds the operators that are in it" $ do+ answers <- traverse (fromSource . fst) modules+ sum [Map.size fixities | Just fixities <- answers] `shouldSatisfy` (>= 300)++ describe "this project's own modules" $ do+ it "parses every one of them" $+ [path | (path, Nothing) <- own] `shouldBe` []++ it "resolves every module they import" $ do+ answers <- traverse (\m -> (m,) <$> resolve m) (importedByOwn own)+ [m | (m, Nothing) <- answers] `shouldBe` []++ it "settles every operator they use" $ do+ unsettled <- traverse (unsettledIn resolver) [(path, m) | (path, Just m) <- own]+ concat unsettled `shouldBe` []++----------------------------------------------------------------------------+-- The dependencies++-- | A package this project is built against, as the compiler holds it.+data Dependency = Dependency+ { -- | The package name+ depPackage :: Text,+ -- | Each module the package holds, with the interface file the compiler+ -- wrote for it.+ depModules :: [(Text, FilePath)]+ }++-- | The modules of every package in the plan that the compiler can also+-- see, keeping the ones the predicate wants.+dependenciesOf :: (Text -> Bool) -> BuildPlan -> Installed -> IO [Dependency]+dependenciesOf wanted plan installed =+ filter (not . null . depModules) <$> traverse ofPackage candidates+ where+ candidates =+ [ (package, dir)+ | package <- installedPackages installed,+ Set.member (ipName package) planned,+ dir <- take 1 (ipImportDirs package)+ ]+ ofPackage (package, dir) =+ Dependency (ipName package)+ <$> filterM+ (doesFileExist . snd)+ [ (m, dir </> T.unpack (T.replace "." "/" m) <> ".hi")+ | m <- ipModules package,+ wanted m+ ]+ planned = Set.fromList [ppName p | p <- bpPackages plan, not (isLocal p)]+ isLocal p = case ppSource p of+ LocalPackage _ -> True+ _ -> False++-- | One test per package, splitting the large ones up.+testsFor :: Dependency -> [(String, [(Text, FilePath)])]+testsFor dependency = case chunksOf 32 (depModules dependency) of+ [whole] -> [(name, whole)]+ pieces ->+ [ (name <> " (" <> show i <> " of " <> show (length pieces) <> ")", piece)+ | (i, piece) <- zip [1 :: Int ..] pieces+ ]+ where+ name = T.unpack (depPackage dependency)++chunksOf :: Int -> [a] -> [[a]]+chunksOf n = \case+ [] -> []+ xs -> let (chunk, rest) = splitAt n xs in chunk : chunksOf n rest++-- | Where the built-in table and the compiler both hold a fixity for an+-- operator and it is not the same fixity.+--+-- The table in "Tilia.Fixity.Builtin" was written by asking a GHC of one+-- version what its boot packages export. The tests run against whichever+-- GHC built the project, which this package supports three of. This is what+-- says the answer has not moved underneath the table.+contradicts :: (Text, FilePath) -> IO [String]+contradicts (modName, interfaceFile) =+ readInterface modName interfaceFile >>= \case+ Nothing -> pure []+ Just interface ->+ pure+ [ T.unpack modName+ <> ": "+ <> show op+ <> " is "+ <> show declared+ <> " per the compiler, "+ <> show ours+ <> " in the table"+ | (op, declared) <- Map.toList (interfaceDeclares interface),+ Just ours <- [Map.lookup op table],+ ours /= declared+ ]+ where+ table = Map.findWithDefault Map.empty modName builtinFixities++-- | Every fixity the compiler recorded for a module that reading the+-- package's source did not produce.+undeclared ::+ -- | What a module declares, read from the package's source+ (Text -> IO (Maybe (Fixities))) ->+ -- | The module, and the interface the compiler wrote for it+ (Text, FilePath) ->+ IO [String]+undeclared fromSource (modName, interfaceFile) =+ readInterface modName interfaceFile >>= \case+ Nothing -> pure []+ Just interface ->+ fromSource modName >>= \case+ Nothing -> pure []+ Just fixities ->+ pure+ [ T.unpack modName+ <> ": "+ <> show op+ <> " is "+ <> show declared+ <> " per the compiler, "+ <> show (Map.lookup op fixities)+ <> " from source"+ | (op, declared) <- Map.toList (interfaceDeclares interface),+ writable declared,+ Map.lookup op fixities /= Just declared+ ]+ where+ -- GHC files @->@ under a module's fixities at precedence -1, below+ -- anything a source file is allowed to declare.+ writable f = fixityPrecedence f >= 0 && fixityPrecedence f <= 9++-- | Where the two routes both have an answer for an operator and it is not+-- the same answer.+--+-- Wider than 'undeclared', because a module's own declarations are the+-- smaller part of what it offers: most operators reach the module that+-- exports them through a chain of re-exports, and following that chain+-- through source text is the part of this most likely to go wrong. The+-- compiler followed the same chain when it built the package, so the two+-- have to arrive at the same place.+conflicting ::+ -- | The answer read out of the package's source+ (Text -> IO (Maybe (Fixities))) ->+ -- | The answer read out of the compiler's interfaces+ (Text -> IO (Maybe (Fixities))) ->+ Text ->+ IO [String]+conflicting fromSource fromInterface modName = do+ source <- fromSource modName+ compiled <- fromInterface modName+ pure $ case (source, compiled) of+ (Just a, Just b) ->+ [ T.unpack modName+ <> ": "+ <> show op+ <> " is "+ <> show fromText+ <> " from source, "+ <> show fromIface+ <> " from the interface"+ | (op, (fromText, fromIface)) <- Map.toList (Map.intersectionWith (,) a b),+ fromText /= fromIface+ ]+ _ -> []++percent :: Int -> Int -> Int+percent part whole = if whole == 0 then 0 else part * 100 `div` whole++----------------------------------------------------------------------------+-- This project++-- | Every Haskell file this project is made of, parsed.+--+-- 'Nothing' where one did not parse, which is a failure of its own rather+-- than something to skip over quietly.+ownModules :: IO [(FilePath, Maybe (HsModule GhcPs))]+ownModules = do+ paths <- concat <$> traverse haskellFilesIn ["src", "app", "tests"]+ traverse parsed paths+ where+ parsed path = do+ source <- T.decodeUtf8Lenient <$> BS.readFile path+ pure+ ( path,+ case parseModule defaultParserConfig path source of+ Left _ -> Nothing+ Right pm -> Just (pmModule pm)+ )++haskellFilesIn :: FilePath -> IO [FilePath]+haskellFilesIn dir = do+ entries <- sort <$> listDirectory dir+ concat <$> traverse below entries+ where+ below entry = do+ let path = dir </> entry+ isDir <- doesDirectoryExist path+ if isDir+ then haskellFilesIn path+ else pure [path | ".hs" `isSuffixOf` path]++-- | Every module this project's own source imports.+importedByOwn :: [(FilePath, Maybe (HsModule GhcPs))] -> [Text]+importedByOwn own =+ Set.toList . Set.fromList $+ [ importModule i+ | (_, Just hsModule) <- own,+ i <- moduleImports (Is #implicitPrelude) hsModule,+ not ("Paths_" `T.isPrefixOf` importModule i)+ ]++-- | The operators one of this project's modules uses that its imports,+-- resolved for real, cannot settle.+--+-- This is the whole machinery end to end: the plan is read, the packages+-- are found, their modules are read, the scope is assembled and the+-- operators are looked up in it. Anything left over is an operator this+-- project could not be laid out from.+unsettledIn ::+ Resolver ->+ (FilePath, HsModule GhcPs) ->+ IO [String]+unsettledIn resolver (path, hsModule) = do+ scope <- scopeFor resolver (Is #implicitPrelude) hsModule+ pure+ [ path <> ": " <> T.unpack (operatorSpelling qualifier op) <> " " <> show why+ | ((qualifier, op), why) <- unknownOperators scope hsModule+ ]
+ tests/Tilia/Fixity/InterfaceSpec.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Reading what @ghc --show-iface@ prints.+--+-- The samples below are cut from real output rather than invented, since+-- the whole risk here is in the format: this is a pretty-printer's idea of+-- an interface, not a documented one.+module Tilia.Fixity.InterfaceSpec (spec) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Test.Hspec+import Tilia.Fixity+import Tilia.Fixity.Interface++spec :: Spec+spec = do+ describe "what a module declares" $ do+ it "reads a fixity line" $+ declares "fixities infixl 9 !, infixl 9 !?, infixl 9 \\\\\n"+ `shouldBe` [ (OpName "!", Fixity LeftAssoc 9),+ (OpName "!?", Fixity LeftAssoc 9),+ (OpName "\\\\", Fixity LeftAssoc 9)+ ]++ it "reads one wrapped across lines" $+ declares+ "fixities infixr 0 $, infixr 0 $!, infixl 4 *>, infixr 5 ++,\n\+ \ infixr 9 ., infixr 5 :|, infixl 4 <$\n"+ `shouldBe` [ (OpName "$", Fixity RightAssoc 0),+ (OpName "$!", Fixity RightAssoc 0),+ (OpName "*>", Fixity LeftAssoc 4),+ (OpName "++", Fixity RightAssoc 5),+ (OpName ".", Fixity RightAssoc 9),+ (OpName ":|", Fixity RightAssoc 5),+ (OpName "<$", Fixity LeftAssoc 4)+ ]++ it "reads every direction, and a name used in backticks" $+ declares "fixities infixl 7 div, infix 4 ===, infixr 1 .&&.\n"+ `shouldBe` [ (OpName ".&&.", Fixity RightAssoc 1),+ (OpName "===", Fixity NoAssoc 4),+ (OpName "div", Fixity LeftAssoc 7)+ ]++ it "reads the precedence GHC gives the function arrow" $+ declares "fixities infixr -1 ->\n"+ `shouldBe` [(OpName "->", Fixity RightAssoc (-1))]++ it "reads it alongside ordinary ones" $+ declares "fixities infixr -1 ->, infixl 9 !\n"+ `shouldBe` [(OpName "!", Fixity LeftAssoc 9), (OpName "->", Fixity RightAssoc (-1))]++ it "passes over an entry it cannot read, and keeps the rest" $+ declares "fixities infixl notadigit ?, infixl 9 !, infixl\n"+ `shouldBe` [(OpName "!", Fixity LeftAssoc 9)]++ it "says nothing for a module that declares nothing" $+ declares "exports:\n member\n" `shouldBe` []++ describe "what a module passes on" $ do+ it "names the module an operator was declared in" $+ passesOn "exports:\n Data.Aeson.Types.FromJSON..:\n"+ `shouldBe` [("Data.Aeson.Types.FromJSON", OpName ".:")]++ it "leaves out what the module declared itself" $+ passesOn "exports:\n decode'\n <+>\n" `shouldBe` []++ it "takes the members of a class along with it" $+ passesOn+ "exports:\n\+ \ Data.Aeson.Types.FromJSON.FromJSON{Data.Aeson.Types.FromJSON.parseJSON}\n"+ `shouldBe` [ ("Data.Aeson.Types.FromJSON", OpName "FromJSON"),+ ("Data.Aeson.Types.FromJSON", OpName "parseJSON")+ ]++ it "takes a record field, written after a bar" $+ passesOn "exports:\n Data.Aeson.Encoding.Internal.Encoding'|{Data.Aeson.Encoding.Internal.fromEncoding}\n"+ `shouldBe` [ ("Data.Aeson.Encoding.Internal", OpName "Encoding'"),+ ("Data.Aeson.Encoding.Internal", OpName "fromEncoding")+ ]++ it "keeps a type apart from the module holding it" $+ passesOn "exports:\n Data.Aeson.Types.Internal.Value\n"+ `shouldBe` [("Data.Aeson.Types.Internal", OpName "Value")]++ it "reads an operator that is nothing but a dot" $+ passesOn "exports:\n Data.Function..\n"+ `shouldBe` [("Data.Function", OpName ".")]++ it "leaves a capitalised name this module declared alone" $+ passesOn "exports:\n Value\n" `shouldBe` []++ describe "which namespace a fixity governs" $ do+ it "gives one to types where the module declares a type of that name" $+ declaresIn "fixities infix 4 :~:\nab12\n data (:~:) a b where\n"+ `shouldBe` [((InTypes, OpName ":~:"), Fixity NoAssoc 4)]++ it "gives one to terms where nothing declares a type of that name" $+ declaresIn "fixities infixl 9 !\nab12\n (!) :: Int -> Int -> Int\n"+ `shouldBe` [((InTerms, OpName "!"), Fixity LeftAssoc 9)]++ it "reads a type synonym as a type" $+ declaresIn "fixities infixr 5 :+\nab12\n type (:+) :: * -> * -> *\n"+ `shouldBe` [((InTypes, OpName ":+"), Fixity RightAssoc 5)]++ it "reads a type family as a type" $+ declaresIn "fixities infixl 6 ==\nab12\n type family (==) a b where\n"+ `shouldBe` [((InTypes, OpName "=="), Fixity LeftAssoc 6)]++ it "reads a class as a type" $+ declaresIn "fixities infixl 4 <%>\nab12\n class (<%>) a where\n"+ `shouldBe` [((InTypes, OpName "<%>"), Fixity LeftAssoc 4)]++ it "takes a role declaration as saying the name is a type" $+ declaresIn "fixities infixl 9 !\nab12\n type role (!) nominal\n"+ `shouldBe` [((InTypes, OpName "!"), Fixity LeftAssoc 9)]++ it "is not misled by declarations of other names" $+ declaresIn "fixities infixl 9 !\nab12\n data Other a b where\n (!) :: Int\n"+ `shouldBe` [((InTerms, OpName "!"), Fixity LeftAssoc 9)]++ describe "what a name carries with it" $ do+ it "takes the members an entry wears in braces" $+ carries "exports:\n GHC.Internal.Base.NonEmpty{GHC.Internal.Base.:|}\n"+ `shouldBe` [(OpName "NonEmpty", [OpName ":|"])]++ it "takes every one of them" $+ carries+ "exports:\n\+ \ GHC.Internal.Base.Applicative{GHC.Internal.Base.*> GHC.Internal.Base.<*> GHC.Internal.Base.pure}\n"+ `shouldBe` [(OpName "Applicative", [OpName "*>", OpName "<*>", OpName "pure"])]++ it "takes them from a partial export, which still says what it has" $+ carries "exports:\n GHC.Internal.Base.Functor|{GHC.Internal.Base.<$}\n"+ `shouldBe` [(OpName "Functor", [OpName "<$"])]++ it "takes a name this module declared, written without a module" $+ carries "exports:\n WrappedArrow{WrapArrow unwrapArrow}\n"+ `shouldBe` [(OpName "WrappedArrow", [OpName "WrapArrow", OpName "unwrapArrow"])]++ it "keeps entries apart where several sit on one line" $+ carries "exports:\n A{B} C{D}\n"+ `shouldBe` [(OpName "A", [OpName "B"]), (OpName "C", [OpName "D"])]++ it "has nothing to say about a name that carries nothing" $+ carries "exports:\n decode'\n Data.Aeson.Types.FromJSON..:\n" `shouldBe` []++ describe "sections it has no use for" $+ it "is not confused by the rest of the file" $ do+ let out =+ "Magic: Wanted 33214052,\n\+ \ got 33214052\n\+ \interface Data.Aeson 9103\n\+ \ interface hash: 6b4f\n\+ \exports:\n\+ \ Data.Aeson.Types.FromJSON..:\n\+ \fixities infixl 9 !\n\+ \direct package dependencies: base-4.20.2.0 bytestring-0.12.2.0\n\+ \orphans: Data.Orphans\n\+ \trusted: none\n"+ fmap (Map.toList . interfaceDeclares) (parseInterface "Data.Aeson" out)+ `shouldBe` Just [((InTerms, OpName "!"), Fixity LeftAssoc 9)]+ fmap interfacePassedOn (parseInterface "Data.Aeson" out)+ `shouldBe` Just [("Data.Aeson.Types.FromJSON", OpName ".:")]++ describe "output it will not read" $ do+ it "refuses what does not name a module at all" $+ parseInterface "M" "some future rendering we do not recognise\n"+ `shouldBe` Nothing++ it "refuses an interface for a different module" $+ parseInterface "Data.Map.Strict" (header "Data.Map.Lazy" <> "fixities infixl 9 !\n")+ `shouldBe` Nothing++ it "reads one that names the module asked for" $+ declares "fixities infixl 9 !\n" `shouldBe` [(OpName "!", Fixity LeftAssoc 9)]++header :: Text -> Text+header modName = "interface " <> modName <> " 9103\n"++-- | The fixities an interface of this shape declares, by name alone.+declares :: Text -> [(OpName, Fixity)]+declares =+ map (\((_, op), fixity) -> (op, fixity))+ . maybe [] (Map.toList . interfaceDeclares)+ . parseInterface "M"+ . (header "M" <>)++-- | The same, keeping the namespace each governs.+declaresIn :: Text -> [((Namespace, OpName), Fixity)]+declaresIn =+ maybe [] (Map.toList . interfaceDeclares) . parseInterface "M" . (header "M" <>)++passesOn :: Text -> [(Text, OpName)]+passesOn = maybe [] interfacePassedOn . parseInterface "M" . (header "M" <>)++-- | What each exported name carries with it, in a settled order.+carries :: Text -> [(OpName, [OpName])]+carries =+ maybe [] (map (fmap Set.toList) . Map.toList . interfaceChildren)+ . parseInterface "M"+ . (header "M" <>)
+ tests/Tilia/Fixity/PackageDbSpec.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Reading what the compiler says it has.+module Tilia.Fixity.PackageDbSpec (spec) where++import Data.List (isInfixOf)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Test.Hspec+import Tilia.Fixity.PackageDb++spec :: Spec+spec = do+ describe "one record of ghc-pkg dump" $ do+ it "reads the directories a package's interfaces are in" $+ dirsOf [("import-dirs", "/opt/ghc/lib/base-4.20.2.0")]+ `shouldBe` Just ["/opt/ghc/lib/base-4.20.2.0"]++ it "puts the package root where the registration left a variable" $+ dirsOf+ [ ("pkgroot", "\"/opt/ghc/lib\""),+ ("import-dirs", "${pkgroot}/../lib/base-4.20.2.0")+ ]+ `shouldBe` Just ["/opt/ghc/lib/../lib/base-4.20.2.0"]++ it "leaves the variable alone when the record does not say" $+ dirsOf [("import-dirs", "${pkgroot}/../lib/base-4.20.2.0")]+ `shouldBe` Just ["${pkgroot}/../lib/base-4.20.2.0"]++ it "roots every directory a package names" $+ dirsOf+ [ ("pkgroot", "/opt/ghc/lib"),+ ("import-dirs", "${pkgroot}/one ${pkgroot}/two")+ ]+ `shouldBe` Just ["/opt/ghc/lib/one", "/opt/ghc/lib/two"]++ it "says nothing of a record that names no package" $+ fromFields (Map.fromList [("import-dirs", "/opt/ghc/lib")])+ `shouldBe` Nothing++ describe "what this compiler reports" $+ it "leaves no path variable in any import directory" $ do+ installed <- readInstalledPackages+ [ dir+ | p <- installedPackages installed,+ dir <- ipImportDirs p,+ "${" `isInfixOf` dir+ ]+ `shouldBe` []++-- | The import directories one record amounts to, given its fields.+dirsOf :: [(Text, Text)] -> Maybe [FilePath]+dirsOf fields =+ ipImportDirs+ <$> fromFields (Map.fromList (named <> fields))+ where+ named = [("name", "base"), ("version", "4.20.2.0")]
+ tests/Tilia/Fixity/PlanSpec.hs view
@@ -0,0 +1,1517 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}++-- | The whole fixity pipeline, run against this project's own dependencies.+--+-- These tests read the real build plan, the real package cache and real+-- Hackage sources. That is the point: every other test in the suite works+-- on constructed inputs, and constructed inputs are exactly what a pipeline+-- that talks to the outside world will not fail on.+--+-- Running the test suite implies the project was built, so the plan and the+-- sources are there. Where they are not — a sandboxed build with no package+-- cache — each test says so and is marked pending rather than failing.+module Tilia.Fixity.PlanSpec (spec) 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.Exception (bracket)+import Control.Monad (when)+import Data.ByteString.Lazy qualified as BL+import Data.Choice (pattern Is)+import Data.Foldable (traverse_)+import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef)+import Data.List (isInfixOf)+import Data.List qualified+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+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 System.Directory (createDirectoryIfMissing)+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.FilePath (dropExtension, takeBaseName, takeDirectory, (</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Tilia.Fixity+import Tilia.Fixity.PackageDb (compilerIdentity)+import Tilia.Fixity.Plan+import Tilia.Parser+import Tilia.Process (readProgramOutput)++spec :: Spec+spec = do+ preparation+ tokens+ reexports+ hscModules+ generatedModuleSpec+ gitDependencies+ repositories+ packageCache+ plan <- runIO (readBuildPlan (planPathFor "."))+ case plan of+ Left _ -> unavailable "no build plan; run cabal build first"+ Right p -> withPlan p++-- | What a cached failure is filed under.+--+-- A failure to read a module leans on the plan and on the compiler this run+-- can ask, so both have to be in the token. Were the environment left out,+-- a shell that cannot see a package would hand its "could not be read" to+-- one that can.+tokens :: Spec+tokens = describe "the token a plan is cached under" $ do+ it "differs between environments over the same plan" $+ planToken "/one/bin/ghc-pkg" onePackage+ `shouldNotBe` planToken "/another/bin/ghc-pkg" onePackage++ it "differs between plans in the same environment" $+ planToken here onePackage `shouldNotBe` planToken here noPackages++ it "is the same twice over for the same plan and environment" $+ planToken here onePackage `shouldBe` planToken here onePackage++ it "asks the environment it is actually going to read in" $ do+ asked <- tokenFor onePackage+ environment <- compilerIdentity+ asked `shouldBe` planToken environment onePackage+ where+ here = "/somewhere/bin/ghc-pkg"+ noPackages = BuildPlan {bpCompiler = "ghc-9.10.3", bpPackages = []}+ onePackage =+ BuildPlan+ { bpCompiler = "ghc-9.10.3",+ bpPackages =+ [ PlanPackage+ { ppName = "containers",+ ppVersion = "0.7",+ ppSource = PreExisting,+ ppComponents = []+ }+ ]+ }++-- | What a run does before it trusts the plan.+--+-- These need no plan of their own and no @cabal@: the point is the order of+-- the steps, so the steps are recorded rather than taken.+preparation :: Spec+preparation = describe "preparing a project" $ do+ it "solves and then fetches, in the one run" $+ withTempProject Nothing $ \dir -> do+ steps <- newIORef []+ let cabal args = do+ record steps args+ when (args == solving) (writePlan dir wantingATarball)+ pure (Right ())+ checkReadiness [] dir `shouldReturn` PlanMissing+ prepareWith cabal forgetfulSolves [] dir PlanMissing `shouldReturn` Right ()+ readIORef steps+ `shouldReturn` [solving, fetching]++ it "fetches without solving when the plan is already good" $+ withTempProject (Just wantingATarball) $ \dir -> do+ steps <- newIORef []+ readiness <- checkReadiness [] dir+ readiness `shouldBe` SourcesMissing ["tilia-phantom"]+ prepareWith (obliging steps) forgetfulSolves [] dir readiness `shouldReturn` Right ()+ readIORef steps `shouldReturn` [fetching]++ it "runs nothing at all when nothing is missing" $ do+ steps <- newIORef []+ prepareWith (obliging steps) forgetfulSolves [] "." Ready `shouldReturn` Right ()+ readIORef steps `shouldReturn` []++ it "does not go on to fetch when the solve fails" $+ withTempProject Nothing $ \dir -> do+ steps <- newIORef []+ let cabal args = record steps args >> pure (Left "cabal said no")+ prepareWith cabal forgetfulSolves [] dir PlanMissing `shouldReturn` Left "cabal said no"+ readIORef steps `shouldReturn` [solving, narrowSolve]++ it "asks about the test suites and the benchmarks, not the library alone" $+ withTempProject Nothing $ \dir -> do+ steps <- newIORef []+ let cabal args = do+ record steps args+ when (args == solving) (writePlan dir wantingATarball)+ pure (Right ())+ _ <- prepareWith cabal forgetfulSolves [] dir PlanMissing+ asked <- readIORef steps+ asked `shouldSatisfy` all (\args -> wholeProject `Data.List.isSuffixOf` args)++ it "settles for what will solve when the whole project will not" $+ withTempProject Nothing $ \dir -> do+ steps <- newIORef []+ let cabal args = do+ record steps args+ if wholeProject `Data.List.isSuffixOf` args+ then pure (Left "a test suite will not solve")+ else do+ when (args == narrowSolve) (writePlan dir wantingATarball)+ pure (Right ())+ prepareWith cabal forgetfulSolves [] dir PlanMissing `shouldReturn` Right ()+ readIORef steps+ `shouldReturn` [solving, narrowSolve, fetching, narrowFetch]++ describe "a plan narrower than the run" $ do+ it "notices a component the plan says nothing about" $+ withTempProject (Just twoComponents) $ \dir ->+ checkReadiness [component "test:tests"] dir+ `shouldReturn` PlanNarrow ["thing:test:tests"]++ it "names every one it is missing" $+ withTempProject (Just twoComponents) $ \dir ->+ checkReadiness [component "test:tests", component "bench:speed"] dir+ `shouldReturn` PlanNarrow ["thing:test:tests", "thing:bench:speed"]++ it "is content with the components the plan does cover" $+ withTempProject (Just twoComponents) $ \dir ->+ checkReadiness [component "lib", component "exe:thing"] dir+ `shouldReturn` Ready++ it "asks for nothing when the run asks about nothing" $+ withTempProject (Just twoComponents) $ \dir ->+ checkReadiness [] dir `shouldReturn` Ready++ it "solves again rather than trusting it" $+ withTempProject (Just twoComponents) $ \dir -> do+ steps <- newIORef []+ let cabal args = do+ record steps args+ when (args == solving) (writePlan dir twoComponents)+ pure (Right ())+ prepareWith cabal forgetfulSolves [component "test:tests"] dir (PlanNarrow ["thing:test:tests"])+ `shouldReturn` Right ()+ readIORef steps `shouldReturn` [solving]++ it "counts the components of this very project as covered" $ do+ plan' <- readBuildPlan (planPathFor ".")+ case plan' of+ Left _ -> pendingWith "no build plan; run cabal build first"+ Right p ->+ checkReadiness (plannedComponents p) "."+ `shouldNotReturn` PlanNarrow []++ it "solves only the once when solving does not widen it" $+ withTempProject (Just twoComponents) $ \dir -> do+ steps <- newIORef []+ futile <- newIORef False+ let cabal args = do+ record steps args+ when (args == solving) (writePlan dir twoComponents)+ pure (Right ())+ solves =+ forgetfulSolves+ { solveWasFutile = readIORef futile,+ rememberFutileSolve = writeIORef futile True+ }+ narrow = PlanNarrow ["thing:test:tests"]+ once = prepareWith cabal solves [component "test:tests"] dir narrow+ once `shouldReturn` Right ()+ readIORef futile `shouldReturn` True+ once `shouldReturn` Right ()+ readIORef steps `shouldReturn` [solving]++ it "fetches what a plan it cannot widen is short of" $+ withTempProject (Just narrowAndWanting) $ \dir -> do+ steps <- newIORef []+ let cabal args = do+ record steps args+ when (args == solving) (writePlan dir narrowAndWanting)+ pure (Right ())+ narrow = PlanNarrow ["thing:test:tests"]+ prepareWith cabal forgetfulSolves [component "test:tests"] dir narrow+ `shouldReturn` Right ()+ readIORef steps+ `shouldReturn` [solving, fetching]++ it "fetches it even once solving again has been given up on" $+ withTempProject (Just narrowAndWanting) $ \dir -> do+ steps <- newIORef []+ futile <- newIORef True+ let solves =+ forgetfulSolves+ { solveWasFutile = readIORef futile,+ rememberFutileSolve = writeIORef futile True+ }+ narrow = PlanNarrow ["thing:test:tests"]+ prepareWith (obliging steps) solves [component "test:tests"] dir narrow+ `shouldReturn` Right ()+ readIORef steps `shouldReturn` [fetching]++ it "does not ask again for what fetching did not bring in" $+ withTempProject (Just narrowAndWanting) $ \dir -> do+ steps <- newIORef []+ refused <- newIORef []+ let solves =+ forgetfulSolves+ { solveWasFutile = pure True,+ fetchWasFutileFor = readIORef refused,+ rememberFutileFetch = writeIORef refused+ }+ narrow = PlanNarrow ["thing:test:tests"]+ again = prepareWith (obliging steps) solves [component "test:tests"] dir narrow+ again `shouldReturn` Right ()+ readIORef refused `shouldReturn` ["tilia-phantom"]+ again `shouldReturn` Right ()+ readIORef steps `shouldReturn` [fetching]++ it "goes on solving while solving still widens it" $+ withTempProject (Just twoComponents) $ \dir -> do+ steps <- newIORef []+ futile <- newIORef False+ let cabal args = do+ record steps args+ when (args == solving) (writePlan dir threeComponents)+ pure (Right ())+ solves =+ forgetfulSolves+ { solveWasFutile = readIORef futile,+ rememberFutileSolve = writeIORef futile True+ }+ prepareWith cabal solves [component "test:tests"] dir (PlanNarrow ["thing:test:tests"])+ `shouldReturn` Right ()+ readIORef futile `shouldReturn` False+ readIORef steps `shouldReturn` [solving]++ describe "a package the plan could not take apart" $ do+ it "counts the components it lists under one entry" $+ withTempProject (Just plannedWhole) $ \dir ->+ checkReadiness [component "lib", component "test:spec"] dir+ `shouldReturn` Ready++ it "still misses one that entry does not list" $+ withTempProject (Just plannedWhole) $ \dir ->+ checkReadiness [component "bench:speed"] dir+ `shouldReturn` PlanNarrow ["thing:bench:speed"]++ it "does not offer the Setup program as a component" $ do+ plan' <- withTempProject (Just plannedWhole) (readBuildPlan . planPathFor)+ fmap plannedComponents plan'+ `shouldBe` Right [component "lib", component "test:spec"]++-- | Chasing an operator a module passes on rather than declares.+--+-- No plan and no network here: the modules a name could have come from+-- answer out of a table written below, which is what makes it possible to+-- ask not merely whether an answer came back but which module it came from.+reexports :: Spec+reexports = describe "an operator a module passes on" $ do+ it "comes from the module the qualifier names" $+ chased "module M ((Disp.<+>)) where\nimport Control.Arrow (first)\nimport qualified Text.PrettyPrint as Disp\n"+ `shouldReturn` Just (Fixity LeftAssoc 6)++ it "comes from an import that brings it in, not one that hides it" $+ chased "module M ((<+>)) where\nimport Control.Arrow hiding ((<+>))\nimport Text.PrettyPrint\n"+ `shouldReturn` Just (Fixity LeftAssoc 6)++ it "comes from an import that brings it in, not one that never names it" $+ chased "module M ((<+>)) where\nimport Control.Arrow (first)\nimport Text.PrettyPrint\n"+ `shouldReturn` Just (Fixity LeftAssoc 6)++ it "does not come from a qualified import when it is written plainly" $+ chased "module M ((<+>)) where\nimport Control.Arrow\nimport qualified Text.PrettyPrint as Disp\n"+ `shouldReturn` Just (Fixity RightAssoc 5)++ it "is the module's own where the module declares it" $+ chased "module M ((<+>)) where\nimport Control.Arrow\ninfixr 3 <+>\n(<+>) :: Int -> Int -> Int\na <+> b = a + b\n"+ `shouldReturn` Just (Fixity RightAssoc 3)++ it "is not answered at all when the module it came from cannot be read" $+ chased "module M ((<+>)) where\nimport No.Such.Module\n"+ `shouldReturn` Nothing++ it "comes from a type handed on whole, which carries it" $+ chased "module M (Doc (..)) where\nimport Text.PrettyPrint\n"+ `shouldReturn` Just (Fixity LeftAssoc 6)++ it "does not come from a type handed on by an import that hides it" $+ chased "module M (Doc (..)) where\nimport Text.PrettyPrint hiding (Doc (..))\nimport Control.Arrow\n"+ `shouldReturn` Nothing++-- | What a module written for @hsc2hs@ amounts to, by either route to one.+--+-- Both fixtures below are what @hsc2hs@ takes and no compiler does, and+-- both write a fixity that the answer is expected to ignore. That is the+-- point: a module nothing can read is answered out of+-- 'Tilia.Fixity.ByHand.hscFixities' or not at all, and were either answer+-- arrived at by reading the file there would be no answer to give.+hscModules :: Spec+hscModules = describe "a module written for hsc2hs" $ do+ it "declares nothing, where it is one of the project's own" $+ withFakeProject [("src/Cursed.hsc", cursed)] $+ \rs -> do+ askFixities rs "Cursed" `shouldReturn` Just Map.empty+ askExportNames rs "Cursed" `shouldReturn` Just Set.empty+ askChildren rs "Cursed" `shouldReturn` Map.empty++ it "declares what the table says, where it comes out of a tarball"+ $ withFakeArchive+ [ ("Cursed.hsc", cursed),+ ("System/Posix/Signals.hsc", signals)+ ]+ $ \rs -> do+ askFixities rs "Cursed" `shouldReturn` Just Map.empty+ askExportNames rs "System.Posix.Signals"+ `shouldReturn` Just (Set.fromList [OpName "addSignal", OpName "deleteSignal"])++-- | Where a package fetched from a repository is looked for.+repositories :: Spec+repositories = describe "a package fetched from a repository" $ do+ it "finds one Hackage downloaded"+ $ withCache+ [("hackage.haskell.org", "thing", "1.0")]+ (fromRepository "{\"type\":\"secure-repo\",\"uri\":\"http://hackage.haskell.org/\"}")+ $ \found -> found `shouldSatisfy` isUnder "hackage.haskell.org"++ it "finds one a private repository downloaded, named after its host"+ $ withCache+ [("packages.example.com", "thing", "1.0")]+ (fromRepository "{\"type\":\"secure-repo\",\"uri\":\"https://packages.example.com/\"}")+ $ \found -> found `shouldSatisfy` isUnder "packages.example.com"++ it "finds one whose directory is not named after its host"+ $ withCache+ [("my-company", "thing", "1.0")]+ (fromRepository "{\"type\":\"secure-repo\",\"uri\":\"https://packages.example.com/\"}")+ $ \found -> found `shouldSatisfy` isUnder "my-company"++ it "leaves a file+noindex repository's tarballs where they are" $+ withSystemTempDirectory "tilia-noindex" $ \repo -> do+ T.writeFile (repo </> "thing-1.0.tar.gz") "not really a tarball"+ withCache+ []+ (fromRepository ("{\"type\":\"local-repo-no-index\",\"path\":\"" <> T.pack repo <> "\"}"))+ $ \found -> found `shouldBe` (repo </> "thing-1.0.tar.gz")++ it "says where its own repository would put one nothing has downloaded" $+ withCache [] (fromRepository "{\"type\":\"secure-repo\",\"uri\":\"https://packages.example.com/\"}") $+ \found -> found `shouldSatisfy` isUnder "packages.example.com"++ it "falls back on Hackage for a plan that names no repository at all" $+ withCache [("hackage.haskell.org", "thing", "1.0")] planWithoutARepository $+ \found -> found `shouldSatisfy` isUnder "hackage.haskell.org"++-- | Is the tarball under this repository's directory of the cache?+isUnder :: FilePath -> FilePath -> Bool+isUnder repo path = ("/" <> repo <> "/") `Data.List.isInfixOf` path++-- | Where the package cache is looked for.+--+-- @cabal@ answers this differently on each platform and has answered it two+-- ways on this one, so the rule is to look everywhere it could be and take+-- whichever place holds an index. These drive the search by moving the+-- directories it derives from, which on Unix are these two variables.+packageCache :: Spec+packageCache = describe "where the package cache is looked for" $ do+ -- Whatever cabal says it is. Checked against cabal rather than against a+ -- path spelled out here, because the whole point of asking is that this+ -- suite cannot know what the answer should be on somebody else's+ -- machine—and did not, on Windows.+ it "is the directory cabal reports" $ do+ said <- readProgramOutput "cabal" ["path", "--remote-repo-cache"]+ case said of+ Nothing -> pendingWith "no cabal on the path to ask"+ Just reported ->+ packageCacheRoot `shouldReturn` T.unpack (T.strip reported)++ describe "and where it is guessed, for a cabal too old to ask" $ do+ it "is what CABAL_DIR says, above all else" $+ withSystemTempDirectory "tilia-cabal-dir" $ \dir ->+ withEnvironment [("CABAL_DIR", dir)] $+ guessedPackageCacheRoot `shouldReturn` (dir </> "packages")++ it "is the XDG cache where the index is there" $+ withLayouts $ \xdg _ -> do+ withIndexIn xdg+ guessedPackageCacheRoot `shouldReturn` xdg++ it "is still the old directory where the index is there instead" $+ withLayouts $ \_ legacy -> do+ withIndexIn legacy+ guessedPackageCacheRoot `shouldReturn` legacy++ it "is the platform's own default where there is no index anywhere" $+ withLayouts $+ \xdg _ -> guessedPackageCacheRoot `shouldReturn` xdg++-- | Run something against a home and an XDG cache directory of its own,+-- handing it both of the places a cache could then be in.+withLayouts :: (FilePath -> FilePath -> Expectation) -> Expectation+withLayouts act =+ withSystemTempDirectory "tilia-home" $ \home ->+ withSystemTempDirectory "tilia-xdg" $ \cache ->+ withEnvironment [("HOME", home), ("XDG_CACHE_HOME", cache)] $+ bracket+ (lookupEnv "CABAL_DIR" <* unsetEnv "CABAL_DIR")+ (traverse_ (setEnv "CABAL_DIR"))+ (const (act (cache </> "cabal" </> "packages") (home </> ".cabal" </> "packages")))++-- | Put a Hackage index where a cache directory would have one.+withIndexIn :: FilePath -> IO ()+withIndexIn root = do+ createDirectoryIfMissing True (root </> "hackage.haskell.org")+ T.writeFile (root </> "hackage.haskell.org" </> "01-index.tar") ""++-- | Run something on where @plannedTarballs@ looked, against a package+-- cache holding the entries given.+withCache ::+ -- | Repository directory, package, version — one per cached tarball+ [(FilePath, Text, Text)] ->+ -- | The plan to read it against+ Text ->+ (FilePath -> Expectation) ->+ Expectation+withCache cached planText act =+ withSystemTempDirectory "tilia-cabal" $ \cabalDir -> do+ traverse_ (put cabalDir) cached+ createDirectoryIfMissing True (cabalDir </> "packages")+ withEnvironment [("CABAL_DIR", cabalDir)] $+ withSystemTempDirectory "tilia-repo-plan" $ \dir -> do+ createDirectoryIfMissing True (takeDirectory (planPathFor dir))+ T.writeFile (planPathFor dir) planText+ readBuildPlan (planPathFor dir) >>= \case+ Left why -> expectationFailure (T.unpack why)+ Right plan ->+ plannedTarballs plan >>= \case+ [(_, found)] -> act found+ other -> expectationFailure (show (map snd other))+ where+ put cabalDir (repo, held, version) = do+ let at =+ cabalDir+ </> "packages"+ </> repo+ </> T.unpack held+ </> T.unpack version+ createDirectoryIfMissing True at+ T.writeFile+ (at </> T.unpack (held <> "-" <> version <> ".tar.gz"))+ "not really a tarball"++-- | A plan naming one package fetched from the repository described.+fromRepository :: Text -> Text+fromRepository repo =+ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\+ \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\+ \\"pkg-src\":{\"type\":\"repo-tar\",\"repo\":"+ <> repo+ <> "}}]}"++-- | The same, as an older @cabal@ wrote it: a tarball and no more.+planWithoutARepository :: Text+planWithoutARepository =+ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\+ \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\+ \\"pkg-src\":{\"type\":\"repo-tar\"}}]}"++-- | A dependency that arrived as a @source-repository-package@.+--+-- @cabal@ clones one into the project's own @dist-newstyle@ and says+-- nothing in the plan about where, so the whole question is whether the+-- clone is found. Once it is, it is a directory of sources like any other+-- and nothing below here is new.+gitDependencies :: Spec+gitDependencies = describe "a dependency that arrived as a git checkout" $ do+ it "finds where cabal unpacked it" $+ withFakeCheckout [("thing-2a9f", "1.0")] $ \dir ->+ sourcesOf dir+ `shouldReturn` [CheckedOut (dir </> "dist-newstyle" </> "src" </> "thing-2a9f")]++ it "leaves one alone that cabal has not unpacked yet" $+ withFakeCheckout [] $+ \dir -> sourcesOf dir `shouldReturn` [SourceRepo]++ it "passes over the clone of a revision that has been moved on from" $+ withFakeCheckout [("thing-0000", "0.9"), ("thing-ffff", "1.0")] $ \dir ->+ sourcesOf dir+ `shouldReturn` [CheckedOut (dir </> "dist-newstyle" </> "src" </> "thing-ffff")]++ it "passes over a directory named for another package" $+ withFakeCheckout [("other-2a9f", "1.0")] $ \dir ->+ sourcesOf dir `shouldReturn` [SourceRepo]++ it "reads a module out of it, fixity and all" $+ withFakeCheckout [("thing-2a9f", "1.0")] $ \dir -> do+ plan <- readBuildPlan (planPathFor dir)+ case plan of+ Left why -> expectationFailure (T.unpack why)+ Right p -> do+ rs <- newResolver p+ askFixities rs "Private.Ops"+ >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity RightAssoc 3)))++-- | What the plan says each of its packages came from.+sourcesOf :: FilePath -> IO [PackageSource]+sourcesOf dir =+ readBuildPlan (planPathFor dir) >>= \case+ Left why -> error (T.unpack why)+ Right plan -> pure (map ppSource (bpPackages plan))++-- | A project whose one dependency is a @source-repository-package@, with+-- the clones given unpacked where @cabal@ unpacks them.+--+-- Each clone is a directory name and the version its @.cabal@ file claims,+-- because telling one clone from another is the whole of the work.+withFakeCheckout :: [(FilePath, Text)] -> (FilePath -> IO a) -> IO a+withFakeCheckout clones act =+ withSystemTempDirectory "tilia-checkout" $ \dir -> do+ createDirectoryIfMissing True (takeDirectory (planPathFor dir))+ T.writeFile (planPathFor dir) fromAGitRepository+ traverse_ (unpack dir) clones+ act dir+ where+ unpack dir (named, version) = do+ let at = dir </> "dist-newstyle" </> "src" </> named+ belongsTo = takeWhile (/= '-') named+ createDirectoryIfMissing True (at </> "src" </> "Private")+ T.writeFile (at </> belongsTo <> ".cabal") (describing (T.pack belongsTo) version)+ T.writeFile (at </> "src" </> "Private" </> "Ops.hs") privateOps+ describing named' version =+ T.unlines+ [ "cabal-version: 2.4",+ "name: " <> named',+ "version: " <> version,+ "library",+ " exposed-modules: Private.Ops",+ " hs-source-dirs: src",+ " default-language: Haskell2010"+ ]++-- | A plan naming one package that came out of a git repository.+fromAGitRepository :: Text+fromAGitRepository =+ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\+ \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\+ \\"pkg-src\":{\"type\":\"source-repo\",\+ \\"source-repo\":{\"type\":\"git\",\"location\":\"git://example/thing\"}}}]}"++-- | A module of that package, declaring something worth resolving.+privateOps :: Text+privateOps =+ T.unlines+ [ "module Private.Ops ((<+>)) where",+ "infixr 3 <+>",+ "(<+>) :: Int -> Int -> Int",+ "a <+> b = a + b"+ ]++-- | The modules @cabal@ writes, which no package carries a file for.+generatedModuleSpec :: Spec+generatedModuleSpec = describe "a module cabal generates" $ do+ it "declares nothing, rather than being one we could not read" $+ withFakeProject [("src/M.hs", "module M where\nimport Paths_fake\n")] $+ \rs -> askFixities rs "Paths_fake" `shouldReturn` Just Map.empty++ it "answers for the newer one cabal writes beside it" $+ withFakeProject [("src/M.hs", "module M where\n")] $+ \rs -> askFixities rs "PackageInfo_fake" `shouldReturn` Just Map.empty++ it "says nothing about a package the plan does not hold" $+ withFakeProject [("src/M.hs", "module M where\n")] $+ \rs -> askFixities rs "Paths_not_a_package" `shouldReturn` Nothing++ it "lets a module that imports one be read"+ $ withFakeProject+ [ ( "src/Facade.hs",+ "module Facade ((<+>)) where\nimport Paths_fake\nimport Inner\n"+ ),+ ("src/Inner.hs", "module Inner ((<+>)) where\ninfixr 5 <+>\na <+> b = a\n")+ ]+ $ \rs ->+ askFixities rs "Facade"+ >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity RightAssoc 5)))++ it "reads one somebody wrote by hand rather than assuming"+ $ withFakeProject+ [ ( "src/Paths_fake.hs",+ "module Paths_fake ((<+>)) where\ninfixr 5 <+>\na <+> b = a\n"+ )+ ]+ $ \rs ->+ askFixities rs "Paths_fake"+ >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity RightAssoc 5)))++-- | A module of the kind @hsc2hs@ takes, declaring an operator nothing can+-- get at.+cursed :: Text+cursed =+ T.unlines+ [ "#include <signal.h>",+ "module Cursed (interrupt, (<+>)) where",+ "infixr 5 <+>",+ "(<+>) :: Int -> Int -> Int",+ "a <+> b = a + b",+ "interrupt :: Int",+ "interrupt = #const SIGINT"+ ]++-- | What @unix@ writes, in miniature: a fixity declaration for a name used+-- in backticks, in a file no reading of ours reaches.+signals :: Text+signals =+ T.unlines+ [ "#include <signal.h>",+ "module System.Posix.Signals (addSignal, deleteSignal) where",+ "infixr `addSignal`, `deleteSignal`",+ "addSignal :: Int -> Int -> Int",+ "addSignal s m = m + #const SIGINT"+ ]++-- | What the chase makes of one module's @<+>@, against a world of modules+-- that disagree about it.+chased :: Text -> IO (Maybe Fixity)+chased source = do+ answer <-+ withReexports (Is #implicitPrelude) reach carries Set.empty "M" (pmModule parsed)+ pure $ case answer of+ Declares fixities -> Map.lookup (InTerms, OpName "<+>") fixities+ Unreadable _ -> Nothing+ where+ carries m =+ pure $ case m of+ "Text.PrettyPrint" ->+ Map.fromList [(OpName "Doc", Set.fromList [OpName "<+>"])]+ _ -> Map.empty+ parsed = case parseModule defaultParserConfig "M.hs" source of+ Left _ -> error "the test input did not parse"+ Right m -> m+ reach m =+ pure $ case m of+ "Control.Arrow" -> Just (Map.fromList [((InTerms, OpName "<+>"), Fixity RightAssoc 5)])+ "Text.PrettyPrint" -> Just (Map.fromList [((InTerms, OpName "<+>"), Fixity LeftAssoc 6)])+ "Prelude" -> Just Map.empty+ _ -> Nothing++withPlan :: BuildPlan -> Spec+withPlan plan = do+ resolver <- runIO (newResolver plan)+ let resolve = askFixities resolver+ exported = askExportNames resolver++ describe "the plan itself" $ do+ it "names the compiler" $+ T.unpack (bpCompiler plan) `shouldSatisfy` isInfixOf "ghc-"++ it "has the dependencies a real project has" $+ length (bpPackages plan) `shouldSatisfy` (> 20)++ it "gives every fetchable package a source hash to check against" $ do+ let fetchable = filter isFetchable (bpPackages plan)+ filter (null . sourceHashOf) fetchable `shouldBe` []++ it "does not mark the project itself as fetchable" $ do+ let locals = filter (\p -> ppName p == "tilia") (bpPackages plan)+ filter isFetchable locals `shouldBe` []++ it "records the project as a local directory, with its path" $ do+ let locals = [s' | p <- bpPackages plan, ppName p == "tilia", let s' = ppSource p]+ locals `shouldSatisfy` all (\s' -> case s' of LocalPackage path -> not (null path); _ -> False)++ it "puts every package in exactly one of the three kinds" $ do+ let kinds p = length (filter id [isPreExisting p, isFetchable p, isLocal p])+ isPreExisting p = ppSource p == PreExisting+ isLocal p = case ppSource p of LocalPackage _ -> True; _ -> False+ filter ((/= 1) . kinds) (bpPackages plan) `shouldBe` []++ describe "resolving a module that declares its own operators" $ do+ it "finds <+> in prettyprinter, with the right fixity" $+ needs resolve "Prettyprinter.Internal" $ \fixities ->+ Map.lookup (InTerms, OpName "<+>") fixities `shouldBe` Just (Fixity RightAssoc 6)++ it "resolves the same module twice to the same answer" $+ needs resolve "Prettyprinter.Internal" $ \first' -> do+ again <- resolve "Prettyprinter.Internal"+ again `shouldBe` Just first'++ describe "re-exports" $+ it "finds an operator a module exports but does not declare" $+ needs resolve "Prettyprinter" $ \fixities ->+ Map.lookup (InTerms, OpName "<+>") fixities `shouldBe` Just (Fixity RightAssoc 6)++ describe "boot packages" $ do+ it "answers for Prelude from the built-in table" $+ needs resolve "Prelude" $ \fixities -> do+ Map.lookup (InTerms, OpName "$") fixities `shouldBe` Just (Fixity RightAssoc 0)+ Map.lookup (InTerms, OpName ">>=") fixities `shouldBe` Just (Fixity LeftAssoc 1)+ Map.lookup (InTerms, OpName ".") fixities `shouldBe` Just (Fixity RightAssoc 9)+ Map.lookup (InTerms, OpName ":") fixities `shouldBe` Just (Fixity RightAssoc 5)++ it "answers for Control.Applicative" $+ needs resolve "Control.Applicative" $ \fixities ->+ Map.lookup (InTerms, OpName "<|>") fixities `shouldBe` Just (Fixity LeftAssoc 3)++ it "covers the containers and text modules a project actually imports" $ do+ let expected =+ [ ("Data.Map", "!", Fixity LeftAssoc 9),+ ("Data.Map", "\\\\", Fixity LeftAssoc 9),+ ("Data.Set", "\\\\", Fixity LeftAssoc 9),+ ("Data.Sequence", "|>", Fixity LeftAssoc 5),+ ("Data.Sequence", "<|", Fixity RightAssoc 5),+ ("Data.Bits", ".&.", Fixity LeftAssoc 7),+ ("Data.Ratio", "%", Fixity LeftAssoc 7),+ ("Data.Functor", "<&>", Fixity LeftAssoc 1),+ ("Control.Monad", ">=>", Fixity RightAssoc 1),+ ("Data.Semigroup", "<>", Fixity RightAssoc 6)+ ]+ wrong <- traverse (check resolve) expected+ concat wrong `shouldBe` []++ it "carries re-exports already resolved" $ do+ p <- resolve "Prelude"+ m <- resolve "Data.Map"+ ( Map.lookup (InTerms, OpName "$") =<< p,+ Map.lookup (InTerms, OpName "!") =<< m+ )+ `shouldBe` (Just (Fixity RightAssoc 0), Just (Fixity LeftAssoc 9))++ it "gives the same operator different fixities in different modules" $ do+ inList <- resolve "Data.List"+ inMap <- resolve "Data.Map"+ ( Map.lookup (InTerms, OpName "\\\\") =<< inList,+ Map.lookup (InTerms, OpName "\\\\") =<< inMap+ )+ `shouldBe` (Just (Fixity NoAssoc 5), Just (Fixity LeftAssoc 9))++ describe "modules it cannot answer for" $ do+ it "says so rather than claiming no operators" $+ resolve "Not.A.Real.Module.At.All" `shouldReturn` Nothing++ it "says so for a module no package exposes" $+ resolve "Some.Package.That.Does.Not.Exist" `shouldReturn` Nothing++ it "distinguishes a boot module with no operators from an unknown one" $ do+ quiet <- resolve "Data.Char"+ quiet `shouldBe` Just Map.empty++ describe "a module that leans on its package's extensions" $ do+ it "reads it, given what the .cabal puts in force" $+ withFakeProject [("fake.cabal", package ["LambdaCase"]), ("src/Fancy.hs", fancy)] $+ \rs ->+ askFixities rs "Fancy"+ >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity RightAssoc 5)))++ it "cannot read it when the .cabal puts nothing in force" $+ withFakeProject [("fake.cabal", package []), ("src/Fancy.hs", fancy)] $+ \rs -> askFixities rs "Fancy" `shouldReturn` Nothing++ it "takes an extension the .cabal turns off into account"+ $ withFakeProject+ [ ("fake.cabal", package ["LambdaCase", "NoLambdaCase"]),+ ("src/Fancy.hs", fancy)+ ]+ $ \rs -> askFixities rs "Fancy" `shouldReturn` Nothing++ describe "modules whose source defeats us" $ do+ it "answers for Test.QuickCheck.Property, which cannot be parsed" $+ needs resolve "Test.QuickCheck.Property" $ \fixities -> do+ Map.lookup (InTerms, OpName "===") fixities `shouldBe` Just (Fixity NoAssoc 4)+ Map.lookup (InTerms, OpName ".&&.") fixities `shouldBe` Just (Fixity RightAssoc 1)+ Map.lookup (InTerms, OpName "==>") fixities `shouldBe` Just (Fixity RightAssoc 0)++ it "carries that through the re-export chain to Test.QuickCheck" $+ needs resolve "Test.QuickCheck" $ \fixities ->+ Map.lookup (InTerms, OpName "===") fixities `shouldBe` Just (Fixity NoAssoc 4)++ describe "a module with more than one configuration" $ do+ -- Built in a temporary directory with a build plan written by hand, so+ -- that the shapes below can be exactly the shapes worth testing. These+ -- are the ones criterion's dependencies turned out to be written in.+ it "answers from the configurations it can read"+ $ withFakeProject+ [ ( "src/Platform.hs",+ T.unlines+ [ "{-# LANGUAGE CPP #-}",+ "module Platform (sort, (<+>)) where",+ "#ifdef WINDOWS",+ "import No.Such.Module.At.All",+ "#endif",+ "import Data.List (sort)",+ "infixl 6 <+>",+ "(<+>) :: Int -> Int -> Int",+ "a <+> b = a + b"+ ]+ )+ ]+ $ \rs ->+ -- The WINDOWS branch imports a module nothing has, which is what+ -- System.IO.CodePage does with System.Win32.CodePage. That branch+ -- is passed over rather than taken as a reason to say nothing.+ askFixities rs "Platform"+ >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity LeftAssoc 6)))++ it "answers from the configurations that are Haskell at all"+ $ withFakeProject+ [ ( "src/Guarded.hs",+ T.unlines+ [ "{-# LANGUAGE CPP #-}",+ "module Guarded ((<+>)) where",+ "infixl 6 <+>",+ "(<+>) :: Int -> Int -> Int",+ "a <+> b = a + b",+ "#ifdef ANCIENT",+ "f x = case",+ "#endif"+ ]+ )+ ]+ $ \rs ->+ askFixities rs "Guarded"+ >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity LeftAssoc 6)))++ it "still refuses when the configurations it can read disagree"+ $ withFakeProject+ [ ( "src/Disagree.hs",+ T.unlines+ [ "{-# LANGUAGE CPP #-}",+ "module Disagree (sort, (<+>)) where",+ "import Data.List (sort)",+ "#ifdef FAST",+ "infixl 6 <+>",+ "#else",+ "infixr 7 <+>",+ "#endif",+ "(<+>) :: Int -> Int -> Int",+ "a <+> b = a + b"+ ]+ )+ ]+ $ \rs -> askFixities rs "Disagree" `shouldReturn` Nothing++ it "says nothing when it can read no configuration at all"+ $ withFakeProject+ [ ( "src/Bothbad.hs",+ T.unlines+ [ "{-# LANGUAGE CPP #-}",+ "module Bothbad (sort) where",+ "#ifdef WINDOWS",+ "import No.Such.One",+ "#else",+ "import No.Such.Two",+ "#endif",+ "import Data.List (sort)"+ ]+ )+ ]+ $ \rs ->+ -- Not @Just mempty@: that would be claiming the module declares+ -- nothing, which is a guess rather than the silence it deserves.+ askFixities rs "Bothbad" `shouldReturn` Nothing++ describe "modules that re-export one another" $+ it "answers for one whose re-exports are mutually entangled" $ do+ answer <- resolve "GHC.Hs"+ answer `shouldSatisfy` (/= Nothing)++ describe "what a package module says it exports" $+ it "names them, read out of the package's own tarball" $+ exported "Prettyprinter" >>= \case+ Nothing -> pendingWith "could not read prettyprinter's source"+ Just names -> names `shouldSatisfy` Set.member (OpName "<+>")++ describe "what a module keeps under each of its names" $ do+ it "reads them out of a package's interface" $ do+ kept <- askChildren resolver "Data.List.NonEmpty"+ Map.lookup (OpName "NonEmpty") kept+ `shouldSatisfy` maybe False (Set.member (OpName ":|"))++ it "has nothing to say about a module it cannot find" $+ askChildren resolver "No.Such.Module" `shouldReturn` Map.empty++ it "reads them out of a local module's source"+ $ withFakeProject+ [("src/Carrier.hs", "module Carrier (T (..)) where\ndata T = A | Int :| Int\n")]+ $ \rs -> do+ kept <- askChildren rs "Carrier"+ Map.lookup (OpName "T") kept+ `shouldBe` Just (Set.fromList [OpName "A", OpName ":|"])++ it "follows a type to the module that declares it"+ $ withFakeProject+ [ ("src/Facade.hs", "module Facade (T (..)) where\nimport Inner\n"),+ ("src/Inner.hs", "module Inner (T (..)) where\ninfixr 5 :|\ndata T = A | Int :| Int\n")+ ]+ $ \rs -> do+ kept <- askChildren rs "Facade"+ Map.lookup (OpName "T") kept+ `shouldBe` Just (Set.fromList [OpName "A", OpName ":|"])++ it "carries the fixity along with it, so the name can be looked up"+ $ withFakeProject+ [ ("src/Facade.hs", "module Facade (T (..)) where\nimport Inner\n"),+ ("src/Inner.hs", "module Inner (T (..)) where\ninfixr 5 :|\ndata T = A | Int :| Int\n")+ ]+ $ \rs -> do+ fixities <- askFixities rs "Facade"+ (Map.lookup (InTerms, OpName ":|") =<< fixities)+ `shouldBe` Just (Fixity RightAssoc 5)++ it "settles an operator that arrives through a façade"+ $ withFakeProject+ [ ("src/Facade.hs", "module Facade (T (..)) where\nimport Inner\n"),+ ("src/Inner.hs", "module Inner (T (..)) where\ninfixr 5 :|\ndata T = A | Int :| Int\n")+ ]+ $ \rs -> do+ let m = parse "module M where\nimport Facade (T (..))\n"+ scope <- scopeFor rs (Is #implicitPrelude) (pmModule m)+ lookupFixity scope InTerms Nothing (OpName ":|")+ `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Facade")++ it "follows a whole module handed on"+ $ withFakeProject+ [ ("src/Facade.hs", "module Facade (module Inner) where\nimport Inner\n"),+ ("src/Inner.hs", "module Inner (T (..)) where\ninfixr 5 :|\ndata T = A | Int :| Int\n")+ ]+ $ \rs -> do+ kept <- askChildren rs "Facade"+ Map.lookup (OpName "T") kept+ `shouldBe` Just (Set.fromList [OpName "A", OpName ":|"])++ it "comes back from two modules that hand each other on"+ $ withFakeProject+ [ ("src/Ping.hs", "module Ping (T (..)) where\nimport Pong\n"),+ ("src/Pong.hs", "module Pong (T (..)) where\nimport Ping\n")+ ]+ $ \rs -> askChildren rs "Ping" `shouldReturn` Map.singleton (OpName "T") Set.empty++ it "keeps to what a local module's export list hands on"+ $ withFakeProject+ [("src/Carrier.hs", "module Carrier (T (A)) where\ndata T = A | Int :| Int\n")]+ $ \rs -> do+ kept <- askChildren rs "Carrier"+ Map.lookup (OpName "T") kept `shouldBe` Just (Set.singleton (OpName "A"))++ describe "what a module says it exports, where its fixities are beyond us" $ do+ it "names them though the module itself went unresolved" $+ withFakeProject [("src/Opaque.hs", opaqueSource)] $+ \rs -> do+ askFixities rs "Opaque" `shouldReturn` Nothing+ askExportNames rs "Opaque"+ `shouldReturn` Just (Set.fromList [OpName "<+>", OpName "f"])++ it "says nothing for a module that hands a whole module on"+ $ withFakeProject+ [ ( "src/Wide.hs",+ T.unlines+ [ "module Wide (module Data.List) where",+ "import Data.List",+ "import No.Such.Module"+ ]+ )+ ]+ $ \rs -> askExportNames rs "Wide" `shouldReturn` Nothing++ it "says nothing for a module it cannot find at all" $+ withFakeProject [("src/Opaque.hs", opaqueSource)] $+ \rs -> askExportNames rs "No.Such.Module" `shouldReturn` Nothing++ it "follows a type it hands on to the module that declares it"+ $ withFakeProject+ [ ("src/Facade.hs", "module Facade (T (..), (<+>)) where\nimport Inner\n"),+ ("src/Inner.hs", "module Inner (T (..)) where\ndata T = A | Int :| Int\n")+ ]+ $ \rs ->+ askExportNames rs "Facade"+ `shouldReturn` Just (Set.fromList [OpName "T", OpName "A", OpName ":|", OpName "<+>"])++ it "follows a whole module it hands on"+ $ withFakeProject+ [ ("src/Facade.hs", "module Facade (module Inner) where\nimport Inner\n"),+ ("src/Inner.hs", "module Inner ((<+>)) where\ninfixl 6 <+>\n(<+>) :: Int -> Int -> Int\na <+> b = a + b\n")+ ]+ $ \rs ->+ askExportNames rs "Facade" `shouldReturn` Just (Set.singleton (OpName "<+>"))++ it "says nothing when what it hands on cannot be read"+ $ withFakeProject+ [("src/Facade.hs", "module Facade (module No.Such.Module) where\nimport No.Such.Module\n")]+ $ \rs -> askExportNames rs "Facade" `shouldReturn` Nothing++ it "says nothing when a type it hands on is beyond us"+ $ withFakeProject+ [("src/Facade.hs", "module Facade (T (..)) where\nimport No.Such.Module\n")]+ $ \rs -> askExportNames rs "Facade" `shouldReturn` Nothing++ it "comes back from two modules that hand each other on"+ $ withFakeProject+ [ ("src/Ping.hs", "module Ping (module Pong) where\nimport Pong\n"),+ ("src/Pong.hs", "module Pong (module Ping) where\nimport Ping\n")+ ]+ $ \rs -> askExportNames rs "Ping" `shouldReturn` Nothing++ it "says nothing for a module whose source will not parse" $+ withFakeProject [("src/Bad.hs", "module Bad ((<+>)) where\nf = (((\n")] $+ \rs -> askExportNames rs "Bad" `shouldReturn` Nothing++ it "takes them from every configuration the preprocessor allows"+ $ withFakeProject+ [ ( "src/Both.hs",+ T.unlines+ [ "{-# LANGUAGE CPP #-}",+ "#ifdef WINDOWS",+ "module Both ((<+>)) where",+ "#else",+ "module Both ((<?>)) where",+ "#endif",+ "import No.Such.Module"+ ]+ )+ ]+ $ \rs ->+ askExportNames rs "Both" `shouldReturn` Just (Set.fromList [OpName "<+>", OpName "<?>"])++ it "says nothing when one configuration hands a whole module on"+ $ withFakeProject+ [ ( "src/Half.hs",+ T.unlines+ [ "{-# LANGUAGE CPP #-}",+ "#ifdef WINDOWS",+ "module Half ((<+>)) where",+ "#else",+ "module Half (module Data.List) where",+ "#endif",+ "import Data.List",+ "import No.Such.Module"+ ]+ )+ ]+ $ \rs -> askExportNames rs "Half" `shouldReturn` Nothing++ it "settles an operator no unread module in scope could have declared" $+ withFakeProject [("src/Opaque.hs", opaqueSource)] $+ \rs -> do+ let m = parse "module M where\nimport Opaque\n"+ scope <- scopeFor rs (Is #implicitPrelude) (pmModule m)+ lookupFixity scope InTerms Nothing (OpName "<??>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "leaves one alone that the unread module's list does name" $+ withFakeProject [("src/Opaque.hs", opaqueSource)] $+ \rs -> do+ let m = parse "module M where\nimport Opaque\n"+ scope <- scopeFor rs (Is #implicitPrelude) (pmModule m)+ lookupFixity scope InTerms Nothing (OpName "<+>")+ `shouldBe` Unresolved (ModuleChain ("Opaque" :| ["No.Such.Module"]) :| [])++ it "names the module that stopped it rather than the import above it" $+ withFakeProject [("src/Opaque.hs", opaqueSource)] $+ \rs -> askChain rs "Opaque" `shouldReturn` ["No.Such.Module"]++ it "follows the reasons down more than one module"+ $ withFakeProject+ [ ("src/Near.hs", "module Near ((<+>)) where\nimport Middle\n"),+ ("src/Middle.hs", "module Middle ((<+>)) where\nimport No.Such.Module\n")+ ]+ $ \rs -> askChain rs "Near" `shouldReturn` ["Middle", "No.Such.Module"]++ it "has nothing to say about a module that could be read" $+ withFakeProject [("src/Opaque.hs", opaqueSource)] $+ \rs -> askChain rs "Prelude" `shouldReturn` []++ describe "the whole pipeline, from source text to a fixity" $ do+ it "resolves an operator through a real import" $+ endToEnd resolver "module M where\nimport Prettyprinter\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName "<+>")+ `shouldBe` Resolved (Fixity RightAssoc 6) (DeclaredIn "Prettyprinter")++ it "prefers the module's own declaration to an imported one" $+ endToEnd resolver "module M where\nimport Prettyprinter\ninfixl 2 <+>\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName "<+>")+ `shouldBe` Resolved (Fixity LeftAssoc 2) DeclaredHere++ it "honours a qualified import" $+ endToEnd resolver "module M where\nimport qualified Prettyprinter as P\n" $ \scope -> do+ lookupFixity scope InTerms (Just "P") (OpName "<+>")+ `shouldBe` Resolved (Fixity RightAssoc 6) (DeclaredIn "Prettyprinter")+ -- Qualified-only, so nothing arrives unqualified.+ lookupFixity scope InTerms Nothing (OpName "<+>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "honours an explicit import list" $+ endToEnd resolver "module M where\nimport Prettyprinter ((<+>))\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName "<+>")+ `shouldBe` Resolved (Fixity RightAssoc 6) (DeclaredIn "Prettyprinter")++ it "honours a hiding list" $+ endToEnd resolver "module M where\nimport Prettyprinter hiding ((<+>))\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName "<+>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "concludes the Report default when everything in scope was read" $+ endToEnd resolver "module M where\nimport Prettyprinter\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName "<!@#>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "refuses to conclude anything when an import could not be read" $+ endToEnd resolver "module M where\nimport No.Such.Module\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName "<!@#>")+ `shouldBe` Unresolved (unreadOnly "No.Such.Module")++ it "still answers for what it did find, despite an unreadable import" $+ endToEnd resolver "module M where\nimport Prettyprinter\nimport No.Such.Module\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName "<+>")+ `shouldBe` Resolved (Fixity RightAssoc 6) (DeclaredIn "Prettyprinter")++ it "concludes the default through a boot import that exports no operators" $+ endToEnd resolver "module M where\nimport Data.Char\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName "<!@#>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "resolves an operator imported from a boot package" $+ endToEnd resolver "module M where\nimport Data.Map\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName "!")+ `shouldBe` Resolved (Fixity LeftAssoc 9) (DeclaredIn "Data.Map")++ it "resolves an operator that arrives under a type's own name" $+ endToEnd resolver "module M where\nimport Data.List.NonEmpty (NonEmpty (..))\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName ":|")+ `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Data.List.NonEmpty")++ it "resolves one written out beside its type" $+ endToEnd resolver "module M where\nimport Data.List.NonEmpty (NonEmpty ((:|)))\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName ":|")+ `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Data.List.NonEmpty")++ it "leaves out an operator no item of the list brings in" $+ endToEnd resolver "module M where\nimport Data.List.NonEmpty (toList)\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName ":|")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "hides one hidden along with its type" $+ endToEnd resolver "module M where\nimport Data.List.NonEmpty hiding (NonEmpty (..))\n" $ \scope ->+ lookupFixity scope InTerms Nothing (OpName ":|")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "brings one in under the qualifier it was imported with" $+ endToEnd resolver "module M where\nimport qualified Data.List.NonEmpty as NE (NonEmpty (..))\n" $ \scope ->+ lookupFixity scope InTerms (Just "NE") (OpName ":|")+ `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Data.List.NonEmpty")++ it "reports no ambiguity for a module that compiles" $+ endToEnd resolver "module M where\nimport Prettyprinter\n" $ \scope ->+ reachAmbiguous (scopeInTerms scope) `shouldBe` []++ describe "readiness" $ do+ it "reports something other than a missing plan for this project" $ do+ readiness <- checkReadiness [] "."+ readiness `shouldNotBe` PlanMissing++ it "reports a missing plan for a directory that has none" $+ checkReadiness [] "/" `shouldReturn` PlanMissing++----------------------------------------------------------------------------+-- Helpers++-- | An empty project directory, holding a plan where @cabal@ writes one if+-- it is to hold a plan at all.+withTempProject :: Maybe Text -> (FilePath -> IO a) -> IO a+withTempProject plan act =+ withSystemTempDirectory "tilia-prepare" $ \dir -> do+ createDirectoryIfMissing True (takeDirectory (planPathFor dir))+ traverse_ (writePlan dir) plan+ act dir++writePlan :: FilePath -> Text -> IO ()+writePlan dir = T.writeFile (planPathFor dir)++-- | A plan naming one package that no package cache can have a tarball+-- for, so that reading it leaves something to fetch.+wantingATarball :: Text+wantingATarball =+ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\+ \[{\"pkg-name\":\"tilia-phantom\",\"pkg-version\":\"9.9.9\",\+ \\"pkg-src\":{\"type\":\"repo-tar\"}}]}"++-- | A plan holding a local package with a library and an executable, and+-- no test suite.+twoComponents :: Text+twoComponents =+ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\+ \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"lib\",\+ \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}},\+ \{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"exe:thing\",\+ \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}}]}"++-- | The same, with a component a solve could go on to add.+threeComponents :: Text+threeComponents =+ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\+ \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"lib\",\+ \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}},\+ \{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"exe:thing\",\+ \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}},\+ \{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"test:tests\",\+ \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}}]}"++-- | Narrow and short at once: two components, neither of them the one a+-- run wants, and a dependency whose tarball is nowhere.+--+-- The shape @servant@ has, where two cookbook executables are named by the+-- project and left out of every plan @cabal@ writes.+narrowAndWanting :: Text+narrowAndWanting =+ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\+ \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"lib\",\+ \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}},\+ \{\"pkg-name\":\"tilia-phantom\",\"pkg-version\":\"9.9.9\",\+ \\"pkg-src\":{\"type\":\"repo-tar\"}}]}"++-- | A package planned whole, as @cabal@ plans one with a @Custom@ build+-- type: no @component-name@, and a @components@ object instead.+plannedWhole :: Text+plannedWhole =+ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\+ \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"type\":\"configured\",\+ \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"},\+ \\"components\":{\"lib\":{},\"test:spec\":{},\"setup\":{}}}]}"++-- | A component of that package, by the name a plan gives it.+component :: Text -> PlanComponent+component = PlanComponent "thing"++-- | Note that @cabal@ was asked for something.+-- | What a solve and a fetch are asked for.+--+-- Both name the test suites and the benchmarks, because both are things a+-- run formats and so things the plan has to reach.+solving, fetching :: [String]+solving = narrowSolve <> wholeProject+fetching = narrowFetch <> wholeProject++-- | The same two, asked only about what @cabal@ builds by default. What is+-- fallen back on where the whole project will not solve.+narrowSolve, narrowFetch :: [String]+narrowSolve = ["build", "all", "--dry-run"]+narrowFetch = ["build", "all", "--only-download"]++wholeProject :: [String]+wholeProject = ["--enable-tests", "--enable-benchmarks"]++record :: IORef [[String]] -> [String] -> IO ()+record steps args = modifyIORef' steps (<> [args])++-- | A @cabal@ that does nothing and says it went well.+obliging :: IORef [[String]] -> [String] -> IO (Either Text ())+obliging steps args = record steps args >> pure (Right ())++-- | Run an assertion on a module's fixities, or mark the test pending if+-- the module could not be resolved at all.+--+-- Pending rather than failing, because an unpopulated package cache is an+-- environment problem and not a defect in the code under test.+needs ::+ (Text -> IO (Maybe (Fixities))) ->+ Text ->+ (Fixities -> Expectation) ->+ Expectation+needs resolve modName assertion =+ resolve modName >>= \case+ Nothing -> pendingWith ("could not resolve " <> T.unpack modName)+ Just fixities -> assertion fixities++-- | Parse a module, resolve its imports for real, and hand over the scope.+endToEnd ::+ Resolver ->+ Text ->+ (Scope -> Expectation) ->+ Expectation+endToEnd resolver source assertion =+ case parseModule defaultParserConfig "test.hs" source of+ Left _ -> expectationFailure "the test input did not parse"+ Right pm -> do+ scope <- scopeFor resolver (Is #implicitPrelude) (pmModule pm)+ assertion scope++-- | Check one expected fixity, returning a description of any mismatch.+check ::+ (Text -> IO (Maybe (Fixities))) ->+ (Text, Text, Fixity) ->+ IO [String]+check resolve (modName, op, expected) = do+ got <- resolve modName+ let actual = Map.lookup (InTerms, OpName op) =<< got+ pure+ [ T.unpack modName+ <> "."+ <> T.unpack op+ <> ": expected "+ <> show expected+ <> " but got "+ <> show actual+ | actual /= Just expected+ ]++-- | A module that needs @LambdaCase@ to parse, and declares a fixity worth+-- finding once it does.+fancy :: Text+fancy =+ T.unlines+ [ "module Fancy where",+ "infixr 5 <+>",+ "(<+>) :: Int -> Int -> Int",+ "a <+> b = a + b",+ "describe :: Int -> Int",+ "describe = \\case",+ " 0 -> 1",+ " _ -> 2"+ ]++-- | A @.cabal@ for the fake project, putting the named extensions in force.+package :: [Text] -> Text+package extensions =+ T.unlines $+ [ "cabal-version: 2.4",+ "name: fake",+ "version: 0.1.0.0",+ "library",+ " exposed-modules: Fancy",+ " hs-source-dirs: src",+ " default-language: Haskell2010"+ ]+ <> [" default-extensions: " <> T.intercalate ", " extensions | not (null extensions)]++-- | A module that is perfectly readable and still cannot be resolved: the+-- operator it exports comes from somewhere nothing can be read from.+opaqueSource :: Text+opaqueSource =+ T.unlines+ [ "module Opaque ((<+>), f) where",+ "import No.Such.Module",+ "f :: Int",+ "f = 1"+ ]++parse :: Text -> ParsedModule+parse source = case parseModule defaultParserConfig "M.hs" source of+ Left _ -> error "the test input did not parse"+ Right pm -> pm++-- | A project of made-up modules, with a build plan written by hand.+--+-- The plan names one local package and nothing else, which is enough for a+-- resolver: local modules are read straight off disk, and everything they+-- import here is either a boot module or does not exist.+withFakeProject :: [(FilePath, Text)] -> (Resolver -> IO a) -> IO a+withFakeProject sources act =+ withFakePlan sources (\plan -> newResolver plan >>= act)++withFakePlan :: [(FilePath, Text)] -> (BuildPlan -> IO a) -> IO a+withFakePlan sources act =+ withSystemTempDirectory "tilia-plan" $ \dir -> do+ createDirectoryIfMissing True (dir </> "src")+ if any ((".cabal" `Data.List.isSuffixOf`) . fst) sources+ then pure ()+ else+ T.writeFile (dir </> "fake.cabal") $+ T.unlines+ [ "cabal-version: 2.4",+ "name: fake",+ "version: 0.1.0.0",+ "library",+ " exposed-modules: " <> T.intercalate ", " (map named (haskellIn sources)),+ " hs-source-dirs: src",+ " default-language: Haskell2010"+ ]+ traverse_ (\(path, text) -> T.writeFile (dir </> path) text) sources+ T.writeFile (dir </> "plan.json") $+ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\+ \[{\"pkg-name\":\"fake\",\"pkg-version\":\"0.1.0.0\",\+ \\"pkg-src\":{\"type\":\"local\",\"path\":\""+ <> T.pack dir+ <> "\"}}]}"+ readBuildPlan (dir </> "plan.json") >>= \case+ Left why -> error (T.unpack why)+ Right plan -> act plan+ where+ haskellIn = filter (isModule . fst)+ isModule path = any (`Data.List.isSuffixOf` path) [".hs", ".hsc"]+ named (path, _) = T.pack (takeBaseName path)++-- | A project whose one dependency is a package off Hackage, with the+-- tarball @cabal@ would have fetched written where it would have put it.+--+-- Nothing here is local: this is the other route to a module, the one that+-- opens an archive. @CABAL_DIR@ says where the package cache is and+-- @XDG_CACHE_HOME@ where what is read gets remembered, so the run reaches+-- the tarball below and no further, and leaves nothing behind.+withFakeArchive :: [(FilePath, Text)] -> (Resolver -> IO a) -> IO a+withFakeArchive sources act =+ withSystemTempDirectory "tilia-archive" $ \dir -> do+ let held = T.unpack (name <> "-" <> version)+ tarball =+ dir+ </> "packages"+ </> "hackage.haskell.org"+ </> T.unpack name+ </> T.unpack version+ </> held+ <> ".tar.gz"+ createDirectoryIfMissing True (takeDirectory tarball)+ writeTarball tarball $+ (held </> T.unpack name <> ".cabal", cabal)+ : [(held </> path, text) | (path, text) <- sources]+ T.writeFile (dir </> "plan.json") plan+ withEnvironment [("CABAL_DIR", dir), ("XDG_CACHE_HOME", dir </> "cache")] $+ readBuildPlan (dir </> "plan.json") >>= \case+ Left why -> error (T.unpack why)+ Right p -> newResolver p >>= act+ where+ name = "tilia-hsc-fixture"+ version = "1.0"+ cabal =+ T.unlines+ [ "cabal-version: 2.4",+ "name: " <> name,+ "version: " <> version,+ "library",+ " exposed-modules: " <> T.intercalate ", " (map moduleIn sources),+ " hs-source-dirs: .",+ " default-language: Haskell2010"+ ]+ moduleIn (path, _) = T.replace "/" "." (T.pack (dropExtension path))+ plan =+ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\+ \[{\"pkg-name\":\""+ <> name+ <> "\",\"pkg-version\":\""+ <> version+ <> "\",\"pkg-src\":{\"type\":\"repo-tar\"}}]}"++-- | Write the named files as a gzipped tarball.+writeTarball :: FilePath -> [(FilePath, Text)] -> IO ()+writeTarball path entries =+ BL.writeFile path . GZip.compress . Tar.write =<< traverse entry entries+ where+ entry (inside, text) = case Tar.toTarPath False inside of+ Left why -> error why+ Right tarPath -> pure (Tar.fileEntry tarPath (BL.fromStrict (T.encodeUtf8 text)))++-- | Run something with the given variables set, and the environment as it+-- was afterwards however it turns out.+withEnvironment :: [(String, String)] -> IO a -> IO a+withEnvironment vars act = bracket set restore (const act)+ where+ set = traverse remember vars+ remember (key, value) = do+ was <- lookupEnv key+ setEnv key value+ pure (key, was)+ restore = traverse_ (\(key, was) -> maybe (unsetEnv key) (setEnv key) was)++-- | The one import blamed for an operator, unread on its own account and so+-- with nothing below it.+unreadOnly :: Text -> NonEmpty ModuleChain+unreadOnly m = ModuleChain (m :| []) :| []++-- | Say why nothing could be tested, once, instead of failing repeatedly.+unavailable :: String -> Spec+unavailable reason =+ it "needs a built project" $ pendingWith reason
+ tests/Tilia/FixitySpec.hs view
@@ -0,0 +1,757 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}++-- | Whether fixities can be resolved exactly from source alone.+module Tilia.FixitySpec (spec) where++import Data.Choice (Choice, pattern Is, pattern Isn't)+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Test.Hspec+import Tilia.Fixity+import Tilia.Parser++spec :: Spec+spec = do+ describe "layer 1: what a module declares" $ do+ it "reads a left-associative declaration" $+ declaredIn "module M where\ninfixl 6 <+>\n"+ `shouldBe` [(OpName "<+>", Fixity LeftAssoc 6)]++ it "reads a right-associative declaration" $+ declaredIn "module M where\ninfixr 5 <>>\n"+ `shouldBe` [(OpName "<>>", Fixity RightAssoc 5)]++ it "reads a non-associative declaration" $+ declaredIn "module M where\ninfix 4 ===\n"+ `shouldBe` [(OpName "===", Fixity NoAssoc 4)]++ it "reads several operators from one declaration" $+ declaredIn "module M where\ninfixl 7 <.>, <:>\n"+ `shouldBe` [(OpName "<.>", Fixity LeftAssoc 7), (OpName "<:>", Fixity LeftAssoc 7)]++ it "reads a backticked function name" $+ declaredIn "module M where\ninfixl 7 `quot`\n"+ `shouldBe` [(OpName "quot", Fixity LeftAssoc 7)]++ it "finds nothing when nothing is declared" $+ declaredIn "module M where\nx = 1\n" `shouldBe` []++ it "reads a declaration that appears after its use" $+ declaredIn "module M where\ny = a <+> b\ninfixl 6 <+>\n"+ `shouldBe` [(OpName "<+>", Fixity LeftAssoc 6)]++ it "reads one a class makes about its own method" $+ declaredIn "module M where\nclass C a where\n infixr 8 .=\n (.=) :: a -> a -> Int\n"+ `shouldBe` [(OpName ".=", Fixity RightAssoc 8)]++ it "reads those at the margin and in a class together" $+ declaredIn "module M where\ninfixl 1 <+>\nclass C a where\n infixr 8 .=\n (.=) :: a -> a -> Int\n"+ `shouldBe` [(OpName ".=", Fixity RightAssoc 8), (OpName "<+>", Fixity LeftAssoc 1)]++ it "leaves a declaration local to a binding where it is" $+ declaredIn "module M where\nf = g\n where\n infixr 3 ###\n g = 1\n"+ `shouldBe` []++ describe "which namespace a declaration governs" $ do+ it "gives a type operator's fixity to types" $+ declaredWithNamespaces "module M where\ninfixr 4 :>\ndata a :> b = Sub a b\n"+ `shouldBe` [((InTypes, OpName ":>"), Fixity RightAssoc 4)]++ it "gives a value operator's fixity to terms" $+ declaredWithNamespaces "module M where\ninfixl 6 <+>\na <+> b = a\n"+ `shouldBe` [((InTerms, OpName "<+>"), Fixity LeftAssoc 6)]++ it "gives a pattern synonym's fixity to terms" $+ declaredWithNamespaces+ "{-# LANGUAGE PatternSynonyms #-}\nmodule M where\ninfixl 5 :>\npattern x :> y = (x, y)\n"+ `shouldBe` [((InTerms, OpName ":>"), Fixity LeftAssoc 5)]++ it "honours a declaration that names the type namespace itself" $+ declaredWithNamespaces "module M where\ninfixr 4 type :>\n"+ `shouldBe` [((InTypes, OpName ":>"), Fixity RightAssoc 4)]++ it "honours one that names the data namespace" $+ declaredWithNamespaces "module M where\ninfixr 4 data :>\n"+ `shouldBe` [((InTerms, OpName ":>"), Fixity RightAssoc 4)]++ it "gives both to a name the module declares in neither" $+ declaredWithNamespaces "module M where\ninfixr 4 <?>\n"+ `shouldBe` [ ((InTypes, OpName "<?>"), Fixity RightAssoc 4),+ ((InTerms, OpName "<?>"), Fixity RightAssoc 4)+ ]++ it "gives both to a name the module declares in both" $+ declaredWithNamespaces "module M where\ninfixr 4 :>\ndata a :> b = a :> b\n"+ `shouldBe` [ ((InTypes, OpName ":>"), Fixity RightAssoc 4),+ ((InTerms, OpName ":>"), Fixity RightAssoc 4)+ ]++ it "gives a class's fixity to types and its method's to terms" $+ declaredWithNamespaces+ "module M where\ninfixl 3 <%>\nclass a <%> b where\n infixl 7 .=\n (.=) :: a -> b -> Int\n"+ `shouldBe` [ ((InTypes, OpName "<%>"), Fixity LeftAssoc 3),+ ((InTerms, OpName ".="), Fixity LeftAssoc 7)+ ]++ describe "one spelling in two namespaces" $ do+ it "settles a type use against the type declaration" $+ lookupFixity (scopeOfBoth "import Types\nimport Terms\n") InTypes Nothing (OpName ":>")+ `shouldBe` Resolved (Fixity RightAssoc 4) (DeclaredIn "Types")++ it "settles a term use against the term declaration" $+ lookupFixity (scopeOfBoth "import Types\nimport Terms\n") InTerms Nothing (OpName ":>")+ `shouldBe` Resolved (Fixity LeftAssoc 5) (DeclaredIn "Terms")++ it "reports no ambiguity between them" $ do+ let scope = scopeOfBoth "import Types\nimport Terms\n"+ reachAmbiguous (scopeInTypes scope) `shouldBe` []+ reachAmbiguous (scopeInTerms scope) `shouldBe` []++ it "still reports one where both are in the same namespace" $+ reachAmbiguous (scopeInTerms (scopeOfBoth "import Terms\nimport Other.Terms\n"))+ `shouldBe` [(Nothing, OpName ":>")]++ it "takes a promoted constructor's fixity from the terms" $+ lookupFixity (scopeOfBoth "import Terms\n") InTypes Nothing (OpName ":>")+ `shouldBe` Resolved (Fixity LeftAssoc 5) (DeclaredIn "Terms")++ it "does not take a type's fixity for a term" $+ lookupFixity (scopeOfBoth "import Types\n") InTerms Nothing (OpName ":>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "prefers the type it finds to the term it could fall back on" $+ lookupFixity (scopeOfBoth "import Types\nimport Terms\n") InTypes Nothing (OpName ":>")+ `shouldBe` Resolved (Fixity RightAssoc 4) (DeclaredIn "Types")++ it "lets a module that writes the type be formatted" $+ unsettledIn "module M where\nimport Types\nimport Terms\ntype T = Int :> Int\n"+ `shouldBe` []++ it "declines one that writes an operator both agree to disagree about" $+ map snd (unsettledIn "module M where\nimport Terms\nimport Other.Terms\nf a b = a :> b\n")+ `shouldBe` [Ambiguous]++ describe "what a module says it exports" $ do+ it "has nothing to say about a module with no export list" $+ exportsOfSource "module M where\nf = 1\n" `shouldBe` Nothing++ it "keeps the qualifier a name was written under" $+ exportsOfSource "module M ((Disp.<+>)) where\n"+ `shouldBe` Just [ExportName (Just "Disp") (OpName "<+>")]++ it "has none for a name written plainly" $+ exportsOfSource "module M ((<+>)) where\n"+ `shouldBe` Just [ExportName Nothing (OpName "<+>")]++ it "reads a whole module passed on as the module it names" $+ exportsOfSource "module M (module Data.Map) where\n"+ `shouldBe` Just [ExportModule "Data.Map"]++ describe "the operators an export list names" $ do+ it "takes them from an explicit list" $+ exportedIn "module M ((<+>), (<?>), f) where\n"+ `shouldBe` Just [OpName "<+>", OpName "<?>", OpName "f"]++ it "takes the members of a class the module declares itself" $+ exportedIn+ "module M (C (..)) where\nclass C a where\n infixr 8 .=\n (.=) :: a -> a -> Int\n"+ `shouldBe` Just [OpName ".=", OpName "C"]++ it "takes the constructors of a type the module declares itself" $+ exportedIn "module M (T (..)) where\ndata T = A | Int :| Int\n"+ `shouldBe` Just [OpName ":|", OpName "A", OpName "T"]++ it "knows nothing of a type the module only passes on" $+ exportedIn "module M (C (..)) where\nimport Elsewhere\n" `shouldBe` Nothing++ it "knows nothing of a module that hands a whole module on" $+ exportedIn "module M ((<+>), module Data.Map) where\n" `shouldBe` Nothing++ it "takes what a module with no export list declares" $+ exportedIn "module M where\ninfixr 5 <+>\ninfixl 6 <?>\n"+ `shouldBe` Just [OpName "<+>", OpName "<?>"]++ it "finds nothing in a module with no list and no declarations" $+ exportedIn "module M where\nf = 1\n" `shouldBe` Just []++ describe "which unread module an unsettled operator is blamed on" $ do+ it "passes over one whose export list has no such operator" $+ lookupFixity (scopeKnowing [("Opaque", ["<+>"])] usesUnknown) InTerms Nothing (OpName "<??>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "blames one whose export list names it" $+ lookupFixity (scopeKnowing [("Opaque", ["<??>"])] usesUnknown) InTerms Nothing (OpName "<??>")+ `shouldBe` Unresolved (unreadOnly "Opaque")++ it "blames one that will not say what it exports" $+ lookupFixity (scopeKnowing [] usesUnknown) InTerms Nothing (OpName "<??>")+ `shouldBe` Unresolved (unreadOnly "Opaque")++ it "still passes over an import list that does not name it" $+ lookupFixity+ (scopeKnowing [("Opaque", ["<??>"])] "module M where\nimport Opaque ((<+>))\n")+ InTerms+ Nothing+ (OpName "<??>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "blames only the ones that could supply it, of several unread" $+ lookupFixity+ (scopeKnowing [("Opaque", ["<+>"]), ("Other.Opaque", ["<??>"])] twoUnread)+ InTerms+ Nothing+ (OpName "<??>")+ `shouldBe` Unresolved (unreadOnly "Other.Opaque")++ it "settles nothing on its own account when told nothing" $+ lookupFixity (fullScope usesUnknown) InTerms Nothing (OpName "<??>")+ `shouldBe` Unresolved (unreadOnly "Opaque")++ it "passes over one whose import list carries no such operator" $+ lookupFixity+ (scopeSuspecting [("Opaque", [("T", ["<+>"])])] "import Opaque (T (..))\n")+ InTerms+ Nothing+ (OpName "<??>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "blames one whose import list carries it" $+ lookupFixity+ (scopeSuspecting [("Opaque", [("T", ["<??>"])])] "import Opaque (T (..))\n")+ InTerms+ Nothing+ (OpName "<??>")+ `shouldBe` Unresolved (unreadOnly "Opaque")++ it "blames one whose (..) nothing is known about" $+ lookupFixity+ (scopeSuspecting [] "import Opaque (T (..))\n")+ InTerms+ Nothing+ (OpName "<??>")+ `shouldBe` Unresolved (unreadOnly "Opaque")++ it "passes over one that hides the operator along with its type" $+ lookupFixity+ (scopeSuspecting [("Opaque", [("T", ["<??>"])])] "import Opaque hiding (T (..))\n")+ InTerms+ Nothing+ (OpName "<??>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "lets a file be formatted when no unread module could have declared it" $+ unknownOperators+ (scopeKnowing [("Opaque", ["<+>"])] usesUnknown)+ (pmModule (parsed usesUnknown))+ `shouldBe` []++ describe "what a name carries with it" $ do+ it "takes a type's constructors" $+ childrenIn "module M where\ndata T = A | Int :| Int\n"+ `shouldBe` [(OpName "T", [OpName ":|", OpName "A"])]++ it "takes a record's fields, which may be operators" $+ childrenIn "module M where\ndata T = T {(#) :: Int, name :: Int}\n"+ `shouldBe` [(OpName "T", [OpName "#", OpName "T", OpName "name"])]++ it "takes a GADT's constructors" $+ childrenIn "module M where\ndata T where\n A :: T\n (:|) :: T -> T\n"+ `shouldBe` [(OpName "T", [OpName ":|", OpName "A"])]++ it "takes a class's methods" $+ childrenIn "module M where\nclass C a where\n (.=) :: a -> a -> Int\n named :: a\n"+ `shouldBe` [(OpName "C", [OpName ".=", OpName "named"])]++ it "takes a class's associated families" $+ childrenIn "module M where\nclass C a where\n type F a\n"+ `shouldBe` [(OpName "C", [OpName "F"])]++ it "has nothing to say about a type synonym" $+ childrenIn "module M where\ntype T = Int\n" `shouldBe` []++ it "keeps to what an export list hands on" $+ exportedChildrenIn "module M (T (A)) where\ndata T = A | Int :| Int\n"+ `shouldBe` [(OpName "T", [OpName "A"])]++ it "hands on everything under a name exported with (..)" $+ exportedChildrenIn "module M (T (..)) where\ndata T = A | Int :| Int\n"+ `shouldBe` [(OpName "T", [OpName ":|", OpName "A"])]++ it "hands on nothing under a type it does not declare" $+ exportedChildrenIn "module M (T (..)) where\nimport Elsewhere\n"+ `shouldBe` [(OpName "T", [])]++ describe "layer 2: imports" $ do+ it "brings in an operator a type carries" $+ lookupFixity (scopeCarrying "import Carrier (T (..))\n") InTerms Nothing (OpName ":|")+ `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Carrier")++ it "leaves out an operator the type does not carry" $+ lookupFixity (scopeCarrying "import Carrier (T (..))\n") InTerms Nothing (OpName "<+>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "hides an operator hidden along with its type" $+ lookupFixity (scopeCarrying "import Carrier hiding (T (..))\n") InTerms Nothing (OpName ":|")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "keeps what a hiding list leaves alone" $+ lookupFixity (scopeCarrying "import Carrier hiding (T (..))\n") InTerms Nothing (OpName "<+>")+ `shouldBe` Resolved (Fixity LeftAssoc 6) (DeclaredIn "Carrier")++ it "brings in one a T(..) may carry, where nothing is known" $+ lookupFixity+ (fullScope "module M where\nimport Carrier (T (..))\n")+ InTerms+ Nothing+ (OpName ":|")+ `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Carrier")++ it "leaves out one no item of that list could carry" $+ lookupFixity+ (fullScope "module M where\nimport Carrier (f)\n")+ InTerms+ Nothing+ (OpName ":|")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "keeps one a hiding T(..) cannot be shown to have hidden" $+ lookupFixity+ (fullScope "module M where\nimport Carrier hiding (T (..))\n")+ InTerms+ Nothing+ (OpName ":|")+ `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Carrier")++ it "brings it in under a qualifier too" $+ lookupFixity+ (scopeCarrying "import qualified Carrier as C (T (..))\n")+ InTerms+ (Just "C")+ (OpName ":|")+ `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Carrier")++ it "sees an unqualified import in both scopes" $+ scopeOf "module M where\nimport Data.Map\n"+ `shouldBe` ( [(OpName "!", Fixity LeftAssoc 9)],+ [(("Data.Map", OpName "!"), Fixity LeftAssoc 9)],+ []+ )++ it "does not bring a qualified import into unqualified scope" $+ scopeOf "module M where\nimport qualified Data.Map\n"+ `shouldBe` ([], [(("Data.Map", OpName "!"), Fixity LeftAssoc 9)], [])++ it "makes an alias the qualifier" $+ scopeOf "module M where\nimport qualified Data.Map as M\n"+ `shouldBe` ([], [(("M", OpName "!"), Fixity LeftAssoc 9)], [])++ it "keeps unqualified names when an alias is not qualified" $+ scopeOf "module M where\nimport Data.Map as M\n"+ `shouldBe` ( [(OpName "!", Fixity LeftAssoc 9)],+ [(("M", OpName "!"), Fixity LeftAssoc 9)],+ []+ )++ it "honours an explicit import list" $+ scopeOf "module M where\nimport Data.Sequence ((|>))\n"+ `shouldBe` ( [(OpName "|>", Fixity LeftAssoc 5)],+ [(("Data.Sequence", OpName "|>"), Fixity LeftAssoc 5)],+ []+ )++ it "honours a hiding list" $+ scopeOf "module M where\nimport Data.Sequence hiding ((|>))\n"+ `shouldBe` ( [(OpName "<|", Fixity RightAssoc 5)],+ [(("Data.Sequence", OpName "<|"), Fixity RightAssoc 5)],+ []+ )++ it "lets the module's own declaration win over an import" $+ let (unq, _, _) = scopeOf "module M where\nimport Data.Map\ninfixr 3 !\n"+ in unq `shouldBe` [(OpName "!", Fixity RightAssoc 3)]++ describe "ambiguity" $ do+ it "reports an operator imported with two different fixities" $+ let (_, _, amb) = scopeOf "module M where\nimport Data.Map\nimport Other\n"+ in amb `shouldBe` [(Nothing, OpName "!")]++ it "reports nothing when two imports agree" $+ let (_, _, amb) = scopeOf "module M where\nimport Data.Map\nimport Agreeing\n"+ in amb `shouldBe` []++ it "reports nothing when the two go under different names" $+ let (_, _, amb) =+ scopeOf "module M where\nimport Data.Map\nimport qualified Other\n"+ in amb `shouldBe` []++ it "reports an alias two imports disagree under" $+ let (_, _, amb) =+ scopeOf+ "module M where\nimport qualified Data.Map as M\nimport qualified Other as M\n"+ in amb `shouldBe` [(Just "M", OpName "!")]++ it "reports nothing when two imports under one alias agree" $+ let (_, _, amb) =+ scopeOf+ "module M where\nimport qualified Data.Map as M\nimport qualified Agreeing as M\n"+ in amb `shouldBe` []++ it "counts an unqualified import towards the name it goes under" $+ let (_, _, amb) =+ scopeOf+ "module M where\nimport Data.Map\nimport qualified Other as Data.Map\n"+ in amb `shouldBe` [(Just "Data.Map", OpName "!")]++ it "keeps a clashing alias apart from a clashing bare name" $+ let (_, _, amb) =+ scopeOf+ "module M where\nimport Data.Map\nimport Other\nimport qualified Data.Map as M\nimport qualified Other as M\n"+ in amb `shouldBe` [(Nothing, OpName "!"), (Just "M", OpName "!")]++ describe "a module compiled with NoImplicitPrelude" $ do+ it "settles an operator on the one module that is really in scope" $+ let s =+ scopeAboutPrelude (Isn't #implicitPrelude) takesItsPreludeElsewhere+ in lookupFixity s InTerms Nothing (OpName "<%>")+ `shouldBe` Resolved (Fixity LeftAssoc 6) (DeclaredIn "Pretty")++ it "is left with nothing unsettled" $+ unsettledAboutPrelude (Isn't #implicitPrelude) usingItBothWays+ `shouldBe` []++ it "would be caught between two spellings were the Prelude assumed" $+ map snd (unsettledAboutPrelude (Is #implicitPrelude) usingItBothWays)+ `shouldBe` [Ambiguous]++ it "still takes the Prelude where the module does import it" $+ let s =+ scopeAboutPrelude+ (Isn't #implicitPrelude)+ "module M where\nimport Prelude\n"+ in lookupFixity s InTerms Nothing (OpName "<%>")+ `shouldBe` Resolved (Fixity RightAssoc 6) (DeclaredIn "Prelude")++ describe "lookupFixity" $ do+ it "finds an unqualified operator" $+ let s = fullScope "module M where\nimport Data.Map\n"+ in lookupFixity s InTerms Nothing (OpName "!")+ `shouldBe` Resolved (Fixity LeftAssoc 9) (DeclaredIn "Data.Map")++ it "finds a qualified operator through its alias" $+ let s = fullScope "module M where\nimport qualified Data.Map as M\n"+ in lookupFixity s InTerms (Just "M") (OpName "!")+ `shouldBe` Resolved (Fixity LeftAssoc 9) (DeclaredIn "Data.Map")++ it "concludes infixl 9 when every module in scope was read" $+ let s = fullScope "module M where\nimport Data.Map\n"+ in lookupFixity s InTerms Nothing (OpName "<??>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "refuses to conclude anything when a module could not be read" $+ let s = fullScope "module M where\nimport Data.Map\nimport Opaque\n"+ in lookupFixity s InTerms Nothing (OpName "<??>")+ `shouldBe` Unresolved (unreadOnly "Opaque")++ it "still answers for an operator it did find, despite an unread module" $+ let s = fullScope "module M where\nimport Data.Map\nimport Opaque\n"+ in lookupFixity s InTerms Nothing (OpName "!")+ `shouldBe` Resolved (Fixity LeftAssoc 9) (DeclaredIn "Data.Map")++ it "attributes the module\'s own declaration to itself" $+ let s = fullScope "module M where\ninfixr 3 <+>\n"+ in lookupFixity s InTerms Nothing (OpName "<+>")+ `shouldBe` Resolved (Fixity RightAssoc 3) DeclaredHere++ it "does not find a qualified-only operator unqualified" $+ let s = fullScope "module M where\nimport qualified Data.Map\n"+ in lookupFixity s InTerms Nothing (OpName "!")+ `shouldBe` Resolved defaultFixity ReportDefault++ describe "a qualified use is answered from qualified scope alone" $ do+ it "does not answer a qualifier that brought nothing in from what did" $+ let s = fullScope "module M where\nimport Data.Map\n"+ in lookupFixity s InTerms (Just "Q") (OpName "!")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "does not lend the module's own declaration to a foreign qualifier" $+ let s = fullScope "module M where\ninfixr 3 <+>\n"+ in lookupFixity s InTerms (Just "Q") (OpName "<+>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "does not answer through an alias the import does not go under" $+ let s = fullScope "module M where\nimport qualified Data.Map as M\n"+ in lookupFixity s InTerms (Just "Data.Map") (OpName "!")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "answers a use qualified by the module's own name" $+ let s = fullScope "module M where\ninfixr 3 <+>\n"+ in lookupFixity s InTerms (Just "M") (OpName "<+>")+ `shouldBe` Resolved (Fixity RightAssoc 3) DeclaredHere++ it "answers a plain import under the module's own name" $+ let s = fullScope "module M where\nimport Data.Map\n"+ in lookupFixity s InTerms (Just "Data.Map") (OpName "!")+ `shouldBe` Resolved (Fixity LeftAssoc 9) (DeclaredIn "Data.Map")++ it "weighs only the unread imports the qualifier reaches" $+ let s = fullScope "module M where\nimport qualified Data.Map as M\nimport Opaque\n"+ in lookupFixity s InTerms (Just "M") (OpName "<??>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "refuses to conclude when the qualifier reaches an unread import" $+ let s = fullScope "module M where\nimport qualified Opaque as O\n"+ in lookupFixity s InTerms (Just "O") (OpName "<??>")+ `shouldBe` Unresolved (unreadOnly "Opaque")++ describe "what could not be settled" $ do+ it "says which qualifier the unsettled use was written under" $+ unsettledIn "module M where\nimport qualified Opaque as O\nf a b = a O.<+> b\n"+ `shouldBe` [((Just "O", OpName "<+>"), NotRead (unreadOnly "Opaque"))]++ it "keeps a qualified use apart from an unqualified one" $+ unsettledIn+ "module M where\nimport Opaque\nimport qualified Opaque as O\nf a b = a <+> b\ng a b = a O.<+> b\n"+ `shouldBe` [ ((Nothing, OpName "<+>"), NotRead (unreadOnly "Opaque")),+ ((Just "O", OpName "<+>"), NotRead (unreadOnly "Opaque"))+ ]++ it "leaves a settled qualified use out, unread imports notwithstanding" $+ unsettledIn "module M where\nimport qualified Data.Map as M\nimport Opaque\nf m = m M.! 1\n"+ `shouldBe` []++ it "holds an ambiguous operator against its unqualified use only" $+ unsettledIn+ "module M where\nimport Data.Map\nimport Other\nimport qualified Data.Map as M\nf a b = (a ! b, a M.! b)\n"+ `shouldBe` [((Nothing, OpName "!"), Ambiguous)]++ it "holds a clashing alias against the use written under it" $+ unsettledIn+ "module M where\nimport qualified Data.Map as M\nimport qualified Other as M\nf a b = a M.! b\n"+ `shouldBe` [((Just "M", OpName "!"), Ambiguous)]++ it "leaves the bare operator alone when only an alias is in doubt" $+ unsettledIn+ "module M where\nimport Data.Map\nimport qualified Data.Map as M\nimport qualified Other as M\nf a b = (a ! b, a M.! b)\n"+ `shouldBe` [((Just "M", OpName "!"), Ambiguous)]++ it "spells a use the way the module wrote it" $+ map (uncurry operatorSpelling . fst) (unsettledIn "module M where\nimport qualified Opaque as O\nf a b = a O.<+> b\n")+ `shouldBe` ["O.<+>"]++ describe "parsing with the module's own pragmas"+ $ it "parses a module that needs an extension it declares"+ $ declaredIn "{-# LANGUAGE MagicHash #-}\nmodule M where\ninfixl 6 <+>\n"+ `shouldBe` [(OpName "<+>", Fixity LeftAssoc 6)]++----------------------------------------------------------------------------+-- Helpers++-- | Stand-in for layer 3. The real one reads a build plan, maps modules to+-- packages and parses their sources; what it returns is exactly this shape,+-- so everything above it can be exercised without any of that.+exportsOf :: Text -> Maybe Fixities+exportsOf = \case+ "Data.Map" -> whichever [(OpName "!", Fixity LeftAssoc 9)]+ "Data.Sequence" ->+ whichever+ [ (OpName "|>", Fixity LeftAssoc 5),+ (OpName "<|", Fixity RightAssoc 5)+ ]+ "Other" -> whichever [(OpName "!", Fixity RightAssoc 4)]+ "Agreeing" -> whichever [(OpName "!", Fixity LeftAssoc 9)]+ "Carrier" ->+ whichever+ [ (OpName ":|", Fixity RightAssoc 5),+ (OpName "<+>", Fixity LeftAssoc 6)+ ]+ -- Spell @:>@ in different namespaces, as servant and text do.+ "Types" -> Just (Map.fromList [((InTypes, OpName ":>"), Fixity RightAssoc 4)])+ "Terms" -> Just (Map.fromList [((InTerms, OpName ":>"), Fixity LeftAssoc 5)])+ "Other.Terms" -> Just (Map.fromList [((InTerms, OpName ":>"), Fixity RightAssoc 9)])+ "Opaque" -> Nothing+ "Other.Opaque" -> Nothing+ _ -> Just Map.empty+ where+ whichever = Just . inBothNamespaces . Map.fromList++parsed :: Text -> ParsedModule+parsed src = case parseModule defaultParserConfig "test.hs" src of+ Left _ -> error "the test input did not parse"+ Right pm -> pm++-- | The fixities a module declares, by name alone.+--+-- One entry per operator: a fixity that governs both namespaces is one+-- declaration, however many places it lands in.+declaredIn :: Text -> [(OpName, Fixity)]+declaredIn =+ Map.toList . Map.fromList . map (\((_, op), fixity) -> (op, fixity)) . declaredWithNamespaces++-- | The same, keeping the namespace each governs.+declaredWithNamespaces :: Text -> [((Namespace, OpName), Fixity)]+declaredWithNamespaces = Map.toList . declaredFixities . pmModule . parsed++exportsOfSource :: Text -> Maybe [ExportItem]+exportsOfSource = moduleExports . pmModule . parsed++-- | A scope knowing what every module it can read exports, and nothing+-- about the ones it cannot.+fullScope :: Text -> Scope+fullScope =+ resolveScope (Is #implicitPrelude) knowingExports . pmModule . parsed++-- | What is known in a world made of 'exportsOf' alone.+knowingExports :: Known+knowingExports = nothingKnown {knownFixities = exportsOf}++-- | The one import blamed for an operator, unread on its own account and so+-- with nothing below it. What every answer here was before a chain could be+-- reported at all.+unreadOnly :: Text -> NonEmpty ModuleChain+unreadOnly m = ModuleChain (m :| []) :| []++-- | A module that uses an operator nothing in scope declares, alongside an+-- import that could not be read.+usesUnknown :: Text+usesUnknown = "module M where\nimport Opaque\nf a b = a <??> b\n"++-- | The same, with a second unread import to tell apart from the first.+twoUnread :: Text+twoUnread = "module M where\nimport Opaque\nimport Other.Opaque\nf a b = a <??> b\n"++-- | A scope in which the unread modules listed say what they export.+--+-- A module absent from the list says nothing, which is what 'fullScope'+-- assumes of every one of them.+scopeKnowing :: [(Text, [Text])] -> Text -> Scope+scopeKnowing said =+ resolveScope+ (Is #implicitPrelude)+ knowingExports {knownExportNames = exportNamesOf}+ . pmModule+ . parsed+ where+ exportNamesOf m = Set.fromList . map OpName <$> lookup m said++-- | What each name a module declares carries with it, in a settled order.+childrenIn :: Text -> [(OpName, [OpName])]+childrenIn = settled . declaredChildren . pmModule . parsed++-- | The same, as the module's export list hands them on.+exportedChildrenIn :: Text -> [(OpName, [OpName])]+exportedChildrenIn = settled . moduleChildren . pmModule . parsed++settled :: Map.Map OpName (Set.Set OpName) -> [(OpName, [OpName])]+settled = map (fmap Set.toList) . Map.toList++-- | A scope over a world where Carrier keeps @:|@ under @T@.+--+-- Carrier declares @<+>@ as well, under nothing, so that a list naming+-- @T(..)@ can be seen to bring the one in and leave the other out.+scopeCarrying :: Text -> Scope+scopeCarrying source =+ resolveScope+ (Is #implicitPrelude)+ knowingExports {knownChildren = childrenOf}+ (pmModule (parsed ("module M where\n" <> source)))+ where+ childrenOf = \case+ "Carrier" -> Map.fromList [(OpName "T", Set.fromList [OpName ":|"])]+ _ -> Map.empty++-- | A scope over the two modules that spell @:>@ in different namespaces.+scopeOfBoth :: Text -> Scope+scopeOfBoth source =+ resolveScope+ (Is #implicitPrelude)+ knowingExports+ (pmModule (parsed ("module M where\n" <> source)))++-- | A scope over an unread module, told what it keeps under its names.+--+-- Opaque cannot be read for fixities and says nothing about what it+-- exports, so what the import list brings in is all there is to go on.+scopeSuspecting :: [(Text, [(Text, [Text])])] -> Text -> Scope+scopeSuspecting carries source =+ resolveScope+ (Is #implicitPrelude)+ knowingExports {knownChildren = childrenOf}+ (pmModule (parsed ("module M where\n" <> source <> "f a b = a <??> b\n")))+ where+ childrenOf m =+ Map.fromList+ [ (OpName parent, Set.fromList (map OpName kids))+ | (parent, kids) <- Map.findWithDefault [] m (Map.fromList carries)+ ]++-- | The operators a module's export list names, in a settled order.+exportedIn :: Text -> Maybe [OpName]+exportedIn = fmap Set.toList . exportedOperators . pmModule . parsed++-- | The uses of an operator a module makes that its scope cannot settle.+unsettledIn :: Text -> [((Maybe Text, OpName), Unknown)]+unsettledIn src =+ let hsModule = pmModule (parsed src)+ in unknownOperators+ (resolveScope (Is #implicitPrelude) knowingExports hsModule)+ hsModule++-- | A module that takes its Prelude from elsewhere and hides an operator+-- from it, in order to take that operator from a module which spells it the+-- other way round.+takesItsPreludeElsewhere :: Text+takesItsPreludeElsewhere =+ "module M where\nimport Prelude.Compat hiding ((<%>))\nimport Pretty\n"++-- | The same, going on to use the operator it took.+usingItBothWays :: Text+usingItBothWays = takesItsPreludeElsewhere <> "f a b = a <%> b\n"++-- | A world in which the Prelude and a pretty-printer spell one operator+-- the two different ways, as @base@ and @pretty@ really do for @<>@.+--+-- Kept out of 'exportsOf' so that a Prelude which declares something does+-- not have to be reckoned with by every other test in the file.+disagreeingAboutPrelude :: Known+disagreeingAboutPrelude = nothingKnown {knownFixities = said}+ where+ said = \case+ "Prelude" -> whichever [(OpName "<%>", Fixity RightAssoc 6)]+ "Pretty" -> whichever [(OpName "<%>", Fixity LeftAssoc 6)]+ _ -> Just Map.empty+ whichever = Just . inBothNamespaces . Map.fromList++-- | That world's scope for a module, told whether it has the Prelude.+scopeAboutPrelude :: Choice "implicitPrelude" -> Text -> Scope+scopeAboutPrelude implicitPrelude =+ resolveScope implicitPrelude disagreeingAboutPrelude . pmModule . parsed++-- | What that world leaves unsettled in a module.+unsettledAboutPrelude ::+ Choice "implicitPrelude" ->+ Text ->+ [((Maybe Text, OpName), Unknown)]+unsettledAboutPrelude implicitPrelude src =+ let hsModule = pmModule (parsed src)+ in unknownOperators+ (resolveScope implicitPrelude disagreeingAboutPrelude hsModule)+ hsModule++scopeOf ::+ Text ->+ ( [(OpName, Fixity)],+ [((Text, OpName), Fixity)],+ [(Maybe Text, OpName)]+ )+scopeOf src =+ let reach = scopeInTerms (fullScope src)+ in ( Map.toList (Map.map fst (reachUnqualified reach)),+ Map.toList (Map.map fst (reachQualified reach)),+ reachAmbiguous reach+ )
+ tests/Tilia/Gen.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Generators for documents and spans.+module Tilia.Gen+ ( AnyDoc (..),+ PlainDoc (..),+ FlatSafeDoc (..),+ AnySpan (..),+ SingleLineSpan (..),+ MultiLineSpan (..),+ docTexts,+ )+where++import Data.Text (Text)+import Data.Text qualified as T+import Test.QuickCheck+import Tilia.Doc.Internal+import Tilia.Span++----------------------------------------------------------------------------+-- Spans++-- | An arbitrary span.+newtype AnySpan = AnySpan Span+ deriving (Eq, Show)++instance Arbitrary AnySpan where+ arbitrary = AnySpan <$> genSpan+ shrink (AnySpan s) = AnySpan <$> shrinkSpan s++-- | A span that occupied one line.+newtype SingleLineSpan = SingleLineSpan Span+ deriving (Eq, Show)++instance Arbitrary SingleLineSpan where+ arbitrary = do+ l <- choose (1, 20)+ c0 <- choose (1, 40)+ c1 <- choose (c0, 80)+ pure (SingleLineSpan (mkSpan (l, c0) (l, c1)))++-- | A span that ran across several lines.+newtype MultiLineSpan = MultiLineSpan Span+ deriving (Eq, Show)++instance Arbitrary MultiLineSpan where+ arbitrary = do+ l0 <- choose (1, 20)+ n <- choose (1, 5)+ c0 <- choose (1, 40)+ c1 <- choose (1, 80)+ pure (MultiLineSpan (mkSpan (l0, c0) (l0 + n, c1)))++genSpan :: Gen Span+genSpan = do+ l0 <- choose (1, 20)+ n <- choose (0, 5)+ c0 <- choose (1, 40)+ c1 <- choose (1, 80)+ pure (mkSpan (l0, c0) (l0 + n, c1))++shrinkSpan :: Span -> [Span]+shrinkSpan s =+ [ mkSpan (spanStartLine s, spanStartColumn s) (spanStartLine s, spanEndColumn s)+ | spanStartLine s /= spanEndLine s+ ]++----------------------------------------------------------------------------+-- Documents++-- | Text for a 'DText' node.+genText :: Gen Text+genText = T.pack <$> resize 4 (listOf1 (elements "abcxyz(),;"))++-- | Any document at all.+newtype AnyDoc = AnyDoc Doc+ deriving (Eq, Show)++instance Arbitrary AnyDoc where+ arbitrary = AnyDoc <$> sized (genDoc True True)+ shrink (AnyDoc d) = AnyDoc <$> shrinkDoc d++-- | A document with no 'DVariant'.+newtype PlainDoc = PlainDoc Doc+ deriving (Eq, Show)++instance Arbitrary PlainDoc where+ arbitrary = PlainDoc <$> sized (genDoc False True)+ shrink (PlainDoc d) = PlainDoc <$> shrinkDoc d++-- | A document that cannot break on its own.+newtype FlatSafeDoc = FlatSafeDoc Doc+ deriving (Eq, Show)++instance Arbitrary FlatSafeDoc where+ arbitrary = FlatSafeDoc <$> sized (genDoc False False)+ shrink (FlatSafeDoc d) = FlatSafeDoc <$> shrinkDoc d++-- | Build a document.+genDoc ::+ -- | Whether 'DVariant' may appear+ Bool ->+ -- | Whether things that force a break may appear+ Bool ->+ -- | The size parameter+ Int ->+ Gen Doc+genDoc withVariant withBreaks = go+ where+ go n+ | n <= 1 = leaf+ | otherwise = oneof (leaf : branches)+ where+ half = n `div` 2+ branches =+ [ DCat <$> go half <*> go half,+ DNest <$> choose (0, 2) <*> go (n - 1),+ DAlign <$> go (n - 1),+ DLocated <$> genSpan <*> go (n - 1),+ DFence <$> genSpan <*> go (n - 1)+ ]+ <> [ DGroup <$> elements [Flat, Broken] <*> go (n - 1)+ | withBreaks+ ]+ <> [ DVariant <$> go half <*> go half+ | withVariant+ ]+ leaf =+ oneof $+ [ pure DEmpty,+ DText <$> genText,+ pure DSpace,+ pure DBreak,+ pure DSoftBreak+ ]+ <> (if withBreaks then [pure DHardBreak] else [])++shrinkDoc :: Doc -> [Doc]+shrinkDoc = \case+ DEmpty -> []+ DText t -> DText <$> filter (not . T.null) (T.inits t)+ DSpace -> [DEmpty]+ DBreak -> [DEmpty, DSpace]+ DSoftBreak -> [DEmpty]+ DHardBreak -> [DEmpty]+ DVerbatimBreak _ -> [DEmpty]+ DCloseLine -> [DEmpty]+ DHoldBack t -> DHoldBack <$> filter (not . T.null) (T.inits t)+ DCat a b -> [DEmpty, a, b] <> [DCat a' b | a' <- shrinkDoc a] <> [DCat a b' | b' <- shrinkDoc b]+ DNest n d -> [DEmpty, d] <> [DNest n d' | d' <- shrinkDoc d]+ DAlign d -> [DEmpty, d] <> [DAlign d' | d' <- shrinkDoc d]+ DGroup l d -> [DEmpty, d] <> [DGroup l d' | d' <- shrinkDoc d]+ DVariant a b -> [DEmpty, a, b]+ DLocated s d -> [DEmpty, d] <> [DLocated s d' | d' <- shrinkDoc d]+ DFence s d -> [DEmpty, d] <> [DFence s d' | d' <- shrinkDoc d]+ DCppChoice bs e -> [DEmpty, e] <> map snd bs+ DCppDirective _ _ -> [DEmpty]++-- | Every fragment of literal text the document contains, in order.+--+-- Undefined in the presence of 'DVariant', which contributes one of two+-- possible sequences depending on a layout this function cannot see; that+-- is what 'PlainDoc' exists to exclude.+docTexts :: Doc -> [Text]+docTexts = \case+ DEmpty -> []+ DText t -> [t]+ DSpace -> []+ DBreak -> []+ DSoftBreak -> []+ DHardBreak -> []+ DVerbatimBreak _ -> []+ DCloseLine -> []+ DHoldBack t -> [t]+ DCat a b -> docTexts a <> docTexts b+ DNest _ d -> docTexts d+ DAlign d -> docTexts d+ DGroup _ d -> docTexts d+ DVariant a _ -> docTexts a+ DLocated _ d -> docTexts d+ DFence _ d -> docTexts d+ DCppChoice bs e -> concat [c : docTexts d | (c, d) <- bs] <> docTexts e+ DCppDirective _ t -> [t]
+ tests/Tilia/NewlineSpec.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}++-- | How a text ends its lines.+module Tilia.NewlineSpec (spec) where++import Test.Hspec+import Tilia.Newline++spec :: Spec+spec = do+ describe "the style a text is written in" $ do+ it "is read off the first ending there is" $+ map getNewlineStyle ["a\r\nb\n", "a\nb\r\n", "a\nb\n", "a\r\nb\r\n"]+ `shouldBe` [CrLf, Lf, Lf, CrLf]++ it "is newlines for a text that ends no line at all" $+ getNewlineStyle "module A where" `shouldBe` Lf++ it "is newlines for a text with nothing in it" $+ getNewlineStyle "" `shouldBe` Lf++ describe "setting the style" $ do+ it "goes either way round" $ do+ setNewlineStyle CrLf "a\nb\n" `shouldBe` "a\r\nb\r\n"+ setNewlineStyle Lf "a\r\nb\r\n" `shouldBe` "a\nb\n"++ it "can be told to set the style already there, and change nothing" $+ map (\(style, t) -> setNewlineStyle style t) [(CrLf, "a\r\nb\r\n"), (Lf, "a\nb\n")]+ `shouldBe` ["a\r\nb\r\n", "a\nb\n"]++ it "brings a text whose endings disagree to one of them" $ do+ setNewlineStyle CrLf "a\r\nb\nc\r\n" `shouldBe` "a\r\nb\r\nc\r\n"+ setNewlineStyle Lf "a\r\nb\nc\r\n" `shouldBe` "a\nb\nc\n"++ it "leaves a carriage return that ends no line where it is" $ do+ setNewlineStyle Lf "x = \"a\\\r b\"\r\n" `shouldBe` "x = \"a\\\r b\"\n"+ setNewlineStyle CrLf "x = \"a\\\r b\"\n" `shouldBe` "x = \"a\\\r b\"\r\n"++ it "has nothing to do to a text that ends no line" $+ map (`setNewlineStyle` "module A where") [Lf, CrLf]+ `shouldBe` ["module A where", "module A where"]++ it "takes a text out and back unchanged, whichever style it began in" $+ [setNewlineStyle style (setNewlineStyle Lf t) | (style, t) <- [(CrLf, crlf), (Lf, lf)]]+ `shouldBe` [crlf, lf]+ where+ crlf = "module A where\r\n\r\nf :: Int\r\n"+ lf = "module A where\n\nf :: Int\n"
+ tests/Tilia/PackageSpec.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Information obtained from @.cabal@ files.+module Tilia.PackageSpec (spec) where++import Data.List (isSuffixOf, sort)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as T+import GHC.LanguageExtensions.Type (Extension (..))+import System.Directory (createDirectoryIfMissing, removeFile)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Tilia.Package (PackageProblem (..), newPackageReader)++spec :: Spec+spec = do+ describe "the component a file belongs to" $ do+ it "is the one whose source directory holds it" $+ inPackage twoComponents ["src", "test"] $ \root -> do+ library <- asked (root </> "src" </> "M.hs")+ suite <- asked (root </> "test" </> "S.hs")+ (has ImportQualifiedPost library, has ImportQualifiedPost suite)+ `shouldBe` (True, False)++ it "settles the extensions separately for each" $+ inPackage twoComponents ["src", "test"] $ \root -> do+ library <- asked (root </> "src" </> "M.hs")+ suite <- asked (root </> "test" </> "S.hs")+ (has OverloadedStrings library, has OverloadedStrings suite)+ `shouldBe` (False, True)++ it "is none of them when the file is outside every source directory" $+ inPackage twoComponents ["src", "test", "scratch"] $ \root ->+ (unclaimed <$> asked (root </> "scratch" </> "X.hs"))+ `shouldReturn` True++ it "is the package's own directory when it names no source directory" $+ inPackage besideTheCabalFile [] $ \root ->+ (has ImportQualifiedPost <$> asked (root </> "M.hs"))+ `shouldReturn` True++ it "is the nearer one when a wider component covers it as well" $+ inPackage overTheWholeTree ["tests"] $ \root ->+ (has ImportQualifiedPost <$> asked (root </> "tests" </> "S.hs"))+ `shouldReturn` True++ it "is still the wider one for a file only it covers" $+ inPackage overTheWholeTree ["tests"] $ \root ->+ (has ImportQualifiedPost <$> asked (root </> "M.hs"))+ `shouldReturn` False++ describe "the extensions a component puts in force" $ do+ it "are the language edition's" $+ inPackage twoComponents ["src"] $ \root -> do+ library <- asked (root </> "src" </> "M.hs")+ (length <$> library) `shouldSatisfy` either (const False) (> 40)++ it "can be turned off again by default-extensions" $+ inPackage refusesAnEdition ["src"] $ \root ->+ (has ImportQualifiedPost <$> asked (root </> "src" </> "M.hs"))+ `shouldReturn` False++ describe "a file nothing can be settled for" $ do+ it "says so when there is no package above it" $+ withSystemTempDirectory "tilia-nopackage" $ \root ->+ asked (root </> "M.hs")+ `shouldReturn` Left NoPackageFile++ it "says so, and how, when the package does not parse" $+ inPackage "library\n hs-source-dirs\n" [] $ \root ->+ asked (root </> "M.hs") >>= \case+ Left (PackageMalformed file complaints) -> do+ file `shouldSatisfy` (("demo.cabal" `isSuffixOf`))+ complaints `shouldSatisfy` not . null+ other -> expectationFailure ("expected a parse failure, got " <> show other)++ describe "a reader kept between files" $ do+ it "answers as a fresh one would" $+ inPackage twoComponents ["src", "test"] $ \root -> do+ ask <- newPackageReader+ kept <- traverse ask (modules root)+ fresh <- traverse asked (modules root)+ kept `shouldBe` fresh++ it "reads a package once, not once per file" $+ inPackage twoComponents ["src"] $ \root -> do+ ask <- newPackageReader+ first <- ask (root </> "src" </> "A.hs")+ removeFile (root </> "demo.cabal")+ ask (root </> "src" </> "B.hs") `shouldReturn` first++ it "remembers every directory the walk went through" $+ inPackage twoComponents ["src" </> "deep"] $ \root -> do+ ask <- newPackageReader+ deep <- ask (root </> "src" </> "deep" </> "A.hs")+ removeFile (root </> "demo.cabal")+ ask (root </> "src" </> "B.hs") `shouldReturn` deep++ it "is what makes those pass, and not the file surviving" $+ inPackage twoComponents ["src"] $ \root -> do+ removeFile (root </> "demo.cabal")+ (unreadableOrMissing <$> asked (root </> "src" </> "A.hs"))+ `shouldReturn` True++----------------------------------------------------------------------------+-- The packages the tests are run against++-- | A library on @GHC2021@ and a test suite on @Haskell2010@, so that the+-- two disagree about everything worth asking.+twoComponents :: Text+twoComponents =+ T.unlines+ [ "cabal-version: 2.4",+ "name: demo",+ "version: 0",+ "",+ "library",+ " exposed-modules: M",+ " hs-source-dirs: src",+ " default-language: GHC2021",+ "",+ "test-suite spec",+ " type: exitcode-stdio-1.0",+ " main-is: S.hs",+ " hs-source-dirs: test",+ " default-language: Haskell2010",+ " default-extensions: OverloadedStrings"+ ]++-- | A library that names no @hs-source-dirs@, so its modules sit beside the+-- @.cabal@ file.+besideTheCabalFile :: Text+besideTheCabalFile =+ T.unlines+ [ "cabal-version: 2.4",+ "name: demo",+ "version: 0",+ "",+ "library",+ " exposed-modules: M",+ " default-language: GHC2021"+ ]++-- | A library that spreads over the whole tree, and a suite inside it.+--+-- The library names no @hs-source-dirs@ and so takes the package+-- directory, which holds the test suite's directory as well as its own+-- modules.+overTheWholeTree :: Text+overTheWholeTree =+ T.unlines+ [ "cabal-version: 2.4",+ "name: demo",+ "version: 0",+ "",+ "library",+ " exposed-modules: M",+ " default-language: Haskell2010",+ "",+ "test-suite spec",+ " type: exitcode-stdio-1.0",+ " main-is: S.hs",+ " hs-source-dirs: tests",+ " default-language: GHC2021"+ ]++-- | An edition, and then one of the things it brings taken back out.+refusesAnEdition :: Text+refusesAnEdition =+ T.unlines+ [ "cabal-version: 2.4",+ "name: demo",+ "version: 0",+ "",+ "library",+ " exposed-modules: M",+ " hs-source-dirs: src",+ " default-language: GHC2021",+ " default-extensions: NoImportQualifiedPost"+ ]++----------------------------------------------------------------------------+-- Running one++-- | Write a @.cabal@ file and the given directories, and hand back the root.+inPackage :: Text -> [FilePath] -> (FilePath -> IO a) -> IO a+inPackage contents dirs use =+ withSystemTempDirectory "tilia-package" $ \root -> do+ T.writeFile (root </> "demo.cabal") contents+ mapM_ (createDirectoryIfMissing True . (root </>)) (sort dirs)+ use root++-- | Ask about one file with a reader of its own, which is what a test that+-- is not about caching wants.+asked :: FilePath -> IO (Either PackageProblem [Extension])+asked path = do+ ask <- newPackageReader+ ask path++-- | One module in each of the two components.+modules :: FilePath -> [FilePath]+modules root = [root </> "src" </> "M.hs", root </> "test" </> "S.hs"]++unreadableOrMissing :: Either PackageProblem [Extension] -> Bool+unreadableOrMissing = either (const True) (const False)++has :: Extension -> Either PackageProblem [Extension] -> Bool+has e = either (const False) (e `elem`)++unclaimed :: Either PackageProblem [Extension] -> Bool+unclaimed = either isFileUnclaimed (const False)+ where+ isFileUnclaimed = \case+ FileUnclaimed _ -> True+ _ -> False
+ tests/Tilia/PragmaSpec.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings #-}++-- | What a module's pragmas say, read off the text.+module Tilia.PragmaSpec (spec) where++import Data.Text (Text)+import GHC.LanguageExtensions.Type (Extension (..))+import Test.Hspec+import Tilia.Pragma++spec :: Spec+spec = do+ describe "movesPositions" $ do+ describe "says so" $ do+ for_'+ [ ("a LINE pragma", "{-# LINE 1 \"Other.hs\" #-}\n"),+ ("a COLUMN pragma", "{-# COLUMN 20 #-}\n"),+ ("one written in lower case", "{-# line 1 \"Other.hs\" #-}\n"),+ ("one written without spaces", "{-#LINE 1 \"Other.hs\"#-}\n"),+ ("one written over several lines", "{-# LINE 1\n \"Other.hs\" #-}\n"),+ ("one below the header", "module M where\nx = 1\n{-# LINE 9 \"O.hs\" #-}\n"),+ ("one among pragmas that do not move anything", langThenLine)+ ]+ (\source -> movesPositions source `shouldBe` True)++ describe "says nothing of" $ do+ for_'+ [ ("a module with no pragma at all", "module M where\nx = 1\n"),+ ("a LANGUAGE pragma", "{-# LANGUAGE LambdaCase #-}\nmodule M where\n"),+ ("an INLINE pragma", "module M where\n{-# INLINE f #-}\nf = id\n"),+ ("a pragma whose name merely starts with one", "{-# LINEAR 1 #-}\n"),+ ("an unclosed pragma", "{-# LINE 1 \"Other.hs\"\n"),+ ("the word in a comment", "-- {-* LINE 1 *-}\nmodule M where\n")+ ]+ (\source -> movesPositions source `shouldBe` False)+ describe "the extensions in force" $ do+ it "starts from what is on by default" $+ effectiveExtensions [] "module M where\n" `shouldBe` [ImplicitPrelude]+ it "keeps what the package puts in force" $+ effectiveExtensions [ImplicitPrelude, GADTs] "module M where\n"+ `shouldBe` [ImplicitPrelude, GADTs]+ it "leaves the Prelude off where the package's own set does" $+ effectiveExtensions [GADTs] "module M where\n" `shouldBe` [GADTs]+ it "reads one extension" $+ effectiveExtensions [] "{-# LANGUAGE BangPatterns #-}\nmodule M where\n"+ `shouldBe` [ImplicitPrelude, BangPatterns]+ it "reads several from one pragma" $+ effectiveExtensions [] "{-# LANGUAGE GADTs, RankNTypes #-}\nmodule M where\n"+ `shouldBe` [ImplicitPrelude, GADTs, RankNTypes]+ it "reads several pragmas" $+ effectiveExtensions [] "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MagicHash #-}\n"+ `shouldBe` [ImplicitPrelude, GADTs, MagicHash]+ it "ignores other pragmas" $+ effectiveExtensions [] "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE GADTs #-}\n"+ `shouldBe` [ImplicitPrelude, GADTs]+ it "ignores an unknown extension rather than failing" $+ effectiveExtensions [] "{-# LANGUAGE GADTs, NotARealExtension #-}\n"+ `shouldBe` [ImplicitPrelude, GADTs]+ it "treats a No-prefix as turning one off" $+ effectiveExtensions [] "{-# LANGUAGE NoImplicitPrelude #-}\n" `shouldBe` []+ it "lets a module refuse what its package put in force" $+ effectiveExtensions [ImplicitPrelude, GADTs] "{-# LANGUAGE NoGADTs #-}\n"+ `shouldBe` [ImplicitPrelude]+ it "lets a module take back a Prelude its package turned off" $+ effectiveExtensions [GADTs] "{-# LANGUAGE ImplicitPrelude #-}\n"+ `shouldBe` [GADTs, ImplicitPrelude]+ it "does not repeat an extension named twice" $+ effectiveExtensions [] "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE GADTs #-}\n"+ `shouldBe` [ImplicitPrelude, GADTs]++ describe "lookupExtension" $ do+ it "knows an extension by the name one writes" $+ lookupExtension "LambdaCase" `shouldBe` Just LambdaCase+ it "says nothing of a name no compiler knows" $+ lookupExtension "NotARealExtension" `shouldBe` Nothing+ it "does not accept the No-prefixed spelling as a name" $+ lookupExtension "NoImplicitPrelude" `shouldBe` Nothing+ where+ for_' cases expect = mapM_ (\(what, source) -> it what (expect source)) cases++ langThenLine :: Text+ langThenLine = "{-# LANGUAGE LambdaCase #-}\nmodule M where\n{-# LINE 3 \"O.hs\" #-}\n"
+ tests/Tilia/ProcessSpec.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Running a program and collecting its output.+module Tilia.ProcessSpec (spec) where++import Data.Text qualified as T+import System.Timeout (timeout)+import Test.Hspec+import Tilia.Process (readProgramOutput)++spec :: Spec+spec = do+ describe "what a program printed" $ do+ it "comes back as it was printed" $+ shell "printf 'one\\ntwo\\n'" `shouldReturn` Just "one\ntwo\n"++ it "is read as UTF-8, whatever the machine's locale is" $+ shell "printf 'ma\\303\\257ntainer\\n'" `shouldReturn` Just "maïntainer\n"++ it "survives bytes that are not UTF-8 at all" $+ (fmap survived <$> shell "printf 'before\\377after'")+ `shouldReturn` Just True++ it "ends its lines with newlines however the program ended them" $+ shell "printf 'a\\r\\nb\\r\\n'" `shouldReturn` Just "a\nb\n"++ describe "a program that has nothing to say" $ do+ it "is nothing when it failed" $+ shell "printf 'half an answer'; exit 3" `shouldReturn` Nothing++ it "is nothing when it is not there to run" $+ readProgramOutput "tilia-no-such-program-exists" [] `shouldReturn` Nothing++ it "is nothing rather than a crash when it is a directory" $+ readProgramOutput "." [] `shouldReturn` Nothing++ describe "a program that says a great deal on its error stream" $+ it "is read to the end all the same" $ do+ answered <-+ timeout (30 * 1000000) $+ shell "yes error | head -c 200000 >&2; printf 'the answer'"+ answered `shouldBe` Just (Just "the answer")++-- | Run a shell command and take what it printed.+shell :: String -> IO (Maybe T.Text)+shell command = readProgramOutput "sh" ["-c", command]++-- | Did what was printed either side of the unreadable byte come through?+survived :: T.Text -> Bool+survived out = T.isInfixOf "before" out && T.isInfixOf "after" out
+ tests/Tilia/ProjectSpec.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Finding the project a file belongs to.+module Tilia.ProjectSpec (spec) where++import System.Directory (createDirectoryIfMissing, withCurrentDirectory)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Tilia.Project++spec :: Spec+spec = do+ describe "in this repository" $ do+ it "finds the root from the root" $ do+ root <- findProjectRoot "."+ (prMarker <$> root) `shouldBe` Just ProjectFile++ it "finds the root from a nested source directory" $ do+ root <- findProjectRoot "src/Tilia/Printer"+ (prMarker <$> root) `shouldBe` Just ProjectFile++ it "finds the root from a file rather than a directory" $ do+ root <- findProjectRoot "src/Tilia/Fixity.hs"+ (prMarker <$> root) `shouldBe` Just ProjectFile++ it "returns the same directory however it is reached" $ do+ a <- findProjectRoot "."+ b <- findProjectRoot "tests/Tilia"+ c <- findProjectRoot "src/Tilia/Printer/Internal.hs"+ (prPath <$> a, prPath <$> b) `shouldBe` (prPath <$> a, prPath <$> c)+ (prPath <$> b) `shouldBe` (prPath <$> c)++ describe "marker precedence" $ do+ it "prefers cabal.project to a bare .cabal file" $+ withTree [("cabal.project", ""), ("thing.cabal", "")] $ \dir -> do+ root <- findProjectRoot dir+ (prMarker <$> root) `shouldBe` Just ProjectFile++ it "accepts a bare .cabal file when there is no project" $+ withTree [("thing.cabal", "")] $ \dir -> do+ root <- findProjectRoot dir+ (prMarker <$> root) `shouldBe` Just (PackageFile "thing.cabal")++ it "passes over a stack.yaml, which cabal does not read" $+ withTree [("stack.yaml", ""), ("thing.cabal", "")] $ \dir -> do+ root <- findProjectRoot dir+ (prMarker <$> root) `shouldBe` Just (PackageFile "thing.cabal")++ it "climbs out of a stack project to the package it is asked about" $+ withTree [("stack.yaml", ""), ("packages/inner/inner.cabal", "")] $+ \dir -> do+ root <- findProjectRoot (dir </> "packages" </> "inner")+ prPath <$> root `shouldBe` Just (dir </> "packages" </> "inner")++ it "climbs past a package to the project that contains it"+ $ withTree+ [ ("cabal.project", ""),+ ("packages/inner/placeholder", "")+ ]+ $ \dir -> do+ root <- findProjectRoot (dir </> "packages" </> "inner")+ (prMarker <$> root) `shouldBe` Just ProjectFile++ it "climbs past a package that has its own .cabal"+ $ withTree+ [ ("cabal.project", ""),+ ("packages/inner/inner.cabal", "")+ ]+ $ \dir -> do+ root <- findProjectRoot (dir </> "packages" </> "inner")+ (prPath <$> root) `shouldBe` Just dir+ (prMarker <$> root) `shouldBe` Just ProjectFile++ it "takes the nearest project of the ones above"+ $ withTree+ [ ("cabal.project", ""),+ ("packages/inner/cabal.project", ""),+ ("packages/inner/inner.cabal", "")+ ]+ $ \dir -> do+ root <- findProjectRoot (dir </> "packages" </> "inner")+ prPath <$> root `shouldBe` Just (dir </> "packages" </> "inner")++ it "takes the nearest package when no project is above either"+ $ withTree+ [ ("outer.cabal", ""),+ ("packages/inner/inner.cabal", "")+ ]+ $ \dir -> do+ root <- findProjectRoot (dir </> "packages" </> "inner")+ (prMarker <$> root) `shouldBe` Just (PackageFile "inner.cabal")++ it "climbs to a project past a package that is not the one asked about"+ $ withTree+ [ ("cabal.project", ""),+ ("outer.cabal", ""),+ ("packages/inner/inner.cabal", "")+ ]+ $ \dir -> do+ root <- findProjectRoot (dir </> "packages" </> "inner")+ (prMarker <$> root) `shouldBe` Just ProjectFile++ describe "no project" $+ it "gives up rather than guessing" $+ withTree [("lonely/Thing.hs", "module Thing where")] $ \dir ->+ -- A temporary directory has no project above it, so this walks to+ -- the filesystem root and finds nothing.+ withCurrentDirectory dir $ do+ root <- findProjectRoot "lonely"+ case root of+ Nothing -> pure ()+ Just found ->+ -- Some machines have a stray marker in a parent of the+ -- system temporary directory; only a genuine find inside the+ -- tree would be a failure.+ prPath found `shouldNotBe` (dir </> "lonely")++-- | Build a throwaway tree of files and run an action on its root.+withTree :: [(FilePath, String)] -> (FilePath -> IO a) -> IO a+withTree files action =+ withSystemTempDirectory "tilia-project" $ \dir -> do+ mapM_ (create dir) files+ action dir+ where+ create dir (path, contents) = do+ let full = dir </> path+ createDirectoryIfMissing True (parentOf full)+ writeFile full contents+ parentOf = reverse . drop 1 . dropWhile (/= '/') . reverse
+ tests/Tilia/Render/OperatorSpec.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE LambdaCase #-}++-- | Regrouping operator chains by precedence.+module Tilia.Render.OperatorSpec (spec) where++import Data.List.NonEmpty (NonEmpty (..))+import Test.Hspec+import Tilia.Fixity (Direction (..), Fixity (..))+import Tilia.Render.Operator++spec :: Spec+spec = do+ describe "flatten" $ do+ it "leaves a leaf alone" $+ flatten split (Leaf 'a') `shouldBe` (Leaf 'a' :| [], [])+ it "reads a chain left to right" $+ flatten split (Apply (Apply (Leaf 'a') '+' (Leaf 'b')) '*' (Leaf 'c'))+ `shouldBe` (Leaf 'a' :| [Leaf 'b', Leaf 'c'], ['+', '*'])+ it "does not go inside a leaf" $+ flatten split (Apply (Leaf 'a') '+' (Opaque (Apply (Leaf 'b') '*' (Leaf 'c'))))+ `shouldBe` (Leaf 'a' :| [Opaque (Apply (Leaf 'b') '*' (Leaf 'c'))], ['+'])++ describe "associate" $ do+ it "makes one level of a chain that binds equally" $+ associate known (leaves "abc") ['+', '+']+ `shouldBe` Chain (Operand (Leaf 'a') :| [Operand (Leaf 'b'), Operand (Leaf 'c')]) ['+', '+']++ it "splits at the loosest operator" $+ associate known (leaves "abc") ['*', '+']+ `shouldBe` Chain+ ( Chain (Operand (Leaf 'a') :| [Operand (Leaf 'b')]) ['*']+ :| [Operand (Leaf 'c')]+ )+ ['+']++ it "puts every level in its place" $+ associate known (leaves "abcd") ['*', '+', '*']+ `shouldBe` Chain+ ( Chain (Operand (Leaf 'a') :| [Operand (Leaf 'b')]) ['*']+ :| [Chain (Operand (Leaf 'c') :| [Operand (Leaf 'd')]) ['*']]+ )+ ['+']++ it "keeps a single operand as one" $+ associate known (Leaf 'a' :| []) []+ `shouldBe` Operand (Leaf 'a')++ -- What the author wrote is the only information left when a fixity+ -- cannot be established, so it is what the layout follows.+ it "leaves the chain flat when one fixity is unknown" $+ associate known (leaves "abc") ['*', '?']+ `shouldBe` Chain (Operand (Leaf 'a') :| [Operand (Leaf 'b'), Operand (Leaf 'c')]) ['*', '?']++ describe "separators" $ do+ it "recognises an operator that introduces its operand" $+ isSeparator (Just (Fixity RightAssoc 0)) `shouldBe` True+ it "does not mistake a tight right-associative operator for one" $+ isSeparator (Just (Fixity RightAssoc 6)) `shouldBe` False+ it "says nothing about an operator it does not know" $+ isSeparator Nothing `shouldBe` False++----------------------------------------------------------------------------+-- A stand-in for the syntax tree++-- | Just enough of an expression to have operators in it.+data E+ = Leaf Char+ | Apply E Char E+ | -- | Something the chain builder must not look inside, standing in for a+ -- parenthesised subexpression.+ Opaque E+ deriving (Eq, Show)++split :: E -> Maybe (E, Char, E)+split = \case+ Apply l o r -> Just (l, o, r)+ _ -> Nothing++leaves :: [Char] -> NonEmpty E+leaves = \case+ [] -> error "leaves: none"+ (c : cs) -> Leaf c :| map Leaf cs++-- | @?@ is the operator nothing is known about.+known :: Char -> Maybe Fixity+known = \case+ '+' -> Just (Fixity LeftAssoc 6)+ '*' -> Just (Fixity LeftAssoc 7)+ _ -> Nothing
+ tests/Tilia/RenderSpec.hs view
@@ -0,0 +1,346 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Formatting whole modules.+module Tilia.RenderSpec (spec) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import GHC.LanguageExtensions.Type (Extension (..))+import Test.Hspec+import Tilia.Doc (defaultRenderOptions, printDoc)+import Tilia.Fixity+ ( Direction (..),+ Fixity (..),+ OpName (..),+ Provenance (..),+ Reach (..),+ Scope (..),+ )+import Tilia.Parser (defaultParserConfig, parseModule)+import Tilia.Render++spec :: Spec+spec = do+ describe "the module header" $ do+ it "puts the pragmas above the module and sorts them" $+ format+ [ "{-# LANGUAGE OverloadedStrings, GADTs #-}",+ "module M where"+ ]+ `shouldBe` [ "{-# LANGUAGE GADTs #-}",+ "{-# LANGUAGE OverloadedStrings #-}",+ "",+ "module M where"+ ]++ it "puts an extension pack before what it enables" $+ format+ [ "{-# LANGUAGE ApplicativeDo #-}",+ "{-# LANGUAGE GHC2021 #-}",+ "module M where"+ ]+ `shouldBe` [ "{-# LANGUAGE GHC2021 #-}",+ "{-# LANGUAGE ApplicativeDo #-}",+ "",+ "module M where"+ ]++ it "puts qualified first throughout when the extension is off" $+ format+ [ "module M where",+ "import Data.Map qualified as M",+ "import qualified Data.Set as S"+ ]+ `shouldBe` [ "module M where",+ "",+ "import qualified Data.Map as M",+ "import qualified Data.Set as S"+ ]++ it "puts qualified last throughout when the extension is on" $+ formatUnder+ [ImportQualifiedPost]+ [ "module M where",+ "import Data.Map qualified as M",+ "import qualified Data.Set as S"+ ]+ `shouldBe` [ "module M where",+ "",+ "import Data.Map qualified as M",+ "import Data.Set qualified as S"+ ]++ it "parses a module that takes back an extension the edition puts in force" $+ format+ [ "{-# LANGUAGE NoStarIsType #-}",+ "{-# LANGUAGE TypeOperators #-}",+ "module M (type (*)) where",+ "import GHC.TypeLits (type (*))"+ ]+ `shouldBe` [ "{-# LANGUAGE TypeOperators #-}",+ "{-# LANGUAGE NoStarIsType #-}",+ "",+ "module M (type (*)) where",+ "",+ "import GHC.TypeLits (type (*))"+ ]++ describe "comments" $ do+ it "keeps one written between declarations" $+ format+ [ "module M where",+ "",+ "-- a note",+ "f = 1"+ ]+ `shouldBe` [ "module M where",+ "",+ "-- a note",+ "f = 1"+ ]++ it "keeps one written inside a binding" $+ format+ [ "module M where",+ "",+ "f = g",+ " where",+ " -- about g",+ " g = 1"+ ]+ `shouldBe` [ "module M where",+ "",+ "f = g",+ " where",+ " -- about g",+ " g = 1"+ ]++ it "keeps a self-delimiting one on the line it was written on" $+ format ["module M where", "", "f =", " {- here -} 1"]+ `shouldBe` ["module M where", "", "f =", " {- here -} 1"]++ it "will not put a construct holding one on a single line" $+ format+ [ "module M where",+ "",+ "f =",+ " ( -- here",+ " 1",+ " )"+ ]+ `shouldBe` [ "module M where",+ "",+ "f =",+ " ( -- here",+ " 1",+ " )"+ ]++ describe "operator chains" $ do+ -- With the fixities known, the chain is regrouped so that what binds+ -- tightly stays together and the break falls where the reader expects.+ it "breaks a chain at its loosest operator" $+ formatWith (Just arithmetic) spreadChain+ `shouldBe` [ "module M where",+ "",+ "f =",+ " a * b",+ " + c * d"+ ]++ -- Without them nothing is asserted about how the chain associates, so+ -- nothing is rearranged and every operator is treated alike.+ it "leaves a chain alone when the fixities are unknown" $+ formatWith Nothing spreadChain+ `shouldBe` [ "module M where",+ "",+ "f =",+ " a",+ " * b",+ " + c",+ " * d"+ ]++ it "lets a separator hand a block to what precedes it" $+ formatWith+ (Just arithmetic)+ ["module M where", "", "f = g $ do", " h", " i"]+ `shouldBe` [ "module M where",+ "",+ "f = g $ do",+ " h",+ " i"+ ]++ describe "where a comment lands" $ do+ -- A comment the author wrote after code ends a line here too, and the+ -- printer has not finished with that line: the comma of a record field,+ -- the arrow of an alternative and the closing bracket of a list all+ -- still have to be emitted, and all of them belong before it.+ it "keeps a comment at the end of the line it was written on" $+ format+ [ "module M where",+ "",+ "f = case x of",+ " a -> -- why",+ " b"+ ]+ `shouldBe` [ "module M where",+ "",+ "f = case x of",+ " a -> -- why",+ " b"+ ]++ it "leaves a comment written on its own line on one" $+ format+ [ "module M where",+ "",+ "f = case x of",+ " a ->",+ " -- why",+ " b"+ ]+ `shouldBe` [ "module M where",+ "",+ "f = case x of",+ " a ->",+ " -- why",+ " b"+ ]++ it "keeps one written before the closing bracket inside it" $+ format+ [ "module M where",+ "",+ "xs =",+ " [ a,",+ " b",+ " -- and that is all",+ " ]"+ ]+ `shouldBe` [ "module M where",+ "",+ "xs =",+ " [ a,",+ " b",+ " -- and that is all",+ " ]"+ ]++ -- Formatting an already formatted file must change nothing. The property+ -- is easy to lose the moment comments move, since where a comment goes is+ -- read off the input and moving it changes what the next pass reads.+ describe "settling"+ $ it "reaches its answer in one pass"+ $ let once = format awkward+ in formatWith Nothing once `shouldBe` once++ describe "layout follows the input" $ do+ it "keeps a declaration that was on one line on one line" $+ format ["module M where", "", "f x = (x, x)"]+ `shouldBe` ["module M where", "", "f x = (x, x)"]++ it "keeps one that was spread out spread out" $+ format ["module M where", "", "f x =", " ( x,", " x", " )"]+ `shouldBe` [ "module M where",+ "",+ "f x =",+ " ( x,",+ " x",+ " )"+ ]++----------------------------------------------------------------------------+-- Helpers++-- | Format the given lines and give the result back as lines.+format :: [Text] -> [Text]+format = formatWith Nothing++-- | Format with the given extensions in force, as a package would put them.+formatUnder :: [Extension] -> [Text] -> [Text]+formatUnder exts = withSettings defaultRenderConfig {rcExtensions = Set.fromList exts}++formatWith :: Maybe Scope -> [Text] -> [Text]+formatWith scope = withSettings defaultRenderConfig {rcScope = scope}++withSettings :: RenderConfig -> [Text] -> [Text]+withSettings settings input =+ case parseModule defaultParserConfig "<test>" source of+ Left _ -> error ("did not parse:\n" <> T.unpack source)+ Right parsed ->+ T.lines (printDoc defaultRenderOptions (renderModule settings parsed))+ where+ source = T.unlines input++-- | A module with comments in all the places that are hard to put them+-- back.+awkward :: [Text]+awkward =+ [ "module M where",+ "",+ "-- | A heading",+ "",+ "-- and a note under it",+ "data T = T",+ " { a :: Int, -- the first",+ " -- the second",+ " b :: Int",+ " }",+ "",+ "f x -- what to do with this?",+ " | x > 0 = g x",+ " | otherwise = h x",+ " where",+ " g = id",+ "",+ " -- about h",+ " h = negate",+ "",+ "xs =",+ " [ one,",+ " {- inline -} two",+ " -- last",+ " ]"+ ]++-- | A chain the author already spread over more than one line, so that the+-- question is where it breaks rather than whether it does.+spreadChain :: [Text]+spreadChain =+ [ "module M where",+ "",+ "f =",+ " a * b",+ " + c * d"+ ]++-- | A scope that knows the operators the tests use.+arithmetic :: Scope+arithmetic =+ Scope+ { scopeInTypes = nothingReaches,+ scopeInTerms =+ nothingReaches+ { reachUnqualified =+ Map.fromList+ [ (OpName "$", (Fixity RightAssoc 0, DeclaredHere)),+ (OpName "+", (Fixity LeftAssoc 6, DeclaredHere)),+ (OpName "*", (Fixity LeftAssoc 7, DeclaredHere))+ ]+ },+ scopeUnread = []+ }++-- | A namespace with nothing in it.+nothingReaches :: Reach+nothingReaches =+ Reach+ { reachUnqualified = Map.empty,+ reachQualified = Map.empty,+ reachAmbiguous = []+ }
+ tests/Tilia/RunSpec.hs view
@@ -0,0 +1,512 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Running the formatter over a set of files.+module Tilia.RunSpec (spec) where++import Control.Concurrent (getNumCapabilities, threadDelay)+import Data.ByteString qualified as BS+import Data.Either (isLeft)+import Data.IORef+import Data.List.NonEmpty (NonEmpty ((:|)))+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 GHC.Clock (getMonotonicTime)+import System.Directory (getModificationTime)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Tilia.Cpp (CppError (..))+import Tilia.Fixity (ModuleChain (..), OpName (..), Unknown (..))+import Tilia.Format (FormatError (..), formatErrorExitCode, refused)+import Tilia.Package (PackageProblem (..))+import Tilia.Palette (Color (Bad), Palette (..))+import Tilia.Run+import Tilia.Utils (lineWidth, visibleLength, wrapTo)++spec :: Spec+spec = do+ describe "telling a refusal from a failure" $ do+ it "counts what we would not touch as a refusal" $+ map+ refused+ [ PositionPragmas "A.hs",+ CppUnsupported "A.hs" UnsplittableConditional,+ UnknownFixity "A.hs" []+ ]+ `shouldBe` [True, True, True]++ it "counts what we could not read or make sense of as a failure" $+ map+ refused+ [ Unreadable "A.hs" "no such file",+ NoPackage "A.hs" NoPackageFile,+ NoProject "A.hs",+ NoBuildPlan "." "cabal said no",+ NotEquivalent "A.hs" "f = 1 became f = 2",+ NotIdempotent "A.hs" "line 12 differs"+ ]+ `shouldBe` [False, False, False, False, False, False]++ describe "what became of a file" $ do+ it "counts a rewrite as a difference and nothing else" $+ map differs [Changed "a" "b", Unchanged, decline, failure]+ `shouldBe` [True, False, False, False]++ it "keeps refusals and failures apart" $ do+ map declined [decline, failure, Unchanged] `shouldBe` [True, False, False]+ map failed [decline, failure, Unchanged] `shouldBe` [False, True, False]++ describe "the status a run leaves behind" $ do+ it "has none to give when nothing failed" $+ exitCodeOf [("A.hs", Unchanged), ("B.hs", decline), ("C.hs", Changed "a" "b")]+ `shouldBe` Nothing++ it "gives the code of the failure when there is one" $+ exitCodeOf [("A.hs", failure)]+ `shouldBe` Just (formatErrorExitCode (Unreadable "A.hs" "gone"))++ it "gives the lowest code when there are several" $+ exitCodeOf [("A.hs", failure), ("B.hs", otherFailure)]+ `shouldBe` Just (min (formatErrorExitCode unreadable) (formatErrorExitCode unclaimed))++ it "does not depend on the order the failures came back in" $+ exitCodeOf [("A.hs", failure), ("B.hs", otherFailure)]+ `shouldBe` exitCodeOf [("B.hs", otherFailure), ("A.hs", failure)]++ it "is not swayed by a refusal, however many there are" $+ exitCodeOf [("A.hs", decline), ("B.hs", decline)] `shouldBe` Nothing++ describe "the summary an inplace run prints" $ do+ it "counts the files it formatted, indented, by extension" $+ reportOut (inplaceReport Plain [("A.hs", Unchanged), ("B.hs", Changed "a" "b")])+ `shouldBe` [" [✓] Formatted 2 .hs files"]++ it "counts each extension on its own line, in a settled order" $+ reportOut+ ( inplaceReport+ Plain+ [("C.hsig", Unchanged), ("A.hs", Unchanged), ("B.hs-boot", Unchanged)]+ )+ `shouldBe` [ " [✓] Formatted 1 .hs file",+ " [✓] Formatted 1 .hs-boot file",+ " [✓] Formatted 1 .hsig file"+ ]++ it "says file rather than files when there is one" $+ reportOut (inplaceReport Plain [("A.hs", Unchanged)])+ `shouldBe` [" [✓] Formatted 1 .hs file"]++ it "counts neither a refusal nor a failure among the formatted" $+ reportOut (inplaceReport Plain [("A.hs", Unchanged), ("B.hs", decline), ("C.hs", failure)])+ `shouldBe` [" [✓] Formatted 1 .hs file"]++ it "says nothing at all about a run with no files" $+ inplaceReport Plain [] `shouldBe` Report [] []++ describe "the files a run did not format" $ do+ let mixed =+ [ ("b.hs", decline),+ ("a.hs", Failed (Unreadable "a.hs" "no such file")),+ ("c.hs-boot", decline)+ ]++ it "tallies refusals and failures apart, and puts refusals first" $+ filter (T.isInfixOf "] ") (reportErr (inplaceReport Plain mixed))+ `shouldBe` [ " [=] Declined 1 .hs file",+ " [=] Declined 1 .hs-boot file",+ " [✗] Failed 1 .hs file"+ ]++ it "gives a reason for every one of them" $+ length (filter opensAReason (reportErr (inplaceReport Plain mixed)))+ `shouldBe` 3++ it "says what a file that would not settle did" $+ reportErr+ (inplaceReport Plain [("A.hs", Failed (NotIdempotent "A.hs" "line 12 differs"))])+ `shouldSatisfy` any (T.isInfixOf "A.hs is not idempotent: line 12 differs")++ it "names the file in the reason, once" $+ reportErr (inplaceReport Plain mixed)+ `shouldSatisfy` any (T.isInfixOf "cannot read a.hs: no such file")++ it "orders the reasons by file, not by arrival" $+ reportErr (inplaceReport Plain mixed)+ `shouldBe` reportErr (inplaceReport Plain (reverse mixed))++ it "opens every case with a bullet" $+ filter opensAReason (reportErr (inplaceReport Plain mixed))+ `shouldSatisfy` all (T.isPrefixOf " · ")++ it "lines a wrapped case up with the text of its bullet" $+ reportErr (inplaceReport Plain [("A.hs", Failed (Unreadable "A.hs" (T.replicate 20 "and more words ")))])+ `shouldSatisfy` \case+ (_tallyLine : opening : continuation : _) ->+ T.isPrefixOf " · " opening+ && T.takeWhile (== ' ') continuation == " "+ _ -> False++ it "lays an unsettled operator at the door of the run, not of the module" $+ flattened (inplaceReport Plain [("A.hs", missing "Criterion.Main")])+ `shouldSatisfy` T.isInfixOf+ "the fixity of <|> may be declared in Criterion.Main, which this run could not read"++ it "counts the modules when the answer could be in more than one" $+ flattened (inplaceReport Plain [("A.hs", missingIn ["Criterion.Main", "Test.Tasty"])])+ `shouldSatisfy` T.isInfixOf+ "may be declared in Criterion.Main or Test.Tasty, neither of which this run could read"++ it "names the module reading stopped at, not only the import above it" $+ flattened+ (inplaceReport Plain [("A.hs", missingThrough [ModuleChain ("Test.Hspec" :| ["Test.QuickCheck.Property"])])])+ `shouldSatisfy` T.isInfixOf+ "may be declared in Test.Hspec → Test.QuickCheck.Property, which this run could not read"++ it "gives one answer once however many operators share it" $+ flattened (inplaceReport Plain [("A.hs", missingTwice "Criterion.Main")])+ `shouldSatisfy` T.isInfixOf+ "the fixities of <|> and <+> may be declared in Criterion.Main, which this run could not read"++ it "puts a comma before the and once there are three of them" $+ flattened (inplaceReport Plain [("A.hs", missingAll ["<|>", "<+>", "<*>"] "Criterion.Main")])+ `shouldSatisfy` T.isInfixOf "the fixities of <|>, <+>, and <*> may be declared in"++ it "leaves a pair without one" $+ flattened (inplaceReport Plain [("A.hs", missingAll ["<|>", "<+>"] "Criterion.Main")])+ `shouldSatisfy` T.isInfixOf "the fixities of <|> and <+> may be declared in"++ it "counts each answer's operators rather than the file's" $+ flattened (inplaceReport Plain [("A.hs", twoAnswers)])+ `shouldSatisfy` T.isInfixOf+ "the fixity of <|> may be declared in Criterion.Main, which this run \+ \could not read, and the fixity of <+> is declared differently by two \+ \modules in scope"++ it "keeps all of it off the stream the summary goes to" $+ reportOut (inplaceReport Plain mixed) `shouldBe` []++ it "says the same about them in either command" $+ reportErr (checkReport Plain mixed) `shouldBe` reportErr (inplaceReport Plain mixed)++ describe "what a check run prints" $ do+ it "shows a diff for a file that would change" $+ reportOut (checkReport Plain [("A.hs", Changed "one\n" "two\n")])+ `shouldSatisfy` any (T.isInfixOf "--- a/A.hs")++ it "heads it the way git heads one" $+ reportOut (checkReport Plain [("A.hs", Changed "one\n" "two\n")])+ `shouldSatisfy` any (T.isInfixOf "diff --git a/A.hs b/A.hs")++ it "shows the removal and the addition" $ do+ let shown = T.unlines (reportOut (checkReport Plain [("A.hs", Changed "one\n" "two\n")]))+ shown `shouldSatisfy` T.isInfixOf "-one"+ shown `shouldSatisfy` T.isInfixOf "+two"++ it "says nothing on standard output about a file it did not format" $+ reportOut (checkReport Plain [("A.hs", Unchanged), ("B.hs", decline), ("C.hs", failure)])+ `shouldBe` []++ describe "color" $ do+ it "leaves everything bare when there is nobody to see it" $+ reportOut (inplaceReport Plain [("A.hs", Unchanged)])+ `shouldSatisfy` all (not . T.isInfixOf "\ESC")++ it "colors the tick and not the brackets around it" $+ reportOut (inplaceReport Colors [("A.hs", Unchanged)])+ `shouldSatisfy` any (T.isInfixOf "[\ESC[32m✓\ESC[0m]")++ it "colors the equals sign yellow" $+ reportErr (inplaceReport Colors [("A.hs", decline)])+ `shouldSatisfy` any (T.isInfixOf "[\ESC[33m=\ESC[0m]")++ it "sets the extension in the summary in bold" $+ reportOut (inplaceReport Colors [("A.hs", Unchanged)])+ `shouldSatisfy` any (T.isInfixOf "\ESC[1m.hs\ESC[0m")++ it "sets the file a case is about in bold, and nothing around it" $+ reportErr (inplaceReport Colors [("src/A.hs", failureAbout "src/A.hs")])+ `shouldSatisfy` any (T.isInfixOf "\ESC[1msrc/A.hs\ESC[0m")++ it "leaves the file bare when there is nobody to see it" $+ reportErr (inplaceReport Plain [("src/A.hs", failureAbout "src/A.hs")])+ `shouldSatisfy` all (not . T.isInfixOf "\ESC")++ it "sets an operator a message names in cyan" $+ reportErr (inplaceReport Colors [("A.hs", about "<|>")])+ `shouldSatisfy` any (T.isInfixOf "\ESC[36m<|>\ESC[0m")++ it "matches an operator as a whole word and not as a fragment" $ do+ let shown = T.unlines (reportErr (inplaceReport Colors [("A.hs", about ".")]))+ T.count "\ESC[36m" shown `shouldBe` 1+ shown `shouldSatisfy` T.isInfixOf "\ESC[1mA.hs\ESC[0m"++ it "leaves the operator bare when there is nobody to see it" $+ reportErr (inplaceReport Plain [("A.hs", about "<|>")])+ `shouldSatisfy` all (not . T.isInfixOf "\ESC")++ it "sets a module a message names in bold" $+ reportErr (inplaceReport Colors [("A.hs", missing "Criterion.Main")])+ `shouldSatisfy` any (T.isInfixOf "\ESC[1mCriterion.Main\ESC[0m")++ it "colors a module even where a comma follows it" $+ reportErr (inplaceReport Colors [("A.hs", missing "Criterion.Main")])+ `shouldSatisfy` any (T.isInfixOf "\ESC[1mCriterion.Main\ESC[0m,")++ it "colors the cross red" $+ reportErr (inplaceReport Colors [("A.hs", failure)])+ `shouldSatisfy` any (T.isInfixOf "[\ESC[31m✗\ESC[0m]")++ describe "breaking text to fit" $ do+ it "keeps every line within the room given" $+ map T.length (wrapTo 20 (T.replicate 40 "word ")) `shouldSatisfy` all (<= 20)++ it "breaks at spaces and nowhere else" $+ wrapTo 12 "one two three four" `shouldBe` ["one two", "three four"]++ it "gives a word too long for the room a line of its own" $+ wrapTo 8 "a supercalifragilistic b"+ `shouldBe` ["a", "supercalifragilistic", "b"]++ it "keeps a line break that was already there" $+ wrapTo 40 "first thing\nsecond thing"+ `shouldBe` ["first thing", "second thing"]++ it "has nothing to say about nothing" $+ wrapTo 20 "" `shouldBe` []++ it "measures what a reader will see, not what the text holds" $ do+ visibleLength "abc" `shouldBe` 3+ visibleLength "\ESC[31mabc\ESC[0m" `shouldBe` 3+ visibleLength "\ESC[1m\ESC[36mab\ESC[0mc" `shouldBe` 3++ it "breaks a colored line exactly where it breaks the bare one" $ do+ let bare = "alpha beta gamma delta epsilon zeta eta theta"+ lit = T.replace "gamma" "\ESC[36mgamma\ESC[0m" bare+ map visibleLength (wrapTo 20 lit) `shouldBe` map T.length (wrapTo 20 bare)++ describe "how wide anything gets" $ do+ let sprawling =+ [ ("some/quite/deeply/nested/directory/Module.hs", decline),+ ("another/quite/deeply/nested/one/Module.hs", failure)+ ]+ it "never prints a line wider than it allows itself" $+ map T.length (reportErr (inplaceReport Plain sprawling))+ `shouldSatisfy` all (<= lineWidth)++ it "does the same when the reason is enormous" $+ map T.length (reportErr (inplaceReport Plain [("A.hs", Failed (Unreadable "A.hs" (T.replicate 40 "and more words ")))]))+ `shouldSatisfy` all (<= lineWidth)++ it "wraps what it says when it gives up, too" $+ map T.length (noted Plain ("✗", Bad) (T.replicate 40 "and more words "))+ `shouldSatisfy` all (<= lineWidth)++ describe "reading a file" $ do+ it "reads it as UTF-8" $+ withBytes (T.encodeUtf8 "-- λ über ✓\n") $ \path ->+ readAsUtf8 path `shouldReturn` Right "-- λ über ✓\n"++ it "reads it as UTF-8 whatever the machine's locale is" $+ withBytes (BS.pack [0xC3, 0xA9, 0x0A]) $ \path ->+ readAsUtf8 path `shouldReturn` Right "é\n"++ it "says so when it is not UTF-8 at all" $+ withBytes (BS.pack [0x6D, 0xFF, 0xFE, 0x0A]) $ \path ->+ readAsUtf8 path `shouldReturn` Left "it is not valid UTF-8"++ it "says so when it is not there" $+ withSystemTempDirectory "tilia-run" $ \directory ->+ (isLeft <$> readAsUtf8 (directory </> "gone.hs"))+ `shouldReturn` True++ it "hands over the line endings it found, rather than the platform's" $+ withBytes "module A where\r\n" $ \path ->+ readAsUtf8 path `shouldReturn` Right "module A where\r\n"++ describe "what would be written back" $ do+ it "is unchanged when the formatter gave back what was there" $+ differs (formattingOutcome "module A where\n" "module A where\n")+ `shouldBe` False++ it "is unchanged when a file with Windows endings formats to itself" $+ differs (formattingOutcome "module A where\r\n" "module A where\n")+ `shouldBe` False++ it "puts the file's own endings back on what it writes" $+ written (formattingOutcome "module A where\r\n" "module B where\n")+ `shouldBe` Just "module B where\r\n"++ it "leaves a file that ends its lines with newlines alone" $+ written (formattingOutcome "module A where\n" "module B where\n")+ `shouldBe` Just "module B where\n"++ it "takes the endings from the first line, over a file of many" $+ written (formattingOutcome "a\r\nb\r\nc\r\n" "a\nb\nd\n")+ `shouldBe` Just "a\r\nb\r\nd\r\n"++ it "counts a file whose endings disagree as one that would change" $+ differs (formattingOutcome "a\r\nb\nc\r\n" "a\nb\nc\n") `shouldBe` True++ it "says as much in the diff, having nothing else to show" $+ T.unlines (reportOut (checkReport Plain [("A.hs", formattingOutcome "a\r\nb\nc\r\n" "a\nb\nc\n")]))+ `shouldSatisfy` T.isInfixOf "differ only in how they end their lines"++ it "leaves a carriage return that is not a line ending where it is" $+ written (formattingOutcome "x = \"a\\\r b\"\r\n" "y = \"a\\\r b\"\n")+ `shouldBe` Just "y = \"a\\\r b\"\r\n"++ describe "putting a file back" $ do+ it "writes one that changed" $+ withSource "module A where\n" $ \path -> do+ writeBack (path, Changed "module A where\n" "module B where\n")+ T.readFile path `shouldReturn` "module B where\n"++ it "writes it as UTF-8, and as the bytes it was given" $+ withSource "module A where\n" $ \path -> do+ writeBack (path, Changed "module A where\n" "-- ✓ über\r\n")+ BS.readFile path `shouldReturn` T.encodeUtf8 "-- ✓ über\r\n"++ it "takes back exactly what it read, over a whole round trip" $+ withBytes (T.encodeUtf8 "-- ü\r\nmodule A where\r\n") $ \path -> do+ Right asItIs <- readAsUtf8 path+ writeBack (path, formattingOutcome asItIs "-- ü\nmodule B where\n")+ BS.readFile path `shouldReturn` T.encodeUtf8 "-- ü\r\nmodule B where\r\n"++ it "leaves one that did not alone, down to its modification time" $+ untouched Unchanged++ it "leaves one it would not format alone" $+ untouched decline++ it "leaves one it could not format alone" $+ untouched failure++ describe "running over many files at once" $ do+ it "answers in the order it was asked, not the order it finished" $ do+ answers <- inParallel (\n -> threadDelay (1000 * (40 - n)) >> pure n) [1 .. 20 :: Int]+ answers `shouldBe` [1 .. 20]++ it "runs every one of them exactly once" $ do+ seen <- newIORef (0 :: Int)+ _ <- inParallel (\_ -> atomicModifyIORef' seen (\n -> (n + 1, ()))) [1 .. 500 :: Int]+ readIORef seen `shouldReturn` 500++ it "copes with having nothing to do" $+ inParallel pure ([] :: [Int]) `shouldReturn` []++ it "really does run them at once" $ do+ capabilities <- getNumCapabilities+ let rounds = ceiling (20 / fromIntegral capabilities :: Double) :: Int+ started <- getMonotonicTime+ _ <- inParallel (\_ -> threadDelay 100000) [1 .. 20 :: Int]+ finished <- getMonotonicTime+ (finished - started) `shouldSatisfy` (< fromIntegral rounds * 0.1 + 0.4)++----------------------------------------------------------------------------+-- Helpers++unreadable, unclaimed :: FormatError+unreadable = Unreadable "A.hs" "gone"+unclaimed = NoPackage "B.hs" NoPackageFile++-- | A file we would not touch, and two we could not.+decline, failure, otherFailure :: Outcome+decline = Declined (PositionPragmas "A.hs")+failure = Failed unreadable+otherFailure = Failed unclaimed++-- | A file with the given contents, in a directory of its own.+withSource :: Text -> (FilePath -> IO a) -> IO a+withSource contents act =+ withSystemTempDirectory "tilia-run" $ \directory -> do+ let path = directory </> "A.hs"+ T.writeFile path contents+ act path++-- | The same, for a file that has to hold exactly these bytes.+withBytes :: BS.ByteString -> (FilePath -> IO a) -> IO a+withBytes contents act =+ withSystemTempDirectory "tilia-run" $ \directory -> do+ let path = directory </> "A.hs"+ BS.writeFile path contents+ act path++-- | What writing this outcome back would put in the file.+written :: Outcome -> Maybe Text+written = \case+ Changed _ wouldBe -> Just wouldBe+ _ -> Nothing++-- | Writing this outcome back should do nothing whatsoever.+untouched :: Outcome -> Expectation+untouched outcome =+ withSource "module A where\n" $ \path -> do+ stamped <- getModificationTime path+ threadDelay 10000+ writeBack (path, outcome)+ stampedAgain <- getModificationTime path+ stampedAgain `shouldBe` stamped+ T.readFile path `shouldReturn` "module A where\n"++-- | Is this the first line of an explanation rather than a continuation?+opensAReason :: Text -> Bool+opensAReason line = T.isPrefixOf " " line && not (T.isPrefixOf " " line)++-- | A failure that names the file it is about, as the real ones do.+failureAbout :: FilePath -> Outcome+failureAbout path = Failed (Unreadable path "no such file")++-- | A case about one operator whose fixity could not be settled.+about :: Text -> Outcome+about op = Declined (UnknownFixity "A.hs" [((Nothing, OpName op), Ambiguous)])++-- | A case about an operator whose fixity is in a module we could not read.+missing :: Text -> Outcome+missing modName = missingIn [modName]++-- | The same, where more than one module could have declared it.+missingIn :: [Text] -> Outcome+missingIn = missingThrough . map (ModuleChain . (:| []))++-- | Two operators with the one answer between them, which is said once.+missingTwice :: Text -> Outcome+missingTwice = missingAll ["<|>", "<+>"]++-- | Two operators with an answer each, so neither is a plurality.+twoAnswers :: Outcome+twoAnswers =+ Declined+ ( UnknownFixity+ "A.hs"+ [ ((Nothing, OpName "<|>"), NotRead (ModuleChain ("Criterion.Main" :| []) :| [])),+ ((Nothing, OpName "<+>"), Ambiguous)+ ]+ )++-- | Any number of them, all with the one answer between them.+missingAll :: [Text] -> Text -> Outcome+missingAll ops modName =+ Declined+ ( UnknownFixity+ "A.hs"+ [((Nothing, OpName op), NotRead names) | op <- ops]+ )+ where+ names = ModuleChain (modName :| []) :| []++-- | The same again, where each import is given down to the module that+-- actually stopped the reading.+missingThrough :: [ModuleChain] -> Outcome+missingThrough chains =+ Declined (UnknownFixity "A.hs" [((Nothing, OpName "<|>"), NotRead names)])+ where+ names = case chains of+ [] -> error "an operator has to be missing from somewhere"+ c : cs -> c :| cs++-- | A report as one piece of text, with the breaks it was wrapped at undone.+flattened :: Report -> Text+flattened = T.unwords . map T.strip . reportErr
+ tests/Tilia/TargetSpec.hs view
@@ -0,0 +1,307 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Working with cabal targets.+module Tilia.TargetSpec (spec) where++import Data.List (isSuffixOf, sort)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as T+import System.Directory (createDirectoryIfMissing)+import System.FilePath (takeFileName, (</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Tilia.Project (Marker (..), ProjectRoot (..), findProjectRoot)+import Tilia.Target++spec :: Spec+spec = do+ describe "reading a target as it was written" $ do+ it "takes all as everything" $+ parseTarget "all" `shouldBe` Right Everything++ it "takes a bare word as a name that may be either" $+ parseTarget "tilia" `shouldBe` Right (Called "tilia")++ it "takes each kind of component" $ do+ parseTarget "lib:tilia" `shouldBe` Right (Qualified Nothing Lib "tilia")+ parseTarget "exe:tilia" `shouldBe` Right (Qualified Nothing Exe "tilia")+ parseTarget "test:tests" `shouldBe` Right (Qualified Nothing Test "tests")+ parseTarget "bench:speed" `shouldBe` Right (Qualified Nothing Bench "speed")++ it "takes benchmark as a spelling of bench" $+ parseTarget "benchmark:speed" `shouldBe` Right (Qualified Nothing Bench "speed")++ it "takes a package in front of the kind" $+ parseTarget "tilia:lib:tilia" `shouldBe` Right (Qualified (Just "tilia") Lib "tilia")++ it "ignores space around it" $+ parseTarget " lib:tilia " `shouldBe` Right (Qualified Nothing Lib "tilia")++ it "refuses an empty target" $+ parseTarget "" `shouldSatisfy` failed++ it "refuses a kind it does not know" $+ parseTarget "flib:thing" `shouldSatisfy` failed++ it "refuses more colons than it can account for" $+ parseTarget "a:lib:b:c" `shouldSatisfy` failed++ it "says what it would have accepted" $+ case parseTarget "flib:thing" of+ Left why -> why `shouldSatisfy` T.isInfixOf "lib:"+ Right _ -> expectationFailure "should not have parsed"++ describe "against this very project" $ do+ root <- runIO (findProjectRoot ".")+ case root of+ Nothing -> it "needs a project" $ pendingWith "no project above the working directory"+ Just here -> do+ it "is rooted at the cabal.project, not the .cabal file" $+ prMarker here `shouldBe` ProjectFile++ it "finds the three components this package declares" $+ componentsOfTarget here Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs ->+ sort (map (\c -> (componentKind c, componentName c)) cs)+ `shouldBe` sort [(Lib, "tilia"), (Exe, "tilia"), (Test, "tests")]++ it "narrows to one component when asked for one" $+ componentsOfTarget here (Qualified Nothing Lib "tilia") >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> map componentDirs cs `shouldBe` [["src"]]++ it "takes the package name as all of its components" $+ componentsOfTarget here (Called "tilia") >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> length cs `shouldBe` 3++ it "refuses a target the project does not hold, and says what it does" $+ componentsOfTarget here (Called "nothing-like-this") >>= \case+ Right cs -> expectationFailure ("matched " <> show (length cs) <> " components")+ Left problem -> do+ let said = describeTargetProblem problem+ said `shouldSatisfy` T.isInfixOf "tilia:lib:tilia"+ said `shouldSatisfy` T.isInfixOf "tilia:test:tests"+ said `shouldSatisfy` T.isInfixOf "\n all"++ it "finds this module among the test component's files" $+ componentsOfTarget here (Qualified Nothing Test "tests") >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> do+ files <- filesOfComponents cs+ map takeFileName files `shouldSatisfy` elem "TargetSpec.hs"++ it "finds only Haskell in it" $+ componentsOfTarget here Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> do+ files <- filesOfComponents cs+ filter (not . haskell) files `shouldBe` []++ it "does not wander into the build directory" $+ componentsOfTarget here Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> do+ files <- filesOfComponents cs+ filter (T.isInfixOf "dist-newstyle" . T.pack) files `shouldBe` []++ describe "against a project made up for the purpose" $ do+ it "reads the packages a cabal.project names"+ $ withProject+ [ ("cabal.project", "packages: one two\n"),+ ("one/one.cabal", package "one" "src"),+ ("one/src/A.hs", "module A where\n"),+ ("two/two.cabal", package "two" "lib"),+ ("two/lib/B.hs", "module B where\n")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> sort (map componentPackage cs) `shouldBe` ["one", "two"]++ it "expands a glob in the packages field"+ $ withProject+ [ ("cabal.project", "packages: pkgs/*/*.cabal\n"),+ ("pkgs/one/one.cabal", package "one" "src"),+ ("pkgs/two/two.cabal", package "two" "src")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> sort (map componentPackage cs) `shouldBe` ["one", "two"]++ it "passes over a package a comment has taken out"+ $ withProject+ [ ("cabal.project", "packages:\n one\n -- two\n"),+ ("one/one.cabal", package "one" "src"),+ ("two/two.cabal", package "two" "src")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> map componentPackage cs `shouldBe` ["one"]++ it "reads a packages field continued onto later lines"+ $ withProject+ [ ("cabal.project", "packages:\n one\n two\n"),+ ("one/one.cabal", package "one" "src"),+ ("two/two.cabal", package "two" "src")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> sort (map componentPackage cs) `shouldBe` ["one", "two"]++ it "reads one continued with tabs, as cabal itself does"+ $ withProject+ [ ("cabal.project", "packages:\n\tone\n\ttwo\n"),+ ("one/one.cabal", package "one" "src"),+ ("two/two.cabal", package "two" "src")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> sort (map componentPackage cs) `shouldBe` ["one", "two"]++ it "finds one a conditional has put inside a section"+ $ withProject+ [ ("cabal.project", "if impl(ghc >= 9.4)\n packages: one\n"),+ ("one/one.cabal", package "one" "src")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> map componentPackage cs `shouldBe` ["one"]++ it "walks every source directory a component names"+ $ withProject+ [ ("only.cabal", packageWith "only" ["src", "gen"]),+ ("src/A.hs", "module A where\n"),+ ("gen/B.hs", "module B where\n")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> do+ files <- filesOfComponents cs+ sort (map takeFileName files) `shouldBe` ["A.hs", "B.hs"]++ it "spells a path through a dot source directory without the dot"+ $ withProject+ [ ("only.cabal", packageWith "only" ["."]),+ ("A.hs", "module A where\n"),+ ("nested/B.hs", "module B where\n")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> do+ files <- filesOfComponents cs+ filter (T.isInfixOf "/./" . T.pack) files `shouldBe` []++ it "names a file once even when two components reach it"+ $ withProject+ [ ("both.cabal", twoComponents),+ ("bench/Main.hs", "module Main where\n")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> do+ files <- filesOfComponents cs+ length cs `shouldBe` 2+ map takeFileName files `shouldBe` ["Main.hs"]++ it "leaves hidden directories alone"+ $ withProject+ [ ("only.cabal", package "only" "src"),+ ("src/A.hs", "module A where\n"),+ ("src/.hidden/B.hs", "module B where\n")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> do+ files <- filesOfComponents cs+ map takeFileName files `shouldBe` ["A.hs"]++ it "says so when a cabal.project names nothing that exists" $+ withProject [("cabal.project", "packages: nowhere\n")] $ \root ->+ componentsOfTarget root Everything >>= \case+ Right cs -> expectationFailure ("found " <> show (length cs) <> " components")+ Left problem -> describeTargetProblem problem `shouldSatisfy` T.isInfixOf "no packages"++ it "says so when a .cabal file will not parse"+ $ withProject+ [ ("cabal.project", "packages: .\n"),+ ("broken.cabal", "this is not a cabal file at all\n")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Right cs -> expectationFailure ("found " <> show (length cs) <> " components")+ Left problem -> describeTargetProblem problem `shouldSatisfy` T.isInfixOf "does not parse"++----------------------------------------------------------------------------+-- Helpers++failed :: Either Text Target -> Bool+failed = \case+ Left _ -> True+ Right _ -> False++haskell :: FilePath -> Bool+haskell path = any (`isSuffixOf` path) [".hs", ".hs-boot", ".hsig"]++-- | A @.cabal@ file for a package with one library.+package :: Text -> Text -> Text+package name dir = packageWith name [dir]++packageWith :: Text -> [Text] -> Text+packageWith name dirs =+ T.unlines+ [ "cabal-version: 2.4",+ "name: " <> name,+ "version: 0.1.0.0",+ "",+ "library",+ " hs-source-dirs: " <> T.intercalate ", " dirs,+ " default-language: Haskell2010"+ ]++-- | Lay out a project in a temporary directory and hand over its root.+withProject :: [(FilePath, Text)] -> (ProjectRoot -> IO a) -> IO a+withProject files act =+ withSystemTempDirectory "tilia-target" $ \directory -> do+ mapM_ (place directory) files+ act (ProjectRoot directory (marker files))+ where+ place directory (path, contents) = do+ createDirectoryIfMissing True (directory </> parent path)+ T.writeFile (directory </> path) contents+ parent = reverse . drop 1 . dropWhile (/= '/') . reverse+ marker fs+ | any ((== "cabal.project") . fst) fs = ProjectFile+ | (named : _) <- [p | (p, _) <- fs, ".cabal" `isSuffixOf` p] = PackageFile named+ | otherwise = ProjectFile++-- | A package whose library sweeps the whole directory and whose benchmark+-- names a directory inside it, so that the two overlap.+twoComponents :: Text+twoComponents =+ T.unlines+ [ "cabal-version: 2.4",+ "name: both",+ "version: 0.1.0.0",+ "",+ "library",+ " default-language: Haskell2010",+ "",+ "benchmark speed",+ " type: exitcode-stdio-1.0",+ " main-is: Main.hs",+ " hs-source-dirs: bench",+ " default-language: Haskell2010"+ ]
+ tests/Tilia/TestConfig.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}++-- | The settings every corpus example is formatted with.+module Tilia.TestConfig+ ( exampleRenderConfig,+ )+where++import Data.Choice (pattern Is)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import GHC.Hs (HsModule)+import GHC.Hs.Extension (GhcPs)+import GHC.LanguageExtensions.Type (Extension)+import Tilia.Fixity+ ( Direction (..),+ Fixities,+ Fixity (..),+ Known (..),+ Namespace (..),+ OpName (..),+ Provenance (..),+ Reach (..),+ Scope (..),+ inBothNamespaces,+ nothingKnown,+ operatorsUsed,+ resolveScope,+ )+import Tilia.Fixity.Builtin (builtinFixities)+import Tilia.Pragma (effectiveExtensions)+import Tilia.Render (RenderConfig (..), defaultRenderConfig)++-- | How to format one corpus example.+exampleRenderConfig ::+ -- | What the package around it puts in force, if it is a module of one.+ [Extension] ->+ Text ->+ HsModule GhcPs ->+ RenderConfig+exampleRenderConfig package source hsModule =+ defaultRenderConfig+ { rcExtensions =+ Set.fromList (effectiveExtensions package source),+ rcScope =+ Just+ ( underEveryQualifier+ (resolveScope (Is #implicitPrelude) known hsModule)+ )+ }+ where+ known = nothingKnown {knownFixities = exportsOf}+ underEveryQualifier scope =+ scope+ { scopeInTypes = alsoQualified (scopeInTypes scope),+ scopeInTerms = alsoQualified (scopeInTerms scope)+ }+ alsoQualified reach =+ reach+ { reachQualified =+ Map.union+ (reachQualified reach)+ ( Map.fromList+ [ ((qualifier, op), (fixity, DeclaredIn qualifier))+ | (_, (Just qualifier, op)) <- operatorsUsed hsModule,+ Just exported <- [exportsOf qualifier],+ Just fixity <- [Map.lookup (InTerms, op) exported]+ ]+ )+ }++-- | What a module in scope exports, as far as the corpus is concerned.+exportsOf :: Text -> Maybe Fixities+exportsOf name = Just (Map.union ours (inBothNamespaces elsewhere))+ where+ ours = case Map.lookup name builtinFixities of+ Just exact -> exact+ Nothing -> everythingKnown++-- | Every operator any boot module exports.+everythingKnown :: Fixities+everythingKnown = Map.unions (Map.elems builtinFixities)++-- | Operators the examples use that no boot package exports.+--+-- The same list Ormolu's test suite carries, for the same reason: these+-- turn up in the examples, their fixities are not discoverable from+-- anything to hand, and without them those examples are laid out as though+-- every one of these were @infixl 9@.+elsewhere :: Map OpName Fixity+elsewhere =+ Map.fromList $+ concat+ [ ormoluOverrides,+ lens,+ esqueleto,+ servant,+ hspec,+ preludeInfix,+ outsideBoot+ ]+ where+ infixL p ops = [(OpName o, Fixity LeftAssoc p) | o <- ops]+ infixR p ops = [(OpName o, Fixity RightAssoc p) | o <- ops]+ infixN p ops = [(OpName o, Fixity NoAssoc p) | o <- ops]++ -- Five operators the corpus uses that belong to no package we can+ -- consult, and whose fixities are therefore whatever the corpus was laid+ -- out with. Two disagree with the library the spelling comes from—@.=@+ -- is @infix 4@ in lens and @#@ is @infixr 8@ there—but the expected+ -- outputs settle it, since matching them is the only thing these are+ -- for.+ ormoluOverrides =+ infixR 8 [".="]+ <> infixR 5 ["#"]+ -- Ormolu gives these 3, 3.3 and 3.7, which it can because its+ -- precedences are fractional and ours are whole numbers. Only their+ -- order relative to one another is ever exercised, and that is kept.+ <> infixR 3 [">~<"]+ <> infixR 4 ["|~|"]+ <> infixR 5 ["<~>"]++ -- @lens@, and the packages that copy its spelling.+ lens =+ infixL 8 ["^.", "^..", "^?", "^?!", "^@.", "^@..", "^@?"]+ <> infixR+ 4+ [ ".~",+ "%~",+ "?~",+ "+~",+ "-~",+ "*~",+ "//~",+ "^~",+ "^^~",+ "**~",+ "||~",+ "&&~",+ "<>~",+ "<.~",+ "<?~"+ ]+ <> infixN 4 ["%=", "?=", "+=", "-=", "*=", "//=", "<>=", ".~=", "%%="]+ <> infixR 9 ["<.", ".>", "<.>"]++ -- @esqueleto@, whose comparisons are the SQL ones with a dot on the end.+ esqueleto =+ infixL 9 ["?."]+ <> infixN 4 ["==.", "!=.", ">=.", ">.", "<=.", "like", "%."]+ <> infixR 3 ["&&."]+ <> infixR 2 ["||."]+ <> infixL 6 ["+.", "-."]+ <> infixL 7 ["*.", "/."]+ <> infixL 2 [":&"]++ -- @servant@'s way of spelling an API.+ servant = infixR 4 [":>"] <> infixR 3 [":<|>"]++ -- @hspec@ writes its expectations infix, and they are meant to be the+ -- loosest thing on the line.+ hspec =+ infixN+ 1+ [ "shouldBe",+ "shouldNotBe",+ "shouldSatisfy",+ "shouldNotSatisfy",+ "shouldContain",+ "shouldNotContain",+ "shouldMatchList",+ "shouldReturn",+ "shouldNotReturn",+ "shouldThrow",+ "shouldStartWith",+ "shouldEndWith"+ ]++ -- Functions written infix often enough to be worth knowing the fixity+ -- of, and which the list of module exports does not carry.+ preludeInfix = infixR 0 ["seq"] <> infixL 0 ["on"]++ -- Loosest-binding operators from packages outside the boot libraries.+ -- These decide layout rather than grouping: an @infixr 0@ is written at+ -- the end of the line it breaks, the way @$@ is, and without the fixity+ -- the examples come out with the operator at the start of the next one.+ outsideBoot = infixR 0 ["deepseq", "?:"]
+ tilia.cabal view
@@ -0,0 +1,254 @@+cabal-version: 2.4+name: tilia+version: 0.0.1.0+license: BSD-3-Clause+license-file: LICENSE.md+maintainer: Mark Karpov <markkarpov92@gmail.com>+tested-with:+ ghc ==9.10.3+ ghc ==9.12.4+ ghc ==9.14.1++homepage: https://github.com/mrkkrp/tilia+bug-reports: https://github.com/mrkkrp/tilia/issues+synopsis: A formatter for Haskell source code+description: A formatter for Haskell source code.+category: Development, Formatting+build-type: Simple+extra-source-files:+ corpora/hackage/hackage.manifest+ corpora/hackage/hackage.report+ corpora/vendored/**/*.hs++extra-doc-files:+ CHANGELOG.md+ README.md++source-repository head+ type: git+ location: https://github.com/mrkkrp/tilia.git++flag dev+ description: Turn on development settings.+ default: False+ manual: True++library+ exposed-modules:+ Tilia.Comments+ Tilia.Comments.Attach+ Tilia.Comments.Place+ Tilia.Cpp+ Tilia.Cpp.Macros+ Tilia.Diff+ Tilia.Doc+ Tilia.Doc.Body+ Tilia.Doc.Combinators+ Tilia.Doc.Internal+ Tilia.Equivalence+ Tilia.Fixity+ Tilia.Fixity.Builtin+ Tilia.Fixity.ByHand+ Tilia.Fixity.Cabal+ Tilia.Fixity.Cache+ Tilia.Fixity.Debug+ Tilia.Fixity.Interface+ Tilia.Fixity.PackageDb+ Tilia.Fixity.Plan+ Tilia.Format+ Tilia.Imports+ Tilia.Newline+ Tilia.Package+ Tilia.Palette+ Tilia.Parser+ Tilia.Pragma+ Tilia.Process+ Tilia.Project+ Tilia.Render+ Tilia.Render.Body+ Tilia.Render.Class+ Tilia.Render.Context+ Tilia.Render.Data+ Tilia.Render.Declaration+ Tilia.Render.Expression+ Tilia.Render.Haddock+ Tilia.Render.Header+ Tilia.Render.Layout+ Tilia.Render.Literal+ Tilia.Render.Name+ Tilia.Render.Operator+ Tilia.Render.Pattern+ Tilia.Render.Pragma+ Tilia.Render.Signature+ Tilia.Render.Type+ Tilia.Run+ Tilia.Source+ Tilia.Source.Lines+ Tilia.Span+ Tilia.Span.Ghc+ Tilia.Target+ Tilia.Utils++ hs-source-dirs: src+ default-language: GHC2021+ build-depends:+ Cabal-syntax >=3.12 && <3.17,+ Diff >=0.4 && <2,+ aeson >=2.1 && <3,+ base >=4.14 && <5,+ base16-bytestring >=1 && <2,+ bytestring >=0.11 && <0.13,+ choice >=0.2 && <0.3,+ containers >=0.5 && <0.9,+ cryptohash-sha256 >=0.11 && <0.12,+ directory ^>=1.3,+ filepath >=1.4 && <1.6,+ ghc-lib-parser >=9.14 && <9.15,+ process >=1.6 && <1.7,+ syb >=0.7 && <0.8,+ tar >=0.6 && <0.7,+ text >=2.1 && <3,+ transformers >=0.5 && <0.7,+ zlib >=0.6 && <0.8,++ if flag(dev)+ ghc-options:+ -O2+ -Wall+ -Werror+ -Wredundant-constraints+ -Wpartial-fields+ -Wunused-packages+ -haddock+ -Winvalid-haddock+ else+ ghc-options:+ -O2+ -Wall++executable tilia+ main-is: Main.hs+ hs-source-dirs: app+ other-modules: Paths_tilia+ autogen-modules: Paths_tilia+ default-language: GHC2021+ build-depends:+ base >=4.14 && <5,+ choice >=0.2 && <0.3,+ directory ^>=1.3,+ optparse-applicative >=0.14 && <0.20,+ text >=2.1 && <3,+ tilia,++ -- Twelve capabilities rather than -N, because formatting a project stops+ -- getting faster well before a machine runs out of cores and every+ -- capability past that point costs about 40 MiB and 0.15s of CPU while+ -- formatting nothing. Over this project's 43 files: 1.88s at -N1, 575ms+ -- at -N8, 518ms at -N12, 499ms at -N16, and back to 509ms at -N24. Asking+ -- for -N here instead is the same wall time as -N12 give or take noise,+ -- for 50% more CPU and 940 MiB against 520 MiB. Twelve is no worse on a+ -- smaller machine either: pinned to four cores it lands within 3% of -N4.+ --+ -- The nursery is the flag that pays for itself. At the default size the+ -- same run takes 828ms rather than 522ms, which is what the extra 320 MiB+ -- buys.+ ghc-options:+ -threaded+ -rtsopts+ "-with-rtsopts=-N12 -A32m"++ if flag(dev)+ ghc-options:+ -O2+ -Wall+ -Werror+ -Wredundant-constraints+ -Wpartial-fields+ -Wunused-packages+ -haddock+ -Winvalid-haddock+ else+ ghc-options:+ -O2+ -Wall++test-suite tests+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-tool-depends: hspec-discover:hspec-discover >=2 && <3+ hs-source-dirs: tests+ other-modules:+ Spec+ Tilia.Comments.PlaceSpec+ Tilia.CommentsSpec+ Tilia.Corpus+ Tilia.Corpus.Manifest+ Tilia.CorpusSpec+ Tilia.Cpp.MacrosSpec+ Tilia.Cpp.PropertiesSpec+ Tilia.CppSpec+ Tilia.Doc.BodySpec+ Tilia.Doc.CombinatorsSpec+ Tilia.Doc.InternalSpec+ Tilia.Doc.PropertiesSpec+ Tilia.EquivalenceSpec+ Tilia.Fixity.CabalSpec+ Tilia.Fixity.CacheSpec+ Tilia.Fixity.DebugSpec+ Tilia.Fixity.DependenciesSpec+ Tilia.Fixity.InterfaceSpec+ Tilia.Fixity.PackageDbSpec+ Tilia.Fixity.PlanSpec+ Tilia.FixitySpec+ Tilia.Gen+ Tilia.NewlineSpec+ Tilia.PackageSpec+ Tilia.PragmaSpec+ Tilia.ProcessSpec+ Tilia.ProjectSpec+ Tilia.Render.OperatorSpec+ Tilia.RenderSpec+ Tilia.RunSpec+ Tilia.TargetSpec+ Tilia.TestConfig++ default-language: GHC2021+ build-depends:+ QuickCheck >=2.14 && <3,+ base >=4.14 && <5,+ base16-bytestring >=1 && <2,+ bytestring >=0.11 && <0.13,+ choice >=0.2 && <0.3,+ containers >=0.5 && <0.9,+ cryptohash-sha256 >=0.11 && <0.12,+ directory ^>=1.3,+ filepath >=1.4 && <1.6,+ ghc-lib-parser >=9.14 && <9.15,+ hspec >=2 && <3,+ http-client >=0.7 && <0.8,+ req >=3.13 && <4,+ tar >=0.6 && <0.7,+ temporary ^>=1.3,+ text >=2.1 && <3,+ tilia,+ zlib >=0.6 && <0.8,++ ghc-options:+ -threaded+ -rtsopts+ "-with-rtsopts=-M8G -N"++ if flag(dev)+ ghc-options:+ -O2+ -Wall+ -Werror+ -Wredundant-constraints+ -Wpartial-fields+ -Wunused-packages+ -haddock+ -Winvalid-haddock+ else+ ghc-options:+ -O2+ -Wall