packages feed

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 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>