tilia 0.1.3.0 → 0.1.4.0
raw patch · 160 files changed
+3985/−947 lines, 160 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Tilia.Fixity: moduleName :: HsModule GhcPs -> Maybe Text
- Tilia.Pragma: optionFlags :: Text -> [Text]
+ Tilia.Cabal.Package: FLib :: Kind
+ Tilia.Cabal.Package: packageBranches :: GenericPackageDescription -> [BranchSections]
+ Tilia.Cabal.Plan: CabalFailed :: Text -> CabalFailure
+ Tilia.Cabal.Plan: Unsolvable :: Text -> CabalFailure
+ Tilia.Cabal.Plan: data CabalFailure
+ Tilia.Cabal.Project: projectConfigFiles :: FilePath -> IO [(FilePath, Either Text [Field Position])]
+ Tilia.Cabal.Target: FLib :: Kind
+ Tilia.Comments.Attach: commentText :: Margin -> Comment -> Doc
+ Tilia.Cpp: BeforeLeadingComma :: Int -> Text -> CppError
+ Tilia.Cpp.Directives: BeforeLeadingComma :: Int -> Text -> CppError
+ Tilia.Fixity: fixityInScope :: Scope -> Namespace -> Maybe Text -> OpName -> Maybe (Namespace, (Fixity, Provenance))
+ Tilia.Fixity: typeOperatorNamespace :: RdrName -> Namespace
+ Tilia.Fixity.Cache: forgetPackageCache :: Cache -> FilePath -> IO ()
+ Tilia.Fixity.Debug: instance GHC.Internal.Classes.Eq Tilia.Fixity.Debug.Namespaces
+ Tilia.Fixity.Debug: instance GHC.Internal.Show.Show Tilia.Fixity.Debug.Namespaces
+ Tilia.Format: Unwritable :: FilePath -> Text -> FormatError
+ Tilia.Format: planSourceFor :: Maybe FilePath -> IO [Component] -> IO PlanSource
+ Tilia.Process: readProgramOutputIn :: FilePath -> FilePath -> [String] -> IO (Maybe Text)
+ Tilia.Render.Pragma: spelledAsWritten :: Text -> Text -> SourceText -> Text
+ Tilia.Source: definedMacros :: Lines -> Set Text
+ Tilia.Source.Lines: definedMacros :: Lines -> Set Text
+ Tilia.Utils: readBytes :: FilePath -> IO (Either Text ByteString)
- Tilia.Cabal.Package: declaredModules :: GenericPackageDescription -> [(Text, FilePath)]
+ Tilia.Cabal.Package: declaredModules :: [BranchSections] -> [(FilePath, [(Text, FilePath)])]
- Tilia.Cabal.Plan: packageCacheRoot :: IO FilePath
+ Tilia.Cabal.Plan: packageCacheRoot :: FilePath -> IO FilePath
- Tilia.Cabal.Plan: plannedTarballs :: Cache -> BuildPlan -> IO [(PlanPackage, FilePath)]
+ Tilia.Cabal.Plan: plannedTarballs :: Cache -> FilePath -> BuildPlan -> IO [(PlanPackage, FilePath)]
- Tilia.Cabal.Plan: prepareWith :: Choice "useCache" -> Choice "download" -> ([String] -> IO (Either Text ())) -> Futility -> [PlanComponent] -> FilePath -> Readiness -> IO (Either Text ())
+ Tilia.Cabal.Plan: prepareWith :: Choice "useCache" -> Choice "download" -> ([String] -> IO (Either CabalFailure ())) -> Futility -> [PlanComponent] -> FilePath -> Readiness -> IO (Either Text ())
- Tilia.Cabal.Target: packageFilesOf :: ProjectRoot -> IO [FilePath]
+ Tilia.Cabal.Target: packageFilesOf :: ProjectRoot -> IO (Either TargetProblem [FilePath])
- Tilia.Fixity.Cache: cachedPackageCache :: Cache -> IO (Maybe FilePath)
+ Tilia.Fixity.Cache: cachedPackageCache :: Cache -> FilePath -> IO (Maybe FilePath)
- Tilia.Fixity.Cache: storePackageCache :: Cache -> FilePath -> IO ()
+ Tilia.Fixity.Cache: storePackageCache :: Cache -> FilePath -> FilePath -> IO ()
- Tilia.Fixity.Plan: Resolver :: (Text -> IO Established) -> Resolver
+ Tilia.Fixity.Plan: Resolver :: (Maybe FilePath -> Text -> IO Established) -> Resolver
- Tilia.Fixity.Plan: [askModule] :: Resolver -> Text -> IO Established
+ Tilia.Fixity.Plan: [askModule] :: Resolver -> Maybe FilePath -> Text -> IO Established
- Tilia.Fixity.Plan: newResolverVia :: Choice "useCache" -> [Route] -> PackageReader -> BuildPlan -> IO Resolver
+ Tilia.Fixity.Plan: newResolverVia :: Choice "useCache" -> [Route] -> PackageReader -> FilePath -> BuildPlan -> IO Resolver
- Tilia.Fixity.Plan: scopeFor :: Resolver -> Choice "implicitPrelude" -> NonEmpty (HsModule GhcPs) -> IO Scope
+ Tilia.Fixity.Plan: scopeFor :: Resolver -> Maybe FilePath -> Choice "implicitPrelude" -> NonEmpty (HsModule GhcPs) -> IO Scope
- Tilia.Palette: paletteFor :: IO Palette
+ Tilia.Palette: paletteFor :: Handle -> IO Palette
- Tilia.Pragma: movesPositions :: Text -> Bool
+ Tilia.Pragma: movesPositions :: [Extension] -> Text -> Bool
- Tilia.Render.Header: takeStackHeader :: Maybe Span -> [Comment] -> (Doc, [Comment])
+ Tilia.Render.Header: takeStackHeader :: [Text] -> [Comment] -> (Doc, [Comment])
- Tilia.Run: checkReport :: Palette -> [(FilePath, Outcome)] -> Report
+ Tilia.Run: checkReport :: Palette -> Palette -> [(FilePath, Outcome)] -> Report
- Tilia.Run: inplaceReport :: Palette -> [(FilePath, Outcome)] -> Report
+ Tilia.Run: inplaceReport :: Palette -> Palette -> [(FilePath, Outcome)] -> Report
- Tilia.Run: writeBack :: (FilePath, Outcome) -> IO ()
+ Tilia.Run: writeBack :: (FilePath, Outcome) -> IO (FilePath, Outcome)
Files
- CHANGELOG.md +300/−0
- README.md +11/−6
- app/Main.hs +20/−19
- bench/Tilia/Bench/Cases.hs +12/−1
- bench/Tilia/Bench/Fixity.hs +1/−1
- bench/bench.record +84/−83
- corpora/hackage/hackage.manifest +85/−85
- corpora/vendored/declaration/class/family-in-a-class-body-on-one-line-out.hs +10/−0
- corpora/vendored/declaration/class/family-in-a-class-body-on-one-line.hs +10/−0
- corpora/vendored/declaration/data/block-haddock-on-the-left-of-an-infix-constructor-out.hs +10/−0
- corpora/vendored/declaration/data/block-haddock-on-the-left-of-an-infix-constructor.hs +9/−0
- corpora/vendored/declaration/data/comment-after-the-equals-sign-out.hs +16/−0
- corpora/vendored/declaration/data/comment-after-the-equals-sign.hs +11/−0
- corpora/vendored/declaration/type/comment-after-an-arrow-out.hs +13/−0
- corpora/vendored/declaration/type/comment-after-an-arrow.hs +12/−0
- corpora/vendored/declaration/value/blank-lines-between-implicit-parameter-bindings-out.hs +22/−0
- corpora/vendored/declaration/value/blank-lines-between-implicit-parameter-bindings.hs +22/−0
- corpora/vendored/declaration/value/block-comment-across-lines-after-a-separator-out.hs +18/−0
- corpora/vendored/declaration/value/block-comment-across-lines-after-a-separator.hs +15/−0
- corpora/vendored/declaration/value/comment-after-a-guard-separator-out.hs +19/−0
- corpora/vendored/declaration/value/comment-after-a-guard-separator.hs +16/−0
- corpora/vendored/declaration/value/function/arrow/case-after-an-arrow-application-out.hs +16/−0
- corpora/vendored/declaration/value/function/arrow/case-after-an-arrow-application.hs +12/−0
- corpora/vendored/declaration/value/function/arrow/nested-block-braces-out.hs +10/−0
- corpora/vendored/declaration/value/function/arrow/nested-block-braces.hs +10/−0
- corpora/vendored/declaration/value/function/arrow/parenthesised-command-in-a-block-out.hs +15/−0
- corpora/vendored/declaration/value/function/arrow/parenthesised-command-in-a-block.hs +12/−0
- corpora/vendored/declaration/value/function/block-before-a-signature-out.hs +32/−0
- corpora/vendored/declaration/value/function/block-before-a-signature.hs +32/−0
- corpora/vendored/declaration/value/function/nested-block-braces-out.hs +21/−0
- corpora/vendored/declaration/value/function/nested-block-braces.hs +21/−0
- corpora/vendored/declaration/value/inlinable-spelled-as-written-out.hs +9/−0
- corpora/vendored/declaration/value/inlinable-spelled-as-written.hs +9/−0
- corpora/vendored/declaration/value/operand-beginning-with-a-symbol-out.hs +27/−0
- corpora/vendored/declaration/value/operand-beginning-with-a-symbol.hs +27/−0
- corpora/vendored/declaration/value/or-pattern-written-across-lines-out.hs +29/−0
- corpora/vendored/declaration/value/or-pattern-written-across-lines.hs +24/−0
- corpora/vendored/declaration/value/quotation-ending-with-a-symbol-out.hs +17/−0
- corpora/vendored/declaration/value/quotation-ending-with-a-symbol.hs +17/−0
- corpora/vendored/declaration/value/specialise-spelled-as-written-out.hs +21/−0
- corpora/vendored/declaration/value/specialise-spelled-as-written.hs +21/−0
- corpora/vendored/declaration/value/specialise-without-a-head-variable-out.hs +1/−1
- corpora/vendored/import/comment-after-the-opening-bracket-out.hs +16/−0
- corpora/vendored/import/comment-after-the-opening-bracket.hs +9/−0
- corpora/vendored/import/package-name-with-a-string-gap-out.hs +7/−0
- corpora/vendored/import/package-name-with-a-string-gap.hs +7/−0
- corpora/vendored/other/block-comment-indented-with-tabs-out.hs +17/−0
- corpora/vendored/other/block-comment-indented-with-tabs.hs +17/−0
- corpora/vendored/other/block-comment-that-code-follows-above-an-empty-line-out.hs +17/−0
- corpora/vendored/other/block-comment-that-code-follows-above-an-empty-line.hs +11/−0
- corpora/vendored/other/comment-in-a-tuple-section-out.hs +14/−0
- corpora/vendored/other/comment-in-a-tuple-section.hs +13/−0
- corpora/vendored/other/comment-opening-with-a-word-like-stack-out.hs +8/−0
- corpora/vendored/other/comment-opening-with-a-word-like-stack.hs +8/−0
- corpora/vendored/other/comment-under-a-block-comment-before-a-closing-bracket-out.hs +20/−0
- corpora/vendored/other/comment-under-a-block-comment-before-a-closing-bracket.hs +18/−0
- corpora/vendored/other/comment-under-the-last-part-of-a-construct-out.hs +7/−0
- corpora/vendored/other/comment-under-the-last-part-of-a-construct.hs +7/−0
- corpora/vendored/other/commented-language-pragma-repeating-an-extension-out.hs +13/−0
- corpora/vendored/other/commented-language-pragma-repeating-an-extension.hs +12/−0
- corpora/vendored/other/comments-after-an-item-before-a-leading-comma-out.hs +6/−0
- corpora/vendored/other/comments-after-an-item-before-a-leading-comma.hs +6/−0
- corpora/vendored/other/cpp/context-headed-by-a-macro-out.hs +29/−0
- corpora/vendored/other/cpp/context-headed-by-a-macro.hs +26/−0
- corpora/vendored/other/cpp/directives-in-a-haddock-out.hs +20/−0
- corpora/vendored/other/cpp/directives-in-a-haddock.hs +20/−0
- corpora/vendored/other/cpp/imports-around-a-conditional-holding-a-directive.hs +1/−1
- corpora/vendored/other/cpp/labels-named-like-directives-out.hs +22/−0
- corpora/vendored/other/cpp/labels-named-like-directives.hs +21/−0
- corpora/vendored/other/cpp/line-marker-passed-on-by-cpp.hs +7/−0
- corpora/vendored/other/cpp/macro-before-a-leading-comma.hs +13/−0
- corpora/vendored/other/declarations-on-one-line-out.hs +7/−0
- corpora/vendored/other/declarations-on-one-line.hs +7/−0
- corpora/vendored/other/haddock-that-documents-nothing-out.hs +12/−0
- corpora/vendored/other/haddock-that-documents-nothing.hs +12/−0
- corpora/vendored/other/line-comment-after-a-block-comment-out.hs +29/−0
- corpora/vendored/other/line-comment-after-a-block-comment.hs +22/−0
- corpora/vendored/other/line-markers-in-a-quasi-quotation-out.hs +16/−0
- corpora/vendored/other/line-markers-in-a-quasi-quotation.hs +16/−0
- corpora/vendored/other/line-markers.hs +16/−0
- corpora/vendored/other/moved-haddock-beginning-with-a-dollar-out.hs +12/−0
- corpora/vendored/other/moved-haddock-beginning-with-a-dollar.hs +10/−0
- corpora/vendored/other/moved-haddock-continued-with-a-dollar-out.hs +14/−0
- corpora/vendored/other/moved-haddock-continued-with-a-dollar.hs +11/−0
- corpora/vendored/other/options-pragma-with-no-options-out.hs +7/−0
- corpora/vendored/other/options-pragma-with-no-options.hs +7/−0
- corpora/vendored/other/position-pragma-in-a-quasi-quotation-out.hs +12/−0
- corpora/vendored/other/position-pragma-in-a-quasi-quotation.hs +12/−0
- corpora/vendored/other/stack-script-header-over-a-comment-out.hs +11/−0
- corpora/vendored/other/stack-script-header-over-a-comment.hs +10/−0
- corpora/vendored/other/warning-category-as-written-out.hs +9/−0
- corpora/vendored/other/warning-category-as-written.hs +9/−0
- corpora/vendored/signature/module-in-the-export-list-out.hsig +7/−0
- corpora/vendored/signature/module-in-the-export-list.hsig +7/−0
- src/Tilia/Cabal/Package.hs +24/−11
- src/Tilia/Cabal/Plan.hs +130/−77
- src/Tilia/Cabal/Project.hs +43/−1
- src/Tilia/Cabal/Target.hs +63/−43
- src/Tilia/Comments.hs +14/−9
- src/Tilia/Comments/Attach.hs +8/−21
- src/Tilia/Comments/Place.hs +26/−7
- src/Tilia/Cpp.hs +5/−7
- src/Tilia/Cpp/Directives.hs +10/−7
- src/Tilia/Cpp/Place.hs +16/−1
- src/Tilia/Diff.hs +23/−19
- src/Tilia/Doc/Internal.hs +1/−1
- src/Tilia/Editor.hs +4/−8
- src/Tilia/Equivalence.hs +23/−9
- src/Tilia/Fixity.hs +59/−16
- src/Tilia/Fixity/Archive.hs +10/−9
- src/Tilia/Fixity/Cabal.hs +6/−2
- src/Tilia/Fixity/Cache.hs +52/−19
- src/Tilia/Fixity/Debug.hs +58/−27
- src/Tilia/Fixity/Interface.hs +15/−5
- src/Tilia/Fixity/PackageDb.hs +21/−18
- src/Tilia/Fixity/Plan.hs +148/−58
- src/Tilia/Format.hs +40/−13
- src/Tilia/Ignore.hs +5/−2
- src/Tilia/Palette.hs +7/−7
- src/Tilia/Parser.hs +0/−1
- src/Tilia/Pragma.hs +56/−19
- src/Tilia/Process.hs +9/−2
- src/Tilia/Render.hs +1/−1
- src/Tilia/Render/Class.hs +1/−2
- src/Tilia/Render/Context.hs +2/−2
- src/Tilia/Render/Data.hs +7/−2
- src/Tilia/Render/Declaration.hs +9/−14
- src/Tilia/Render/Expression.hs +96/−41
- src/Tilia/Render/Haddock.hs +12/−12
- src/Tilia/Render/Header.hs +23/−11
- src/Tilia/Render/Pattern.hs +20/−18
- src/Tilia/Render/Pragma.hs +16/−4
- src/Tilia/Render/Signature.hs +6/−4
- src/Tilia/Render/Type.hs +38/−11
- src/Tilia/Run.hs +34/−15
- src/Tilia/Source.hs +1/−0
- src/Tilia/Source/Lines.hs +28/−8
- src/Tilia/Utils.hs +9/−0
- tests/Tilia/Cabal/PackageSpec.hs +37/−4
- tests/Tilia/Cabal/TargetSpec.hs +126/−6
- tests/Tilia/Comments/PlaceSpec.hs +7/−7
- tests/Tilia/Corpus.hs +7/−2
- tests/Tilia/CorpusSpec.hs +6/−3
- tests/Tilia/CppSpec.hs +45/−1
- tests/Tilia/DiffSpec.hs +29/−0
- tests/Tilia/EquivalenceSpec.hs +20/−0
- tests/Tilia/Fixity/CabalSpec.hs +38/−1
- tests/Tilia/Fixity/CacheSpec.hs +33/−9
- tests/Tilia/Fixity/DebugSpec.hs +49/−6
- tests/Tilia/Fixity/DependenciesSpec.hs +19/−12
- tests/Tilia/Fixity/InterfaceSpec.hs +18/−0
- tests/Tilia/Fixity/PackageDbSpec.hs +22/−0
- tests/Tilia/Fixity/PlanSpec.hs +345/−62
- tests/Tilia/FixitySpec.hs +74/−0
- tests/Tilia/IgnoreSpec.hs +3/−0
- tests/Tilia/PragmaSpec.hs +50/−4
- tests/Tilia/RunSpec.hs +102/−61
- tests/Tilia/TestUtils.hs +8/−6
- tests/Tilia/WithProjectPlan.hs +1/−1
- tilia.cabal +1/−1
CHANGELOG.md view
@@ -1,3 +1,303 @@+## Tilia 0.1.4.0++* An import is resolved first among the modules of the importing file's own+ component, as GHC resolves it, so a test suite's own `Utils` gives its+ operators their fixities rather than a library's `Utils`, and a module+ another component holds no longer stands in for a dependency's module of+ that name. [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A pattern synonym bundled with a type in an export list, as in+ `T (E, (:<))`, keeps its fixity, and `T (.., P)` exports every constructor+ of `T` with its fixity, rather than the modules importing them taking+ these operators for `infixl 9`.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* Two runs storing one answer in the cache at once no longer leave it+ holding part of the answer, or none, which a later run could take for a+ module declaring fewer fixities, or none.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A `cabal.project` that takes its `packages` from a file it imports with+ `import:`, directly or through further imports, has those packages+ formatted, as `cabal` builds them, rather than being reported as naming no+ packages, and an edit to an imported file makes the build plan stale, as+ it does for `cabal`. An import from a URL is passed over.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* An entry of the `packages` field of a `cabal.project` written with `**`,+ as `**/*.cabal`, or with more than one `*` in a name, as `pkgs/*-*`, finds+ the packages it finds for `cabal`, rather than none.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* `inplace` counts a file it cannot write, such as a read-only one, among+ the failed files, says why, and goes on with the rest, printing its+ summary and exiting with a code of its own, 20, rather than stopping at+ that file with exit code 1, which `check` uses for a file that would+ change. [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A dependency's module is read only from its path under one of the+ package's source directories, rather than from any file in its tarball+ whose path ends the same way, which could be another module's, and a+ source directory written as `src/` or `./src` is found.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* `cabal path`, which tells where `cabal` keeps the sources it downloads,+ runs in the project's directory rather than in the one Tilia runs in, so a+ `remote-repo-cache` set in the project's `cabal.project` is found, as when+ `for-editor` formats a file from outside its project, and what it says is+ remembered for that project alone.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* An operator in a type takes the fixity of the type of its name where one+ may be in scope, and that of a promoted constructor only where none can+ be, while one written with a tick, as in `':+:`, takes the constructor's.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* The constructors of a data instance exported with their family, as in+ `F (..)`, keep their fixities.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* An operator that one CPP configuration of a module declares a fixity for+ and another exports without one is left unsettled, rather than taken to+ have the declared fixity in every configuration.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* `--check-ast` no longer reports a comment as gained where it is written+ under the last import or the `module` line, further left than the comment+ at the end of that line, and goes with the code after it.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* The diffs `check` prints apply with `git apply` and `patch`: a hunk at the+ end of a file no longer shows an empty line after the last one, a file+ without a newline at its end gets `\ No newline at end of file`, and+ carriage returns are kept, so a file whose formatting changes only its+ line endings gets a diff headed with its name.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* Only the comment Stack reads its options from, the one at the margin of+ the first line, or of the line under the `#!` line, whose first word is+ `stack`, is taken for a Stack script header, so a comment such as+ `-- stacks of disks` at the top of a module stays an ordinary one rather+ than being split from its next line by an empty one.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A Haddock written between `{-` and `-}` that documents nothing has only+ the trigger of its first line escaped, rather than a backslash also being+ put before anything on its other lines that looks like a trigger.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* The lines of a block comment keep their columns against its first line+ where tabs indent them, a tab counting up to the next multiple of eight as+ GHC counts it, rather than losing or keeping a character of indentation+ for each character before the comment.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* Foreign libraries are formatted like other components: `check` and+ `inplace` take their modules, `for-editor` settles a module's extensions+ from the one that holds it, and `flib:NAME` selects one. A target may name+ its kind in any of the spellings `cabal` takes, as `library:`,+ `foreign-library:`, `executable:`, `test-suite:` or `tst:`, in any case.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* Packages are found in a package database, and their interfaces read, where+ the database or an import directory has a path holding a space, a comma or+ a character outside ASCII, which `ghc-pkg` writes quoted and escaped.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* On Windows, an absolute entry of the `packages` field of a `cabal.project`+ written with forward slashes, as `C:/proj/lib`, is looked for where it+ points rather than under the working directory of its drive, and an entry+ written with backslashes can hold a glob.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* With a compiler whose interfaces are read through `ghc --show-iface`, one+ outside GHC 9.10 to 9.14, a constructor named after its type, such as+ `:*:`, gets its fixity rather than none.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A module whose quasi-quotation holds `{-# LINE` or `{-# COLUMN` as text is+ formatted rather than declined as one using those pragmas.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* Formatting a line with comments at its end takes time linear in the line's+ length rather than quadratic: a line of 64,000 characters with 20 block+ comments after it took 17.7 seconds to format, and takes 0.3.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A dependency's source that stays missing with no download to blame, such+ as one of a package the compiler already has, any source under+ `--no-downloads`, or one the fetch for a plan given with `--build-plan`+ does not bring in, no longer makes every run ask `cabal` twice where it+ keeps sources: it is asked again only after a download leaves a source+ missing. The fetch for a plan given with `--build-plan` no longer runs on+ every run for a source it does not bring in either.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A `cabal.project`, or a file it imports, that does not parse is reported+ as not parsing, with what the parser said, rather than as naming no+ packages. [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A byte order mark at the start of a `.tiliaignore` is skipped, as Git+ skips one in a `.gitignore`, rather than being read as part of its first+ pattern. [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A comment lined up with the last line of a construct at the end of a+ module, such as under the last binding of a `where` clause, stays under+ that line, as it does where code follows, rather than going to the margin+ after an empty line. [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A comment written before the closing bracket of a tuple section, as in+ `(x, {- later -})`, stays inside the section rather than moving to the+ front of the next declaration, where the module no longer parsed, or under+ the whole declaration. [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* Blank lines between implicit-parameter bindings in a `let` or a `where`+ are kept, as between value bindings, rather than dropped.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A `case`, a `do` block or another expression that hangs after `>-` stays+ on the line of the `>-`, as one after `-<` does, rather than going on a+ line of its own under it.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* `INLINABLE` pragmas keep the spelling they are written with, `INLINABLE`+ or `INLINEABLE`, rather than all coming out as `INLINEABLE`.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* `SPECIALISE` pragmas, `SPECIALISE INLINE` and `SPECIALISE instance`+ among them, keep the spelling they are written with, `SPECIALISE` or+ `SPECIALIZE`, rather than all coming out as `SPECIALIZE`.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* An options pragma with no options, such as `{-# OPTIONS_GHC #-}`, comes+ out with one space before `#-}` rather than two.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A `cabal` failure other than one to resolve dependencies, such as a+ `cabal.project` that does not parse, is printed once rather than twice, as+ `cabal` is asked again without the test suites and benchmarks only where+ it could not resolve dependencies with them.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* Whether what goes to standard error is colored is decided by whether+ standard error is a terminal, rather than by whether standard output is,+ and a `NO_COLOR` set to the empty string no longer turns colors off, as+ no-color.org asks. [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* The summary `inplace` prints is written in the locale's encoding, with+ what it cannot show transliterated, as what goes to standard error is,+ rather than as UTF-8 whatever the locale. The module `for-editor` prints+ and the diffs `check` prints are still UTF-8.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A module declined for an alternative that aborts with `#error` names the+ line of the `#error`, where it could name line 0 when the alternative+ settled a conditional around the `#error`.+ [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* A missing build plan is reported once, as in+ `no build plan for /p: nowhere.json does not exist`, rather than as+ `no build plan for /p: no build plan at nowhere.json`, and a plan that+ does not parse is named. A source file or a `.cabal` file that cannot be+ read, and a CPP configuration that does not parse, name their file once+ too. [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* `--debug-fixity` lists a fixity a module declares for a type beside the+ one it declares for a constructor of the same name, rather than the+ constructor's alone. [PR 348](https://github.com/mrkkrp/tilia/pull/348).+* `--debug-fixity` says which namespace each fixity it lists is for, as in+ `:. infixr 5 (term)`, and gives an operator one line where its fixity is+ the same among types and among terms, as in `:- infix 8 (type & term)`.+ [PR 354](https://github.com/mrkkrp/tilia/pull/354).+* A module with a line using a macro, or an `#include`, before a leading+ comma is declined, since formatting moves the comma above that line,+ where the preprocessor can then make code that does not parse, such as+ `[1, 2, , 3 4]`. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A braced block written on one line keeps its braces where it ends a bind+ or the last argument of an application and a `;` follows, as in+ `do { x <- do { a }; pure x }`, rather than coming out as+ `do x <- do a; pure x`, which takes `pure x` into the inner block. The+ same holds for the body of a `proc`, what follows `-<` or `>-`, the+ argument of a command application, and what `static` or an `SCC` pragma+ applies to. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* Declarations written on one line, as in `x = 1; y = 2`, are separated by+ one semicolon rather than by `; ;`.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A module without CPP that holds a line marker, as in `#line 40 "M.hs"` or+ `# 40 "M.hs"`, or a `#pragma` or `#!` line other than those a script+ begins with, is declined, as one with `{-# LINE #-}` pragmas is, rather+ than having those lines dropped.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* An or-pattern written across lines inside parentheses keeps the+ semicolons between its alternatives, rather than coming out as a+ constructor applied to the rest.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A block comment of several lines written after the `->` or `=` that opens+ a body goes after that token, on lines of its own, rather than before+ it, where the token began the next line and the module no longer parsed.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A minus or a backslash is kept apart from an operand beginning with a+ symbol character, as in `- ?x`, `- #x`, `- $(x)` and `\ -1 -> 0`, rather+ than printed against it, where the two read as one operator.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A quotation whose body may end with a symbol character, as that of+ `[d| infixl 6 +++ |]` or `[| x :: Proxy * |]` may, keeps the body apart+ from its brackets, in typed quotations too, rather than coming out as+ `[d|infixl 6 +++|]`, where `+++|` lexes as one operator.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A parenthesised command broken over several lines in an arrow `do` block+ closes its bracket one step in, rather than at the column of the block,+ where the module no longer parsed.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* An export list item naming a whole module keeps the keyword `module` in a+ signature, rather than coming out as `signature Prelude`.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* In a module with CPP, an indented line opening with an `OverloadedLabels`+ label named like a directive, such as `#line` or `#if`, stays as it is+ written, since cpp takes a `#` for a directive only at the start of a+ line, rather than being moved to the margin or having the module+ declined. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A language pragma holding a comment is kept where a pragma before it+ names the same extension, rather than dropped with its comment.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* `--check-ast` reports a language pragma holding a comment that went+ missing. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* `--check-ast` reports comments of an export list that come out in+ another order. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A line comment written after a block comment on its line stays after it,+ as in `w = {- e -} -- f`, rather than coming out before it, after `w =`.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A comment on a line of its own under a trailing block comment, before a+ closing bracket, stays on its line rather than being pulled up onto the+ block comment's line, so formatting with leading commas is idempotent+ there. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A block Haddock on the left field of an infix constructor, as in+ `Int {- ^ x -} :+ Int`, stays on its line, so formatting is idempotent+ there. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A `-- ^` Haddock whose text begins with `$` keeps it unescaped when it+ moves in front of what it documents, rather than coming out as+ `-- | \$…`, which `--check-ast` refused.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* The signature of an expression ending in a block, as in+ `do { pure () } :: IO ()`, stays outside the block: the block keeps its+ braces on one line, and across lines the `::` opens a line of its own at+ the expression's column, rather than going after the block's last+ statement, where the module no longer parsed.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A comment written at the end of the line after the `=` or `->` of a guard+ goes after that token, as after the `=` of an equation without guards,+ rather than before it. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A comment written at the end of the line after the `->` of a function+ type goes after the arrow rather than before it.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A block comment written after the opening bracket of an import list, on+ the line of the module's name, stays inside the brackets rather than+ going after the module's name.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A block comment written after the `=` of a data declaration, on the line+ of the type's name, stays after the `=` rather than going before it.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* In a list written with leading commas, a block comment and a line comment+ written after an item stay after that item, rather than coming out after+ its comma and then, on the next run, in front of the next item.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A block comment of several lines that code follows on its last line no+ longer gets an empty line under it where the source has one under that+ line. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A module with CPP holding a line marker written with a number, as in+ `# 40 "M.hs"`, or a `#!` line below its top, both of which cpp passes on+ to GHC, is declined, as one without CPP is, rather than having those+ lines dropped. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A `-- ^` Haddock continued on a line written `--$`, with no space, keeps+ that line as written when it moves in front of what it documents,+ rather than coming out escaped as `-- \$`, which changed the+ documentation. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* An associated family in a class body laid out on one line comes out with+ no space before the `;` after it.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* A string gap in the package name of an import is lined up with the+ opening quote where the name moves.+ [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* The category of a `WARNING` pragma is kept as written rather than rebuilt+ from its value. [PR 355](https://github.com/mrkkrp/tilia/pull/355).+* In a module with CPP, the directives written at the margin of a block+ Haddock stay there, as they already did in other block comments, rather+ than being indented with the Haddock's lines, where cpp no longer reads+ them and every configuration gets both branches of the Haddock.+ [Issue 116](https://github.com/mrkkrp/tilia/issues/116).+* In a module with CPP, a constraint headed by a macro the module defines,+ as in `HasCallStack_ (Eq a, Show a) =>` where `HasCallStack_` stands for+ `HasCallStack =>`, gets no parentheses around it, rather than ones that+ closed in what the macro stands for, which cpp turned into a qualified+ type or a pragma inside a context that GHC rejects.+ [PR 357](https://github.com/mrkkrp/tilia/pull/357).+* Where formatting leaves a module with no lines, as one holding only empty+ lines, `check` heads its hunk with `+0,0`, as `git diff` does, rather+ than `+1,0`. [PR 358](https://github.com/mrkkrp/tilia/pull/358).+ ## Tilia 0.1.3.0 * An empty context comes out as written in a class or a data declaration,
README.md view
@@ -37,7 +37,8 @@ `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.+notion of component: libraries, foreign libraries, executables, test+suites, and benchmarks. For example, in the case of Tilia itself the valid choices are: * `all`@@ -67,16 +68,18 @@ modules a component declares get formatted: its `exposed-modules`, `other-modules`, `signatures`, and `main-is`, in every conditional branch, found under its `hs-source-dirs` as `.hs`, `.hs-boot`, or `.hsig` files.+A `Setup.hs` next to a package's `.cabal` file is formatted too. 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.+build anything. A download is made once, since Cabal's package cache is+shared between projects, and a solve is made again only when the plan goes+out of date. 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@@ -166,7 +169,9 @@ 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.+of the module is a valid Haskell module. A module with too many+configurations to format, or with something cpp passes on to GHC, such as a+line marker, is declined and left as it is. ## Comparison with other formatters
app/Main.hs view
@@ -9,7 +9,6 @@ import Data.ByteString qualified as BS import Data.Choice (Choice, fromBool, isTrue) import Data.Foldable (traverse_)-import Data.Maybe (mapMaybe) import Data.Text (Text) import Data.Text.Encoding qualified as T import Data.Text.IO qualified as T@@ -34,7 +33,6 @@ import Tilia.Cabal.Target ( Component, Target,- componentInPlan, componentsOfTarget, describeTargetProblem, filesOfComponents,@@ -44,12 +42,12 @@ import Tilia.Fixity.Debug (renderFixityNotes) import Tilia.Format ( FormatError (NoProject, Unreadable),- PlanSource (..), Session, describeFormatError, fixityNotesOf, formatErrorExitCode, newSession,+ planSourceFor, ) import Tilia.Palette (Color (Bad), Palette, paletteFor) import Tilia.Parser (ghcLibParserVersion)@@ -73,19 +71,19 @@ main = do traverse_ transliterateUnprintable [stdout, stderr] opts <- customExecParser (prefs (columns lineWidth)) optsParserInfo- palette <- paletteFor+ out <- paletteFor stdout+ err <- paletteFor stderr let cmd = optCommand opts outcomes <- case cmd of Inplace target -> do- outcomes <- formatComponents palette opts target- traverse_ writeBack outcomes- outcomes <$ printReport (inplaceReport palette outcomes)+ outcomes <- traverse writeBack =<< formatComponents err opts target+ outcomes <$ printReport T.putStr (inplaceReport out err outcomes) Check target -> do- outcomes <- formatComponents palette opts target- outcomes <$ printReport (checkReport palette outcomes)+ outcomes <- formatComponents err opts target+ outcomes <$ printReport putUtf8 (checkReport out err outcomes) ForEditor file -> do- (input, outcomes) <- formatStdin palette opts file- outcomes <$ printReport (stdinReport palette input outcomes)+ (input, outcomes) <- formatStdin err opts file+ outcomes <$ printReport putUtf8 (stdinReport err input outcomes) exitWith cmd outcomes -- | Format the files of the components a target asks for.@@ -104,13 +102,11 @@ files <- traverse makeRelativeToCurrentDirectory =<< filesOfComponents root components+ planSource <- planSourceFor optBuildPlan (pure components) session <- newSession root- ( case optBuildPlan of- Nothing -> PlanFromCabal (mapMaybe componentInPlan components)- Just givenPlan -> GivenPlan givenPlan- )+ planSource optUseCache optDownload optCheckAst@@ -204,13 +200,18 @@ (System.Exit.exitWith (ExitFailure 1)) ForEditor _ -> pure () --- | Print a 'Report'.-printReport :: Report -> IO ()-printReport report = do- BS.putStr (T.encodeUtf8 (reportOut report))+-- | Print a 'Report', with what writes its part for standard output.+printReport :: (Text -> IO ()) -> Report -> IO ()+printReport putOut report = do+ putOut (reportOut report) hFlush stdout traverse_ (T.hPutStrLn stderr) (reportErr report) hFlush stderr++-- | Write to standard output as UTF-8, whatever the locale, and with the+-- newlines as they are.+putUtf8 :: Text -> IO ()+putUtf8 = BS.putStr . T.encodeUtf8 -- | Every component the target asks for, and the project they were found -- in, which is where the run's settings are read from as well.
bench/Tilia/Bench/Cases.hs view
@@ -148,7 +148,8 @@ [ subjectOf Nothing False "synthetic/comments" commented, subjectOf Nothing False "synthetic/imports" imported, subjectOf Nothing False "synthetic/conditionals" conditional,- subjectOf Nothing False "synthetic/nesting" nested+ subjectOf Nothing False "synthetic/nesting" nested,+ subjectOf Nothing False "synthetic/long-line" long ] where commented =@@ -196,6 +197,16 @@ "", "wide :: [Int]", "wide = [" <> T.intercalate ", " (numbers 5000) <> "]"+ ]+ long =+ T.unlines+ [ "module Long where",+ "",+ "long :: [Int]",+ "long = ["+ <> T.intercalate ", " (numbers 1000)+ <> "]"+ <> foldMap (\n -> " {- " <> n <> " -}") (numbers 20) ] deeper n e = "case x of { " <> n <> " -> (" <> e <> "); _ -> x + " <> n <> " }"
bench/Tilia/Bench/Fixity.hs view
@@ -211,7 +211,7 @@ packageReader <- newPackageReader (plannedCompiler plan) [] resolver <- newResolverWith [FromSource] kept [] tarballs packageReader plan pure $ do- answers <- traverse (askModule resolver) modules+ answers <- traverse (askModule resolver Nothing) modules length <$> evaluate (force answers) packages <- for toResolve $ \release -> do modules <- fromMaybe [] <$> packageModules (tarballOf release)
bench/bench.record view
@@ -29,93 +29,94 @@ interfaces 78bbcc544104eadc # stage allocated instructions benchmark-check 262394328 561065716 Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs+check 262394328 555231347 Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs check 397446832 830954176 ShellCheck-0.11.0/src/ShellCheck/Analytics.hs-check 241124648 438396589 aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs-check 189604912 503938397 blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs-check 61103592 123879818 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs-check 80904096 166165901 distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs-check 122830480 257529681 esqueleto-3.6.0.3/test/PostgreSQL/Test.hs-check 494049016 907759201 haxl-2.5.1.1/Haxl/Core/Monad.hs-check 208630016 437290005 idris-1.3.4/src/Idris/Elab/Term.hs-check 316305056 548835398 lifted-base-0.2.3.12/Control/Exception/Lifted.hs-check 58863640 126561712 megaparsec-9.8.1/Text/Megaparsec/Internal.hs-check 78865104 169281790 optparse-applicative-0.19.0.0/tests/test.hs-check 49898856 88299550 pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs-check 155279368 326828232 pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs-check 208221512 425543616 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs-check 171071104 351249427 purescript-0.15.15/src/Language/PureScript/Errors.hs-check 83717864 177741049 purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs-check 75851168 173224739 recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs-check 87866232 190347605 servant-server-0.20.3.0/src/Servant/Server/Internal.hs-check 96614904 199151954 swagger2-2.9.1/src/Data/Swagger/Internal.hs-check 100392680 186829756 text-2.1.4/tests/Tests/Properties/Folds.hs-check 59225512 125146433 time-1.16.0.1/test/main/Test/Format/ParseTime.hs-check 65691176 132601013 tls-2.4.3/Network/TLS/Extension.hs-check 316686328 745977417 unpacked-containers-0/src/Map/Internal.hs-check 429238096 834183400 vector-0.13.2.0/src/Data/Vector/Generic.hs-check 68487400 145286254 xmonad-0.18.1/src/XMonad/Operations.hs+check 241179344 427994023 aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs+check 189525056 491514771 blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs+check 61117160 123909455 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs+check 80917320 165175283 distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs+check 122847376 257559652 esqueleto-3.6.0.3/test/PostgreSQL/Test.hs+check 494145192 876441840 haxl-2.5.1.1/Haxl/Core/Monad.hs+check 208630016 436314494 idris-1.3.4/src/Idris/Elab/Term.hs+check 313497704 525197526 lifted-base-0.2.3.12/Control/Exception/Lifted.hs+check 58885096 124278628 megaparsec-9.8.1/Text/Megaparsec/Internal.hs+check 78865104 169302733 optparse-applicative-0.19.0.0/tests/test.hs+check 49900040 86256621 pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs+check 155279368 326065024 pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs+check 208221512 424247665 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs+check 171071104 350069884 purescript-0.15.15/src/Language/PureScript/Errors.hs+check 83717864 174927701 purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs+check 75850352 154401932 recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs+check 87843760 182442615 servant-server-0.20.3.0/src/Servant/Server/Internal.hs+check 96642800 186847776 swagger2-2.9.1/src/Data/Swagger/Internal.hs+check 100410968 185782213 text-2.1.4/tests/Tests/Properties/Folds.hs+check 59225512 125094901 time-1.16.0.1/test/main/Test/Format/ParseTime.hs+check 65691176 131935007 tls-2.4.3/Network/TLS/Extension.hs+check 316481920 699896481 unpacked-containers-0/src/Map/Internal.hs+check 429238096 806439773 vector-0.13.2.0/src/Data/Vector/Generic.hs+check 68487400 140877072 xmonad-0.18.1/src/XMonad/Operations.hs decode 25986560 42986706 base-4.22.0.0 decode 6162184 7405780 bytestring-0.12.2.0 decode 9617160 11823599 containers-0.8 decode 60341752 75721656 ghc-internal-9.1401.0 decode 5048664 9492955 template-haskell-2.24.0.0 decode 6427528 6910066 text-2.1.3-format 556566968 1040003316 Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs-format 3948115280 7939983547 QuickCheck-2.18.0.0/src/Test/QuickCheck/Arbitrary.hs-format 863564728 1573781326 ShellCheck-0.11.0/src/ShellCheck/Analytics.hs-format 303951416 534115111 aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs-format 164705632 309258425 blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs-format 114058024 212152157 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs-format 170229520 316697956 distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs-format 297570528 541006283 esqueleto-3.6.0.3/test/PostgreSQL/Test.hs-format 759077968 1520521231 haxl-2.5.1.1/Haxl/Core/Monad.hs-format 483356504 878928957 idris-1.3.4/src/Idris/Elab/Term.hs-format 1320092680 2678994116 lens-5.3.6/src/Control/Lens/Wrapped.hs-format 372668480 696092011 lifted-base-0.2.3.12/Control/Exception/Lifted.hs-format 110834768 209454593 megaparsec-9.8.1/Text/Megaparsec/Internal.hs-format 143959296 262866520 optparse-applicative-0.19.0.0/tests/test.hs-format 52995496 94413105 pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs-format 361638296 659596851 pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs-format 443949808 814179116 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs-format 357025320 656146525 purescript-0.15.15/src/Language/PureScript/Errors.hs-format 150005992 275935657 purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs-format 122875928 216641468 recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs-format 164938072 301655910 servant-server-0.20.3.0/src/Servant/Server/Internal.hs-format 167528512 311088065 swagger2-2.9.1/src/Data/Swagger/Internal.hs-format 648895256 1363324909 synthetic/comments-format 105358360 225585007 synthetic/conditionals-format 76791456 114759701 synthetic/imports-format 97076928 207279778 synthetic/nesting-format 793484632 1508895855 text-2.1.4/src/Data/Text/Internal/Fusion/CaseMapping.hs-format 216925176 379840605 text-2.1.4/tests/Tests/Properties/Folds.hs-format 125519664 227671534 time-1.16.0.1/test/main/Test/Format/ParseTime.hs-format 128974056 241642635 tls-2.4.3/Network/TLS/Extension.hs-format 985060280 1912068703 unordered-containers-0.2.21/Data/HashMap/Internal.hs-format 486293072 872473350 unpacked-containers-0/src/Map/Internal.hs-format 533965872 1009710097 vector-0.13.2.0/src/Data/Vector/Generic.hs-format 132689048 241971753 xmonad-0.18.1/src/XMonad/Operations.hs-recall 5011864 9048673 aeson-2.3.1.0-recall 2205328 4115511 conduit-1.3.6.1-recall 1748312 2942852 free-5.2-recall 10404000 22672143 lens-5.3.6-recall 1825680 3287510 megaparsec-9.8.1-recall 2160552 3802105 mtl-2.3.2-recall 1351496 2492548 optics-0.4.2.1-recall 1559568 3026727 pandoc-types-1.23.1.2-recall 2337880 4125023 semigroupoids-6.0.2-recall 3239392 5595514 servant-0.20.3.0-recall 5102944 8218446 text-2.1.4-recall 3946288 7016254 vector-0.13.2.0-resolve 1711586824 2939731779 aeson-2.3.1.0-resolve 414482984 677964413 conduit-1.3.6.1-resolve 453525440 735173130 free-5.2-resolve 2764810360 4739854108 lens-5.3.6-resolve 199884528 326934357 megaparsec-9.8.1-resolve 209198760 338204339 mtl-2.3.2-resolve 63227560 99404301 optics-0.4.2.1-resolve 71461520 116712703 pandoc-types-1.23.1.2-resolve 124101824 202496534 semigroupoids-6.0.2-resolve 198377800 321014101 servant-0.20.3.0-resolve 1090795072 1819001479 text-2.1.4-resolve 2271139808 3767375431 vector-0.13.2.0+format 556595184 1024297945 Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs+format 3854465456 7712722586 QuickCheck-2.18.0.0/src/Test/QuickCheck/Arbitrary.hs+format 862511712 1567214479 ShellCheck-0.11.0/src/ShellCheck/Analytics.hs+format 295473128 517227235 aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs+format 164675032 294608279 blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs+format 113853464 207448636 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs+format 170106856 312154128 distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs+format 296607832 538709571 esqueleto-3.6.0.3/test/PostgreSQL/Test.hs+format 759369024 1508706632 haxl-2.5.1.1/Haxl/Core/Monad.hs+format 483251128 868494716 idris-1.3.4/src/Idris/Elab/Term.hs+format 1316303056 2664117713 lens-5.3.6/src/Control/Lens/Wrapped.hs+format 373374296 680947697 lifted-base-0.2.3.12/Control/Exception/Lifted.hs+format 110841232 208652611 megaparsec-9.8.1/Text/Megaparsec/Internal.hs+format 143598656 262285835 optparse-applicative-0.19.0.0/tests/test.hs+format 53015136 93114333 pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs+format 360710120 655868610 pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs+format 443773152 810435549 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs+format 356368584 653553524 purescript-0.15.15/src/Language/PureScript/Errors.hs+format 149847256 273651638 purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs+format 122975344 214196977 recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs+format 164898304 299829497 servant-server-0.20.3.0/src/Servant/Server/Internal.hs+format 167353792 307352666 swagger2-2.9.1/src/Data/Swagger/Internal.hs+format 646295808 1317931248 synthetic/comments+format 103182688 220701758 synthetic/conditionals+format 76881520 114863718 synthetic/imports+format 19981040 49830507 synthetic/long-line+format 97023824 207242378 synthetic/nesting+format 793907888 1488797446 text-2.1.4/src/Data/Text/Internal/Fusion/CaseMapping.hs+format 198569872 352095273 text-2.1.4/tests/Tests/Properties/Folds.hs+format 125558376 227176081 time-1.16.0.1/test/main/Test/Format/ParseTime.hs+format 128855712 237558926 tls-2.4.3/Network/TLS/Extension.hs+format 986781016 1895559558 unordered-containers-0.2.21/Data/HashMap/Internal.hs+format 486456840 864325592 unpacked-containers-0/src/Map/Internal.hs+format 534644928 1002665230 vector-0.13.2.0/src/Data/Vector/Generic.hs+format 132456840 239250934 xmonad-0.18.1/src/XMonad/Operations.hs+recall 5035568 9104334 aeson-2.3.1.0+recall 2206256 4115511 conduit-1.3.6.1+recall 1750872 2949239 free-5.2+recall 10419728 22711949 lens-5.3.6+recall 1827984 3292762 megaparsec-9.8.1+recall 2163752 3809556 mtl-2.3.2+recall 1352776 2495420 optics-0.4.2.1+recall 1560720 3029138 pandoc-types-1.23.1.2+recall 2341464 4133432 semigroupoids-6.0.2+recall 3245280 5631070 servant-0.20.3.0+recall 5115360 8248496 text-2.1.4+recall 4017336 7192306 vector-0.13.2.0+resolve 1716508320 2903065195 aeson-2.3.1.0+resolve 415521608 666133331 conduit-1.3.6.1+resolve 455618520 731997671 free-5.2+resolve 2779443504 4747264065 lens-5.3.6+resolve 200991232 324227373 megaparsec-9.8.1+resolve 210145040 336012772 mtl-2.3.2+resolve 63439952 98654952 optics-0.4.2.1+resolve 71737424 113796838 pandoc-types-1.23.1.2+resolve 124790624 202262598 semigroupoids-6.0.2+resolve 199289360 317418805 servant-0.20.3.0+resolve 1092843928 1794267358 text-2.1.4+resolve 2278152904 3740045561 vector-0.13.2.0
corpora/hackage/hackage.manifest view
@@ -154,7 +154,7 @@ formatted dd8c9bc90890 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 d018d2c7e144 Agda-2.8.0/src/full/Agda/Syntax/Parser/Tokens.hs-formatted a0ef5d8e9313 Agda-2.8.0/src/full/Agda/Syntax/Position.hs+formatted 852250f6def7 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 cddc9daac015 Agda-2.8.0/src/full/Agda/Syntax/Scope/Base.hs@@ -178,7 +178,7 @@ formatted 109612b2572f 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 522c2e92c2f2 Agda-2.8.0/src/full/Agda/TypeChecking/Abstract.hs+formatted f0d75a71448d Agda-2.8.0/src/full/Agda/TypeChecking/Abstract.hs formatted e757073d2d4e Agda-2.8.0/src/full/Agda/TypeChecking/CheckInternal.hs formatted 2d6bbce1312f Agda-2.8.0/src/full/Agda/TypeChecking/CheckInternal.hs-boot formatted 32a35663e792 Agda-2.8.0/src/full/Agda/TypeChecking/CompiledClause.hs@@ -205,7 +205,7 @@ formatted 2c03c6d0d27b Agda-2.8.0/src/full/Agda/TypeChecking/DropArgs.hs formatted c4bcc3ec3efc Agda-2.8.0/src/full/Agda/TypeChecking/Empty.hs formatted 546e2690c8bd Agda-2.8.0/src/full/Agda/TypeChecking/Empty.hs-boot-formatted d796fe01f1e9 Agda-2.8.0/src/full/Agda/TypeChecking/Errors.hs+formatted d66d78d15813 Agda-2.8.0/src/full/Agda/TypeChecking/Errors.hs formatted 4d637dbd29d8 Agda-2.8.0/src/full/Agda/TypeChecking/Errors.hs-boot formatted aaf8e5a6f74a Agda-2.8.0/src/full/Agda/TypeChecking/Errors/Names.hs formatted fa9468d1b394 Agda-2.8.0/src/full/Agda/TypeChecking/EtaContract.hs@@ -236,22 +236,22 @@ formatted 9825c48e7a9c Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars/Occurs.hs formatted d47e8c206217 Agda-2.8.0/src/full/Agda/TypeChecking/Modalities.hs formatted 1fd16a038ff2 Agda-2.8.0/src/full/Agda/TypeChecking/Monad.hs-formatted 4d33b706cb4f Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Base.hs+formatted 0ed8f798da0a Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Base.hs formatted 9ab4cf397957 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 a0072b209daf Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Builtin.hs+formatted 384a0401d298 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 d3627bb3ef79 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Caching.hs formatted ceeedfc93ba5 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Closure.hs formatted c94a9adc6e79 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Constraints.hs-formatted 965403e8d54c Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Context.hs+formatted 868d2a157e43 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 93f76be51b99 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 2b0eabe8c79e Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Env.hs formatted 46512cb4f780 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Imports.hs-formatted a4bdd532cdc1 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/MetaVars.hs+formatted 7d9f46715dba 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 a46ae335e8c2 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Modality.hs formatted bbf8f13a117e Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Mutual.hs@@ -266,7 +266,7 @@ formatted ede0f3649b77 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 49a778fb5b1f Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Trace.hs-formatted 38ca9a4b989f Agda-2.8.0/src/full/Agda/TypeChecking/Names.hs+formatted 9fd81672bd87 Agda-2.8.0/src/full/Agda/TypeChecking/Names.hs formatted 5519525e6548 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@@ -277,7 +277,7 @@ formatted 2f5659c12840 Agda-2.8.0/src/full/Agda/TypeChecking/Polarity.hs-boot formatted 2901072a89fa Agda-2.8.0/src/full/Agda/TypeChecking/Positivity.hs formatted 5626959a260d Agda-2.8.0/src/full/Agda/TypeChecking/Positivity/Occurrence.hs-formatted 37a92ee30da4 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty.hs+formatted fc17ec29d60f Agda-2.8.0/src/full/Agda/TypeChecking/Pretty.hs formatted 7c15c0f77e82 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty.hs-boot formatted 9a154e2294df 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@@ -287,7 +287,7 @@ formatted bf4e737ce041 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Warning.hs-boot formatted 3d893370c964 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive.hs formatted 3c8fe98419dd Agda-2.8.0/src/full/Agda/TypeChecking/Primitive.hs-boot-formatted 8ed22976b92a Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Base.hs+formatted da2381c955f4 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Base.hs formatted 449b06119ca8 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Cubical.hs formatted 2ea530f280a4 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@@ -300,14 +300,14 @@ formatted 2d7e0d93add3 Agda-2.8.0/src/full/Agda/TypeChecking/RecordPatterns.hs formatted 2ea1183d053a Agda-2.8.0/src/full/Agda/TypeChecking/Records.hs formatted 65b1d93597cd Agda-2.8.0/src/full/Agda/TypeChecking/Records.hs-boot-formatted d796d469ac77 Agda-2.8.0/src/full/Agda/TypeChecking/Reduce.hs+formatted c04a8dcdb87f Agda-2.8.0/src/full/Agda/TypeChecking/Reduce.hs formatted 82cb10489996 Agda-2.8.0/src/full/Agda/TypeChecking/Reduce.hs-boot formatted 902d61b8794a 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 8290b6f13ee3 Agda-2.8.0/src/full/Agda/TypeChecking/Reduce/Monad.hs formatted 4138b13a5df5 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting.hs formatted 0158a552c77f Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting.hs-boot-formatted a5b5675ddb35 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/Clause.hs+formatted b3f48345a2ca Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/Clause.hs formatted e53d93353f66 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/Confluence.hs formatted ffa8c612942d Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/NonLinMatch.hs formatted cf2803dfe738 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/NonLinPattern.hs@@ -349,11 +349,11 @@ formatted 904a4e241e74 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/Utils.hs formatted 0be08dcf3e01 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/WarshallSolver.hs formatted dace03972057 Agda-2.8.0/src/full/Agda/TypeChecking/Sort.hs-formatted 23e9f5a4dd33 Agda-2.8.0/src/full/Agda/TypeChecking/Substitute.hs-formatted 5c1090094604 Agda-2.8.0/src/full/Agda/TypeChecking/Substitute/Class.hs+formatted e672d69282fb Agda-2.8.0/src/full/Agda/TypeChecking/Substitute.hs+formatted ed6f3c6c04cb 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 bdddf47208eb Agda-2.8.0/src/full/Agda/TypeChecking/SyntacticEquality.hs-formatted 9403f483b826 Agda-2.8.0/src/full/Agda/TypeChecking/Telescope.hs+formatted 64e7a1aa36eb Agda-2.8.0/src/full/Agda/TypeChecking/Telescope.hs formatted d94c0d202dfc Agda-2.8.0/src/full/Agda/TypeChecking/Telescope.hs-boot formatted a311599b882a Agda-2.8.0/src/full/Agda/TypeChecking/Telescope/Path.hs formatted 065cd440ceef Agda-2.8.0/src/full/Agda/TypeChecking/Unquote.hs@@ -363,7 +363,7 @@ 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 0f294429e9ba Agda-2.8.0/src/full/Agda/Utils/Bag.hs-formatted 3856d320f4f2 Agda-2.8.0/src/full/Agda/Utils/Benchmark.hs+formatted ede5e2261435 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 66c20e52ae54 Agda-2.8.0/src/full/Agda/Utils/Boolean.hs@@ -386,7 +386,7 @@ formatted 873df66a7304 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 8328694f97ac Agda-2.8.0/src/full/Agda/Utils/HashTable.hs formatted 019e9637b9b0 Agda-2.8.0/src/full/Agda/Utils/Haskell/Syntax.hs formatted e861d8cbd7ce Agda-2.8.0/src/full/Agda/Utils/IArray.hs formatted 8d53e1639c43 Agda-2.8.0/src/full/Agda/Utils/IO.hs@@ -440,14 +440,14 @@ formatted fe0ca6de293d Agda-2.8.0/src/full/Agda/Utils/Zipper.hs formatted 86e923a357db Agda-2.8.0/src/main/Main.hs formatted 61f76fd386b5 Agda-2.8.0/src/setup/Agda/Setup.hs-formatted 4fdcc92be0f4 Agda-2.8.0/src/setup/Agda/Setup/DataFiles.hs+formatted 57e71e771600 Agda-2.8.0/src/setup/Agda/Setup/DataFiles.hs formatted 7a631dd4456c 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 0971b82d0690 HUnit-1.6.2.0/src/Test/HUnit/Base.hs-formatted 259f46f80849 HUnit-1.6.2.0/src/Test/HUnit/Lang.hs+formatted e35d465aa045 HUnit-1.6.2.0/src/Test/HUnit/Base.hs+formatted cb7ff16c7dc4 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@@ -617,7 +617,7 @@ formatted 1aaa3e2316a9 ansi-terminal-1.1.5/win/System/Console/ANSI/Windows/Foreign.hs formatted e763680dce5b ansi-terminal-1.1.5/win/System/Console/ANSI/Windows/Win32/Types.hs formatted 9e25d9947df5 async-2.2.6/Control/Concurrent/Async.hs-partly-checked f088ecc2c2e1 async-2.2.6/Control/Concurrent/Async/Internal.hs+partly-checked a1029cf51bc3 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@@ -627,7 +627,7 @@ formatted 4db35c37a9a6 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 00312ec6e47a 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@@ -636,7 +636,7 @@ formatted dbeb97f732d5 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 c4be73924922 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@@ -759,7 +759,7 @@ formatted 4115c76b6f3d aws-0.25.3/Aws/SimpleDb.hs formatted 0b6040677d6d aws-0.25.3/Aws/SimpleDb/Commands.hs formatted 30e4762ca046 aws-0.25.3/Aws/SimpleDb/Commands/Attributes.hs-formatted 66e68309ec36 aws-0.25.3/Aws/SimpleDb/Commands/Domain.hs+formatted 2f311cda5b86 aws-0.25.3/Aws/SimpleDb/Commands/Domain.hs formatted d6accda5efc3 aws-0.25.3/Aws/SimpleDb/Commands/Select.hs formatted 75d5726cf334 aws-0.25.3/Aws/SimpleDb/Core.hs formatted 412e7ea774c8 aws-0.25.3/Aws/Sqs.hs@@ -794,7 +794,7 @@ 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 f732441f45ac bifunctors-5.6.3/src/Data/Biapplicative.hs+formatted 77e2e9cc64d0 bifunctors-5.6.3/src/Data/Biapplicative.hs formatted 463448893cde bifunctors-5.6.3/src/Data/Bifunctor/Biap.hs formatted 9705f6a45db6 bifunctors-5.6.3/src/Data/Bifunctor/Biff.hs formatted 738f47d063bd bifunctors-5.6.3/src/Data/Bifunctor/Clown.hs@@ -1571,11 +1571,11 @@ formatted f520242138c3 conduit-1.3.6.1/src/Data/Conduit/Combinators/Stream.hs formatted 438fcb6d4096 conduit-1.3.6.1/src/Data/Conduit/Combinators/Unqualified.hs formatted 8e861a915c2f conduit-1.3.6.1/src/Data/Conduit/Internal.hs-formatted c35f5a66accc conduit-1.3.6.1/src/Data/Conduit/Internal/Conduit.hs+formatted 98597865ff40 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 bf0df637e814 conduit-1.3.6.1/src/Data/Conduit/Internal/Pipe.hs-formatted 4a4c14b72249 conduit-1.3.6.1/src/Data/Conduit/Lift.hs+formatted 5a515cebf8f7 conduit-1.3.6.1/src/Data/Conduit/Internal/Pipe.hs+formatted 926d89b12351 conduit-1.3.6.1/src/Data/Conduit/Lift.hs formatted e698a877d8f0 conduit-1.3.6.1/src/Data/Conduit/List.hs formatted 98630a5362e8 conduit-1.3.6.1/src/Data/Streaming/FileRead.hs formatted 9860da5f427f conduit-1.3.6.1/src/Data/Streaming/Filesystem.hs@@ -1701,15 +1701,15 @@ 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 629f31e714bd 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 2f0cabb85d66 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 63f76fd57ace 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@@ -1872,7 +1872,7 @@ formatted 988c01fea196 dlist-1.0/tests/ImportUnsafe.hs formatted 7878296311fe dlist-1.0/tests/Main.hs formatted 4d7411576558 dlist-1.0/tests/OverloadedStrings.hs-formatted 0c9b9888b599 dlist-1.0/tests/QuickCheckUtil.hs+formatted 2393b4a3587d 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@@ -2196,7 +2196,7 @@ formatted 691876a14ba8 flatparse-0.5.6.1/bench/Megaparsec.hs formatted 4e5c403e7a3b flatparse-0.5.6.1/bench/Parsec.hs formatted 767291fb667b flatparse-0.5.6.1/bench/ReadInteger.hs-formatted 94b6d379ba91 flatparse-0.5.6.1/src/FlatParse/Basic.hs+formatted bcacec1d3ede flatparse-0.5.6.1/src/FlatParse/Basic.hs formatted 162dda57b01e flatparse-0.5.6.1/src/FlatParse/Basic/Addr.hs formatted e944703d9644 flatparse-0.5.6.1/src/FlatParse/Basic/Base.hs formatted 2f38d187e067 flatparse-0.5.6.1/src/FlatParse/Basic/Bytes.hs@@ -2212,9 +2212,9 @@ formatted 10cb24214eea flatparse-0.5.6.1/src/FlatParse/Common/Switch.hs formatted 412fc97e8505 flatparse-0.5.6.1/src/FlatParse/Examples/BasicLambda/Lexer.hs formatted 2c72cb96232c flatparse-0.5.6.1/src/FlatParse/Examples/BasicLambda/Parser.hs-formatted e5272a875046 flatparse-0.5.6.1/src/FlatParse/Minimal.hs+formatted 24e21b400286 flatparse-0.5.6.1/src/FlatParse/Minimal.hs formatted 3f356742f6e5 flatparse-0.5.6.1/src/FlatParse/Minimal/Internal.hs-formatted 7ecd84a0c48e flatparse-0.5.6.1/src/FlatParse/Stateful.hs+formatted 1fc3563f3fee flatparse-0.5.6.1/src/FlatParse/Stateful.hs formatted 122b007be519 flatparse-0.5.6.1/src/FlatParse/Stateful/Addr.hs formatted bc3b9c3f288a flatparse-0.5.6.1/src/FlatParse/Stateful/Base.hs formatted 944f11f97db1 flatparse-0.5.6.1/src/FlatParse/Stateful/Bytes.hs@@ -2226,7 +2226,7 @@ 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 9fcd1a6b4714 free-5.2/src/Control/Alternative/Free.hs+formatted 0fed369b08ea free-5.2/src/Control/Alternative/Free.hs formatted 6cdf81c21164 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@@ -2468,7 +2468,7 @@ formatted 3fc4bde8aaae hledger-1.52.1/Hledger/Cli/Commands/Incomestatement.hs formatted e795242e76e2 hledger-1.52.1/Hledger/Cli/Commands/Notes.hs formatted 7868c26f6945 hledger-1.52.1/Hledger/Cli/Commands/Payees.hs-formatted 74c42e16a7cb hledger-1.52.1/Hledger/Cli/Commands/Prices.hs+formatted fe56fd581b75 hledger-1.52.1/Hledger/Cli/Commands/Prices.hs formatted 177a0e3d59ff hledger-1.52.1/Hledger/Cli/Commands/Print.hs formatted b3664f32c410 hledger-1.52.1/Hledger/Cli/Commands/Register.hs formatted fe57269eee06 hledger-1.52.1/Hledger/Cli/Commands/Rewrite.hs@@ -2751,7 +2751,7 @@ formatted 77ebc33633f8 idris-1.3.4/src/Idris/Elab/RunElab.hs formatted 711d76a30f2c idris-1.3.4/src/Idris/Elab/Term.hs formatted 43565a6d9bac idris-1.3.4/src/Idris/Elab/Transform.hs-formatted cf8cbbec4fe7 idris-1.3.4/src/Idris/Elab/Type.hs+formatted eb98b1329d21 idris-1.3.4/src/Idris/Elab/Type.hs formatted b3e66f72a9ac idris-1.3.4/src/Idris/Elab/Utils.hs formatted ac9c50ffdaf7 idris-1.3.4/src/Idris/Elab/Value.hs formatted 5ce0ed3888f3 idris-1.3.4/src/Idris/ElabDecls.hs@@ -2817,7 +2817,7 @@ formatted 1cefb44a49bc leksah-0.16.2.2/data/leksah-welcome/test/Main.hs formatted 34cb8bb8a612 leksah-0.16.2.2/main/Main.hs formatted 0d71ef1dc947 leksah-0.16.2.2/src/IDE/BufferMode.hs-formatted 0cd8482b4f61 leksah-0.16.2.2/src/IDE/Build.hs+formatted 404f52b9bd79 leksah-0.16.2.2/src/IDE/Build.hs formatted d08cdd390358 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@@ -2834,7 +2834,7 @@ formatted b8029845c5f6 leksah-0.16.2.2/src/IDE/Core/Types.hs formatted 375889d7ec16 leksah-0.16.2.2/src/IDE/Debug.hs does-not-parse - leksah-0.16.2.2/src/IDE/Find.hs-formatted a7b49b049b8e leksah-0.16.2.2/src/IDE/GUIHistory.hs+formatted 4d3884c63c61 leksah-0.16.2.2/src/IDE/GUIHistory.hs formatted 8ac61c496a03 leksah-0.16.2.2/src/IDE/HLint.hs formatted 8ddfdb5cd7cb leksah-0.16.2.2/src/IDE/ImportTool.hs formatted c94ba55b56fd leksah-0.16.2.2/src/IDE/Keymap.hs@@ -2893,7 +2893,7 @@ formatted 1e7ca6c2bac4 lens-5.3.6/examples/Turtle.hs formatted e865ae48f11b lens-5.3.6/lens-properties/Setup.hs formatted 03d5b652be06 lens-5.3.6/lens-properties/src/Control/Lens/Properties.hs-formatted fb677a8ca744 lens-5.3.6/src/Control/Exception/Lens.hs+formatted 458d82357e04 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@@ -2941,7 +2941,7 @@ formatted 6e871d8e4385 lens-5.3.6/src/Control/Lens/Review.hs formatted 5f1a95d65c20 lens-5.3.6/src/Control/Lens/Setter.hs formatted fa7936ec3040 lens-5.3.6/src/Control/Lens/TH.hs-formatted 9164ff122ee8 lens-5.3.6/src/Control/Lens/Traversal.hs+formatted 17d4f9d6b2ac 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@@ -2987,17 +2987,17 @@ formatted a554fa5629d9 lens-5.3.6/tests/hunit.hs declined - lens-5.3.6/tests/properties.hs formatted 4bd3d2baa141 lens-5.3.6/tests/templates.hs-formatted 2a47884feb32 lifted-base-0.2.3.12/Control/Concurrent/Chan/Lifted.hs-formatted 2878fb30d603 lifted-base-0.2.3.12/Control/Concurrent/Lifted.hs-formatted 5ca1cae42a21 lifted-base-0.2.3.12/Control/Concurrent/MVar/Lifted.hs-formatted 7896c1c8db7e lifted-base-0.2.3.12/Control/Concurrent/QSem/Lifted.hs-formatted 0e92e2e3c452 lifted-base-0.2.3.12/Control/Concurrent/QSemN/Lifted.hs-formatted 5cc7e142b7a9 lifted-base-0.2.3.12/Control/Concurrent/SampleVar/Lifted.hs-formatted 9a9d09688902 lifted-base-0.2.3.12/Control/Exception/Lifted.hs-formatted 6ce3f2d36b4c lifted-base-0.2.3.12/Data/IORef/Lifted.hs+formatted 1710cd1da159 lifted-base-0.2.3.12/Control/Concurrent/Chan/Lifted.hs+formatted 9afd73e18f04 lifted-base-0.2.3.12/Control/Concurrent/Lifted.hs+formatted 61a68e35cd0d lifted-base-0.2.3.12/Control/Concurrent/MVar/Lifted.hs+formatted 9e4f63e571b9 lifted-base-0.2.3.12/Control/Concurrent/QSem/Lifted.hs+formatted db70a2e6121a lifted-base-0.2.3.12/Control/Concurrent/QSemN/Lifted.hs+formatted e977da901a85 lifted-base-0.2.3.12/Control/Concurrent/SampleVar/Lifted.hs+formatted 054d7b6af1e4 lifted-base-0.2.3.12/Control/Exception/Lifted.hs+formatted 22bce56a50cb lifted-base-0.2.3.12/Data/IORef/Lifted.hs formatted 0232c1b3e9de lifted-base-0.2.3.12/Foreign/Marshal/Utils/Lifted.hs formatted e865ae48f11b lifted-base-0.2.3.12/Setup.hs-formatted 5d96e3b3a63b lifted-base-0.2.3.12/System/Timeout/Lifted.hs+formatted 577a6034129f lifted-base-0.2.3.12/System/Timeout/Lifted.hs formatted 8186b0308f97 lifted-base-0.2.3.12/bench/bench.hs formatted 969f026a4085 lifted-base-0.2.3.12/test/test.hs formatted 0331614d7776 megaparsec-9.8.1/Text/Megaparsec.hs@@ -3025,7 +3025,7 @@ partly-checked 37206fb8e023 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-partly-checked a6c752419362 microlens-0.5.0.0/src/Lens/Micro/Internal.hs+partly-checked e7bef62398e7 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@@ -3238,7 +3238,7 @@ formatted 25cccdcbef5d pandoc-3.10.2/src/Text/Pandoc/Readers/Textile.hs formatted 7e7d5f748c66 pandoc-3.10.2/src/Text/Pandoc/Readers/TikiWiki.hs formatted 92e7cf81f874 pandoc-3.10.2/src/Text/Pandoc/Readers/Txt2Tags.hs-formatted 4af418633a39 pandoc-3.10.2/src/Text/Pandoc/Readers/Typst.hs+formatted 38ba4ac13251 pandoc-3.10.2/src/Text/Pandoc/Readers/Typst.hs formatted 571c0f71e243 pandoc-3.10.2/src/Text/Pandoc/Readers/Typst/Math.hs formatted 862b8ee41599 pandoc-3.10.2/src/Text/Pandoc/Readers/Typst/Parsing.hs formatted d9474be2d4dd pandoc-3.10.2/src/Text/Pandoc/Readers/Vimwiki.hs@@ -3325,7 +3325,7 @@ formatted 64258df1d09e pandoc-3.10.2/src/Text/Pandoc/Writers/Shared.hs formatted 6ff714d9bc8d pandoc-3.10.2/src/Text/Pandoc/Writers/TEI.hs formatted 01231d1cd443 pandoc-3.10.2/src/Text/Pandoc/Writers/Texinfo.hs-formatted 3a596ddb6e0a pandoc-3.10.2/src/Text/Pandoc/Writers/Textile.hs+formatted c961b91b586a pandoc-3.10.2/src/Text/Pandoc/Writers/Textile.hs formatted e65d7bf1c614 pandoc-3.10.2/src/Text/Pandoc/Writers/Txt2Tags.hs formatted ab0ca20ffb33 pandoc-3.10.2/src/Text/Pandoc/Writers/Typst.hs formatted 5753a1fc2b52 pandoc-3.10.2/src/Text/Pandoc/Writers/Vimdoc.hs@@ -3414,7 +3414,7 @@ formatted 2f99ad7040cc 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 521e0dcaf505 pandoc-types-1.23.1.2/src/Text/Pandoc/Walk.hs+formatted a6d367888d28 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 aa803b05c956 pandoc-types-1.23.1.2/test/test-pandoc-types.hs formatted 7474b7e1d4f5 parsec3-1.0.1.8/Setup.hs@@ -3530,12 +3530,12 @@ 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 c9e4b8790a2e pipes-4.3.16/src/Pipes.hs-formatted 73ed6cfff72e 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 d96fb6cefc30 pipes-4.3.16/benchmarks/PreludeBench.hs+formatted c033c83ec4cb pipes-4.3.16/src/Pipes.hs+formatted e3dc5b339200 pipes-4.3.16/src/Pipes/Core.hs+formatted a6c6ec5a4f4c pipes-4.3.16/src/Pipes/Internal.hs+formatted b0d9eaef316b pipes-4.3.16/src/Pipes/Lift.hs+formatted b21ef8ba8f5d pipes-4.3.16/src/Pipes/Prelude.hs formatted 436224de8a77 pipes-4.3.16/src/Pipes/Tutorial.hs formatted 068bd78f1e97 pipes-4.3.16/tests/Main.hs formatted 56dca68e0a87 postgrest-9.0.1/Setup.hs@@ -3888,7 +3888,7 @@ formatted 7a6d55f211a6 raaz-0.3.11/core/Raaz/Core/Types/Endian.hs formatted a48c22bbc9bf raaz-0.3.11/core/Raaz/Core/Types/Equality.hs formatted 72aa730843b9 raaz-0.3.11/core/Raaz/Core/Types/Internal.hs-formatted 131bd6941a42 raaz-0.3.11/core/Raaz/Core/Types/Pointer.hs+formatted c7e28dcd7d70 raaz-0.3.11/core/Raaz/Core/Types/Pointer.hs formatted f9be8525b0e9 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@@ -4020,13 +4020,13 @@ 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 bfa9329aa42a safe-exceptions-0.1.7.4/src/Control/Exception/Safe.hs+formatted 71750c378530 safe-exceptions-0.1.7.4/src/Control/Exception/Safe.hs formatted d65c0e991a57 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 6fcd3c78e09a scientific-0.3.8.1/src/Data/Scientific.hs+formatted 862aefb94cc9 scientific-0.3.8.1/src/Data/Scientific.hs formatted 5837fdbf8485 scientific-0.3.8.1/src/Data/Text/Lazy/Builder/Scientific.hs formatted e18e1762aa10 scientific-0.3.8.1/src/GHC/Integer/Compat.hs formatted 70da6923c6d5 scientific-0.3.8.1/src/Utils.hs@@ -4265,7 +4265,7 @@ 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 62fa7f2a0865 shake-0.19.9/src/Test/FilePath.hs+formatted 1dd160a81730 shake-0.19.9/src/Test/FilePath.hs formatted 19b187c8cbe6 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@@ -4406,28 +4406,28 @@ formatted bd8bb4f92c76 statistics-0.16.5.0/Statistics/Distribution/Weibull.hs formatted a5d3ccd314a5 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 3802c4ce0920 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 7333b62fa746 statistics-0.16.5.0/Statistics/Sample/KernelDensity.hs+formatted 5148550f72c0 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 bae6889ac8ec statistics-0.16.5.0/Statistics/Sample/Normalize.hs formatted 1242733971ab statistics-0.16.5.0/Statistics/Sample/Powers.hs formatted 5530b1f597e3 statistics-0.16.5.0/Statistics/Test/Bartlett.hs-formatted da8b73ff5c88 statistics-0.16.5.0/Statistics/Test/ChiSquared.hs+formatted 4ba8ec52c2e3 statistics-0.16.5.0/Statistics/Test/ChiSquared.hs formatted 4990518d53f6 statistics-0.16.5.0/Statistics/Test/Internal.hs-formatted b240b0717330 statistics-0.16.5.0/Statistics/Test/KolmogorovSmirnov.hs+formatted 93bdbc32499f 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 958fe17b2454 statistics-0.16.5.0/Statistics/Test/Levene.hs formatted 537ff3519540 statistics-0.16.5.0/Statistics/Test/MannWhitneyU.hs-formatted 63ad198bde51 statistics-0.16.5.0/Statistics/Test/StudentT.hs+formatted 24eee9104de3 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 96689c868795 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@@ -4442,7 +4442,7 @@ 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 3f54ac156fe8 statistics-0.16.5.0/tests/Tests/Matrix/Types.hs formatted 5815fd5a68d5 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@@ -4471,7 +4471,7 @@ formatted 0f86f9b94d82 stm-2.5.3.1/testsuite/src/Stm065.hs formatted 0872066614e0 swagger2-2.9.1/Setup.hs formatted e61f805d8652 swagger2-2.9.1/examples/hackage.hs-formatted 3c1b0b04d952 swagger2-2.9.1/src/Data/HashMap/Strict/InsOrd/Compat.hs+formatted 947090f59ec4 swagger2-2.9.1/src/Data/HashMap/Strict/InsOrd/Compat.hs formatted d71d272f220f swagger2-2.9.1/src/Data/Swagger.hs formatted f496ee0d4d0c swagger2-2.9.1/src/Data/Swagger/Declare.hs formatted 5302fa19a1a8 swagger2-2.9.1/src/Data/Swagger/Internal.hs@@ -4605,7 +4605,7 @@ formatted 7297075f77b5 text-2.1.4/src/Data/Text/Internal/Reverse.hs formatted 9ddb417cbaa3 text-2.1.4/src/Data/Text/Internal/Search.hs formatted 67bf06cca611 text-2.1.4/src/Data/Text/Internal/StrictBuilder.hs-formatted ed455e9ee12d text-2.1.4/src/Data/Text/Internal/Transformation.hs+formatted 66ed61ee4282 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 8bc67bc79968 text-2.1.4/src/Data/Text/Internal/Validate.hs@@ -4889,7 +4889,7 @@ 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+formatted d9a38375e7fb 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@@ -4916,15 +4916,15 @@ 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 e6cf398d7548 unordered-containers-0.2.21/Data/HashMap/Internal.hs+formatted 9e71a44bc71c 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 24da0241d81f unordered-containers-0.2.21/Data/HashMap/Internal/Strict.hs+formatted 1951edac1020 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 3bfd62a86198 unordered-containers-0.2.21/Data/HashSet/Internal.hs formatted e865ae48f11b unordered-containers-0.2.21/Setup.hs formatted 31f2eba3c570 unordered-containers-0.2.21/benchmarks/Benchmarks.hs formatted 0ed2a6102dba unordered-containers-0.2.21/benchmarks/FineGrained.hs@@ -4946,13 +4946,13 @@ 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 92369d5c9642 unpacked-containers-0/src/Map/Internal.hs+formatted 406fe8b6f676 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 f41fa99a0443 unpacked-containers-0/src/Map/Strict/Internal.hs+formatted 9e8445172242 unpacked-containers-0/src/Map/Strict/Internal.hs formatted bb6c9398369f unpacked-containers-0/src/Set.hs formatted 185a318216e6 unpacked-containers-0/src/Set/Internal.hs formatted 867c9afd504a unpacked-containers-0/utils/Internal/BitQueue.hs@@ -5026,14 +5026,14 @@ formatted 88ed51490944 vector-0.13.2.0/tests/doctests.hs formatted 5561dc5bc4a0 vector-algorithms-0.9.1.0/bench/simple/Blocks.hs formatted 8f4b8b5057e3 vector-algorithms-0.9.1.0/bench/simple/Main.hs-formatted 3e94b6538b40 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms.hs+formatted 21a195e3ab16 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 862dcd1590b5 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 c2cb20f40fd9 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 f86bd27d6c5a vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Optimal.hs+formatted 5d6eea29399a 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
+ corpora/vendored/declaration/class/family-in-a-class-body-on-one-line-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilyDependencies #-}++module M where++class C a where type X a; f :: a -> X a++class D a where type Y a = r | r -> a; g :: a -> Y a++x = [d|class E a where type W a :: Type; h :: a|]
+ corpora/vendored/declaration/class/family-in-a-class-body-on-one-line.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilyDependencies #-}++module M where++class C a where { type X a; f :: a -> X a }++class D a where { type Y a = r | r -> a; g :: a -> Y a }++x = [d| class E a where { type W a :: Type; h :: a } |]
+ corpora/vendored/declaration/data/block-haddock-on-the-left-of-an-infix-constructor-out.hs view
@@ -0,0 +1,10 @@+module Kiln.Infix where++-- A block Haddock ends where it closes, so the constructor stays on the+-- line it is written on.+data Ratio = Integer {- ^ the numerator -} :% Integer++data Interval+ = Double {- ^ the lower bound -}+ :..+ Double
+ corpora/vendored/declaration/data/block-haddock-on-the-left-of-an-infix-constructor.hs view
@@ -0,0 +1,9 @@+module Kiln.Infix where++-- A block Haddock ends where it closes, so the constructor stays on the+-- line it is written on.+data Ratio = Integer {- ^ the numerator -} :% Integer++data Interval+ = Double {- ^ the lower bound -}+ :.. Double
+ corpora/vendored/declaration/data/comment-after-the-equals-sign-out.hs view
@@ -0,0 +1,16 @@+module M where++data Answer+ = {- in the order asked -}+ Yes+ | No++data Size+ = {- small+ ones first -}+ Small+ | Large++newtype Count+ = {- of answers -}+ Count Int
+ corpora/vendored/declaration/data/comment-after-the-equals-sign.hs view
@@ -0,0 +1,11 @@+module M where++data Answer = {- in the order asked -}+ Yes | No++data Size = {- small+ ones first -}+ Small | Large++newtype Count = {- of answers -}+ Count Int
+ corpora/vendored/declaration/type/comment-after-an-arrow-out.hs view
@@ -0,0 +1,13 @@+module M where++f ::+ Int ->+ {- the count -}+ Bool+g ::+ Int -> -- the count+ Int ->+ {- the limit,+ if any -}+ Bool+h :: Int -> {- a -} Bool
+ corpora/vendored/declaration/type/comment-after-an-arrow.hs view
@@ -0,0 +1,12 @@+module M where++f :: Int -> {- the count -}+ Bool++g ::+ Int -> -- the count+ Int -> {- the limit,+ if any -}+ Bool++h :: Int -> {- a -} Bool
+ corpora/vendored/declaration/value/blank-lines-between-implicit-parameter-bindings-out.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE ImplicitParams #-}++module Render.Settings where++render page =+ let ?width = 80+ ?indent = 2++ ?colour = False+ in layout page++preview page = layout page+ where+ ?width = 40++ ?colour = True++session = do+ let ?width = 120++ ?colour = True+ run
+ corpora/vendored/declaration/value/blank-lines-between-implicit-parameter-bindings.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE ImplicitParams #-}++module Render.Settings where++render page =+ let ?width = 80+ ?indent = 2++ ?colour = False+ in layout page++preview page = layout page+ where+ ?width = 40++ ?colour = True++session = do+ let ?width = 120++ ?colour = True+ run
+ corpora/vendored/declaration/value/block-comment-across-lines-after-a-separator-out.hs view
@@ -0,0 +1,18 @@+module Ledger.Entry where++amount entry = case entry of+ Credit n ->+ {- paid in,+ as written -}+ n+ Debit n -> negate n++signed = \n ->+ {- the sign+ is the caller's -}+ n++opening =+ {- carried over+ from last year -}+ 0
+ corpora/vendored/declaration/value/block-comment-across-lines-after-a-separator.hs view
@@ -0,0 +1,15 @@+module Ledger.Entry where++amount entry = case entry of+ Credit n -> {- paid in,+ as written -}+ n+ Debit n -> negate n++signed = \n -> {- the sign+ is the caller's -}+ n++opening = {- carried over+ from last year -}+ 0
+ corpora/vendored/declaration/value/comment-after-a-guard-separator-out.hs view
@@ -0,0 +1,19 @@+module M where++f x+ | x > 0 =+ {- positive -}+ 1+ | x < 0 = -- negative+ 2+ | otherwise =+ {- zero,+ or close -}+ 3++g x = case x of+ Just y+ | y > 0 ->+ {- positive -}+ y+ _ -> 0
+ corpora/vendored/declaration/value/comment-after-a-guard-separator.hs view
@@ -0,0 +1,16 @@+module M where++f x+ | x > 0 = {- positive -}+ 1+ | x < 0 = -- negative+ 2+ | otherwise = {- zero,+ or close -}+ 3++g x = case x of+ Just y+ | y > 0 -> {- positive -}+ y+ _ -> 0
+ corpora/vendored/declaration/value/function/arrow/case-after-an-arrow-application-out.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE Arrows #-}++module Cache.Refresh where++refresh mode = proc key -> do+ fresh <-+ fetch+ -< case key of+ Pinned k -> k+ Loose k -> normalise k+ stale <-+ key+ >- case mode of+ Eager -> fetchNow+ Lazy -> fetchLater+ returnA -< (fresh, stale)
+ corpora/vendored/declaration/value/function/arrow/case-after-an-arrow-application.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE Arrows #-}++module Cache.Refresh where++refresh mode = proc key -> do+ fresh <- fetch -< case key of+ Pinned k -> k+ Loose k -> normalise k+ stale <- key >- case mode of+ Eager -> fetchNow+ Lazy -> fetchLater+ returnA -< (fresh, stale)
+ corpora/vendored/declaration/value/function/arrow/nested-block-braces-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE BlockArguments #-}++module Circuit.Feed where++feed = do step <- pure $ proc x -> do { returnA -< x }; run step++relay = proc x -> do y <- send -< do { encode x }; returnA -< y++echo = proc x -> do (\y -> send -< y) do { encode x }; returnA -< x
+ corpora/vendored/declaration/value/function/arrow/nested-block-braces.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE BlockArguments #-}++module Circuit.Feed where++feed = do { step <- pure $ proc x -> do { returnA -< x }; run step }++relay = proc x -> do { y <- send -< do { encode x }; returnA -< y }++echo = proc x -> do { (\y -> send -< y) do { encode x }; returnA -< x }
+ corpora/vendored/declaration/value/function/arrow/parenthesised-command-in-a-block-out.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE Arrows #-}++module Circuit.Gate where++gate = proc signal -> do+ ( case signal of+ High -> open -< signal+ Low -> shut -< signal+ )+ ( case signal of+ High -> count -< 1+ Low -> count -< 0+ )+ <+> (trace -< signal)+ returnA -< signal
+ corpora/vendored/declaration/value/function/arrow/parenthesised-command-in-a-block.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE Arrows #-}++module Circuit.Gate where++gate = proc signal -> do+ (case signal of+ High -> open -< signal+ Low -> shut -< signal)+ (case signal of+ High -> count -< 1+ Low -> count -< 0) <+> (trace -< signal)+ returnA -< signal
+ corpora/vendored/declaration/value/function/block-before-a-signature-out.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE LambdaCase #-}++module M where++a = do { pure () } :: IO ()++b = (case x of { A -> y } :: T)++c = run do { x } :: IO ()++d = x <> do { y } :: T++e = \case { A -> y } :: T -> U++f =+ do+ x+ y+ :: IO ()++g =+ run do+ x+ y+ :: IO ()++h =+ f+ x+ y ::+ Int
+ corpora/vendored/declaration/value/function/block-before-a-signature.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE LambdaCase #-}++module M where++a = do { pure () } :: IO ()++b = (case x of { A -> y } :: T)++c = run do { x } :: IO ()++d = x <> do { y } :: T++e = \case { A -> y } :: T -> U++f =+ do+ x+ y+ :: IO ()++g =+ run do+ x+ y+ :: IO ()++h =+ f+ x+ y ::+ Int
+ corpora/vendored/declaration/value/function/nested-block-braces-out.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE StaticPointers #-}++module Journal.Replay where++replay = do entry <- do { readEntry }; apply entry++retry lock = do withLock lock do { flush }; release lock++warnUnless quiet = do unless quiet if loud then shout else do { warn }; finish++restore = mdo rec { ref <- do { newRef cell }; cell <- load ref }; pure cell++pick mode = case mode of Eager -> run do { fetch }; Lazy -> defer++settle = let first = run do { fetch }; rest = defer in first++profile = do {-# SCC "flush" #-} do { flush }; report++pointer = do static do { flush }; report
+ corpora/vendored/declaration/value/function/nested-block-braces.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE StaticPointers #-}++module Journal.Replay where++replay = do { entry <- do { readEntry }; apply entry }++retry lock = do { withLock lock do { flush }; release lock }++warnUnless quiet = do { unless quiet if loud then shout else do { warn }; finish }++restore = mdo { rec { ref <- do { newRef cell }; cell <- load ref }; pure cell }++pick mode = case mode of { Eager -> run do { fetch }; Lazy -> defer }++settle = let { first = run do { fetch }; rest = defer } in first++profile = do { {-# SCC "flush" #-} do { flush }; report }++pointer = do { static do { flush }; report }
+ corpora/vendored/declaration/value/inlinable-spelled-as-written-out.hs view
@@ -0,0 +1,9 @@+module Data.Ring (add, scale) where++add :: (Num a) => a -> a -> a+add = (+)+{-# INLINABLE add #-}++scale :: (Num a) => a -> a -> a+scale = (*)+{-# INLINEABLE scale #-}
+ corpora/vendored/declaration/value/inlinable-spelled-as-written.hs view
@@ -0,0 +1,9 @@+module Data.Ring (add, scale) where++add :: (Num a) => a -> a -> a+add = (+)+{-# INLINABLE add #-}++scale :: (Num a) => a -> a -> a+scale = (*)+{-# INLINEABLE scale #-}
+ corpora/vendored/declaration/value/operand-beginning-with-a-symbol-out.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE NegativeLiterals #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TemplateHaskell #-}++-- A prefix minus or a backslash stays apart from what follows it where that+-- begins with a symbol character, as the two would read as one operator.+module Ledger.Balance where++debit = - ?amount++credit = - ?rate * ?amount++refund = - #total++drift = - ?rate interval++offset = - $(lookupOffset)++typedOffset = - $$(lookupOffset)++spliced = - $offset++parity = map (\ -1 -> 0) readings++unboxed = \ -1# -> 0#
+ corpora/vendored/declaration/value/operand-beginning-with-a-symbol.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE NegativeLiterals #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TemplateHaskell #-}++-- A prefix minus or a backslash stays apart from what follows it where that+-- begins with a symbol character, as the two would read as one operator.+module Ledger.Balance where++debit = - ?amount++credit = - ?rate * ?amount++refund = - #total++drift = - ?rate interval++offset = - $(lookupOffset)++typedOffset = - $$(lookupOffset)++spliced = - $offset++parity = map (\ -1 -> 0) readings++unboxed = \ -1# -> 0#
+ corpora/vendored/declaration/value/or-pattern-written-across-lines-out.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OrPatterns #-}++module Shape.Corners where++hasCorners :: Shape -> Bool+hasCorners s = case s of+ ( Square;+ Triangle+ ) -> True+ _ -> False++startsWithCorners :: [Shape] -> Bool+startsWithCorners+ ( ( Square;+ Triangle+ )+ : _+ ) = True+startsWithCorners _ = False++isFlat :: Shape -> Bool+isFlat s = case s of+ Line+ Point -> True+ _ -> False++isRound :: Shape -> Bool+isRound (Circle; Ellipse) = True+isRound _ = False
+ corpora/vendored/declaration/value/or-pattern-written-across-lines.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OrPatterns #-}++module Shape.Corners where++hasCorners :: Shape -> Bool+hasCorners s = case s of+ (Square;+ Triangle) -> True+ _ -> False++startsWithCorners :: [Shape] -> Bool+startsWithCorners ((Square;+ Triangle) : _) = True+startsWithCorners _ = False++isFlat :: Shape -> Bool+isFlat s = case s of+ Line+ Point -> True+ _ -> False++isRound :: Shape -> Bool+isRound (Circle; Ellipse) = True+isRound _ = False
+ corpora/vendored/declaration/value/quotation-ending-with-a-symbol-out.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TemplateHaskell #-}++-- A quotation whose body may end with a symbol character keeps a space+-- inside each bracket, as the closing one would read as part of an operator.+module Chain.Quoted where++fixities = [d| infixl 6 +++ |]++method = [d| class Joinable a where infixr 5 <+> |]++local = [d| joined = x +++ y where infixl 6 +++ |]++kinded = [| Proxy :: Proxy * |]++typedKinded = [|| Proxy :: Proxy * ||]++plain = [d|joined = x ++ y|]
+ corpora/vendored/declaration/value/quotation-ending-with-a-symbol.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TemplateHaskell #-}++-- A quotation whose body may end with a symbol character keeps a space+-- inside each bracket, as the closing one would read as part of an operator.+module Chain.Quoted where++fixities = [d| infixl 6 +++ |]++method = [d| class Joinable a where infixr 5 <+> |]++local = [d| joined = x +++ y where infixl 6 +++ |]++kinded = [| Proxy :: Proxy * |]++typedKinded = [|| Proxy :: Proxy * ||]++plain = [d| joined = x ++ y |]
+ corpora/vendored/declaration/value/specialise-spelled-as-written-out.hs view
@@ -0,0 +1,21 @@+module Data.Ring (add, scale, Ring (..)) where++add :: (Num a) => a -> a -> a+add = (+)+{-# SPECIALISE add :: Int -> Int -> Int #-}+{-# SPECIALIZE add :: Double -> Double -> Double #-}++scale :: (Num a) => a -> a -> a+scale = (*)+{-# SPECIALISE INLINE scale :: Int -> Int -> Int #-}+{-# SPECIALIZE NOINLINE scale :: Double -> Double -> Double #-}++newtype Ring a = Ring a++instance (Eq a) => Eq (Ring a) where+ {-# SPECIALISE instance Eq (Ring Int) #-}+ Ring a == Ring b = a == b++instance (Ord a) => Ord (Ring a) where+ {-# SPECIALIZE instance Ord (Ring Int) #-}+ compare (Ring a) (Ring b) = compare a b
+ corpora/vendored/declaration/value/specialise-spelled-as-written.hs view
@@ -0,0 +1,21 @@+module Data.Ring (add, scale, Ring (..)) where++add :: (Num a) => a -> a -> a+add = (+)+{-# SPECIALISE add :: Int -> Int -> Int #-}+{-# SPECIALIZE add :: Double -> Double -> Double #-}++scale :: (Num a) => a -> a -> a+scale = (*)+{-# SPECIALISE INLINE scale :: Int -> Int -> Int #-}+{-# SPECIALIZE NOINLINE scale :: Double -> Double -> Double #-}++newtype Ring a = Ring a++instance (Eq a) => Eq (Ring a) where+ {-# SPECIALISE instance Eq (Ring Int) #-}+ Ring a == Ring b = a == b++instance (Ord a) => Ord (Ring a) where+ {-# SPECIALIZE instance Ord (Ring Int) #-}+ compare (Ring a) (Ring b) = compare a b
corpora/vendored/declaration/value/specialise-without-a-head-variable-out.hs view
@@ -1,4 +1,4 @@ f :: (Ord a) => a -> a f = f -{-# SPECIALIZE let x = 2 in f x #-}+{-# SPECIALISE let x = 2 in f x #-}
+ corpora/vendored/import/comment-after-the-opening-bracket-out.hs view
@@ -0,0 +1,16 @@+module M where++import Data.List+ ( {- for the order -}+ sortOn,+ )+import Data.Map+ ( {- the map+ itself -}+ Map,+ fromList,+ )+import Data.Maybe hiding+ ( {- not these -}+ fromJust,+ )
+ corpora/vendored/import/comment-after-the-opening-bracket.hs view
@@ -0,0 +1,9 @@+module M where++import Data.List ( {- for the order -}+ sortOn )+import Data.Map ( {- the map+ itself -} Map,+ fromList )+import Data.Maybe hiding ( {- not these -}+ fromJust )
+ corpora/vendored/import/package-name-with-a-string-gap-out.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE PackageImports #-}++module M where++import "ba\+ \se" Data.List qualified as L
+ corpora/vendored/import/package-name-with-a-string-gap.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE PackageImports #-}++module M where++import qualified "ba\+ \se" Data.List as L
+ corpora/vendored/other/block-comment-indented-with-tabs-out.hs view
@@ -0,0 +1,17 @@+-- The lines of a moved block comment stay where they were against its first+-- line, a tab counting up to the next multiple of eight, as GHC counts.+module Tabs where++underTabs :: Int+underTabs = g+ where+ {- a+ b -}+ g = 1++overATab :: Int+overATab = g+ where+ {- a+ b -}+ g = 1
+ corpora/vendored/other/block-comment-indented-with-tabs.hs view
@@ -0,0 +1,17 @@+-- The lines of a moved block comment stay where they were against its first+-- line, a tab counting up to the next multiple of eight, as GHC counts.+module Tabs where++underTabs :: Int+underTabs = g+ where+ {- a+ b -}+ g = 1++overATab :: Int+overATab = g+ where+ {- a+ b -}+ g = 1
+ corpora/vendored/other/block-comment-that-code-follows-above-an-empty-line-out.hs view
@@ -0,0 +1,17 @@+module M where++f x =+ if x+ then {- a+ b -}+ y+ else z++g = 1++data T+ = T {- a+ b -}+ Int++h = 2
+ corpora/vendored/other/block-comment-that-code-follows-above-an-empty-line.hs view
@@ -0,0 +1,11 @@+module M where++f x = if x then {- a+ b -} y else z++g = 1++data T = T {- a+ b -} Int++h = 2
+ corpora/vendored/other/comment-in-a-tuple-section-out.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TupleSections #-}++module Queue.Pairs where++pending = (,Nothing {- yet -})++leftOnly = (Left x, {- the right comes later -})++rightOnly =+ (,Right y+ -- and the left from the caller+ )++done = (x, y)
+ corpora/vendored/other/comment-in-a-tuple-section.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TupleSections #-}++module Queue.Pairs where++pending = (, Nothing {- yet -})++leftOnly = (Left x, {- the right comes later -} )++rightOnly = (, Right y+ -- and the left from the caller+ )++done = (x, y)
+ corpora/vendored/other/comment-opening-with-a-word-like-stack-out.hs view
@@ -0,0 +1,8 @@+-- stacks of disks, the smallest on top,+-- and never a larger disk on a smaller one+module Hanoi (moves) where++moves :: Int -> a -> a -> a -> [(a, a)]+moves 0 _ _ _ = []+moves n from to via =+ moves (n - 1) from via to ++ [(from, to)] ++ moves (n - 1) via to from
+ corpora/vendored/other/comment-opening-with-a-word-like-stack.hs view
@@ -0,0 +1,8 @@+-- stacks of disks, the smallest on top,+-- and never a larger disk on a smaller one+module Hanoi (moves) where++moves :: Int -> a -> a -> a -> [(a, a)]+moves 0 _ _ _ = []+moves n from to via =+ moves (n - 1) from via to ++ [(from, to)] ++ moves (n - 1) via to from
+ corpora/vendored/other/comment-under-a-block-comment-before-a-closing-bracket-out.hs view
@@ -0,0 +1,20 @@+module Garden.Beds where++perennials =+ [ sage,+ thyme {- both kinds -}+ -- and more next spring+ ]++annuals =+ [ basil,+ dill {- self-seeding -}+ -- if left alone+ ]++border =+ plant+ ( lavender,+ rosemary {- by the path -}+ -- in full sun+ )
+ corpora/vendored/other/comment-under-a-block-comment-before-a-closing-bracket.hs view
@@ -0,0 +1,18 @@+module Garden.Beds where++perennials =+ [ sage,+ thyme {- both kinds -}+ -- and more next spring+ ]++annuals =+ [ basil+ , dill {- self-seeding -}+ -- if left alone+ ]++border = plant+ ( lavender, rosemary {- by the path -}+ -- in full sun+ )
corpora/vendored/other/comment-under-the-last-part-of-a-construct-out.hs view
@@ -50,3 +50,10 @@ beam :: Int beam = 2++-- At the end of the module, where nothing follows the construct, too.+loom :: Int+loom = shuttles+ where+ shuttles = 2+ -- and a spare
corpora/vendored/other/comment-under-the-last-part-of-a-construct.hs view
@@ -45,3 +45,10 @@ -- on both sides beam :: Int beam = 2++-- At the end of the module, where nothing follows the construct, too.+loom :: Int+loom = shuttles+ where+ shuttles = 2+ -- and a spare
+ corpora/vendored/other/commented-language-pragma-repeating-an-extension-out.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase -- for classify+ #-}+{-# LANGUAGE TupleSections #-}++module Kiln.Repeated where++-- A pragma that names an extension again but holds a comment stays, with+-- the comment.+classify :: Int -> String+classify = \case+ 0 -> "zero"+ _ -> "other"
+ corpora/vendored/other/commented-language-pragma-repeating-an-extension.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE LambdaCase -- for classify+ #-}+module Kiln.Repeated where++-- A pragma that names an extension again but holds a comment stays, with+-- the comment.+classify :: Int -> String+classify = \case+ 0 -> "zero"+ _ -> "other"
+ corpora/vendored/other/comments-after-an-item-before-a-leading-comma-out.hs view
@@ -0,0 +1,6 @@+module Survey.Tally+ ( count, {- the total -} -- so far+ reset, {- to zero -}+ tally, -- by answer+ )+where
+ corpora/vendored/other/comments-after-an-item-before-a-leading-comma.hs view
@@ -0,0 +1,6 @@+module Survey.Tally+ ( count {- the total -} -- so far+ , reset {- to zero -}+ , tally -- by answer+ )+where
+ corpora/vendored/other/cpp/context-headed-by-a-macro-out.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE CPP #-}++-- A macro may stand for a whole constraint and its arrow, or for a pragma,+-- so a context headed by one gets no parentheses that would close it in.+module M where++import GHC.Stack (HasCallStack)++#define CALLSTACK HasCallStack =>+#define OVERLAPS {-# OVERLAPPING #-}++assertEqual :: CALLSTACK (Eq a, Show a) => a -> a -> IO ()+assertEqual expected actual = print (expected == actual)++firstOf ::+ CALLSTACK+ Foldable+ t =>+ t a -> a+firstOf = foldr const (error "empty")++same :: (Eq a) => a -> a -> Bool+same = (==)++class Pretty a where+ pretty :: a -> String++instance OVERLAPS (Pretty a, Pretty b) => Pretty (a, b) where+ pretty (a, b) = pretty a <> pretty b
+ corpora/vendored/other/cpp/context-headed-by-a-macro.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE CPP #-}++-- A macro may stand for a whole constraint and its arrow, or for a pragma,+-- so a context headed by one gets no parentheses that would close it in.+module M where++import GHC.Stack (HasCallStack)++#define CALLSTACK HasCallStack =>+#define OVERLAPS {-# OVERLAPPING #-}++assertEqual :: CALLSTACK (Eq a, Show a) => a -> a -> IO ()+assertEqual expected actual = print (expected == actual)++firstOf :: CALLSTACK+ Foldable t => t a -> a+firstOf = foldr const (error "empty")++same :: Eq a => a -> a -> Bool+same = (==)++class Pretty a where+ pretty :: a -> String++instance OVERLAPS (Pretty a, Pretty b) => Pretty (a, b) where+ pretty (a, b) = pretty a <> pretty b
+ corpora/vendored/other/cpp/directives-in-a-haddock-out.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE CPP #-}++module M where++class Shape a where+ {- |+ The area, for example:++#if MIN_VERSION_base(4,10,0)+ >>> area (Square 2)+ 4.0+#else+ >>> area (Square 2.0)+ 4.0+#endif+ -}+ area :: a -> Double++ -- | The perimeter.+ perimeter :: a -> Double
+ corpora/vendored/other/cpp/directives-in-a-haddock.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE CPP #-}++module M where++class Shape a where+ {- |+The area, for example:++#if MIN_VERSION_base(4,10,0)+>>> area (Square 2)+4.0+#else+>>> area (Square 2.0)+4.0+#endif+ -}+ area :: a -> Double++ -- | The perimeter.+ perimeter :: a -> Double
corpora/vendored/other/cpp/imports-around-a-conditional-holding-a-directive.hs view
@@ -4,7 +4,7 @@ import System.Environment (lookupEnv) #ifdef WIDE_TERMINALS- #define DEFAULT_WIDTH 132+#define DEFAULT_WIDTH 132 #endif import Data.Maybe (fromMaybe)
+ corpora/vendored/other/cpp/labels-named-like-directives-out.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedLabels #-}++-- | Labels named like directives, which cpp leaves alone where they do not+-- open their line.+module Record.Fields (columns, defined) where++#if MIN_VERSION_base(4,10,0)+import GHC.OverloadedLabels (IsLabel (..))+#endif++columns :: [Column]+columns =+ [ #line,+ #if,+ #else+ ]++defined :: Column -> Bool+defined =+ hasValue+ #define
+ corpora/vendored/other/cpp/labels-named-like-directives.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedLabels #-}++-- | Labels named like directives, which cpp leaves alone where they do not+-- open their line.+module Record.Fields (columns, defined) where++#if MIN_VERSION_base(4,10,0)+import GHC.OverloadedLabels (IsLabel (..))+#endif++columns :: [Column]+columns =+ [ #line,+ #if, #else+ ]++defined :: Column -> Bool+defined =+ hasValue+ #define
+ corpora/vendored/other/cpp/line-marker-passed-on-by-cpp.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE CPP #-}++module M where++x = 1 -- one+# 40 "Other.hs"+y = 2 -- two
+ corpora/vendored/other/cpp/macro-before-a-leading-comma.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}++module Signals (handled) where++#define ALSO(name) , name++handled :: [String]+handled =+ [ "INT"+ , "TERM"+ ALSO("HUP")+ , "QUIT"+ ]
+ corpora/vendored/other/declarations-on-one-line-out.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TemplateHaskell #-}++module Grid.Sizes where++sizes = [d|width = 80; height = 24|]++limits = [d|maxWidth :: Int; maxWidth = 200; minWidth = 10|]
+ corpora/vendored/other/declarations-on-one-line.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TemplateHaskell #-}++module Grid.Sizes where++sizes = [d| width = 80; height = 24 |]++limits = [d| maxWidth :: Int; maxWidth = 200; minWidth = 10 |]
corpora/vendored/other/haddock-that-documents-nothing-out.hs view
@@ -40,3 +40,15 @@ -> Int g = id++-- A block one above a local binding has only its trigger escaped: the lines+-- under it are its text.+blockAbove :: Int+blockAbove = g+ where+ {- \| What g is, as these would write it:++ -- | One.+ {- * Two. -}+ -}+ g = 1
corpora/vendored/other/haddock-that-documents-nothing.hs view
@@ -39,3 +39,15 @@ on to a second line -} -> Int g = id++-- A block one above a local binding has only its trigger escaped: the lines+-- under it are its text.+blockAbove :: Int+blockAbove = g+ where+ {- | What g is, as these would write it:++ -- | One.+ {- * Two. -}+ -}+ g = 1
+ corpora/vendored/other/line-comment-after-a-block-comment-out.hs view
@@ -0,0 +1,29 @@+module Survey.Tally+ ( count, {- the total -} -- so far+ reset,+ )+where++import Data.List+ ( {- for the order -} -- of answers+ sortOn,+ )++count =+ {- every answer -} -- once+ length answers++data Answer+ = {- in the order asked -} -- on the form+ Yes+ | No++verdict a = case a of+ Yes ->+ {- counted -} -- as one+ 1+ No -> 0++skipped = \a ->+ {- left out -} -- of the count+ 0
+ corpora/vendored/other/line-comment-after-a-block-comment.hs view
@@ -0,0 +1,22 @@+module Survey.Tally+ ( count, {- the total -} -- so far+ reset,+ )+where++import Data.List ( {- for the order -} -- of answers+ sortOn )++count = {- every answer -} -- once+ length answers++data Answer = {- in the order asked -} -- on the form+ Yes | No++verdict a = case a of+ Yes -> {- counted -} -- as one+ 1+ No -> 0++skipped = \a -> {- left out -} -- of the count+ 0
+ corpora/vendored/other/line-markers-in-a-quasi-quotation-out.hs view
@@ -0,0 +1,16 @@+#!/usr/bin/env runghc+{-# LANGUAGE QuasiQuotes #-}++-- | Lines that GHC reads past elsewhere are text in a quasi-quotation, and a+-- script's first line is its own.+module Stitched.Script where++script :: String+script = [str|+#!/bin/sh+# 40 "Template.hs"+#pragma once+|]++after :: Int+after = 1
+ corpora/vendored/other/line-markers-in-a-quasi-quotation.hs view
@@ -0,0 +1,16 @@+#!/usr/bin/env runghc+{-# LANGUAGE QuasiQuotes #-}++-- | Lines that GHC reads past elsewhere are text in a quasi-quotation, and a+-- script's first line is its own.+module Stitched.Script where++script :: String+script = [str|+#!/bin/sh+# 40 "Template.hs"+#pragma once+|]++after :: Int+after = 1
+ corpora/vendored/other/line-markers.hs view
@@ -0,0 +1,16 @@+-- | Code stitched together from several files, which says where each part+-- of it came from the way cpp does.+module Stitched where++ownLine :: Int -> Int+ownLine n = n + 1++# 40 "Template.hs"++fromTheTemplate :: Int -> Int+fromTheTemplate n = n++#line 12 "Stitched.hs"++andBackAgain :: Int -> Int+andBackAgain n = n - 1
+ corpora/vendored/other/moved-haddock-beginning-with-a-dollar-out.hs view
@@ -0,0 +1,12 @@+module Kiln.Price where++-- A dollar that a Haddock moved in front of what it documents begins with+-- stays as written.+charge ::+ -- | $1 for each unit+ Int ->+ {- | $5 at least,+ $10 at most -}+ Int ->+ Int+charge = const
+ corpora/vendored/other/moved-haddock-beginning-with-a-dollar.hs view
@@ -0,0 +1,10 @@+module Kiln.Price where++-- A dollar that a Haddock moved in front of what it documents begins with+-- stays as written.+charge ::+ Int -- ^ $1 for each unit+ -> Int {- ^ $5 at least,+ $10 at most -}+ -> Int+charge = const
+ corpora/vendored/other/moved-haddock-continued-with-a-dollar-out.hs view
@@ -0,0 +1,14 @@+module M where++f ::+ -- | the price,+ --$5 at most+ Int ->+ Int+f = id++data T+ = -- | the price,+ --$5 at most+ T+ Int
+ corpora/vendored/other/moved-haddock-continued-with-a-dollar.hs view
@@ -0,0 +1,11 @@+module M where++f ::+ Int -> -- ^ the price,+ --$5 at most+ Int+f = id++data T = T+ Int -- ^ the price,+ --$5 at most
+ corpora/vendored/other/options-pragma-with-no-options-out.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC #-}++module Kiln.Fire where++fire :: Int+fire = 1
+ corpora/vendored/other/options-pragma-with-no-options.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC #-}++module Kiln.Fire where++fire :: Int+fire = 1
+ corpora/vendored/other/position-pragma-in-a-quasi-quotation-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE QuasiQuotes #-}++-- | A position pragma in a quasi-quotation is text, and moves nothing.+module Woven.Template where++template :: String+template = [str|+{-# LINE 40 "Template.hs" #-}+|]++after :: Int+after = 1
+ corpora/vendored/other/position-pragma-in-a-quasi-quotation.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE QuasiQuotes #-}++-- | A position pragma in a quasi-quotation is text, and moves nothing.+module Woven.Template where++template :: String+template = [str|+{-# LINE 40 "Template.hs" #-}+|]++after :: Int+after = 1
+ corpora/vendored/other/stack-script-header-over-a-comment-out.hs view
@@ -0,0 +1,11 @@+#!/usr/bin/env stack+-- stack script --snapshot lts-22.21 --package text++-- Print each line of the input with its words in reverse order.+module Main (main) where++import qualified Data.Text as T+import qualified Data.Text.IO as T++main :: IO ()+main = T.interact (T.unlines . map (T.unwords . reverse . T.words) . T.lines)
+ corpora/vendored/other/stack-script-header-over-a-comment.hs view
@@ -0,0 +1,10 @@+#!/usr/bin/env stack+-- stack script --snapshot lts-22.21 --package text+-- Print each line of the input with its words in reverse order.+module Main (main) where++import qualified Data.Text as T+import qualified Data.Text.IO as T++main :: IO ()+main = T.interact (T.unlines . map (T.unwords . reverse . T.words) . T.lines)
+ corpora/vendored/other/warning-category-as-written-out.hs view
@@ -0,0 +1,9 @@+module M where++{-# WARNING in "x-p\&artial" f "Partial" #-}+f :: Int -> Int+f = id++{-# WARNING in "x-unsafe" g "Unsafe" #-}+g :: Int -> Int+g = id
+ corpora/vendored/other/warning-category-as-written.hs view
@@ -0,0 +1,9 @@+module M where++{-# WARNING in "x-p\&artial" f "Partial" #-}+f :: Int -> Int+f = id++{-# WARNING in "x-unsafe" g "Unsafe" #-}+g :: Int -> Int+g = id
+ corpora/vendored/signature/module-in-the-export-list-out.hsig view
@@ -0,0 +1,7 @@+signature Codec (Codec, module Data.Text) where++import Data.Text++data Codec++encode :: Codec -> Text
+ corpora/vendored/signature/module-in-the-export-list.hsig view
@@ -0,0 +1,7 @@+signature Codec (Codec, module Data.Text) where++import Data.Text++data Codec++encode :: Codec -> Text
src/Tilia/Cabal/Package.hs view
@@ -18,6 +18,7 @@ Kind (..), packageOf, packageComponents,+ packageBranches, addedSources, sourceExtensions, isDeclaredModule,@@ -54,6 +55,7 @@ CondTree (..), ConfVar (..), Executable (..),+ ForeignLib (..), GenericPackageDescription (..), Library (..), PackageDescription (..),@@ -88,7 +90,7 @@ import Tilia.Cabal.Project (cabalFilesIn, startingDirectory) import Tilia.Pragma (Defaults, defaultsOf, lookupEdition, nameSwitch) import Tilia.Process (readProgramOutput)-import Tilia.Utils (attempted, pathUnder, quietly, tshow)+import Tilia.Utils (pathUnder, quietly, readBytes, tshow) -- | Why a file's extensions could not be settled. data PackageProblem@@ -261,7 +263,7 @@ -- | Read and parse a @.cabal@ file, or say why it cannot be. readPackageDescription :: FilePath -> IO (Either PackageProblem GenericPackageDescription) readPackageDescription cabalFile =- attempted (BS.readFile cabalFile) >>= \case+ readBytes cabalFile >>= \case Left why -> pure (Left (PackageUnreadable cabalFile why)) Right bytes -> pure (parsePackageDescription cabalFile bytes) @@ -351,7 +353,7 @@ -- | The kinds of component a @.cabal@ file can declare, and the setup -- script beside it.-data Kind = Lib | Exe | Test | Bench | Setup+data Kind = Lib | FLib | Exe | Test | Bench | Setup deriving (Eq, Ord, Show) -- | Every component of a package, in the order declared: its kind, its@@ -361,6 +363,7 @@ concat [ [(Lib, packageOf described, libraryBranches t) | t <- toList (condLibrary described)], [(Lib, nameOf n, libraryBranches t) | (n, t) <- condSubLibraries described],+ [(FLib, nameOf n, foreignLibBranches t) | (n, t) <- condForeignLibs described], [(Exe, nameOf n, executableBranches t) | (n, t) <- condExecutables described], [(Test, nameOf n, suiteBranches t) | (n, t) <- condTestSuites described], [(Bench, nameOf n, benchmarkBranches t) | (n, t) <- condBenchmarks described]@@ -373,14 +376,20 @@ packageOf = T.pack . unPackageName . pkgName . package . packageDescription --- | Every module any branch of a package declares, with where it would be--- written relative to the package, without an extension.-declaredModules :: GenericPackageDescription -> [(Text, FilePath)]-declaredModules described =- [ (T.intercalate "." (fmap T.pack (splitDirectories sub <> [name])), joined d (joined sub name))- | branch <- packageBranches described,- (d, section) <- addedSources branch,- (sub, name) <- sectionModules section+-- | Each source directory the branches given name, with every module they+-- declare there and where it would be written under it, without an+-- extension.+declaredModules :: [BranchSections] -> [(FilePath, [(Text, FilePath)])]+declaredModules branches =+ [ ( d,+ [ ( T.intercalate "." (fmap T.pack (splitDirectories sub <> [name])),+ joined sub name+ )+ | (sub, name) <- sectionModules section+ ]+ )+ | branch <- branches,+ (d, section) <- addedSources branch ] -- | Every directory any branch of a package names for its files, and then@@ -442,6 +451,10 @@ libraryBranches :: CondTree ConfVar Library -> [BranchSections] libraryBranches = branchesOf $ \l -> declaring (libBuildInfo l) (exposedModules l <> signatures l) []++-- | Every branch of a foreign library.+foreignLibBranches :: CondTree ConfVar ForeignLib -> [BranchSections]+foreignLibBranches = branchesOf $ \f -> declaring (foreignLibBuildInfo f) [] [] -- | Every branch of an executable. executableBranches :: CondTree ConfVar Executable -> [BranchSections]
src/Tilia/Cabal/Plan.hs view
@@ -34,12 +34,13 @@ Futility (..), undiscoveredFutility, futilityFor,+ CabalFailure (..), prepareWith, loadPlan, ) where -import Control.Monad (filterM, join, void)+import Control.Monad (filterM, join) import Data.Aeson ( FromJSON (..), Value,@@ -50,6 +51,8 @@ (.:?), ) import Data.Aeson.Types (parseMaybe)+import Data.Bifunctor (first)+import Data.ByteString qualified as BS import Data.Choice (Choice, isFalse) import Data.Containers.ListUtils (nubOrdOn) import Data.Foldable (toList, traverse_)@@ -82,10 +85,10 @@ import System.Environment (lookupEnv) import System.Exit (ExitCode (..)) import System.FilePath (isRelative, takeDirectory, (</>))-import System.IO (hClose, hFlush, stderr)+import System.IO (Handle, hClose, hFlush, stderr) import System.Info qualified import System.Process- ( StdStream (CreatePipe, Inherit, UseHandle),+ ( StdStream (CreatePipe, UseHandle), createProcess, cwd, proc,@@ -95,11 +98,11 @@ waitForProcess, ) import Tilia.Cabal.Package (readPackageDescription)-import Tilia.Cabal.Project (cabalFilesIn)+import Tilia.Cabal.Project (cabalFilesIn, projectConfigFiles) import Tilia.Cpp.Macros (Macros (..)) import Tilia.Fixity.Cache import Tilia.Fixity.PackageDb-import Tilia.Process (readProgramOutput)+import Tilia.Process (readProgramOutputIn) import Tilia.Utils (quietly, sha256Of) ----------------------------------------------------------------------------@@ -302,8 +305,10 @@ decodePlan :: FilePath -> IO (Either Text BuildPlan) decodePlan path = doesFileExist path >>= \case- False -> pure (Left ("no build plan at " <> T.pack path))- True -> either (Left . T.pack) Right <$> eitherDecodeFileStrict path+ False -> pure (Left (T.pack path <> " does not exist"))+ True -> first unparsed <$> eitherDecodeFileStrict path+ where+ unparsed why = T.pack path <> " does not parse: " <> T.pack why -- | Find where @cabal@ unpacked each @source-repository-package@. checkedOutIn :: FilePath -> BuildPlan -> IO BuildPlan@@ -427,7 +432,8 @@ data PlanComponent = PlanComponent { -- | The package it belongs to. pcPackage :: Text,- -- | @lib@, @exe:name@, @test:name@, @bench:name@.+ -- | @lib@ for the main library, or else the kind and the name, as in+ -- @lib:name@, @flib:name@, @exe:name@, @test:name@ or @bench:name@. pcName :: Text } deriving (Eq, Ord, Show)@@ -492,14 +498,15 @@ (_ : _, _) -> pure (PlanStale newer) ([], _ : _) -> pure (PlanNarrow missing) ([], []) ->- sourcesShortOf cache plan >>= \case+ sourcesShortOf cache projectDir plan >>= \case [] -> pure Ready ps -> pure (SourcesMissing (fmap ppName ps)) -- | The packages the plan expects to fetch whose sources are not here.-sourcesShortOf :: Cache -> BuildPlan -> IO [PlanPackage]-sourcesShortOf cache plan = do- tarballs <- filter (isFetchable . fst) <$> plannedTarballs cache plan+sourcesShortOf :: Cache -> FilePath -> BuildPlan -> IO [PlanPackage]+sourcesShortOf cache projectDir plan = do+ tarballs <-+ filter (isFetchable . fst) <$> plannedTarballs cache projectDir plan absent <- fmap fst <$> filterM (fmap not . doesFileExist . snd) tarballs if null absent then pure []@@ -507,6 +514,19 @@ installed <- getInstalledPackages cache pure (filter (not . builtAlready installed) absent) +-- | The packages a fetch left the plan short of, with @cabal@ asked again+-- where it keeps what it downloads if there are any.+--+-- A fetch leaving a source missing where @cabal@ last said is what a moved+-- package cache looks like, and the only thing taken for one.+shortAfterFetch :: Cache -> FilePath -> BuildPlan -> IO [PlanPackage]+shortAfterFetch cache projectDir plan =+ sourcesShortOf cache projectDir plan >>= \case+ [] -> pure []+ _ -> do+ forgetPackageCache cache projectDir+ sourcesShortOf cache projectDir plan+ -- | Has the compiler got this package already? builtAlready :: [InstalledPackage] -> PlanPackage -> Bool builtAlready installed p = any matches installed@@ -519,13 +539,10 @@ filesNewerThanPlan plan projectDir solved = quietly [] $ do written <- getModificationTime (planPathFor projectDir) let planTime = maybe written (max written) solved- atRoot <- quietly [] (listDirectory projectDir)+ configs <- traverse (projectConfigFiles . (projectDir </>)) projectFiles atRootPackage <- cabalFilesIn projectDir inPackages <- concat <$> traverse cabalFilesIn (localDirs plan)- let candidates =- [projectDir </> f | f <- atRoot, f `elem` projectFiles]- <> atRootPackage- <> inPackages+ let candidates = fmap fst (concat configs) <> atRootPackage <> inPackages newer <- traverse (isNewerThan planTime) candidates pure [f | Just f <- newer] where@@ -581,6 +598,13 @@ Left _ -> pure fallback Right plan -> use =<< openCache caching =<< tokenForBuildPlan plan +-- | Why a run of @cabal@ failed, as said to the user.+data CabalFailure+ = -- | No plan satisfies what it was asked about.+ Unsolvable Text+ | -- | Anything else.+ CabalFailed Text+ -- | Do whatever is missing, given a way to run @cabal@ and a memory of what -- earlier attempts came to. prepareWith ::@@ -589,7 +613,7 @@ -- | Whether to download what is missing. Choice "download" -> -- | Run @cabal@ with these arguments.- ([String] -> IO (Either Text ())) ->+ ([String] -> IO (Either CabalFailure ())) -> -- | What earlier attempts came to. Futility -> -- | The components the run is about to format.@@ -610,10 +634,14 @@ False -> solveThenFetch where wholeProject = ["--enable-tests", "--enable-benchmarks"]- tryWholeProject args =- cabal (args <> wholeProject) >>= \case- Right () -> pure (Right ())- Left _ -> cabal args+ tryWholeProject args = do+ attempt <- cabal (args <> wholeProject)+ first said <$> case attempt of+ Left (Unsolvable _) -> cabal args+ _ -> pure attempt+ said = \case+ Unsolvable why -> why+ CabalFailed why -> why fetch short | isFalse downloading = pure (Right ()) | otherwise = do@@ -624,14 +652,16 @@ tryWholeProject ["build", ":all", "--only-download"] >>= \case Left err -> pure (Left err) Right () ->- withPlan ((Right () <$) . rememberFutileFetch futility)- fetchWhatIsShort = withPlan fetch- withPlan use =+ withPlan+ shortAfterFetch+ ((Right () <$) . rememberFutileFetch futility)+ fetchWhatIsShort = withPlan sourcesShortOf fetch+ withPlan shortOf use = readBuildPlan (planPathFor projectDir) >>= \case Left _ -> pure (Right ()) Right plan -> do cache <- openCache caching =<< tokenForBuildPlan plan- use . fmap ppName =<< sourcesShortOf cache plan+ use . fmap ppName =<< shortOf cache projectDir plan solveThenFetch = do started <- getCurrentTime tryWholeProject ["build", ":all", "--dry-run"] >>= \case@@ -644,31 +674,50 @@ _ -> 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- -- A pipe closed at once rather than our standard input, which in an- -- editor's process carries what the editor says to it.- (toChild, _, _, running) <-- createProcess- (proc "cabal" args)- { cwd = Just projectDir,- std_in = CreatePipe,- std_out = UseHandle passed,- std_err = Inherit- }- traverse_ hClose toChild- code <- waitForProcess running- pure $ case code of- ExitSuccess -> Right ()- _ -> Left ("cabal " <> T.unwords (fmap T.pack args) <> " failed; see above")+runCabal :: FilePath -> [String] -> IO (Either CabalFailure ())+runCabal projectDir args =+ quietly (Left (CabalFailed "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+ -- A pipe closed at once rather than our standard input, which in an+ -- editor's process carries what the editor says to it.+ (toChild, _, fromChild, running) <-+ createProcess+ (proc "cabal" args)+ { cwd = Just projectDir,+ std_in = CreatePipe,+ std_out = UseHandle passed,+ std_err = CreatePipe+ }+ traverse_ hClose toChild+ complaints <- foldMap passedOn fromChild+ code <- waitForProcess running+ pure $ case code of+ ExitSuccess -> Right ()+ _+ | "Could not resolve dependencies" `BS.isInfixOf` complaints ->+ Left (Unsolvable failed)+ | otherwise -> Left (CabalFailed failed)+ where+ failed = "cabal " <> T.unwords (fmap T.pack args) <> " failed; see above" +-- | Copy what comes out of a handle to standard error as it comes, and hand+-- all of it back once it ends.+passedOn :: Handle -> IO BS.ByteString+passedOn h = go []+ where+ go chunks =+ BS.hGetSome h 4096 >>= \chunk ->+ if BS.null chunk+ then pure (BS.concat (reverse chunks))+ else BS.hPut stderr chunk >> go (chunk : chunks)+ -- | Fetch the sources of a trusted plan's dependencies that are neither--- installed nor fetched already, at the versions the plan names.+-- installed nor fetched already, at the versions the plan names, unless a+-- fetch has already failed to bring them in. fetchUninstalled :: -- | Whether to use the cache. Choice "useCache" ->@@ -679,13 +728,19 @@ IO () fetchUninstalled caching projectDir plan = do cache <- openCache caching =<< tokenForBuildPlan plan- sourcesShortOf cache plan >>= \case+ refused <- cachedFutileFetch cache+ short <- sourcesShortOf cache projectDir plan+ case [p | p <- short, ppName p `notElem` refused] of [] -> pure ()- short ->- void . runCabal projectDir $- "fetch"- : "--no-dependencies"- : [T.unpack (ppName p <> "-" <> ppVersion p) | p <- short]+ wanted ->+ runCabal projectDir ("fetch" : "--no-dependencies" : fmap named wanted)+ >>= \case+ Left _ -> pure ()+ Right () ->+ storeFutileFetch cache . fmap ppName+ =<< shortAfterFetch cache projectDir plan+ where+ named p = T.unpack (ppName p <> "-" <> ppVersion p) -- | Get a plan that is safe to use, doing whatever @cabal@ work is needed. loadPlan ::@@ -718,25 +773,22 @@ _ -> readBuildPlan (planPathFor projectDir) -- | Every planned package whose source could be in the package cache, with--- where that would be: under the package cache @cabal@ last named, unless--- a tarball it downloads is not there and a fetch has not already failed--- to bring it in, when @cabal@ is asked again.-plannedTarballs :: Cache -> BuildPlan -> IO [(PlanPackage, FilePath)]-plannedTarballs cache plan =- cachedPackageCache cache >>= \case- Just remembered -> do- tarballs <- under remembered- refused <- cachedFutileFetch cache- absent <-- filterM- (fmap not . doesFileExist . snd)- [t | t@(p, _) <- tarballs, isFetchable p, ppName p `notElem` refused]- if null absent then pure tarballs else asked- Nothing -> asked+-- where that would be under the package cache @cabal@ last named for the+-- project, or names now where it has named none.+plannedTarballs ::+ -- | Where what @cabal@ said is remembered.+ Cache ->+ -- | The project the plan is for.+ FilePath ->+ -- | The plan.+ BuildPlan ->+ IO [(PlanPackage, FilePath)]+plannedTarballs cache projectDir plan =+ maybe asked under =<< cachedPackageCache cache projectDir where asked = do- cacheRoot <- packageCacheRoot- storePackageCache cache cacheRoot+ cacheRoot <- packageCacheRoot projectDir+ storePackageCache cache projectDir cacheRoot under cacheRoot under cacheRoot = do repos <- quietly [] (Data.List.sort <$> listDirectory cacheRoot)@@ -748,11 +800,12 @@ CheckedOut _ -> True _ -> False --- | Where @cabal@ keeps downloaded package sources, one directory per--- repository it downloads from.-packageCacheRoot :: IO FilePath-packageCacheRoot =- readProgramOutput+-- | Where @cabal@ keeps the package sources it downloads for the project in+-- the directory given, one directory per repository it downloads from.+packageCacheRoot :: FilePath -> IO FilePath+packageCacheRoot projectDir =+ readProgramOutputIn+ projectDir "cabal" ["path", "--remote-repo-cache", "--output-format=json"] >>= \case
src/Tilia/Cabal/Project.hs view
@@ -9,12 +9,28 @@ findProjectRoot, startingDirectory, cabalFilesIn,+ projectConfigFiles, ) where import Control.Monad (filterM)+import Data.Bifunctor (first)+import Data.ByteString qualified as BS+import Data.Either (fromRight) import Data.List (isSuffixOf, sort) 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 Distribution.Fields.Field+ ( Field (..),+ FieldLine (..),+ Name (..),+ fieldUniverse,+ )+import Distribution.Fields.Parser (readFields)+import Distribution.Parsec.Position (Position) import System.Directory ( canonicalizePath, doesDirectoryExist,@@ -22,7 +38,7 @@ listDirectory, ) import System.FilePath (takeDirectory, takeFileName, (</>))-import Tilia.Utils (quietly)+import Tilia.Utils (quietly, tshow) -- | A project, and what marked it out. data ProjectRoot = ProjectRoot@@ -84,3 +100,29 @@ filterM doesFileExist (fmap (directory </>) (sort (filter (".cabal" `isSuffixOf`) entries)))++-- | A project configuration file and the files it imports, directly or+-- through one another, each once, with its fields or why they do not+-- parse.+--+-- A file that cannot be read, such as an import from a URL, is passed over.+projectConfigFiles :: FilePath -> IO [(FilePath, Either Text [Field Position])]+projectConfigFiles = go Set.empty . pure+ where+ go _ [] = pure []+ go seen (given : rest) = do+ file <- quietly given (canonicalizePath given)+ contents <- quietly Nothing (Just <$> BS.readFile file)+ case contents of+ Just bytes | Set.notMember file seen -> do+ let fields = first tshow (readFields bytes)+ ((file, fields) :)+ <$> go+ (Set.insert file seen)+ (importsOf file (fromRight [] fields) <> rest)+ _ -> go seen rest+ importsOf file fields =+ [ takeDirectory file </> T.unpack (T.decodeUtf8Lenient value)+ | Field (Name _ "import") [FieldLine _ value] <-+ concatMap fieldUniverse fields+ ]
src/Tilia/Cabal/Target.hs view
@@ -19,10 +19,8 @@ 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.Bifunctor (first)+import Data.List (isPrefixOf, isSuffixOf, sort, tails) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Set (Set)@@ -31,12 +29,13 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as T import Distribution.Fields.Field (Field (..), FieldLine (..), Name (..))-import Distribution.Fields.Parser (readFields) import Distribution.PackageDescription (GenericPackageDescription (..))+import Distribution.Parsec.Position (Position) import System.Directory (canonicalizePath, doesFileExist, listDirectory) import System.FilePath ( dropTrailingPathSeparator, normalise,+ splitDirectories, takeDirectory, (</>), )@@ -54,7 +53,13 @@ setupScript, ) import Tilia.Cabal.Plan (PlanComponent (..))-import Tilia.Cabal.Project (Marker (..), ProjectRoot (..), cabalFilesIn, markerFile)+import Tilia.Cabal.Project+ ( Marker (..),+ ProjectRoot (..),+ cabalFilesIn,+ markerFile,+ projectConfigFiles,+ ) import Tilia.Ignore (withoutIgnored) import Tilia.Utils (fieldWords, quietly, tshow) @@ -82,11 +87,17 @@ "unrecognised target " <> tshow written <> ": expected all, a package or component name, or one of\- \ lib:, exe:, test:, bench: followed by a name"- kindNamed = \case+ \ lib:, flib:, exe:, test:, bench: followed by a name"+ kindNamed k = case T.toLower k of "lib" -> Just Lib+ "library" -> Just Lib+ "flib" -> Just FLib+ "foreign-library" -> Just FLib "exe" -> Just Exe+ "executable" -> Just Exe+ "tst" -> Just Test "test" -> Just Test+ "test-suite" -> Just Test "bench" -> Just Bench "benchmark" -> Just Bench _ -> Nothing@@ -139,6 +150,8 @@ data TargetProblem = -- | A @cabal.project@ naming packages, none of which could be found. NoPackages FilePath+ | -- | A project configuration file that does not parse, and why.+ ProjectMalformed FilePath Text | -- | A @.cabal@ file that could not be read or parsed, and why. UnreadablePackage PackageProblem | -- | A target naming no component the project holds.@@ -150,6 +163,8 @@ describeTargetProblem = \case NoPackages file -> T.pack file <> " names no packages that exist"+ ProjectMalformed file why ->+ T.pack file <> " does not parse:" <> foldMap ("\n " <>) (T.lines why) UnreadablePackage problem -> describePackageProblem problem NoSuchTarget asked available -> "no component matches "@@ -162,11 +177,12 @@ 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+componentsOfTarget root target =+ packageFilesOf root >>= \case+ Left problem -> pure (Left problem)+ Right [] ->+ pure (Left (NoPackages (prPath root </> markerFile (prMarker root))))+ Right files -> traverse componentsInCabalFile files >>= \case results | (problem : _) <- [p | Left p <- results] -> pure (Left problem)@@ -213,6 +229,7 @@ spellKind :: Kind -> Text spellKind = \case Lib -> "lib"+ FLib -> "flib" Exe -> "exe" Test -> "test" Bench -> "bench"@@ -252,31 +269,32 @@ asDirectory :: FilePath -> FilePath asDirectory = dropTrailingPathSeparator . normalise --- | The @.cabal@ files the project is made of.+-- | The @.cabal@ files the project is made of, or which of its+-- configuration files does not parse. -- -- 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 :: ProjectRoot -> IO (Either TargetProblem [FilePath]) packageFilesOf root = case prMarker root of- PackageFile named -> pure [prPath root </> named]+ PackageFile named -> pure (Right [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)))+ configs <- projectConfigFiles (prPath root </> "cabal.project")+ case traverse (uncurry (first . ProjectMalformed)) configs of+ Left problem -> pure (Left problem)+ Right parsed -> do+ found <-+ traverse+ (packageToCabalFile (prPath root))+ (concatMap packagesInProjectConfig parsed)+ pure (Right (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)+-- | The entries of a project configuration file's @packages@ fields.+packagesInProjectConfig :: [Field Position] -> [Text]+packagesInProjectConfig = concatMap entries . packagesIn where packagesIn = concatMap $ \case Field (Name _ name) ls- | BS8.map toLower name `elem` ["packages", "optional-packages"] ->+ | name `elem` ["packages", "optional-packages"] -> [T.unwords [T.decodeUtf8Lenient value | FieldLine _ value <- ls]] | otherwise -> [] Section _ _ inner -> packagesIn inner@@ -285,33 +303,35 @@ -- | Turn one entry of a @packages@ field into the @.cabal@ files it names. packageToCabalFile :: FilePath -> Text -> IO [FilePath] packageToCabalFile root entry = do- paths <-- packageGlobToCabalFiles- (if "/" `T.isPrefixOf` written then "/" else root)- (fmap T.unpack (T.split (== '/') written))+ paths <- packageGlobToCabalFiles root (splitDirectories (T.unpack entry)) concat <$> traverse asPackage paths where- written = 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 @*@.+-- | Resolve a path whose components may contain @*@, or be @**@, which+-- stands for any number of directories. packageGlobToCabalFiles :: FilePath -> [String] -> IO [FilePath] packageGlobToCabalFiles here = \case [] -> pure [here]- ("" : rest) -> packageGlobToCabalFiles here rest ("." : rest) -> packageGlobToCabalFiles here rest+ components@("**" : rest) ->+ (<>)+ <$> packageGlobToCabalFiles here rest+ <*> entriesMatching (const True) components (component : rest)- | '*' `elem` component -> do- entries <- quietly [] (listDirectory here)- concat- <$> traverse- (\e -> packageGlobToCabalFiles (here </> e) rest)- (sort (filter (globMatching component) entries))+ | '*' `elem` component -> entriesMatching (globMatching component) rest | otherwise -> packageGlobToCabalFiles (here </> component) rest+ where+ entriesMatching matching rest = do+ entries <- quietly [] (listDirectory here)+ concat+ <$> traverse+ (\e -> packageGlobToCabalFiles (here </> e) rest)+ (sort (filter matching entries)) -- | Does a name match a pattern with @*@ in it? globMatching :: String -> String -> Bool@@ -319,7 +339,7 @@ (before, []) -> before == name (before, _ : after) -> before `isPrefixOf` name- && after `isSuffixOf` drop (length before) name+ && any (globMatching after) (tails (drop (length before) name)) -- | Every component one @.cabal@ file declares. componentsInCabalFile :: FilePath -> IO (Either TargetProblem [Component])
src/Tilia/Comments.hs view
@@ -122,7 +122,6 @@ GHC.ITlineComment t _ -> Just (commentAt ls s LineComment (T.pack t)) GHC.ITblockComment t _ -> Just (commentAt ls s BlockComment (T.pack t)) GHC.ITdocComment _ _ -> Just (commentAt ls s DocComment (sliceSpan (lineTexts ls) s))- GHC.ITdocOptions t _ -> Just (commentAt ls s LineComment (T.pack t)) _ -> Nothing where s = spanOfReal spn@@ -132,14 +131,14 @@ commentAt ls spn style raw = Comment { commentSpan = spn,- commentBody = normalizeBody startColumn style raw,+ commentBody = normalizeBody (spanStartColumn spn) style raw, commentStyle = style, commentAbove = above, commentCodeBeforeStopsAt = codeBeforeStopsAt, commentFirstInBrackets = any ((`T.elem` "([{") . snd) (T.unsnoc before'), commentFollowed = followed, commentGapAbove = above == BlankLine,- commentGapBelow = blankAt (spanEndLine spn + 1) ls,+ commentGapBelow = not followed && blankAt (spanEndLine spn + 1) ls, commentNextLine = nextLine } where@@ -181,25 +180,28 @@ BlockComment -> c { commentBody =- normalizeBody startColumn BlockComment (sliceSpan (lineTexts ls) s)+ normalizeBody+ (spanStartColumn s)+ BlockComment+ (sliceSpan (lineTexts ls) s) } _ -> c where s = commentSpan c- startColumn =- maybe 0 (`offsetOf` spanStartColumn s) (lineAt (spanStartLine s) ls) -- | 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 =+normalizeBody column style raw = case NE.nonEmpty (T.lines raw) of Nothing -> spaceAfterDashes style raw :| [] Just (first' :| rest) -> fmap T.stripEnd (spaceAfterDashes style first' :| fmap dedent rest) where- dedent l = T.drop (min startColumn (T.length (T.takeWhile isSpace l))) l+ dedent l =+ let n = offsetOf (T.takeWhile isSpace l) column+ in T.replicate (columnOf l n - column) " " <> T.drop n l -- | @--foo@ becomes @-- foo@; @----@ and @-- foo@ are left alone. --@@ -285,6 +287,7 @@ -- | The line whose trailing comment a comment with the line to itself -- carries on, by being lined up under that line or that comment, or under -- comments that carry it on in turn, and the column that comment begins at.+-- A trailing comment that closes itself is carried on by none. carriedOnFrom :: [Comment] -> Comment -> Maybe (Int, Int) carriedOnFrom cs = \c -> if commentTrailing c || commentFollowed c@@ -301,6 +304,7 @@ | c <- cs, commentTrailing c, not (commentFollowed c),+ not (closesItself c), let s = commentSpan c ] ownLineComments =@@ -350,7 +354,8 @@ escapeTrigger c = case commentStyle c of DocComment -> c- { commentBody = fmap escape (commentBody c),+ { commentBody = case commentBody c of+ opening :| rest -> escape opening :| rest, commentStyle = if bracketed c then BlockComment else LineComment } _ -> c
src/Tilia/Comments/Attach.hs view
@@ -9,6 +9,7 @@ ( attachComments, attachScopedComments, Margin (..),+ commentText, ) where @@ -25,7 +26,7 @@ import Tilia.Comments import Tilia.Comments.Place import Tilia.Doc.Combinators-import Tilia.Doc.Internal (Doc (..), Spill (..), foldChildren)+import Tilia.Doc.Internal (Doc (..), foldChildren) import Tilia.Span -- | Attach comments to a 'Doc'.@@ -97,10 +98,10 @@ where placeOne opensTheRun c = commentDoc c $- closeLine+ DCloseLine <> includeWhen (opensTheRun || commentGapAbove c) blankLine <> commentText margin c- <> closeLine+ <> DCloseLine -- | The spans of every 'DLocated' in the document, and of every 'DFence', -- in that order.@@ -239,12 +240,12 @@ InPlace -> case position of Before -> includeUnless glued space <> body <> includeUnless atTheEnd space _ -> space <> body- EndsTheLine -> space <> body <> closeLine <> gapBelow- HeldBack spill -> holdBack spill (renderComment c)+ EndsTheLine -> space <> body <> DCloseLine <> gapBelow+ HeldBack spill -> DHoldBack spill (renderComment c) OnItsOwnLines ->- closeLineUnlessAfterOpener (commentGapAbove c)+ DCloseLineUnlessAfterOpener (commentGapAbove c) <> body- <> closeLine+ <> DCloseLine <> gapBelow where glued = commentTrailing c && (not atTheEnd || commentFirstInBrackets c)@@ -272,17 +273,3 @@ note | marginComment margin c = cppMarginNote | otherwise = id---- | Put this text at the end of the line this position falls on.-holdBack :: Spill -> Text -> Doc-holdBack = DHoldBack---- | End the current line and leave a mark so that a line break that follows--- it immediately (if any) will have no effect.-closeLine :: Doc-closeLine = DCloseLine---- | 'closeLine', with an empty line under it if told to, unless the line--- ends with an opening bracket, a bar or an equals sign.-closeLineUnlessAfterOpener :: Bool -> Doc-closeLineUnlessAfterOpener = DCloseLineUnlessAfterOpener
src/Tilia/Comments/Place.hs view
@@ -133,7 +133,7 @@ wider a b = if endPoint a >= endPoint b then a else b against c- | Just placed@(_, After _) <- asCommentBefore = Just placed+ | Just placed <- asCommentBefore = Just placed | commentTrailing c, Just r <- trailed = Just (r, After SpillAtIndentation)@@ -146,7 +146,7 @@ here = commentSpan c asCommentBefore = against =<< (`Map.lookup` commentsByEndPoint) =<< stopsAt trailed- | writtenAgainst || not (commentFollowed c) =+ | writtenAgainst || endsItsLine c = linedUpUnder <|> endingOn (spanStartLine here) | otherwise = Nothing linedUpUnder = do@@ -167,11 +167,13 @@ fencedOff r = outside (Map.lookup here enclosingRegions)- || (printedInPlace && outside (Map.lookup here enclosingFences))+ || (not heldBack && outside (Map.lookup here enclosingFences)) where outside = maybe False (\(from, to) -> not (from <= startPoint r && endPoint r <= to)) - printedInPlace = shapeOf (After SpillAtIndentation) c == InPlace+ heldBack = case shapeOf (After SpillAtIndentation) c of+ HeldBack _ -> True+ _ -> False next = snd <$> Map.lookupGE (endPoint here) regionsByStartPoint @@ -187,12 +189,15 @@ under | Just (top, bottom) <- IntMap.lookup (spanStartLine here) runs,- Just (line, column) <- commentNextLine bottom,- column /= spanStartColumn here,- any ((<= (line, column)) . startPoint) next =+ all (beginsUnder (commentNextLine bottom)) next = lineOfCode top | otherwise = Nothing + beginsUnder below r = case below of+ Just (line, column) ->+ column /= spanStartColumn here && startPoint r <= (line, column)+ Nothing -> False+ lineOfCode top = do r <- nearest (Down . startPoint) (filter linedUp onThatLine) guard (any (larger r) onThatLine)@@ -221,6 +226,20 @@ larger r o = startPoint o < startPoint r && endPoint o == lineEnd commentsByEndPoint = Map.fromList [(endPoint (commentSpan c), c) | c <- comments]++ endsItsLine c =+ not (commentFollowed c)+ || maybe+ False+ endsItsLine+ (Map.lookup (endPoint (commentSpan c)) commentsByStopPoint)++ commentsByStopPoint =+ Map.fromList+ [ ((spanStartLine (commentSpan c), n), c)+ | c <- comments,+ Just n <- [commentCodeBeforeStopsAt c]+ ] runs = IntMap.fromList
src/Tilia/Cpp.hs view
@@ -5,7 +5,7 @@ -- -- Each configuration is printed on its own and the documents are merged. -- Working out what the configurations are is "Tilia.Cpp.Directives", whose--- vocabulary this module re-exports so that callers need only one import.+-- vocabulary this module re-exports. module Tilia.Cpp ( -- * Formatting formatWithCpp,@@ -510,7 +510,8 @@ <$> formatAllConfigs formatter (readingOf r t) else pure Nothing docs <-- except (traverse (complete (fmap (fmap fst) found)) (zip [0 ..] texts))+ except . traverse (complete (fmap (fmap fst) found)) $+ zip [0 ..] (fmap snd answers) let settledIn i | Just _ <- lookup i found = settledBy !! i | otherwise = foldMap ((settledBy !!) . fst) (listToMaybe found)@@ -545,11 +546,8 @@ . unconditionalErrors $ t --- | Preserve an error-only alternative without asking the Haskell parser to--- parse its missing expression or declaration. A successful sibling supplies--- the surrounding syntax, with the nodes wholly inside the conditional taken--- out; the @#error@ is put back into the space they leave with every other--- directive. More complicated aborting alternatives are left unsupported.+-- | The document of a configuration whose varied lines hold nothing but an+-- @#error@: a sibling's, with what it printed from those lines taken out. errorBranch :: Varied -> Text -> Doc -> Maybe Doc errorBranch (Varied ranges) source reference = foldl step (Just reference) ranges where
src/Tilia/Cpp/Directives.hs view
@@ -148,6 +148,9 @@ | -- | A line using a macro written inside a quasi-quote or a multi-line -- string, its line, and what is written on it. MacroInQuotedText Int Text+ | -- | A line using a macro or an @#include@ written before a leading+ -- comma, its line, and what is written on it.+ BeforeLeadingComma Int Text | -- | A branch holding something that a conditional around it, asking the -- same question, rules out, and the line of the directive opening it. RuledOutBranch Int@@ -178,6 +181,11 @@ "the #" <> k <> " at line " <> tshow n <> " is inside a quasi-quote or a multi-line string" MacroInQuotedText n t -> t <> " at line " <> tshow n <> " is inside a quasi-quote or a multi-line string"+ BeforeLeadingComma n t ->+ t+ <> " at line "+ <> tshow n+ <> " comes before a leading comma, which formatting moves above it" RuledOutBranch n -> "the branch at line " <> tshow n@@ -384,13 +392,8 @@ | gs <- forest ] --- | Read both spellings under the same CPP choices.------ Sorting or deduplicating the resulting source text separately loses the--- association with the guards: formatting can change that order or make two--- formerly different strings identical. Cover every branch of either--- spelling, including its ancestors. 'Nothing' denotes a configuration--- deliberately rejected by @#error@.+-- | Each configuration either module has, as the one and the other read in+-- it, with 'Nothing' where an @#error@ rules it out. correspondingBranches :: -- | Before. Text ->
src/Tilia/Cpp/Place.hs view
@@ -15,6 +15,7 @@ import Control.Applicative ((<|>)) import Control.Monad (foldM)+import Data.Char (isSpace) import Data.List (sortOn, unsnoc) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map@@ -61,7 +62,7 @@ unwrap, wrap, )-import Tilia.Source (Lines, Written (..), blankAt, lineAt, linesOf)+import Tilia.Source (Lines, Written (..), blankAt, lineAt, lineTexts, linesOf) import Tilia.Span (Span (..), mkSpan, startPoint) -- | What the configurations of a module had besides their code.@@ -418,6 +419,9 @@ putDirective :: Lines -> Doc -> Directive -> Either CppError Doc putDirective written doc d | quotedAt doc (dLine d) = Left (DirectiveInQuotedText (dLine d) (dKeyword d))+ | dKeyword d == "include",+ commaUnder written (dLastLine d) =+ Left (BeforeLeadingComma (dLine d) ("#" <> dText d)) | otherwise = Right (placeAt (const False) (Just written) (dLine d) body id doc) where body =@@ -429,11 +433,22 @@ putMacroLine :: Lines -> Doc -> (Int, Text) -> Either CppError Doc putMacroLine written doc (n, t) | quotedAt doc n = Left (MacroInQuotedText n t)+ | commaUnder written n = Left (BeforeLeadingComma n t) | otherwise = Right (placeAt (const False) (Just written) n body indent doc) where body = DLocated (mkSpan (n, 1) (n, 1)) (DCloseLine <> DText t <> DCloseLine) <> includeWhen (blankAt (n + 1) written) blankLine++-- | Does the code under a line open with a comma, which the printer puts at+-- the end of the item above the line instead?+commaUnder :: Lines -> Int -> Bool+commaUnder written n = case dropWhile passed (drop n (lineTexts written)) of+ l : _ -> T.isPrefixOf "," (T.stripStart l)+ [] -> False+ where+ passed l =+ T.all isSpace l || isDirective l || T.isPrefixOf "--" (T.stripStart l) -- | Is this line inside something the document reproduces verbatim, such -- as a quasi-quotation, where a line cannot be put back?
src/Tilia/Diff.hs view
@@ -14,8 +14,8 @@ import Control.Monad.ST (ST, runST) import Data.Array.ST (STUArray, newArray, readArray, writeArray) import Data.Array.Unboxed (Array, UArray, listArray, (!))+import Data.List (unfoldr) import Data.Map.Strict qualified as Map-import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as T import Tilia.Palette (Color (..), Palette, paint)@@ -57,7 +57,8 @@ before = "a/" <> T.pack path after = "b/" <> T.pack path --- | One line of the comparison, with the number it has on each side.+-- | One line of the comparison, with the number it has on each side, and+-- with the newline it ends in, if it ends in one. data Line = Line !Mark !Int !Int !Text -- | A unified diff, with whatever heading the caller wants.@@ -72,14 +73,8 @@ -- | After. Text -> Text-unified palette 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 <> body)+unified palette above (beforeName, afterName) before after =+ T.intercalate "\n" (above <> heading <> body) where heading = [ paint palette (Header Gone) ("--- " <> beforeName),@@ -88,7 +83,7 @@ body = concatMap render hunks - render range = hunkHeading range : fmap line (slice range)+ render range = hunkHeading range : concatMap line (slice range) hunkHeading range = paint palette Meta $@@ -99,13 +94,18 @@ <> " @@" where span' which n = case slice range of- (l : _) -> tshow (which l) <> "," <> tshow n- [] -> "0,0"+ l : _ | n > 0 -> tshow (which l) <> "," <> tshow n+ _ -> "0,0" - line (Line mark _ _ text) = case mark of- Context -> paint palette Kept (" " <> text)- Removed -> paint palette Gone ("-" <> text)- Added -> paint palette New ("+" <> text)+ line (Line mark _ _ text) = case T.stripSuffix "\n" text of+ Just ended -> [marked ended]+ Nothing ->+ [marked text, paint palette Meta "\\ No newline at end of file"]+ where+ marked = case mark of+ Context -> paint palette Kept . (" " <>)+ Removed -> paint palette Gone . ("-" <>)+ Added -> paint palette New . ("+" <>) slice (from, to) = take (to - from + 1) (drop from lines') @@ -118,8 +118,12 @@ changed = [i | (i, Line m _ _ _) <- zip [0 ..] lines', m /= Context] total = length lines' lines' = tag (split before) (split after)- split = fmap withoutReturn . T.splitOn "\n"- withoutReturn l = fromMaybe l (T.stripSuffix "\r" l)+ split = unfoldr $ \t ->+ if T.null t+ then Nothing+ else+ let (l, rest) = T.breakOn "\n" t+ in Just (l <> T.take 1 rest, T.drop 1 rest) -- | How many unchanged lines to show either side of a change. margin :: Int
src/Tilia/Doc/Internal.hs view
@@ -685,7 +685,7 @@ KeepWhitespace -> id -- | Assemble the final text: one trailing newline, no blank lines at the--- end, no trailing whitespace anywhere.+-- end, and trailing whitespace only where a verbatim line keeps it. finish :: Out -> Text finish out = case dropWhile (T.null . lineBody) (outLines (breakLine 0 out)) of
src/Tilia/Editor.hs view
@@ -11,21 +11,20 @@ where import Data.Choice (Choice)-import Data.Maybe (mapMaybe)+import Data.Either (fromRight) import Data.Text (Text) import Tilia.Cabal.Project (ProjectRoot (..), findProjectRoot) import Tilia.Cabal.Target ( Target (Everything),- componentInPlan, componentsOfTarget, ) import Tilia.Format ( Compiled (..), FormatError (NoProject),- PlanSource (..), Session, compiledSession, newSession,+ planSourceFor, sessionRoot, ) import Tilia.Ignore (isIgnoredInProject)@@ -61,11 +60,8 @@ findProjectRoot file >>= \case Nothing -> pure (Left (NoProject file)) Just root -> do- planSource <- case givenPlan of- Just plan -> pure (GivenPlan plan)- Nothing ->- PlanFromCabal . either (const []) (mapMaybe componentInPlan)- <$> componentsOfTarget root Everything+ planSource <-+ planSourceFor givenPlan (fromRight [] <$> componentsOfTarget root Everything) newSession root planSource
src/Tilia/Equivalence.hs view
@@ -58,6 +58,7 @@ Pragma (..), asOrdinary, carriedOnFrom,+ carriesOn, commentPragma, commentTrailing, triggerEscaped,@@ -67,7 +68,7 @@ import Tilia.Pragma (languageNames, pragmaFlags) import Tilia.Pragma.Ghc (InForce (..), inForceAfter) import Tilia.Source (comments, sourceLines)-import Tilia.Span (Span (..))+import Tilia.Span (Span (..), covers) import Tilia.Span.Ghc (spanOf, spansOf) import Tilia.Utils (tshow) @@ -431,8 +432,10 @@ -- 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.+-- before being compared, with the pragmas of the header that hold a+-- comment. What is still asked of that stretch is that the same comments+-- come out of it, and those inside the export list, which nothing sorts,+-- in order. -- -- Documentation comments are counted rather than compared. The printer may -- legitimately rewrite one—a @-- ^ x@ that moves in front of what it@@ -476,19 +479,27 @@ <> tshow docsAfter | otherwise = diverge (belowHeader moduleBefore before) (belowHeader moduleAfter after)+ <|> diverge (settled headerCommentsBefore) (settled headerCommentsAfter) <|> diverge- (settled (withinHeader moduleBefore before))- (settled (withinHeader moduleAfter after))+ (exported moduleBefore headerCommentsBefore)+ (exported moduleAfter headerCommentsAfter) where moduleBefore = pmModule parsedBefore moduleAfter = pmModule parsedAfter before = asRead parsedBefore after = asRead parsedAfter+ headerCommentsBefore = withinHeader parsedBefore before+ headerCommentsAfter = withinHeader parsedAfter after asRead m = concatMap (asOrdinary (sourceLines (pmSource m))) (comments (pmSource m)) belowHeader m cs = filter (not . inHeader m cs) (ordinary cs)- withinHeader m cs = filter (inHeader m cs) (ordinary cs)+ withinHeader m cs =+ filter (inHeader (pmModule m) cs) (ordinary cs)+ <> filter commented (takeWhile (pragmaWritten m . commentSpan) cs)+ pragmaWritten = writtenInHeader . pmHeaderEnd+ exported m =+ filter (\c -> any (`covers` commentSpan c) (spanOf =<< hsmodExports m)) settled = sortOn bodyKey inHeader m cs = case lastRearrangedLine m cs of@@ -515,6 +526,7 @@ ordinary = filter (\c -> not (isDocumentation c) && isNothing (commentPragma c))+ commented = maybe False pragmaCommented . commentPragma diverge [] [] = Nothing diverge (b : _) [] = Just ("lost " <> quoted b)@@ -607,12 +619,14 @@ <> foldMap spanOf (hsmodExports m) carriedPast lastLine = maybe lastLine (spanEndLine . commentSpan . snd) . unsnoc $- takeWhile- (maybe False ((<= lastLine) . fst) . carriedOnFrom (remarks <> run))- run+ takeWhile (\c -> any (carries c) (carriedOn c)) run where remarks = [c | c <- cs, spanEndLine (commentSpan c) == lastLine] run = following (lastLine + 1) cs+ carriedOn = carriedOnFrom (remarks <> run)+ carries c (line, remark) =+ line <= lastLine && carriesOn remark (commentSpan c) next+ next = spanOf =<< listToMaybe (hsmodDecls m) following n = \case c : more | spanStartLine (commentSpan c) < n -> following n more
src/Tilia/Fixity.hs view
@@ -16,7 +16,6 @@ -- * Module declarations declaredFixities,- moduleName, -- * Module exports ExportItem (..),@@ -32,6 +31,7 @@ certainlyBrings, decides, Namespace (..),+ typeOperatorNamespace, Fixities, Certain (..), ModuleChain (..),@@ -45,6 +45,7 @@ Provenance (..), Resolution (..), lookupFixity,+ fixityInScope, -- * What could not be answered Unknown (..),@@ -78,7 +79,7 @@ import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map-import Data.Maybe (mapMaybe)+import Data.Maybe (listToMaybe, mapMaybe) import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text)@@ -87,7 +88,7 @@ import GHC.Generics (Generic) import GHC.Hs hiding (Fixity, OpName) import GHC.Types.Fixity qualified as GHC-import GHC.Types.Name.Occurrence (occNameString)+import GHC.Types.Name.Occurrence (isDataOcc, occNameString) import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc) import GHC.Types.SrcLoc (GenLocated (..), unLoc) import Tilia.Gathered (Gathered (..))@@ -196,7 +197,7 @@ ForD _ f -> [opName (unLoc (fd_name f))] TyClD _ d@DataDecl{} -> fmap snd (membersOf d) TyClD _ ClassDecl{tcdSigs} -> concatMap (signedNames . unLoc) tcdSigs- _ -> []+ d -> concatMap (constructorsOf . snd) (dataInstances d) -- | The members of the type or class a declaration declares, by -- namespace: a data type's constructors and record fields, a class's@@ -206,13 +207,29 @@ -- its own—@:|@ is a constructor and @infixr 5@ all the same. membersOf :: TyClDecl GhcPs -> [(Namespace, OpName)] membersOf = \case- DataDecl{tcdDataDefn} ->- fmap (InTerms,) (concatMap (fromCon . unLoc) (consOf (dd_cons tcdDataDefn)))+ DataDecl{tcdDataDefn} -> fmap (InTerms,) (constructorsOf tcdDataDefn) ClassDecl{tcdSigs, tcdATs} -> fmap (InTerms,) (concatMap (signedNames . unLoc) tcdSigs) <> [(InTypes, opName (unLoc (fdLName (unLoc f)))) | f <- tcdATs] _ -> []++-- | The data instances a declaration makes, each with its family: its own,+-- or those of a class instance.+dataInstances :: HsDecl GhcPs -> [(OpName, HsDataDefn GhcPs)]+dataInstances = \case+ InstD _ (DataFamInstD _ d) -> [instanceOf d]+ InstD _ (ClsInstD _ ClsInstDecl{cid_datafam_insts}) ->+ fmap (instanceOf . unLoc) cid_datafam_insts+ _ -> [] where+ instanceOf :: DataFamInstDecl GhcPs -> (OpName, HsDataDefn GhcPs)+ instanceOf (DataFamInstDecl FamEqn{feqn_tycon, feqn_rhs}) =+ (opName (unLoc feqn_tycon), feqn_rhs)++-- | The constructors and record fields a data definition declares.+constructorsOf :: HsDataDefn GhcPs -> [OpName]+constructorsOf = concatMap (fromCon . unLoc) . consOf . dd_cons+ where consOf :: DataDefnCons (LConDecl GhcPs) -> [LConDecl GhcPs] consOf = toList @@ -299,8 +316,9 @@ IEVar _ n _ -> [as (ExportName InTerms) n] IEThingAbs _ n _ -> [as (ExportName InTypes) n] IEThingAll _ n _ -> [as ExportAll n]- IEThingWith _ n _ ns _ ->- [as ExportSome n (fmap (opName . ieWrappedName . unLoc) ns)]+ IEThingWith _ n wildcard ns _ ->+ [as ExportAll n | IEWildcard _ <- [wildcard]]+ <> [as ExportSome n (fmap (opName . ieWrappedName . unLoc) ns)] IEModuleContents _ m -> [ExportModule (T.pack (moduleNameString (unLoc m)))] _ -> [] as item n =@@ -313,7 +331,8 @@ Qual m _ -> Just (T.pack (moduleNameString m)) _ -> Nothing --- | The members of each type or class a module declares.+-- | The members of each type or class a module declares, and of each data+-- family it gives instances of. declaredMembers :: HsModule GhcPs -> Map OpName (Set (Namespace, OpName)) declaredMembers = Map.fromListWith Set.union . concatMap (fromDecl . unLoc) . hsmodDecls@@ -321,7 +340,10 @@ fromDecl = \case TyClD _ d@DataDecl{tcdLName} -> [entry tcdLName d] TyClD _ d@ClassDecl{tcdLName} -> [entry tcdLName d]- _ -> []+ d ->+ [ (family, Set.fromList (fmap (InTerms,) (constructorsOf defn)))+ | (family, defn) <- dataInstances d+ ] entry name d = (opName (unLoc name), Set.fromList (membersOf d)) -- | The members a module's export list offers with each name.@@ -333,9 +355,12 @@ declared = Map.map (Set.map snd) (declaredMembers hsModule) fromIE = \case IEThingAbs _ n _ -> [(nameOf n, Set.empty)]- IEThingAll _ n _ -> [(nameOf n, kids) | Just kids <- [Map.lookup (nameOf n) declared]]- IEThingWith _ n _ ns _ -> [(nameOf n, Set.fromList (fmap nameOf ns))]+ IEThingAll _ n _ -> whole n+ IEThingWith _ n wildcard ns _ ->+ (nameOf n, Set.fromList (fmap nameOf ns))+ : concat [whole n | IEWildcard _ <- [wildcard]] _ -> []+ whole n = [(nameOf n, kids) | Just kids <- [Map.lookup (nameOf n) declared]] nameOf = opName . ieWrappedName . unLoc ----------------------------------------------------------------------------@@ -740,6 +765,9 @@ Just missing -> Unresolved missing -- | What the scope itself has for a use, and the namespace it came from.+--+-- A use among types is taken for a promoted constructor only where no type+-- of its name may be in scope, as GHC prefers the type. fixityInScope :: -- | The scope. Scope ->@@ -756,14 +784,21 @@ | Just fixity <- Map.lookup op builtInSyntax = Just (namespace, (fixity, BuiltIn)) | otherwise =- case mapMaybe found (namespace : promotedFrom namespace) of- (answer : _) -> Just answer- [] -> Nothing+ listToMaybe . mapMaybe found $+ namespace : [n | n <- promotedFrom namespace, unclaimed] where found n = (n,) <$> case qualifier of Nothing -> Map.lookup op (reachUnqualified (reachIn n scope)) Just q -> Map.lookup (q, op) (reachQualified (reachIn n scope))+ unclaimed =+ Set.notMember (qualifier, op) (reachDecided (reachIn namespace scope))+ && null+ [ ()+ | (i, established) <- scopeUnsettled scope,+ maySupply (establishedMembers established) qualifier op i,+ _ <- unsettledThrough established (namespace, op)+ ] -- | The operators the language gives a fixity, rather than a declaration -- anywhere: @:@ alone.@@ -776,6 +811,13 @@ InTypes -> [InTerms] InTerms -> [] +-- | The namespace an operator written in a type is in: among terms for a+-- promoted constructor written with its tick, among types otherwise.+typeOperatorNamespace :: RdrName -> Namespace+typeOperatorNamespace n+ | isDataOcc (rdrNameOcc n) = InTerms+ | otherwise = InTypes+ -- | The unread imports that could have declared this operator. unreadThatMightDeclare :: -- | The scope.@@ -828,7 +870,8 @@ -- nothing is regrouped around it. operatorsUsed :: Gathered -> [(Namespace, (Maybe Text, OpName))] operatorsUsed found =- fmap (named InTerms) inExpressions <> fmap (named InTypes) inTypes+ fmap (named InTerms) inExpressions+ <> [named (typeOperatorNamespace n) n | n <- inTypes] where captured = capturedUses found inExpressions =
src/Tilia/Fixity/Archive.hs view
@@ -27,6 +27,7 @@ import Data.Text.Encoding qualified as T import Distribution.PackageDescription (GenericPackageDescription) import GHC.Generics (Generic)+import System.FilePath.Posix qualified as Posix import Tilia.Cabal.Package (packageSourceDirs) import Tilia.Fixity.Cabal (entryPosixPath, ownCabalFile) import Tilia.Utils (quietly)@@ -67,15 +68,15 @@ where dirs = maybe [] packageSourceDirs (archiveCabal archive) pick ending =- inArchive ending . T.decodeUtf8Lenient . snd- <$> listToMaybe (under sfx matching <> matching)- where- sfx = "/" <> pathOfModule modName <> ending- matching = [f | f <- archiveFiles archive, sfx `isSuffixOf` fst f]- under sfx matching = [f | d <- dirs, f <- matching, inDir sfx d (fst f)]- inDir sfx d path- | d == "." = takeWhile (/= '/') path <> sfx == path- | otherwise = ("/" <> d <> sfx) `isSuffixOf` path+ inArchive ending . T.decodeUtf8Lenient+ <$> listToMaybe+ [ content+ | d <- dirs,+ let file =+ Posix.normalise (d <> "/" <> pathOfModule modName <> ending),+ (path, content) <- archiveFiles archive,+ drop 1 (dropWhile (/= '/') path) == file+ ] -- | Where a module's file is under the directory that holds it, without an -- extension.
src/Tilia/Fixity/Cabal.hs view
@@ -21,7 +21,11 @@ import Data.List (isSuffixOf) import Data.Text (Text) import Distribution.PackageDescription (GenericPackageDescription)-import Tilia.Cabal.Package (declaredModules, parsePackageDescription)+import Tilia.Cabal.Package+ ( declaredModules,+ packageBranches,+ parsePackageDescription,+ ) import Tilia.Utils (quietly) -- | The modules a package holds, read from the @.cabal@ file in its@@ -32,7 +36,7 @@ packageModules tarball = quietly Nothing $ do bytes <- BL.readFile tarball evaluate . force $- fmap fst . declaredModules+ fmap fst . concatMap snd . declaredModules . packageBranches <$> cabalFileInArchive (Tar.read (GZip.decompress bytes)) -- | The first @.cabal@ file at the top level of an archive.
src/Tilia/Fixity/Cache.hs view
@@ -25,10 +25,13 @@ storeSolveTime, cachedPackageCache, storePackageCache,+ forgetPackageCache, ) where +import Control.Exception (bracketOnError) import Control.Monad (join)+import Data.ByteString qualified as BS import Data.Choice (Choice, isFalse) import Data.Foldable (toList, traverse_) import Data.List.NonEmpty (NonEmpty)@@ -39,6 +42,7 @@ 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.Time (UTCTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.Format.ISO8601 (iso8601ParseM, iso8601Show)@@ -47,12 +51,14 @@ createDirectoryIfMissing, getModificationTime, getXdgDirectory,+ removeFile, renameFile, )-import System.FilePath (takeDirectory, (</>))+import System.FilePath (takeDirectory, takeFileName, (</>))+import System.IO (hClose, openBinaryTempFile) import Tilia.Fixity import Tilia.Fixity.PackageDb (Installed (..), InstalledPackage (..))-import Tilia.Utils (quietly, readUtf8File, tshow, writeUtf8File)+import Tilia.Utils (quietly, readUtf8File, sha256Of, tshow) -- | Where cached answers are kept together with a token unique to this -- build plan and environment, or nowhere, in which case nothing is@@ -453,16 +459,34 @@ storeSolveTime cache = writeAtomically (at cache (solveTimeFile cache)) . T.pack . iso8601Show --- | Where @cabal@ last said it keeps the sources it downloads.-cachedPackageCache :: Cache -> IO (Maybe FilePath)-cachedPackageCache cache =- readIfPresent (at cache (packageCacheFile cache)) (T.unpack . T.strip)+-- | Where @cabal@ last said it keeps the sources it downloads for the+-- project in the directory given.+cachedPackageCache :: Cache -> FilePath -> IO (Maybe FilePath)+cachedPackageCache cache projectDir =+ readIfPresent+ (at cache (packageCacheFile cache projectDir))+ (T.unpack . T.strip) --- | Remember where @cabal@ keeps the sources it downloads.-storePackageCache :: Cache -> FilePath -> IO ()-storePackageCache cache =- writeAtomically (at cache (packageCacheFile cache)) . T.pack+-- | Remember where @cabal@ keeps the sources it downloads for a project.+storePackageCache ::+ -- | Where to remember it.+ Cache ->+ -- | The project's directory.+ FilePath ->+ -- | Where @cabal@ keeps the sources.+ FilePath ->+ IO ()+storePackageCache cache projectDir =+ writeAtomically (at cache (packageCacheFile cache projectDir)) . T.pack +-- | Forget where @cabal@ said it keeps the sources it downloads for a+-- project.+forgetPackageCache :: Cache -> FilePath -> IO ()+forgetPackageCache cache projectDir =+ traverse_+ (quietly () . removeFile)+ (at cache (packageCacheFile cache projectDir))+ -- | Render a fixity declaration as fields. renderFixity :: ((Namespace, OpName), Fixity) -> [Text] renderFixity ((namespace, OpName op), Fixity direction precedence) =@@ -571,9 +595,12 @@ solveTimeFile :: Cache -> [Text] solveTimeFile cache = ["solve-times", tokenOf cache] --- | The path of the directory @cabal@ downloads sources into.-packageCacheFile :: Cache -> [Text]-packageCacheFile cache = ["package-cache", tokenOf cache]+-- | The path of the directory @cabal@ downloads a project's sources into.+packageCacheFile :: Cache -> FilePath -> [Text]+packageCacheFile cache projectDir =+ [ "package-cache",+ tokenOf cache <> "-" <> T.take 16 (sha256Of (T.pack projectDir))+ ] -- | The token a cache is kept under. tokenOf :: Cache -> Text@@ -591,13 +618,19 @@ Nothing -> pure Nothing Just path -> fmap parse <$> readUtf8File path --- | Write via a temporary file and a rename, making the directory if need--- be.+-- | Write via a temporary file of this write's own and a rename, making+-- the directory if need be. writeAtomically :: Maybe FilePath -> Text -> IO () writeAtomically place contents = case place of Nothing -> pure () Just path -> quietly () $ do- createDirectoryIfMissing True (takeDirectory path)- let temporary = path <> ".tmp"- writeUtf8File temporary contents- renameFile temporary path+ let directory = takeDirectory path+ createDirectoryIfMissing True directory+ bracketOnError+ (openBinaryTempFile directory (takeFileName path <> ".tmp"))+ (\(temporary, h) -> hClose h >> removeFile temporary)+ ( \(temporary, h) -> do+ BS.hPut h (T.encodeUtf8 contents)+ hClose h+ renameFile temporary path+ )
src/Tilia/Fixity/Debug.hs view
@@ -24,15 +24,18 @@ Fixity (..), Import (..), ModuleChain (..),+ Namespace (..), OpName (..), Provenance (..), Resolution (..), Scope (..), disagreement,+ fixityInScope, lookupFixity, moduleImports, operatorSpelling, operatorsUsed,+ reachIn, reachUnqualified, spellDisagreement, spellFixity,@@ -47,10 +50,11 @@ data FixityNotes = FixityNotes { -- | What each import brought, in the order the module writes them. notedImports :: [ImportNote],- -- | Resolutions per operator.- notedOperators :: [OperatorNote],- -- | What operators the module declares.- notedDeclarations :: [(Text, Fixity)]+ -- | Resolutions per operator, with the namespaces each holds in.+ notedOperators :: [(Namespaces, OperatorNote)],+ -- | What operators the module declares, with the namespaces each+ -- declaration is in.+ notedDeclarations :: [(Namespaces, (Text, Fixity))] } deriving (Eq, Show) @@ -84,6 +88,10 @@ } deriving (Eq, Show) +-- | The namespaces an entry holds in.+data Namespaces = One Namespace | Both+ deriving (Eq, Show)+ -- | Record everything that decided one module's fixities. fixityNotes :: -- | Whether @ImplicitPrelude@ is on, so that the Prelude is listed among@@ -102,7 +110,7 @@ pure FixityNotes { notedImports = importNotes,- notedOperators = fmap aboutOperator used,+ notedOperators = used, notedDeclarations = here } where@@ -130,29 +138,38 @@ } used =- Map.elems- ( Map.fromList- [ ((namespace, uncurry operatorSpelling u), (namespace, u))- | (namespace, u) <- concatMap (operatorsUsed . pmGathered) configurations- ]- )+ joined . Map.elems $+ Map.fromList+ [ ((noteSpelling note, answering), (One answering, note))+ | (answering, note) <-+ fmap aboutOperator (concatMap (operatorsUsed . pmGathered) configurations)+ ] here =- [ (op, fixity)- | (OpName op, (fixity, DeclaredHere)) <- Map.toList declaredHere- ]- declaredHere =- Map.union- (reachUnqualified (scopeInTerms scope))- (reachUnqualified (scopeInTypes scope))+ joined . Map.elems $+ Map.fromList+ [ ((op, namespace), (One namespace, (op, fixity)))+ | namespace <- [InTypes, InTerms],+ (OpName op, (fixity, DeclaredHere)) <-+ Map.toList (reachUnqualified (reachIn namespace scope))+ ] aboutOperator (namespace, (qualifier, op)) =- OperatorNote- { noteSpelling = operatorSpelling qualifier op,- noteResolution = lookupFixity scope namespace qualifier op,- noteDisagreement = disagreement scope namespace qualifier op- }+ ( maybe namespace fst (fixityInScope scope namespace qualifier op),+ OperatorNote+ { noteSpelling = operatorSpelling qualifier op,+ noteResolution = lookupFixity scope namespace qualifier op,+ noteDisagreement = disagreement scope namespace qualifier op+ }+ ) +-- | Join adjacent entries that differ only in their namespaces.+joined :: (Eq a) => [(Namespaces, a)] -> [(Namespaces, a)]+joined = \case+ (_, a) : (_, b) : rest | a == b -> (Both, a) : joined rest+ entry : rest -> entry : joined rest+ [] -> []+ -- | Set out all the 'FixityNotes' per file. renderFixityNotes :: Palette -> Map FilePath FixityNotes -> [Text] renderFixityNotes palette notes =@@ -202,16 +219,30 @@ (False, Just alias) -> " as " <> named alias (False, Nothing) -> "" - fromOwn (op, fixity) = operator op <> " " <> spellFixity fixity+ fromOwn (namespaces, (op, fixity)) =+ operator op <> " " <> spellFixity fixity <> " " <> spellNamespaces namespaces - fromOperator o =+ fromOperator (namespaces, o) = operator (noteSpelling o) <> " " <> case noteResolution o of Resolved fixity provenance ->- spellFixity fixity <> ", " <> from provenance <> ambiguously o+ spellFixity fixity+ <> " "+ <> spellNamespaces namespaces+ <> ", "+ <> from provenance+ <> ambiguously o Unresolved missing ->- "unknown: may be declared in " <> spellUnreadIn palette missing+ "unknown "+ <> spellNamespaces namespaces+ <> ": may be declared in "+ <> spellUnreadIn palette missing++ spellNamespaces = \case+ One InTypes -> "(type)"+ One InTerms -> "(term)"+ Both -> "(type & term)" from = \case DeclaredHere -> "declared in this module"
src/Tilia/Fixity/Interface.hs view
@@ -139,7 +139,12 @@ ("interface" : m : _) -> m == modName _ -> False sectionsNamed name = [body | (heading, body) <- sections out, heading == name]- fixities = Map.fromList (concatMap declared (sectionsNamed "fixities"))+ fixities =+ Map.fromListWith+ (flip (<>))+ [ (op, [fixity])+ | (op, fixity) <- concatMap declared (sectionsNamed "fixities")+ ] declared = mapMaybe fixityEntry . T.splitOn "," ownExports section = Set.fromList@@ -173,14 +178,19 @@ name <- take 1 (dropWhile (`elem` (["family", "role", "instance"] :: [Text])) rest) ] --- | Sort declared fixities into the namespaces they govern.-namespaced :: Set OpName -> Map OpName Fixity -> Fixities+-- | Sort declared fixities into the namespaces they govern: of two for one+-- name, GHC lists the term's first.+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]+ | (op, fixities) <- Map.toList declared,+ (namespace, fixity) <- zip (governed op fixities) fixities ]+ where+ governed op = \case+ [_, _] -> [InTerms, InTypes]+ _ -> [if Set.member op types then InTypes else InTerms] -- | Split the output into sections. sections :: Text -> [(Text, Text)]
src/Tilia/Fixity/PackageDb.hs view
@@ -13,11 +13,14 @@ where import Control.Monad (filterM)-import Data.List (nub)+import Data.List (nub, stripPrefix) import Data.Map.Strict qualified as Map-import Data.Maybe (mapMaybe)+import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text) import Data.Text qualified as T+import Distribution.Compat.Newtype (unpack')+import Distribution.FieldGrammar.Newtypes (FSep (..), FilePathNT (..), alaList')+import Distribution.Parsec (Parsec, simpleParsec) import System.Directory (doesDirectoryExist, findExecutable) import System.FilePath ((</>)) import Tilia.Process (readProgramOutput)@@ -81,16 +84,18 @@ -- | 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]- ]+ nub [root </> "package.conf.d" | Just root <- fmap packageRoot fields] --- | Strip the quotes a path is written in when it has none needing them.-unquote :: Text -> Text-unquote = T.dropAround (== '"') . T.strip+-- | Where a record's database keeps what @${pkgroot}@ stands for.+packageRoot :: Map.Map Text Text -> Maybe FilePath+packageRoot = fmap getFilePathNT . parsedField "pkgroot" +-- | A record's field, read as Cabal-syntax reads it, which is how+-- @ghc-pkg@ writes it.+parsedField :: (Parsec a) => Text -> Map.Map Text Text -> Maybe a+parsedField key fields =+ simpleParsec . T.unpack . T.strip =<< Map.lookup key fields+ -- | Split @ghc-pkg dump@ output into its records. records :: Text -> [Text] records = fmap T.unlines . go . T.lines@@ -117,15 +122,13 @@ ipImportDirs = maybe []- (fmap (T.unpack . rooted fields . unquote) . T.words)- (Map.lookup "import-dirs" fields)+ (fmap rooted . unpack' (alaList' FSep FilePathNT))+ (parsedField "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+ where+ rooted path =+ fromMaybe path ((<>) <$> root <*> stripPrefix "${pkgroot}" path)+ root = packageRoot fields -- | The modules an @exposed-modules@ field names that the package holds. moduleNames :: Text -> [Text]
src/Tilia/Fixity/Plan.hs view
@@ -27,7 +27,7 @@ import Control.Monad (filterM, join) import Data.Choice (Choice, fromBool, pattern Do) import Data.Containers.ListUtils (nubOrd)-import Data.Foldable (toList)+import Data.Foldable (asum, toList) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map)@@ -37,15 +37,18 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T+import Data.Traversable (for) import GHC.Hs (HsModule) import GHC.Hs.Extension (GhcPs) import GHC.LanguageExtensions.Type (Extension (ImplicitPrelude))-import System.Directory (doesFileExist)+import System.Directory (canonicalizePath, doesFileExist) import System.FilePath ((</>)) import Tilia.Cabal.Package- ( PackageReader,+ ( Kind (Lib),+ PackageReader, declaredModules, newPackageReader,+ packageComponents, packageExtensions, readPackageDescription, )@@ -63,7 +66,16 @@ import Tilia.Memo (Flights, memoized, newFlights, newMemo) import Tilia.Parser import Tilia.Pragma (Defaults, effectiveExtensions)-import Tilia.Utils (byteOrderMark, inParallel, quietly, readUtf8File, sha256Of, sha256OfFile, tshow)+import Tilia.Utils+ ( byteOrderMark,+ inParallel,+ pathUnder,+ quietly,+ readUtf8File,+ sha256Of,+ sha256OfFile,+ tshow,+ ) ---------------------------------------------------------------------------- -- Resolving@@ -82,11 +94,13 @@ -- | What can be asked about a module, once a plan says where to look. newtype Resolver = Resolver- { -- | What reading a module established about the names it exports.- askModule :: Text -> IO Established+ { -- | What reading a module established about the names it exports, as+ -- the file at the canonical path given, where it is one of the+ -- project's own, imports it.+ askModule :: Maybe FilePath -> Text -> IO Established } --- | Build a new 'Resolver'.+-- | Build a new 'Resolver' for the project in the current directory. -- -- 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@@ -97,7 +111,12 @@ IO Resolver newResolver plan = do packageReader <- newPackageReader (plannedCompiler plan) []- newResolverVia (Do #useCache) [FromInterface, FromSource] packageReader plan+ newResolverVia+ (Do #useCache)+ [FromInterface, FromSource]+ packageReader+ "."+ plan -- | 'newResolver', restricted to the routes given. newResolverVia ::@@ -107,14 +126,16 @@ [Route] -> -- | What the package of each of the project's own modules puts in force. PackageReader ->+ -- | The project the plan is for.+ FilePath -> -- | The build plan to use. BuildPlan -> IO Resolver-newResolverVia caching routes packageReader plan = do+newResolverVia caching routes packageReader projectDir plan = do cache <- openCache caching =<< tokenForBuildPlan plan tarballs <- if FromSource `elem` routes- then plannedTarballs cache plan+ then plannedTarballs cache projectDir plan else pure [] installed <- getInstalledPackages cache newResolverWith routes cache installed tarballs packageReader plan@@ -138,7 +159,7 @@ newResolverWith routes cache installed tarballs packageReader plan = do index <- buildModuleIndex cache installed tarballs let interfaces = interfaceIndex installed- local <- localModules plan+ importable <- localModules plan flights <- newFlights answersRead <- newMemo extensionsRead <- newMemo@@ -154,7 +175,7 @@ Workings { wkRoutes = routes, wkCache = cache,- wkLocal = local,+ wkImportable = importable, wkIndex = index, wkInterfaces = interfaces, wkInterfaceOf = interfaceOf,@@ -169,13 +190,16 @@ } -- The stand-in is what 'withReexports' makes of a module it is in the -- middle of reading.- reach visiting modName- | modName `Set.member` visiting = pure mempty+ reach visiting local modName+ | key `Set.member` visiting = pure mempty | otherwise =- memoized flights answersRead mempty modName $- resolveModule workings visiting modName- summariesOf modName text =- extensionsOf modName >>= \case+ memoized flights answersRead mempty key $+ resolveModule workings (Set.insert key visiting) found modName+ where+ found = local modName+ key = maybe modName T.pack found+ summariesOf found modName text =+ extensionsOf found modName >>= \case Nothing -> pure Nothing Just extensions -> do let summarized =@@ -184,7 +208,7 @@ stamp = digestOf . T.intercalate "\n" $ [tshow extensions, macrosRead, text]- case digestOf . T.pack <$> Map.lookup modName local of+ case digestOf . T.pack <$> found of Nothing -> summarized Just key -> join@@ -193,8 +217,8 @@ (storeSummaries cache key stamp) (Just <$> summarized) macrosRead = tshow (macrosOf plan)- extensionsOf modName- | Just path <- Map.lookup modName local =+ extensionsOf found modName+ | Just path <- found = either (const Nothing) Just <$> packageReader path | Just (package, tarball) <- Map.lookup modName index = memoized flights extensionsRead Nothing package $@@ -203,7 +227,7 @@ archiveOf tarball = memoized flights archivesRead Nothing (T.pack tarball) (readArchive tarball) moduleInArchive tarball modName = (moduleIn modName =<<) <$> archiveOf tarball- pure Resolver{askModule = reach Set.empty}+ pure Resolver{askModule = reach Set.empty . importable} -- | A module's interface, read once, with the primops' fixities standing -- in for that of @GHC.Prim@, which has no file.@@ -234,7 +258,7 @@ (either (const Nothing) Just . fromHiFile modName =<<) <$> given modName pure Resolver- { askModule = \modName ->+ { askModule = \_ modName -> memoized flights answersRead unreadable modName $ fromInterface interfaceOf modName }@@ -249,6 +273,9 @@ scopeFor :: -- | What can be asked about the modules it imports. Resolver ->+ -- | The canonical path of the module, where it is one of the project's+ -- own.+ Maybe FilePath -> -- | Whether @ImplicitPrelude@ is on, which the module's own pragmas -- and its package's @default-extensions@ decide between them. Choice "implicitPrelude" ->@@ -257,11 +284,12 @@ NonEmpty (HsModule GhcPs) -> -- | Everything that module can see, and what it could not find out. IO Scope-scopeFor resolver implicitPrelude configurations = do+scopeFor resolver importer implicitPrelude configurations = do let imports = moduleImports implicitPrelude configurations+ asked = askModule resolver importer answers <- inParallel- (\m -> (m,) <$> askModule resolver m)+ (\m -> (m,) <$> asked m) (fmap importModule imports) let table = Map.fromList answers pure $@@ -280,9 +308,10 @@ wkRoutes :: [Route], -- | Where to remember answers between runs. wkCache :: 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,+ -- | Where each module the file at the canonical path given, where it is+ -- one of the project's own, imports from a directory rather than an+ -- archive is. See 'localModules'.+ wkImportable :: Maybe FilePath -> Text -> Maybe 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.@@ -291,13 +320,23 @@ 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+ -- | How to reach another module, given where each module the one+ -- importing it imports from a directory is. Tied back on itself by -- 'newResolverWith', so that the memo it keeps covers the recursive -- calls too.- wkReach :: Set Text -> Text -> IO Established,- -- | What each configuration of a module says, given its text, worked- -- out once a run.- wkSummariesOf :: Text -> Text -> IO (Maybe (NonEmpty ModuleSummary)),+ wkReach ::+ Set Text ->+ (Text -> Maybe FilePath) ->+ Text ->+ IO Established,+ -- | What each configuration of a module says, given where it is if it+ -- is one of the project's own, its name and its text, worked out once a+ -- run.+ wkSummariesOf ::+ Maybe FilePath ->+ Text ->+ Text ->+ IO (Maybe (NonEmpty ModuleSummary)), -- | What a tarball holds for a module, each tarball read once a run. wkModuleInArchive :: FilePath -> Text -> IO (Maybe InArchive), -- | The modules @cabal@ writes itself, which are therefore in no@@ -313,8 +352,12 @@ resolveModule :: -- | Where to look, and how to get back to the resolver. Workings ->- -- | Modules currently being resolved further up the call chain.+ -- | Modules currently being resolved further up the call chain, this one+ -- among them, each by its path if it is one of the project's own and by+ -- its name otherwise. Set Text ->+ -- | Where the module is, if it is one of the project's own.+ Maybe FilePath -> -- | The module to resolve. Text -> IO Established@@ -322,7 +365,7 @@ Workings { wkRoutes, wkCache,- wkLocal,+ wkImportable, wkIndex, wkInterfaces, wkInterfaceOf,@@ -333,22 +376,23 @@ wkReexported } visiting+ found modName- | Just path <- Map.lookup modName wkLocal,+ | Just path <- found, writtenForHsc path = pure mempty- | Just path <- Map.lookup modName wkLocal =+ | Just path <- found = readUtf8File path >>= \case Nothing -> pure unreadable Just source ->- fromSummaries (wkReach visiting') modName- =<< wkSummariesOf modName (snd (byteOrderMark source))+ fromSummaries (wkReach visiting (wkImportable found)) modName+ =<< wkSummariesOf found modName (snd (byteOrderMark source)) | Just original <- Map.lookup modName wkReexported, Map.notMember modName wkInterfaces =- wkReach visiting' original+ wkReach visiting fromDependency original | otherwise = answered <$> firstAnswer (fmap taking wkRoutes) where- visiting' = Set.insert modName visiting+ fromDependency = wkImportable Nothing taking = \case FromInterface -> viaInterface@@ -377,8 +421,8 @@ throughCache package $ fromSource wkModuleInArchive- wkSummariesOf- (wkReach visiting')+ (wkSummariesOf Nothing)+ (wkReach visiting fromDependency) tarball modName @@ -568,9 +612,10 @@ -- | One answer from every configuration of a module that counts. ----- 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 leaves the name unsettled.+-- A module may declare a fixity in one configuration and a different one, or+-- none, which is infixl 9, in another. Which of them holds depends on how the+-- module is compiled, which is not ours to decide, so disagreement leaves+-- the name unsettled. -- Agreement across the ones that count is an answer, and a stronger one -- than the blanked text could give. --@@ -604,7 +649,17 @@ declared = Map.unionsWith (<>)- [Map.map pure (establishedFixities a) | a <- toList counted]+ [ Map.map pure (Map.union (establishedFixities a) (defaulted a))+ | a <- toList counted+ ]+ defaulted a =+ Map.fromSet+ (const defaultFixity)+ ( Set.filter+ (null . unsettledThrough a)+ (Set.intersection fixed (certainNames (establishedCertain a)))+ )+ fixed = foldMap (Map.keysSet . establishedFixities) counted sole (fixity :| rest) = if all (== fixity) rest then Just fixity else Nothing disagreed = inhabited (Map.keysSet (Map.filter (isNothing . sole) declared))@@ -618,26 +673,56 @@ (certainMembers b) } --- | 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 (nubOrd (concatMap directoryOf (bpPackages plan)))+-- | Where each module the file at the canonical path given, where it is one+-- of the project's own, imports from a directory rather than an archive is.+--+-- A module of the component with the source directory nearest above the+-- file comes before any library's, as GHC looks in a component's own+-- source directories before the packages it depends on. Components whose+-- directories are as near count together.+localModules :: BuildPlan -> IO (Maybe FilePath -> Text -> Maybe FilePath)+localModules plan = do+ components <-+ concat+ <$> traverse forPackage (nubOrd (concatMap directoryOf (bpPackages plan)))+ let libraries = Map.unions [modules | (Lib, _, modules) <- components]+ pure $ \importer ->+ let covering =+ [ (length rest, modules)+ | Just file <- [importer],+ (_, dirs, modules) <- components,+ Just rest <- fmap (`pathUnder` file) dirs+ ]+ holding =+ [modules | (n, modules) <- covering, all ((n <=) . fst) covering]+ in \modName ->+ asum (fmap (Map.lookup modName) holding)+ <|> Map.lookup modName libraries where directoryOf p = case ppSource p of LocalPackage dir -> [dir] CheckedOut dir -> [dir] _ -> []- forPackage dir = quietly Map.empty $ do+ forPackage dir = quietly [] $ do cabalFilesIn dir >>= \case- [] -> pure Map.empty+ [] -> pure [] (cabalFile : _) -> readPackageDescription cabalFile >>= \case- Left _ -> pure Map.empty+ Left _ -> pure [] Right described ->- Map.fromListWith (\_ first' -> first') . concat- <$> traverse (locate dir) (declaredModules described)- locate dir (m, unwritten) = do- found <- filterM doesFileExist [dir </> unwritten <> e | e <- moduleEndings]+ traverse (component dir) (packageComponents described)+ component dir (kind, _, branches) = do+ placed <- for (declaredModules branches) $ \(d, modules) -> do+ root <- canonicalizePath (dir </> d)+ (root,) . concat <$> traverse (locate root) modules+ pure+ ( kind,+ fmap fst placed,+ Map.fromListWith (\_ first' -> first') (concatMap snd placed)+ )+ locate root (m, unwritten) = do+ found <-+ filterM doesFileExist [root </> unwritten <> e | e <- moduleEndings] pure [(m, path) | path <- take 1 found] -- | What a module exports, out of what it declares and what its imports@@ -742,6 +827,11 @@ (certainMembersOf answers qualifier parent) (Map.lookup parent declared) )+ <> Set.fromList+ [ (InTerms, kid)+ | kid <- kids,+ Set.member (InTerms, kid) (summaryNames summary)+ ] ) ExportModule m -> (if Just m == summaryName summary || m == modName then own else mempty)
src/Tilia/Format.hs view
@@ -12,6 +12,7 @@ Session, sessionRoot, PlanSource (..),+ planSourceFor, newSession, Compiled (..), compiledSession,@@ -26,16 +27,19 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) import Data.Choice (Choice, fromBool, isTrue)+import Data.Either (fromRight) 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.Maybe (mapMaybe) import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T import Data.Version (Version, versionBranch) import GHC.Driver.Session (OnOff (..)) import GHC.LanguageExtensions.Type (Extension (ImplicitPrelude))+import System.Directory (canonicalizePath) import Tilia.Cabal.Package ( PackageProblem (..), PackageReader,@@ -52,7 +56,7 @@ versionMacros, ) import Tilia.Cabal.Project (ProjectRoot (..), findProjectRoot)-import Tilia.Cabal.Target (packageFilesOf)+import Tilia.Cabal.Target (Component, componentInPlan, packageFilesOf) import Tilia.Cpp ( CppError (..), correspondingBranches,@@ -106,7 +110,8 @@ NoPackage FilePath PackageProblem | -- | The file is not Haskell we can parse. NotParsed ParseError- | -- | The file carries @{-# LINE #-}@ or @{-# COLUMN #-}@ pragmas.+ | -- | The file carries @{-# LINE #-}@ or @{-# COLUMN #-}@ pragmas, or lines+ -- GHC's lexer reads past, such as @#line@ ones. PositionPragmas FilePath | -- | The file uses the preprocessor in a way we cannot handle. CppUnsupported FilePath CppError@@ -115,6 +120,8 @@ UnknownFixity FilePath [((Maybe Text, OpName), Unknown)] | -- | The file could not be read at all. Unreadable FilePath Text+ | -- | The file could not be written back once formatted.+ Unwritable FilePath Text | -- | Formatting the file changed its AST. NotEquivalent FilePath Text | -- | Formatting is not idempotent.@@ -138,11 +145,14 @@ PositionPragmas path -> "will not format " <> file path- <> ": it uses {-# LINE #-} or {-# COLUMN #-} pragmas, and no"- <> " reformatting can leave those true"- CppUnsupported path why ->- "will not format " <> file path <> ": " <> describeCppError why+ <> ": it uses {-# LINE #-} or {-# COLUMN #-} pragmas or #line, #pragma"+ <> " or #! lines, and no reformatting can leave those true"+ CppUnsupported path why -> case why of+ ConfigurationNotParsed{} ->+ "will not format " <> located (describeCppError why)+ _ -> "will not format " <> file path <> ": " <> describeCppError why Unreadable path why -> "cannot read " <> file path <> ": " <> why+ Unwritable path why -> "cannot write " <> file path <> ": " <> why NotEquivalent path why -> "formatting " <> file path <> " changed the program: " <> why NotIdempotent path why ->@@ -190,12 +200,14 @@ NotEquivalent{} -> 17 NotIdempotent{} -> 18 Threw{} -> 19+ Unwritable{} -> 20 CppUnsupported _ why -> case why of MalformedConditional{} -> 9 TooManyConfigurations -> 10 ConfigurationNotParsed{} -> 11 DirectiveInQuotedText{} -> 12 MacroInQuotedText{} -> 12+ BeforeLeadingComma{} -> 12 RuledOutBranch{} -> 13 AbortingAlternative{} -> 14 @@ -208,6 +220,7 @@ NotParsed{} -> False NoPackage{} -> False Unreadable{} -> False+ Unwritable{} -> False NotEquivalent{} -> False NotIdempotent{} -> False Threw{} -> False@@ -242,6 +255,13 @@ -- Cabal to solve it. GivenPlan FilePath +-- | Where a session's build plan comes from: the plan file given, if any,+-- or else Cabal, solving for the components the action finds.+planSourceFor :: Maybe FilePath -> IO [Component] -> IO PlanSource+planSourceFor givenPlan components = case givenPlan of+ Just plan -> pure (GivenPlan plan)+ Nothing -> PlanFromCabal . mapMaybe componentInPlan <$> components+ -- | Settle everything that does not depend on the file being formatted. newSession :: -- | The project.@@ -273,9 +293,9 @@ then [FromInterface, FromSource] <$ liftIO (fetchUninstalled caching root plan) else pure [FromInterface] pure (plan, routes)- packages <- liftIO (packageFilesOf project)+ packages <- liftIO (fromRight [] <$> packageFilesOf project) packageReader <- liftIO (newPackageReader (plannedCompiler plan) packages)- resolver <- liftIO (newResolverVia caching routes packageReader plan)+ resolver <- liftIO (newResolverVia caching routes packageReader root plan) notes <- if isTrue debugFixity then Just <$> liftIO (newIORef Map.empty)@@ -358,9 +378,8 @@ -- | 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)+ importer <- liftIO (canonicalizePath path) let resolver = sessionResolver session config = ParserConfig package extensionsAndCpp text =@@ -369,14 +388,20 @@ renderConfigFor extensions parsed = do let implicitPrelude = fromBool (Set.member ImplicitPrelude extensions)- scope <- liftIO (scopeFor resolver implicitPrelude (fmap pmModule parsed))+ scope <-+ liftIO $+ scopeFor+ resolver+ (Just importer)+ implicitPrelude+ (fmap pmModule parsed) liftIO $ case sessionFixityNotes session of Nothing -> pure () Just ref -> do told <- fixityNotes implicitPrelude- (askModule resolver)+ (askModule resolver (Just importer)) scope parsed atomicModifyIORef' ref (\m -> (Map.insertWith (\_ old -> old) path told m, ()))@@ -406,7 +431,9 @@ ( printDoc (renderModule render parsed), Just parsed )- let inForce@(_, cpp) = extensionsAndCpp source+ let inForce@(extensions, cpp) = extensionsAndCpp source+ when (movesPositions (Set.toList extensions) source) $+ throwE (PositionPragmas path) (formatted, tree) <- formatting inForce Nothing source printedTree <- if isTrue (sessionCheckAst session)
src/Tilia/Ignore.hs view
@@ -35,7 +35,7 @@ import Data.Text.Encoding qualified as T import System.Directory (canonicalizePath, doesFileExist) import System.FilePath (joinPath, (</>))-import Tilia.Utils (pathUnder, quietly)+import Tilia.Utils (byteOrderMark, pathUnder, quietly) -- | The patterns of one ignore file, in the order they are written. newtype IgnoreFile = IgnoreFile [Pattern]@@ -70,12 +70,15 @@ | -- | A bracket expression, whether it is negated, and what it holds. Bracket Bool [Char -> Bool] --- | Read an ignore file.+-- | Read an ignore file, past the byte order mark it may begin with, as Git+-- does. parseIgnoreFile :: Text -> IgnoreFile parseIgnoreFile = IgnoreFile . mapMaybe (parsePattern . T.unpack . withoutReturn) . T.lines+ . snd+ . byteOrderMark where withoutReturn = T.dropWhileEnd (== '\r')
src/Tilia/Palette.hs view
@@ -11,22 +11,22 @@ ) where -import Data.Maybe (isJust) import Data.Text (Text) import System.Environment (lookupEnv)-import System.IO (hIsTerminalDevice, stdout)+import System.IO (Handle, hIsTerminalDevice) -- | 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+-- | Color what goes to a handle when there is somebody there to see it,+-- unless a @NO_COLOR@ that is not empty says otherwise.+paletteFor :: Handle -> IO Palette+paletteFor h = do refused <- lookupEnv "NO_COLOR"- terminal <- hIsTerminalDevice stdout+ terminal <- hIsTerminalDevice h pure $- if terminal && not (isJust refused)+ if terminal && maybe True null refused then Colors else Plain
src/Tilia/Parser.hs view
@@ -218,7 +218,6 @@ GHC.ITlineComment _ _ -> True GHC.ITblockComment _ _ -> True GHC.ITdocComment _ _ -> True- GHC.ITdocOptions _ _ -> True _ -> False -- | Is this token a quasi-quotation?
src/Tilia/Pragma.hs view
@@ -11,7 +11,6 @@ lookupEdition, nameSwitch, flagSwitches,- optionFlags, pragmaFlags, languageNames, withoutSkippedComments,@@ -19,11 +18,12 @@ ) where -import Control.Monad ((<=<))-import Data.Char (isAlphaNum, isSpace)+import Control.Monad (guard, (<=<))+import Data.Char (isAlphaNum, isDigit, isLower, isSpace, isUpper)+import Data.List (unsnoc) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map-import Data.Maybe (mapMaybe, maybeToList)+import Data.Maybe (fromMaybe, mapMaybe, maybeToList) import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T@@ -34,12 +34,23 @@ import GHC.Types.SrcLoc (mkRealSrcLoc, unLoc) import Tilia.Utils (tshow) --- | Recognize @{-# LINE #-}@ and @{-# COLUMN #-}@ pragmas.-movesPositions :: Text -> Bool-movesPositions = any positional . pragmaBodies+-- | Recognize @{-# LINE #-}@ and @{-# COLUMN #-}@ pragmas in a module with+-- these extensions in force, and the lines GHC's lexer reads past at the+-- start of a line, but for the @#!@ lines a script begins with.+--+-- Those are the line markers cpp writes, such as @# 40 "M.hs"@, which move+-- positions as a @LINE@ pragma does, and @#pragma@ and @#!@ lines, which+-- leave nothing behind for formatting to print. With CPP on, @#line@ and+-- @#pragma@ lines are directives, which formatting keeps.+movesPositions :: [Extension] -> Text -> Bool+movesPositions extensions =+ or . scanPragmas positional (pastCode extensions) . T.cons '\n' . script where positional body = T.toUpper (T.takeWhile (/= ' ') body) `elem` ["LINE", "COLUMN"]+ script t+ | "#!" `T.isPrefixOf` t = script (T.drop 1 (T.dropWhile (/= '\n') t))+ | otherwise = t -- | What a component puts in force before the pragmas of a module: its -- @default-language@ and its @default-extensions@.@@ -206,16 +217,40 @@ byFlagName flags = Map.fromList [(T.pack (GHC.flagSpecName f), GHC.flagSpecFlag f) | f <- flags] --- | What every @{-# … #-}@ in a module has between its braces, each on one--- line.-pragmaBodies :: Text -> [Text]-pragmaBodies = scanPragmas past+-- | Carry on past the code of a module with these extensions in force, over+-- its strings, characters and quasi-quotations, up to a line that GHC's+-- lexer reads past and formatting would lose.+pastCode :: [Extension] -> (Text -> [Bool]) -> Text -> [Bool]+pastCode extensions = past where past go t = case T.uncons t of+ Just ('\n', after) | readPast after -> [True] Just ('"', after) -> go (skipString after) Just ('\'', after) -> go (skipCharacter after)- _ -> go (skipCode t)+ _+ | QuasiQuotes `elem` extensions,+ Just body <- quasiQuotation t ->+ go (T.drop 2 (snd (T.breakOn "|]" body)))+ | otherwise -> go (skipCode t) + withoutCpp = Cpp `notElem` extensions+ readPast l = case T.uncons l of+ Just ('#', rest) ->+ (withoutCpp && any (`T.isPrefixOf` rest) ["line", "pragma"])+ || "!" `T.isPrefixOf` rest+ || T.any isDigit (T.take 1 (fromMaybe rest (T.stripPrefix " " rest)))+ Just (' ', rest) -> "#!" `T.isPrefixOf` rest+ _ -> False++ quasiQuotation t = do+ (quoter, rest) <- T.span inQuoter <$> T.stripPrefix "[" t+ (modules, name) <- unsnoc (T.splitOn "." quoter)+ guard (all (begins isUpper) modules && begins varStart name)+ T.stripPrefix "|" rest+ inQuoter c = inName c || c == '.'+ begins p = maybe False (p . fst) . T.uncons+ varStart c = isLower c || c == '_'+ skipString = inString . T.dropWhile (\c -> c /= '"' && c /= '\\') inString t@@ -233,14 +268,15 @@ let (plain, rest) = T.break opens (T.drop 1 t) before = maybe (T.head t) snd (T.unsnoc plain) in if "'" `T.isPrefixOf` rest && inName before then skipCode rest else rest- opens c = c == '{' || c == '-' || c == '"' || c == '\''+ opens c =+ c == '{' || c == '-' || c == '"' || c == '\'' || c == '[' || c == '\n' inName c = isAlphaNum c || c == '_' || c == '\'' -- | What the @{-# … #-}@ of a module's header have between their braces, each -- on one line: those above the first thing that is neither a comment, a -- directive nor a pragma, which are all GHC reads. headerPragmaBodies :: Text -> [Text]-headerPragmaBodies = scanPragmas past+headerPragmaBodies = scanPragmas id past where past go t = case T.uncons t of Just (c, _)@@ -248,17 +284,18 @@ | c == '#' -> go (T.dropWhile (/= '\n') t) _ -> [] --- | The bodies of the pragmas of a module, each on one line, carrying on past--- what is neither a comment nor a pragma as the given function does.-scanPragmas :: ((Text -> [Text]) -> Text -> [Text]) -> Text -> [Text]-scanPragmas past = go+-- | What the given function makes of the bodies of the pragmas of a module,+-- each on one line, carrying on past what is neither a comment nor a pragma+-- as the other given function does.+scanPragmas :: (Text -> a) -> ((Text -> [a]) -> Text -> [a]) -> Text -> [a]+scanPragmas pragma past = go where go t | T.null t = [] | Just body <- T.stripPrefix "{-#" t = case T.breakOn "#-}" body of (_, after) | T.null after -> [] (inner, after) ->- T.unwords (T.words (withoutSkippedComments inner))+ pragma (T.unwords (T.words (withoutSkippedComments inner))) : go (T.drop 3 after) | Just after <- T.stripPrefix "{-" t = go (skipBlock (1 :: Int) after) | opensLineComment t = go (T.dropWhile (/= '\n') t)
src/Tilia/Process.hs view
@@ -3,6 +3,7 @@ -- | Running a program and reading its output. module Tilia.Process ( readProgramOutput,+ readProgramOutputIn, ) where @@ -15,6 +16,7 @@ import System.IO (Handle, hClose, hSetBinaryMode) import System.Process ( StdStream (CreatePipe),+ cwd, proc, std_err, std_in,@@ -31,7 +33,11 @@ -- -- Line endings come back as newlines however the program wrote them. readProgramOutput :: FilePath -> [String] -> IO (Maybe Text)-readProgramOutput program args = quietly Nothing $+readProgramOutput = readProgramOutputIn "."++-- | 'readProgramOutput', with the program run in the directory given.+readProgramOutputIn :: FilePath -> FilePath -> [String] -> IO (Maybe Text)+readProgramOutputIn dir program args = quietly Nothing $ withCreateProcess spec $ \toChild fromChild childErrors running -> do traverse_ hClose toChild waitForErrors <- forked (drain childErrors)@@ -43,7 +49,8 @@ where spec = (proc program args)- { std_in = CreatePipe,+ { cwd = Just dir,+ std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
src/Tilia/Render.hs view
@@ -92,7 +92,7 @@ (pmGathered parsed) (comments (pmSource parsed)) plain = heldOff haddocks loose'- (stackHeader, rest) = takeStackHeader (pmHeaderEnd parsed) plain+ (stackHeader, rest) = takeStackHeader (pmPrologue parsed) plain (pragmas, uncovered) = takeHeaderPragmas (pmSource parsed) (pmHeaderEnd parsed) rest held = heldOffModuleDoc hsMod haddocks pragmas uncovered opening = importsOpening (sourceLines (pmSource parsed)) held hsMod
src/Tilia/Render/Class.hs view
@@ -240,8 +240,7 @@ space <> indent ( fold resultSig- <> space- <> foldMap (at_ ctx (injectivityAnn ctx)) fdInjectivityAnn+ <> foldMap ((space <>) . at_ ctx (injectivityAnn ctx)) fdInjectivityAnn ) resultSig = familyResultSig ctx fdResultSig
src/Tilia/Render/Context.hs view
@@ -90,7 +90,7 @@ -- | The uses of an operator a local binding captures, by where the -- operator is written, with their fixities. ctxCaptured :: Map Span Fixity,- -- | The comments that take whole lines, by starting position.+ -- | The comments that end their line, by starting position. ctxLineComments :: Map (Int, Int) Comment, -- | The column of the trailing comment each comment that carries one on -- begins at, by where that comment begins.@@ -375,7 +375,7 @@ n >= spanEndLine s || maybe False from (quoteEndingFrom n (ctxSource ctx)) --- | Does a comment that takes whole lines begin inside this span?+-- | Does a comment that ends its line begin inside this span? holdsLineComment :: Ctx -> Span -> Bool holdsLineComment ctx s = case Map.lookupGE (startPoint s) (ctxLineComments ctx) of
src/Tilia/Render/Data.hs view
@@ -122,7 +122,10 @@ (fmap (at_ ctx (conDecl ctx (Isn't #singleRecCon))) cons) | otherwise -> layoutFrom ctx (spanOf tyCon <> spansOf cons) . indent $- beforeEquals <> txt "=" <> space <> alternatives+ beforeEquals+ <> txt "="+ <> space+ <> fenceWithin ctx (fmap endOf equalsSpan <> spansOf cons) alternatives where singleRecCon = case cons of [L _ ConDeclH98{con_args = RecCon{}}] -> True@@ -133,6 +136,8 @@ ConDeclGADT{..} -> spansOf (NE.toList con_names) ConDeclH98{..} -> spanOf con_name + equalsSpan = spanOf (andd_equal dd_ext)+ lineHaddocks = any (printsWholeLineDocs ctx . visibleDocs . unLoc) cons beforeEquals@@ -280,7 +285,7 @@ | otherwise = conDeclField ctx x <> case cdf_doc x of- Just d -> space <> haddock ctx Caret Closed d+ Just d -> space <> haddockInline ctx Caret d Nothing -> breakOrSpace rightDoc x = case cdf_doc x of Just d -> hardBreak <> haddock ctx Pipe Closed d
src/Tilia/Render/Declaration.hs view
@@ -56,19 +56,17 @@ -- | Render a declaration run while applying the requested 'Grouping'. 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)+ items+ NoBrace+ [ includeWhen gap breakOrSpace <> at_ ctx (hsDecl ctx style) d+ | (previous, current) <- zip (Nothing : fmap Just groups) groups,+ let gaps = any (`separate` current) previous : repeat False,+ (gap, d) <- zip gaps (NE.toList current)+ ] 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 = not (remarkUnder ctx ended began || underHeading) && case grouping of Disregard -> True@@ -83,8 +81,8 @@ isHeading (unLoc (NE.last previous)) && commentRightUnder ctx ended began - isDocumented = any (isDocNext . unLoc)- isDocNext = \case+ isDocumented = any (isDocComment . unLoc)+ isDocComment = \case DocD _ (DocCommentNext _) -> True DocD _ (DocCommentPrev _) -> True _ -> False@@ -154,7 +152,6 @@ | FamilyDeclaration | TypeSynonym | PragmaDeclaration- | DocumentsNext | DocumentsPrevious | Unremarkable deriving (Eq, Show)@@ -182,7 +179,6 @@ TyClD _ (SynDecl _ (L _ n) _ _ _) -> (TypeSynonym, [n]) TyClD _ (FamDecl _ (FamilyDecl _ _ _ (L _ n) _ _ _ _)) -> (FamilyDeclaration, [n]) KindSigD _ (StandaloneKindSig _ (L _ n) _) -> (KindSignature, [n])- DocD _ (DocCommentNext _) -> (DocumentsNext, []) DocD _ (DocCommentPrev _) -> (DocumentsPrevious, []) _ -> (Unremarkable, []) @@ -190,7 +186,6 @@ -- them? relatedDecls :: LHsDecl GhcPs -> LHsDecl GhcPs -> Bool relatedDecls a b = case (kindA, kindB) of- (DocumentsNext, _) -> True (_, DocumentsPrevious) -> True pair | pair `elem` relatedKinds -> shareAName namesA namesB _ -> False
src/Tilia/Render/Expression.hs view
@@ -17,6 +17,7 @@ import Control.Applicative ((<|>)) import Data.Choice (Choice, fromBool, isTrue, pattern Is, pattern Isn't)+import Data.Data (Data) import Data.Generics.Schemes (listify) import Data.List (unsnoc) import Data.List.NonEmpty (NonEmpty (..))@@ -85,6 +86,7 @@ NegApp _ e _ -> txt "-" <> includeWhen (isLiteral e) (negativeLiteralGap ctx)+ <> includeWhen (startsWithSymbol e) space <> hsExpr ctx e HsPar _ e -> layoutWithin ctx here (spanOf e) $@@ -156,11 +158,14 @@ HsProjection{..} -> parens (txt "." <> dotFields ctx proj_flds) ExprWithTySig _ x HsWC{hswc_body} -> align $- hsExpr ctx x- <> joinedBy "::"+ hsExprIn ctx (withBracing MayBrace plainSite) x+ <> ( if endsWithBlock (unLoc x)+ then breakOrSpace <> txt "::" <> space+ else joinedBy "::"+ ) <> indent (hsSigType ctx hswc_body) ArithSeq _ _ range -> arithSeq ctx here (closingFor site) range- HsTypedBracket (bracketAnn, _) e -> quoted here opener "||]" (hsExpr ctx e)+ HsTypedBracket (bracketAnn, _) e -> quoted here opener "||]" e (hsExpr ctx e) where opener = case bracketAnn of BracketNoE{} -> "[||"@@ -172,15 +177,21 @@ 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)+ <> attachBody+ (CmdTopBody ctx (withBracing (siteBracing site) plainSite) e)+ HsStatic _ e ->+ txt "static"+ <> breakOrSpace+ <> indent (hsExprIn ctx (withBracing (siteBracing site) plainSite) e) HsPragE _ prag x -> case prag of HsPragSCC _ n -> txt "{-# SCC " <> writtenString n <> txt " #-}" <> breakOrSpace- <> nest (if siteInBlock site then 1 else 0) (hsExpr ctx x)+ <> nest+ (if siteInBlock site then 1 else 0)+ (hsExprIn ctx (withBracing (siteBracing site) plainSite) x) HsEmbTy _ HsWC{hswc_body} -> txt "type" <> space <> hsType ctx hswc_body HsHole holeKind -> case holeKind of HoleVar n -> name ctx n@@ -213,20 +224,36 @@ HsOverLit{} -> True _ -> False +-- | Does this expression begin with a symbol character, which an operator+-- written right before it would take into its name?+startsWithSymbol :: LHsExpr GhcPs -> Bool+startsWithSymbol e = case unLoc e of+ HsIPVar{} -> True+ HsOverLabel{} -> True+ HsLam{} -> True+ HsUntypedSplice _ HsUntypedSpliceExpr{} -> True+ HsTypedSplice{} -> True+ HsApp _ f _ -> startsWithSymbol f+ HsAppType _ f _ -> startsWithSymbol f+ RecordUpd{rupd_expr} -> startsWithSymbol rupd_expr+ HsGetField{gf_expr} -> startsWithSymbol gf_expr+ _ -> False+ -- | A function applied to arguments. application :: Ctx -> Site -> LHsExpr GhcPs -> LHsExpr GhcPs -> Doc application ctx site f x = case placement of Normal -> mayBraceWhenFlat (siteBracing site) headAndInit- <> indent (breakOrSpace <> hsExpr ctx lastArg)+ <> indent (breakOrSpace <> lastArgDoc) Hanging -> layoutFrom ctx initSpan (headAndInit MayBrace)- <> attach Hanging (hsExpr ctx lastArg)+ <> attach Hanging lastArgDoc where (func, args) = gatherArgs f (x :| []) initArgs = NE.init args lastArg = NE.last args+ lastArgDoc = hsExprIn ctx (withBracing (siteBracing site) plainSite) lastArg initSpan = spanOf f <> (startOf <$> spanOf lastArg) placement | maybe False (writtenOnOneLine ctx) initSpan = exprHangs (unLoc lastArg)@@ -253,9 +280,9 @@ tuple :: Ctx -> Maybe Span -> ClosingIndent -> Boxity -> [HsTupArg GhcPs] -> Doc tuple ctx here closing boxity args | any isMissing args = flat (brackets' (sepBy comma (fmap arg args)))- | otherwise = brackets' (insideBrackets here (commaSep (fmap arg args)))+ | otherwise = brackets' (commaSep (fmap arg args)) where- brackets' = boxityBrackets boxity closing+ brackets' = boxityBrackets boxity closing . insideBrackets here isMissing = \case Missing _ -> True _ -> False@@ -460,7 +487,7 @@ (fmap endOf (spanOf p) <> spanOf f) (attach placement (printBody bound)) where- bound = mkBody plainSite f+ bound = bodyIn mkBody (siteBracing site) f placement | sameLine (spanOf p) (spanOf f) = bodyPlacement bound | otherwise = Normal@@ -695,7 +722,10 @@ 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 (fmap (at_ ctx implicitBind) xs))+ anchored ann . items bracing $+ keepBlanks+ (separatedByBlank ctx)+ [(spanOf x, at ctx x implicitBind) | x <- xs] EmptyLocalBinds _ -> mempty where implicitBind (IPBind _ (L _ n) e) =@@ -741,7 +771,8 @@ <> breakOrSpace <> indent ( txt (arrowText arrow rightToLeft)- <> attach (exprHangs (unLoc input)) (hsExpr ctx writtenSecond)+ <> attachBody+ (bodyIn (ExprBody ctx) (siteBracing site) writtenSecond) ) HsCmdArrForm _ form Prefix cmds -> bananaWith (closingFor site) $@@ -761,9 +792,9 @@ HsCmdApp _ cmd e -> hsCmd ctx site{siteApplicand = True} cmd <> breakOrSpace- <> indent (hsExpr ctx e)+ <> indent (hsExprIn ctx (withBracing (siteBracing site) plainSite) e) HsCmdLam _ variant' mg -> lambda ctx site variant' (CmdBody ctx) mg- HsCmdPar _ c -> parens (hsCmd ctx plainSite c)+ HsCmdPar _ c -> parensWith (closingFor site) (hsCmd ctx plainSite c) HsCmdCase anns e mg -> caseOf ctx site (CmdBody ctx) anns e mg HsCmdIf anns _ c t e -> ifThenElse ctx (bodyIn (CmdBody ctx) (siteBracing site)) anns c t e@@ -962,12 +993,16 @@ rendered = fmap (hsPat ctx) pats lambdaGap p = includeWhen (needsGap (unLoc p)) space- needsGap = \case+ needsGap p = case p of LazyPat{} -> True BangPat{} -> True SplicePat{} -> True InvisPat{} -> True+ NPat{} -> negative+ LitPat{} -> negative _ -> False+ where+ negative = T.isPrefixOf "-" (showGhc p) endOfPats = case pats of [] -> case style of@@ -1067,9 +1102,13 @@ _ -> maybe id located (spanOf lgrhs) . layoutFrom ctx (grhsSpan grhs) $ fenceWithin ctx headSpan guardHead- <> nest- (if parentPlacement == Normal then 1 else 0)- (attach placement (printBody bound))+ <> fenceWithin+ ctx+ (fmap endOf separatorSpan <> spanOf body)+ ( nest+ (if parentPlacement == Normal then 1 else 0)+ (attach placement (printBody bound))+ ) where GRHS EpAnn{anns = GrhsAnn{ga_vbar, ga_sep}} guards body = grhs guardHead =@@ -1176,48 +1215,51 @@ -- | A Template Haskell quotation. quotation :: Ctx -> Maybe Span -> HsQuote GhcPs -> Doc quotation ctx here = \case- ExpBr (bracketAnn, _) e -> quotedAs (flavour bracketAnn) (hsExpr ctx e)+ ExpBr (bracketAnn, _) e -> quotedAs (flavour bracketAnn) e (hsExpr ctx e) where flavour = \case BracketNoE{} -> "" BracketHasE{} -> "e"- PatBr _ p -> quotedAs "p" (hsPat ctx p)- DecBrL _ decls ->- quotedAs "d" (starGuard decls (knotDecls (ctxKnot ctx) ctx decls))+ PatBr _ p -> quotedAs "p" p (hsPat ctx p)+ DecBrL _ decls -> quotedAs "d" decls (knotDecls (ctxKnot ctx) ctx decls) DecBrG _ _ -> error "Tilia: DecBrG is produced by the renamer"- TypBr _ ty -> quotedAs "t" (starGuard ty (hsType ctx ty))+ TypBr _ ty -> quotedAs "t" ty (hsType ctx ty) VarBr _ isSingle n -> txt (if isSingle then "'" else "''") <> name ctx n where+ quotedAs :: (Data a) => Text -> a -> Doc -> Doc quotedAs flavour = quoted here ("[" <> flavour <> "|") "|]"- 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 --- | The body of a quotation between its brackets, indented where it breaks.+-- | The body of a quotation between its brackets, indented where it breaks,+-- and spaced from them where it may end with a symbol character. quoted ::+ (Data a) => -- | Where the quotation is written. Maybe Span -> -- | The opening bracket. Text -> -- | The closing bracket. Text ->+ -- | What is quoted.+ a -> -- | The body. Doc -> Doc-quoted here opener closer body =+quoted here opener closer x body = txt opener- <> breakOrNothing- <> indent (insideBrackets here body <> breakOrNothing <> txt closer)+ <> gap+ <> indent (insideBrackets here body <> gap <> txt closer)+ where+ gap = if risky then breakOrSpace else breakOrNothing+ risky =+ any isStar (listify (const True :: HsType GhcPs -> Bool) x)+ || any isAbstract (listify (const True :: FamilyInfo GhcPs -> Bool) x)+ || not (null (listify (const True :: FixitySig GhcPs -> Bool) x))+ isStar = \case+ HsStarTy{} -> True+ _ -> False+ isAbstract = \case+ ClosedTypeFamily Nothing -> True+ _ -> False -- | An item of a block: the last one keeps the block's bracing, and any -- other may brace itself when the block is flat.@@ -1288,6 +1330,19 @@ exprHangs (unLoc y) | otherwise -> exprHangs (unLoc x) _ -> Normal++-- | Does this expression end with a layout block, which takes in what is+-- printed after it on its last line?+endsWithBlock :: HsExpr GhcPs -> Bool+endsWithBlock = \case+ HsDo _ (DoExpr _) _ -> True+ HsDo _ (MDoExpr _) _ -> True+ HsCase{} -> True+ HsLam _ LamCase _ -> True+ HsLam _ LamCases _ -> True+ HsApp _ _ y -> endsWithBlock (unLoc y)+ OpApp _ _ _ y -> endsWithBlock (unLoc y)+ _ -> False -- | Does this command absorb the line break that introduces it? cmdHangs :: HsCmd GhcPs -> Placement
src/Tilia/Render/Haddock.hs view
@@ -19,15 +19,18 @@ import Data.Generics.Schemes (listify) import Data.List (dropWhileEnd) import Data.List.NonEmpty qualified as NE-import Data.Maybe (fromMaybe, mapMaybe)+import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Text (Text) import Data.Text qualified as T import GHC.Hs+import GHC.LanguageExtensions.Type (Extension (Cpp)) import GHC.Types.SrcLoc (GenLocated (..), getLoc, unLoc) import Tilia.Comments (Comment (..), afterOpener, bracketed, singleLine, triggerOn)+import Tilia.Comments.Attach (Margin (..), commentText) import Tilia.Doc.Combinators import Tilia.Gathered (Gathered (..)) import Tilia.Render.Context+import Tilia.Source (directiveOnLine) import Tilia.Span import Tilia.Span.Ghc @@ -75,9 +78,7 @@ docBody ctx style doc@(L l str) = case reusableText ctx style doc of Just c ->- ( maybe id located (spanOfSrcSpan l)- $ align- $ verbatimLines AtIndent TrimWhitespace (NE.toList (commentBody c)),+ ( maybe id located (spanOfSrcSpan l) (commentText margin c), selfClosing c ) Nothing@@ -85,6 +86,8 @@ | blockForm -> (writtenAt rebuiltBlock, False) | otherwise -> (writtenAt rebuilt, False) where+ margin = Margin directive (const False)+ directive t = extensionOn ctx Cpp && isJust (directiveOnLine t) writtenAt = fenceWithin ctx (spanOfSrcSpan l) emptyBlock = txt (blockOpener style) <> space <> txt "-}" rebuilt =@@ -94,10 +97,10 @@ Nothing -> 0 Just c -> length (takeWhile isBlankLine (reverse (NE.toList (commentBody c)))) isBlankLine t = T.null (T.strip (fromMaybe t (T.stripPrefix "--" (T.strip t))))- line' isFirst t =- (if isFirst then txt (opener style) else txt "--")- <> space- <> txt t+ line' isFirst t+ | isFirst = txt (opener style) <> space <> txt t+ | "$" `T.isPrefixOf` t = txt "--" <> txt t+ | otherwise = txt "--" <> space <> txt t rebuiltBlock = align $ txt (blockOpener style)@@ -221,7 +224,7 @@ [Text] docLines blockForm str | null body = []- | otherwise = fmap guardDollar (dedent (fmap unpad body))+ | otherwise = dedent (fmap unpad body) where body = dropWhileEnd T.null@@ -244,6 +247,3 @@ [] -> 0 ns -> minimum ns indentation = T.length . T.takeWhile (== ' ')- guardDollar t- | "$" `T.isPrefixOf` t = T.cons '\\' t- | otherwise = t
src/Tilia/Render/Header.hs view
@@ -32,6 +32,7 @@ import Tilia.Render.Declaration (decls) import Tilia.Render.Haddock import Tilia.Render.Layout+import Tilia.Render.Literal (writtenString) import Tilia.Render.Name import Tilia.Render.Pragma (warningTxt) import Tilia.Source (Source, directivePresentOnLine, sourceLines)@@ -118,20 +119,22 @@ "OPTIONS_HADDOCK" -> Just OptionsHaddockOrder _ -> Nothing --- | Take the Stack script header off the front of a comment stream.+-- | Take the Stack script header off the front of a comment stream: the+-- comment whose first word is @stack@ at the margin of the first line, or+-- of the line under the @#!@ line, which Stack reads its options from. takeStackHeader ::- -- | Where the header ends.- Maybe Span ->+ -- | The lines above the module that the parser never sees.+ [Text] -> -- | The comment stream. [Comment] -> (Doc, [Comment])-takeStackHeader headerEnd = \case+takeStackHeader prologue = \case (c : cs) | isStackHeader c -> (reproduce c <> blankLine, cs) cs -> (mempty, cs) where isStackHeader c =- writtenInHeader headerEnd (commentSpan c)- && T.isPrefixOf "stack" (T.stripStart (T.drop 2 (NE.head (commentBody c))))+ startPoint (commentSpan c) == (if null prologue then 1 else 2, 1)+ && take 1 (T.words (T.drop 2 (NE.head (commentBody c)))) == ["stack"] reproduce c = verbatimLines AtMargin TrimWhitespace (NE.toList (commentBody c)) @@ -161,7 +164,8 @@ key p = (hpRun p, orderOf p, hpBody p) orderOf p = pragmaOrder (hpName p) (hpBody p) dedupe = fmap NE.head . NE.groupBy repeated- repeated a b = hpName a == "LANGUAGE" && key a == key b+ repeated a b =+ hpName a == "LANGUAGE" && isNothing (hpWritten b) && key a == key b split p | hpName p == "LANGUAGE", isNothing (hpWritten p) =@@ -173,7 +177,10 @@ render p = located (hpSpan p) (written p) <> hardBreak written p = case hpWritten p of Nothing ->- txt "{-# " <> txt (hpName p) <> space <> txt (hpBody p) <> txt " #-}"+ txt "{-# "+ <> txt (hpName p)+ <> includeUnless (T.null (hpBody p)) (space <> txt (hpBody p))+ <> txt " #-}" Just ls -> verbatim (T.intercalate "\n" (NE.toList ls)) -- | Does this name a whole edition of the language rather than one@@ -320,7 +327,9 @@ let (before, after) = splitAt n' rendered in before <> [keywordAt ctx (spanOf dots) ".."] <> after IEModuleContents (warning, _) m ->- exportWarning warning <> at ctx m (moduleHeadName ctx) <> comma'+ exportWarning warning+ <> at ctx m (\n -> txt "module" <> space <> outputable n)+ <> 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@@ -395,7 +404,7 @@ isQualified = isImportDeclQualified ideclQualified packageQualifier = case ideclPkgQual of NoRawPkgQual -> mempty- RawPkgQual literal -> outputable literal+ RawPkgQual literal -> writtenString literal levelBefore = case ideclLevelSpec of LevelStylePre l -> declLevel l _ -> mempty@@ -411,7 +420,10 @@ in layoutWithin ctx listSpan parensSpan $ hidden <> breakOrSpace- <> parens (insideBrackets listSpan (importExportItems ctx xs))+ <> fenceWithin+ ctx+ parensSpan+ (parens (insideBrackets listSpan (importExportItems ctx xs))) -- | The keyword an import's level is written with. declLevel :: ImportDeclLevel -> Doc
src/Tilia/Render/Pattern.hs view
@@ -37,28 +37,28 @@ -- | A pattern whose outermost bracket closes where it is told to. hsPatClosing :: Ctx -> ClosingIndent -> LPat GhcPs -> Doc-hsPatClosing ctx = hsPatIn ctx (Isn't #inAsPat)+hsPatClosing ctx = hsPatIn ctx (Isn't #inParens) -- | A pattern that knows where it stands. hsPatIn :: -- | The context. Ctx ->- -- | Is this inside an as-pattern?- Choice "inAsPat" ->+ -- | Is this inside parentheses?+ Choice "inParens" -> -- | Where its outermost bracket closes. ClosingIndent -> -- | The pattern. LPat GhcPs -> Doc-hsPatIn ctx inAsPat closing l =- at ctx l (patBody ctx inAsPat closing (spanOf l))+hsPatIn ctx inParens closing l =+ at ctx l (patBody ctx inParens closing (spanOf l)) -- | Every shape a pattern can take. patBody :: -- | The context. Ctx ->- -- | Is this inside an as-pattern?- Choice "inAsPat" ->+ -- | Is this inside parentheses?+ Choice "inParens" -> -- | Where its outermost bracket closes. ClosingIndent -> -- | Where the pattern was written.@@ -66,13 +66,15 @@ -- | The pattern. Pat GhcPs -> Doc-patBody ctx inAsPat closing here = \case+patBody ctx inParens closing here = \case WildPat _ -> txt "_" VarPat _ n -> name ctx n LazyPat _ p -> txt "~" <> recur p- AsPat _ n p ->- name ctx n <> txt "@" <> hsPatIn ctx (Is #inAsPat) Indented p- ParPat _ p -> parensWith closing (insideBrackets here (recur p))+ AsPat _ n p -> name ctx n <> txt "@" <> recur p+ ParPat _ p ->+ parensWith+ closing+ (insideBrackets here (hsPatIn ctx (Is #inParens) Indented p)) BangPat _ p -> txt "!" <> recur p ListPat _ ps -> bracketsWith closing (insideBrackets here (commaSep (fmap recur ps)))@@ -82,9 +84,9 @@ closing (insideBrackets here (commaSep (fmap (align . recur) ps))) OrPat _ ps ->- itemsSepBy (fromBool (isTrue inAsPat)) NoBrace (fmap recur (NE.toList ps))+ itemsSepBy (fromBool (isTrue inParens)) NoBrace (fmap recur (NE.toList ps)) SumPat _ p tag arity -> unboxedSum closing tag arity (recur p)- ConPat _ con details -> conPattern ctx inAsPat here con details+ ConPat _ con details -> conPattern ctx inParens here con details ViewPat _ e p -> align $ knotExpr (ctxKnot ctx) ctx plainSite e@@ -105,14 +107,14 @@ EmbTyPat _ (HsTP _ ty) -> txt "type" <> space <> hsType ctx ty InvisPat _ (HsTP _ ty) -> txt "@" <> hsType ctx ty where- recur = hsPatIn ctx inAsPat Indented+ recur = hsPatIn ctx inParens Indented -- | A constructor pattern, in whichever of its three forms. conPattern :: -- | The context. Ctx ->- -- | Is this inside an as-pattern?- Choice "inAsPat" ->+ -- | Is this inside parentheses?+ Choice "inParens" -> -- | Where the pattern was written. Maybe Span -> -- | The constructor.@@ -120,7 +122,7 @@ -- | What it was applied to. HsConPatDetails GhcPs -> Doc-conPattern ctx inAsPat here con = \case+conPattern ctx inParens here con = \case PrefixCon args -> align $ name ctx con@@ -135,7 +137,7 @@ recur l <> attachOperator Normal (spanOf l) (spanOf con) (spanOf r) (name ctx con) (recur r) where- recur = hsPatIn ctx inAsPat Indented+ recur = hsPatIn ctx inParens Indented field = either wildcard (at_ ctx (patFieldBind ctx)) wildcard l = at ctx l (const (txt "..")) visibleFields dotdot fields = case dotdot of
src/Tilia/Render/Pragma.hs view
@@ -9,6 +9,7 @@ pragma, activation, inlineSpec,+ spelledAsWritten, overlapMode, warnDecls, warningTxt,@@ -18,6 +19,7 @@ import Data.Char (toUpper) import Data.List (isInfixOf) import Data.Text (Text)+import Data.Text qualified as T import GHC.Data.FastString (unpackFS) import GHC.Hs import GHC.Types.Basic hiding (overlapMode)@@ -26,7 +28,7 @@ import GHC.Unit.Module.Warnings import Tilia.Doc.Combinators import Tilia.Render.Context-import Tilia.Render.Literal (writtenString)+import Tilia.Render.Literal (stringLiteral, writtenString) import Tilia.Render.Name -- | Wrap a body in pragma braces.@@ -48,15 +50,23 @@ ActiveAfter _ n -> txt "[" <> outputable n <> txt "]" FinalActive -> error "Tilia: FinalActive is not expected in parsed source" --- | Which flavour of inlining was asked for.+-- | Which flavour of inlining was asked for, @INLINABLE@ spelled as written. inlineSpec :: InlineSpec -> Doc inlineSpec = \case Inline _ -> txt "INLINE"- Inlinable _ -> txt "INLINEABLE"+ Inlinable src -> txt (spelledAsWritten "INLINABLE" "INLINEABLE" src) NoInline _ -> txt "NOINLINE" Opaque _ -> txt "OPAQUE" NoUserInlinePrag -> mempty +-- | Whichever of two spellings of a pragma's name its source text uses, the+-- first where it has none.+spelledAsWritten :: Text -> Text -> SourceText -> Text+spelledAsWritten usual other = \case+ SourceText s+ | T.unpack other `isInfixOf` fmap toUpper (unpackFS s) -> other+ _ -> usual+ -- | The overlap pragma of an instance. overlapMode :: Ctx -> Maybe (LocatedP OverlapMode) -> Maybe Doc overlapMode ctx mode = do@@ -117,7 +127,9 @@ where said = fmap (fmap hsDocString) named (unLoc -> InWarningCategory{..}) =- txt ("in \"" <> showGhc (unLoc iwc_wc) <> "\"") <> space+ txt "in" <> space <> written iwc_st iwc_wc <> space+ written (SourceText s) _ = stringLiteral s+ written NoSourceText wc = txt ("\"" <> showGhc (unLoc wc) <> "\"") -- | One message is written bare; several go in a list. literalList :: [LocatedE StringLiteral] -> Doc
src/Tilia/Render/Signature.hs view
@@ -50,8 +50,10 @@ 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))+ SpecInstSig (_, src) sigType ->+ pragma+ (spelledAsWritten "SPECIALIZE" "SPECIALISE" src <> " instance")+ (indent (hsSigType ctx sigType)) MinimalSig _ formula -> at ctx formula (pragma "MINIMAL" . indent . booleanFormula ctx) CompleteMatchSig _ names ty -> completeSig ctx names ty@@ -134,7 +136,7 @@ ConLike -> txt "CONLIKE" FunLike -> mempty --- | A @SPECIALIZE@ pragma.+-- | A @SPECIALIZE@ pragma, spelled as written. specialiseSig :: Ctx -> Maybe (RuleBndrs GhcPs) ->@@ -144,7 +146,7 @@ Doc specialiseSig ctx binders target types InlinePragma{..} = pragmaBrackets $- txt "SPECIALIZE"+ txt (spelledAsWritten "SPECIALIZE" "SPECIALISE" inl_src) <> space <> inlineSpec inl_inline <> space
src/Tilia/Render/Type.hs view
@@ -33,20 +33,23 @@ import Data.Choice (Choice, fromBool, isTrue) import Data.List.NonEmpty (NonEmpty (..))+import Data.Set qualified as Set import Data.Text qualified as T import GHC.Hs-import GHC.Types.Name.Occurrence (isTvOcc)-import GHC.Types.Name.Reader (RdrName, rdrNameOcc)+import GHC.LanguageExtensions.Type (Extension (Cpp))+import GHC.Types.Name.Occurrence (isTvOcc, occNameString)+import GHC.Types.Name.Reader (RdrName, isUnqual, 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.Fixity (typeOperatorNamespace) import Tilia.Render.Context import Tilia.Render.Haddock import Tilia.Render.Literal (stringLiteral) import Tilia.Render.Name import Tilia.Render.Operator+import Tilia.Source (definedMacros, sourceLines) import Tilia.Span import Tilia.Span.Ghc @@ -97,7 +100,9 @@ <> space <> txt "->" <> betweenArgs- <> case unLoc y of+ <> fenceWithin ctx (fmap endOf (arrowSpan multAnn) <> spanOf y) result+ where+ result = case unLoc y of HsFunTy{} -> recur (unLoc y) _ -> at ctx y recur HsListTy _ t ->@@ -153,7 +158,7 @@ split t = case unLoc t of HsOpTy _ _ l o r -> Just (l, o, r) _ -> Nothing- fixity o = operatorFixity ctx InTypes (unLoc o)+ fixity o = operatorFixity ctx (typeOperatorNamespace (unLoc o)) (unLoc o) -- | Print a chain of type operators once precedence has regrouped it. renderChain :: Ctx -> OpChain (LHsType GhcPs) (LocatedN RdrName) -> Doc@@ -264,11 +269,21 @@ -- | A class context, as it appears before a @=>@. context :: Ctx -> LHsContext GhcPs -> Doc-context ctx = at_ ctx (contextOf loneVariable (hsType ctx) . fmap unbracket)+context ctx = at_ ctx (contextOf bare (hsType ctx) . fmap unbracket) where- loneVariable t = case unLoc t of- HsTyVar _ _ (L _ n) -> isTvOcc (rdrNameOcc n)+ bare t = case unLoc t of+ HsTyVar _ _ (L _ n) | isTvOcc (rdrNameOcc n) -> True+ _ -> headedByMacro t+ headedByMacro t = case unLoc t of+ HsTyVar _ _ (L _ n) -> macro n+ HsAppTy _ f _ -> headedByMacro f _ -> False+ macro n =+ extensionOn ctx Cpp+ && isUnqual n+ && Set.member+ (T.pack (occNameString (rdrNameOcc n)))+ (definedMacros (sourceLines (ctxSource ctx))) unbracket t = case unLoc t of HsParTy _ inner -> unbracket inner _ -> t@@ -280,16 +295,16 @@ -- | A context over anything that can stand as a constraint. contextOf ::- -- | Is this constraint nothing but a variable?+ -- | Can this constraint, when it is the only one, go without parentheses? (a -> Bool) -> -- | How to print one. (a -> Doc) -> -- | The constraints. [a] -> Doc-contextOf lone render = \case+contextOf bare render = \case [] -> txt "()"- [x] | lone x -> render x+ [x] | bare x -> render x xs -> parens (commaSep (fmap (align . render) xs)) -- | The flags a type variable binder may carry.@@ -363,6 +378,18 @@ close = case visibility of Invisible -> txt "." Visible -> space <> txt "->"++-- | Where the arrow of a function type is written.+arrowSpan :: HsMultAnnOf mult GhcPs -> Maybe Span+arrowSpan = \case+ HsUnannotated a -> arrow a+ HsLinearAnn (EpPct1 _ a) -> arrow a+ HsLinearAnn (EpLolly t) -> spanOf t+ HsExplicitMult (_, a) _ -> arrow a+ where+ arrow = \case+ EpArrow t -> spanOf t+ _ -> Nothing -- | The @forall@ that opens a type. forallTelescope :: Ctx -> HsForAllTelescope GhcPs -> Doc
src/Tilia/Run.hs view
@@ -26,7 +26,6 @@ where import Control.Exception (evaluate)-import Data.ByteString qualified as BS import Data.List (sortOn) import Data.Map.Strict qualified as Map import Data.Text (Text)@@ -34,7 +33,7 @@ import System.FilePath (takeExtension) import Tilia.Diff (diffInFull) import Tilia.Format- ( FormatError (Threw, Unreadable),+ ( FormatError (Threw, Unreadable, Unwritable), Session, describeFormatError, formatErrorExitCode,@@ -49,6 +48,7 @@ byteOrderMark, inParallel, indent,+ readBytes, tshow, wrappedUnder, writeUtf8File,@@ -136,7 +136,7 @@ -- | Read a source file as UTF-8. readAsUtf8 :: FilePath -> IO (Either Text Text) readAsUtf8 path =- attempted (BS.readFile path) >>= \case+ readBytes path >>= \case Left why -> pure (Left why) Right bytes -> pure (asUtf8 bytes) @@ -153,11 +153,14 @@ where after = setNewlineStyle (getNewlineStyle before) formatted --- | Put a formatted file back, and only if it changed.-writeBack :: (FilePath, Outcome) -> IO ()+-- | Put a formatted file back, and only if it changed, counting it as failed+-- where it cannot be written.+writeBack :: (FilePath, Outcome) -> IO (FilePath, Outcome) writeBack (path, outcome) = case outcome of- Changed _ after -> writeUtf8File path after- _ -> pure ()+ Changed _ after ->+ (path,) . either (Failed . Unwritable path) (const outcome)+ <$> attempted (writeUtf8File path after)+ _ -> pure (path, outcome) ---------------------------------------------------------------------------- -- Report@@ -172,30 +175,46 @@ deriving (Eq, Show) -- | The summary an @inplace@ run prints.-inplaceReport :: Palette -> [(FilePath, Outcome)] -> Report-inplaceReport palette outcomes =+inplaceReport ::+ -- | The palette of standard output.+ Palette ->+ -- | The palette of standard error.+ Palette ->+ -- | Every file of the run, and what became of it.+ [(FilePath, Outcome)] -> Report- { reportOut = T.unlines (tally palette ("✓", Good) "Formatted" (not . skipped) outcomes),- reportErr = asides palette outcomes+inplaceReport out err outcomes =+ Report+ { reportOut =+ T.unlines (tally out ("✓", Good) "Formatted" (not . skipped) outcomes),+ reportErr = asides err 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 =+checkReport ::+ -- | The palette of standard output.+ Palette ->+ -- | The palette of standard error.+ Palette ->+ -- | Every file of the run, and what became of it.+ [(FilePath, Outcome)] -> Report+checkReport out err outcomes =+ Report { reportOut = T.unlines- [ diffInFull palette path before after+ [ diffInFull out path before after | (path, Changed before after) <- outcomes ],- reportErr = asides palette outcomes+ reportErr = asides err outcomes } -- | The module a @for-editor@ run prints, formatted or as it was read where -- it was declined, and why it was not formatted. stdinReport ::+ -- | The palette of standard error. Palette -> -- | The module as it was read. Text ->
src/Tilia/Source.hs view
@@ -18,6 +18,7 @@ offsetOf, directivePresentOnLine, directiveOnLine,+ definedMacros, -- * Its comments comments,
src/Tilia/Source/Lines.hs view
@@ -17,6 +17,7 @@ contentColumn, directivePresentOnLine, directiveOnLine,+ definedMacros, conditionalKeywords, opensGroup, continuesGroup,@@ -30,8 +31,11 @@ import Data.IntSet (IntSet) import Data.IntSet qualified as IntSet import Data.Maybe (isJust)+import Data.Set (Set)+import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T+import Tilia.Cpp.Macros (isNameChar) -- | The text of a module as its author wrote it. --@@ -46,7 +50,10 @@ { -- | Every line of the module as written. lnWritten :: !(IntMap Text), -- | The ones this configuration does not contain.- lnDropped :: !IntSet+ lnDropped :: !IntSet,+ -- | The names the module defines with @#define@, in whichever+ -- configuration.+ lnMacros :: Set Text } -- | Read the lines of a module, every one of which it has.@@ -54,7 +61,13 @@ linesOf (Written text) = Lines { lnWritten = IntMap.fromList (zip [1 ..] (T.lines text)),- lnDropped = IntSet.empty+ lnDropped = IntSet.empty,+ lnMacros =+ Set.fromList+ [ T.takeWhile isNameChar (T.stripStart rest)+ | Just ("define", body) <- fmap directiveOnLine (T.lines text),+ Just rest <- [T.stripPrefix "define" body]+ ] } -- | Drop the given ranges from the 'Lines'.@@ -93,12 +106,11 @@ -- 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)+offsetOf line column = T.foldr walk (\i !_ -> i) line 0 1 where- walk i c- | c >= column = i- | i >= T.length line = i + (column - c)- | otherwise = walk (i + 1) (afterChar (T.index line i) c)+ walk ch next i c+ | c < column = next (i + 1) (afterChar ch c)+ | otherwise = i -- | The compiler's column for the character at this offset. columnOf :: Text -> Int -> Int@@ -119,9 +131,17 @@ directivePresentOnLine :: Int -> Lines -> Bool directivePresentOnLine n ls = isJust (directiveOnLine =<< lineAt n ls) +-- | The names the module defines with @#define@, in whichever configuration.+definedMacros :: Lines -> Set Text+definedMacros = lnMacros+ -- | The keyword a directive line opens with, and everything after its @#@.+--+-- The @#@ is the first character of the line: cpp, in the traditional mode+-- GHC runs it in, passes a line indented further on to GHC, which may read+-- an OverloadedLabels label there. directiveOnLine :: Text -> Maybe (Text, Text)-directiveOnLine l = case T.uncons (T.stripStart l) of+directiveOnLine l = case T.uncons l of Just ('#', rest) | keyword `elem` directiveKeywords -> Just (keyword, body) where
src/Tilia/Utils.hs view
@@ -5,6 +5,7 @@ module Tilia.Utils ( quietly, attempted,+ readBytes, readUtf8File, writeUtf8File, fieldWords,@@ -42,6 +43,7 @@ displayException, fromException, throwIO,+ try, ) import Control.Monad (replicateM, (>=>)) import Crypto.Hash.SHA256 qualified as SHA256@@ -57,6 +59,7 @@ import Data.Text.Encoding qualified as T import System.Directory (doesFileExist) import System.FilePath (equalFilePath, normalise, splitDirectories)+import System.IO.Error (ioeGetErrorString) -- | 'show' a value and take the result as 'Text'. tshow :: (Show a) => a -> Text@@ -75,6 +78,12 @@ if there then Just . T.decodeUtf8Lenient <$> BS.readFile path else pure Nothing++-- | Read a file's bytes, or say why they could not be read without naming+-- the file, which whoever reports it names already.+readBytes :: FilePath -> IO (Either Text BS.ByteString)+readBytes path =+ either (Left . T.pack . ioeGetErrorString) Right <$> try (BS.readFile path) -- | Write a file as UTF-8. writeUtf8File :: FilePath -> Text -> IO ()
tests/Tilia/Cabal/PackageSpec.hs view
@@ -18,20 +18,26 @@ ( PackageProblem (..), newPackageReader, parsePackageDescription,+ readPackageDescription, ) import Tilia.Cabal.Plan (BuildPlan (..), plannedCompiler) import Tilia.Pragma (Defaults, effectiveExtensions) import Tilia.TestUtils (withFiles)-import Tilia.Utils (writeUtf8File) spec :: Spec spec = do- describe "a .cabal file" $+ describe "a .cabal file" $ do it "parses whatever version of the format it declares, up to the newest" $ for_ ["2.4", "3.0", "3.4", "3.8", "3.12", "3.14", "3.16", "3.18"] $ \v -> let held = "cabal-version: " <> v <> "\nname: t\nversion: 0\nlibrary\n" in parsePackageDescription "t.cabal" held `shouldSatisfy` isRight + it "is said to be unreadable without being named again" $+ withSystemTempDirectory "tilia-gone" $ \root -> do+ let cabalFile = root </> "t.cabal"+ fmap (const ()) <$> readPackageDescription cabalFile+ `shouldReturn` Left (PackageUnreadable cabalFile "does not exist")+ describe "the component a file belongs to" $ do it "is the one whose source directory holds it" $ inPackage twoComponents ["src", "test"] $ \root -> do@@ -73,6 +79,13 @@ driver <- asked (root </> "tests" </> "Doctests.hs") (has BangPatterns unit, has BangPatterns driver) `shouldBe` (True, False) + it "is a foreign library where its source directory holds the file" $+ inPackage withForeignLibrary ["src", "flib"] $ \root -> do+ library <- asked (root </> "src" </> "M.hs")+ flib <- asked (root </> "flib" </> "F.hs")+ (has OverloadedStrings library, has OverloadedStrings flib)+ `shouldBe` (False, True)+ it "inherits settings in conditional source directories" $ inPackage conditionalLibrary ["src", "new"] $ \root -> (has BangPatterns <$> asked (root </> "new" </> "M.hs"))@@ -241,6 +254,27 @@ " default-extensions: OverloadedStrings" ] +-- | A library, and a foreign library with settings of its own.+withForeignLibrary :: Text+withForeignLibrary =+ T.unlines+ [ "cabal-version: 2.4",+ "name: demo",+ "version: 0",+ "",+ "library",+ " exposed-modules: M",+ " hs-source-dirs: src",+ " default-language: Haskell2010",+ "",+ "foreign-library demo",+ " type: native-shared",+ " other-modules: F",+ " hs-source-dirs: flib",+ " default-language: Haskell2010",+ " default-extensions: OverloadedStrings"+ ]+ -- | A library that names no @hs-source-dirs@, so its modules sit beside the -- @.cabal@ file. besideTheCabalFile :: Text@@ -425,8 +459,7 @@ -- | 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- writeUtf8File (root </> "demo.cabal") contents+ withFiles [("demo.cabal", contents)] $ \root -> do mapM_ (createDirectoryIfMissing True . (root </>)) (sort dirs) use root
tests/Tilia/Cabal/TargetSpec.hs view
@@ -7,7 +7,7 @@ import Data.List (isSuffixOf, sort) import Data.Text (Text) import Data.Text qualified as T-import System.FilePath (takeFileName, (</>))+import System.FilePath (isPathSeparator, takeFileName, (</>)) import Test.Hspec import Tilia.Cabal.Plan (PlanComponent (..)) import Tilia.Cabal.Project (Marker (..), ProjectRoot (..), findProjectRoot)@@ -26,12 +26,19 @@ it "takes each kind of component" $ do parseTarget "lib:tilia" `shouldBe` Right (Qualified Nothing Lib "tilia")+ parseTarget "flib:tilia" `shouldBe` Right (Qualified Nothing FLib "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" $+ it "takes every spelling of a kind cabal takes, in any case" $ do+ parseTarget "library:tilia" `shouldBe` Right (Qualified Nothing Lib "tilia")+ parseTarget "foreign-library:tilia" `shouldBe` Right (Qualified Nothing FLib "tilia")+ parseTarget "executable:tilia" `shouldBe` Right (Qualified Nothing Exe "tilia")+ parseTarget "tst:tests" `shouldBe` Right (Qualified Nothing Test "tests")+ parseTarget "test-suite:tests" `shouldBe` Right (Qualified Nothing Test "tests") parseTarget "benchmark:speed" `shouldBe` Right (Qualified Nothing Bench "speed")+ parseTarget "LIB:tilia" `shouldBe` Right (Qualified Nothing Lib "tilia") it "takes a package in front of the kind" $ parseTarget "tilia:lib:tilia" `shouldBe` Right (Qualified (Just "tilia") Lib "tilia")@@ -43,13 +50,13 @@ parseTarget "" `shouldSatisfy` failed it "refuses a kind it does not know" $- parseTarget "flib:thing" `shouldSatisfy` failed+ parseTarget "doc: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+ case parseTarget "doc:thing" of Left why -> why `shouldSatisfy` T.isInfixOf "lib:" Right _ -> expectationFailure "should not have parsed" @@ -143,15 +150,16 @@ files <- filesOfComponents project cs fmap takeFileName files `shouldBe` ["L.hs"] - it "reads a package an absolute entry names"+ it "reads a package an absolute entry names with forward slashes" $ withProject [ ("proj/cabal.project", ""), ("lib/lib.cabal", package "lib" "src") ] $ \root -> do+ let entry = T.map forward (T.pack (prPath root </> "lib")) writeUtf8File (prPath root </> "proj" </> "cabal.project")- ("packages: " <> T.pack (prPath root </> "lib") <> "\n")+ ("packages: " <> entry <> "\n") componentsOfTarget (ProjectRoot (prPath root </> "proj") ProjectFile) Everything >>= \case Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))@@ -178,6 +186,32 @@ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) Right cs -> sort (fmap componentPackage cs) `shouldBe` ["one", "two"] + it "expands a component with more than one star in it"+ $ withProject+ [ ("cabal.project", "packages: pkgs/*-*\n"),+ ("pkgs/one-a/one.cabal", package "one" "src"),+ ("pkgs/two-b/two.cabal", package "two" "src"),+ ("pkgs/three/three.cabal", package "three" "src")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> sort (fmap componentPackage cs) `shouldBe` ["one", "two"]++ it "expands a double star to any depth, none included"+ $ withProject+ [ ("cabal.project", "packages: pkgs/**/*.cabal\n"),+ ("pkgs/one.cabal", package "one" "src"),+ ("pkgs/a/two.cabal", package "two" "src"),+ ("pkgs/a/b/three.cabal", package "three" "src"),+ ("other/four.cabal", package "four" "src")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs ->+ sort (fmap componentPackage cs) `shouldBe` ["one", "three", "two"]+ it "passes over a package a comment has taken out" $ withProject [ ("cabal.project", "packages:\n one\n -- two\n"),@@ -221,6 +255,32 @@ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) Right cs -> fmap componentPackage cs `shouldBe` ["one"] + it "reads the packages the files it imports name, as cabal does"+ $ withProject+ [ ("cabal.project", "packages: one\nimport: config/more.config\n"),+ ("config/more.config", "packages: two\nimport: last.config\n"),+ ("config/last.config", "packages: three\n"),+ ("one/one.cabal", package "one" "src"),+ ("two/two.cabal", package "two" "src"),+ ("three/three.cabal", package "three" "src")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs ->+ sort (fmap componentPackage cs) `shouldBe` ["one", "three", "two"]++ it "reads a file imported in a cycle once"+ $ withProject+ [ ("cabal.project", "packages: one\nimport: more.config\n"),+ ("more.config", "import: ./cabal.project\n"),+ ("one/one.cabal", package "one" "src")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> fmap componentPackage cs `shouldBe` ["one"]+ it "looks in every source directory a component names" $ withProject [ ("only.cabal", packageWith "only" ["src", "gen"] ["A", "B"]),@@ -445,6 +505,20 @@ filesFor (Called "only") `shouldReturn` ["Setup.hs", "A.hs"] filesFor (Qualified Nothing Lib "only") `shouldReturn` ["A.hs"] + it "finds the modules of a foreign library, and names it as a plan does"+ $ withProject+ [ ("only.cabal", withForeignLibrary),+ ("src/A.hs", "module A where\n"),+ ("flib/F.hs", "module F where\n")+ ]+ $ \root ->+ componentsOfTarget root (Qualified Nothing FLib "foreign") >>= \case+ Left problem -> expectationFailure (T.unpack (describeTargetProblem problem))+ Right cs -> do+ files <- filesOfComponents root cs+ fmap takeFileName files `shouldBe` ["F.hs"]+ fmap (fmap pcName . componentInPlan) cs `shouldBe` [Just "flib:foreign"]+ it "names each library the way a plan does" $ withProject [("both.cabal", withSubLibrary)] $ \root -> componentsOfTarget root Everything >>= \case@@ -469,6 +543,28 @@ Right cs -> expectationFailure ("found " <> show (length cs) <> " components") Left problem -> describeTargetProblem problem `shouldSatisfy` T.isInfixOf "no packages" + it "says what the parser said of a cabal.project that will not parse" $+ withProject [("cabal.project", "packages: one\nfoo bar: baz\n")] $ \root ->+ componentsOfTarget root Everything >>= \case+ Right cs -> expectationFailure ("found " <> show (length cs) <> " components")+ Left problem -> do+ let said = describeTargetProblem problem+ said `shouldSatisfy` T.isInfixOf "cabal.project does not parse:"+ said `shouldSatisfy` T.isInfixOf "line 2, column 5"++ it "says so when a file it imports will not parse"+ $ withProject+ [ ("cabal.project", "packages: one\nimport: more.config\n"),+ ("more.config", "foo bar: baz\n"),+ ("one/one.cabal", package "one" "src")+ ]+ $ \root ->+ componentsOfTarget root Everything >>= \case+ Right cs -> expectationFailure ("found " <> show (length cs) <> " components")+ Left problem ->+ describeTargetProblem problem+ `shouldSatisfy` T.isInfixOf "more.config does not parse:"+ it "includes optional packages that exist, ignoring absent ones" $ withProject [ ("cabal.project", "packages: main\noptional-packages: optional absent\n"),@@ -493,6 +589,10 @@ ---------------------------------------------------------------------------- -- Helpers +-- | Turn a path separator into a forward slash, which every system takes.+forward :: Char -> Char+forward c = if isPathSeparator c then '/' else c+ failed :: Either Text Target -> Bool failed = \case Left _ -> True@@ -572,6 +672,26 @@ "", "library inner", " hs-source-dirs: inner",+ " default-language: Haskell2010"+ ]++-- | A package with a library and a foreign library.+withForeignLibrary :: Text+withForeignLibrary =+ T.unlines+ [ "cabal-version: 2.4",+ "name: only",+ "version: 0.1.0.0",+ "",+ "library",+ " hs-source-dirs: src",+ " exposed-modules: A",+ " default-language: Haskell2010",+ "",+ "foreign-library foreign",+ " type: native-shared",+ " hs-source-dirs: flib",+ " other-modules: F", " default-language: Haskell2010" ]
tests/Tilia/Comments/PlaceSpec.hs view
@@ -134,10 +134,10 @@ ("{- c -}", Just (After SpillAtIndentation, fName)) ] - it "goes its own way where that comment goes before what follows" $- placedIn [xOnLineTwo] [] "{- a -} -- b\nx = 1\n"- `shouldBe` [ ("{- a -}", Just (Before, xOnLineTwo)),- ("-- b", Just (Before, xOnLineTwo))+ it "goes before what follows where that comment does" $+ placedIn [foo, oneOnLineTwo] [mkSpan (1, 6) (2, 4)] "foo = {- a -} -- b\n 1\n"+ `shouldBe` [ ("{- a -}", Just (Before, oneOnLineTwo)),+ ("-- b", Just (Before, oneOnLineTwo)) ] describe "a comment with nothing written against it" $ do@@ -244,9 +244,9 @@ fBody = mkSpan (1, 21) (1, 22) fBodyPastThree = mkSpan (1, 29) (1, 30) --- | The @x@ on the second line.-xOnLineTwo :: Span-xOnLineTwo = mkSpan (2, 1) (2, 2)+-- | The @1@ on the second line of @foo = {- a -} -- b@.+oneOnLineTwo :: Span+oneOnLineTwo = mkSpan (2, 3) (2, 4) ---------------------------------------------------------------------------- -- The snippets that take more than one line
tests/Tilia/Corpus.hs view
@@ -126,10 +126,13 @@ expectUnreadable = [], expectDeclined = [ "other" </> "position-pragmas.hs",+ "other" </> "line-markers.hs", "other" </> "cpp" </> "unbalanced.hs", "other" </> "cpp" </> "define-in-a-quasiquote.hs", "other" </> "cpp" </> "macro-standing-for-a-bracket.hs",- "other" </> "cpp" </> "branch-opening-a-bracket-it-does-not-close.hs"+ "other" </> "cpp" </> "macro-before-a-leading-comma.hs",+ "other" </> "cpp" </> "branch-opening-a-bracket-it-does-not-close.hs",+ "other" </> "cpp" </> "line-marker-passed-on-by-cpp.hs" ] }, corpusInPackages = False@@ -196,6 +199,7 @@ ghcDeclined = [ "driver" </> "T17786.hs", "ghci.debugger" </> "HappyTest.hs",+ "overloadedrecflds" </> "should_run" </> "overloadedlabelsrun04.hs", "parser" </> "should_compile" </> "ColumnPragma.hs", "parser" </> "should_compile" </> "T7118.hs", "perf" </> "compiler" </> "T20261.hs",@@ -394,7 +398,8 @@ "other" </> "cpp" </> "separation-2a.hs", "other" </> "cpp" </> "separation-2b.hs", "other" </> "cpp" </> "shifted.hs",- "other" </> "cpp" </> "simple-import.hs"+ "other" </> "cpp" </> "simple-import.hs",+ "declaration" </> "signature" </> "specialize" </> "specialize-2.hs" ] <> ormoluRecordBraces
tests/Tilia/CorpusSpec.hs view
@@ -16,6 +16,7 @@ import Data.Text.Encoding (decodeUtf8') import System.Directory (createDirectoryIfMissing) import System.FilePath (replaceExtension, (</>))+import System.IO (stdout) import System.IO.Temp (withSystemTempDirectory) import Test.Hspec hiding (Example, after, before, example) import Tilia.Corpus@@ -69,7 +70,7 @@ it "is available" . expectationFailure $ "corpus not on this machine and could not be fetched: " <> T.unpack problem Right examples -> do- palette <- runIO paletteFor+ palette <- runIO (paletteFor stdout) case corpusExpectations corpus of Listed lists -> againstLists lists (check palette) examples -- Plain, so that what a record says does not depend on whether the@@ -273,7 +274,9 @@ 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"+ "this "+ <> what+ <> ", and the corpus does not list it under expectUnreadable" check :: Palette -> Example -> IO Result check palette example = do@@ -322,7 +325,7 @@ -- more input or output. checkPure :: Palette -> FilePath -> Maybe Defaults -> Text -> Maybe Text -> Result checkPure palette path package source expected- | movesPositions source =+ | movesPositions inForce 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
tests/Tilia/CppSpec.hs view
@@ -280,21 +280,32 @@ formatCpp includeInQuasiquote `shouldBe` Left "the #include at line 7 is inside a quasi-quote or a multi-line string" + it "refuses an #include before a leading comma" $+ formatCpp includeBeforeLeadingComma+ `shouldBe` Left "#include \"colors.h\" at line 5 comes before a leading comma, which formatting moves above it"+ it "refuses an alternative aborting with #error that it cannot format" $ formatCpp abortingAlternative `shouldBe` Left "the alternative that the #error at line 7 aborts cannot be formatted without parsing it" + it "names the line of an #error that settling a conditional leaves unguarded" $+ formatCpp abortingWhereSettled+ `shouldBe` Left "the alternative that the #error at line 10 aborts cannot be formatted without parsing it"+ it "refuses a branch that a conditional around it asking the same question rules out" $ formatCpp ruledOut `shouldBe` Left "the branch at line 6 is ruled out by a conditional around it that asks the same question" describe "telling a directive line from code" $ do it "reads the keyword and everything after the hash" $- directiveOnLine " # if FOO" `shouldBe` Just ("if", "if FOO")+ directiveOnLine "# if FOO" `shouldBe` Just ("if", "if FOO") it "does not take a label at the start of a line for a directive" $ directiveOnLine " #field" `shouldBe` Nothing + it "does not take an indented line for one, as cpp does not" $+ directiveOnLine " #if FOO" `shouldBe` Nothing+ ---------------------------------------------------------------------------- -- The modules the question is asked of @@ -646,6 +657,20 @@ "|]" ] +-- | An @#include@ standing for items of a list, written above the comma+-- that separates them from the next.+includeBeforeLeadingComma :: Text+includeBeforeLeadingComma =+ T.unlines+ [ "module M where",+ "",+ "colors =",+ " [ \"red\"",+ "#include \"colors.h\"",+ " , \"blue\"",+ " ]"+ ]+ -- | An alternative that aborts with @#error@ and leaves an expression -- unfinished, in a module whose conditionals cannot be varied one at a -- time.@@ -663,6 +688,25 @@ " + 2", "#if A", "g = 1",+ "#endif"+ ]++-- | An alternative that aborts with @#error@ once what it answers settles+-- the conditional around the @#error@, which another alternative leaves+-- open.+abortingWhereSettled :: Text+abortingWhereSettled =+ T.unlines+ [ "module M where",+ "",+ "f =",+ "#ifdef A",+ " 1 +",+ "#else",+ " 2",+ "#endif",+ "#if defined(A) || defined(B)",+ "#error \"b\"", "#endif" ]
tests/Tilia/DiffSpec.hs view
@@ -55,6 +55,35 @@ " h" ] + it "ends a hunk at the last line, with nothing after it" $+ diff Plain ("x", "y") "a\nb\n" "a\nB\n"+ `shouldBe` T.intercalate+ "\n"+ ["--- x", "+++ y", "@@ -1,2 +1,2 @@", " a", "-b", "+B"]++ it "marks a last line that no newline ends" $+ diff Plain ("x", "y") "a\nb" "a\nb\n"+ `shouldBe` T.intercalate+ "\n"+ [ "--- x",+ "+++ y",+ "@@ -1,2 +1,2 @@",+ " a",+ "-b",+ "\\ No newline at end of file",+ "+b"+ ]++ it "keeps the carriage returns the lines end in" $+ diff Plain ("x", "y") "a\r\nb\nc\r\n" "a\r\nb\r\nc\r\n"+ `shouldBe` T.intercalate+ "\n"+ ["--- x", "+++ y", "@@ -1,3 +1,3 @@", " a\r", "-b", "+b\r", " c\r"]++ it "starts a side with no lines at 0, as git does" $+ diff Plain ("x", "y") "\n\n" ""+ `shouldBe` T.intercalate "\n" ["--- x", "+++ y", "@@ -1,2 +0,0 @@", "-", "-"]+ it "keeps changes far apart in hunks of their own" $ length (filter (T.isPrefixOf "@@") (T.lines (diff Plain ("x", "y") far (T.replace "k" "K" (T.replace "b" "B" far))))) `shouldBe` 2
tests/Tilia/EquivalenceSpec.hs view
@@ -121,10 +121,22 @@ Nothing -> expectationFailure "let the pragma through" Just why -> why `shouldSatisfy` T.isInfixOf "invented the pragma" + it "notices a pragma holding a comment that went missing" $+ differsBecause+ "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE LambdaCase -- for f\n #-}\nmodule M where\n"+ "{-# LANGUAGE LambdaCase #-}\nmodule M where\n"+ "-- for f"+ 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 "notices comments inside the export list coming out in another order" $+ differsBecause+ "module M\n ( a, {- e -} -- f\n b,\n )\nwhere\n"+ "module M\n ( a, -- f\n {- e -} b,\n )\nwhere\n"+ "`{- e -}` became `-- f`"+ 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"@@ -136,6 +148,14 @@ it "notices a comment carried on under the last import going missing" $ "module M where\nimport Data.Maybe\nimport Data.Char () -- not needed, just\n -- re-exported\n" `losesTheCommentsOf` "module M where\n\nimport Data.Char () -- not needed, just\nimport Data.Maybe\n"++ it "does not mind a comment under the last import going with the code after it" $+ "module M where\nimport Data.List -- a remark\n-- about f\nf = 1\n"+ `keepsTheCommentsOf` "module M where\n\nimport Data.List -- a remark\n\n-- about f\nf = 1\n"++ it "does not mind a comment under the module line going with the code after it" $+ "module M (f) where -- a remark\n-- about f\nf = 1\n"+ `keepsTheCommentsOf` "module M (f) where -- a remark\n\n-- about f\nf = 1\n" describe "what the header puts in force" $ do it "does not mind language pragmas sorted where that changes nothing" $
tests/Tilia/Fixity/CabalSpec.hs view
@@ -7,6 +7,7 @@ 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 qualified as BS import Data.ByteString.Lazy qualified as BL import Data.Text (Text) import Data.Text qualified as T@@ -19,10 +20,12 @@ import Tilia.Cabal.Package ( declaredModules, describePackageProblem,+ packageBranches, packageExtensions, packageSourceDirs, parsePackageDescription, )+import Tilia.Fixity.Archive (Archive (..), InArchive (..), moduleIn) import Tilia.Fixity.Cabal import Tilia.Pragma (effectiveExtensions) @@ -186,6 +189,29 @@ it "offers it when nothing names anything" $ sourceDirs "library\n build-depends: base\n" `shouldBe` ["."] + describe "a module's file in an archive" $ do+ it "is found under a source directory" $+ textOf "src" "Foo.Parser" [("t-0/src/Foo/Parser.hs", "found")]+ `shouldBe` Just "found"++ it "is found in the package directory" $+ textOf "." "Parser" [("t-0/Parser.hs", "found")]+ `shouldBe` Just "found"++ it "is found under a source directory however it is spelled" $+ fmap+ (\dir -> textOf dir "Parser" [("t-0/src/Parser.hs", "found")])+ ["src/", "./src"]+ `shouldBe` [Just "found", Just "found"]++ it "is not a file of that name below a source directory" $+ textOf "src" "Parser" [("t-0/src/Foo/Parser.hs", "module Foo.Parser")]+ `shouldBe` Nothing++ it "is not a file under a directory of that name further down" $+ textOf "src" "Parser" [("t-0/vendor/src/Parser.hs", "vendored")]+ `shouldBe` Nothing+ describe "what the package puts in force" $ do it "reads an extension the .cabal turns on" $ extensions "library\n default-extensions: LambdaCase\n"@@ -283,6 +309,17 @@ extensions :: Text -> [Extension] extensions = (`effectiveExtensions` "") . packageExtensions . described +-- | The text an archive of these files gives for a module, where its+-- @.cabal@ file names this source directory.+textOf :: FilePath -> Text -> [(FilePath, BS.ByteString)] -> Maybe Text+textOf dir modName files =+ case moduleIn modName (Archive (Just cabal) files) of+ Just (Haskell text) -> Just text+ _ -> Nothing+ where+ cabal =+ described ("library\n hs-source-dirs: " <> T.pack dir <> "\n")+ -- | What a @.cabal@ file holding the fields given describes. described :: Text -> GenericPackageDescription described fields =@@ -295,7 +332,7 @@ -- | The names of the modules a package declares. modulesOf :: GenericPackageDescription -> [Text]-modulesOf = fmap fst . declaredModules+modulesOf = fmap fst . concatMap snd . declaredModules . packageBranches -- | A tar entry at the given path, holding the given text. entryFor :: FilePath -> Text -> Tar.Entry
tests/Tilia/Fixity/CacheSpec.hs view
@@ -5,11 +5,14 @@ -- | The on-disk cache of what was read out of a package. module Tilia.Fixity.CacheSpec (spec) where +import Control.Monad (replicateM, replicateM_) import Data.Choice (pattern Do, pattern Don't)+import Data.Foldable (traverse_) 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 System.Directory (getModificationTime, listDirectory, setModificationTime) import System.FilePath ((</>)) import System.IO.Temp (withSystemTempDirectory)@@ -18,6 +21,7 @@ import Tilia.Fixity.Cache import Tilia.Fixity.PackageDb (Installed (..), InstalledPackage (..)) import Tilia.TestUtils (underAsciiLocale, withEnvironment)+import Tilia.Utils (inParallel) spec :: Spec spec = do@@ -25,7 +29,7 @@ database describe "a cache not to be used" $ it "remembers nothing, and nothing is made on disk for it" $- withIsolatedDirectory $ \dir -> do+ withSystemTempDirectory "tilia-cache" $ \dir -> do cache <- withEnvironment [("XDG_CACHE_HOME", dir)] $ openCache (Don't #useCache) (PlanToken "plan")@@ -146,6 +150,23 @@ cachedEstablished cache "thing-1.0" "M" `shouldReturn` Just (declaring [((InTerms, OpName "!"), Fixity RightAssoc 3)]) + it "gives back no half of an answer two writers store at once" $ \cache -> do+ let answers =+ [ declaring+ [ ((InTerms, OpName (T.replicate n "+")), Fixity LeftAssoc k)+ | n <- [1 .. 200]+ ]+ | k <- [1, 2]+ ]+ store = storeEstablished cache "thing-1.0" "M"+ storing established = [] <$ replicateM_ 200 (store established)+ recalling = replicateM 200 (cachedEstablished cache "thing-1.0" "M")+ traverse_ store answers+ recalled' <-+ concat+ <$> inParallel id (fmap storing answers <> [recalling, recalling])+ filter (`notElem` fmap Just answers) recalled' `shouldBe` []+ it "round-trips the members of each name, a name without members among them" $ \cache -> do let established = mempty@@ -240,6 +261,12 @@ storeSummaries cache "m" "stamp" (Just (crowded :| [])) cachedSummaries cache "n" "stamp" `shouldReturn` Nothing + describe "where cabal keeps downloaded sources" $+ it "keeps projects apart under one plan" $ \cache -> do+ storePackageCache cache "/one" "/one/packages"+ cachedPackageCache cache "/another" `shouldReturn` Nothing+ cachedPackageCache cache "/one" `shouldReturn` Just "/one/packages"+ describe "module names with dots" $ it "files a deeply qualified module without confusion" $ \cache -> do storeEstablished cache "thing-1.0" "A.B.C.D" (declaring [((InTerms, OpName "%"), Fixity NoAssoc 5)])@@ -339,7 +366,7 @@ cachedInstalled cache `shouldReturn` Nothing it "gives back nothing to a token it was not written under" $ \_ ->- withIsolatedDirectory $ \dir ->+ withSystemTempDirectory "tilia-cache" $ \dir -> withDatabase $ \db -> do before' <- open dir (PlanToken "one") storeInstalled before' (Installed [containers] [db])@@ -347,7 +374,7 @@ cachedInstalled after' `shouldReturn` Nothing it "gives it back under the token it was written under" $ \_ ->- withIsolatedDirectory $ \dir ->+ withSystemTempDirectory "tilia-cache" $ \dir -> withDatabase $ \db -> do before' <- open dir (PlanToken "one") storeInstalled before' (Installed [containers] [db])@@ -355,7 +382,7 @@ cachedInstalled again `shouldReturn` Just [containers] it "keeps one token's answer when another writes its own" $ \_ ->- withIsolatedDirectory $ \dir ->+ withSystemTempDirectory "tilia-cache" $ \dir -> withDatabase $ \db -> do one <- open dir (PlanToken "one") storeInstalled one (Installed [containers] [db])@@ -422,7 +449,7 @@ -- | What an answer that leaves names unsettled is tied to, and what it is -- not. tokens :: Spec-tokens = around withIsolatedDirectory $ do+tokens = around (withSystemTempDirectory "tilia-cache") $ do it "does not offer an unread answer written under another token" $ \dir -> do before' <- open dir (PlanToken "one") storeEstablished before' "thing-1.0" "M" unreadable@@ -465,10 +492,7 @@ -- 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"+ withSystemTempDirectory "tilia-cache" (\dir -> open dir (PlanToken "plan") >>= action) -- | Open a cache in a given directory, under a given token. open :: FilePath -> PlanToken -> IO Cache
tests/Tilia/Fixity/DebugSpec.hs view
@@ -50,20 +50,21 @@ notesFor [("Prelude", Just []), ("Data.Map", Just [("!", infixl' 9)])] "import Data.Map\nf m = m ! 1\n"- >>= (`shouldContain'` "· ! infixl 9, declared in Data.Map")+ >>= (`shouldContain'` "· ! infixl 9 (term), 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")+ >>= (`shouldContain'` "· <+> infixr 5 (term), 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")+ >>= (`mentions` "<?> infixl 9 (term), 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"+ "· <?> unknown (term): may be declared in Criterion.Main, \+ \which this run could not read" ) it "counts the unread modules when there is more than one" $@@ -78,7 +79,7 @@ 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")+ >>= (`shouldContain'` "· M.! infixl 9 (term), declared in Data.Map") it "says when two imports disagree about one" $ notesFor@@ -107,6 +108,34 @@ told <- notesFor [("Prelude", Just [])] "f a b c = a <?> b <?> c <?> a\n" length (filter (T.isInfixOf "<?>") told) `shouldBe` 1 + it "gives an operator a line per namespace where they differ" $ do+ told <-+ notesFor+ [("Prelude", Just [])]+ "data a :. b = a :. b\ninfixr 5 data :.\ninfixl 4 type :.\n\+ \type T = Int :. Int\nx = 1 :. 2\n"+ told `shouldContain'` "· :. infixl 4 (type), declared in this module"+ told `shouldContain'` "· :. infixr 5 (term), declared in this module"++ it "gives an operator one line where both namespaces agree" $ do+ told <-+ notesFor+ [("Prelude", Just [])]+ "data a :- b = a :- b\ninfix 8 :-\ntype T = Int :- Int\nx = 1 :- 2\n"+ filter (T.isInfixOf "declared in this module") (fmap T.stripStart told)+ `shouldBe` ["· :- infix 8 (type & term), declared in this module"]++ it "names the namespace a constructor written among types answers from" $ do+ let answerOf m =+ mempty+ { establishedFixities =+ Map.fromList+ [((InTerms, OpName ":>"), Fixity RightAssoc 5) | m == "Ops"]+ }+ told <- notesAgainst answerOf "import Ops\ntype T = Int :> Int\nx = 1 :> 2\n"+ filter (T.isInfixOf ":>") (fmap T.stripStart told)+ `shouldBe` ["· :> infixr 5 (term), declared in Ops"]+ describe "how far reading an import got" $ do it "names the module that stopped it rather than the import above it" $ throughHspec@@ -166,7 +195,21 @@ it "lists what the module declares for itself" $ notesFor [("Prelude", Just [])] "infixr 5 <+>\nf a b = a <+> b\n"- >>= (`shouldContain'` "· <+> infixr 5")+ >>= (`shouldContain'` "· <+> infixr 5 (type & term)")++ it "lists what it declares for a type beside a constructor of its name" $ do+ told <-+ notesFor+ [("Prelude", Just [])]+ "data a :. b = a :. b\ninfixr 5 data :.\ninfixl 4 type :.\n"+ told `shouldContain'` "· :. infixr 5 (term)"+ told `shouldContain'` "· :. infixl 4 (type)"++ it "lists once what it declares for both at once" $ do+ told <-+ notesFor [("Prelude", Just [])] "data a :- b = a :- b\ninfix 8 :-\n"+ filter (T.isInfixOf ":-") (fmap T.stripStart told)+ `shouldBe` ["· :- infix 8 (type & term)"] ---------------------------------------------------------------------------- -- Helpers
tests/Tilia/Fixity/DependenciesSpec.hs view
@@ -25,7 +25,7 @@ import Data.Text.Encoding qualified as T import GHC.Hs (HsModule) import GHC.Hs.Extension (GhcPs)-import System.Directory (doesFileExist)+import System.Directory (canonicalizePath, doesFileExist) import Test.Hspec import Tilia.BootFixities (bootFixities) import Tilia.Cabal.Plan@@ -70,7 +70,7 @@ runIO $ filterM (fmap not . doesFileExist . snd) . filter ((`Set.member` readFromSourcePackages) . ppName . fst)- =<< plannedTarballs noCache plan+ =<< plannedTarballs noCache "." 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)@@ -145,8 +145,12 @@ [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` []+ answers <-+ traverse+ (\(path, m) -> (m,) <$> askModule resolver (Just path) m)+ (importedByOwn own)+ [m | (m, answer) <- answers, not (settlesEverything answer)]+ `shouldBe` [] it "settles every operator they use" $ do unsettled <- traverse (unsettledIn resolver) [(path, m) | (path, Just m) <- own]@@ -256,14 +260,15 @@ ---------------------------------------------------------------------------- -- This project --- | Every Haskell file this project is made of, parsed.+-- | Every Haskell file this project is made of, by its canonical path,+-- 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+ traverse parsed =<< traverse canonicalizePath paths where parsed path = do source <- T.decodeUtf8Lenient <$> BS.readFile path@@ -276,18 +281,20 @@ -- | What a module exports, where reading it settles every name. fixitiesThrough :: Resolver -> Text -> IO (Maybe Fixities)-fixitiesThrough resolver modName = settled <$> askModule resolver modName+fixitiesThrough resolver modName =+ settled <$> askModule resolver Nothing modName where settled established | settlesEverything established = Just (establishedFixities established) | otherwise = Nothing --- | Every module this project's own source imports.-importedByOwn :: [(FilePath, Maybe (HsModule GhcPs))] -> [Text]+-- | Every module this project's own source imports, with each file+-- importing it.+importedByOwn :: [(FilePath, Maybe (HsModule GhcPs))] -> [(FilePath, Text)] importedByOwn own = Set.toList . Set.fromList $- [ importModule i- | (_, Just hsModule) <- own,+ [ (path, importModule i)+ | (path, Just hsModule) <- own, i <- moduleImports (Is #implicitPrelude) (pure hsModule), not ("Paths_" `T.isPrefixOf` importModule i) ]@@ -304,7 +311,7 @@ (FilePath, HsModule GhcPs) -> IO [String] unsettledIn resolver (path, hsModule) = do- scope <- scopeFor resolver (Is #implicitPrelude) (pure hsModule)+ scope <- scopeFor resolver (Just path) (Is #implicitPrelude) (pure hsModule) pure [ path <> ": " <> T.unpack (operatorSpelling qualifier op) <> " " <> show why | ((qualifier, op), why) <- unknownOperators scope (pure (gathered hsModule))
tests/Tilia/Fixity/InterfaceSpec.hs view
@@ -140,6 +140,24 @@ declaresIn "exports:\n !\nfixities infixl 9 !\nab12\n data Other a b where\n (!) :: Int\n" `shouldBe` [((InTerms, OpName "!"), Fixity LeftAssoc 9)] + it "gives a type and a constructor of one name each its own" $+ declaresIn+ "exports:\n :.{:.}\n\+ \fixities infixr 5 :., infixl 4 :.\n\+ \b4c8\n type (:.) :: * -> * -> *\n data (:.) a b = a :. b\n"+ `shouldBe` [ ((InTypes, OpName ":."), Fixity LeftAssoc 4),+ ((InTerms, OpName ":."), Fixity RightAssoc 5)+ ]++ it "gives one fixity for a type and a constructor of one name to both" $+ declaresIn+ "exports:\n :-{:-}\n\+ \fixities infix 8 :-, infix 8 :-\n\+ \eeee\n type (:-) :: * -> * -> *\n data (:-) a b = a :- b\n"+ `shouldBe` [ ((InTypes, OpName ":-"), Fixity NoAssoc 8),+ ((InTerms, OpName ":-"), Fixity NoAssoc 8)+ ]+ describe "the members of a name" $ do it "takes the members an entry wears in braces" $ members "exports:\n GHC.Internal.Base.NonEmpty{GHC.Internal.Base.:|}\n"
tests/Tilia/Fixity/PackageDbSpec.hs view
@@ -27,6 +27,28 @@ dirsOf [("import-dirs", "${pkgroot}/../lib/base-4.20.2.0")] `shouldBe` Just ["${pkgroot}/../lib/base-4.20.2.0"] + it "reads the package root as ghc-pkg writes it, escapes and all" $+ dirsOf+ [ ("pkgroot", "\"/opt/J\\243zef, \\\"q\\\"/lib\""),+ ("import-dirs", "${pkgroot}/base")+ ]+ `shouldBe` Just ["/opt/Józef, \"q\"/lib/base"]++ it "reads a directory ghc-pkg quotes, as it does one with a space" $+ dirsOf+ [ ("pkgroot", "\"/opt/lib\""),+ ( "import-dirs",+ " \"${pkgroot}/a b\" ${pkgroot}/plain \"${pkgroot}/c,d\" \+ \\"/with space/\\233\""+ )+ ]+ `shouldBe` Just+ [ "/opt/lib/a b",+ "/opt/lib/plain",+ "/opt/lib/c,d",+ "/with space/é"+ ]+ it "roots every directory a package names" $ dirsOf [ ("pkgroot", "/opt/ghc/lib"),
tests/Tilia/Fixity/PlanSpec.hs view
@@ -27,13 +27,15 @@ import Data.List qualified import Data.List.NonEmpty (NonEmpty ((:|))) 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 Data.Time (addUTCTime, getCurrentTime) import System.Directory- ( createDirectoryIfMissing,+ ( canonicalizePath,+ createDirectoryIfMissing, doesFileExist, getPermissions, setModificationTime,@@ -53,7 +55,6 @@ import Tilia.Fixity.Cache ( PlanToken (..), openCache,- storeFutileFetch, storePackageCache, ) import Tilia.Fixity.HiFile (HiExport (..), HiFile (..), HiName (..))@@ -87,6 +88,7 @@ askedAtOnce givenInterfaces readBefore+ namedAlike gitDependencies repositories packageCache@@ -168,7 +170,7 @@ -- | 'Plan.prepareWith', with the cache in use as it is by default. prepareWith ::- ([String] -> IO (Either Text ())) ->+ ([String] -> IO (Either CabalFailure ())) -> Futility -> [PlanComponent] -> FilePath ->@@ -262,10 +264,29 @@ 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")+ let cabal args = Left (Unsolvable "cabal said no") <$ record steps args prepareWith cabal undiscoveredFutility [] dir PlanMissing `shouldReturn` Left "cabal said no" readIORef steps `shouldReturn` [solving, narrowSolve] + it "asks about less only where the whole project will not solve" $+ withTempProject Nothing $ \dir -> do+ steps <- newIORef []+ let cabal args = Left (CabalFailed "cabal said no") <$ record steps args+ prepareWith cabal undiscoveredFutility [] dir PlanMissing+ `shouldReturn` Left "cabal said no"+ readIORef steps `shouldReturn` [solving]++ it "hears from cabal that the whole project will not solve" $+ withTempProject Nothing $ \dir -> do+ let unsolvable = complaining "Could not resolve dependencies:"+ fst <$> runsCabalWith unsolvable (loading dir)+ `shouldReturn` ["build", "build"]++ it "hears from cabal that it failed otherwise" $+ withTempProject Nothing $ \dir -> do+ let unparsed = complaining "Error parsing project file"+ fst <$> runsCabalWith unparsed (loading dir) `shouldReturn` ["build"]+ it "asks about the test suites and the benchmarks, not the library alone" $ withTempProject Nothing $ \dir -> do steps <- newIORef []@@ -283,7 +304,7 @@ let cabal args = do record steps args if wholeProject `Data.List.isSuffixOf` args- then pure (Left "a test suite will not solve")+ then pure (Left (Unsolvable "a test suite will not solve")) else do when (args == narrowSolve) (writePlan dir wantingATarball) pure (Right ())@@ -310,6 +331,16 @@ setModificationTime (dir </> "thing.cabal") later checkReadiness [] dir `shouldReturn` PlanStale [dir </> "thing.cabal"] + it "takes a change to a file the project imports as making the plan stale" $+ withOwnPlan $ \dir -> do+ writeUtf8File (dir </> "cabal.project") "import: config/more.config\n"+ createDirectoryIfMissing True (dir </> "config")+ writeUtf8File (dir </> "config" </> "more.config") ""+ earlier <- addUTCTime (-90) <$> getCurrentTime+ setModificationTime (dir </> "cabal.project") earlier+ imported <- canonicalizePath (dir </> "config" </> "more.config")+ checkReadiness [] dir `shouldReturn` PlanStale [imported]+ describe "a plan narrower than the run" $ do it "notices a component the plan says nothing about" $ withTempProject (Just twoComponents) $ \dir ->@@ -589,7 +620,7 @@ it "declares nothing, where it is one of the project's own" $ withFakeProject [("src/Cursed.hsc", cursed)] $ \rs -> do- askModule rs "Cursed" `shouldReturn` mempty+ askModule rs Nothing "Cursed" `shouldReturn` mempty it "declares nothing, where it comes out of a tarball" $ withFakeArchive [("Cursed.hsc", cursed)] $@@ -653,8 +684,16 @@ case said of Nothing -> expectationFailure "no cabal on the path to ask" Just reported ->- packageCacheRoot `shouldReturn` T.unpack (T.strip reported)+ packageCacheRoot "." `shouldReturn` T.unpack (T.strip reported) + it "is the one the project's own configuration names" $+ withSystemTempDirectory "tilia-own-cache" $ \dir -> do+ writeUtf8File (dir </> "cabal.project") . T.pack $+ "packages: .\nremote-repo-cache: " <> (dir </> "packages") <> "\n"+ writeUtf8File (dir </> "thing.cabal") $+ "cabal-version: 3.0\nname: thing\nversion: 1.0\n\nlibrary\n"+ packageCacheRoot dir `shouldReturn` (dir </> "packages")+ 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 ->@@ -677,49 +716,83 @@ describe "and where it was remembered" $ do it "is not asked again where the plan's tarballs are there" $- withRemembered True [] $ \root asked found -> do+ withRemembered True $ \root asked found -> do asked `shouldBe` [] found `shouldBe` [root </> "hackage.haskell.org/thing/1.0/thing-1.0.tar.gz"] - it "is asked again where a tarball of the plan is not there" $- withRemembered False [] $ \_ asked _ ->- asked `shouldBe` ["path"]-- it "is not asked again for a tarball fetching did not bring in" $- withRemembered False ["thing"] $ \_ asked _ ->+ it "is not asked again where a tarball of the plan is not there" $+ withRemembered False $ \_ asked _ -> asked `shouldBe` [] + it "is asked again where a fetch leaves a tarball of the plan missing" $+ afterFetching (\_ -> pure ()) `shouldReturn` ["path"]++ it "is not asked again where a fetch brings the plan's tarballs in" $+ afterFetching+ ( \root -> do+ let at = root </> "hackage.haskell.org/tilia-phantom/9.9.9"+ createDirectoryIfMissing True at+ writeUtf8File (at </> "tilia-phantom-9.9.9.tar.gz") "not really"+ )+ `shouldReturn` []+ -- | Find the tarballs of a plan wanting one package from Hackage, where the -- package cache was remembered to be a directory of its own, holding the--- tarball or not, and a fetch was remembered not to bring in the packages--- given, and hand over the directory, the commands the stand-in for--- @cabal@ was given, and where each tarball was found.+-- tarball or not, and hand over the directory, the commands the stand-in+-- for @cabal@ was given, and where each tarball was found. withRemembered :: Bool ->- [Text] -> (FilePath -> [String] -> [FilePath] -> Expectation) -> Expectation-withRemembered holding refused act =+withRemembered holding act = withSystemTempDirectory "tilia-remembered" $ \root -> do let at = root </> "hackage.haskell.org" </> "thing" </> "1.0" when holding $ do createDirectoryIfMissing True at writeUtf8File (at </> "thing-1.0.tar.gz") "not really a tarball" cache <- openCache (Do #useCache) (PlanToken (T.pack (takeBaseName root)))- storePackageCache cache root- storeFutileFetch cache refused- withTempProject (Just (fromRepository hackage)) $ \dir ->+ withTempProject (Just (fromRepository hackage)) $ \dir -> do+ storePackageCache cache dir root readBuildPlan (planPathFor dir) >>= \case Left why -> expectationFailure (T.unpack why) Right plan -> do- (asked, found) <- runsCabal (plannedTarballs cache plan)+ (asked, found) <- runsCabal (plannedTarballs cache dir plan) act root asked (fmap snd found) where hackage = "{\"type\":\"secure-repo\",\"uri\":\"https://hackage.haskell.org/\"}" +-- | The commands the stand-in for @cabal@ is given while a project short of+-- a tarball fetches it, the package cache remembered to be a directory of+-- its own, which the fetch does what is given to.+afterFetching :: (FilePath -> IO ()) -> IO [String]+afterFetching fetched =+ withSystemTempDirectory "tilia-remembered" $ \root ->+ withEnvironment [("XDG_CACHE_HOME", root </> "cache")] $+ withTempProject (Just wantingATarball) $ \dir -> do+ Right plan <- readBuildPlan (planPathFor dir)+ cache <- openCache (Do #useCache) =<< tokenForBuildPlan plan+ storePackageCache cache dir root+ let cabal args = Right () <$ when (args == fetching) (fetched root)+ short = SourcesMissing ["tilia-phantom"]+ fst <$> runsCabal (prepareWith cabal undiscoveredFutility [] dir short)+ -- | A plan handed over to be taken as it is. givenPlans :: Spec givenPlans = describe "a plan trusted as up to date" $ do+ it "says which plan is not there, once" $+ withGivenPlan [] $ \project _ ->+ readGivenPlan project "nowhere.json"+ `shouldReturn` Left "nowhere.json does not exist"++ it "says which plan does not parse" $+ withGivenPlan [] $ \project _ -> do+ let planFile = project </> "bad.json"+ unparsed = T.pack planFile <> " does not parse: "+ writeUtf8File planFile "{\"compiler-id\": 3}"+ readGivenPlan project planFile >>= \case+ Left why -> why `shouldSatisfy` T.isPrefixOf unparsed+ Right _ -> expectationFailure "a plan that does not parse was read"+ it "finds a local package it names relatively under the project" $ withGivenPlan [] $ \project planFile -> readGivenPlan project planFile >>= \case@@ -744,6 +817,12 @@ filter (== "fetch") . fst <$> runsCabal (fetchingFor project planFile) `shouldReturn` ["fetch"] + it "does not fetch again what fetching did not bring in" $+ withGivenPlan [unavailable] $ \project planFile -> do+ let succeeding = fmap fst . runsCabalWith "exit 0" . fetchingFor project+ succeeding planFile `shouldReturn` ["path", "fetch", "path"]+ succeeding planFile `shouldReturn` []+ it "runs no cabal where it reads interfaces alone, whatever it is asked" $ withGivenPlan [unavailable] $ \project planFile -> fst@@ -780,7 +859,12 @@ -- | The @cabal@ commands something runs, as told by a stand-in put first -- on the path that fails, and what it came to. runsCabal :: IO a -> IO ([String], a)-runsCabal act+runsCabal = runsCabalWith "exit 1"++-- | 'runsCabal', with the stand-in going on to run the shell commands+-- given.+runsCabalWith :: String -> IO a -> IO ([String], a)+runsCabalWith script act | System.Info.os == "mingw32" = expectationFailure "the stand-in for cabal is a shell script, which does not run on Windows" >> (,) [] <$> act@@ -788,7 +872,12 @@ withSystemTempDirectory "tilia-cabal" $ \bin -> do let stand = bin </> "cabal" commandLog = bin </> "commands"- writeFile stand ("#!/bin/sh\necho \"$1\" >> '" <> commandLog <> "'\nexit 1\n")+ writeFile stand $+ "#!/bin/sh\necho \"$1\" >> '"+ <> commandLog+ <> "'\n"+ <> script+ <> "\n" setPermissions stand . setOwnerExecutable True =<< getPermissions stand path <- maybe "" (searchPathSeparator :) <$> lookupEnv "PATH" answer <- withEnvironment [("PATH", bin <> path)] act@@ -833,12 +922,11 @@ writeUtf8File (planPathFor dir) planText readBuildPlan (planPathFor dir) >>= \case Left why -> expectationFailure (T.unpack why)- Right plan ->- openCache (Don't #useCache) (PlanToken "")- >>= (`plannedTarballs` plan)- >>= \case- [(_, found)] -> act found- other -> expectationFailure (show (fmap snd other))+ Right plan -> do+ cache <- openCache (Don't #useCache) (PlanToken "")+ plannedTarballs cache dir plan >>= \case+ [(_, found)] -> act found+ other -> expectationFailure (show (fmap snd other)) where put cabalDir (repo, held, version) = do let at =@@ -1133,6 +1221,78 @@ ] localDirsOf plan = [dir | LocalPackage dir <- fmap ppSource (bpPackages plan)] +-- | A module another component of the package names alike, as GHC finds it+-- for each of them.+namedAlike :: Spec+namedAlike = describe "a module another component names alike" $ do+ it "is the one of the component importing it" $+ withFakePlan components $ \plan -> do+ fixityFrom plan ("tests" </> "Main.hs") "Utils" "<+>"+ `shouldReturn` Just (Fixity RightAssoc 5)+ fixityFrom plan "Lib.hs" "Utils" "<+>"+ `shouldReturn` Just (Fixity LeftAssoc 6)++ it "is a dependency's for a component that does not hold it" $+ withFakePlan components $ \plan ->+ fixityFrom plan "Lib.hs" "Data.Function" "&"+ `shouldReturn` Just (Fixity LeftAssoc 1)++ it "is the one of a component sharing the importer's directory" $+ withFakePlan components $ \plan ->+ fixityFrom plan ("app" </> "Other.hs") "Data.Function" "&"+ `shouldReturn` Just (Fixity RightAssoc 0)+ where+ fixityFrom plan file modName op = do+ rs <- newResolver plan+ importer <-+ traverse+ canonicalizePath+ [dir </> file | LocalPackage dir <- fmap ppSource (bpPackages plan)]+ Map.lookup (InTerms, OpName op) . establishedFixities+ <$> askModule rs (listToMaybe importer) modName+ components =+ [ ( "fake.cabal",+ T.unlines+ [ "cabal-version: 2.4",+ "name: fake",+ "version: 0.1.0.0",+ "library",+ " exposed-modules: Lib, Utils",+ " default-language: Haskell2010",+ "test-suite tests",+ " type: exitcode-stdio-1.0",+ " main-is: Main.hs",+ " other-modules: Utils",+ " hs-source-dirs: tests",+ " default-language: Haskell2010",+ "executable other",+ " main-is: Other.hs",+ " hs-source-dirs: app",+ " default-language: Haskell2010",+ "executable app",+ " main-is: Main.hs",+ " other-modules: Data.Function",+ " hs-source-dirs: app",+ " default-language: Haskell2010"+ ]+ ),+ ("Lib.hs", "module Lib () where\nimport Utils ()\n"),+ ("Utils.hs", utils "infixl 6"),+ ("tests/Main.hs", "module Main (main) where\nimport Utils ()\n"),+ ("tests/Utils.hs", utils "infixr 5"),+ ( "app/Data/Function.hs",+ "module Data.Function ((&)) where\ninfixr 0 &\n\+ \(&) :: a -> (a -> b) -> b\nx & f = f x\n"+ )+ ]+ utils fixity =+ T.unlines+ [ "module Utils ((<+>)) where",+ fixity <> " <+>",+ "(<+>) :: Int -> Int -> Int",+ "a <+> b = a + b"+ ]+ -- | How many modules the ring has. ringSize :: Int ringSize = 8@@ -1162,7 +1322,8 @@ -- | What a module exports, where reading it settles every name. fixitiesOf :: Resolver -> Text -> IO (Maybe Fixities)-fixitiesOf resolver modName = settled <$> askModule resolver modName+fixitiesOf resolver modName =+ settled <$> askModule resolver Nothing modName where settled established | settlesEverything established = Just (establishedFixities established)@@ -1170,11 +1331,13 @@ -- | The members of each of a module's names. membersIn :: Resolver -> Text -> IO (Map.Map OpName (Set.Set OpName))-membersIn resolver modName = establishedMembers <$> askModule resolver modName+membersIn resolver modName =+ establishedMembers <$> askModule resolver Nothing modName -- | Every name a module certainly brings in. certainNamesOf :: Resolver -> Text -> IO (Set.Set (Namespace, OpName))-certainNamesOf resolver modName = certainNames . establishedCertain <$> askModule resolver modName+certainNamesOf resolver modName =+ certainNames . establishedCertain <$> askModule resolver Nothing modName -- | A module of the kind @hsc2hs@ takes, declaring an operator nothing can -- get at.@@ -1430,10 +1593,51 @@ ) ] $ \rs -> do- answer <- askModule rs "Disagree"+ answer <- askModule rs Nothing "Disagree" unsettledThrough answer (InTerms, OpName "<+>") `shouldBe` [[]] unsettledThrough answer (InTerms, OpName "sort") `shouldBe` [] + it "leaves unsettled what one configuration declares and another does not"+ $ withFakeProject+ [ ( "src/Partly.hs",+ T.unlines+ [ "{-# LANGUAGE CPP #-}",+ "module Partly ((<+>)) where",+ "#ifdef FAST",+ "infixr 5 <+>",+ "#endif",+ "(<+>) :: Int -> Int -> Int",+ "a <+> b = a + b"+ ]+ )+ ]+ $ \rs -> do+ answer <- askModule rs Nothing "Partly"+ unsettledThrough answer (InTerms, OpName "<+>") `shouldBe` [[]]++ it "keeps the fixity of a name only one configuration exports"+ $ withFakeProject+ [ ( "src/Partly.hs",+ T.unlines+ [ "{-# LANGUAGE CPP #-}",+ "#ifdef FAST",+ "module Partly ((<+>), f) where",+ "#else",+ "module Partly (f) where",+ "#endif",+ "infixr 5 <+>",+ "(<+>) :: Int -> Int -> Int",+ "a <+> b = a + b",+ "f :: Int",+ "f = 1"+ ]+ )+ ]+ $ \rs ->+ fixitiesOf rs "Partly"+ `shouldReturn` Just+ (Map.singleton (InTerms, OpName "<+>") (Fixity RightAssoc 5))+ it "settles what an import it can read decides, though no configuration reads every import" $ withFakeProject [ ( "src/Bothbad.hs",@@ -1461,7 +1665,7 @@ describe "what a package module brings in" $ it "names what it hands on" $ do- answer <- askModule resolver "Prettyprinter"+ answer <- askModule resolver Nothing "Prettyprinter" certainNames (establishedCertain answer) `shouldSatisfy` Set.member (InTerms, OpName "<+>") describe "the members of each of a module's names" $ do@@ -1515,7 +1719,7 @@ ] $ \rs -> do let m = parsed "module M where\nimport Facade (T (..))\n"- scope <- scopeFor rs (Is #implicitPrelude) (pure (pmModule m))+ scope <- scopeFor rs Nothing (Is #implicitPrelude) (pure (pmModule m)) lookupFixity scope InTerms Nothing (OpName ":|") `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Facade") @@ -1547,7 +1751,7 @@ it "is what it hands on from where reading gave up" $ withFakeProject [("src/Opaque.hs", opaqueSource)] $ \rs -> do- answer <- askModule rs "Opaque"+ answer <- askModule rs Nothing "Opaque" establishedUnsettled answer `shouldBe` Map.singleton ["No.Such.Module"] (Set.singleton (InTerms, OpName "<+>")) establishedUntold answer `shouldBe` Set.empty@@ -1562,24 +1766,25 @@ ] ) ]- $ \rs -> settlesEverything <$> askModule rs "Wide" `shouldReturn` True+ $ \rs ->+ settlesEverything <$> askModule rs Nothing "Wide" `shouldReturn` True it "is everything for a module it cannot find at all" $ withFakeProject [("src/Opaque.hs", opaqueSource)] $- \rs -> askModule rs "No.Such.Module" `shouldReturn` unreadable+ \rs -> askModule rs Nothing "No.Such.Module" `shouldReturn` unreadable it "is everything it does not certainly bring in, when what it hands on whole cannot be read" $ withFakeProject [("src/Facade.hs", "module Facade (module No.Such.Module) where\nimport No.Such.Module\n")] $ \rs -> do- answer <- askModule rs "Facade"+ answer <- askModule rs Nothing "Facade" establishedUntold answer `shouldBe` Set.singleton ["No.Such.Module"] it "is the type and its members, when a type it hands on is beyond us" $ withFakeProject [("src/Facade.hs", "module Facade (T (..)) where\nimport No.Such.Module\n")] $ \rs -> do- answer <- askModule rs "Facade"+ answer <- askModule rs Nothing "Facade" unsettledThrough answer (InTypes, OpName "T") `shouldBe` [["No.Such.Module"]] unsettledThrough answer (InTerms, OpName ":|") `shouldBe` [["No.Such.Module"]] @@ -1588,11 +1793,11 @@ [ ("src/Ping.hs", "module Ping (module Pong) where\nimport Pong\n"), ("src/Pong.hs", "module Pong (module Ping) where\nimport Ping\n") ]- $ \rs -> askModule rs "Ping" `shouldReturn` mempty+ $ \rs -> askModule rs Nothing "Ping" `shouldReturn` mempty it "is everything for a module whose source will not parse" $ withFakeProject [("src/Bad.hs", "module Bad ((<+>)) where\nf = (((\n")] $- \rs -> askModule rs "Bad" `shouldReturn` unreadable+ \rs -> askModule rs Nothing "Bad" `shouldReturn` unreadable it "is what any configuration leaves unsettled, where none settles every name" $ withFakeProject@@ -1609,7 +1814,7 @@ ) ] $ \rs -> do- answer <- askModule rs "Both"+ answer <- askModule rs Nothing "Both" establishedUnsettled answer `shouldBe` Map.singleton ["No.Such.Module"] (Set.fromList [(InTerms, OpName "<+>"), (InTerms, OpName "<?>")]) @@ -1617,7 +1822,7 @@ withFakeProject [("src/Opaque.hs", opaqueSource)] $ \rs -> do let m = parsed "module M where\nimport Opaque\n"- scope <- scopeFor rs (Is #implicitPrelude) (pure (pmModule m))+ scope <- scopeFor rs Nothing (Is #implicitPrelude) (pure (pmModule m)) lookupFixity scope InTerms Nothing (OpName "<??>") `shouldBe` Resolved defaultFixity ReportDefault @@ -1625,24 +1830,30 @@ withFakeProject [("src/Opaque.hs", opaqueSource)] $ \rs -> do let m = parsed "module M where\nimport Opaque\n"- scope <- scopeFor rs (Is #implicitPrelude) (pure (pmModule m))+ scope <- scopeFor rs Nothing (Is #implicitPrelude) (pure (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 -> Map.keys . establishedUnsettled <$> askModule rs "Opaque" `shouldReturn` [["No.Such.Module"]]+ \rs ->+ Map.keys . establishedUnsettled <$> askModule rs Nothing "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 -> Map.keys . establishedUnsettled <$> askModule rs "Near" `shouldReturn` [["Middle", "No.Such.Module"]]+ $ \rs ->+ Map.keys . establishedUnsettled <$> askModule rs Nothing "Near"+ `shouldReturn` [["Middle", "No.Such.Module"]] it "has nothing to say about a module that could be read" $ withFakeProject [("src/Opaque.hs", opaqueSource)] $- \rs -> settlesEverything <$> askModule rs "Prelude" `shouldReturn` True+ \rs ->+ settlesEverything <$> askModule rs Nothing "Prelude"+ `shouldReturn` True describe "what a module brings in" $ do it "is every name its interface exports" $ do@@ -1700,6 +1911,41 @@ certainNamesOf rs "Own" `shouldReturn` (Set.fromList [(InTypes, OpName "T"), (InTerms, OpName "C")]) + it "keeps the fixity of a data instance's constructor, with its family"+ $ withFakeProject+ [ ( "src/Own.hs",+ T.unlines+ [ "{-# LANGUAGE TypeFamilies #-}",+ "module Own (F (..)) where",+ "data family F a",+ "infixr 5 :+",+ "data instance F Int = Int :+ Int"+ ]+ )+ ]+ $ \rs ->+ fixitiesOf rs "Own"+ `shouldReturn` Just+ (Map.singleton (InTerms, OpName ":+") (Fixity RightAssoc 5))++ it "keeps the fixity of a pattern synonym it bundles with a type" $+ withFakeProject [("src/Own.hs", bundling "T (E, (:<))")] $+ \rs ->+ fixitiesOf rs "Own"+ `shouldReturn` Just+ (Map.singleton (InTerms, OpName ":<") (Fixity RightAssoc 5))++ it "keeps the constructors of a type exported as T (.., P)" $+ withFakeProject [("src/Own.hs", bundling "T (.., (:<))")] $+ \rs ->+ fixitiesOf rs "Own"+ `shouldReturn` Just+ ( Map.fromList+ [ ((InTerms, OpName ":+"), Fixity RightAssoc 4),+ ((InTerms, OpName ":<"), Fixity RightAssoc 5)+ ]+ )+ it "takes the members of a type it hands on from the module the type came from" $ withFakeProject [ ("src/Inner.hs", "module Inner where\ndata T = C | D\n"),@@ -1753,7 +1999,7 @@ ] $ \rs -> do let m = parsed "module C (w) where\nimport A\nimport B\nw :: Int\nw = 1 `clampTo` 2\n"- scope <- scopeFor rs (Is #implicitPrelude) (pure (pmModule m))+ scope <- scopeFor rs Nothing (Is #implicitPrelude) (pure (pmModule m)) lookupFixity scope InTerms Nothing (OpName "clampTo") `shouldBe` Resolved defaultFixity ReportDefault @@ -1764,7 +2010,7 @@ ] $ \rs -> do let m = parsed "module C (w) where\nimport A\nimport B\nw = 1 :+: 2\n"- scope <- scopeFor rs (Is #implicitPrelude) (pure (pmModule m))+ scope <- scopeFor rs Nothing (Is #implicitPrelude) (pure (pmModule m)) lookupFixity scope InTerms Nothing (OpName ":+:") `shouldBe` Unresolved (unreadOnly "A") @@ -1776,7 +2022,7 @@ ] $ \rs -> do let m = parsed "module C (w) where\nimport Core\nimport Tree (Tree (..))\nw = Leaf `Node` Leaf `Node` Leaf\n"- scope <- scopeFor rs (Is #implicitPrelude) (pure (pmModule m))+ scope <- scopeFor rs Nothing (Is #implicitPrelude) (pure (pmModule m)) lookupFixity scope InTerms Nothing (OpName "Node") `shouldBe` Resolved defaultFixity ReportDefault @@ -1788,7 +2034,7 @@ ] $ \rs -> do let m = parsed "module C (w) where\nimport Core\nimport Tree (Tree)\nw = Leaf `Node` Leaf `Node` Leaf\n"- scope <- scopeFor rs (Is #implicitPrelude) (pure (pmModule m))+ scope <- scopeFor rs Nothing (Is #implicitPrelude) (pure (pmModule m)) lookupFixity scope InTerms Nothing (OpName "Node") `shouldBe` Unresolved (ModuleChain ("Core" :| ["A"]) :| []) @@ -1799,7 +2045,7 @@ ] $ \rs -> do let m = parsed "module C (w) where\nimport Ops (T (..))\nimport Other\nw = 1 <+> 2\n"- scope <- scopeFor rs (Is #implicitPrelude) (pure (pmModule m))+ scope <- scopeFor rs Nothing (Is #implicitPrelude) (pure (pmModule m)) lookupFixity scope InTerms Nothing (OpName "<+>") `shouldBe` Resolved (Fixity LeftAssoc 6) (DeclaredIn "Other") @@ -1946,10 +2192,19 @@ writePlan :: FilePath -> Text -> IO () writePlan dir = writeUtf8File (planPathFor dir) --- | A project whose @.cabal@ file changed after its plan was written, under--- a plan of its own, so that what it leaves in the cache is its own.+-- | A project whose @.cabal@ file changed after its plan was written. withChangedPackage :: (FilePath -> IO a) -> IO a withChangedPackage act =+ withOwnPlan $ \dir -> do+ now <- getCurrentTime+ writeUtf8File (dir </> "thing.cabal") ""+ setModificationTime (dir </> "thing.cabal") (addUTCTime (-30) now)+ act dir++-- | An empty project under a plan of its own, written a minute ago, so+-- that what it leaves in the cache is its own.+withOwnPlan :: (FilePath -> IO a) -> IO a+withOwnPlan act = withTempProject Nothing $ \dir -> do writePlan dir $ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\@@ -1959,8 +2214,6 @@ \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}}]}" now <- getCurrentTime setModificationTime (planPathFor dir) (addUTCTime (-60) now)- writeUtf8File (dir </> "thing.cabal") ""- setModificationTime (dir </> "thing.cabal") (addUTCTime (-30) now) act dir -- | A plan naming one package that no package cache can have a tarball@@ -2040,9 +2293,19 @@ record steps args = modifyIORef' steps (<> [args]) -- | A @cabal@ that does nothing and says it went well.-obliging :: IORef [[String]] -> [String] -> IO (Either Text ())+obliging :: IORef [[String]] -> [String] -> IO (Either CabalFailure ()) obliging steps args = record steps args >> pure (Right ()) +-- | Load the plan of a project as a run does, with the real way of running+-- @cabal@.+loading :: FilePath -> IO (Either Text BuildPlan)+loading = loadPlan (Do #useCache) (Do #download) []++-- | What a stand-in for @cabal@ runs to fail, saying what is given on its+-- standard error.+complaining :: String -> String+complaining complaint = "echo '" <> complaint <> "' >&2; exit 1"+ -- | Run an assertion on a module's fixities, failing where the module could -- not be resolved at all. needs ::@@ -2062,7 +2325,11 @@ (Scope -> Expectation) -> Expectation endToEnd resolver source assertion =- scopeFor resolver (Is #implicitPrelude) (pure (pmModule (parsed source)))+ scopeFor+ resolver+ Nothing+ (Is #implicitPrelude)+ (pure (pmModule (parsed source))) >>= assertion -- | Check one expected fixity, returning a description of any mismatch.@@ -2124,6 +2391,20 @@ "f = 1" ] +-- | A module bundling the pattern synonym @:<@ with its type @T@, which has+-- the constructor @:+@, in the export given.+bundling :: Text -> Text+bundling export =+ T.unlines+ [ "{-# LANGUAGE PatternSynonyms #-}",+ "module Own (" <> export <> ") where",+ "infixr 4 :+",+ "data T = E | Int :+ T",+ "infixr 5 :<",+ "pattern (:<) :: Int -> T -> T",+ "pattern x :< xs = x :+ xs"+ ]+ -- | 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@@ -2150,7 +2431,9 @@ " hs-source-dirs: src", " default-language: Haskell2010" ]- traverse_ (\(path, text) -> writeUtf8File (dir </> path) text) sources+ for_ sources $ \(path, text) -> do+ createDirectoryIfMissing True (takeDirectory (dir </> path))+ writeUtf8File (dir </> path) text writeUtf8File (dir </> "plan.json") $ "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ \[{\"pkg-name\":\"fake\",\"pkg-version\":\"0.1.0.0\",\
tests/Tilia/FixitySpec.hs view
@@ -73,6 +73,12 @@ declaredWithNamespaces "module M where\ninfixl 6 <+>\na <+> b = a\n" `shouldBe` [((InTerms, OpName "<+>"), Fixity LeftAssoc 6)] + it "gives a data instance constructor's fixity to terms" $+ declaredWithNamespaces+ "{-# LANGUAGE TypeFamilies #-}\nmodule M where\ninfixr 5 :>\n\+ \data family F a\ndata instance F Int = Int :> Int\n"+ `shouldBe` [((InTerms, OpName ":>"), Fixity RightAssoc 5)]+ it "gives a pattern synonym's fixity to terms" $ declaredWithNamespaces "{-# LANGUAGE PatternSynonyms #-}\nmodule M where\ninfixl 5 :>\npattern x :> y = (x, y)\n"@@ -127,6 +133,33 @@ lookupFixity (scopeOfBoth "import Terms\n") InTypes Nothing (OpName ":>") `shouldBe` Resolved (Fixity LeftAssoc 5) (DeclaredIn "Terms") + it "takes none for a type a read import brings in" $+ lookupFixity+ ( scopeBringing+ [("Readable", [(InTypes, ":>")])]+ "import Readable\nimport Terms\n"+ )+ InTypes+ Nothing+ (OpName ":>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "takes none for a type the module declares" $+ lookupFixity+ (scopeOfBoth "import Terms\ntype a :> b = Either a b\n")+ InTypes+ Nothing+ (OpName ":>")+ `shouldBe` Resolved defaultFixity ReportDefault++ it "takes none where an unread import may bring a type in" $+ lookupFixity+ (scopeOfBoth "import Terms\nimport Opaque\n")+ InTypes+ Nothing+ (OpName ":>")+ `shouldBe` Unresolved (unreadOnly "Opaque")+ it "does not take a type's fixity for a term" $ lookupFixity (scopeOfBoth "import Types\n") InTerms Nothing (OpName ":>") `shouldBe` Resolved defaultFixity ReportDefault@@ -147,6 +180,15 @@ fmap snd (unsettledIn "module M where\nimport Terms\nimport Other.Terms\ntype T = Int :> Int\n") `shouldBe` [Ambiguous termsDisagreeing] + it "settles a constructor written with its tick among the terms alone" $+ fmap+ snd+ ( unsettledIn+ "{-# LANGUAGE DataKinds #-}\nmodule M where\nimport Types\n\+ \import Terms\nimport Other.Terms\ntype T = 1 ':> 2\n"+ )+ `shouldBe` [Ambiguous termsDisagreeing]+ 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@@ -163,6 +205,14 @@ exportsOfSource "module M (module Data.Map) where\n" `shouldBe` Just [ExportModule "Data.Map"] + it "reads T (.., P) as T (..) and T (P) together" $+ exportsOfSource+ "{-# LANGUAGE PatternSynonyms #-}\nmodule M (T (.., P)) where\n"+ `shouldBe` Just+ [ ExportAll Nothing (OpName "T"),+ ExportSome Nothing (OpName "T") [OpName "P"]+ ]+ 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 "<??>")@@ -465,6 +515,24 @@ declaredMembersIn "module M where\nclass C a where\n type F a\n" `shouldBe` [(OpName "C", [(InTypes, OpName "F")])] + it "takes a data instance's constructors, under its family" $+ declaredMembersIn+ "{-# LANGUAGE TypeFamilies #-}\nmodule M where\n\+ \data family F a\ndata instance F Int = A | Int :| Int\n"+ `shouldBe` [ ( OpName "F",+ [(InTerms, OpName ":|"), (InTerms, OpName "A")]+ )+ ]++ it "takes those of the data instances of a class instance" $+ declaredMembersIn+ "{-# LANGUAGE TypeFamilies #-}\nmodule M where\n\+ \instance C Int where\n data F Int = A | Int :| Int\n"+ `shouldBe` [ ( OpName "F",+ [(InTerms, OpName ":|"), (InTerms, OpName "A")]+ )+ ]+ it "has nothing to say about a type synonym" $ declaredMembersIn "module M where\ntype T = Int\n" `shouldBe` [] @@ -475,6 +543,12 @@ it "hands on every member of a name exported with (..)" $ listedMembersIn "module M (T (..)) where\ndata T = A | Int :| Int\n" `shouldBe` [(OpName "T", [OpName ":|", OpName "A"])]++ it "hands on every member of a name exported with (..) and the rest" $+ listedMembersIn+ "{-# LANGUAGE PatternSynonyms #-}\n\+ \module M (T (.., P)) where\ndata T = A | Int :| Int\npattern P = A\n"+ `shouldBe` [(OpName "T", [OpName ":|", OpName "A", OpName "P"])] it "says nothing of the members of a type it does not declare" $ listedMembersIn "module M (T (..)) where\nimport Elsewhere\n"
tests/Tilia/IgnoreSpec.hs view
@@ -72,6 +72,9 @@ it "reads lines ended with a carriage return" $ "*.hs\r\n!keep.hs\r\n" `ignores` ["a.hs"] `butNot` ["keep.hs"] + it "reads its first line past a byte order mark" $+ "\xFEFF*.hs\n" `ignores` ["a.hs"] `butNot` []+ describe "ignore files in several directories" $ do it "match from their own directories" $ nested [([], ""), (["src"], "/x/\n")] ["src/x/B.hs"] ["x/B.hs", "src/A.hs"]
tests/Tilia/PragmaSpec.hs view
@@ -39,10 +39,36 @@ ("one among pragmas that do not move anything", langThenLine), ( "one after a character literal holding a double quote", "module M where\nq = '\"'\n{-# LINE 9 \"O.hs\" #-}\n"- )+ ),+ ( "one after a quasi-quotation",+ "module M where\nx = [q|a|]\n{-# LINE 9 \"O.hs\" #-}\n"+ ),+ ("a line marker", "module M where\nx = 1\n# 40 \"O.hs\"\ny = x\n"),+ ("one written without a space", "module M where\n#40 \"O.hs\"\n"),+ ("one written as a #line", "module M where\n#line 40 \"O.hs\"\n"),+ ("one on the first line", "# 1 \"M.hs\"\nmodule M where\n"),+ ("one under a script's #! line", "#!/bin/runghc\n# 1 \"M.hs\"\n"),+ ("one after a comment", "module M where\n-- x\n# 9 \"O.hs\"\n"),+ ("a #pragma line", "module M where\n#pragma once\n"),+ ("a #! line below the top", "module M where\n#!/bin/sh\n"),+ ("a #! line after a space", " #!/bin/sh\nmodule M where\n") ]- (\source -> movesPositions source `shouldBe` True)+ (\source -> movesPositions [QuasiQuotes] source `shouldBe` True) + it "one after a list comprehension, where quasi-quotes are off" $+ movesPositions+ []+ "module M where\nxs = [x|x<-[1]]\n{-# LINE 9 \"O.hs\" #-}\n"+ `shouldBe` True++ it "a line marker written with a number where CPP is on, which cpp passes on" $+ movesPositions [Cpp] "module M where\n# 9 \"O.hs\"\n"+ `shouldBe` True++ it "a #! line below the top where CPP is on, which cpp passes on" $+ movesPositions [Cpp] "module M where\n#!/bin/sh\n"+ `shouldBe` True+ describe "says nothing of" $ do for_' [ ("a module with no pragma at all", "module M where\nx = 1\n"),@@ -60,9 +86,29 @@ ), ( "one in a string after a name ending in a prime", "module M where\nx = f'\"'\"\ny = \"{-# LINE 1 #-}\"\n"- )+ ),+ ( "one in a quasi-quotation",+ "module M where\nx = [q|\n{-# LINE 1 \"O.hs\" #-}\n|]\n"+ ),+ ( "one in a qualified quasi-quotation",+ "module M where\nx = [Q.q|{-# LINE 1 \"O.hs\" #-}|]\n"+ ),+ ("the #! lines a script begins with", "#!/bin/sh\n#!x\n-- stack\n"),+ ( "lines GHC reads past, in a quasi-quotation",+ "module M where\nx = [q|\n# 9 \"O.hs\"\n#pragma once\n#!/bin/sh\n|]\n"+ ),+ ("a hash and a number in a block comment", "{-\n#15888 says\n-}\n"),+ ("a label opening an indented line", "module M where\nf = g\n #line\n") ]- (\source -> movesPositions source `shouldBe` False)+ (\source -> movesPositions [QuasiQuotes] source `shouldBe` False)++ it "a line marker where CPP is on, which cpp reads" $+ movesPositions [Cpp] "module M where\n#line 9 \"O.hs\"\n"+ `shouldBe` False++ it "a #pragma line where CPP is on, which cpp reads" $+ movesPositions [Cpp] "module M where\n#pragma once\n"+ `shouldBe` False describe "the extensions in force" $ do it "keeps what the package puts in force" $ inForceUnder [ImplicitPrelude, GADTs] "module M where\n"
tests/Tilia/RunSpec.hs view
@@ -6,7 +6,6 @@ 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)@@ -16,7 +15,8 @@ import GHC.Clock (getMonotonicTime) import System.Directory (getModificationTime) import System.FilePath ((</>))-import System.IO.Temp (withSystemTempDirectory)+import System.IO (Handle, IOMode (ReadWriteMode), withFile)+import System.IO.Temp (withSystemTempDirectory, withSystemTempFile) import Test.Hspec import Tilia.Cabal.Package (PackageProblem (..)) import Tilia.Cpp (CppError (..))@@ -28,9 +28,11 @@ Unknown (..), ) import Tilia.Format (FormatError (..), formatErrorExitCode, refused)-import Tilia.Palette (Color (Bad), Palette (..))+import Tilia.Palette (Color (Bad), Palette (..), paletteFor)+import Tilia.Parser (parseModule) import Tilia.Run-import Tilia.Utils (inParallel, lineWidth, visibleLength, wrapTo, writeUtf8File)+import Tilia.TestUtils (defaultParserConfig, withEnvironment, withFiles)+import Tilia.Utils (inParallel, lineWidth, visibleLength, wrapTo) spec :: Spec spec = do@@ -88,13 +90,14 @@ 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")])+ reportOut (inplaceReport Plain Plain [("A.hs", Unchanged), ("B.hs", Changed "a" "b")]) `shouldBe` " [✓] Formatted 2 .hs files\n" it "counts each extension on its own line, in a settled order" $ reportOut ( inplaceReport Plain+ Plain [("C.hsig", Unchanged), ("A.hs", Unchanged), ("B.hs-boot", Unchanged)] ) `shouldBe` T.unlines@@ -104,15 +107,15 @@ ] it "says file rather than files when there is one" $- reportOut (inplaceReport Plain [("A.hs", Unchanged)])+ reportOut (inplaceReport Plain Plain [("A.hs", Unchanged)]) `shouldBe` " [✓] Formatted 1 .hs file\n" it "counts neither a refusal nor a failure among the formatted" $- reportOut (inplaceReport Plain [("A.hs", Unchanged), ("B.hs", decline), ("C.hs", failure)])+ reportOut (inplaceReport Plain Plain [("A.hs", Unchanged), ("B.hs", decline), ("C.hs", failure)]) `shouldBe` " [✓] Formatted 1 .hs file\n" it "says nothing at all about a run with no files" $- inplaceReport Plain [] `shouldBe` Report "" []+ inplaceReport Plain Plain [] `shouldBe` Report "" [] describe "the files a run did not format" $ do let mixed =@@ -122,35 +125,44 @@ ] it "tallies refusals and failures apart, and puts refusals first" $- filter (T.isInfixOf "] ") (reportErr (inplaceReport Plain mixed))+ filter (T.isInfixOf "] ") (reportErr (inplaceReport Plain 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)))+ length (filter opensAReason (reportErr (inplaceReport Plain 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"))])+ (inplaceReport Plain 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)+ reportErr (inplaceReport Plain Plain mixed) `shouldSatisfy` any (T.isInfixOf "cannot read a.hs: no such file") + it "names a file once where one of its configurations does not parse" $+ case parseModule defaultParserConfig "A.hs" "x = (" of+ Right _ -> expectationFailure "x = ( parsed"+ Left e -> do+ let said = flattened (inplaceReport Plain Plain [("A.hs", Declined why)])+ why = CppUnsupported "A.hs" (ConfigurationNotParsed [] e)+ said `shouldSatisfy` T.isInfixOf "will not format A.hs:"+ T.count "A.hs" said `shouldBe` 1+ it "orders the reasons by file, not by arrival" $- reportErr (inplaceReport Plain mixed)- `shouldBe` reportErr (inplaceReport Plain (reverse mixed))+ reportErr (inplaceReport Plain Plain mixed)+ `shouldBe` reportErr (inplaceReport Plain Plain (reverse mixed)) it "opens every case with a bullet" $- filter opensAReason (reportErr (inplaceReport Plain mixed))+ filter opensAReason (reportErr (inplaceReport Plain 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 ")))])+ reportErr (inplaceReport Plain Plain [("A.hs", Failed (Unreadable "A.hs" (T.replicate 20 "and more words ")))]) `shouldSatisfy` \case (_tallyLine : opening : continuation : _) -> T.isPrefixOf " · " opening@@ -158,57 +170,58 @@ _ -> False it "lays an unsettled operator at the door of the run, not of the module" $- flattened (inplaceReport Plain [("A.hs", missing "Criterion.Main")])+ flattened (inplaceReport Plain 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"])])+ flattened (inplaceReport Plain 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"])])])+ (inplaceReport Plain 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")])+ flattened (inplaceReport Plain 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")])+ flattened (inplaceReport Plain 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")])+ flattened (inplaceReport Plain 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)])+ flattened (inplaceReport Plain 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 infixl 6 in Left but infixr 5 \ \in Right" it "names the imports that disagree and what each brings" $- flattened (inplaceReport Plain [("A.hs", about "<+>")])+ flattened (inplaceReport Plain Plain [("A.hs", about "<+>")]) `shouldSatisfy` T.isInfixOf "the fixity of <+> is infixl 6 in Left but infixr 5 in Right" it "gathers the imports that agree with one another" $- flattened (inplaceReport Plain [("A.hs", disagreeing (leftSix :| [rightFive, ("Middle", Fixity LeftAssoc 6)]))])+ flattened (inplaceReport Plain Plain [("A.hs", disagreeing (leftSix :| [rightFive, ("Middle", Fixity LeftAssoc 6)]))]) `shouldSatisfy` T.isInfixOf "is infixl 6 in Left and Middle but infixr 5 in Right" it "lists three fixities the way it lists three of anything" $- flattened (inplaceReport Plain [("A.hs", disagreeing (leftSix :| [rightFive, ("Third", Fixity NoAssoc 4)]))])+ flattened (inplaceReport Plain Plain [("A.hs", disagreeing (leftSix :| [rightFive, ("Third", Fixity NoAssoc 4)]))]) `shouldSatisfy` T.isInfixOf "is infixl 6 in Left, infixr 5 in Right, and infix 4 in Third" it "gives one disagreement once however many operators share it" $ flattened ( inplaceReport Plain+ Plain [ ( "A.hs", Declined ( UnknownFixity@@ -223,27 +236,27 @@ `shouldSatisfy` T.isInfixOf "the fixities of <|> and <+> are infixl 6 in Left but infixr 5 in Right" it "keeps all of it off the stream the summary goes to" $- reportOut (inplaceReport Plain mixed) `shouldBe` ""+ reportOut (inplaceReport Plain Plain mixed) `shouldBe` "" it "says the same about them in either command" $- reportErr (checkReport Plain mixed) `shouldBe` reportErr (inplaceReport Plain mixed)+ reportErr (checkReport Plain Plain mixed) `shouldBe` reportErr (inplaceReport Plain 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")])+ reportOut (checkReport Plain Plain [("A.hs", Changed "one\n" "two\n")]) `shouldSatisfy` T.isInfixOf "--- a/A.hs" it "heads it the way git heads one" $- reportOut (checkReport Plain [("A.hs", Changed "one\n" "two\n")])+ reportOut (checkReport Plain Plain [("A.hs", Changed "one\n" "two\n")]) `shouldSatisfy` T.isInfixOf "diff --git a/A.hs b/A.hs" it "shows the removal and the addition" $ do- let shown = reportOut (checkReport Plain [("A.hs", Changed "one\n" "two\n")])+ let shown = reportOut (checkReport Plain 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)])+ reportOut (checkReport Plain Plain [("A.hs", Unchanged), ("B.hs", decline), ("C.hs", failure)]) `shouldBe` "" describe "what a for-editor run prints" $ do@@ -268,54 +281,75 @@ describe "color" $ do it "leaves everything bare when there is nobody to see it" $- reportOut (inplaceReport Plain [("A.hs", Unchanged)])+ reportOut (inplaceReport Plain Plain [("A.hs", Unchanged)]) `shouldSatisfy` (not . T.isInfixOf "\ESC") it "colors the tick and not the brackets around it" $- reportOut (inplaceReport Colors [("A.hs", Unchanged)])+ reportOut (inplaceReport Colors Colors [("A.hs", Unchanged)]) `shouldSatisfy` T.isInfixOf "[\ESC[32m✓\ESC[0m]" it "colors the equals sign yellow" $- reportErr (inplaceReport Colors [("A.hs", decline)])+ reportErr (inplaceReport Colors 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)])+ reportOut (inplaceReport Colors Colors [("A.hs", Unchanged)]) `shouldSatisfy` 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")])+ reportErr (inplaceReport Colors 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")])+ reportErr (inplaceReport Plain 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 "<|>")])+ reportErr (inplaceReport Colors 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 ".")]))+ let shown = T.unlines (reportErr (inplaceReport Colors 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 "<|>")])+ reportErr (inplaceReport Plain 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")])+ reportErr (inplaceReport Colors 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")])+ reportErr (inplaceReport Colors 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)])+ reportErr (inplaceReport Colors Colors [("A.hs", failure)]) `shouldSatisfy` any (T.isInfixOf "[\ESC[31m✗\ESC[0m]") + it "colors each stream with a palette of its own" $ do+ let summary = inplaceReport Colors Plain [("A.hs", Unchanged), ("B.hs", decline)]+ diffs = checkReport Plain Colors [("A.hs", Changed "a\n" "b\n"), ("B.hs", decline)]+ reportOut summary `shouldSatisfy` T.isInfixOf "\ESC"+ reportErr summary `shouldSatisfy` all (not . T.isInfixOf "\ESC")+ reportOut diffs `shouldSatisfy` (not . T.isInfixOf "\ESC")+ reportErr diffs `shouldSatisfy` any (T.isInfixOf "\ESC")++ it "colors what goes to a terminal, and nothing else" $+ withEnvironment [("NO_COLOR", "")] . withTerminal $ \terminal ->+ withSystemTempFile "tilia-run" $ \_ file ->+ ((,) <$> paletteFor terminal <*> paletteFor file)+ `shouldReturn` (Colors, Plain)++ it "turns colors off for a NO_COLOR that is set, but not for an empty one" $+ withTerminal $ \terminal -> do+ withEnvironment [("NO_COLOR", "1")] (paletteFor terminal)+ `shouldReturn` Plain+ withEnvironment [("NO_COLOR", "")] (paletteFor terminal)+ `shouldReturn` Colors+ describe "breaking text to fit" $ do it "keeps every line within the room given" $ fmap T.length (wrapTo 20 (T.replicate 40 "word ")) `shouldSatisfy` all (<= 20)@@ -350,11 +384,11 @@ ("another/quite/deeply/nested/one/Module.hs", failure) ] it "never prints a line wider than it allows itself" $- fmap T.length (reportErr (inplaceReport Plain sprawling))+ fmap T.length (reportErr (inplaceReport Plain Plain sprawling)) `shouldSatisfy` all (<= lineWidth) it "does the same when the reason is enormous" $- fmap T.length (reportErr (inplaceReport Plain [("A.hs", Failed (Unreadable "A.hs" (T.replicate 40 "and more words ")))]))+ fmap T.length (reportErr (inplaceReport Plain 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" $@@ -374,10 +408,10 @@ 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" $+ it "says so when it is not there, without naming it again" $ withSystemTempDirectory "tilia-run" $ \directory ->- (isLeft <$> readAsUtf8 (directory </> "gone.hs"))- `shouldReturn` True+ readAsUtf8 (directory </> "gone.hs")+ `shouldReturn` Left "does not exist" it "hands over the line endings it found, rather than the platform's" $ withBytes "module A where\r\n" $ \path ->@@ -407,9 +441,9 @@ 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" $- 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 "shows the line whose ending would change in the diff" $+ reportOut (checkReport Plain Plain [("A.hs", formattingOutcome "a\r\nb\nc\r\n" "a\nb\nc\n")])+ `shouldSatisfy` T.isInfixOf "\n-b\n+b\r\n" 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")@@ -418,18 +452,18 @@ 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")+ _ <- 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")+ _ <- 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")+ _ <- 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" $@@ -441,6 +475,13 @@ it "leaves one it could not format alone" $ untouched failure + it "fails one it cannot write, and says why" $+ withSystemTempDirectory "tilia-run" $ \directory -> do+ let path = directory </> "gone" </> "A.hs"+ (_, outcome) <- writeBack (path, Changed "module A where\n" "x\n")+ flattened (inplaceReport Plain Plain [(path, outcome)])+ `shouldSatisfy` T.isInfixOf ("cannot write " <> T.pack path)+ 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]@@ -481,11 +522,7 @@ -- | 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"- writeUtf8File path contents- act path+withSource contents act = withFiles [("A.hs", contents)] (act . (</> "A.hs")) -- | The same, for a file that has to hold exactly these bytes. withBytes :: BS.ByteString -> (FilePath -> IO a) -> IO a@@ -501,13 +538,17 @@ Changed _ wouldBe -> Just wouldBe _ -> Nothing +-- | A terminal, the master side of a new pseudo-terminal.+withTerminal :: (Handle -> IO a) -> IO a+withTerminal = withFile "/dev/ptmx" ReadWriteMode+ -- | 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)+ _ <- writeBack (path, outcome) stampedAgain <- getModificationTime path stampedAgain `shouldBe` stamped T.readFile path `shouldReturn` "module A where\n"
tests/Tilia/TestUtils.hs view
@@ -54,7 +54,8 @@ doesDirectoryExist, listDirectory, )-import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.Environment (lookupEnv)+import System.Environment.Blank (setEnv, unsetEnv) import System.FilePath (takeBaseName, takeDirectory, takeExtension, (</>)) import System.IO (mkTextEncoding) import System.IO.Temp (withSystemTempDirectory)@@ -88,17 +89,18 @@ import Tilia.Source (comments) import Tilia.Utils (quietly, writeUtf8File) --- | Run something with the given variables set, and the environment as it--- was afterwards however it turns out.+-- | Run something with the given variables set, to empty values too, 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+ setEnv key value True pure (key, was)- restore = traverse_ (\(key, was) -> maybe (unsetEnv key) (setEnv key) was)+ restore = traverse_ $ \(key, was) ->+ maybe (unsetEnv key) (\value -> setEnv key value True) was -- | Run something on a new temporary directory, by its canonical path, -- holding these files at their paths in it.@@ -249,7 +251,7 @@ routedResolver :: [Route] -> BuildPlan -> IO Resolver routedResolver routes plan = do packageReader <- newPackageReader (plannedCompiler plan) []- newResolverVia (Do #useCache) routes packageReader plan+ newResolverVia (Do #useCache) routes packageReader "." plan -- | Split a module on its first outermost conditional, and on every other -- one written behind the same directives, wherever in the module it sits.
tests/Tilia/WithProjectPlan.hs view
@@ -82,7 +82,7 @@ absent <- filterM (fmap not . doesFileExist . snd) . filter (not . (`Set.member` unread) . ppName . fst)- =<< plannedTarballs noCache plan+ =<< plannedTarballs noCache "." plan unless (null absent) $ do putStrLn ("fetching the source of " <> show (length absent) <> " package(s)") refused <- filterM (fmap isNothing . fetch . fst) absent
tilia.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: tilia-version: 0.1.3.0+version: 0.1.4.0 license: BSD-3-Clause license-file: LICENSE.md author: Mark Karpov <markkarpov92@gmail.com>