diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## Tilia 0.0.1.0 + +* Initial release. diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,28 @@ +Copyright © 2026–present Mark Karpov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +* Neither the name Mark Karpov nor the names of contributors may be used to + endorse or promote products derived from this software without specific + prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, +EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,144 @@ +# Tilia + +Tilia is a formatter for Haskell source code. Its primary design choices +are: + +* Use `ghc-lib-parser` for parsing, thus achieving correct parsing at all + times. +* Let single vs multiline layout be influenced by the input. +* Admit no configuration. +* Ensure high-quality formatting of comments. +* Provide first-class support for CPP. +* Guarantee inference of operator fixity with absolute precision at all + times. + +## Getting started + +The two most useful (and only!) commands are `inplace` and `check`: + +```console +$ tilia inplace [COMPONENT] # format all files of COMPONENT in place +$ tilia check [COMPONENT] # check that all files of COMPONENT are formatted +``` + +`COMPONENT` may be omitted and in that case it defaults to `all`. To be +precise, the kind of component we are talking about is exactly Cabal's +notion of component: libraries, executables, test suites, and benchmarks. +For example, in the case of Tilia itself the valid choices are: + +* `all` +* `tilia`, the package, which means every component of it +* `lib:tilia` or `tilia:lib:tilia` +* `exe:tilia` or `tilia:exe:tilia` +* `test:tests` or `tilia:test:tests`, or just `tests` + +It may be surprising that we talk about components rather than individual +files. Well, formatting a Haskell module, fortunately or unfortunately, +depends on much more than the input text. It depends on things like +`default-extensions`, `default-language`, and, most importantly, the actual +dependencies, because that's where the fixities of the operators you use +come from. What all these things have in common is that they are properties +of the respective Cabal components your modules belong to. Therefore, it +makes sense to consider those components the unit of formatting rather than +individual files. + +Tilia respects Cabal projects as defined by `cabal.project` files. It finds +the project by starting at the working directory and walking upwards for a +`cabal.project` or a `.cabal` file. A `cabal.project` anywhere above wins +over a `.cabal` file that is nearer, so a package inside a multi-package +repository resolves to the repository. It is worth pointing out that a +package in the tree that the `packages` field does not name is not part of +the project and will not be visited. Within a package, a component's +`hs-source-dirs` say which files belong to it, and every `.hs`, `.hs-boot`, +and `.hsig` under them gets formatted. + +If there is no build plan yet, or it is older than the `.cabal` and +`cabal.project` files, or it says nothing about a component you asked for, +Tilia has Cabal solve it with `cabal build all --dry-run`. If the plan is +fine but some dependencies have been neither downloaded nor built, it +fetches them with `cabal build all --only-download`. These commands do not +build anything, and both are one-time costs, since Cabal's package cache is +shared between projects. So do not worry if the first run in a project +prints a few lines from Cabal before Tilia starts formatting. Later runs +check the plan with a read and a `stat` per package. + +Both of those calls also pass `--enable-tests` and `--enable-benchmarks`, +because test suites and benchmarks are components Tilia formats, but they +are often not enabled by default and that would be confusing. Where a +project will not solve with those flags, Tilia settles for what Cabal builds +by default, so you get a narrower plan rather than none. + +Finally, here are some other flags that may be of interest: + +* `--check-ast` performs an AST-equivalence check; +* `--check-idempotence` performs an idempotence check; +* `--debug-fixity` prints information that is useful for debugging + formatting of operator chains. + +## Formatting operator chains + +There is nothing you need to know about it or do to make it work. It will +just happen, no matter where your operators come from: Hackage, Nix, private +repos, or the modules of the project you are formatting. + +## Formatting CPP + +CPP is a first-class formattable object to Tilia. Any Haskell syntactically +enclosed in a conditional branch will format, and it does not even need to +be self-contained valid Haskell on its own, as long as every configuration +of the module is a valid Haskell module. + +## Development + +Enter the development shell by either running `direnv allow` or `nix +develop`. Once in the shell, the development is ordinary Cabal: + +```console +$ cabal build +$ cabal test +``` + +All tests are in one test suite and there are a fair number of them. On my +machine the full test suite passes in 140 seconds, but it may be different +for you, so isolating a subset of the test suite may be helpful: + +```console +$ cabal test --test-options='--match "Tilia.Fixity"' +``` + +The test suite will perform downloads the first time you run it and so it +will be a bit slower on that run. It needs various corpora, such as Hackage +packages and GHC's own test suite, which are not checked into this +repository. + +The Hackage corpus is exercised in order to ensure that every module +formats, that its AST is preserved, and that formatting it is idempotent. +The results are recorded in `corpora/hackage/hackage.manifest`. Next to it, +`hackage.report` explains the failing cases. The manifest and the report can +be updated like this: + +```console +$ TILIA_CORPUS_ACCEPT=1 cabal test +``` + +Finally, Tilia formats itself, so make sure to run this command before you +open a PR: + +```console +$ nix run .#format +``` + +## Contribution + +Issues, bugs, and questions may be reported in [the GitHub issue tracker for +this project][issue-tracker]. + +Pull requests are also welcome. + +[issue-tracker]: https://github.com/mrkkrp/tilia/issues + +## License + +Copyright © 2026–present Mark Karpov + +Distributed under the BSD 3-clause license. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,217 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Main (main) where + +import Control.Monad (when) +import Data.Choice (Choice, fromBool) +import Data.Foldable (traverse_) +import Data.Text (Text) +import Data.Text.IO qualified as T +import Data.Version (showVersion) +import GHC.IO.Encoding (TextEncoding (textEncodingName)) +import Options.Applicative +import Paths_tilia (version) +import System.Directory (makeRelativeToCurrentDirectory) +import System.Exit (ExitCode (..)) +import System.Exit qualified +import System.IO + ( Handle, + hFlush, + hGetEncoding, + hSetEncoding, + mkTextEncoding, + stderr, + stdout, + ) +import Tilia.Fixity.Debug (renderFixityNotes) +import Tilia.Format + ( FormatError, + describeFormatError, + fixityNotesOf, + formatErrorExitCode, + newSession, + ) +import Tilia.Palette (Color (Bad), Palette, paletteFor) +import Tilia.Parser (ghcLibParserVersion) +import Tilia.Project (findProjectRoot) +import Tilia.Run + ( Outcome, + Report (..), + checkReport, + differs, + exitCodeOf, + inplaceReport, + noted, + runOver, + writeBack, + ) +import Tilia.Target + ( Component, + Target, + componentInPlan, + componentsOfTarget, + describeTargetProblem, + filesOfComponents, + parseTarget, + ) +import Tilia.Utils (lineWidth, quietly) + +-- | The program's entry point. +main :: IO () +main = do + traverse_ transliterateUnprintable [stdout, stderr] + Opts {..} <- customExecParser (prefs (columns lineWidth)) optsParserInfo + palette <- paletteFor + target <- + either + (die usageExitCode palette) + pure + (maybe (parseTarget "all") parseTarget optTarget) + components <- componentsFor palette target + files <- + traverse makeRelativeToCurrentDirectory + =<< filesOfComponents components + session <- + newSession + "." + (componentInPlan <$> components) + optCheckAst + optCheckIdempotence + optDebugFixity + >>= either (dieFormatting palette) pure + outcomes <- runOver session files + fixityNotesOf session + >>= traverse_ (T.hPutStrLn stderr) . renderFixityNotes palette + case optMode of + Inplace -> do + traverse_ writeBack outcomes + printReport (inplaceReport palette outcomes) + Check -> printReport (checkReport palette outcomes) + exitWith optMode outcomes + +-- | Transliterate unprintable characters if the stream cannot handle them. +transliterateUnprintable :: Handle -> IO () +transliterateUnprintable h = + quietly () $ + hGetEncoding h >>= \case + Just encoding + | name <- textEncodingName encoding, + '/' `notElem` name -> + hSetEncoding h =<< mkTextEncoding (name <> "//TRANSLIT") + _ -> pure () + +-- | Exit the way the run turned out. +exitWith :: Mode -> [(FilePath, Outcome)] -> IO () +exitWith mode outcomes = case exitCodeOf outcomes of + Just code -> System.Exit.exitWith (ExitFailure code) + Nothing -> case mode of + Inplace -> pure () + Check -> when (any (differs . snd) outcomes) (System.Exit.exitWith (ExitFailure 1)) + +-- | Print a 'Report'. +printReport :: Report -> IO () +printReport report = do + traverse_ T.putStrLn (reportOut report) + hFlush stdout + traverse_ (T.hPutStrLn stderr) (reportErr report) + hFlush stderr + +-- | Every component the target asks for. +componentsFor :: Palette -> Target -> IO [Component] +componentsFor palette target = + findProjectRoot "." >>= \case + Nothing -> + die 2 palette "no cabal.project or .cabal file at or above the working directory" + Just root -> + componentsOfTarget root target >>= \case + Left problem -> die usageExitCode palette (describeTargetProblem problem) + Right components -> pure components + +-- | What @sysexits.h@ has called a usage error since 4.3BSD, and well clear +-- of the codes 'formatErrorExitCode' returns. +usageExitCode :: Int +usageExitCode = 64 + +-- | Give up, under the same mark a failed file wears. +die :: Int -> Palette -> Text -> IO a +die code palette why = do + traverse_ (T.hPutStrLn stderr) (noted palette ("✗", Bad) why) + System.Exit.exitWith (ExitFailure code) + +-- | Print out the 'FormatError' and exit. +dieFormatting :: Palette -> FormatError -> IO a +dieFormatting palette e = + die (formatErrorExitCode e) palette (describeFormatError palette e) + +---------------------------------------------------------------------------- +-- Command line options + +-- | What a run was asked to do. +data Mode = Inplace | Check + +-- | The options a run was given. +data Opts = Opts + { -- | The mode of operation. + optMode :: Mode, + -- | Which component to work on, if not all of them. + optTarget :: Maybe String, + -- | Whether to check AST equivalence. + optCheckAst :: Choice "checkAst", + -- | Whether to check idempotence. + optCheckIdempotence :: Choice "checkIdempotence", + -- | Whether to print debugging information about fixities. + optDebugFixity :: Choice "debugFixity" + } + +optsParserInfo :: ParserInfo Opts +optsParserInfo = + info (helper <*> versionOption <*> optsParser) . mconcat $ + [ fullDesc, + progDesc "Format Haskell source code", + header "tilia - a formatter for Haskell source code" + ] + where + versionOption = + infoOption + ("tilia " ++ showVersion version ++ "\nusing ghc-lib-parser " ++ ghcLibParserVersion) + (long "version" <> short 'v' <> help "Print version of the program") + +optsParser :: Parser Opts +optsParser = + hsubparser . mconcat $ + [ command "inplace" (info (parser Inplace) (progDesc "Format files, in place")), + command "check" (info (parser Check) (progDesc "Report what formatting would change, and fail if anything would")) + ] + where + parser mode = + Opts mode + <$> optional targetArgument + <*> checkAstSwitch + <*> checkIdempotenceSwitch + <*> debugFixitySwitch + checkAstSwitch = + fromBool + <$> (switch . mconcat) + [ long "check-ast", + help "Check AST equivalence" + ] + checkIdempotenceSwitch = + fromBool + <$> (switch . mconcat) + [ long "check-idempotence", + help "Check idempotence" + ] + debugFixitySwitch = + fromBool + <$> (switch . mconcat) + [ long "debug-fixity", + help "Print debugging information about fixities" + ] + targetArgument = + (strArgument . mconcat) + [ metavar "COMPONENT", + help "Component to format: all (the default) or a package/component name" + ] diff --git a/corpora/hackage/hackage.manifest b/corpora/hackage/hackage.manifest new file mode 100644 --- /dev/null +++ b/corpora/hackage/hackage.manifest @@ -0,0 +1,5208 @@ +# What each example of this corpus does today, one line each. +# Generated: run the test suite with TILIA_CORPUS_ACCEPT=1. +# See Tilia.Corpus.Manifest for what the outcomes mean, and the +# matching .report for why each example that is not `formatted` is +# not. + +formatted 8deb10445c00 Agda-2.8.0/src/agda-mode/Main.hs +formatted 4e93ad007cfb Agda-2.8.0/src/data/MAlonzo/src/MAlonzo/RTE.hs +formatted 4e3f28ed5e54 Agda-2.8.0/src/data/MAlonzo/src/MAlonzo/RTE/Float.hs +formatted 111f8e7154e9 Agda-2.8.0/src/full/Agda/Benchmarking.hs +formatted 8080793f0fa5 Agda-2.8.0/src/full/Agda/Compiler/Backend.hs +formatted 98789e7a7f39 Agda-2.8.0/src/full/Agda/Compiler/Backend/Base.hs +formatted b8be5cf3b8d8 Agda-2.8.0/src/full/Agda/Compiler/Builtin.hs +formatted ef45f44548b6 Agda-2.8.0/src/full/Agda/Compiler/CallCompiler.hs +formatted c83ed61f571c Agda-2.8.0/src/full/Agda/Compiler/Common.hs +formatted 591432260542 Agda-2.8.0/src/full/Agda/Compiler/JS/Compiler.hs +formatted ca0717d44b6a Agda-2.8.0/src/full/Agda/Compiler/JS/Pretty.hs +formatted f3ee347549c0 Agda-2.8.0/src/full/Agda/Compiler/JS/Substitution.hs +formatted bb8f414ff908 Agda-2.8.0/src/full/Agda/Compiler/JS/Syntax.hs +formatted 38a999dc0841 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Coerce.hs +formatted 724b18d39db9 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Compiler.hs +formatted a5e37499e9c4 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Encode.hs +formatted bf9e10f9443d Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/HaskellTypes.hs +formatted aa62f795f1b2 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Misc.hs +formatted 63bb8f6c7f1d Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Pragmas.hs +formatted 550643b1a281 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Pretty.hs +formatted 8431d6301172 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Primitives.hs +formatted d1a6c45e8549 Agda-2.8.0/src/full/Agda/Compiler/MAlonzo/Strict.hs +formatted 5024f9b4392b Agda-2.8.0/src/full/Agda/Compiler/ToTreeless.hs +formatted fcf0c3d029c1 Agda-2.8.0/src/full/Agda/Compiler/Treeless/AsPatterns.hs +formatted e4084ca4a00b Agda-2.8.0/src/full/Agda/Compiler/Treeless/Builtin.hs +formatted ce128b9cab5e Agda-2.8.0/src/full/Agda/Compiler/Treeless/Compare.hs +formatted f24d73001033 Agda-2.8.0/src/full/Agda/Compiler/Treeless/EliminateDefaults.hs +formatted ebfd63fc43ed Agda-2.8.0/src/full/Agda/Compiler/Treeless/EliminateLiteralPatterns.hs +formatted d11b630a3f26 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Erase.hs +formatted 4bf71aa72967 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Erase.hs-boot +formatted e3c866a3b262 Agda-2.8.0/src/full/Agda/Compiler/Treeless/GuardsToPrims.hs +formatted 861aba1dcf19 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Identity.hs +formatted 39d8ddd0447e Agda-2.8.0/src/full/Agda/Compiler/Treeless/NormalizeNames.hs +formatted 79a064f98a58 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Pretty.hs +formatted 9e9ffec9fb88 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Pretty.hs-boot +formatted cca1261b95c2 Agda-2.8.0/src/full/Agda/Compiler/Treeless/Simplify.hs +formatted 3750c8bfe53a Agda-2.8.0/src/full/Agda/Compiler/Treeless/Subst.hs +formatted e0117fa2b8cc Agda-2.8.0/src/full/Agda/Compiler/Treeless/Uncase.hs +formatted 185411c97f8d Agda-2.8.0/src/full/Agda/Compiler/Treeless/Unused.hs +formatted 3985ec175c5f Agda-2.8.0/src/full/Agda/ImpossibleTest.hs +formatted 2dd615d81e66 Agda-2.8.0/src/full/Agda/Interaction/AgdaTop.hs +formatted e41de99732fd Agda-2.8.0/src/full/Agda/Interaction/Base.hs +formatted e47314761701 Agda-2.8.0/src/full/Agda/Interaction/BasicOps.hs +formatted a799c433771a Agda-2.8.0/src/full/Agda/Interaction/BuildLibrary.hs +formatted eb4048782016 Agda-2.8.0/src/full/Agda/Interaction/Command.hs +formatted 27569f5bd988 Agda-2.8.0/src/full/Agda/Interaction/CommandLine.hs +formatted ab83a5beeab5 Agda-2.8.0/src/full/Agda/Interaction/EmacsCommand.hs +formatted 555155a56d86 Agda-2.8.0/src/full/Agda/Interaction/EmacsTop.hs +formatted 720e5305288c Agda-2.8.0/src/full/Agda/Interaction/ExitCode.hs +formatted 7691578538c0 Agda-2.8.0/src/full/Agda/Interaction/FindFile.hs +formatted 3170eb1921b4 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Common.hs +formatted 1fb0462a1b45 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Dot.hs +formatted 604a1fd2d42f Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Dot/Backend.hs +formatted fc10621b7e2c Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Dot/Base.hs +formatted 773365a6b3e4 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Emacs.hs +formatted ff75327912fc Agda-2.8.0/src/full/Agda/Interaction/Highlighting/FromAbstract.hs +formatted a8d4144bdde2 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Generate.hs +formatted 8bc140b18e62 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Generate.hs-boot +formatted 9a3fde618f2b Agda-2.8.0/src/full/Agda/Interaction/Highlighting/HTML.hs +formatted 99b5ef12d008 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/HTML/Backend.hs +formatted b17a80a34eff Agda-2.8.0/src/full/Agda/Interaction/Highlighting/HTML/Base.hs +formatted d36037cbeadf Agda-2.8.0/src/full/Agda/Interaction/Highlighting/JSON.hs +formatted b5bb035e43f1 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/LaTeX.hs +formatted 7f14d85b664e Agda-2.8.0/src/full/Agda/Interaction/Highlighting/LaTeX/Backend.hs +formatted dd1725a94427 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/LaTeX/Base.hs +formatted ab86c6631700 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Precise.hs +formatted 83c7932f742c Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Range.hs +formatted 0054edf8b9e6 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Vim.hs +formatted 767a9afa8f4b Agda-2.8.0/src/full/Agda/Interaction/Imports.hs +formatted 65e8798f3384 Agda-2.8.0/src/full/Agda/Interaction/Imports.hs-boot +formatted 3cfa9e2d2bbf Agda-2.8.0/src/full/Agda/Interaction/InteractionTop.hs +formatted 3424b7b23f57 Agda-2.8.0/src/full/Agda/Interaction/JSON.hs +formatted ee7c581ca624 Agda-2.8.0/src/full/Agda/Interaction/JSONTop.hs +formatted b1854ec69b1d Agda-2.8.0/src/full/Agda/Interaction/Library.hs +formatted d4a922d69a6c Agda-2.8.0/src/full/Agda/Interaction/Library/Base.hs +formatted 79e462154a68 Agda-2.8.0/src/full/Agda/Interaction/Library/Parse.hs +formatted 64d6fc3383fb Agda-2.8.0/src/full/Agda/Interaction/MakeCase.hs +formatted 555b4179be0a Agda-2.8.0/src/full/Agda/Interaction/Monad.hs +formatted c831a742f557 Agda-2.8.0/src/full/Agda/Interaction/Options.hs +formatted 828aef6a3731 Agda-2.8.0/src/full/Agda/Interaction/Options/Base.hs +formatted d1a377c4a707 Agda-2.8.0/src/full/Agda/Interaction/Options/Errors.hs +formatted e44ed789f5f9 Agda-2.8.0/src/full/Agda/Interaction/Options/HasOptions.hs +formatted 434d46226886 Agda-2.8.0/src/full/Agda/Interaction/Options/Help.hs +formatted 1241fd26a436 Agda-2.8.0/src/full/Agda/Interaction/Options/Lenses.hs +formatted 0cacf2e95f8d Agda-2.8.0/src/full/Agda/Interaction/Options/Types.hs +formatted 865f0c039c33 Agda-2.8.0/src/full/Agda/Interaction/Options/Warnings.hs +formatted 11f05a0591fc Agda-2.8.0/src/full/Agda/Interaction/Output.hs +formatted 772e302dedad Agda-2.8.0/src/full/Agda/Interaction/Response.hs +formatted 77cf584c94f3 Agda-2.8.0/src/full/Agda/Interaction/Response/Base.hs +formatted 150002ef2df6 Agda-2.8.0/src/full/Agda/Interaction/SearchAbout.hs +declined - Agda-2.8.0/src/full/Agda/Main.hs +formatted b3fbe2c6389d Agda-2.8.0/src/full/Agda/Mimer/Mimer.hs +formatted 5ee8e2854fd8 Agda-2.8.0/src/full/Agda/Mimer/Options.hs +formatted 4513e6faa1f1 Agda-2.8.0/src/full/Agda/Syntax/Abstract.hs +formatted ed5b0f0a1630 Agda-2.8.0/src/full/Agda/Syntax/Abstract/Name.hs +formatted 992febb98ad9 Agda-2.8.0/src/full/Agda/Syntax/Abstract/Pattern.hs +formatted 8f9f098701be Agda-2.8.0/src/full/Agda/Syntax/Abstract/PatternSynonyms.hs +formatted 3f1f9a03363a Agda-2.8.0/src/full/Agda/Syntax/Abstract/Pretty.hs +formatted 4fdca8ef893f Agda-2.8.0/src/full/Agda/Syntax/Abstract/UsedNames.hs +formatted 120c37e72495 Agda-2.8.0/src/full/Agda/Syntax/Abstract/Views.hs +formatted 4860938107fe Agda-2.8.0/src/full/Agda/Syntax/Builtin.hs +formatted b915aac0abef Agda-2.8.0/src/full/Agda/Syntax/Common.hs +formatted e4fbe59bf094 Agda-2.8.0/src/full/Agda/Syntax/Common/Aspect.hs +formatted 25d40d92c083 Agda-2.8.0/src/full/Agda/Syntax/Common/KeywordRange.hs +formatted bddb87a288f9 Agda-2.8.0/src/full/Agda/Syntax/Common/Pretty.hs +formatted 0b01caf3aafb Agda-2.8.0/src/full/Agda/Syntax/Common/Pretty/ANSI.hs +formatted 6dfde2d67e3b Agda-2.8.0/src/full/Agda/Syntax/Concrete.hs +formatted 00ae9aed3826 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Attribute.hs +formatted 775eefd66300 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Definitions.hs +formatted ac99ea65d8d0 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Definitions/Errors.hs +formatted 3383d8244565 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Definitions/Monad.hs +formatted 0c9352e12d50 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Definitions/Types.hs +formatted 5104de9d5636 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Fixity.hs +formatted 2ef3d6e9d84d Agda-2.8.0/src/full/Agda/Syntax/Concrete/Generic.hs +formatted 6a2db093db8c Agda-2.8.0/src/full/Agda/Syntax/Concrete/Glyph.hs +formatted e23bf915bdc1 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Name.hs +formatted c075c7cb4c0b Agda-2.8.0/src/full/Agda/Syntax/Concrete/Operators.hs +formatted 332b0602c260 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Operators/Parser.hs +formatted d052bdb98637 Agda-2.8.0/src/full/Agda/Syntax/Concrete/Operators/Parser/Monad.hs +formatted ab5dcacbdf6e Agda-2.8.0/src/full/Agda/Syntax/Concrete/Pattern.hs +formatted 3a81fcfb623a Agda-2.8.0/src/full/Agda/Syntax/Concrete/Pretty.hs +formatted a4b545b06abe Agda-2.8.0/src/full/Agda/Syntax/DoNotation.hs +formatted 232b18d60ee2 Agda-2.8.0/src/full/Agda/Syntax/Fixity.hs +formatted cfd07520b531 Agda-2.8.0/src/full/Agda/Syntax/IdiomBrackets.hs +formatted 79409485ed3e Agda-2.8.0/src/full/Agda/Syntax/Info.hs +formatted f69fe6ede869 Agda-2.8.0/src/full/Agda/Syntax/Internal.hs +formatted 0e29f775f790 Agda-2.8.0/src/full/Agda/Syntax/Internal/Blockers.hs +formatted 8a379f39a418 Agda-2.8.0/src/full/Agda/Syntax/Internal/Defs.hs +formatted 150656090085 Agda-2.8.0/src/full/Agda/Syntax/Internal/Elim.hs +formatted 16f733f04829 Agda-2.8.0/src/full/Agda/Syntax/Internal/Generic.hs +formatted 05c9219e868e Agda-2.8.0/src/full/Agda/Syntax/Internal/MetaVars.hs +formatted 7d2cf90ab69b Agda-2.8.0/src/full/Agda/Syntax/Internal/Names.hs +formatted 3bb3112a21db Agda-2.8.0/src/full/Agda/Syntax/Internal/Pattern.hs +formatted 4f0688215ae9 Agda-2.8.0/src/full/Agda/Syntax/Internal/SanityCheck.hs +formatted dc9c871223a7 Agda-2.8.0/src/full/Agda/Syntax/Internal/Univ.hs +formatted 5c12e7741878 Agda-2.8.0/src/full/Agda/Syntax/Literal.hs +formatted 912aaf4945c5 Agda-2.8.0/src/full/Agda/Syntax/Notation.hs +formatted d38be9906bda Agda-2.8.0/src/full/Agda/Syntax/Parser.hs +formatted bbd0148c6f3c Agda-2.8.0/src/full/Agda/Syntax/Parser/Alex.hs +formatted 040f0691743c Agda-2.8.0/src/full/Agda/Syntax/Parser/Comments.hs +formatted aa98a9c8fab8 Agda-2.8.0/src/full/Agda/Syntax/Parser/Helpers.hs +formatted 962b19f0478d Agda-2.8.0/src/full/Agda/Syntax/Parser/Layout.hs +formatted 700549be6fd6 Agda-2.8.0/src/full/Agda/Syntax/Parser/Layout.hs-boot +formatted aa496d556481 Agda-2.8.0/src/full/Agda/Syntax/Parser/LexActions.hs +formatted a5d57cb1b6b9 Agda-2.8.0/src/full/Agda/Syntax/Parser/LexActions.hs-boot +formatted 8bcd7e473217 Agda-2.8.0/src/full/Agda/Syntax/Parser/Literate.hs +formatted bd9441d27edb Agda-2.8.0/src/full/Agda/Syntax/Parser/LookAhead.hs +formatted 988b42cfcde3 Agda-2.8.0/src/full/Agda/Syntax/Parser/Monad.hs +formatted 6b041886ce39 Agda-2.8.0/src/full/Agda/Syntax/Parser/StringLiterals.hs +formatted 2c4b958b94a9 Agda-2.8.0/src/full/Agda/Syntax/Parser/Tokens.hs +formatted aa9d78064d47 Agda-2.8.0/src/full/Agda/Syntax/Position.hs +formatted d16539c2a462 Agda-2.8.0/src/full/Agda/Syntax/Position.hs-boot +formatted b1dd8bfd3111 Agda-2.8.0/src/full/Agda/Syntax/Reflected.hs +formatted bb9a2f130d18 Agda-2.8.0/src/full/Agda/Syntax/Scope/Base.hs +formatted 6ff9f287871d Agda-2.8.0/src/full/Agda/Syntax/Scope/Flat.hs +formatted 3f7e4d1c297e Agda-2.8.0/src/full/Agda/Syntax/Scope/Monad.hs +formatted 5751db976d34 Agda-2.8.0/src/full/Agda/Syntax/TopLevelModuleName.hs +formatted ac2fc82ba8a4 Agda-2.8.0/src/full/Agda/Syntax/TopLevelModuleName/Boot.hs +formatted 09f51b9e33b1 Agda-2.8.0/src/full/Agda/Syntax/Translation/AbstractToConcrete.hs +formatted c0d33e44c05c Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs +formatted 4db4a0bb2579 Agda-2.8.0/src/full/Agda/Syntax/Translation/InternalToAbstract.hs +formatted 4c1a1033f8d5 Agda-2.8.0/src/full/Agda/Syntax/Translation/ReflectedToAbstract.hs +formatted 2ae972608fb0 Agda-2.8.0/src/full/Agda/Syntax/Treeless.hs +formatted 25f21c7793f4 Agda-2.8.0/src/full/Agda/Termination/CallGraph.hs +formatted fec59f499d06 Agda-2.8.0/src/full/Agda/Termination/CallMatrix.hs +formatted ebc4ce14c917 Agda-2.8.0/src/full/Agda/Termination/CutOff.hs +formatted 7978d5a44013 Agda-2.8.0/src/full/Agda/Termination/Monad.hs +formatted 9436ec427f9a Agda-2.8.0/src/full/Agda/Termination/Order.hs +formatted 0f8827158a99 Agda-2.8.0/src/full/Agda/Termination/RecCheck.hs +formatted b6a7543ba3d1 Agda-2.8.0/src/full/Agda/Termination/Semiring.hs +formatted 2978d402a77e Agda-2.8.0/src/full/Agda/Termination/SparseMatrix.hs +formatted 8fdc334dfc0f Agda-2.8.0/src/full/Agda/Termination/TermCheck.hs +formatted ed0ea780ef94 Agda-2.8.0/src/full/Agda/Termination/Termination.hs +formatted 9ce4d907acfa Agda-2.8.0/src/full/Agda/TheTypeChecker.hs +formatted 697581af4578 Agda-2.8.0/src/full/Agda/TypeChecking/Abstract.hs +formatted 7066ed85a0fa Agda-2.8.0/src/full/Agda/TypeChecking/CheckInternal.hs +formatted 2d6bbce1312f Agda-2.8.0/src/full/Agda/TypeChecking/CheckInternal.hs-boot +formatted e158edb02d76 Agda-2.8.0/src/full/Agda/TypeChecking/CompiledClause.hs +formatted e807c1d8a459 Agda-2.8.0/src/full/Agda/TypeChecking/CompiledClause/Compile.hs +formatted 6b8cf4277b16 Agda-2.8.0/src/full/Agda/TypeChecking/CompiledClause/Compile.hs-boot +formatted a51bcd9a85c8 Agda-2.8.0/src/full/Agda/TypeChecking/CompiledClause/Match.hs +formatted 3142e5d8c639 Agda-2.8.0/src/full/Agda/TypeChecking/CompiledClause/Match.hs-boot +formatted 1c45f74cdbf6 Agda-2.8.0/src/full/Agda/TypeChecking/Constraints.hs +formatted 47ac61419563 Agda-2.8.0/src/full/Agda/TypeChecking/Constraints.hs-boot +broken 1b7f9f60a42c Agda-2.8.0/src/full/Agda/TypeChecking/Conversion.hs +formatted cc3a6f5cf005 Agda-2.8.0/src/full/Agda/TypeChecking/Conversion.hs-boot +formatted 330bf1da7807 Agda-2.8.0/src/full/Agda/TypeChecking/Conversion/Pure.hs +formatted 4967e1b8d4f6 Agda-2.8.0/src/full/Agda/TypeChecking/Coverage.hs +formatted 2269cd66c46c Agda-2.8.0/src/full/Agda/TypeChecking/Coverage/Cubical.hs +formatted 12c1a3918395 Agda-2.8.0/src/full/Agda/TypeChecking/Coverage/Match.hs +formatted 66752ed436cd Agda-2.8.0/src/full/Agda/TypeChecking/Coverage/SplitClause.hs +formatted 860fb8b6d684 Agda-2.8.0/src/full/Agda/TypeChecking/Coverage/SplitTree.hs +formatted e11eb64dcee6 Agda-2.8.0/src/full/Agda/TypeChecking/Datatypes.hs +formatted bf771aa7c583 Agda-2.8.0/src/full/Agda/TypeChecking/Datatypes.hs-boot +formatted d195809b35f2 Agda-2.8.0/src/full/Agda/TypeChecking/DeadCode.hs +formatted bb854a3c2b16 Agda-2.8.0/src/full/Agda/TypeChecking/DiscrimTree.hs +formatted c17cb27af1b5 Agda-2.8.0/src/full/Agda/TypeChecking/DiscrimTree/Types.hs +formatted fbe3a0be6a73 Agda-2.8.0/src/full/Agda/TypeChecking/DisplayForm.hs +formatted db46b8c74ecf Agda-2.8.0/src/full/Agda/TypeChecking/DropArgs.hs +formatted a7d18b90b5cb Agda-2.8.0/src/full/Agda/TypeChecking/Empty.hs +formatted 546e2690c8bd Agda-2.8.0/src/full/Agda/TypeChecking/Empty.hs-boot +formatted c3bb228c6556 Agda-2.8.0/src/full/Agda/TypeChecking/Errors.hs +formatted 4d637dbd29d8 Agda-2.8.0/src/full/Agda/TypeChecking/Errors.hs-boot +formatted 3fd276903525 Agda-2.8.0/src/full/Agda/TypeChecking/Errors/Names.hs +formatted 56b2daf135cc Agda-2.8.0/src/full/Agda/TypeChecking/EtaContract.hs +formatted 0b5e5500c9e6 Agda-2.8.0/src/full/Agda/TypeChecking/Forcing.hs +formatted 91ec1972ef50 Agda-2.8.0/src/full/Agda/TypeChecking/Free.hs +formatted b17e10ebb4bf Agda-2.8.0/src/full/Agda/TypeChecking/Free/Lazy.hs +formatted f5cc2aa53ce3 Agda-2.8.0/src/full/Agda/TypeChecking/Free/Precompute.hs +formatted 4652dff8fa52 Agda-2.8.0/src/full/Agda/TypeChecking/Free/Reduce.hs +formatted dda08728d05b Agda-2.8.0/src/full/Agda/TypeChecking/Functions.hs +formatted a2822b4bbb2a Agda-2.8.0/src/full/Agda/TypeChecking/Generalize.hs +formatted 170ae60a3b34 Agda-2.8.0/src/full/Agda/TypeChecking/IApplyConfluence.hs +formatted d2bedae2afec Agda-2.8.0/src/full/Agda/TypeChecking/Implicit.hs +formatted 5230555cc911 Agda-2.8.0/src/full/Agda/TypeChecking/Injectivity.hs +formatted 765027ab5536 Agda-2.8.0/src/full/Agda/TypeChecking/Inlining.hs +formatted f69b901c92d1 Agda-2.8.0/src/full/Agda/TypeChecking/InstanceArguments.hs +formatted daede539773d Agda-2.8.0/src/full/Agda/TypeChecking/InstanceArguments.hs-boot +formatted bc076aa1fdbe Agda-2.8.0/src/full/Agda/TypeChecking/Irrelevance.hs +formatted f5e2359204d8 Agda-2.8.0/src/full/Agda/TypeChecking/Irrelevance.hs-boot +formatted 3809c256f1bf Agda-2.8.0/src/full/Agda/TypeChecking/Level.hs +formatted 4df75f041db4 Agda-2.8.0/src/full/Agda/TypeChecking/Level.hs-boot +formatted 43902630fee9 Agda-2.8.0/src/full/Agda/TypeChecking/Level/Solve.hs +formatted ae0893a4561e Agda-2.8.0/src/full/Agda/TypeChecking/LevelConstraints.hs +formatted c4a1b0f2708c Agda-2.8.0/src/full/Agda/TypeChecking/Lock.hs +formatted 00b8f5e75aa7 Agda-2.8.0/src/full/Agda/TypeChecking/Lock.hs-boot +formatted 4d870d6be892 Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars.hs +formatted 52101179c5b2 Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars.hs-boot +formatted 7e2cc6c3656a Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars/Mention.hs +formatted b8142e719029 Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars/Occurs.hs +formatted a4be1ca0bbf7 Agda-2.8.0/src/full/Agda/TypeChecking/Modalities.hs +formatted 1fd16a038ff2 Agda-2.8.0/src/full/Agda/TypeChecking/Monad.hs +formatted 8628aa83fca2 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Base.hs +formatted d349fd5d15cf Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Base/Types.hs +formatted 7860b2253820 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Base/Warning.hs +formatted 56ab8bfd7ea3 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Benchmark.hs +formatted 6bd9d4f5cc91 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Builtin.hs +formatted 6b2e93e4eef0 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Builtin.hs-boot +formatted a608a81b85da Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Caching.hs +formatted f7eb389a97e5 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Closure.hs +formatted ecdbeb5fb96a Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Constraints.hs +formatted fb8152beded7 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Context.hs +formatted aa421afb353b Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Context.hs-boot +formatted 25a69fe0b2e6 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Debug.hs +formatted 07c8440dbd10 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Debug.hs-boot +formatted e171cc504b07 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Env.hs +formatted 80aecb84d70e Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Imports.hs +formatted 1f2b7f206ac5 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/MetaVars.hs +formatted 894d39f81e58 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/MetaVars.hs-boot +formatted 5d9486ab6943 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Modality.hs +formatted 219de79701c4 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Mutual.hs +formatted 8fe6e5c381d6 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Open.hs +formatted 4e4d159df7b7 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Options.hs +formatted 2b144a9f6ada Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Options.hs-boot +formatted a266ccade893 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Pure.hs +formatted f549f9160d1c Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Pure.hs-boot +formatted 651849abb47d Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Signature.hs +formatted a5b44843ae0b Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Signature.hs-boot +formatted 69d2cf4b28ec Agda-2.8.0/src/full/Agda/TypeChecking/Monad/SizedTypes.hs +formatted 011c35706d91 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/State.hs +formatted 63e1167a5c2e Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Statistics.hs +formatted 9aa1d0aad9a7 Agda-2.8.0/src/full/Agda/TypeChecking/Monad/Trace.hs +formatted 9e2717f40129 Agda-2.8.0/src/full/Agda/TypeChecking/Names.hs +formatted 519f4d3abcf4 Agda-2.8.0/src/full/Agda/TypeChecking/Opacity.hs +formatted d26ddecf1923 Agda-2.8.0/src/full/Agda/TypeChecking/Opacity.hs-boot +formatted ec77f6d2c4ee Agda-2.8.0/src/full/Agda/TypeChecking/Patterns/Abstract.hs +formatted 0f6e0c168a7c Agda-2.8.0/src/full/Agda/TypeChecking/Patterns/Internal.hs +formatted 9e7f1b1cf5e9 Agda-2.8.0/src/full/Agda/TypeChecking/Patterns/Match.hs +formatted 5ee7033010bf Agda-2.8.0/src/full/Agda/TypeChecking/Patterns/Match.hs-boot +formatted 262f6816a482 Agda-2.8.0/src/full/Agda/TypeChecking/Polarity.hs +formatted 2f5659c12840 Agda-2.8.0/src/full/Agda/TypeChecking/Polarity.hs-boot +formatted 7503757a37fb Agda-2.8.0/src/full/Agda/TypeChecking/Positivity.hs +formatted 5626959a260d Agda-2.8.0/src/full/Agda/TypeChecking/Positivity/Occurrence.hs +formatted 850bea97b290 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty.hs +formatted 8bd6edac6240 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty.hs-boot +formatted f13c4b57eaf1 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Call.hs +formatted f5434869778b Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Call.hs-boot +formatted c54ae0776ac3 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Constraint.hs +formatted 4c2edd49d675 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Constraint.hs-boot +formatted 5734afd5c29b Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Warning.hs +formatted bf4e737ce041 Agda-2.8.0/src/full/Agda/TypeChecking/Pretty/Warning.hs-boot +formatted de8c83eec1d4 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive.hs +formatted 3c8fe98419dd Agda-2.8.0/src/full/Agda/TypeChecking/Primitive.hs-boot +formatted 92564f8a667c Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Base.hs +formatted df2301069d40 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Cubical.hs +formatted 2825417cf284 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Cubical/Base.hs +formatted 34da472277ef Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Cubical/Base.hs-boot +formatted 4aec12c8b204 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Cubical/Glue.hs +formatted 4056250b5173 Agda-2.8.0/src/full/Agda/TypeChecking/Primitive/Cubical/HCompU.hs +formatted dbe29e9e0df8 Agda-2.8.0/src/full/Agda/TypeChecking/ProjectionLike.hs +formatted 21d019305ce5 Agda-2.8.0/src/full/Agda/TypeChecking/ProjectionLike.hs-boot +formatted 0442d4c1571a Agda-2.8.0/src/full/Agda/TypeChecking/Quote.hs +formatted 185176614b3d Agda-2.8.0/src/full/Agda/TypeChecking/ReconstructParameters.hs +formatted 649031626628 Agda-2.8.0/src/full/Agda/TypeChecking/RecordPatterns.hs +formatted 7b9818f0d07e Agda-2.8.0/src/full/Agda/TypeChecking/Records.hs +formatted 65b1d93597cd Agda-2.8.0/src/full/Agda/TypeChecking/Records.hs-boot +formatted 9000008643a3 Agda-2.8.0/src/full/Agda/TypeChecking/Reduce.hs +formatted 82cb10489996 Agda-2.8.0/src/full/Agda/TypeChecking/Reduce.hs-boot +formatted e69843d8012c Agda-2.8.0/src/full/Agda/TypeChecking/Reduce/Fast.hs +formatted 2158647025d5 Agda-2.8.0/src/full/Agda/TypeChecking/Reduce/Fast.hs-boot +formatted 52ceaeb66838 Agda-2.8.0/src/full/Agda/TypeChecking/Reduce/Monad.hs +formatted 88bd74e33b27 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting.hs +formatted 0158a552c77f Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting.hs-boot +formatted 682e7693d697 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/Clause.hs +formatted 0259fd79bf81 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/Confluence.hs +formatted e8d5ebd74ed8 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/NonLinMatch.hs +formatted 996477d19b29 Agda-2.8.0/src/full/Agda/TypeChecking/Rewriting/NonLinPattern.hs +formatted a6c2b94986a3 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Application.hs +formatted 8094c6b9ca8d Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Application.hs-boot +formatted dbb4bda7bd40 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Builtin.hs +formatted 6100823529c1 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Builtin/Coinduction.hs +formatted 48f627566132 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Builtin/Coinduction.hs-boot +formatted d760db0d3bfa Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Data.hs +formatted 89ea7a6db701 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Data.hs-boot +formatted e7ba6af78bdb Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Decl.hs +formatted c3dda6e649e5 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Decl.hs-boot +formatted d9c53c2db40c Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Def.hs +formatted aa2e722e924d Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Def.hs-boot +formatted cf342aa0175d Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Display.hs +formatted 69ec6b99fd75 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS.hs +formatted 199f73f82f56 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/Implicit.hs +formatted 11b826b41073 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/Problem.hs +formatted c5e217446f2f Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/ProblemRest.hs +formatted 30ba5ebd5abd Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/Unify.hs +formatted c06cebdc5744 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/Unify/LeftInverse.hs +formatted 8db95ca4d472 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/LHS/Unify/Types.hs +formatted de67f3e2b3e6 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Record.hs +formatted 3cb29243d1ce Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Term.hs +formatted ccd5b1bd7f62 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Term.hs-boot +formatted 14e895036162 Agda-2.8.0/src/full/Agda/TypeChecking/Serialise.hs +formatted 7e6c6a48b26a Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Base.hs +formatted 0b03fe8ecc8f Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances.hs +formatted 01a9d48b433f Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Abstract.hs +formatted 5e11ce5ca675 Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Common.hs +formatted d11e2e781bb4 Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Compilers.hs +formatted 8047289f42cb Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Errors.hs +formatted abbb853d7207 Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Highlighting.hs +formatted 93eed7f54faa Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Internal.hs +formatted 1a6e0ff617b0 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes.hs +formatted c502702d4646 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/Pretty.hs +formatted 7bbcf170102a Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/Solve.hs +formatted 5e69f4b9b310 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/Syntax.hs +formatted 904a4e241e74 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/Utils.hs +formatted 342d213dbae3 Agda-2.8.0/src/full/Agda/TypeChecking/SizedTypes/WarshallSolver.hs +formatted 8b1a445ba3fc Agda-2.8.0/src/full/Agda/TypeChecking/Sort.hs +formatted 082efa258eb6 Agda-2.8.0/src/full/Agda/TypeChecking/Substitute.hs +formatted c975b7162ab1 Agda-2.8.0/src/full/Agda/TypeChecking/Substitute/Class.hs +formatted 2656f0d28fba Agda-2.8.0/src/full/Agda/TypeChecking/Substitute/DeBruijn.hs +formatted 639f3a17346d Agda-2.8.0/src/full/Agda/TypeChecking/SyntacticEquality.hs +formatted abeda68a8419 Agda-2.8.0/src/full/Agda/TypeChecking/Telescope.hs +formatted d94c0d202dfc Agda-2.8.0/src/full/Agda/TypeChecking/Telescope.hs-boot +formatted cea913d9b4f5 Agda-2.8.0/src/full/Agda/TypeChecking/Telescope/Path.hs +formatted eb5313ed3eb3 Agda-2.8.0/src/full/Agda/TypeChecking/Unquote.hs +formatted ceb3878e054e Agda-2.8.0/src/full/Agda/TypeChecking/Warnings.hs +formatted 0a8e5e5ab7e5 Agda-2.8.0/src/full/Agda/TypeChecking/With.hs +formatted b02f16e6d20a Agda-2.8.0/src/full/Agda/Utils/AffineHole.hs +formatted ae5ced9ae20f Agda-2.8.0/src/full/Agda/Utils/Applicative.hs +formatted 7fe48d6127fe Agda-2.8.0/src/full/Agda/Utils/AssocList.hs +formatted 72df986a37f7 Agda-2.8.0/src/full/Agda/Utils/Bag.hs +formatted 05b1c7f71baf Agda-2.8.0/src/full/Agda/Utils/Benchmark.hs +formatted 19e137bd74e4 Agda-2.8.0/src/full/Agda/Utils/BiMap.hs +formatted 09925de009a1 Agda-2.8.0/src/full/Agda/Utils/BoolSet.hs +formatted 7f37f70bbf2b Agda-2.8.0/src/full/Agda/Utils/Boolean.hs +formatted 880aa8847616 Agda-2.8.0/src/full/Agda/Utils/CallStack.hs +formatted c579014a9dbd Agda-2.8.0/src/full/Agda/Utils/CallStack/Base.hs +formatted 486c936e1b1e Agda-2.8.0/src/full/Agda/Utils/CallStack/Pretty.hs +formatted eeedf1a4e3da Agda-2.8.0/src/full/Agda/Utils/Char.hs +formatted 2b8eb290abc6 Agda-2.8.0/src/full/Agda/Utils/Cluster.hs +formatted b2757fa5ae2f Agda-2.8.0/src/full/Agda/Utils/Either.hs +formatted 5c0f9924f59f Agda-2.8.0/src/full/Agda/Utils/Empty.hs +formatted 284145f1db7f Agda-2.8.0/src/full/Agda/Utils/Environment.hs +formatted 822c68a5ddb8 Agda-2.8.0/src/full/Agda/Utils/Fail.hs +formatted aa59492cb884 Agda-2.8.0/src/full/Agda/Utils/Favorites.hs +formatted 9990de329253 Agda-2.8.0/src/full/Agda/Utils/FileId.hs +formatted 6b83a7abbe9a Agda-2.8.0/src/full/Agda/Utils/FileName.hs +formatted e5f5fbd21c99 Agda-2.8.0/src/full/Agda/Utils/Float.hs +formatted bb823613272f Agda-2.8.0/src/full/Agda/Utils/Function.hs +formatted 75a5028a6b1a Agda-2.8.0/src/full/Agda/Utils/Functor.hs +formatted 026b04b8661e Agda-2.8.0/src/full/Agda/Utils/GetOpt.hs +formatted a7c248d266b0 Agda-2.8.0/src/full/Agda/Utils/Graph/AdjacencyMap/Unidirectional.hs +formatted 989ea83c378b Agda-2.8.0/src/full/Agda/Utils/Graph/TopSort.hs +formatted db38367e7a17 Agda-2.8.0/src/full/Agda/Utils/Hash.hs +formatted 43284ef7124c Agda-2.8.0/src/full/Agda/Utils/HashTable.hs +formatted 019e9637b9b0 Agda-2.8.0/src/full/Agda/Utils/Haskell/Syntax.hs +formatted 7802531cbbc5 Agda-2.8.0/src/full/Agda/Utils/IArray.hs +formatted 8d53e1639c43 Agda-2.8.0/src/full/Agda/Utils/IO.hs +formatted ddd200e851ab Agda-2.8.0/src/full/Agda/Utils/IO/Binary.hs +formatted c62ffb044eae Agda-2.8.0/src/full/Agda/Utils/IO/Directory.hs +formatted 44ca6943bebd Agda-2.8.0/src/full/Agda/Utils/IO/TempFile.hs +formatted 51a9c4ed68e8 Agda-2.8.0/src/full/Agda/Utils/IO/UTF8.hs +formatted d938f94198a6 Agda-2.8.0/src/full/Agda/Utils/IORef.hs +formatted 695329a3bad9 Agda-2.8.0/src/full/Agda/Utils/Impossible.hs +formatted e5520ad27268 Agda-2.8.0/src/full/Agda/Utils/IndexedList.hs +formatted faa55c2f1ad1 Agda-2.8.0/src/full/Agda/Utils/IntSet/Infinite.hs +formatted 37f9f2b34f7d Agda-2.8.0/src/full/Agda/Utils/Lens.hs +formatted 7cc1db9fff98 Agda-2.8.0/src/full/Agda/Utils/Lens/Examples.hs +formatted ef65f125c3b1 Agda-2.8.0/src/full/Agda/Utils/List.hs +formatted 8392227e3997 Agda-2.8.0/src/full/Agda/Utils/List1.hs +formatted 3bd635eb52aa Agda-2.8.0/src/full/Agda/Utils/List1.hs-boot +formatted 3514de48df05 Agda-2.8.0/src/full/Agda/Utils/List2.hs +formatted e460a45d4f65 Agda-2.8.0/src/full/Agda/Utils/ListT.hs +formatted 960b2b6f10d7 Agda-2.8.0/src/full/Agda/Utils/Map.hs +formatted 8c9045bc776a Agda-2.8.0/src/full/Agda/Utils/Map1.hs +formatted 6e06ef12a477 Agda-2.8.0/src/full/Agda/Utils/Maybe.hs +formatted f52b8f698d5f Agda-2.8.0/src/full/Agda/Utils/Maybe/Strict.hs +formatted fde8defcff6d Agda-2.8.0/src/full/Agda/Utils/Memo.hs +formatted df3a8985dc8e Agda-2.8.0/src/full/Agda/Utils/Monad.hs +formatted dd3cac49f886 Agda-2.8.0/src/full/Agda/Utils/Monoid.hs +formatted 92bb2192c3b2 Agda-2.8.0/src/full/Agda/Utils/Null.hs +formatted 4fd8ca5748d3 Agda-2.8.0/src/full/Agda/Utils/POMonoid.hs +formatted bb186d0604db Agda-2.8.0/src/full/Agda/Utils/Parser/MemoisedCPS.hs +formatted 3298d386e71e Agda-2.8.0/src/full/Agda/Utils/PartialOrd.hs +formatted 5763223e9061 Agda-2.8.0/src/full/Agda/Utils/Permutation.hs +formatted 1a3e4a1087c4 Agda-2.8.0/src/full/Agda/Utils/ProfileOptions.hs +formatted b58b87ef89f8 Agda-2.8.0/src/full/Agda/Utils/RangeMap.hs +formatted 5039e6e9abfe Agda-2.8.0/src/full/Agda/Utils/SemiRing.hs +formatted 9aa281a4615c Agda-2.8.0/src/full/Agda/Utils/Semigroup.hs +formatted fdb04073ce98 Agda-2.8.0/src/full/Agda/Utils/Set1.hs +formatted f45ad8f08443 Agda-2.8.0/src/full/Agda/Utils/Singleton.hs +formatted 18c4a0bbe326 Agda-2.8.0/src/full/Agda/Utils/Size.hs +formatted a5753ba84ff3 Agda-2.8.0/src/full/Agda/Utils/SmallSet.hs +formatted 21babb4b50a9 Agda-2.8.0/src/full/Agda/Utils/String.hs +formatted 57a8a5b9fa29 Agda-2.8.0/src/full/Agda/Utils/Suffix.hs +formatted 736b26cda8bc Agda-2.8.0/src/full/Agda/Utils/Three.hs +formatted ebc104ac11d6 Agda-2.8.0/src/full/Agda/Utils/Time.hs +formatted 628c44ebe216 Agda-2.8.0/src/full/Agda/Utils/Trie.hs +formatted 1711e06969b5 Agda-2.8.0/src/full/Agda/Utils/Tuple.hs +formatted db9dcb1b8f66 Agda-2.8.0/src/full/Agda/Utils/TypeLevel.hs +formatted c8c672126225 Agda-2.8.0/src/full/Agda/Utils/TypeLits.hs +formatted 8d8d3b50eebc Agda-2.8.0/src/full/Agda/Utils/Unsafe.hs +formatted 56bf105aca9a Agda-2.8.0/src/full/Agda/Utils/Update.hs +formatted 383866b27bb0 Agda-2.8.0/src/full/Agda/Utils/VarSet.hs +formatted 9f0839da86cb Agda-2.8.0/src/full/Agda/Utils/WithDefault.hs +formatted 415a87aa2127 Agda-2.8.0/src/full/Agda/Utils/Zipper.hs +formatted 86e923a357db Agda-2.8.0/src/main/Main.hs +formatted d3512172a4bc Agda-2.8.0/src/setup/Agda/Setup.hs +formatted 114aa5ab1508 Agda-2.8.0/src/setup/Agda/Setup/DataFiles.hs +formatted 42af21c8ecf8 Agda-2.8.0/src/setup/Agda/Setup/EmacsMode.hs +formatted acb74e0db7a5 Agda-2.8.0/src/setup/Agda/Version.hs +formatted 5164a4006c26 Agda-2.8.0/src/setup/Agda/VersionCommit.hs +formatted 90cd663d9426 HUnit-1.6.2.0/examples/Example.hs +formatted 9b1cac4b6c09 HUnit-1.6.2.0/src/Test/HUnit.hs +formatted a7dea629b3ef HUnit-1.6.2.0/src/Test/HUnit/Base.hs +formatted ab91586830e9 HUnit-1.6.2.0/src/Test/HUnit/Lang.hs +formatted f9959d10adae HUnit-1.6.2.0/src/Test/HUnit/Terminal.hs +formatted c1c1d4fdc273 HUnit-1.6.2.0/src/Test/HUnit/Text.hs +formatted 358e8e211fe4 HUnit-1.6.2.0/tests/HUnitTestExtended.hs +formatted 2277de61adab HUnit-1.6.2.0/tests/HUnitTests.hs +formatted 6f374a392385 HUnit-1.6.2.0/tests/TerminalTest.hs +formatted 3c8a199a8a36 QuickCheck-2.18.0.0/examples/Heap.hs +formatted 0bd3a87ca5b5 QuickCheck-2.18.0.0/examples/Heap_Program.hs +formatted 85df59b82228 QuickCheck-2.18.0.0/examples/Heap_ProgramAlgebraic.hs +formatted cc37d9bcd159 QuickCheck-2.18.0.0/examples/Lambda.hs +formatted 56c98d50971f QuickCheck-2.18.0.0/examples/Merge.hs +formatted 6506a17a91ff QuickCheck-2.18.0.0/examples/Set.hs +formatted 598740b3d57c QuickCheck-2.18.0.0/examples/Simple.hs +partly-checked 5234e8085ba9 QuickCheck-2.18.0.0/src/Test/QuickCheck.hs +formatted d4509e6743a4 QuickCheck-2.18.0.0/src/Test/QuickCheck/All.hs +declined - QuickCheck-2.18.0.0/src/Test/QuickCheck/Arbitrary.hs +formatted b394fbd4debb QuickCheck-2.18.0.0/src/Test/QuickCheck/Compat.hs +partly-checked 06fafd04e06a QuickCheck-2.18.0.0/src/Test/QuickCheck/Exception.hs +formatted 682aa52bce46 QuickCheck-2.18.0.0/src/Test/QuickCheck/Features.hs +declined - QuickCheck-2.18.0.0/src/Test/QuickCheck/Function.hs +formatted 061130c71dd5 QuickCheck-2.18.0.0/src/Test/QuickCheck/Gen.hs +formatted 0488daa21096 QuickCheck-2.18.0.0/src/Test/QuickCheck/Gen/Unsafe.hs +declined - QuickCheck-2.18.0.0/src/Test/QuickCheck/Modifiers.hs +declined - QuickCheck-2.18.0.0/src/Test/QuickCheck/Monadic.hs +formatted 521d14fa41a7 QuickCheck-2.18.0.0/src/Test/QuickCheck/Monoids.hs +formatted c7e1654e2011 QuickCheck-2.18.0.0/src/Test/QuickCheck/Poly.hs +declined - QuickCheck-2.18.0.0/src/Test/QuickCheck/Property.hs +formatted d248979763fb QuickCheck-2.18.0.0/src/Test/QuickCheck/Random.hs +formatted 67a6c49f2d76 QuickCheck-2.18.0.0/src/Test/QuickCheck/State.hs +formatted b836923353a8 QuickCheck-2.18.0.0/src/Test/QuickCheck/Test.hs +formatted fc335cb1eb17 QuickCheck-2.18.0.0/src/Test/QuickCheck/Text.hs +formatted 658c2a75fd36 QuickCheck-2.18.0.0/tests/CollectDataTypes.hs +formatted deb44539c869 QuickCheck-2.18.0.0/tests/DiscardRatio.hs +formatted 5408e5e13bd3 QuickCheck-2.18.0.0/tests/GCoArbitraryExample.hs +formatted 8dd012261272 QuickCheck-2.18.0.0/tests/GShrinkExample.hs +formatted ddae5a0658b8 QuickCheck-2.18.0.0/tests/Generators.hs +formatted 79d32874cf04 QuickCheck-2.18.0.0/tests/Misc.hs +formatted 414efdc48918 QuickCheck-2.18.0.0/tests/MonadFix.hs +formatted d98e80df98ac QuickCheck-2.18.0.0/tests/Monoids.hs +formatted eae30fa51b1b QuickCheck-2.18.0.0/tests/RunCollectDataTypes.hs +formatted a844703dc876 QuickCheck-2.18.0.0/tests/Split.hs +formatted da1fe583377c QuickCheck-2.18.0.0/tests/Strictness.hs +formatted 5b211214c287 QuickCheck-2.18.0.0/tests/Terminal.hs +formatted 398a0f17171d QuickCheck-2.18.0.0/tests/WithProgress.hs +formatted 5bd7a41e0fb6 ShellCheck-0.11.0/shellcheck.hs +formatted e96f582d0994 ShellCheck-0.11.0/src/ShellCheck/AST.hs +formatted 1a672e0e9b45 ShellCheck-0.11.0/src/ShellCheck/ASTLib.hs +formatted f856db0e58cd ShellCheck-0.11.0/src/ShellCheck/Analytics.hs +formatted a37e7d6ad771 ShellCheck-0.11.0/src/ShellCheck/Analyzer.hs +formatted 53f56d1c3ae1 ShellCheck-0.11.0/src/ShellCheck/AnalyzerLib.hs +formatted ae3b0ca5251a ShellCheck-0.11.0/src/ShellCheck/CFG.hs +formatted 8b94af7378f4 ShellCheck-0.11.0/src/ShellCheck/CFGAnalysis.hs +formatted 64df5efa4dca ShellCheck-0.11.0/src/ShellCheck/Checker.hs +formatted ca5d54071468 ShellCheck-0.11.0/src/ShellCheck/Checks/Commands.hs +formatted c5722fd33abb ShellCheck-0.11.0/src/ShellCheck/Checks/ControlFlow.hs +formatted 0cbfece4e54b ShellCheck-0.11.0/src/ShellCheck/Checks/Custom.hs +formatted a6c175fc2ac7 ShellCheck-0.11.0/src/ShellCheck/Checks/ShellSupport.hs +formatted d39eda0efa56 ShellCheck-0.11.0/src/ShellCheck/Data.hs +formatted 0b8c4331f2cb ShellCheck-0.11.0/src/ShellCheck/Debug.hs +formatted eeebdf1e43d5 ShellCheck-0.11.0/src/ShellCheck/Fixer.hs +formatted 1c5c142bbc8c ShellCheck-0.11.0/src/ShellCheck/Formatter/CheckStyle.hs +formatted 8b36dd878a90 ShellCheck-0.11.0/src/ShellCheck/Formatter/Diff.hs +formatted 78112453fad7 ShellCheck-0.11.0/src/ShellCheck/Formatter/Format.hs +formatted d90b451f113e ShellCheck-0.11.0/src/ShellCheck/Formatter/GCC.hs +formatted b5dba8eeaa1e ShellCheck-0.11.0/src/ShellCheck/Formatter/JSON.hs +formatted 780be929b254 ShellCheck-0.11.0/src/ShellCheck/Formatter/JSON1.hs +formatted a381122da904 ShellCheck-0.11.0/src/ShellCheck/Formatter/Quiet.hs +formatted ede5712d5ab7 ShellCheck-0.11.0/src/ShellCheck/Formatter/TTY.hs +formatted a601aea10041 ShellCheck-0.11.0/src/ShellCheck/Interface.hs +formatted d91cb8e53cd5 ShellCheck-0.11.0/src/ShellCheck/Parser.hs +formatted 41e45f4ec82e ShellCheck-0.11.0/src/ShellCheck/Prelude.hs +formatted 0b6a2ca650ea ShellCheck-0.11.0/src/ShellCheck/Regex.hs +formatted d7f66e7f3a00 ShellCheck-0.11.0/test/shellcheck.hs +formatted f11704872a0d adjunctions-4.4.4/HLint.hs +formatted b76eebd88dde adjunctions-4.4.4/src/Control/Comonad/Representable/Store.hs +formatted 2dcd64bcfe48 adjunctions-4.4.4/src/Control/Comonad/Trans/Adjoint.hs +formatted 7b743cda361d adjunctions-4.4.4/src/Control/Monad/Representable/Reader.hs +formatted 35d839d56a32 adjunctions-4.4.4/src/Control/Monad/Representable/State.hs +formatted 4f5dfaf566a3 adjunctions-4.4.4/src/Control/Monad/Trans/Adjoint.hs +formatted daa2f636edb9 adjunctions-4.4.4/src/Control/Monad/Trans/Contravariant/Adjoint.hs +formatted 067960eebdd3 adjunctions-4.4.4/src/Control/Monad/Trans/Conts.hs +formatted a9be4a7e726b adjunctions-4.4.4/src/Data/Functor/Adjunction.hs +formatted 191e78a8f894 adjunctions-4.4.4/src/Data/Functor/Contravariant/Adjunction.hs +formatted 573a1fcd59fd adjunctions-4.4.4/src/Data/Functor/Contravariant/Rep.hs +formatted 16b695eb1cf2 adjunctions-4.4.4/src/Data/Functor/Rep.hs +formatted 538f4bee921a adjunctions-4.4.4/tests/GenericsSpec.hs +formatted 2fbd14b119a4 adjunctions-4.4.4/tests/Spec.hs +formatted 7bbf4758e5ad aeson-2.3.1.0/src/Data/Aeson.hs +formatted e884d6813fc6 aeson-2.3.1.0/src/Data/Aeson/Decoding.hs +formatted 93bdee10e02a aeson-2.3.1.0/src/Data/Aeson/Decoding/ByteString.hs +formatted 635321399aa4 aeson-2.3.1.0/src/Data/Aeson/Decoding/ByteString/Lazy.hs +formatted 1d3a54288c25 aeson-2.3.1.0/src/Data/Aeson/Decoding/Conversion.hs +formatted f1f142fef403 aeson-2.3.1.0/src/Data/Aeson/Decoding/Internal.hs +formatted e972ebea468c aeson-2.3.1.0/src/Data/Aeson/Decoding/Text.hs +formatted 709b71ada144 aeson-2.3.1.0/src/Data/Aeson/Decoding/Tokens.hs +formatted c6cf8dff7aea aeson-2.3.1.0/src/Data/Aeson/Encoding.hs +formatted 96d4e6121b81 aeson-2.3.1.0/src/Data/Aeson/Encoding/Builder.hs +formatted 32e6990c1aad aeson-2.3.1.0/src/Data/Aeson/Encoding/Internal.hs +formatted d7002010fdc9 aeson-2.3.1.0/src/Data/Aeson/Internal/ByteString.hs +formatted 7ff60392d6c3 aeson-2.3.1.0/src/Data/Aeson/Internal/Functions.hs +formatted e048ffa25767 aeson-2.3.1.0/src/Data/Aeson/Internal/Prelude.hs +formatted 57e28222c296 aeson-2.3.1.0/src/Data/Aeson/Internal/Scientific.hs +formatted 6bb6b5229c29 aeson-2.3.1.0/src/Data/Aeson/Internal/TH.hs +formatted b61b87ef28b1 aeson-2.3.1.0/src/Data/Aeson/Internal/Text.hs +formatted e83337edc6e6 aeson-2.3.1.0/src/Data/Aeson/Internal/Unescape.hs +formatted 20257ed727b2 aeson-2.3.1.0/src/Data/Aeson/Internal/UnescapeFromText.hs +formatted 726df9d09937 aeson-2.3.1.0/src/Data/Aeson/Key.hs +formatted ddeec884181e aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs +formatted a8f98f92bb33 aeson-2.3.1.0/src/Data/Aeson/Parser/Time.hs +formatted 34673c7e3119 aeson-2.3.1.0/src/Data/Aeson/QQ/Simple.hs +formatted 8c47510bfe90 aeson-2.3.1.0/src/Data/Aeson/RFC8785.hs +formatted 7995a04278eb aeson-2.3.1.0/src/Data/Aeson/TH.hs +formatted 12a0132d4a2c aeson-2.3.1.0/src/Data/Aeson/Text.hs +formatted d929af4e0687 aeson-2.3.1.0/src/Data/Aeson/Types.hs +formatted e11d9a90b593 aeson-2.3.1.0/src/Data/Aeson/Types/Class.hs +formatted 057e2b106402 aeson-2.3.1.0/src/Data/Aeson/Types/FromJSON.hs +formatted 3a14da7819a3 aeson-2.3.1.0/src/Data/Aeson/Types/Generic.hs +formatted 9fc1ad97795b aeson-2.3.1.0/src/Data/Aeson/Types/Internal.hs +formatted edb832a8dbeb aeson-2.3.1.0/src/Data/Aeson/Types/ToJSON.hs +formatted 4a92c519c2c4 aeson-2.3.1.0/tests/CastFloat.hs +formatted bad3a5065737 aeson-2.3.1.0/tests/DataFamilies/Encoders.hs +formatted 0d864147e795 aeson-2.3.1.0/tests/DataFamilies/Instances.hs +formatted 91fe7aa4d3dc aeson-2.3.1.0/tests/DataFamilies/Properties.hs +formatted 97579c76fd4d aeson-2.3.1.0/tests/DataFamilies/Types.hs +formatted 058d139e8724 aeson-2.3.1.0/tests/DoubleToScientific.hs +formatted 29b00f8c0d83 aeson-2.3.1.0/tests/Encoders.hs +formatted 30150da5a855 aeson-2.3.1.0/tests/ErrorMessages.hs +formatted 72fb423455c1 aeson-2.3.1.0/tests/Functions.hs +formatted a2da87dc85a4 aeson-2.3.1.0/tests/Instances.hs +formatted 38b7096d53c4 aeson-2.3.1.0/tests/JSONTestSuite.hs +formatted 82f27586e194 aeson-2.3.1.0/tests/Options.hs +formatted 269fd896fd74 aeson-2.3.1.0/tests/PropUtils.hs +formatted 5c7e1bcf3dd6 aeson-2.3.1.0/tests/Properties.hs +formatted 47a934388051 aeson-2.3.1.0/tests/PropertyGeneric.hs +formatted 109d7fb52b5b aeson-2.3.1.0/tests/PropertyKeys.hs +formatted 0d9df9d04cba aeson-2.3.1.0/tests/PropertyQC.hs +formatted a2e378d49eb8 aeson-2.3.1.0/tests/PropertyRTFunctors.hs +formatted d54279308532 aeson-2.3.1.0/tests/PropertyRoundTrip.hs +formatted 1c47871a8c20 aeson-2.3.1.0/tests/PropertyTH.hs +formatted 816e57772780 aeson-2.3.1.0/tests/RFC8785.hs +formatted 378b97660503 aeson-2.3.1.0/tests/Regression/Issue1138.hs +formatted 1cfcacdcaf11 aeson-2.3.1.0/tests/Regression/Issue351.hs +formatted d7ea7e8c0a78 aeson-2.3.1.0/tests/Regression/Issue571.hs +formatted c773b848db86 aeson-2.3.1.0/tests/Regression/Issue687.hs +formatted e5c541d1465a aeson-2.3.1.0/tests/Regression/Issue967.hs +formatted 97b26e935032 aeson-2.3.1.0/tests/SerializationFormatSpec.hs +formatted 8eaa36c16021 aeson-2.3.1.0/tests/Tests.hs +formatted fca86e7ab321 aeson-2.3.1.0/tests/Types.hs +formatted b711a1e1b18d aeson-2.3.1.0/tests/UnitTests.hs +formatted f18689008d86 aeson-2.3.1.0/tests/UnitTests/FromJSONKey.hs +formatted 8fa12a214cda aeson-2.3.1.0/tests/UnitTests/Hashable.hs +formatted 2e6e13a2b307 aeson-2.3.1.0/tests/UnitTests/KeyMapInsertWith.hs +formatted fc462ed61e50 aeson-2.3.1.0/tests/UnitTests/MonadFix.hs +formatted 657449faeb93 aeson-2.3.1.0/tests/UnitTests/NoThunks.hs +formatted 31a111ec64d8 aeson-2.3.1.0/tests/UnitTests/NullaryConstructors.hs +formatted 095b9b74ccb5 aeson-2.3.1.0/tests/UnitTests/OmitNothingFieldsNote.hs +formatted 579ca9c8641b aeson-2.3.1.0/tests/UnitTests/OptionalFields.hs +formatted 4e613e1ef254 aeson-2.3.1.0/tests/UnitTests/OptionalFields/Common.hs +formatted d8f208687b90 aeson-2.3.1.0/tests/UnitTests/OptionalFields/Generics.hs +formatted cc59c7b4c685 aeson-2.3.1.0/tests/UnitTests/OptionalFields/Manual.hs +formatted 4a6ecc95787f aeson-2.3.1.0/tests/UnitTests/OptionalFields/TH.hs +formatted e93203961852 aeson-2.3.1.0/tests/UnitTests/UTCTime.hs +formatted e865ae48f11b ansi-terminal-1.1.5/Setup.hs +formatted 444d34793bf4 ansi-terminal-1.1.5/app/Example.hs +formatted 64edb10877a8 ansi-terminal-1.1.5/src/System/Console/ANSI.hs +formatted 0cc59e71668d ansi-terminal-1.1.5/unix/System/Console/ANSI/Internal.hs +formatted 2ee987b3a95a ansi-terminal-1.1.5/win/System/Console/ANSI/Internal.hs +formatted 1aaa3e2316a9 ansi-terminal-1.1.5/win/System/Console/ANSI/Windows/Foreign.hs +does-not-parse - ansi-terminal-1.1.5/win/System/Console/ANSI/Windows/Win32/Types.hs +formatted 9e25d9947df5 async-2.2.6/Control/Concurrent/Async.hs +partly-checked 539941d64e62 async-2.2.6/Control/Concurrent/Async/Internal.hs +formatted 68777666410b async-2.2.6/Control/Concurrent/Async/Warden.hs +formatted a0f5a7bd29cb async-2.2.6/Control/Concurrent/Stream.hs +formatted e865ae48f11b async-2.2.6/Setup.hs +formatted 7f1489b412a3 async-2.2.6/bench/concasync.hs +formatted 947eb9e17a7c async-2.2.6/bench/conccancel.hs +formatted 6fd907018c80 async-2.2.6/bench/race.hs +formatted 5737c788d68d async-2.2.6/test/test-async.hs +formatted 9f3238148609 attoparsec-0.14.4/Data/Attoparsec.hs +formatted 7d88b33f4399 attoparsec-0.14.4/Data/Attoparsec/ByteString.hs +formatted 4ba03080e749 attoparsec-0.14.4/Data/Attoparsec/ByteString/Char8.hs +formatted 0e47afce0362 attoparsec-0.14.4/Data/Attoparsec/ByteString/Internal.hs +formatted fcc23ffbbc3d attoparsec-0.14.4/Data/Attoparsec/ByteString/Lazy.hs +formatted 220f76f3ce4e attoparsec-0.14.4/Data/Attoparsec/Char8.hs +formatted 90be588fbc3a attoparsec-0.14.4/Data/Attoparsec/Combinator.hs +formatted 4b9154d41c2a attoparsec-0.14.4/Data/Attoparsec/Internal.hs +formatted 4f1284a9fd4b attoparsec-0.14.4/Data/Attoparsec/Internal/Types.hs +formatted ea3b710a875e attoparsec-0.14.4/Data/Attoparsec/Lazy.hs +formatted 3d8057d5d688 attoparsec-0.14.4/Data/Attoparsec/Number.hs +formatted 45050bdb0a87 attoparsec-0.14.4/Data/Attoparsec/Text.hs +formatted 8419b057d5a4 attoparsec-0.14.4/Data/Attoparsec/Text/Internal.hs +formatted b1c4021729a8 attoparsec-0.14.4/Data/Attoparsec/Text/Lazy.hs +formatted 63d322215a87 attoparsec-0.14.4/Data/Attoparsec/Types.hs +formatted 8ab300fd67b0 attoparsec-0.14.4/Data/Attoparsec/Zepto.hs +formatted 53b0400e60aa attoparsec-0.14.4/benchmarks/Aeson.hs +formatted b151a3ed3e1a attoparsec-0.14.4/benchmarks/Benchmarks.hs +formatted bd0309211105 attoparsec-0.14.4/benchmarks/Common.hs +formatted baa4df75c7d8 attoparsec-0.14.4/benchmarks/Genome.hs +formatted 3f8483fc03da attoparsec-0.14.4/benchmarks/HeadersByteString.hs +formatted bb42606c4a8a attoparsec-0.14.4/benchmarks/HeadersByteString/Atto.hs +formatted 5a57c6aaa740 attoparsec-0.14.4/benchmarks/HeadersText.hs +formatted 8fa6e462f95f attoparsec-0.14.4/benchmarks/Links.hs +formatted f582abe3e244 attoparsec-0.14.4/benchmarks/Numbers.hs +formatted 696be472825c attoparsec-0.14.4/benchmarks/Sets.hs +formatted 4127b367fedd attoparsec-0.14.4/benchmarks/TextFastSet.hs +formatted 2b16e18cd8c0 attoparsec-0.14.4/benchmarks/Warp.hs +formatted 5aab92534568 attoparsec-0.14.4/benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/ReadInt.hs +formatted 1f7d3a417fb5 attoparsec-0.14.4/benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/RequestHeader.hs +formatted 0d3565bef090 attoparsec-0.14.4/examples/Atto_RFC2616.hs +formatted b6861e7aadf8 attoparsec-0.14.4/examples/Parsec_RFC2616.hs +formatted af7fdd1013cc attoparsec-0.14.4/examples/RFC2616.hs +formatted ef93830525fb attoparsec-0.14.4/internal/Data/Attoparsec/ByteString/Buffer.hs +formatted 11586d954f58 attoparsec-0.14.4/internal/Data/Attoparsec/ByteString/FastSet.hs +formatted f21e47830b1f attoparsec-0.14.4/internal/Data/Attoparsec/Internal/Compat.hs +formatted 4498fcbfa61f attoparsec-0.14.4/internal/Data/Attoparsec/Internal/Fhthagn.hs +formatted 5702ff8f1bfe attoparsec-0.14.4/internal/Data/Attoparsec/Text/Buffer.hs +formatted eb9808888de1 attoparsec-0.14.4/internal/Data/Attoparsec/Text/FastSet.hs +formatted ccaeb87485db attoparsec-0.14.4/tests/QC.hs +formatted c4481214d6c0 attoparsec-0.14.4/tests/QC/Buffer.hs +formatted ae7fa7b38a4b attoparsec-0.14.4/tests/QC/ByteString.hs +formatted 455e4866502a attoparsec-0.14.4/tests/QC/Combinator.hs +formatted 432dc39c009b attoparsec-0.14.4/tests/QC/Common.hs +formatted e1690783c200 attoparsec-0.14.4/tests/QC/IPv6/Internal.hs +formatted 0692feda416d attoparsec-0.14.4/tests/QC/IPv6/Types.hs +formatted 08452f3d9508 attoparsec-0.14.4/tests/QC/Rechunked.hs +formatted 0bab40e54197 attoparsec-0.14.4/tests/QC/Simple.hs +formatted f610227583f7 attoparsec-0.14.4/tests/QC/Text.hs +formatted 930b366b3b68 attoparsec-0.14.4/tests/QC/Text/FastSet.hs +formatted ed6a9f21b67c attoparsec-0.14.4/tests/QC/Text/Regressions.hs +formatted 7710b806795e aws-0.25.3/Aws.hs +formatted a9796f263dfc aws-0.25.3/Aws/Aws.hs +formatted 162fd677ca7f aws-0.25.3/Aws/Core.hs +formatted 526f7494fea1 aws-0.25.3/Aws/DynamoDb.hs +formatted 11c5a36e6111 aws-0.25.3/Aws/DynamoDb/Commands.hs +formatted 816c9145f15f aws-0.25.3/Aws/DynamoDb/Commands/BatchGetItem.hs +formatted 66180bb576de aws-0.25.3/Aws/DynamoDb/Commands/BatchWriteItem.hs +formatted 2dd73c556bae aws-0.25.3/Aws/DynamoDb/Commands/DeleteItem.hs +formatted a4c1ac5401e1 aws-0.25.3/Aws/DynamoDb/Commands/GetItem.hs +formatted 8eeae03bf6c6 aws-0.25.3/Aws/DynamoDb/Commands/PutItem.hs +formatted 39a1d3ed567f aws-0.25.3/Aws/DynamoDb/Commands/Query.hs +formatted ee62e16512fa aws-0.25.3/Aws/DynamoDb/Commands/Scan.hs +formatted c38c6911e37d aws-0.25.3/Aws/DynamoDb/Commands/Table.hs +formatted 63e4dc333814 aws-0.25.3/Aws/DynamoDb/Commands/UpdateItem.hs +formatted 953d8c1f7a8f aws-0.25.3/Aws/DynamoDb/Core.hs +formatted 7da30757579d aws-0.25.3/Aws/Ec2/InstanceMetadata.hs +formatted 64524ea72e53 aws-0.25.3/Aws/Iam.hs +formatted 749eee8b56a6 aws-0.25.3/Aws/Iam/Commands.hs +formatted 6cab7de997d4 aws-0.25.3/Aws/Iam/Commands/AddUserToGroup.hs +formatted 86ddf2e56d99 aws-0.25.3/Aws/Iam/Commands/CreateAccessKey.hs +formatted d91ce3a3d7eb aws-0.25.3/Aws/Iam/Commands/CreateGroup.hs +formatted 0151d576a66e aws-0.25.3/Aws/Iam/Commands/CreateUser.hs +formatted 534cd5da900d aws-0.25.3/Aws/Iam/Commands/DeleteAccessKey.hs +formatted 69f808dacd5c aws-0.25.3/Aws/Iam/Commands/DeleteGroup.hs +formatted c99d76b534c3 aws-0.25.3/Aws/Iam/Commands/DeleteGroupPolicy.hs +formatted 7214274b0a75 aws-0.25.3/Aws/Iam/Commands/DeleteUser.hs +formatted 539089e60152 aws-0.25.3/Aws/Iam/Commands/DeleteUserPolicy.hs +formatted 96c13cf9a584 aws-0.25.3/Aws/Iam/Commands/GetGroupPolicy.hs +formatted 512be8c8f03d aws-0.25.3/Aws/Iam/Commands/GetUser.hs +formatted a2a951b85bd4 aws-0.25.3/Aws/Iam/Commands/GetUserPolicy.hs +formatted 27c28857ce57 aws-0.25.3/Aws/Iam/Commands/ListAccessKeys.hs +formatted dbb935e72374 aws-0.25.3/Aws/Iam/Commands/ListGroupPolicies.hs +formatted 650c943b98e3 aws-0.25.3/Aws/Iam/Commands/ListGroups.hs +formatted ba0e4827b583 aws-0.25.3/Aws/Iam/Commands/ListMfaDevices.hs +formatted 318b8d56fcfa aws-0.25.3/Aws/Iam/Commands/ListUserPolicies.hs +formatted 1238be9d0ebe aws-0.25.3/Aws/Iam/Commands/ListUsers.hs +formatted a9adfe2a442f aws-0.25.3/Aws/Iam/Commands/PutGroupPolicy.hs +formatted 6f67f99ccb94 aws-0.25.3/Aws/Iam/Commands/PutUserPolicy.hs +formatted 3108bb7a63ed aws-0.25.3/Aws/Iam/Commands/RemoveUserFromGroup.hs +formatted fbb2573ec037 aws-0.25.3/Aws/Iam/Commands/UpdateAccessKey.hs +formatted 318f4ad2dd6f aws-0.25.3/Aws/Iam/Commands/UpdateGroup.hs +formatted 0e38dcbc3f33 aws-0.25.3/Aws/Iam/Commands/UpdateUser.hs +formatted 0e616b268e22 aws-0.25.3/Aws/Iam/Core.hs +formatted feab396b426b aws-0.25.3/Aws/Iam/Internal.hs +formatted 02714b33e7fa aws-0.25.3/Aws/Network.hs +formatted ce77812a32a4 aws-0.25.3/Aws/S3.hs +formatted 468614525265 aws-0.25.3/Aws/S3/Commands.hs +formatted 6e0d1bf40820 aws-0.25.3/Aws/S3/Commands/CopyObject.hs +formatted 74b3876221d3 aws-0.25.3/Aws/S3/Commands/DeleteBucket.hs +formatted 2172bd0ac689 aws-0.25.3/Aws/S3/Commands/DeleteObject.hs +formatted 71b066deaf91 aws-0.25.3/Aws/S3/Commands/DeleteObjectVersion.hs +formatted aec32a8ce26a aws-0.25.3/Aws/S3/Commands/DeleteObjects.hs +formatted 58c26ad66fe6 aws-0.25.3/Aws/S3/Commands/GetBucket.hs +formatted 25df4181bd01 aws-0.25.3/Aws/S3/Commands/GetBucketLocation.hs +formatted 8576d8050fa2 aws-0.25.3/Aws/S3/Commands/GetBucketObjectVersions.hs +formatted c2ae17dfac1c aws-0.25.3/Aws/S3/Commands/GetBucketVersioning.hs +formatted 1da66c4c9858 aws-0.25.3/Aws/S3/Commands/GetObject.hs +formatted 6f29ea695d0a aws-0.25.3/Aws/S3/Commands/GetService.hs +formatted 293d655f68ee aws-0.25.3/Aws/S3/Commands/HeadObject.hs +formatted 6d71ddbd4d83 aws-0.25.3/Aws/S3/Commands/Multipart.hs +formatted c9972f937c82 aws-0.25.3/Aws/S3/Commands/PutBucket.hs +formatted 17fac1555526 aws-0.25.3/Aws/S3/Commands/PutBucketVersioning.hs +formatted 5f970509bf06 aws-0.25.3/Aws/S3/Commands/PutObject.hs +formatted 35b464748fc1 aws-0.25.3/Aws/S3/Commands/RestoreObject.hs +formatted 627fffa71c1a aws-0.25.3/Aws/S3/Core.hs +formatted e59133632c71 aws-0.25.3/Aws/Ses.hs +formatted 98906d812790 aws-0.25.3/Aws/Ses/Commands.hs +formatted d82f6af0c772 aws-0.25.3/Aws/Ses/Commands/DeleteIdentity.hs +formatted 0a54c52718c5 aws-0.25.3/Aws/Ses/Commands/GetIdentityDkimAttributes.hs +formatted 661cdba65ae1 aws-0.25.3/Aws/Ses/Commands/GetIdentityNotificationAttributes.hs +formatted abee7d091f47 aws-0.25.3/Aws/Ses/Commands/GetIdentityVerificationAttributes.hs +formatted cf1089b5ea07 aws-0.25.3/Aws/Ses/Commands/ListIdentities.hs +formatted 7ab7fc59aa36 aws-0.25.3/Aws/Ses/Commands/SendRawEmail.hs +formatted 562173d60b20 aws-0.25.3/Aws/Ses/Commands/SetIdentityDkimEnabled.hs +formatted 629ac12fe396 aws-0.25.3/Aws/Ses/Commands/SetIdentityFeedbackForwardingEnabled.hs +formatted 7b13bc8a115c aws-0.25.3/Aws/Ses/Commands/SetIdentityNotificationTopic.hs +formatted 2ef608635aeb aws-0.25.3/Aws/Ses/Commands/VerifyDomainDkim.hs +formatted ffb19c08b235 aws-0.25.3/Aws/Ses/Commands/VerifyDomainIdentity.hs +formatted de43062d4755 aws-0.25.3/Aws/Ses/Commands/VerifyEmailIdentity.hs +formatted b9023a14f6f1 aws-0.25.3/Aws/Ses/Core.hs +formatted 4115c76b6f3d aws-0.25.3/Aws/SimpleDb.hs +formatted 0b6040677d6d aws-0.25.3/Aws/SimpleDb/Commands.hs +formatted 81ffab76c170 aws-0.25.3/Aws/SimpleDb/Commands/Attributes.hs +formatted 9616c948cf13 aws-0.25.3/Aws/SimpleDb/Commands/Domain.hs +formatted 8deb23c46a5b aws-0.25.3/Aws/SimpleDb/Commands/Select.hs +formatted 1542fdb811fb aws-0.25.3/Aws/SimpleDb/Core.hs +formatted 412e7ea774c8 aws-0.25.3/Aws/Sqs.hs +formatted 346f822a2760 aws-0.25.3/Aws/Sqs/Commands.hs +formatted 6d4c58eca68a aws-0.25.3/Aws/Sqs/Commands/Message.hs +formatted 05c968d4a089 aws-0.25.3/Aws/Sqs/Commands/Permission.hs +formatted 3a2b342a12c4 aws-0.25.3/Aws/Sqs/Commands/Queue.hs +formatted 33ff20c0cc1b aws-0.25.3/Aws/Sqs/Commands/QueueAttributes.hs +formatted 8141a49d45ee aws-0.25.3/Aws/Sqs/Core.hs +formatted eb8ba0f68d00 aws-0.25.3/Examples/DynamoDb.hs +formatted 9a96ec734f74 aws-0.25.3/Examples/GetObject.hs +formatted 799e429953e7 aws-0.25.3/Examples/GetObjectGoogle.hs +formatted 8065499ab307 aws-0.25.3/Examples/GetObjectV4.hs +formatted 0121b3f3d691 aws-0.25.3/Examples/MultipartTransfer.hs +formatted c09c03a39390 aws-0.25.3/Examples/MultipartUpload.hs +formatted f8163e1e4473 aws-0.25.3/Examples/NukeBucket.hs +formatted 34698069cedb aws-0.25.3/Examples/PutBucketNearLine.hs +formatted d6caebe65382 aws-0.25.3/Examples/SimpleDb.hs +formatted c31e8b7adbf5 aws-0.25.3/Examples/Sqs.hs +formatted e865ae48f11b aws-0.25.3/Setup.hs +formatted 354bb309a68c aws-0.25.3/tests/DynamoDb/Main.hs +formatted 75daea597c6a aws-0.25.3/tests/DynamoDb/Utils.hs +formatted 3ffa8999bdf7 aws-0.25.3/tests/S3/Main.hs +formatted 44336eea1e26 aws-0.25.3/tests/Sqs/Main.hs +formatted 001f1d1eb163 aws-0.25.3/tests/Utils.hs +formatted c4588035d2e2 base64-bytestring-1.2.1.0/Data/ByteString/Base64.hs +formatted 2897fc80ce31 base64-bytestring-1.2.1.0/Data/ByteString/Base64/Internal.hs +formatted dae9abac8bd0 base64-bytestring-1.2.1.0/Data/ByteString/Base64/Lazy.hs +formatted f0e7d8a34f4b base64-bytestring-1.2.1.0/Data/ByteString/Base64/URL.hs +formatted 0d8bf6b77f56 base64-bytestring-1.2.1.0/Data/ByteString/Base64/URL/Lazy.hs +formatted e865ae48f11b base64-bytestring-1.2.1.0/Setup.hs +formatted 0328dc0c3c7c base64-bytestring-1.2.1.0/benchmarks/BM.hs +formatted e856b328c01f base64-bytestring-1.2.1.0/tests/Tests.hs +formatted d41a83550f57 base64-bytestring-1.2.1.0/utils/Transcode.hs +formatted a696585f6bb3 bifunctors-5.6.3/src/Data/Biapplicative.hs +formatted 445cc73ae2f4 bifunctors-5.6.3/src/Data/Bifunctor/Biap.hs +formatted 4e8e99fc3d02 bifunctors-5.6.3/src/Data/Bifunctor/Biff.hs +formatted 622562a94746 bifunctors-5.6.3/src/Data/Bifunctor/Clown.hs +formatted 5ed71c802f86 bifunctors-5.6.3/src/Data/Bifunctor/Fix.hs +formatted 2b2e1c855d83 bifunctors-5.6.3/src/Data/Bifunctor/Flip.hs +formatted 3ac44f1c96ed bifunctors-5.6.3/src/Data/Bifunctor/Functor.hs +formatted c5ca87b8d191 bifunctors-5.6.3/src/Data/Bifunctor/Join.hs +formatted 50a39353a74f bifunctors-5.6.3/src/Data/Bifunctor/Joker.hs +formatted d60de274f1df bifunctors-5.6.3/src/Data/Bifunctor/Product.hs +formatted a4989781f0a5 bifunctors-5.6.3/src/Data/Bifunctor/Sum.hs +formatted 07398be9dabc bifunctors-5.6.3/src/Data/Bifunctor/TH.hs +formatted b4784a48aa1a bifunctors-5.6.3/src/Data/Bifunctor/TH/Internal.hs +formatted d65d2830209f bifunctors-5.6.3/src/Data/Bifunctor/Tannen.hs +formatted 4b43e6d2b7ee bifunctors-5.6.3/src/Data/Bifunctor/Wrapped.hs +formatted 0abba42a51a4 bifunctors-5.6.3/tests/BifunctorSpec.hs +formatted 2fbd14b119a4 bifunctors-5.6.3/tests/Spec.hs +formatted 20bbaaea7be2 bifunctors-5.6.3/tests/T89Spec.hs +formatted e865ae48f11b blaze-html-0.9.2.0/Setup.hs +formatted 59b1e28dc18c blaze-html-0.9.2.0/src/Text/Blaze/Html.hs +formatted 1ceaed7998ed blaze-html-0.9.2.0/src/Text/Blaze/Html/Renderer/Pretty.hs +formatted a5a8080ce8a3 blaze-html-0.9.2.0/src/Text/Blaze/Html/Renderer/String.hs +formatted 850270b61be0 blaze-html-0.9.2.0/src/Text/Blaze/Html/Renderer/Text.hs +formatted 4dbd824fb533 blaze-html-0.9.2.0/src/Text/Blaze/Html/Renderer/Utf8.hs +formatted 193787aa6e82 blaze-html-0.9.2.0/src/Text/Blaze/Html4/FrameSet.hs +formatted 311d6a242cd1 blaze-html-0.9.2.0/src/Text/Blaze/Html4/FrameSet/Attributes.hs +formatted 980072ab3333 blaze-html-0.9.2.0/src/Text/Blaze/Html4/Strict.hs +formatted 6d96fbabc526 blaze-html-0.9.2.0/src/Text/Blaze/Html4/Strict/Attributes.hs +formatted 4c6ce53fa6c0 blaze-html-0.9.2.0/src/Text/Blaze/Html4/Transitional.hs +formatted d39d423c9274 blaze-html-0.9.2.0/src/Text/Blaze/Html4/Transitional/Attributes.hs +formatted 6593178d8914 blaze-html-0.9.2.0/src/Text/Blaze/Html5.hs +formatted a51b4ec4c88c blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs +formatted a3131475444c blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/FrameSet.hs +formatted b11110851d4d blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/FrameSet/Attributes.hs +formatted 326a6b8007f4 blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/Strict.hs +formatted 614d1d8b8758 blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/Strict/Attributes.hs +formatted f18debc4b04a blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/Transitional.hs +formatted b02420bd150d blaze-html-0.9.2.0/src/Text/Blaze/XHtml1/Transitional/Attributes.hs +formatted 19fcd3fe0b2a blaze-html-0.9.2.0/src/Text/Blaze/XHtml5.hs +formatted e7349ea7b26e blaze-html-0.9.2.0/src/Text/Blaze/XHtml5/Attributes.hs +formatted 6a3eeb3e9d8b blaze-html-0.9.2.0/src/Util/GenerateHtmlCombinators.hs +formatted c350d72adcf6 blaze-html-0.9.2.0/src/Util/Sanitize.hs +formatted 3b0e5b5fbcb0 blaze-html-0.9.2.0/tests/TestSuite.hs +formatted e2943235e42d blaze-html-0.9.2.0/tests/Text/Blaze/Html/Tests.hs +formatted 9dae0554f33d blaze-html-0.9.2.0/tests/Text/Blaze/Html/Tests/Util.hs +formatted c858d7e158e9 blaze-html-0.9.2.0/tests/Util/Tests.hs +formatted e865ae48f11b blaze-markup-0.8.3.0/Setup.hs +formatted a414efd123bb blaze-markup-0.8.3.0/src/Text/Blaze.hs +formatted b748bec53a7d blaze-markup-0.8.3.0/src/Text/Blaze/Internal.hs +formatted 4846f41adc9e blaze-markup-0.8.3.0/src/Text/Blaze/Renderer/Pretty.hs +formatted 2e54745ce84a blaze-markup-0.8.3.0/src/Text/Blaze/Renderer/String.hs +formatted 8bb5a6b40341 blaze-markup-0.8.3.0/src/Text/Blaze/Renderer/Text.hs +formatted c0f54cd6a8ef blaze-markup-0.8.3.0/src/Text/Blaze/Renderer/Utf8.hs +formatted c7292f26d075 blaze-markup-0.8.3.0/tests/TestSuite.hs +formatted efa997a477e9 blaze-markup-0.8.3.0/tests/Text/Blaze/Tests.hs +formatted e6ac9555645c blaze-markup-0.8.3.0/tests/Text/Blaze/Tests/Util.hs +formatted e865ae48f11b brick-2.13/Setup.hs +formatted 63a60b3578b5 brick-2.13/programs/AnimationDemo.hs +formatted 5d807c6bfef9 brick-2.13/programs/AttrDemo.hs +formatted efff9829e309 brick-2.13/programs/BorderDemo.hs +formatted aef958fe74cd brick-2.13/programs/CacheDemo.hs +formatted 095e55ce36f6 brick-2.13/programs/CroppingDemo.hs +formatted 2bd41626b7f1 brick-2.13/programs/CustomEventDemo.hs +formatted 74968af52af2 brick-2.13/programs/CustomKeybindingDemo.hs +formatted 8438ad4ac269 brick-2.13/programs/DialogDemo.hs +formatted 70a751a6fa70 brick-2.13/programs/DynamicBorderDemo.hs +formatted 464ea19b0d91 brick-2.13/programs/EditDemo.hs +formatted 4cce67dc7675 brick-2.13/programs/EditorLineNumbersDemo.hs +formatted cb441c25368f brick-2.13/programs/FileBrowserDemo.hs +formatted f42c468e824d brick-2.13/programs/FillDemo.hs +formatted f53d59f91db3 brick-2.13/programs/FormDemo.hs +formatted ccec85b0d210 brick-2.13/programs/HelloWorldDemo.hs +formatted df3c26970095 brick-2.13/programs/LayerDemo.hs +formatted f010e64931de brick-2.13/programs/ListDemo.hs +formatted 72b3c637e7a9 brick-2.13/programs/ListViDemo.hs +formatted b09c3f445d0e brick-2.13/programs/MouseDemo.hs +formatted 07bae652c697 brick-2.13/programs/PaddingDemo.hs +formatted b42491ad385a brick-2.13/programs/ProgressBarDemo.hs +formatted 663c2424c9c5 brick-2.13/programs/ReadmeDemo.hs +formatted d199bd740848 brick-2.13/programs/SuspendAndResumeDemo.hs +formatted da922e788566 brick-2.13/programs/TableDemo.hs +formatted 4475181f29de brick-2.13/programs/TabularListDemo.hs +formatted b7e39f0a8d19 brick-2.13/programs/TailDemo.hs +formatted d386391b5c6d brick-2.13/programs/TextWrapDemo.hs +formatted 4539be6276d5 brick-2.13/programs/ThemeDemo.hs +formatted 2c64cf0649ba brick-2.13/programs/ViewportScrollDemo.hs +formatted 76a2aa468b27 brick-2.13/programs/ViewportScrollbarsDemo.hs +formatted e2bd645f4c8a brick-2.13/programs/VisibilityDemo.hs +formatted 0abc07286e47 brick-2.13/src/Brick.hs +formatted 5c7acfef56e2 brick-2.13/src/Brick/Animation.hs +formatted deb1866c9333 brick-2.13/src/Brick/Animation/Clock.hs +formatted 91b158ee4b8a brick-2.13/src/Brick/AttrMap.hs +formatted 13c109f25eb8 brick-2.13/src/Brick/BChan.hs +formatted a220048b3f60 brick-2.13/src/Brick/BorderMap.hs +formatted 7aa4818185b3 brick-2.13/src/Brick/Focus.hs +formatted b99dcc536b6e brick-2.13/src/Brick/Forms.hs +formatted d6c2a2e1b0a0 brick-2.13/src/Brick/Keybindings.hs +formatted 4afba3471679 brick-2.13/src/Brick/Keybindings/KeyConfig.hs +formatted e8fe81270a11 brick-2.13/src/Brick/Keybindings/KeyDispatcher.hs +formatted 10682f468a33 brick-2.13/src/Brick/Keybindings/KeyEvents.hs +formatted 20d38a2fef1c brick-2.13/src/Brick/Keybindings/Normalize.hs +formatted 422ce68b006b brick-2.13/src/Brick/Keybindings/Parse.hs +formatted 500582ecf6a0 brick-2.13/src/Brick/Keybindings/Pretty.hs +formatted 3a2fd805219a brick-2.13/src/Brick/Main.hs +formatted 74d114b85be0 brick-2.13/src/Brick/Themes.hs +formatted af2489bd5835 brick-2.13/src/Brick/Types.hs +formatted 5a0fb2f107c1 brick-2.13/src/Brick/Types/Common.hs +formatted 1053ffe4d321 brick-2.13/src/Brick/Types/EventM.hs +formatted 680c7fc4c12b brick-2.13/src/Brick/Types/Internal.hs +formatted 81c674829568 brick-2.13/src/Brick/Types/TH.hs +formatted 02b0e53f451c brick-2.13/src/Brick/Util.hs +formatted cba7b18b8f68 brick-2.13/src/Brick/Widgets/Border.hs +formatted 89894b08f498 brick-2.13/src/Brick/Widgets/Border/Style.hs +formatted e3b47970aba1 brick-2.13/src/Brick/Widgets/Center.hs +formatted d864d6f5529c brick-2.13/src/Brick/Widgets/Core.hs +formatted 9b5313ab5ee9 brick-2.13/src/Brick/Widgets/Dialog.hs +formatted c71ef0bf6ec5 brick-2.13/src/Brick/Widgets/Edit.hs +formatted 4478fd2c6064 brick-2.13/src/Brick/Widgets/FileBrowser.hs +formatted c480d93b371e brick-2.13/src/Brick/Widgets/Internal.hs +formatted f35028306876 brick-2.13/src/Brick/Widgets/List.hs +formatted 45273510047b brick-2.13/src/Brick/Widgets/ProgressBar.hs +formatted 18c427091a7b brick-2.13/src/Brick/Widgets/Table.hs +formatted 868aec6c5d83 brick-2.13/src/Data/IMap.hs +formatted 15733bb95234 brick-2.13/tests/List.hs +formatted 2e6ed8d0e976 brick-2.13/tests/Main.hs +formatted 073f01c2462e brick-2.13/tests/Render.hs +formatted e0fa5e2b222c brittany-0.14.0.2/data/Test1.hs +formatted a7fed1125f29 brittany-0.14.0.2/data/Test10.hs +formatted dd2db552d155 brittany-0.14.0.2/data/Test100.hs +formatted 3ebccae4d2bf brittany-0.14.0.2/data/Test101.hs +formatted 000b618097d0 brittany-0.14.0.2/data/Test102.hs +formatted 26845ab84f6a brittany-0.14.0.2/data/Test103.hs +formatted 25cf4c76ed6b brittany-0.14.0.2/data/Test104.hs +formatted bac120fe0092 brittany-0.14.0.2/data/Test105.hs +formatted e29d7ffca93f brittany-0.14.0.2/data/Test106.hs +formatted 0b6e06bf2c23 brittany-0.14.0.2/data/Test107.hs +formatted eda42fe4d65b brittany-0.14.0.2/data/Test108.hs +formatted 9ce1b7bc7832 brittany-0.14.0.2/data/Test109.hs +formatted c7d09069af77 brittany-0.14.0.2/data/Test11.hs +formatted 61661f795457 brittany-0.14.0.2/data/Test110.hs +formatted 37d78f5961ec brittany-0.14.0.2/data/Test111.hs +formatted 1e4bb8275bfb brittany-0.14.0.2/data/Test112.hs +formatted 8cda89e87702 brittany-0.14.0.2/data/Test113.hs +formatted 751bfd56bc69 brittany-0.14.0.2/data/Test114.hs +formatted 5078888fc5d2 brittany-0.14.0.2/data/Test115.hs +formatted 3fdf3b074d25 brittany-0.14.0.2/data/Test116.hs +formatted 15ad0c63e705 brittany-0.14.0.2/data/Test117.hs +formatted 5d67c955a452 brittany-0.14.0.2/data/Test118.hs +formatted 4581aecedf18 brittany-0.14.0.2/data/Test119.hs +formatted 624becd3f674 brittany-0.14.0.2/data/Test12.hs +formatted 5bbfe94a03d4 brittany-0.14.0.2/data/Test120.hs +formatted 01ac88bcab1a brittany-0.14.0.2/data/Test121.hs +formatted 057f0ce3ffb0 brittany-0.14.0.2/data/Test122.hs +formatted 661f6da49632 brittany-0.14.0.2/data/Test123.hs +formatted 86c1caf3eee5 brittany-0.14.0.2/data/Test124.hs +formatted c6ffbf389d8d brittany-0.14.0.2/data/Test125.hs +formatted 1b2ef1cfadaa brittany-0.14.0.2/data/Test126.hs +formatted 058f31d7f6cc brittany-0.14.0.2/data/Test127.hs +formatted bec0f8aa554d brittany-0.14.0.2/data/Test128.hs +formatted f712d9c961eb brittany-0.14.0.2/data/Test129.hs +formatted 79735ec00a3d brittany-0.14.0.2/data/Test13.hs +formatted f808d5477ba7 brittany-0.14.0.2/data/Test130.hs +formatted 2372bf2e1670 brittany-0.14.0.2/data/Test131.hs +formatted c6526aabb3c3 brittany-0.14.0.2/data/Test132.hs +formatted 5287afc100b5 brittany-0.14.0.2/data/Test133.hs +formatted cbf28cc3de46 brittany-0.14.0.2/data/Test134.hs +formatted e9f15a2df4fd brittany-0.14.0.2/data/Test135.hs +formatted d40ccadec39d brittany-0.14.0.2/data/Test136.hs +formatted e8b4564e3bfa brittany-0.14.0.2/data/Test137.hs +formatted ddbd7b880898 brittany-0.14.0.2/data/Test138.hs +formatted 4ce9b0b36ac2 brittany-0.14.0.2/data/Test139.hs +formatted bb31ea72e15c brittany-0.14.0.2/data/Test14.hs +formatted f04daeaa79e9 brittany-0.14.0.2/data/Test140.hs +formatted 3f2c0367c6f9 brittany-0.14.0.2/data/Test141.hs +formatted edb875329172 brittany-0.14.0.2/data/Test142.hs +formatted fa53ce7f455d brittany-0.14.0.2/data/Test143.hs +formatted 1c5e166b5b3c brittany-0.14.0.2/data/Test144.hs +formatted 412dc562e63e brittany-0.14.0.2/data/Test145.hs +formatted 6594ac0ac89d brittany-0.14.0.2/data/Test146.hs +formatted 0132945dc887 brittany-0.14.0.2/data/Test147.hs +formatted 0277bb5ca795 brittany-0.14.0.2/data/Test148.hs +formatted cbbb9e8ddafa brittany-0.14.0.2/data/Test149.hs +formatted 9db344b52a25 brittany-0.14.0.2/data/Test15.hs +formatted d29a46b01b30 brittany-0.14.0.2/data/Test150.hs +formatted d4d803460298 brittany-0.14.0.2/data/Test151.hs +formatted a36d7b2912f5 brittany-0.14.0.2/data/Test152.hs +formatted ea0b611491be brittany-0.14.0.2/data/Test153.hs +formatted 6607ab7d8924 brittany-0.14.0.2/data/Test154.hs +formatted 66cbd556135d brittany-0.14.0.2/data/Test155.hs +formatted 2913f4f1ea6b brittany-0.14.0.2/data/Test156.hs +formatted 57f3fe7514c4 brittany-0.14.0.2/data/Test157.hs +formatted 7cff7b0ac651 brittany-0.14.0.2/data/Test158.hs +formatted d8fde995e15b brittany-0.14.0.2/data/Test159.hs +formatted b65a3702395c brittany-0.14.0.2/data/Test16.hs +formatted 8f083a4a74fc brittany-0.14.0.2/data/Test160.hs +formatted 756b8d709d75 brittany-0.14.0.2/data/Test161.hs +formatted fb931ccfd1e4 brittany-0.14.0.2/data/Test162.hs +formatted 30ebe5ac65f1 brittany-0.14.0.2/data/Test163.hs +formatted 729a285d4963 brittany-0.14.0.2/data/Test164.hs +formatted 1d7b340799de brittany-0.14.0.2/data/Test165.hs +formatted 660e2a8d17c4 brittany-0.14.0.2/data/Test166.hs +formatted 9034e094d375 brittany-0.14.0.2/data/Test167.hs +formatted d8056c8b2928 brittany-0.14.0.2/data/Test168.hs +formatted cd8fce2bda23 brittany-0.14.0.2/data/Test169.hs +formatted bce8e4d3c9ba brittany-0.14.0.2/data/Test17.hs +formatted b9c1ba677274 brittany-0.14.0.2/data/Test170.hs +formatted 81fa7c381707 brittany-0.14.0.2/data/Test171.hs +formatted ac4339e3794f brittany-0.14.0.2/data/Test172.hs +formatted c651a0d78d61 brittany-0.14.0.2/data/Test173.hs +formatted 893e9047ccc9 brittany-0.14.0.2/data/Test174.hs +formatted 44a807f3c420 brittany-0.14.0.2/data/Test175.hs +formatted feac3083c99d brittany-0.14.0.2/data/Test176.hs +formatted 2cc15cb26130 brittany-0.14.0.2/data/Test177.hs +formatted 47771349ee44 brittany-0.14.0.2/data/Test178.hs +formatted fe3c3245408d brittany-0.14.0.2/data/Test179.hs +formatted 674dab4fdbcb brittany-0.14.0.2/data/Test18.hs +formatted c68cfb31f575 brittany-0.14.0.2/data/Test180.hs +formatted e6325e11af38 brittany-0.14.0.2/data/Test181.hs +formatted 42d9bc7fc2ce brittany-0.14.0.2/data/Test182.hs +formatted a1e86d78ee32 brittany-0.14.0.2/data/Test183.hs +formatted 88ddfc17a44e brittany-0.14.0.2/data/Test184.hs +formatted f6c7f8ad0585 brittany-0.14.0.2/data/Test185.hs +formatted 5016aa65eeae brittany-0.14.0.2/data/Test186.hs +formatted 1f6812c3d99f brittany-0.14.0.2/data/Test187.hs +formatted a063a95ec0b5 brittany-0.14.0.2/data/Test188.hs +formatted 67c40f7b42e6 brittany-0.14.0.2/data/Test189.hs +formatted 1b68494e9013 brittany-0.14.0.2/data/Test19.hs +formatted 96f1ef06a2f4 brittany-0.14.0.2/data/Test190.hs +formatted a063a95ec0b5 brittany-0.14.0.2/data/Test191.hs +formatted dc32174d8f9d brittany-0.14.0.2/data/Test192.hs +formatted b35395abfd05 brittany-0.14.0.2/data/Test193.hs +formatted 4d5ddfd8aaab brittany-0.14.0.2/data/Test194.hs +formatted 8bb98e83f59e brittany-0.14.0.2/data/Test195.hs +formatted 45232601b2c3 brittany-0.14.0.2/data/Test196.hs +formatted bdc233fea9ba brittany-0.14.0.2/data/Test197.hs +formatted 9ce65738e093 brittany-0.14.0.2/data/Test198.hs +formatted eec0cab9f980 brittany-0.14.0.2/data/Test199.hs +formatted 31b2046f8a67 brittany-0.14.0.2/data/Test2.hs +formatted a7a0e1c03060 brittany-0.14.0.2/data/Test20.hs +formatted d2a7653b9ba4 brittany-0.14.0.2/data/Test200.hs +formatted 585cd696f310 brittany-0.14.0.2/data/Test201.hs +formatted 8bba3630cd88 brittany-0.14.0.2/data/Test202.hs +formatted 3e4e79b5a82a brittany-0.14.0.2/data/Test203.hs +formatted 4ce40055a31c brittany-0.14.0.2/data/Test204.hs +formatted be6b7a8883f5 brittany-0.14.0.2/data/Test205.hs +formatted 8e7d7929e338 brittany-0.14.0.2/data/Test206.hs +formatted 3e6a91618060 brittany-0.14.0.2/data/Test207.hs +formatted 59f9efb3349d brittany-0.14.0.2/data/Test208.hs +formatted 79081f0fe37d brittany-0.14.0.2/data/Test209.hs +formatted b383b15d82f0 brittany-0.14.0.2/data/Test21.hs +formatted 4f8c82f9b51b brittany-0.14.0.2/data/Test210.hs +formatted 210d2b918c18 brittany-0.14.0.2/data/Test211.hs +formatted d8fb0486ae8c brittany-0.14.0.2/data/Test212.hs +formatted e75e1dd08970 brittany-0.14.0.2/data/Test213.hs +formatted 43a86c48e3e0 brittany-0.14.0.2/data/Test214.hs +formatted ccd8170ddd1c brittany-0.14.0.2/data/Test215.hs +formatted d9d08f97d6ce brittany-0.14.0.2/data/Test216.hs +formatted ee242f311cec brittany-0.14.0.2/data/Test217.hs +formatted 2c1a4f8388c7 brittany-0.14.0.2/data/Test218.hs +formatted 77521cf0255b brittany-0.14.0.2/data/Test219.hs +formatted df6920225c3e brittany-0.14.0.2/data/Test22.hs +formatted 6912b515f3d4 brittany-0.14.0.2/data/Test220.hs +formatted 7e87f164cb90 brittany-0.14.0.2/data/Test221.hs +formatted d7e0783e5c83 brittany-0.14.0.2/data/Test222.hs +formatted ac59786a0059 brittany-0.14.0.2/data/Test223.hs +formatted f4b2c131b776 brittany-0.14.0.2/data/Test224.hs +formatted fc2a39383602 brittany-0.14.0.2/data/Test225.hs +formatted 0a2523228f93 brittany-0.14.0.2/data/Test226.hs +formatted 228fee2942c2 brittany-0.14.0.2/data/Test227.hs +formatted 911d30954d07 brittany-0.14.0.2/data/Test228.hs +formatted 2f660f4ac662 brittany-0.14.0.2/data/Test229.hs +formatted fbc349a18ac2 brittany-0.14.0.2/data/Test23.hs +formatted a7a3d4cdb042 brittany-0.14.0.2/data/Test230.hs +formatted 8213e25c0010 brittany-0.14.0.2/data/Test231.hs +formatted cf2c7ac7b851 brittany-0.14.0.2/data/Test232.hs +formatted 60e66feea926 brittany-0.14.0.2/data/Test233.hs +formatted b6113299b5da brittany-0.14.0.2/data/Test234.hs +formatted 661c1fe894fb brittany-0.14.0.2/data/Test235.hs +formatted 57f09569ac82 brittany-0.14.0.2/data/Test236.hs +formatted 0dfd55915ad3 brittany-0.14.0.2/data/Test237.hs +formatted 4bc18bfc8664 brittany-0.14.0.2/data/Test238.hs +formatted f1066c5f9396 brittany-0.14.0.2/data/Test239.hs +formatted d0c0b62e11ea brittany-0.14.0.2/data/Test24.hs +formatted a51ff778ca0c brittany-0.14.0.2/data/Test240.hs +formatted 6f66ff6e7884 brittany-0.14.0.2/data/Test241.hs +formatted 7526d4749124 brittany-0.14.0.2/data/Test242.hs +formatted d600bfded86f brittany-0.14.0.2/data/Test243.hs +formatted dc1932ee9eaf brittany-0.14.0.2/data/Test244.hs +formatted 03cd50abedcb brittany-0.14.0.2/data/Test245.hs +formatted 676a58886eb0 brittany-0.14.0.2/data/Test246.hs +formatted 86d72bb559bc brittany-0.14.0.2/data/Test247.hs +formatted 15d8e562989b brittany-0.14.0.2/data/Test248.hs +formatted 95a821921e97 brittany-0.14.0.2/data/Test249.hs +formatted 372e384be5d9 brittany-0.14.0.2/data/Test25.hs +formatted c8b79c319e1b brittany-0.14.0.2/data/Test250.hs +formatted 9e983a1c88d0 brittany-0.14.0.2/data/Test251.hs +formatted e25fa77a311d brittany-0.14.0.2/data/Test252.hs +formatted 2abc462210d7 brittany-0.14.0.2/data/Test253.hs +formatted 3dab93bb6c11 brittany-0.14.0.2/data/Test254.hs +formatted ded4f913ac25 brittany-0.14.0.2/data/Test255.hs +formatted 7072c13a95c7 brittany-0.14.0.2/data/Test256.hs +formatted f79f249e0890 brittany-0.14.0.2/data/Test257.hs +formatted a9cbb8a905a0 brittany-0.14.0.2/data/Test258.hs +formatted 7c0c18756066 brittany-0.14.0.2/data/Test259.hs +formatted a9993e322f84 brittany-0.14.0.2/data/Test26.hs +formatted bd4ad74e5ad1 brittany-0.14.0.2/data/Test260.hs +formatted 40147eb0ec0f brittany-0.14.0.2/data/Test261.hs +formatted 3821b5d35161 brittany-0.14.0.2/data/Test262.hs +formatted fd9a1453387e brittany-0.14.0.2/data/Test263.hs +formatted b7281c5fb795 brittany-0.14.0.2/data/Test264.hs +formatted d815db72d171 brittany-0.14.0.2/data/Test265.hs +formatted e1e74708d396 brittany-0.14.0.2/data/Test266.hs +formatted eedcbb210202 brittany-0.14.0.2/data/Test267.hs +formatted 0ca543b36b5d brittany-0.14.0.2/data/Test268.hs +formatted 93850bc1adc9 brittany-0.14.0.2/data/Test269.hs +formatted b82004f9b520 brittany-0.14.0.2/data/Test27.hs +formatted 56d7e350bfb5 brittany-0.14.0.2/data/Test270.hs +formatted 8da0ed8508b1 brittany-0.14.0.2/data/Test271.hs +formatted 059cb60e3ffb brittany-0.14.0.2/data/Test272.hs +formatted ce7c5a9f7346 brittany-0.14.0.2/data/Test273.hs +formatted cf3d3b9f17a4 brittany-0.14.0.2/data/Test274.hs +formatted 5687e1c0c469 brittany-0.14.0.2/data/Test275.hs +formatted f54d68eb932d brittany-0.14.0.2/data/Test276.hs +formatted 5280a70aa08d brittany-0.14.0.2/data/Test277.hs +formatted 334f9705684d brittany-0.14.0.2/data/Test278.hs +formatted 9a6ca39add52 brittany-0.14.0.2/data/Test279.hs +formatted 35c64cf444f0 brittany-0.14.0.2/data/Test28.hs +formatted 2c62cf845c15 brittany-0.14.0.2/data/Test280.hs +formatted 6582acde6803 brittany-0.14.0.2/data/Test281.hs +formatted d69c5a291173 brittany-0.14.0.2/data/Test282.hs +formatted dad1fa89cc7b brittany-0.14.0.2/data/Test283.hs +formatted 61ba8c0a1014 brittany-0.14.0.2/data/Test284.hs +formatted dc5e12a45407 brittany-0.14.0.2/data/Test285.hs +formatted dc5e12a45407 brittany-0.14.0.2/data/Test286.hs +formatted f395a35ab415 brittany-0.14.0.2/data/Test287.hs +formatted 3fdaf4d18a7c brittany-0.14.0.2/data/Test288.hs +formatted 8472b4d5d119 brittany-0.14.0.2/data/Test289.hs +formatted 4b4297a0f4c5 brittany-0.14.0.2/data/Test29.hs +formatted af881940fba6 brittany-0.14.0.2/data/Test290.hs +formatted 6b8b53cb8029 brittany-0.14.0.2/data/Test291.hs +formatted afd400f5f5ca brittany-0.14.0.2/data/Test292.hs +formatted dbd53f969525 brittany-0.14.0.2/data/Test293.hs +formatted 8e4e40c43066 brittany-0.14.0.2/data/Test294.hs +formatted 5378d8225be8 brittany-0.14.0.2/data/Test295.hs +formatted efa089fba7ce brittany-0.14.0.2/data/Test296.hs +formatted f2528253489c brittany-0.14.0.2/data/Test297.hs +formatted a71313de7a74 brittany-0.14.0.2/data/Test298.hs +formatted 9c7a3513d329 brittany-0.14.0.2/data/Test299.hs +formatted e430aa9e3dac brittany-0.14.0.2/data/Test3.hs +formatted b786e0a045c4 brittany-0.14.0.2/data/Test30.hs +formatted 82411c11ab17 brittany-0.14.0.2/data/Test300.hs +formatted 6578a96b238b brittany-0.14.0.2/data/Test301.hs +formatted 8cee95f91f47 brittany-0.14.0.2/data/Test302.hs +formatted 01d16f13bc99 brittany-0.14.0.2/data/Test303.hs +formatted 2f37bef49ce1 brittany-0.14.0.2/data/Test304.hs +formatted 9d3e8b7bf639 brittany-0.14.0.2/data/Test305.hs +formatted 20c63b9ecba6 brittany-0.14.0.2/data/Test306.hs +formatted 348106878578 brittany-0.14.0.2/data/Test307.hs +formatted 017f020a856d brittany-0.14.0.2/data/Test308.hs +formatted 980708cbb4c4 brittany-0.14.0.2/data/Test309.hs +formatted b7f73c7d2a34 brittany-0.14.0.2/data/Test31.hs +formatted 3c2cc10d169b brittany-0.14.0.2/data/Test310.hs +formatted 66fcc75686ea brittany-0.14.0.2/data/Test311.hs +formatted 8897cdb0ddcd brittany-0.14.0.2/data/Test312.hs +formatted 0c098371b939 brittany-0.14.0.2/data/Test313.hs +formatted 8de65d3cce3e brittany-0.14.0.2/data/Test314.hs +formatted 3e5aa0cbbf8d brittany-0.14.0.2/data/Test315.hs +formatted 77220193f4fd brittany-0.14.0.2/data/Test316.hs +formatted 681c70c26bdd brittany-0.14.0.2/data/Test317.hs +formatted c9b19f55338f brittany-0.14.0.2/data/Test318.hs +formatted fa83330d01a6 brittany-0.14.0.2/data/Test319.hs +formatted 310b7bac3014 brittany-0.14.0.2/data/Test32.hs +formatted d911bbdfeb7f brittany-0.14.0.2/data/Test320.hs +formatted 1275e28eeb82 brittany-0.14.0.2/data/Test321.hs +formatted d51414b5c108 brittany-0.14.0.2/data/Test322.hs +formatted e318ac8aa564 brittany-0.14.0.2/data/Test323.hs +formatted f018e148e8d5 brittany-0.14.0.2/data/Test324.hs +formatted 1d0af944da7b brittany-0.14.0.2/data/Test325.hs +formatted 5798a680c21f brittany-0.14.0.2/data/Test326.hs +formatted 023057e5ea2c brittany-0.14.0.2/data/Test327.hs +formatted 2341d88441d5 brittany-0.14.0.2/data/Test328.hs +formatted 947d63282515 brittany-0.14.0.2/data/Test329.hs +formatted 786cf111bdad brittany-0.14.0.2/data/Test33.hs +formatted 9dd64349f3ea brittany-0.14.0.2/data/Test330.hs +formatted 15292e5353c7 brittany-0.14.0.2/data/Test331.hs +formatted 909ea0b219f8 brittany-0.14.0.2/data/Test332.hs +formatted 2ad0ebe6ebb0 brittany-0.14.0.2/data/Test333.hs +formatted 9b7204f946d7 brittany-0.14.0.2/data/Test334.hs +formatted 2baa737cfd00 brittany-0.14.0.2/data/Test335.hs +formatted b2addef5d712 brittany-0.14.0.2/data/Test336.hs +formatted 571c3cac2376 brittany-0.14.0.2/data/Test337.hs +formatted 7ab714dc2fd3 brittany-0.14.0.2/data/Test338.hs +formatted 0b6993151fe2 brittany-0.14.0.2/data/Test339.hs +formatted 7056ebf6bcea brittany-0.14.0.2/data/Test34.hs +formatted aed8c9d9f03b brittany-0.14.0.2/data/Test340.hs +formatted c93ad9724528 brittany-0.14.0.2/data/Test341.hs +formatted f189a1720eae brittany-0.14.0.2/data/Test342.hs +formatted 1e9cfbe2f3ab brittany-0.14.0.2/data/Test343.hs +formatted 5af677fa0a9b brittany-0.14.0.2/data/Test344.hs +formatted abe1b659b346 brittany-0.14.0.2/data/Test345.hs +formatted 3c1f80fba7f5 brittany-0.14.0.2/data/Test346.hs +formatted 7f12720f2600 brittany-0.14.0.2/data/Test347.hs +formatted 264cc0e7cf96 brittany-0.14.0.2/data/Test348.hs +formatted 03a3efa0a75e brittany-0.14.0.2/data/Test349.hs +formatted b7f73c7d2a34 brittany-0.14.0.2/data/Test35.hs +formatted 726069a13358 brittany-0.14.0.2/data/Test350.hs +formatted a50f8646bfb1 brittany-0.14.0.2/data/Test351.hs +formatted 849dab5ec39d brittany-0.14.0.2/data/Test352.hs +formatted baedf91b8ccd brittany-0.14.0.2/data/Test353.hs +formatted fcae903dc453 brittany-0.14.0.2/data/Test354.hs +formatted 2637fe2659d5 brittany-0.14.0.2/data/Test355.hs +formatted 65798192c40d brittany-0.14.0.2/data/Test356.hs +formatted 2cdb94cbf551 brittany-0.14.0.2/data/Test357.hs +formatted 501e5f69073e brittany-0.14.0.2/data/Test358.hs +formatted 86bec0344083 brittany-0.14.0.2/data/Test359.hs +formatted 987603d032ac brittany-0.14.0.2/data/Test36.hs +formatted 15308dc2dd01 brittany-0.14.0.2/data/Test360.hs +formatted 0b2ad491920b brittany-0.14.0.2/data/Test361.hs +formatted d9da88c7cdef brittany-0.14.0.2/data/Test362.hs +formatted d9831cd6816b brittany-0.14.0.2/data/Test363.hs +formatted 1ae4a98bcc4a brittany-0.14.0.2/data/Test364.hs +formatted ce4109a16e55 brittany-0.14.0.2/data/Test365.hs +formatted d16eae4aad20 brittany-0.14.0.2/data/Test366.hs +formatted b07954dfc9bf brittany-0.14.0.2/data/Test367.hs +formatted 45eeef287ee4 brittany-0.14.0.2/data/Test368.hs +formatted e61e587a6843 brittany-0.14.0.2/data/Test369.hs +formatted f500b3d5f559 brittany-0.14.0.2/data/Test37.hs +formatted 08718fefbaf6 brittany-0.14.0.2/data/Test370.hs +formatted 2fc71603e098 brittany-0.14.0.2/data/Test371.hs +formatted 34177b9d84e3 brittany-0.14.0.2/data/Test372.hs +formatted 5fa71c232724 brittany-0.14.0.2/data/Test373.hs +formatted f5fca966196b brittany-0.14.0.2/data/Test374.hs +formatted a4d64bf7587b brittany-0.14.0.2/data/Test375.hs +formatted 14e2ed1f0f63 brittany-0.14.0.2/data/Test376.hs +formatted f5a4e0c1e34f brittany-0.14.0.2/data/Test377.hs +formatted bddefc49765b brittany-0.14.0.2/data/Test378.hs +formatted ea19c516bcbf brittany-0.14.0.2/data/Test379.hs +formatted 7335e7ca5bd3 brittany-0.14.0.2/data/Test38.hs +formatted d2ee555751f5 brittany-0.14.0.2/data/Test380.hs +formatted 3823e3c2d919 brittany-0.14.0.2/data/Test381.hs +formatted 80271da1e835 brittany-0.14.0.2/data/Test382.hs +formatted ed5f4e8c4709 brittany-0.14.0.2/data/Test383.hs +formatted d4963535df46 brittany-0.14.0.2/data/Test384.hs +formatted 6ced47de66db brittany-0.14.0.2/data/Test385.hs +formatted 1570d72029b7 brittany-0.14.0.2/data/Test386.hs +formatted 1416aa178cdb brittany-0.14.0.2/data/Test387.hs +formatted edfafa8fb3e5 brittany-0.14.0.2/data/Test388.hs +formatted 4e122b4b2697 brittany-0.14.0.2/data/Test389.hs +formatted 6c58063d3fab brittany-0.14.0.2/data/Test39.hs +formatted fac1b1c7f0c1 brittany-0.14.0.2/data/Test390.hs +formatted edfafa8fb3e5 brittany-0.14.0.2/data/Test391.hs +formatted b0d3ee7240ad brittany-0.14.0.2/data/Test392.hs +formatted 3742d5df31d3 brittany-0.14.0.2/data/Test393.hs +formatted 28dd7a32aa13 brittany-0.14.0.2/data/Test394.hs +formatted 91de5c22d799 brittany-0.14.0.2/data/Test395.hs +formatted 15521d568177 brittany-0.14.0.2/data/Test396.hs +formatted bc632756e066 brittany-0.14.0.2/data/Test397.hs +formatted fc2de0dfca48 brittany-0.14.0.2/data/Test398.hs +formatted 8294327ebf8b brittany-0.14.0.2/data/Test399.hs +formatted c3cdd2cbcecc brittany-0.14.0.2/data/Test4.hs +formatted c8a00284c5f4 brittany-0.14.0.2/data/Test40.hs +formatted e55074dcd689 brittany-0.14.0.2/data/Test400.hs +formatted 4da9e5870180 brittany-0.14.0.2/data/Test401.hs +formatted 74396290a673 brittany-0.14.0.2/data/Test402.hs +formatted d2fafd899e89 brittany-0.14.0.2/data/Test403.hs +formatted dede30d772d6 brittany-0.14.0.2/data/Test404.hs +formatted 899e8af490d3 brittany-0.14.0.2/data/Test405.hs +formatted 6a318c357310 brittany-0.14.0.2/data/Test406.hs +formatted 183f062112e1 brittany-0.14.0.2/data/Test407.hs +formatted 55c58dc8cf59 brittany-0.14.0.2/data/Test408.hs +formatted a04dc9525882 brittany-0.14.0.2/data/Test409.hs +formatted cdc2db1c8449 brittany-0.14.0.2/data/Test41.hs +formatted a59bda637fa1 brittany-0.14.0.2/data/Test410.hs +formatted c65e5f1f3ba5 brittany-0.14.0.2/data/Test411.hs +formatted 462efbd02872 brittany-0.14.0.2/data/Test412.hs +formatted 4fc4ab30dcc3 brittany-0.14.0.2/data/Test413.hs +formatted d9eab58246aa brittany-0.14.0.2/data/Test414.hs +formatted 3d11263d426e brittany-0.14.0.2/data/Test415.hs +formatted dbbe7b5f2b24 brittany-0.14.0.2/data/Test416.hs +formatted 099959230be5 brittany-0.14.0.2/data/Test417.hs +formatted 056c3c85e1ce brittany-0.14.0.2/data/Test418.hs +formatted bd3660de0717 brittany-0.14.0.2/data/Test419.hs +formatted e3f087db5440 brittany-0.14.0.2/data/Test42.hs +formatted 821fd8910ac5 brittany-0.14.0.2/data/Test420.hs +formatted d9b47c23fec6 brittany-0.14.0.2/data/Test421.hs +formatted 15fe8b3f5a9e brittany-0.14.0.2/data/Test422.hs +formatted cafda87f90a6 brittany-0.14.0.2/data/Test423.hs +formatted 7fa298da41f9 brittany-0.14.0.2/data/Test424.hs +formatted acddf7b49624 brittany-0.14.0.2/data/Test425.hs +formatted 84cfb756f2f4 brittany-0.14.0.2/data/Test426.hs +formatted 33c641a7a072 brittany-0.14.0.2/data/Test427.hs +formatted 19772ef1090c brittany-0.14.0.2/data/Test428.hs +formatted 07a30e1c142f brittany-0.14.0.2/data/Test429.hs +formatted 6aa1c5a0086b brittany-0.14.0.2/data/Test43.hs +formatted f5d76f5634f5 brittany-0.14.0.2/data/Test430.hs +formatted 9aae587a1706 brittany-0.14.0.2/data/Test431.hs +formatted cab5eb48ea87 brittany-0.14.0.2/data/Test432.hs +formatted 035c19e15e23 brittany-0.14.0.2/data/Test433.hs +formatted 54c8c833912d brittany-0.14.0.2/data/Test434.hs +formatted 4b85517ecc64 brittany-0.14.0.2/data/Test435.hs +formatted ab4c449d67c6 brittany-0.14.0.2/data/Test436.hs +formatted 9e0a9c4de4a7 brittany-0.14.0.2/data/Test437.hs +formatted 22f3bbfaab9e brittany-0.14.0.2/data/Test438.hs +formatted 27ee3c3a9f1d brittany-0.14.0.2/data/Test439.hs +formatted bc6e01f7c126 brittany-0.14.0.2/data/Test44.hs +formatted f114f80afa88 brittany-0.14.0.2/data/Test440.hs +formatted 91959f72bf42 brittany-0.14.0.2/data/Test441.hs +formatted e100c133e0a6 brittany-0.14.0.2/data/Test442.hs +formatted a447fa310286 brittany-0.14.0.2/data/Test443.hs +formatted afb74691ba25 brittany-0.14.0.2/data/Test444.hs +formatted b04dcb13770d brittany-0.14.0.2/data/Test445.hs +formatted 005984004c81 brittany-0.14.0.2/data/Test446.hs +formatted 519cfd48a90e brittany-0.14.0.2/data/Test447.hs +formatted 245fb4545054 brittany-0.14.0.2/data/Test448.hs +formatted 036f126597a1 brittany-0.14.0.2/data/Test449.hs +formatted 914e8892ce9f brittany-0.14.0.2/data/Test45.hs +formatted dfae62440755 brittany-0.14.0.2/data/Test450.hs +formatted 3d8e022d4ea8 brittany-0.14.0.2/data/Test451.hs +formatted 204a8f956d01 brittany-0.14.0.2/data/Test452.hs +formatted 3ae152eef9f8 brittany-0.14.0.2/data/Test453.hs +formatted dd5c2ba000d9 brittany-0.14.0.2/data/Test454.hs +formatted 255bf40fcf81 brittany-0.14.0.2/data/Test455.hs +formatted 186aedf45b55 brittany-0.14.0.2/data/Test456.hs +formatted 00342a85f4ce brittany-0.14.0.2/data/Test457.hs +formatted 4d9ccb4d6155 brittany-0.14.0.2/data/Test458.hs +formatted 33f453ac627f brittany-0.14.0.2/data/Test459.hs +formatted 65a9efd49258 brittany-0.14.0.2/data/Test46.hs +formatted dbfa4f771264 brittany-0.14.0.2/data/Test460.hs +formatted 75bf53838e5c brittany-0.14.0.2/data/Test461.hs +formatted 5fde28db6063 brittany-0.14.0.2/data/Test462.hs +formatted ff5bcd3737f2 brittany-0.14.0.2/data/Test463.hs +formatted e30c0ff394dd brittany-0.14.0.2/data/Test464.hs +formatted 82f7c7fb716e brittany-0.14.0.2/data/Test465.hs +formatted f59579bd97ca brittany-0.14.0.2/data/Test466.hs +formatted 5909971846f9 brittany-0.14.0.2/data/Test467.hs +formatted fe8bf0d3f053 brittany-0.14.0.2/data/Test468.hs +formatted 79dd70b7320f brittany-0.14.0.2/data/Test469.hs +formatted 1983a10a25f3 brittany-0.14.0.2/data/Test47.hs +formatted 271132ce279b brittany-0.14.0.2/data/Test470.hs +formatted 14a056182567 brittany-0.14.0.2/data/Test471.hs +formatted cbe652ef0cbb brittany-0.14.0.2/data/Test472.hs +formatted 3bf39beb5bf7 brittany-0.14.0.2/data/Test473.hs +formatted ac6e5e3c9b28 brittany-0.14.0.2/data/Test474.hs +formatted 7752938de9c6 brittany-0.14.0.2/data/Test475.hs +formatted 756e0e0edd8b brittany-0.14.0.2/data/Test476.hs +formatted a87acb3bdeb3 brittany-0.14.0.2/data/Test477.hs +formatted d489d082ed14 brittany-0.14.0.2/data/Test478.hs +formatted dca2bbac2e81 brittany-0.14.0.2/data/Test479.hs +formatted 00909af2b184 brittany-0.14.0.2/data/Test48.hs +formatted 0150b83ded52 brittany-0.14.0.2/data/Test480.hs +formatted 9fd1038ae87c brittany-0.14.0.2/data/Test481.hs +formatted 99e73c09fd8f brittany-0.14.0.2/data/Test482.hs +formatted b6e0c157ec82 brittany-0.14.0.2/data/Test483.hs +formatted 5308cabef2dd brittany-0.14.0.2/data/Test484.hs +formatted 3b0850dd8d8d brittany-0.14.0.2/data/Test485.hs +formatted 3a14007e64e3 brittany-0.14.0.2/data/Test486.hs +formatted e28b3f6dc92a brittany-0.14.0.2/data/Test487.hs +formatted d7ac2e728ca4 brittany-0.14.0.2/data/Test488.hs +formatted 3455b362a4d8 brittany-0.14.0.2/data/Test489.hs +formatted 379cdfc91569 brittany-0.14.0.2/data/Test49.hs +formatted d2c2b5b45546 brittany-0.14.0.2/data/Test490.hs +formatted 964f39f9fdd1 brittany-0.14.0.2/data/Test491.hs +formatted d469e1b3965b brittany-0.14.0.2/data/Test492.hs +formatted d469e1b3965b brittany-0.14.0.2/data/Test493.hs +formatted 1eddc3503b32 brittany-0.14.0.2/data/Test494.hs +formatted 196d9b015a57 brittany-0.14.0.2/data/Test495.hs +formatted fae583830ad8 brittany-0.14.0.2/data/Test496.hs +formatted cbeb80fac007 brittany-0.14.0.2/data/Test497.hs +formatted 326e5653c262 brittany-0.14.0.2/data/Test498.hs +formatted 7f7e87e04f47 brittany-0.14.0.2/data/Test499.hs +formatted 3bb5ad04d6c9 brittany-0.14.0.2/data/Test5.hs +formatted 30d139cbecdf brittany-0.14.0.2/data/Test50.hs +formatted bb1de50ba61a brittany-0.14.0.2/data/Test500.hs +formatted 46987cddeeb1 brittany-0.14.0.2/data/Test501.hs +formatted a26bb5e5e289 brittany-0.14.0.2/data/Test502.hs +formatted 608441a45ea2 brittany-0.14.0.2/data/Test503.hs +formatted 088a029a2027 brittany-0.14.0.2/data/Test504.hs +formatted b8d19bd75331 brittany-0.14.0.2/data/Test505.hs +formatted 7aafe7248e10 brittany-0.14.0.2/data/Test506.hs +formatted 4c5c5d2bb818 brittany-0.14.0.2/data/Test507.hs +formatted a017d7235dda brittany-0.14.0.2/data/Test508.hs +formatted 525ac73a7645 brittany-0.14.0.2/data/Test509.hs +formatted bdb9309b69ef brittany-0.14.0.2/data/Test51.hs +formatted be3e1e21b3e7 brittany-0.14.0.2/data/Test510.hs +formatted 386680696e97 brittany-0.14.0.2/data/Test511.hs +formatted c74bbb4b17cf brittany-0.14.0.2/data/Test512.hs +formatted bb9ffbc270ba brittany-0.14.0.2/data/Test513.hs +formatted 4babc1db968e brittany-0.14.0.2/data/Test514.hs +formatted 4babc1db968e brittany-0.14.0.2/data/Test515.hs +formatted 4ef117d8e3e2 brittany-0.14.0.2/data/Test516.hs +formatted 9cdba405b7be brittany-0.14.0.2/data/Test517.hs +formatted 6192bf9c4318 brittany-0.14.0.2/data/Test518.hs +formatted 438975b07785 brittany-0.14.0.2/data/Test519.hs +formatted 3e9fb57fe53f brittany-0.14.0.2/data/Test52.hs +formatted e0922f030820 brittany-0.14.0.2/data/Test520.hs +formatted 7a6eceaa78bc brittany-0.14.0.2/data/Test521.hs +formatted cd889668f531 brittany-0.14.0.2/data/Test522.hs +formatted 5eae819cfab2 brittany-0.14.0.2/data/Test523.hs +formatted cdd55a113657 brittany-0.14.0.2/data/Test524.hs +formatted 948aab2f7cf9 brittany-0.14.0.2/data/Test525.hs +formatted 74dd57f3e6b2 brittany-0.14.0.2/data/Test526.hs +formatted ebc6624271d5 brittany-0.14.0.2/data/Test527.hs +formatted 6d566659bc06 brittany-0.14.0.2/data/Test528.hs +formatted 86bb82b0ae12 brittany-0.14.0.2/data/Test529.hs +formatted 113cb843c235 brittany-0.14.0.2/data/Test53.hs +formatted c77ad7418bdb brittany-0.14.0.2/data/Test530.hs +formatted e82e4a69ecaf brittany-0.14.0.2/data/Test531.hs +formatted 98d38ba919b8 brittany-0.14.0.2/data/Test532.hs +formatted 93f0725e6f33 brittany-0.14.0.2/data/Test533.hs +formatted 2f3eea919721 brittany-0.14.0.2/data/Test534.hs +formatted 4dfe442efa9f brittany-0.14.0.2/data/Test535.hs +formatted 083e49e545b1 brittany-0.14.0.2/data/Test536.hs +formatted a93167132f4b brittany-0.14.0.2/data/Test537.hs +formatted 76a9d8390ac0 brittany-0.14.0.2/data/Test538.hs +formatted cb52a4163a3d brittany-0.14.0.2/data/Test539.hs +formatted 3206388ca862 brittany-0.14.0.2/data/Test54.hs +formatted 32bac85b1c99 brittany-0.14.0.2/data/Test540.hs +formatted c1076b4718f2 brittany-0.14.0.2/data/Test55.hs +formatted 5b5da4a27041 brittany-0.14.0.2/data/Test56.hs +formatted 7d48cd742ee9 brittany-0.14.0.2/data/Test57.hs +formatted 09a9442047e7 brittany-0.14.0.2/data/Test58.hs +formatted 007b3f5499fb brittany-0.14.0.2/data/Test59.hs +formatted d9ed4ebe21ed brittany-0.14.0.2/data/Test6.hs +formatted 87e8860858b2 brittany-0.14.0.2/data/Test60.hs +formatted 7bba808f3304 brittany-0.14.0.2/data/Test61.hs +formatted 7e7c53e8f5f9 brittany-0.14.0.2/data/Test62.hs +formatted 38957227fb18 brittany-0.14.0.2/data/Test63.hs +formatted d1d477cbcd19 brittany-0.14.0.2/data/Test64.hs +formatted abec5eceeaf7 brittany-0.14.0.2/data/Test65.hs +formatted 7e83cb328466 brittany-0.14.0.2/data/Test66.hs +formatted 08c924dc75db brittany-0.14.0.2/data/Test67.hs +formatted 534f9f24c4c4 brittany-0.14.0.2/data/Test68.hs +formatted 0edc4bf88879 brittany-0.14.0.2/data/Test69.hs +formatted 6e4a80a16587 brittany-0.14.0.2/data/Test7.hs +formatted c26c8d4af0d4 brittany-0.14.0.2/data/Test70.hs +formatted 7f9b2bb1df69 brittany-0.14.0.2/data/Test71.hs +formatted 9d549df4742d brittany-0.14.0.2/data/Test72.hs +formatted 05ed72d9e760 brittany-0.14.0.2/data/Test73.hs +formatted a54128f146c1 brittany-0.14.0.2/data/Test74.hs +formatted 29302a244e5c brittany-0.14.0.2/data/Test75.hs +formatted 89a2a63deffe brittany-0.14.0.2/data/Test76.hs +formatted 7a3ad7569e3d brittany-0.14.0.2/data/Test77.hs +formatted 286a50a0eb22 brittany-0.14.0.2/data/Test78.hs +formatted bc99bdbbbb1e brittany-0.14.0.2/data/Test79.hs +formatted 0a8cec799b2a brittany-0.14.0.2/data/Test8.hs +formatted 2f2e96416d6d brittany-0.14.0.2/data/Test80.hs +formatted d1d172867e08 brittany-0.14.0.2/data/Test81.hs +formatted f66f9b2381e3 brittany-0.14.0.2/data/Test82.hs +formatted 4fe035cf193a brittany-0.14.0.2/data/Test83.hs +formatted 43e925441c75 brittany-0.14.0.2/data/Test84.hs +formatted dddcd81d8e89 brittany-0.14.0.2/data/Test85.hs +formatted b34676f3162a brittany-0.14.0.2/data/Test86.hs +formatted 847e26a48a11 brittany-0.14.0.2/data/Test87.hs +formatted d37afb2bca9c brittany-0.14.0.2/data/Test88.hs +formatted 870cc6003dc1 brittany-0.14.0.2/data/Test89.hs +formatted cd000b5a236a brittany-0.14.0.2/data/Test9.hs +formatted 14a1a4f54ceb brittany-0.14.0.2/data/Test90.hs +formatted 583f169ace4c brittany-0.14.0.2/data/Test91.hs +formatted 1d30d5458df2 brittany-0.14.0.2/data/Test92.hs +formatted 21ca73bf65e9 brittany-0.14.0.2/data/Test93.hs +formatted 2640ff7299cc brittany-0.14.0.2/data/Test94.hs +formatted 139f17bd37c8 brittany-0.14.0.2/data/Test95.hs +formatted 3f35ed17b5d4 brittany-0.14.0.2/data/Test96.hs +formatted 54dbf9915298 brittany-0.14.0.2/data/Test97.hs +formatted 25178db879d4 brittany-0.14.0.2/data/Test98.hs +formatted 52caf5793d73 brittany-0.14.0.2/data/Test99.hs +formatted 7a5d0ee67b99 brittany-0.14.0.2/source/executable/Main.hs +formatted f006bb65ddb6 brittany-0.14.0.2/source/library/Language/Haskell/Brittany.hs +formatted bd3007c00bcb brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal.hs +formatted 52c61c8f36a7 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Backend.hs +formatted d92b21322bd4 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/BackendUtils.hs +formatted 6c0d53b31d45 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Config.hs +formatted 4387eb5344c3 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Config/Types.hs +formatted e13b5e1cf845 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs +formatted 3a7e4e0507b6 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +formatted 10f39372ebc8 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/LayouterBasics.hs +formatted 5d4ba42810fc brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs +formatted c1d4180a7364 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +formatted 6da334c9b8cc brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +formatted 63ac93aa854f brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot +formatted acf1184a4039 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/IE.hs +formatted ba5e2c3aa9ff brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Import.hs +formatted b3eeef75906a brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Module.hs +formatted c314ecc033b2 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs +formatted d46ed5a9675b brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +formatted 08c3e5d27dd4 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot +formatted 48b61a61db4a brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Layouters/Type.hs +formatted 8d7327e29615 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Obfuscation.hs +formatted 0dc2352f4480 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/ParseModule.hs +formatted 79e767ee3e91 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Prelude.hs +formatted 1a8db66fd521 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/PreludeUtils.hs +formatted 7bd9ea5667be brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs +formatted 8524c6970b7f brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Columns.hs +formatted 73d5a7f6f8f9 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Floating.hs +formatted e2ac60fc2da6 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Indent.hs +formatted 2ed0cc6dc5ae brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Par.hs +formatted a0c752ec0c1d brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Types.hs +formatted df622f9a5a85 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Utils.hs +formatted 5e05cfeb3dd6 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Main.hs +formatted e425ebfb8e97 brittany-0.14.0.2/source/test-suite/Main.hs +formatted e865ae48f11b capability-0.5.0.1/Setup.hs +formatted eb7b2158a88b capability-0.5.0.1/examples/CountLog.hs +formatted aa1d67f90726 capability-0.5.0.1/examples/Error.hs +formatted 7bb91536c52e capability-0.5.0.1/examples/Reader.hs +formatted cf7788db327f capability-0.5.0.1/examples/Reflection.hs +formatted 4ca78b40a428 capability-0.5.0.1/examples/Sink.hs +formatted 4bd9f1f5ce20 capability-0.5.0.1/examples/State.hs +formatted de729285889f capability-0.5.0.1/examples/Test.hs +formatted bc483d61ffa2 capability-0.5.0.1/examples/Test/Common.hs +formatted 6c9e8b236461 capability-0.5.0.1/examples/WordCount.hs +formatted 9a2c6692cf10 capability-0.5.0.1/examples/Writer.hs +formatted c7634b7f4e60 capability-0.5.0.1/src/Capability.hs +formatted 83447b7b7ea5 capability-0.5.0.1/src/Capability/Accessors.hs +formatted 8d8d36f3f008 capability-0.5.0.1/src/Capability/Constraints.hs +formatted f8fc4a2aaee2 capability-0.5.0.1/src/Capability/Derive.hs +formatted 08904961a765 capability-0.5.0.1/src/Capability/Error.hs +formatted 97515747424b capability-0.5.0.1/src/Capability/Reader.hs +formatted 89877e765220 capability-0.5.0.1/src/Capability/Reader/Internal/Class.hs +formatted 007089e89b2a capability-0.5.0.1/src/Capability/Reader/Internal/Strategies.hs +formatted cdf1d99e626f capability-0.5.0.1/src/Capability/Reflection.hs +formatted 42f2a624abd3 capability-0.5.0.1/src/Capability/Sink.hs +formatted dc0a5d3d3878 capability-0.5.0.1/src/Capability/Sink/Internal/Class.hs +formatted 074cd292b8a7 capability-0.5.0.1/src/Capability/Sink/Internal/Strategies.hs +formatted d6a811b81394 capability-0.5.0.1/src/Capability/Source.hs +formatted 7655749a90f6 capability-0.5.0.1/src/Capability/Source/Internal/Class.hs +formatted b718392f90a6 capability-0.5.0.1/src/Capability/Source/Internal/Strategies.hs +formatted e288db1d616d capability-0.5.0.1/src/Capability/State.hs +formatted 9d0280d2e19e capability-0.5.0.1/src/Capability/State/Internal/Class.hs +formatted 77e19ee12ef0 capability-0.5.0.1/src/Capability/State/Internal/Strategies.hs +formatted e0fc7f2c44f9 capability-0.5.0.1/src/Capability/State/Internal/Strategies/Common.hs +formatted dca34ed58cfd capability-0.5.0.1/src/Capability/Stream.hs +formatted 6cd51b2d63f1 capability-0.5.0.1/src/Capability/TypeOf.hs +formatted 9a266b123a93 capability-0.5.0.1/src/Capability/Writer.hs +formatted e865ae48f11b cassava-0.5.5.0/Setup.hs +formatted f8de97e1c58a cassava-0.5.5.0/examples/IncrementalIndexedBasedDecode.hs +formatted b9e7e3d9a0fb cassava-0.5.5.0/examples/IncrementalNamedBasedEncode.hs +formatted a004028b7dc3 cassava-0.5.5.0/examples/IndexBasedDecode.hs +formatted 03830830ed9e cassava-0.5.5.0/examples/IndexBasedGeneric.hs +formatted f4fb7ce7564b cassava-0.5.5.0/examples/NamedBasedDecode.hs +formatted ecf9a4c54a67 cassava-0.5.5.0/examples/NamedBasedExplicitDecode.hs +formatted d51604b7e89f cassava-0.5.5.0/examples/NamedBasedGeneric.hs +formatted 9612391bd37b cassava-0.5.5.0/examples/StreamingIndexBasedDecode.hs +formatted efc1fe9896ec cassava-0.5.5.0/src/Data/Csv.hs +formatted 817b8cca8d06 cassava-0.5.5.0/src/Data/Csv/Builder.hs +formatted 38c7c4badf0a cassava-0.5.5.0/src/Data/Csv/Conversion.hs +formatted a4c56813cba7 cassava-0.5.5.0/src/Data/Csv/Conversion/Internal.hs +formatted 5906452b290a cassava-0.5.5.0/src/Data/Csv/Encoding.hs +formatted 32c60ff1a4fd cassava-0.5.5.0/src/Data/Csv/Incremental.hs +formatted be1c60df3b34 cassava-0.5.5.0/src/Data/Csv/Parser.hs +formatted 014bb9b262b9 cassava-0.5.5.0/src/Data/Csv/Streaming.hs +formatted 20f42a736b97 cassava-0.5.5.0/src/Data/Csv/Types.hs +formatted 4a5a0e1a51c9 cassava-0.5.5.0/src/Data/Csv/Util.hs +formatted a844141d1fe8 cassava-0.5.5.0/tests/UnitTests.hs +formatted 7dbba0331af5 comonad-5.0.10/examples/History.hs +formatted f218701f2ac5 comonad-5.0.10/src/Control/Comonad.hs +formatted d084cf5c7fa7 comonad-5.0.10/src/Control/Comonad/Env.hs +formatted 3b8ec012a04c comonad-5.0.10/src/Control/Comonad/Env/Class.hs +formatted 0dcf633542eb comonad-5.0.10/src/Control/Comonad/Hoist/Class.hs +formatted 4bfafba3ce3b comonad-5.0.10/src/Control/Comonad/Identity.hs +formatted 49b438747b63 comonad-5.0.10/src/Control/Comonad/Store.hs +formatted cf408da422ba comonad-5.0.10/src/Control/Comonad/Store/Class.hs +formatted 2c72a397c339 comonad-5.0.10/src/Control/Comonad/Traced.hs +formatted da617308f9a3 comonad-5.0.10/src/Control/Comonad/Traced/Class.hs +formatted adbd6d7e0f72 comonad-5.0.10/src/Control/Comonad/Trans/Class.hs +formatted 871b9e0bc5cd comonad-5.0.10/src/Control/Comonad/Trans/Env.hs +formatted c405a550608b comonad-5.0.10/src/Control/Comonad/Trans/Identity.hs +formatted 6b990e80a8eb comonad-5.0.10/src/Control/Comonad/Trans/Store.hs +formatted b9f942c1ae6c comonad-5.0.10/src/Control/Comonad/Trans/Traced.hs +formatted 34f425eff98b comonad-5.0.10/src/Data/Functor/Composition.hs +formatted be111de01001 conduit-1.3.6.1/benchmarks/optimize-201408.hs +formatted f70f6155e62a conduit-1.3.6.1/benchmarks/unfused.hs +formatted 20fad0c5aecd conduit-1.3.6.1/src/Conduit.hs +formatted bf88ceabad43 conduit-1.3.6.1/src/Data/Conduit.hs +formatted 6fba99ab1b1b conduit-1.3.6.1/src/Data/Conduit/Combinators.hs +formatted 9e46f7ab29ac conduit-1.3.6.1/src/Data/Conduit/Combinators/Stream.hs +formatted 1290e9b983f1 conduit-1.3.6.1/src/Data/Conduit/Combinators/Unqualified.hs +formatted 8e861a915c2f conduit-1.3.6.1/src/Data/Conduit/Internal.hs +formatted 2081cc2fc43d conduit-1.3.6.1/src/Data/Conduit/Internal/Conduit.hs +formatted bbfd28e5b98b conduit-1.3.6.1/src/Data/Conduit/Internal/Fusion.hs +formatted 54120af8edce conduit-1.3.6.1/src/Data/Conduit/Internal/List/Stream.hs +formatted 2fe8b1b7e798 conduit-1.3.6.1/src/Data/Conduit/Internal/Pipe.hs +formatted 4a4c14b72249 conduit-1.3.6.1/src/Data/Conduit/Lift.hs +formatted 15e5ac8a2cb1 conduit-1.3.6.1/src/Data/Conduit/List.hs +formatted 55a50272f6a7 conduit-1.3.6.1/src/Data/Streaming/FileRead.hs +formatted 71e1c3bf7039 conduit-1.3.6.1/src/Data/Streaming/Filesystem.hs +formatted d9e8dbaa2534 conduit-1.3.6.1/test/Data/Conduit/Extra/ZipConduitSpec.hs +formatted 3df81ded6599 conduit-1.3.6.1/test/Data/Conduit/StreamSpec.hs +formatted cf41359a6248 conduit-1.3.6.1/test/Spec.hs +formatted d10fe79bbeec conduit-1.3.6.1/test/StreamSpec.hs +formatted db2295b8113a conduit-1.3.6.1/test/doctests.hs +formatted a21201eaf0ea conduit-1.3.6.1/test/main.hs +formatted e29ee20973f2 contravariant-1.5.6/old-src/Data/Functor/Contravariant.hs +formatted acc631e94060 contravariant-1.5.6/src/Data/Functor/Contravariant/Compose.hs +formatted 12261ada3c4f contravariant-1.5.6/src/Data/Functor/Contravariant/Divisible.hs +formatted 6e8599bf8082 contravariant-1.5.6/src/Data/Functor/Contravariant/Generic.hs +formatted 2841bd16822b criterion-1.6.5.0/Criterion.hs +formatted ee1798194249 criterion-1.6.5.0/Criterion/Analysis.hs +formatted c039ba5918a9 criterion-1.6.5.0/Criterion/EmbeddedData.hs +formatted f07714df2d3d criterion-1.6.5.0/Criterion/IO.hs +formatted 9cbbe0381e04 criterion-1.6.5.0/Criterion/IO/Printf.hs +formatted 6b182673462d criterion-1.6.5.0/Criterion/Internal.hs +formatted 9c5a685a07c7 criterion-1.6.5.0/Criterion/Main.hs +formatted 99f71e90fa4b criterion-1.6.5.0/Criterion/Main/Options.hs +formatted aab23b74a86d criterion-1.6.5.0/Criterion/Monad.hs +formatted bbcaa9535a9f criterion-1.6.5.0/Criterion/Monad/Internal.hs +formatted b2eb4d4fb4eb criterion-1.6.5.0/Criterion/Report.hs +formatted 74308ba37d6a criterion-1.6.5.0/Criterion/Types.hs +formatted 54f92871c793 criterion-1.6.5.0/app/Options.hs +formatted 49dcbeebb5c4 criterion-1.6.5.0/app/Report.hs +formatted a437ea93f53e criterion-1.6.5.0/examples/BadReadFile.hs +formatted bfb4844251ca criterion-1.6.5.0/examples/Comparison.hs +formatted f54fba36e069 criterion-1.6.5.0/examples/ConduitVsPipes.hs +formatted a4f8cda29d3c criterion-1.6.5.0/examples/ExtensibleCLI.hs +formatted 8f4df570ff4e criterion-1.6.5.0/examples/Fibber.hs +formatted 9196e3f4c3d7 criterion-1.6.5.0/examples/GoodReadFile.hs +formatted 30240b972d60 criterion-1.6.5.0/examples/Judy.hs +formatted 7d1ede331f1f criterion-1.6.5.0/examples/Maps.hs +formatted f396bcf9c829 criterion-1.6.5.0/examples/Overhead.hs +formatted 3a50edf5477c criterion-1.6.5.0/examples/Quotes.hs +formatted ce8d353ea567 criterion-1.6.5.0/tests/Cleanup.hs +formatted 78253dc00e1a criterion-1.6.5.0/tests/Properties.hs +formatted a99e4edb542c criterion-1.6.5.0/tests/Sanity.hs +formatted f8a8d8f2c4ae criterion-1.6.5.0/tests/Tests.hs +formatted 44af498375d5 cryptonite-0.30/Crypto/Cipher/AES.hs +formatted 2240267dad51 cryptonite-0.30/Crypto/Cipher/AES/Primitive.hs +formatted 5694da9617bf cryptonite-0.30/Crypto/Cipher/AESGCMSIV.hs +formatted ab05e6ed96e9 cryptonite-0.30/Crypto/Cipher/Blowfish.hs +formatted 98e1845904ad cryptonite-0.30/Crypto/Cipher/Blowfish/Box.hs +formatted 23c195272bfd cryptonite-0.30/Crypto/Cipher/Blowfish/Primitive.hs +formatted 7ece5bd42232 cryptonite-0.30/Crypto/Cipher/CAST5.hs +formatted d0210ba9a96f cryptonite-0.30/Crypto/Cipher/CAST5/Primitive.hs +formatted c818f5ccfd4a cryptonite-0.30/Crypto/Cipher/Camellia.hs +formatted f429b69d6156 cryptonite-0.30/Crypto/Cipher/Camellia/Primitive.hs +formatted dbd216d2f0aa cryptonite-0.30/Crypto/Cipher/ChaCha.hs +formatted bcadafa03089 cryptonite-0.30/Crypto/Cipher/ChaChaPoly1305.hs +formatted 092e6bcae818 cryptonite-0.30/Crypto/Cipher/DES.hs +formatted 7b3282079b6c cryptonite-0.30/Crypto/Cipher/DES/Primitive.hs +formatted bc58b513348e cryptonite-0.30/Crypto/Cipher/RC4.hs +formatted d59fa1e97895 cryptonite-0.30/Crypto/Cipher/Salsa.hs +formatted 58b5729d32db cryptonite-0.30/Crypto/Cipher/TripleDES.hs +formatted 8aafca6b830e cryptonite-0.30/Crypto/Cipher/Twofish.hs +formatted 7d7789d95b82 cryptonite-0.30/Crypto/Cipher/Twofish/Primitive.hs +formatted 54afbb146e5c cryptonite-0.30/Crypto/Cipher/Types.hs +formatted 9872fb82a680 cryptonite-0.30/Crypto/Cipher/Types/AEAD.hs +formatted 839caaf5c14b cryptonite-0.30/Crypto/Cipher/Types/Base.hs +formatted e02385d86f90 cryptonite-0.30/Crypto/Cipher/Types/Block.hs +formatted 7c2782316618 cryptonite-0.30/Crypto/Cipher/Types/GF.hs +formatted 17ceaf6e3360 cryptonite-0.30/Crypto/Cipher/Types/Stream.hs +formatted 6cdb1c7bd28d cryptonite-0.30/Crypto/Cipher/Types/Utils.hs +formatted f1893d3edfa7 cryptonite-0.30/Crypto/Cipher/Utils.hs +formatted 20107f92349f cryptonite-0.30/Crypto/Cipher/XSalsa.hs +formatted 117e7ce7c967 cryptonite-0.30/Crypto/ConstructHash/MiyaguchiPreneel.hs +formatted 4f15b3874982 cryptonite-0.30/Crypto/Data/AFIS.hs +formatted 37c60fc95ef2 cryptonite-0.30/Crypto/Data/Padding.hs +formatted 2ba3cd2f51b9 cryptonite-0.30/Crypto/ECC.hs +formatted 951ccc172449 cryptonite-0.30/Crypto/ECC/Edwards25519.hs +formatted e213548aa40e cryptonite-0.30/Crypto/ECC/Simple/Prim.hs +formatted 64fc04cd74ae cryptonite-0.30/Crypto/ECC/Simple/Types.hs +formatted 3560b9821c3b cryptonite-0.30/Crypto/Error.hs +formatted 0caeb40058f2 cryptonite-0.30/Crypto/Error/Types.hs +formatted bcc2e2a5ecac cryptonite-0.30/Crypto/Hash.hs +formatted 514502d73233 cryptonite-0.30/Crypto/Hash/Algorithms.hs +formatted a83eee5ae7b0 cryptonite-0.30/Crypto/Hash/Blake2.hs +formatted f99040e35232 cryptonite-0.30/Crypto/Hash/Blake2b.hs +formatted 9fc6dd4195c9 cryptonite-0.30/Crypto/Hash/Blake2bp.hs +formatted aa6fb8816478 cryptonite-0.30/Crypto/Hash/Blake2s.hs +formatted 5987b76d2285 cryptonite-0.30/Crypto/Hash/Blake2sp.hs +formatted 36d330a27ffe cryptonite-0.30/Crypto/Hash/IO.hs +formatted 527ac917164f cryptonite-0.30/Crypto/Hash/Keccak.hs +formatted 988960beff03 cryptonite-0.30/Crypto/Hash/MD2.hs +formatted 643fd2f5f7f2 cryptonite-0.30/Crypto/Hash/MD4.hs +formatted 0176320f82f4 cryptonite-0.30/Crypto/Hash/MD5.hs +formatted 54c369b13f00 cryptonite-0.30/Crypto/Hash/RIPEMD160.hs +formatted 0cf990ecd2cd cryptonite-0.30/Crypto/Hash/SHA1.hs +formatted 6b15758ab087 cryptonite-0.30/Crypto/Hash/SHA224.hs +formatted a5a52f418404 cryptonite-0.30/Crypto/Hash/SHA256.hs +formatted 05629720d732 cryptonite-0.30/Crypto/Hash/SHA3.hs +formatted 076c9d704bf2 cryptonite-0.30/Crypto/Hash/SHA384.hs +formatted d65edf0aeac8 cryptonite-0.30/Crypto/Hash/SHA512.hs +formatted 94400683916e cryptonite-0.30/Crypto/Hash/SHA512t.hs +formatted 9b214034fb00 cryptonite-0.30/Crypto/Hash/SHAKE.hs +formatted 506e64c190a2 cryptonite-0.30/Crypto/Hash/Skein256.hs +formatted da70bee9980a cryptonite-0.30/Crypto/Hash/Skein512.hs +formatted 2f8832cc95bb cryptonite-0.30/Crypto/Hash/Tiger.hs +formatted f7994b599588 cryptonite-0.30/Crypto/Hash/Types.hs +formatted 4ea25e04f5c1 cryptonite-0.30/Crypto/Hash/Whirlpool.hs +formatted f70544b8e5f8 cryptonite-0.30/Crypto/Internal/Builder.hs +formatted 98a5de0267ed cryptonite-0.30/Crypto/Internal/ByteArray.hs +formatted f801f423094d cryptonite-0.30/Crypto/Internal/Compat.hs +formatted 54db2fce0fcc cryptonite-0.30/Crypto/Internal/CompatPrim.hs +formatted d4435b068486 cryptonite-0.30/Crypto/Internal/DeepSeq.hs +formatted 4646f54cc944 cryptonite-0.30/Crypto/Internal/Imports.hs +formatted 4878b8fb8411 cryptonite-0.30/Crypto/Internal/Nat.hs +formatted 483861a9b72d cryptonite-0.30/Crypto/Internal/WordArray.hs +formatted 5786998be3b3 cryptonite-0.30/Crypto/Internal/Words.hs +formatted 0434f24b7a9f cryptonite-0.30/Crypto/KDF/Argon2.hs +formatted 9725e47b1b66 cryptonite-0.30/Crypto/KDF/BCrypt.hs +formatted 28be07832b83 cryptonite-0.30/Crypto/KDF/BCryptPBKDF.hs +formatted 7c78160cd13d cryptonite-0.30/Crypto/KDF/HKDF.hs +formatted f25d68c357c2 cryptonite-0.30/Crypto/KDF/PBKDF2.hs +formatted 3307468c4b5d cryptonite-0.30/Crypto/KDF/Scrypt.hs +formatted 8f3891401559 cryptonite-0.30/Crypto/MAC/CMAC.hs +formatted b5b065a845f0 cryptonite-0.30/Crypto/MAC/HMAC.hs +formatted 4d0062fd1ebe cryptonite-0.30/Crypto/MAC/KMAC.hs +formatted a54d3189768c cryptonite-0.30/Crypto/MAC/Poly1305.hs +formatted c065c0ae8804 cryptonite-0.30/Crypto/Number/Basic.hs +partly-checked 27ebb2f56bcc cryptonite-0.30/Crypto/Number/Compat.hs +formatted d8e4da3cf8c5 cryptonite-0.30/Crypto/Number/F2m.hs +formatted 7b62d9f0185b cryptonite-0.30/Crypto/Number/Generate.hs +formatted 53fbd1bf4d6c cryptonite-0.30/Crypto/Number/ModArithmetic.hs +formatted 3887ba3c7c43 cryptonite-0.30/Crypto/Number/Nat.hs +formatted 930fa05c486f cryptonite-0.30/Crypto/Number/Prime.hs +formatted 3be1d9c43e52 cryptonite-0.30/Crypto/Number/Serialize.hs +formatted cfe6a456efe7 cryptonite-0.30/Crypto/Number/Serialize/Internal.hs +formatted 8f181f9bc069 cryptonite-0.30/Crypto/Number/Serialize/Internal/LE.hs +formatted c21267dc7970 cryptonite-0.30/Crypto/Number/Serialize/LE.hs +formatted 306914497f38 cryptonite-0.30/Crypto/OTP.hs +formatted 47ac3109be1c cryptonite-0.30/Crypto/PubKey/Curve25519.hs +formatted ff1bad4fe0ae cryptonite-0.30/Crypto/PubKey/Curve448.hs +formatted 7279b7fc32ee cryptonite-0.30/Crypto/PubKey/DH.hs +formatted 61fc8cd02023 cryptonite-0.30/Crypto/PubKey/DSA.hs +formatted 9671d669d9fb cryptonite-0.30/Crypto/PubKey/ECC/DH.hs +formatted face3da85363 cryptonite-0.30/Crypto/PubKey/ECC/ECDSA.hs +formatted 97c5eb3f0754 cryptonite-0.30/Crypto/PubKey/ECC/Generate.hs +formatted d4527eb98a84 cryptonite-0.30/Crypto/PubKey/ECC/P256.hs +formatted 0a2b67b3348e cryptonite-0.30/Crypto/PubKey/ECC/Prim.hs +formatted 65081a388743 cryptonite-0.30/Crypto/PubKey/ECC/Types.hs +formatted dae44ef68546 cryptonite-0.30/Crypto/PubKey/ECDSA.hs +formatted 04ef544fcbc1 cryptonite-0.30/Crypto/PubKey/ECIES.hs +formatted ca8ec46db323 cryptonite-0.30/Crypto/PubKey/Ed25519.hs +formatted dba822ca565e cryptonite-0.30/Crypto/PubKey/Ed448.hs +formatted 365814eb2b58 cryptonite-0.30/Crypto/PubKey/EdDSA.hs +formatted e083f4a748a3 cryptonite-0.30/Crypto/PubKey/ElGamal.hs +formatted 5a0517dd2399 cryptonite-0.30/Crypto/PubKey/Internal.hs +formatted 83e024783092 cryptonite-0.30/Crypto/PubKey/MaskGenFunction.hs +formatted aaafa0f20f26 cryptonite-0.30/Crypto/PubKey/RSA.hs +formatted c12317773f47 cryptonite-0.30/Crypto/PubKey/RSA/OAEP.hs +formatted b777939c6984 cryptonite-0.30/Crypto/PubKey/RSA/PKCS15.hs +formatted 9255a1c6fd3d cryptonite-0.30/Crypto/PubKey/RSA/PSS.hs +formatted 8643b6ddea84 cryptonite-0.30/Crypto/PubKey/RSA/Prim.hs +formatted 7ab3ae862f55 cryptonite-0.30/Crypto/PubKey/RSA/Types.hs +formatted a97d7fbec7cf cryptonite-0.30/Crypto/PubKey/Rabin/Basic.hs +formatted 3e0ac8c999c0 cryptonite-0.30/Crypto/PubKey/Rabin/Modified.hs +formatted a53ee7c1c1a5 cryptonite-0.30/Crypto/PubKey/Rabin/OAEP.hs +formatted b578b97afc3e cryptonite-0.30/Crypto/PubKey/Rabin/RW.hs +formatted c0eae64dcf68 cryptonite-0.30/Crypto/PubKey/Rabin/Types.hs +formatted 1854f69b3828 cryptonite-0.30/Crypto/Random.hs +formatted f3902d2c9c96 cryptonite-0.30/Crypto/Random/ChaChaDRG.hs +formatted 8b31b5a87af9 cryptonite-0.30/Crypto/Random/Entropy.hs +formatted f8afb2ba19cc cryptonite-0.30/Crypto/Random/Entropy/Backend.hs +formatted 9b0c8653e10a cryptonite-0.30/Crypto/Random/Entropy/RDRand.hs +formatted 0c206170779c cryptonite-0.30/Crypto/Random/Entropy/Source.hs +formatted 75121bc8d581 cryptonite-0.30/Crypto/Random/Entropy/Unix.hs +formatted 2b02d2fc4203 cryptonite-0.30/Crypto/Random/Entropy/Unsafe.hs +declined - cryptonite-0.30/Crypto/Random/Entropy/Windows.hs +formatted 4f4ac464c6e9 cryptonite-0.30/Crypto/Random/EntropyPool.hs +formatted 762f30275eb4 cryptonite-0.30/Crypto/Random/Probabilistic.hs +formatted dd360e4a76e6 cryptonite-0.30/Crypto/Random/SystemDRG.hs +formatted 3613df3a0846 cryptonite-0.30/Crypto/Random/Types.hs +formatted b12c43b64866 cryptonite-0.30/Crypto/System/CPU.hs +formatted 3f10131f3add cryptonite-0.30/Crypto/Tutorial.hs +formatted e865ae48f11b cryptonite-0.30/Setup.hs +formatted 6977c38d789e cryptonite-0.30/benchs/Bench.hs +formatted 772fcb717c67 cryptonite-0.30/benchs/Number/F2m.hs +formatted 57d09cf26ff7 cryptonite-0.30/tests/BCrypt.hs +formatted e0a9d879663a cryptonite-0.30/tests/BCryptPBKDF.hs +formatted 523e547e051d cryptonite-0.30/tests/BlockCipher.hs +formatted ae1da1712bf7 cryptonite-0.30/tests/ChaCha.hs +formatted 2ff39a30e968 cryptonite-0.30/tests/ChaChaPoly1305.hs +formatted c628564c97aa cryptonite-0.30/tests/ECC.hs +formatted 5d886e661761 cryptonite-0.30/tests/ECC/Edwards25519.hs +formatted e8de6edaf6ac cryptonite-0.30/tests/ECDSA.hs +formatted 27ce811073c1 cryptonite-0.30/tests/Hash.hs +formatted e00752436aeb cryptonite-0.30/tests/Imports.hs +formatted b56f327286e8 cryptonite-0.30/tests/KAT_AES.hs +formatted 810d48314931 cryptonite-0.30/tests/KAT_AES/KATCBC.hs +formatted 18eaacc22a0b cryptonite-0.30/tests/KAT_AES/KATCCM.hs +formatted 44fe15b7084a cryptonite-0.30/tests/KAT_AES/KATECB.hs +formatted 82fa19f7ce7a cryptonite-0.30/tests/KAT_AES/KATGCM.hs +formatted 615d3d0c3896 cryptonite-0.30/tests/KAT_AES/KATOCB3.hs +formatted 7ab1f2d998b8 cryptonite-0.30/tests/KAT_AES/KATXTS.hs +formatted 0ad3fede040b cryptonite-0.30/tests/KAT_AESGCMSIV.hs +formatted 5f71c9d0489d cryptonite-0.30/tests/KAT_AFIS.hs +formatted a29f1f177a83 cryptonite-0.30/tests/KAT_Argon2.hs +formatted f080f3e9d382 cryptonite-0.30/tests/KAT_Blowfish.hs +formatted c8352efb01e7 cryptonite-0.30/tests/KAT_CAST5.hs +formatted a3584b1b317f cryptonite-0.30/tests/KAT_CMAC.hs +formatted a2b1c23d4a23 cryptonite-0.30/tests/KAT_Camellia.hs +formatted 6afe12fcf4eb cryptonite-0.30/tests/KAT_Curve25519.hs +formatted 6093259a5aa9 cryptonite-0.30/tests/KAT_Curve448.hs +formatted 101e8ac3b19d cryptonite-0.30/tests/KAT_DES.hs +formatted 3a7902b73bd8 cryptonite-0.30/tests/KAT_Ed25519.hs +formatted bbf6a21d5f18 cryptonite-0.30/tests/KAT_Ed448.hs +formatted 6a2436512f8d cryptonite-0.30/tests/KAT_EdDSA.hs +formatted 0fa0afdb302b cryptonite-0.30/tests/KAT_HKDF.hs +formatted f0b45b263f2a cryptonite-0.30/tests/KAT_HMAC.hs +formatted 1735ae86f00c cryptonite-0.30/tests/KAT_KMAC.hs +formatted 66cf41c37e13 cryptonite-0.30/tests/KAT_MiyaguchiPreneel.hs +formatted 5161823955d7 cryptonite-0.30/tests/KAT_OTP.hs +formatted e23a8a363aff cryptonite-0.30/tests/KAT_PBKDF2.hs +formatted 1f0d2812b0a5 cryptonite-0.30/tests/KAT_PubKey.hs +formatted c92369374dbb cryptonite-0.30/tests/KAT_PubKey/DSA.hs +formatted 743790d1c893 cryptonite-0.30/tests/KAT_PubKey/ECC.hs +formatted 72827abb8090 cryptonite-0.30/tests/KAT_PubKey/ECDSA.hs +formatted 0a8edec8bb84 cryptonite-0.30/tests/KAT_PubKey/OAEP.hs +formatted 6ba37e5828ed cryptonite-0.30/tests/KAT_PubKey/P256.hs +formatted 93c9f8d40494 cryptonite-0.30/tests/KAT_PubKey/PSS.hs +formatted bba8cd12072c cryptonite-0.30/tests/KAT_PubKey/RSA.hs +formatted cd527ad025c4 cryptonite-0.30/tests/KAT_PubKey/Rabin.hs +formatted fa1389bb8af8 cryptonite-0.30/tests/KAT_RC4.hs +formatted 6c174475decc cryptonite-0.30/tests/KAT_Scrypt.hs +formatted 36380d994c1c cryptonite-0.30/tests/KAT_TripleDES.hs +formatted 509c09091817 cryptonite-0.30/tests/KAT_Twofish.hs +formatted d3ffb4dd724c cryptonite-0.30/tests/Number.hs +formatted 7da4a28c8580 cryptonite-0.30/tests/Number/F2m.hs +formatted 153769199399 cryptonite-0.30/tests/Padding.hs +formatted e4b87212dc1f cryptonite-0.30/tests/Poly1305.hs +formatted 38c09837971d cryptonite-0.30/tests/Salsa.hs +formatted 54065ea7b3f2 cryptonite-0.30/tests/Tests.hs +formatted 8ebf266d6afa cryptonite-0.30/tests/Utils.hs +formatted f7ee48c90ce9 cryptonite-0.30/tests/XSalsa.hs +formatted e865ae48f11b diagrams-core-1.5.1.2/Setup.hs +formatted 390dfdff3fbc diagrams-core-1.5.1.2/src/Diagrams/Core.hs +formatted 5b9f4064740f diagrams-core-1.5.1.2/src/Diagrams/Core/Compile.hs +formatted dcc0b6e7d82d diagrams-core-1.5.1.2/src/Diagrams/Core/Envelope.hs +formatted c945af86b66d diagrams-core-1.5.1.2/src/Diagrams/Core/HasOrigin.hs +formatted 5e6397a73cbf diagrams-core-1.5.1.2/src/Diagrams/Core/Juxtapose.hs +formatted 5d249b0ae2ba diagrams-core-1.5.1.2/src/Diagrams/Core/Measure.hs +formatted 3f232ced8cd3 diagrams-core-1.5.1.2/src/Diagrams/Core/Names.hs +formatted 169fec80496d diagrams-core-1.5.1.2/src/Diagrams/Core/Points.hs +formatted d8167797c638 diagrams-core-1.5.1.2/src/Diagrams/Core/Query.hs +formatted c1f6572049e6 diagrams-core-1.5.1.2/src/Diagrams/Core/Style.hs +formatted 67cdc6b4a26e diagrams-core-1.5.1.2/src/Diagrams/Core/Trace.hs +formatted ceb1829b99d5 diagrams-core-1.5.1.2/src/Diagrams/Core/Transform.hs +formatted 053c9acdc8a3 diagrams-core-1.5.1.2/src/Diagrams/Core/Types.hs +formatted a9f71c9c75d0 diagrams-core-1.5.1.2/src/Diagrams/Core/V.hs +formatted 5cabe7655bac distributed-process-0.7.8/benchmarks/Channels.hs +formatted 504953bb1387 distributed-process-0.7.8/benchmarks/Latency.hs +formatted d09b9e8f8cf6 distributed-process-0.7.8/benchmarks/ProcessRing.hs +formatted c83a31f749c7 distributed-process-0.7.8/benchmarks/Spawns.hs +formatted 85c826b4657d distributed-process-0.7.8/benchmarks/Throughput.hs +formatted e7bfb48f27d1 distributed-process-0.7.8/src/Control/Distributed/Process.hs +formatted 3f710068b83b distributed-process-0.7.8/src/Control/Distributed/Process/Closure.hs +formatted 9abdf121594b distributed-process-0.7.8/src/Control/Distributed/Process/Debug.hs +formatted c98976ba0493 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/BiMultiMap.hs +formatted fe72c6f43347 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/CQueue.hs +formatted 2946b3a11a2f distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Closure/BuiltIn.hs +formatted a950bf8d3ff9 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Closure/Explicit.hs +formatted 8ab242465a6d distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Closure/TH.hs +formatted 4f632ae95bca distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Messaging.hs +formatted 371d302bf97d distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Primitives.hs +formatted e8934f2fb775 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Spawn.hs +formatted cd3afabcd890 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/StrictContainerAccessors.hs +formatted 8a9d9c67b86f distributed-process-0.7.8/src/Control/Distributed/Process/Internal/StrictList.hs +formatted b21182e8f9f2 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/StrictMVar.hs +formatted 8741f1720d69 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/Types.hs +formatted d8a70ea27555 distributed-process-0.7.8/src/Control/Distributed/Process/Internal/WeakTQueue.hs +formatted 7260ec04f829 distributed-process-0.7.8/src/Control/Distributed/Process/Management.hs +formatted 0fc21b015e4c distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Agent.hs +formatted 39b50d32c5a6 distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Bus.hs +formatted 5e7aa53931dc distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Trace/Primitives.hs +formatted 818907f11c3f distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Trace/Remote.hs +formatted de6da63f59ad distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Trace/Tracer.hs +formatted 2b21046051cd distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Trace/Types.hs +formatted 7142839f16fe distributed-process-0.7.8/src/Control/Distributed/Process/Management/Internal/Types.hs +formatted 412c9677cfbc distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs +formatted 6b86ee01b32a distributed-process-0.7.8/src/Control/Distributed/Process/Serializable.hs +formatted daf3cd1d8b53 distributed-process-0.7.8/src/Control/Distributed/Process/UnsafePrimitives.hs +broken c7f3522faa0a dlist-1.0/Data/DList.hs +formatted 20c1dbe536f4 dlist-1.0/Data/DList/DNonEmpty.hs +formatted 3d51b496abb0 dlist-1.0/Data/DList/DNonEmpty/Internal.hs +declined - dlist-1.0/Data/DList/Internal.hs +formatted 669ee89127ed dlist-1.0/Data/DList/Unsafe.hs +formatted c7f9b52c6db5 dlist-1.0/tests/DListProperties.hs +formatted 54f0c52fc06b dlist-1.0/tests/DNonEmptyProperties.hs +formatted 9471e1a867e9 dlist-1.0/tests/ImportUnsafe.hs +formatted 977d78f79456 dlist-1.0/tests/Main.hs +formatted ff0ea90a2896 dlist-1.0/tests/OverloadedStrings.hs +formatted eda938831fc8 dlist-1.0/tests/QuickCheckUtil.hs +formatted e865ae48f11b esqueleto-3.6.0.3/Setup.hs +formatted fb274a829f01 esqueleto-3.6.0.3/src/Database/Esqueleto.hs +formatted 99a3554c79c4 esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental.hs +formatted 62ae3d4e946f esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/From.hs +formatted 66df5876db87 esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/From/CommonTableExpression.hs +formatted 1c658ac7468e esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/From/Join.hs +formatted beecd102c083 esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/From/SqlSetOperation.hs +formatted d4056ae5fdae esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/ToAlias.hs +formatted 570cc685ebf9 esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/ToAliasReference.hs +formatted 9f36875401e2 esqueleto-3.6.0.3/src/Database/Esqueleto/Experimental/ToMaybe.hs +formatted 1182bc5f07a3 esqueleto-3.6.0.3/src/Database/Esqueleto/Internal/ExprParser.hs +formatted 7d5926bb95a1 esqueleto-3.6.0.3/src/Database/Esqueleto/Internal/Internal.hs +formatted 8e8a8c378f2b esqueleto-3.6.0.3/src/Database/Esqueleto/Internal/PersistentImport.hs +formatted 23c62f207b2d esqueleto-3.6.0.3/src/Database/Esqueleto/Legacy.hs +formatted 9cd66d1b3ed2 esqueleto-3.6.0.3/src/Database/Esqueleto/MySQL.hs +formatted c89093d794d3 esqueleto-3.6.0.3/src/Database/Esqueleto/PostgreSQL.hs +formatted c9c85bd4863e esqueleto-3.6.0.3/src/Database/Esqueleto/PostgreSQL/JSON.hs +formatted 1499072a5bb5 esqueleto-3.6.0.3/src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs +formatted c9e808f99d5b esqueleto-3.6.0.3/src/Database/Esqueleto/Record.hs +formatted 167fa1cef38a esqueleto-3.6.0.3/src/Database/Esqueleto/SQLite.hs +formatted 87d19093371d esqueleto-3.6.0.3/test/Common/Record.hs +formatted 898e906dfbfd esqueleto-3.6.0.3/test/Common/Test.hs +formatted c745d9be5124 esqueleto-3.6.0.3/test/Common/Test/CTE.hs +formatted 1f83d04692e3 esqueleto-3.6.0.3/test/Common/Test/Import.hs +formatted 2e16567983e5 esqueleto-3.6.0.3/test/Common/Test/Models.hs +formatted 1e1af0ff65e2 esqueleto-3.6.0.3/test/Common/Test/Select.hs +formatted 6c403a7dbfd3 esqueleto-3.6.0.3/test/MySQL/Test.hs +formatted 649022fe6ecf esqueleto-3.6.0.3/test/PostgreSQL/MigrateJSON.hs +formatted 2b853749fb75 esqueleto-3.6.0.3/test/PostgreSQL/Test.hs +formatted 0e0ef1763885 esqueleto-3.6.0.3/test/SQLite/Test.hs +formatted 9c274d8e66c1 esqueleto-3.6.0.3/test/Spec.hs +formatted 27965836c84d exceptions-0.10.12/src/Control/Monad/Catch.hs +formatted bfa68dd05586 exceptions-0.10.12/src/Control/Monad/Catch/Pure.hs +formatted 9e0076961bd9 exceptions-0.10.12/tests/Control/Monad/Catch/Tests.hs +formatted bba664ba2b8b exceptions-0.10.12/tests/Tests.hs +formatted 421394df9111 fay-0.24.2.0/Setup.hs +formatted ec9eeba0c6a1 fay-0.24.2.0/examples/CodeWorld.hs +formatted 99245f57be0e fay-0.24.2.0/examples/CodeWorldMain.hs +formatted 548a2ab668be fay-0.24.2.0/examples/Cont.hs +formatted 51acf9e074e7 fay-0.24.2.0/examples/D3TreeSample.hs +formatted 5ecb259af8cb fay-0.24.2.0/examples/FayFromJs.hs +formatted d4be2511948d fay-0.24.2.0/examples/Separated.hs +formatted 73cbc6340843 fay-0.24.2.0/examples/X.hs +formatted 89a1e9058dc3 fay-0.24.2.0/examples/Y.hs +formatted 55d7b8cf115f fay-0.24.2.0/examples/alert.hs +formatted 3563971c6bdb fay-0.24.2.0/examples/calc.hs +formatted 2d60fb67f2de fay-0.24.2.0/examples/canvaswater.hs +formatted 97df12f5dfa2 fay-0.24.2.0/examples/console.hs +formatted 219026b77ebc fay-0.24.2.0/examples/data.hs +formatted 57124dd1aa0e fay-0.24.2.0/examples/dom.hs +formatted a017f7092550 fay-0.24.2.0/examples/jquery.hs +formatted aabfbe529b18 fay-0.24.2.0/examples/json.hs +formatted db1cb782ccc3 fay-0.24.2.0/examples/node.hs +formatted f3df3b020033 fay-0.24.2.0/examples/nqueens.hs +formatted 082f30944841 fay-0.24.2.0/examples/obj.hs +formatted 876df6e6b3f1 fay-0.24.2.0/examples/oscillator.hs +formatted c79a44579d85 fay-0.24.2.0/examples/pat.hs +formatted fa732b1a5e66 fay-0.24.2.0/examples/properties.hs +formatted 7085b02d6471 fay-0.24.2.0/examples/ref.hs +formatted 55fe2b9f624f fay-0.24.2.0/examples/showExamples.hs +formatted 884b6fbdaadc fay-0.24.2.0/examples/tailrecursive.hs +formatted 1463fee0cdc0 fay-0.24.2.0/src/Fay.hs +formatted 07c67e558a55 fay-0.24.2.0/src/Fay/Compiler.hs +formatted 08e147a7ca10 fay-0.24.2.0/src/Fay/Compiler/Decl.hs +formatted d4575500ee48 fay-0.24.2.0/src/Fay/Compiler/Defaults.hs +formatted 9e167b4dd860 fay-0.24.2.0/src/Fay/Compiler/Desugar.hs +formatted e8e463edecee fay-0.24.2.0/src/Fay/Compiler/Desugar/Name.hs +formatted fe53147a7e33 fay-0.24.2.0/src/Fay/Compiler/Desugar/Types.hs +formatted 07d2e834d04c fay-0.24.2.0/src/Fay/Compiler/Exp.hs +formatted 28a5f094dde5 fay-0.24.2.0/src/Fay/Compiler/FFI.hs +formatted 69fd6dd80a66 fay-0.24.2.0/src/Fay/Compiler/GADT.hs +formatted 1a601ae0f75b fay-0.24.2.0/src/Fay/Compiler/Import.hs +formatted a2f05f014ae5 fay-0.24.2.0/src/Fay/Compiler/InitialPass.hs +formatted a22d45c5c321 fay-0.24.2.0/src/Fay/Compiler/Misc.hs +formatted bce0992d570d fay-0.24.2.0/src/Fay/Compiler/ModuleT.hs +formatted 5ff84858fb95 fay-0.24.2.0/src/Fay/Compiler/Optimizer.hs +formatted ac32749d90ec fay-0.24.2.0/src/Fay/Compiler/Packages.hs +formatted a76cfec53b82 fay-0.24.2.0/src/Fay/Compiler/Parse.hs +formatted 4e8f1b8a0816 fay-0.24.2.0/src/Fay/Compiler/Pattern.hs +formatted 7cca783f3fcd fay-0.24.2.0/src/Fay/Compiler/Prelude.hs +formatted 0fe3943a05fb fay-0.24.2.0/src/Fay/Compiler/PrimOp.hs +formatted ea36afcb904b fay-0.24.2.0/src/Fay/Compiler/Print.hs +formatted 66a7ddb00b81 fay-0.24.2.0/src/Fay/Compiler/QName.hs +formatted fa9988c44218 fay-0.24.2.0/src/Fay/Compiler/State.hs +formatted fb1831a445cc fay-0.24.2.0/src/Fay/Compiler/Typecheck.hs +formatted 413034d717c7 fay-0.24.2.0/src/Fay/Config.hs +formatted 15cd1e849d0e fay-0.24.2.0/src/Fay/Convert.hs +formatted 80d46083d774 fay-0.24.2.0/src/Fay/Exts.hs +formatted 7ec6f093e0ca fay-0.24.2.0/src/Fay/Exts/NoAnnotation.hs +formatted bd1f234d96c0 fay-0.24.2.0/src/Fay/Exts/Scoped.hs +formatted f7856f337bee fay-0.24.2.0/src/Fay/FFI.hs +formatted 7dd89da8a466 fay-0.24.2.0/src/Fay/Runtime.hs +formatted 0ac5069cbf76 fay-0.24.2.0/src/Fay/Types.hs +formatted 6654772d79a6 fay-0.24.2.0/src/Fay/Types/CompileError.hs +formatted 4f7fdfee2a8f fay-0.24.2.0/src/Fay/Types/CompileResult.hs +formatted f21a75633d68 fay-0.24.2.0/src/Fay/Types/FFI.hs +formatted 16c62b3f8086 fay-0.24.2.0/src/Fay/Types/Js.hs +formatted 8b5e7dc5b55c fay-0.24.2.0/src/Fay/Types/ModulePath.hs +formatted 70b756fa52b3 fay-0.24.2.0/src/Fay/Types/Printer.hs +formatted 6593766b1d2e fay-0.24.2.0/src/haskell-names/Language/Haskell/Names.hs +formatted bfea4a051d5e fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Annotated.hs +formatted b36e999e1b42 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Exports.hs +formatted ba7a7290b652 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/GetBound.hs +formatted dcc2c3f113a9 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/GlobalSymbolTable.hs +formatted 13662130820d fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/GlobalSymbolTable.hs-boot +formatted c7ae29226dad fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Imports.hs +formatted bda66c725ce4 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/LocalSymbolTable.hs +formatted b64dde2af1d1 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/ModuleSymbols.hs +formatted 76ce45f69410 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Open/Base.hs +formatted b12db8ba5ce9 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Open/Derived.hs +formatted e5d7ccfc13f3 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Open/Instances.hs +formatted 5830466c394d fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/RecordWildcards.hs +formatted 80dec7fda3fb fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Recursive.hs +formatted 0c478b11a301 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/ScopeUtils.hs +formatted 0ad105ebc45d fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/SyntaxUtils.hs +formatted 2b1329bafe82 fay-0.24.2.0/src/haskell-names/Language/Haskell/Names/Types.hs +formatted a185a50b6e6a fay-0.24.2.0/src/main/Main.hs +formatted b9c869a29067 fay-0.24.2.0/src/tests/Test/CommandLine.hs +formatted 4aba97e21b8e fay-0.24.2.0/src/tests/Test/Compile.hs +formatted 86467d080a45 fay-0.24.2.0/src/tests/Test/Convert.hs +formatted 89d594b07db0 fay-0.24.2.0/src/tests/Test/Desugar.hs +formatted a3937c4d8bef fay-0.24.2.0/src/tests/Test/Util.hs +formatted 63cce78f9492 fay-0.24.2.0/src/tests/Tests.hs +formatted 8114602da4c3 fay-0.24.2.0/tests/AllBaseModules.hs +formatted e78d25c5a73d fay-0.24.2.0/tests/AutomaticList.hs +formatted 779c72fbdb74 fay-0.24.2.0/tests/Bool.hs +formatted 85b587f06e29 fay-0.24.2.0/tests/CPP.hs +formatted 61e542a01350 fay-0.24.2.0/tests/Char.hs +formatted 7badee2f20a7 fay-0.24.2.0/tests/Compile/CPPMultiLineStrings.hs +formatted a64f08ccafac fay-0.24.2.0/tests/Compile/CPPTypecheck.hs +formatted 66d008a435ce fay-0.24.2.0/tests/Compile/EnumChar.hs +formatted 79a705007362 fay-0.24.2.0/tests/Compile/ImportRecords.hs +formatted a0d1bb7739c9 fay-0.24.2.0/tests/Compile/Records.hs +formatted 654d49354de8 fay-0.24.2.0/tests/Compile/StrictWrapper.hs +formatted 3f10c446d77e fay-0.24.2.0/tests/Compile/pretty.hs +formatted 3f10c446d77e fay-0.24.2.0/tests/Compile/prettyOperators.hs +formatted 3f10c446d77e fay-0.24.2.0/tests/Compile/prettyThunks.hs +formatted 7e5ba819c89a fay-0.24.2.0/tests/Defined.hs +formatted 933b5c75c95d fay-0.24.2.0/tests/DesugarFFI.hs +formatted 247bf5cdbba0 fay-0.24.2.0/tests/DoLet2.hs +formatted 8e59e23cdef2 fay-0.24.2.0/tests/DoLet3.hs +formatted 8506e48ae167 fay-0.24.2.0/tests/Double.hs +formatted 555ed6125da8 fay-0.24.2.0/tests/Double2.hs +formatted 940c2db0f038 fay-0.24.2.0/tests/Double3.hs +formatted ce51517b312e fay-0.24.2.0/tests/Double4.hs +formatted e7d8f2571cb1 fay-0.24.2.0/tests/Either.hs +formatted f00c11dbed60 fay-0.24.2.0/tests/EmptyDataDeclArray.hs +formatted 7c2bc66a86e6 fay-0.24.2.0/tests/Eq.hs +formatted 25d8fd9d5d5a fay-0.24.2.0/tests/ExportEThingAll.hs +formatted bea5851db3b4 fay-0.24.2.0/tests/ExportEThingAll_Export.hs +formatted b86ba0189dff fay-0.24.2.0/tests/ExportEThingWith.hs +formatted 19c335568239 fay-0.24.2.0/tests/ExportList.hs +formatted b39169d37973 fay-0.24.2.0/tests/ExportList_A.hs +formatted eb351b1cfd3e fay-0.24.2.0/tests/ExportList_B.hs +formatted 4736c70718a7 fay-0.24.2.0/tests/ExportList_C.hs +formatted 41c7f9eb857a fay-0.24.2.0/tests/ExportList_D.hs +formatted b42dad751766 fay-0.24.2.0/tests/ExportQualified_Export.hs +formatted e08dc6f4e84b fay-0.24.2.0/tests/ExportQualified_Import.hs +formatted 7778565bb389 fay-0.24.2.0/tests/ExportType.hs +formatted ba54245a67ef fay-0.24.2.0/tests/Floating.hs +formatted 02165869295d fay-0.24.2.0/tests/FromString.hs +formatted fc43945a5277 fay-0.24.2.0/tests/FromString/Dep.hs +formatted 09e516e107ad fay-0.24.2.0/tests/FromString/DepDep.hs +formatted a8e31b7f9068 fay-0.24.2.0/tests/FromString/FayText.hs +formatted 3da43a919ebc fay-0.24.2.0/tests/GADTs_without_records.hs +formatted 102949714efb fay-0.24.2.0/tests/GuardWhere.hs +formatted 4c6803c7f169 fay-0.24.2.0/tests/HidePreludeImport.hs +formatted a1408d450caf fay-0.24.2.0/tests/HidePreludeImport_Import.hs +formatted fa5b4cc76a44 fay-0.24.2.0/tests/Hierarchical/Export.hs +formatted 102307416bcd fay-0.24.2.0/tests/Hierarchical/RecordDefined.hs +formatted 920c9acca3b5 fay-0.24.2.0/tests/HierarchicalImport.hs +formatted def230ba708f fay-0.24.2.0/tests/ImplicitPrelude.hs +formatted c71809dd7876 fay-0.24.2.0/tests/ImportHiding.hs +formatted 75f8ddda7df8 fay-0.24.2.0/tests/ImportIThingAll.hs +formatted b4c50a46461c fay-0.24.2.0/tests/ImportList.hs +formatted 87c5a69d1b76 fay-0.24.2.0/tests/ImportList1/A.hs +formatted 8d3ac5b6cbc9 fay-0.24.2.0/tests/ImportList1/B.hs +formatted baf7f8cf38cc fay-0.24.2.0/tests/ImportList1/C.hs +formatted b5cb6de55974 fay-0.24.2.0/tests/ImportListType.hs +formatted 69bb47d76aef fay-0.24.2.0/tests/ImportType.hs +formatted 440bc41f78be fay-0.24.2.0/tests/ImportType2.hs +formatted 5ff8e931a567 fay-0.24.2.0/tests/ImportType2I/A.hs +formatted e15dbb9a2720 fay-0.24.2.0/tests/ImportType2I/B.hs +formatted 9d4bcec16bd7 fay-0.24.2.0/tests/Integer.hs +formatted ed2b3650244f fay-0.24.2.0/tests/Integral.hs +formatted dadef2b7cb03 fay-0.24.2.0/tests/Issue215/B.hs +formatted eeedb44973d0 fay-0.24.2.0/tests/Issue215A.hs +formatted b0a19078b259 fay-0.24.2.0/tests/Js2FayFunc.hs +formatted 8592007d3db3 fay-0.24.2.0/tests/JsFunctionPassing.hs +formatted 009642e56a6b fay-0.24.2.0/tests/LambdaCase.hs +formatted 47266926fa39 fay-0.24.2.0/tests/LazyOperators.hs +formatted ee291ee7e00e fay-0.24.2.0/tests/List.hs +formatted c8021ca9ec3f fay-0.24.2.0/tests/List2.hs +formatted a93b0ff4bcc5 fay-0.24.2.0/tests/ListEq.hs +formatted c3daafcf2461 fay-0.24.2.0/tests/MainThunk.hs +formatted 350d9831d6f8 fay-0.24.2.0/tests/ModuleReExport/ExportsIdentifier.hs +formatted 25cef8780cae fay-0.24.2.0/tests/ModuleReExport/ExportsModule.hs +formatted 9dfef0f7c129 fay-0.24.2.0/tests/ModuleReExports.hs +formatted c082d387d888 fay-0.24.2.0/tests/ModuleRecordClash.hs +formatted 997782df97ba fay-0.24.2.0/tests/ModuleRecordClash/R.hs +formatted 53ea9782c8a3 fay-0.24.2.0/tests/ModuleRecordClash2.hs +formatted 9800c4c956c7 fay-0.24.2.0/tests/ModuleRecordClash2_Hello.hs +formatted 1a83fbebaaf8 fay-0.24.2.0/tests/Monad.hs +formatted 86f64805684f fay-0.24.2.0/tests/Monad2.hs +formatted 0c9780229637 fay-0.24.2.0/tests/MultiWayIf.hs +formatted 0e3845c048a2 fay-0.24.2.0/tests/NestedImporting.hs +formatted 4b3a670722e0 fay-0.24.2.0/tests/NestedImporting/A.hs +formatted 2a092a0c1f4c fay-0.24.2.0/tests/NestedImporting2.hs +formatted 19cbbffb80bc fay-0.24.2.0/tests/NestedImporting2/A.hs +formatted 5b0905d26851 fay-0.24.2.0/tests/NewtypeImport_Export.hs +formatted 34ed28dbd073 fay-0.24.2.0/tests/NewtypeImport_Import.hs +formatted ad07b3a0d755 fay-0.24.2.0/tests/Nullable.hs +formatted f01c35cc494d fay-0.24.2.0/tests/Num.hs +formatted 75ea0e91fb04 fay-0.24.2.0/tests/Ord.hs +formatted 66e4369c7bda fay-0.24.2.0/tests/PrefixOpPat.hs +formatted cc9547968f50 fay-0.24.2.0/tests/QualifiedImport.hs +formatted e548782c2e69 fay-0.24.2.0/tests/QualifiedImport/X.hs +formatted 391559feaa6f fay-0.24.2.0/tests/QualifiedImport/Y.hs +formatted 5a73215af899 fay-0.24.2.0/tests/Ratio.hs +formatted 577c81fcbe39 fay-0.24.2.0/tests/ReExport1.hs +formatted 97f273a7040d fay-0.24.2.0/tests/ReExport2.hs +formatted 9fb50fe15789 fay-0.24.2.0/tests/ReExport3.hs +formatted 8b077416b2a2 fay-0.24.2.0/tests/ReExportGlobally.hs +formatted 51e4cd174ea4 fay-0.24.2.0/tests/ReExportGlobally/A.hs +formatted b21d1616e152 fay-0.24.2.0/tests/ReExportGloballyExplicit.hs +formatted 9315bbd88930 fay-0.24.2.0/tests/RealFrac.hs +formatted 1a6a33c6ac9d fay-0.24.2.0/tests/RecCon.hs +formatted d0c6c8bc95e4 fay-0.24.2.0/tests/RecDecl.hs +formatted 23fcb8f6b7c4 fay-0.24.2.0/tests/RecordImport2_Export1.hs +formatted 1cf7d6a06d1d fay-0.24.2.0/tests/RecordImport2_Export2.hs +formatted c044e70c8101 fay-0.24.2.0/tests/RecordImport2_Import.hs +formatted 4a78cf573fbc fay-0.24.2.0/tests/RecordImport_Export.hs +formatted 602840c8fb4f fay-0.24.2.0/tests/RecordImport_Import.hs +formatted 50271d9b8bd9 fay-0.24.2.0/tests/Sink.hs +formatted 0d52d0cd7e4b fay-0.24.2.0/tests/SkipLetTypes.hs +formatted 79a7eb241171 fay-0.24.2.0/tests/SkipWhereTypes.hs +formatted b2f90faa6d96 fay-0.24.2.0/tests/StringForcing.hs +formatted 78f704c770c1 fay-0.24.2.0/tests/Strings.hs +formatted b23a6f00c551 fay-0.24.2.0/tests/T190.hs +formatted 692f0dae5fb8 fay-0.24.2.0/tests/T190_A.hs +formatted 8e73afc88ae8 fay-0.24.2.0/tests/T190_B.hs +formatted e68acdaf2dfe fay-0.24.2.0/tests/T190_C.hs +formatted 7bd1c4fd8478 fay-0.24.2.0/tests/TextOrd.hs +formatted f47544b81667 fay-0.24.2.0/tests/Trace.hs +formatted c578ce2acbf6 fay-0.24.2.0/tests/TupleCalls.hs +formatted d35a3f3c7245 fay-0.24.2.0/tests/TyVarSerialization.hs +formatted 7d85fb13bd93 fay-0.24.2.0/tests/Var.hs +formatted 7a2ffc1587f5 fay-0.24.2.0/tests/VarPtr.hs +formatted 5bcb67338113 fay-0.24.2.0/tests/WhenUnlessRecursion.hs +formatted c767b8778a1d fay-0.24.2.0/tests/asPatternMatch.hs +formatted aa05f8bd2bf0 fay-0.24.2.0/tests/automatic.hs +formatted 83d1d385ae83 fay-0.24.2.0/tests/baseFixities.hs +formatted ce58f47bac04 fay-0.24.2.0/tests/basicFunctions.hs +formatted 33b5a5453ff8 fay-0.24.2.0/tests/case.hs +formatted a51f036ac082 fay-0.24.2.0/tests/case2.hs +formatted 4a4542652251 fay-0.24.2.0/tests/case3.hs +formatted e563419849e3 fay-0.24.2.0/tests/caseList.hs +formatted 6f41ab7df8c9 fay-0.24.2.0/tests/caseWildcard.hs +formatted 9437474fc565 fay-0.24.2.0/tests/circular.hs +formatted 3ac360393116 fay-0.24.2.0/tests/curry.hs +formatted 9bbe8cd8c749 fay-0.24.2.0/tests/cycle.hs +formatted d07827315b77 fay-0.24.2.0/tests/do.hs +formatted 262e4e61e6b8 fay-0.24.2.0/tests/doAssingPatternMatch.hs +formatted ad5b707f664a fay-0.24.2.0/tests/doBindAssign.hs +formatted e41cbdd7656a fay-0.24.2.0/tests/doLet.hs +formatted 9f8a8d10c1d3 fay-0.24.2.0/tests/emptyMain.hs +formatted 380eff7dedb9 fay-0.24.2.0/tests/enumFrom.hs +formatted 05834fe58432 fay-0.24.2.0/tests/error.hs +formatted f563902672cb fay-0.24.2.0/tests/ffiExpr.hs +formatted 73697f0c099c fay-0.24.2.0/tests/ffimunging.hs +formatted dc67c504a097 fay-0.24.2.0/tests/fix.hs +formatted 9267690ec8d2 fay-0.24.2.0/tests/fromInteger.hs +formatted 73a7dce83bdd fay-0.24.2.0/tests/fromIntegral.hs +formatted 860a7aed8af3 fay-0.24.2.0/tests/guards.hs +formatted 8ff7b7e5d80d fay-0.24.2.0/tests/infixDataConst.hs +formatted 99c963974ca0 fay-0.24.2.0/tests/ints.hs +formatted 9ec2af24577b fay-0.24.2.0/tests/linesAndWords.hs +formatted 36a10a974013 fay-0.24.2.0/tests/listComprehensions.hs +formatted 392b79e97d1d fay-0.24.2.0/tests/listlen.hs +formatted 9d98dc262b39 fay-0.24.2.0/tests/mutableReference.hs +formatted 7fe9f65a3adf fay-0.24.2.0/tests/nameGen.hs +formatted c17264ffcbde fay-0.24.2.0/tests/namedFieldPuns.hs +formatted 68fcd666b331 fay-0.24.2.0/tests/negation.hs +formatted 18a910a17dd2 fay-0.24.2.0/tests/newtype.hs +formatted ea2625a5c5d9 fay-0.24.2.0/tests/newtypeIndirectApp.hs +formatted a587812e6602 fay-0.24.2.0/tests/numTheory.hs +formatted 40bd883716b3 fay-0.24.2.0/tests/nums.hs +formatted c27df9670630 fay-0.24.2.0/tests/pats.hs +formatted b317cbb85f97 fay-0.24.2.0/tests/patternGuards.hs +formatted 353e37b5a857 fay-0.24.2.0/tests/patternMatchFail.hs +formatted 0e69935e45c9 fay-0.24.2.0/tests/patternMatchLet.hs +formatted f963663ae2cf fay-0.24.2.0/tests/patternMatchingTuples.hs +formatted 41871bce5735 fay-0.24.2.0/tests/recordFunctionPatternMatch.hs +formatted 6010444abc75 fay-0.24.2.0/tests/recordPatternMatch.hs +formatted 0dda5fc8df9d fay-0.24.2.0/tests/recordPatternMatch2.hs +formatted 63b9091a92a2 fay-0.24.2.0/tests/recordUseBeforeDefine.hs +formatted 1534c0770b97 fay-0.24.2.0/tests/recordWildCards.hs +formatted 38ba272a8da1 fay-0.24.2.0/tests/records.hs +formatted a371f7d8d704 fay-0.24.2.0/tests/recursive.hs +formatted 9797f8836f3b fay-0.24.2.0/tests/reservedWords.hs +formatted 3bdaf5d65328 fay-0.24.2.0/tests/sections.hs +formatted 19e9c7c69db9 fay-0.24.2.0/tests/seq-fake.hs +formatted 2ac1dc3c2516 fay-0.24.2.0/tests/seq.hs +formatted 3bf92844987c fay-0.24.2.0/tests/serialization.hs +formatted e76961e79030 fay-0.24.2.0/tests/succPred.hs +formatted 461d16ef4da1 fay-0.24.2.0/tests/tailRecursion.hs +formatted b29bc268b713 fay-0.24.2.0/tests/then.hs +formatted 7b2a525c6d17 fay-0.24.2.0/tests/tupleCon.hs +formatted 71a59816933e fay-0.24.2.0/tests/tupleSec.hs +formatted c864de89b243 fay-0.24.2.0/tests/unit.hs +formatted cfb7dd15a745 fay-0.24.2.0/tests/utf8.hs +formatted 68905bc32429 fay-0.24.2.0/tests/where.hs +formatted 6ea0b301c8c4 fay-0.24.2.0/tests/whereBind.hs +formatted 62b7dd25b5c9 fay-0.24.2.0/tests/whereBind2.hs +formatted dd52de0acf94 fay-0.24.2.0/tests/whereBind3.hs +formatted b3d258de0403 free-5.2/examples/PerfTH.hs +formatted 24418bc38fac free-5.2/examples/RetryTH.hs +formatted 7641743d0c1f free-5.2/examples/ValidationForm.hs +formatted 550f8b9da7b3 free-5.2/src/Control/Alternative/Free.hs +formatted f8e32632bd32 free-5.2/src/Control/Alternative/Free/Final.hs +formatted 8b307bae43e5 free-5.2/src/Control/Applicative/Free.hs +formatted 1593e637f12f free-5.2/src/Control/Applicative/Free/Fast.hs +formatted 883709cfad5b free-5.2/src/Control/Applicative/Free/Final.hs +formatted bf937338e8cd free-5.2/src/Control/Applicative/Trans/Free.hs +formatted dd9069083e98 free-5.2/src/Control/Comonad/Cofree.hs +formatted 9b0f6d5a4082 free-5.2/src/Control/Comonad/Cofree/Class.hs +formatted 38f0ea646bae free-5.2/src/Control/Comonad/Trans/Cofree.hs +formatted 09cad19ae5db free-5.2/src/Control/Comonad/Trans/Coiter.hs +formatted f6734128b306 free-5.2/src/Control/Monad/Free.hs +formatted 92f9ffbc940f free-5.2/src/Control/Monad/Free/Ap.hs +formatted aa9c76266363 free-5.2/src/Control/Monad/Free/Church.hs +formatted 39bf4e33f6e2 free-5.2/src/Control/Monad/Free/Class.hs +formatted d6318fb07edb free-5.2/src/Control/Monad/Free/TH.hs +formatted 3088c885facf free-5.2/src/Control/Monad/Trans/Free.hs +formatted 294db67cce93 free-5.2/src/Control/Monad/Trans/Free/Ap.hs +formatted eacfb36ea2de free-5.2/src/Control/Monad/Trans/Free/Church.hs +formatted aabaf90633fd free-5.2/src/Control/Monad/Trans/Iter.hs +formatted e865ae48f11b hakyll-4.17.0.0/Setup.hs +formatted 0a3f98709f72 hakyll-4.17.0.0/data/example/site.hs +formatted 116aaa72d476 hakyll-4.17.0.0/lib/Data/List/Extended.hs +formatted f638cd45236f hakyll-4.17.0.0/lib/Data/Yaml/Extended.hs +formatted 0fcae45b2ba9 hakyll-4.17.0.0/lib/Hakyll.hs +formatted 7abdda6d7a7a hakyll-4.17.0.0/lib/Hakyll/Check.hs +formatted d16c4d72c9d4 hakyll-4.17.0.0/lib/Hakyll/Commands.hs +formatted ee8ce55f1a4b hakyll-4.17.0.0/lib/Hakyll/Core/Compiler.hs +formatted 2f2012949948 hakyll-4.17.0.0/lib/Hakyll/Core/Compiler/Internal.hs +formatted c7cfc530bd2a hakyll-4.17.0.0/lib/Hakyll/Core/Compiler/Require.hs +formatted 10bda89cbe6d hakyll-4.17.0.0/lib/Hakyll/Core/Configuration.hs +formatted 8f683f53a9e9 hakyll-4.17.0.0/lib/Hakyll/Core/Dependencies.hs +formatted 558f0d294954 hakyll-4.17.0.0/lib/Hakyll/Core/File.hs +formatted 2a29ca50b4cf hakyll-4.17.0.0/lib/Hakyll/Core/Identifier.hs +formatted 02b568af6a14 hakyll-4.17.0.0/lib/Hakyll/Core/Identifier/Pattern.hs +formatted 4da1703227de hakyll-4.17.0.0/lib/Hakyll/Core/Identifier/Pattern/Internal.hs +formatted 25bce39252d0 hakyll-4.17.0.0/lib/Hakyll/Core/Item.hs +formatted ea66b0f47f92 hakyll-4.17.0.0/lib/Hakyll/Core/Item/SomeItem.hs +formatted 8d06795590b2 hakyll-4.17.0.0/lib/Hakyll/Core/Logger.hs +formatted 9c84e3b20e81 hakyll-4.17.0.0/lib/Hakyll/Core/Metadata.hs +formatted 6e39852547dc hakyll-4.17.0.0/lib/Hakyll/Core/Provider.hs +formatted 13032bda8285 hakyll-4.17.0.0/lib/Hakyll/Core/Provider/Internal.hs +formatted d080542e3185 hakyll-4.17.0.0/lib/Hakyll/Core/Provider/Metadata.hs +formatted 0cfbeb9b73ba hakyll-4.17.0.0/lib/Hakyll/Core/Provider/MetadataCache.hs +formatted b66bbdf4a200 hakyll-4.17.0.0/lib/Hakyll/Core/Routes.hs +formatted 6fc04bfca9f2 hakyll-4.17.0.0/lib/Hakyll/Core/Rules.hs +formatted a3472736a528 hakyll-4.17.0.0/lib/Hakyll/Core/Rules/Internal.hs +formatted 3ff34b463d20 hakyll-4.17.0.0/lib/Hakyll/Core/Runtime.hs +formatted df1c2bd7e8fb hakyll-4.17.0.0/lib/Hakyll/Core/Store.hs +formatted 69e4cf2a975a hakyll-4.17.0.0/lib/Hakyll/Core/UnixFilter.hs +formatted acbb971a63bc hakyll-4.17.0.0/lib/Hakyll/Core/Util/File.hs +formatted 5cef0dfbc5f6 hakyll-4.17.0.0/lib/Hakyll/Core/Util/Parser.hs +formatted 3f21bbf445b2 hakyll-4.17.0.0/lib/Hakyll/Core/Util/String.hs +formatted a3abc0522132 hakyll-4.17.0.0/lib/Hakyll/Core/Writable.hs +formatted 4a743a6f14b2 hakyll-4.17.0.0/lib/Hakyll/Main.hs +formatted daae4ce0a7f7 hakyll-4.17.0.0/lib/Hakyll/Preview/Poll.hs +formatted d363dc04f1a7 hakyll-4.17.0.0/lib/Hakyll/Preview/Server.hs +formatted 90f95798e3c7 hakyll-4.17.0.0/lib/Hakyll/Web/CompressCss.hs +formatted 2fc0d8fdc6f4 hakyll-4.17.0.0/lib/Hakyll/Web/Feed.hs +formatted 9e925648d786 hakyll-4.17.0.0/lib/Hakyll/Web/Html.hs +formatted 2c80bbb22db0 hakyll-4.17.0.0/lib/Hakyll/Web/Html/RelativizeUrls.hs +formatted 0923e680c5d2 hakyll-4.17.0.0/lib/Hakyll/Web/Meta/JSONLD.hs +formatted a3dbe80d0b45 hakyll-4.17.0.0/lib/Hakyll/Web/Meta/OpenGraph.hs +formatted a3b6503b2c4a hakyll-4.17.0.0/lib/Hakyll/Web/Meta/TwitterCard.hs +formatted 47b99b2ffc3a hakyll-4.17.0.0/lib/Hakyll/Web/Paginate.hs +formatted fe263519bf71 hakyll-4.17.0.0/lib/Hakyll/Web/Pandoc.hs +formatted 5f46737f3756 hakyll-4.17.0.0/lib/Hakyll/Web/Pandoc/Biblio.hs +formatted 63c711e3ed6f hakyll-4.17.0.0/lib/Hakyll/Web/Pandoc/Binary.hs +formatted 413e30365505 hakyll-4.17.0.0/lib/Hakyll/Web/Pandoc/FileType.hs +formatted d77258d3d120 hakyll-4.17.0.0/lib/Hakyll/Web/Redirect.hs +formatted 174f0977fbfb hakyll-4.17.0.0/lib/Hakyll/Web/Tags.hs +formatted 0e9947c1a4f2 hakyll-4.17.0.0/lib/Hakyll/Web/Template.hs +formatted 61c4714e9090 hakyll-4.17.0.0/lib/Hakyll/Web/Template/Context.hs +formatted 46295fe0766a hakyll-4.17.0.0/lib/Hakyll/Web/Template/Internal.hs +formatted 1ba12838107a hakyll-4.17.0.0/lib/Hakyll/Web/Template/Internal/Element.hs +formatted 7741b1b5c63c hakyll-4.17.0.0/lib/Hakyll/Web/Template/Internal/Trim.hs +formatted 270fe0160883 hakyll-4.17.0.0/lib/Hakyll/Web/Template/List.hs +formatted 3bd65fed66ca hakyll-4.17.0.0/src/Init.hs +formatted a98f565dc3bd hakyll-4.17.0.0/tests/Hakyll/Core/Dependencies/Tests.hs +formatted 178a4cbe186e hakyll-4.17.0.0/tests/Hakyll/Core/Identifier/Tests.hs +formatted f8af7a73d467 hakyll-4.17.0.0/tests/Hakyll/Core/Provider/Metadata/Tests.hs +formatted 7741f8e19a21 hakyll-4.17.0.0/tests/Hakyll/Core/Provider/Tests.hs +formatted 0a6fac8a3fe5 hakyll-4.17.0.0/tests/Hakyll/Core/Routes/Tests.hs +formatted db910a6e5dc7 hakyll-4.17.0.0/tests/Hakyll/Core/Rules/Tests.hs +formatted 82ed53ac9567 hakyll-4.17.0.0/tests/Hakyll/Core/Runtime/Tests.hs +formatted 3a05a7e0bc33 hakyll-4.17.0.0/tests/Hakyll/Core/Store/Tests.hs +formatted 7d940c89cef0 hakyll-4.17.0.0/tests/Hakyll/Core/UnixFilter/Tests.hs +formatted e736c3a104ec hakyll-4.17.0.0/tests/Hakyll/Core/Util/String/Tests.hs +formatted 0bb0c4e70b5a hakyll-4.17.0.0/tests/Hakyll/Web/CompressCss/Tests.hs +formatted a15554f5d248 hakyll-4.17.0.0/tests/Hakyll/Web/Feed/Tests.hs +formatted e35e1039078b hakyll-4.17.0.0/tests/Hakyll/Web/Html/RelativizeUrls/Tests.hs +formatted 4744c78df9c5 hakyll-4.17.0.0/tests/Hakyll/Web/Html/Tests.hs +formatted 024dfd4bd370 hakyll-4.17.0.0/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs +formatted 6ca61c42770e hakyll-4.17.0.0/tests/Hakyll/Web/Pandoc/FileType/Tests.hs +formatted 84bc8e02e810 hakyll-4.17.0.0/tests/Hakyll/Web/Tags/Tests.hs +formatted 22cdf7a972b8 hakyll-4.17.0.0/tests/Hakyll/Web/Template/Context/Tests.hs +formatted 713b01148048 hakyll-4.17.0.0/tests/Hakyll/Web/Template/Tests.hs +formatted 7638b562c2be hakyll-4.17.0.0/tests/TestSuite.hs +formatted d0e8ca390798 hakyll-4.17.0.0/tests/TestSuite/Util.hs +formatted 66153c16e099 hakyll-4.17.0.0/web/site.hs +formatted 9226007b6541 hashable-1.5.1.0/Setup.hs +formatted ca97ac3a2690 hashable-1.5.1.0/examples/Main.hs +formatted eeae7da4f236 hashable-1.5.1.0/src/Data/Hashable.hs +declined - hashable-1.5.1.0/src/Data/Hashable/Class.hs +formatted 63527ee9cd6b hashable-1.5.1.0/src/Data/Hashable/FFI.hs +formatted d2be5b809f2a hashable-1.5.1.0/src/Data/Hashable/Generic.hs +formatted ca3275b258b3 hashable-1.5.1.0/src/Data/Hashable/Generic/Instances.hs +formatted c9c87bb00bc0 hashable-1.5.1.0/src/Data/Hashable/Imports.hs +formatted e6b4c010a36d hashable-1.5.1.0/src/Data/Hashable/Lifted.hs +formatted 710bda251742 hashable-1.5.1.0/src/Data/Hashable/LowLevel.hs +formatted 228c88ef0843 hashable-1.5.1.0/src/Data/Hashable/Mix.hs +formatted bd7108c77ca4 hashable-1.5.1.0/src/Data/Hashable/XXH3.hs +formatted f74f5b618f9a hashable-1.5.1.0/tests/Main.hs +formatted 5f3b7f834308 hashable-1.5.1.0/tests/Properties.hs +broken 42af08530ac7 hashable-1.5.1.0/tests/Regress.hs +formatted 468c72120829 hashable-1.5.1.0/tests/xxhash-tests.hs +formatted 867a035875ee haxl-2.5.1.1/Haxl/Core.hs +formatted d1219c0fe211 haxl-2.5.1.1/Haxl/Core/CallGraph.hs +formatted 0ae77138c17c haxl-2.5.1.1/Haxl/Core/DataCache.hs +formatted 87d5268c5c21 haxl-2.5.1.1/Haxl/Core/DataSource.hs +formatted b4583121e35d haxl-2.5.1.1/Haxl/Core/Exception.hs +formatted 2a7c39599c8c haxl-2.5.1.1/Haxl/Core/Fetch.hs +formatted b4afaa8d717d haxl-2.5.1.1/Haxl/Core/Flags.hs +formatted f5053bdd605e haxl-2.5.1.1/Haxl/Core/Memo.hs +formatted 295e686b1256 haxl-2.5.1.1/Haxl/Core/Monad.hs +formatted 59de6a1f9ba8 haxl-2.5.1.1/Haxl/Core/Parallel.hs +formatted dfa57a1a8071 haxl-2.5.1.1/Haxl/Core/Profile.hs +formatted 72749066756e haxl-2.5.1.1/Haxl/Core/RequestStore.hs +formatted c5d4556673d1 haxl-2.5.1.1/Haxl/Core/Run.hs +formatted a8e73c380c33 haxl-2.5.1.1/Haxl/Core/ShowP.hs +formatted f2cb25c4ae73 haxl-2.5.1.1/Haxl/Core/StateStore.hs +formatted 979f6f3e416c haxl-2.5.1.1/Haxl/Core/Stats.hs +formatted bd368a5862fd haxl-2.5.1.1/Haxl/Core/Util.hs +formatted 4d201ce15d28 haxl-2.5.1.1/Haxl/DataSource/ConcurrentIO.hs +formatted cf38b55569d1 haxl-2.5.1.1/Haxl/Prelude.hs +formatted 0bf115c25c25 haxl-2.5.1.1/Setup.hs +formatted 5897e1a72e86 haxl-2.5.1.1/tests/AdoTests.hs +formatted 7392cb2bf8df haxl-2.5.1.1/tests/AllTests.hs +formatted d2d969d17124 haxl-2.5.1.1/tests/BadDataSource.hs +formatted c747d2048e95 haxl-2.5.1.1/tests/BatchTests.hs +formatted a75656cc58b4 haxl-2.5.1.1/tests/Bench.hs +formatted 67f526c34fd3 haxl-2.5.1.1/tests/CoreTests.hs +formatted 616081b9f14c haxl-2.5.1.1/tests/DataCacheTest.hs +formatted 8120f9ee1106 haxl-2.5.1.1/tests/DataSourceDispatchTests.hs +formatted e20ece2dcc35 haxl-2.5.1.1/tests/ExampleDataSource.hs +formatted 60d04dd78c5e haxl-2.5.1.1/tests/ExceptionStackTests.hs +formatted 329e1c7e0fd4 haxl-2.5.1.1/tests/FullyAsyncTest.hs +formatted 5b348a1f5fab haxl-2.5.1.1/tests/LoadCache.hs +formatted 4c9a496637db haxl-2.5.1.1/tests/MemoizationTests.hs +formatted fc04b9cb728b haxl-2.5.1.1/tests/MockTAO.hs +formatted 679224c9d5e5 haxl-2.5.1.1/tests/MonadAsyncTest.hs +formatted 98176d25f2d8 haxl-2.5.1.1/tests/MonadBench.hs +formatted 44fb28b20457 haxl-2.5.1.1/tests/OutgoneFetchesTests.hs +formatted f760bff6e190 haxl-2.5.1.1/tests/ParallelTests.hs +formatted ea594477eb7f haxl-2.5.1.1/tests/ProfileTests.hs +formatted 478999c2d1bd haxl-2.5.1.1/tests/SleepDataSource.hs +formatted acd820448a53 haxl-2.5.1.1/tests/StatsTests.hs +formatted e30def33c769 haxl-2.5.1.1/tests/TestBadDataSource.hs +formatted 26dd7ea798ca haxl-2.5.1.1/tests/TestExampleDataSource.hs +formatted 33f33c2b6767 haxl-2.5.1.1/tests/TestMain.hs +formatted c0a01d1bb863 haxl-2.5.1.1/tests/TestTypes.hs +formatted 0cdf14515138 haxl-2.5.1.1/tests/TestUtils.hs +formatted 19781f6f8677 haxl-2.5.1.1/tests/WorkDataSource.hs +formatted b8be7bcaa06e haxl-2.5.1.1/tests/WriteTests.hs +formatted 39ae68a1e26c hedgehog-1.7/src/Hedgehog.hs +formatted 1c094fda6263 hedgehog-1.7/src/Hedgehog/Gen.hs +formatted c03c7c6e1080 hedgehog-1.7/src/Hedgehog/Internal/Barbie.hs +formatted d9db2ccb4bc7 hedgehog-1.7/src/Hedgehog/Internal/Config.hs +formatted 7855a4bfe6fc hedgehog-1.7/src/Hedgehog/Internal/Discovery.hs +formatted 968088a89cf8 hedgehog-1.7/src/Hedgehog/Internal/Distributive.hs +formatted db3d79ebed8e hedgehog-1.7/src/Hedgehog/Internal/Exception.hs +formatted 9815c1a50552 hedgehog-1.7/src/Hedgehog/Internal/Gen.hs +formatted 82bd44e46c74 hedgehog-1.7/src/Hedgehog/Internal/HTraversable.hs +formatted 0b6e930c617c hedgehog-1.7/src/Hedgehog/Internal/Opaque.hs +formatted 0c41d0d4f087 hedgehog-1.7/src/Hedgehog/Internal/Prelude.hs +formatted 6810eba33ae6 hedgehog-1.7/src/Hedgehog/Internal/Property.hs +formatted 144a39866885 hedgehog-1.7/src/Hedgehog/Internal/Queue.hs +formatted 9d14d12ad0b0 hedgehog-1.7/src/Hedgehog/Internal/Range.hs +formatted e83fa4c27743 hedgehog-1.7/src/Hedgehog/Internal/Region.hs +formatted ab1296ed4cc9 hedgehog-1.7/src/Hedgehog/Internal/Report.hs +formatted f73ae514c1f8 hedgehog-1.7/src/Hedgehog/Internal/Runner.hs +formatted 5c17cc008e95 hedgehog-1.7/src/Hedgehog/Internal/Seed.hs +formatted 704b5c10e39d hedgehog-1.7/src/Hedgehog/Internal/Show.hs +formatted c446e4f9c366 hedgehog-1.7/src/Hedgehog/Internal/Shrink.hs +formatted c9e8e47ba6c5 hedgehog-1.7/src/Hedgehog/Internal/Source.hs +formatted dc592494d5b6 hedgehog-1.7/src/Hedgehog/Internal/State.hs +formatted 6c94f06be1cf hedgehog-1.7/src/Hedgehog/Internal/TH.hs +formatted 8a627c0fefb1 hedgehog-1.7/src/Hedgehog/Internal/Tree.hs +formatted 42e8fad71904 hedgehog-1.7/src/Hedgehog/Internal/Tripping.hs +formatted 33c9141eeffd hedgehog-1.7/src/Hedgehog/Main.hs +formatted d71772dad16c hedgehog-1.7/src/Hedgehog/Range.hs +formatted e23ab85e9c05 hedgehog-1.7/test/Test/Hedgehog/Applicative.hs +formatted 37e6a1383406 hedgehog-1.7/test/Test/Hedgehog/Confidence.hs +formatted 937e5890d2b0 hedgehog-1.7/test/Test/Hedgehog/Filter.hs +formatted 6e253dd6a871 hedgehog-1.7/test/Test/Hedgehog/Maybe.hs +formatted b90e9af1e67d hedgehog-1.7/test/Test/Hedgehog/Seed.hs +formatted 4edd92333a33 hedgehog-1.7/test/Test/Hedgehog/Skip.hs +formatted d20ec251ab72 hedgehog-1.7/test/Test/Hedgehog/Text.hs +formatted 2d3b2e9d7168 hedgehog-1.7/test/Test/Hedgehog/Zip.hs +formatted df799f9ffb57 hedgehog-1.7/test/test.hs +formatted 01b498bf6573 hledger-1.52.1/Hledger/Cli.hs +formatted 2883f330eae3 hledger-1.52.1/Hledger/Cli/Anchor.hs +formatted 8da9d899b517 hledger-1.52.1/Hledger/Cli/Anon.hs +formatted 43e230af0dbc hledger-1.52.1/Hledger/Cli/CliOptions.hs +formatted df73224dbfc3 hledger-1.52.1/Hledger/Cli/Commands.hs +formatted b5468ff32d68 hledger-1.52.1/Hledger/Cli/Commands/Accounts.hs +formatted 9f82d9b83f50 hledger-1.52.1/Hledger/Cli/Commands/Activity.hs +formatted 390f5c20db45 hledger-1.52.1/Hledger/Cli/Commands/Add.hs +formatted d2b5d8ddbfe2 hledger-1.52.1/Hledger/Cli/Commands/Aregister.hs +formatted 3d162d8b81a6 hledger-1.52.1/Hledger/Cli/Commands/Balance.hs +formatted f0880edebbde hledger-1.52.1/Hledger/Cli/Commands/Balancesheet.hs +formatted 6efd74ac6427 hledger-1.52.1/Hledger/Cli/Commands/Balancesheetequity.hs +formatted e7815e4484c7 hledger-1.52.1/Hledger/Cli/Commands/Cashflow.hs +formatted 71fa0aea1fe8 hledger-1.52.1/Hledger/Cli/Commands/Check.hs +formatted 9acd11176d66 hledger-1.52.1/Hledger/Cli/Commands/Close.hs +formatted 1ee9d5996a53 hledger-1.52.1/Hledger/Cli/Commands/Codes.hs +formatted d9cafa4a7ba9 hledger-1.52.1/Hledger/Cli/Commands/Commodities.hs +formatted 8b9bde91d49e hledger-1.52.1/Hledger/Cli/Commands/Demo.hs +formatted c6b07096e5d5 hledger-1.52.1/Hledger/Cli/Commands/Descriptions.hs +formatted d7f05c08652b hledger-1.52.1/Hledger/Cli/Commands/Diff.hs +formatted 314567299894 hledger-1.52.1/Hledger/Cli/Commands/Files.hs +formatted 15d50a6cb01a hledger-1.52.1/Hledger/Cli/Commands/Help.hs +formatted ab6a528f18d5 hledger-1.52.1/Hledger/Cli/Commands/Import.hs +formatted f52dabbdb8da hledger-1.52.1/Hledger/Cli/Commands/Incomestatement.hs +formatted f3beae981cf6 hledger-1.52.1/Hledger/Cli/Commands/Notes.hs +formatted c2ba7a5f589f hledger-1.52.1/Hledger/Cli/Commands/Payees.hs +formatted 386853c2aabb hledger-1.52.1/Hledger/Cli/Commands/Prices.hs +formatted 710dcb2e4f9b hledger-1.52.1/Hledger/Cli/Commands/Print.hs +formatted 0776c0d4e1bb hledger-1.52.1/Hledger/Cli/Commands/Register.hs +formatted 86dbaaa31622 hledger-1.52.1/Hledger/Cli/Commands/Rewrite.hs +formatted 5057749fdb76 hledger-1.52.1/Hledger/Cli/Commands/Roi.hs +formatted fdd3ce4aced8 hledger-1.52.1/Hledger/Cli/Commands/Run.hs +formatted 9eb1c950c825 hledger-1.52.1/Hledger/Cli/Commands/Setup.hs +formatted 619de6c78d7a hledger-1.52.1/Hledger/Cli/Commands/Stats.hs +formatted 7a05bf643d07 hledger-1.52.1/Hledger/Cli/Commands/Tags.hs +formatted f3805bd9e067 hledger-1.52.1/Hledger/Cli/CompoundBalanceCommand.hs +formatted 790c0d70714f hledger-1.52.1/Hledger/Cli/Conf.hs +formatted d2d28f0566d1 hledger-1.52.1/Hledger/Cli/DocFiles.hs +formatted 060eef1f372e hledger-1.52.1/Hledger/Cli/Script.hs +formatted 692db84f9314 hledger-1.52.1/Hledger/Cli/Utils.hs +formatted 75e82c3d7f3a hledger-1.52.1/Hledger/Cli/Version.hs +formatted e865ae48f11b hledger-1.52.1/Setup.hs +formatted 5f05220c744b hledger-1.52.1/app/hledger-cli.hs +formatted 4aa7156cea96 hledger-1.52.1/bench/bench.hs +formatted 770ce114d693 hledger-1.52.1/test/unittest.hs +formatted e865ae48f11b hlint-3.10/Setup.hs +formatted c359541e6f23 hlint-3.10/data/HLint_QuickCheck.hs +declined - hlint-3.10/data/HLint_TypeCheck.hs +formatted 7f62e2698706 hlint-3.10/data/Test.hs +formatted 3d97c22b05bf hlint-3.10/src/Apply.hs +formatted 3fcacf39d946 hlint-3.10/src/CC.hs +formatted b10eb0886b76 hlint-3.10/src/CmdLine.hs +formatted 221e9adae31a hlint-3.10/src/Config/Compute.hs +formatted a7c73de17e90 hlint-3.10/src/Config/Haskell.hs +formatted 747182f5f5c1 hlint-3.10/src/Config/Read.hs +formatted 1c0e336b9e8f hlint-3.10/src/Config/Type.hs +declined - hlint-3.10/src/Config/Yaml.hs +formatted 871e24292ba2 hlint-3.10/src/EmbedData.hs +formatted a0cce8b000d7 hlint-3.10/src/Extension.hs +formatted 232c5ddbbb9b hlint-3.10/src/Fixity.hs +formatted d904d8984e43 hlint-3.10/src/GHC/All.hs +formatted 63d81c2c405a hlint-3.10/src/GHC/Util.hs +formatted 0106b9c8d879 hlint-3.10/src/GHC/Util/ApiAnnotation.hs +formatted f9d97257610d hlint-3.10/src/GHC/Util/Brackets.hs +formatted 8cff3984ef92 hlint-3.10/src/GHC/Util/DynFlags.hs +formatted 56ec3add8792 hlint-3.10/src/GHC/Util/FreeVars.hs +formatted 9ab2d91ee37b hlint-3.10/src/GHC/Util/HsDecl.hs +formatted ba417cad3380 hlint-3.10/src/GHC/Util/HsExpr.hs +formatted 7e3362b9d0bb hlint-3.10/src/GHC/Util/Scope.hs +formatted d8a06089d209 hlint-3.10/src/GHC/Util/SrcLoc.hs +formatted 32a1ee71787a hlint-3.10/src/GHC/Util/Unify.hs +formatted ee5a3002a158 hlint-3.10/src/GHC/Util/View.hs +formatted dcf2b6c06331 hlint-3.10/src/HLint.hs +formatted 6e2f629bc2ae hlint-3.10/src/Hint/All.hs +formatted fea1c1a2897d hlint-3.10/src/Hint/Bracket.hs +formatted e0953eb3c567 hlint-3.10/src/Hint/Comment.hs +formatted 4a34094f4e91 hlint-3.10/src/Hint/Duplicate.hs +formatted a58adef76952 hlint-3.10/src/Hint/Export.hs +formatted ebafd0f86b73 hlint-3.10/src/Hint/Extensions.hs +formatted 8e9b77e23dc7 hlint-3.10/src/Hint/Fixities.hs +formatted 9e280ced172a hlint-3.10/src/Hint/Import.hs +formatted e123b5497c48 hlint-3.10/src/Hint/Lambda.hs +formatted 9306ce4be39c hlint-3.10/src/Hint/List.hs +formatted 367ea0ed84f0 hlint-3.10/src/Hint/ListRec.hs +formatted ff76042813f8 hlint-3.10/src/Hint/Match.hs +formatted 54ff68f3bc0d hlint-3.10/src/Hint/Monad.hs +formatted f5cb1a9c0152 hlint-3.10/src/Hint/Naming.hs +formatted 53ee9e6f677c hlint-3.10/src/Hint/Negation.hs +formatted 199df51582af hlint-3.10/src/Hint/NewType.hs +formatted 66e2152899c5 hlint-3.10/src/Hint/NumLiteral.hs +formatted 03b48e865a24 hlint-3.10/src/Hint/Pattern.hs +formatted 0076ccb5bd1c hlint-3.10/src/Hint/Pragma.hs +formatted c8af37d55e42 hlint-3.10/src/Hint/Restrict.hs +formatted 793c20138fa4 hlint-3.10/src/Hint/Smell.hs +formatted 3308ee100b88 hlint-3.10/src/Hint/Type.hs +formatted 06d92bcca35f hlint-3.10/src/Hint/Unsafe.hs +formatted 48cd04ad2e02 hlint-3.10/src/HsColour.hs +formatted 9f80ce05e290 hlint-3.10/src/Idea.hs +formatted 21091880d7b8 hlint-3.10/src/Language/Haskell/HLint.hs +formatted 7b8846cb4591 hlint-3.10/src/Main.hs +formatted fcdf50a5835c hlint-3.10/src/Parallel.hs +formatted cddb107b52b7 hlint-3.10/src/Refact.hs +formatted 08757ddcd20a hlint-3.10/src/Report.hs +formatted 63e79ae7e622 hlint-3.10/src/SARIF.hs +formatted d0eb61196032 hlint-3.10/src/Summary.hs +formatted e23d1347a2dd hlint-3.10/src/Test/All.hs +formatted 4a4b0f06e68b hlint-3.10/src/Test/Annotations.hs +formatted 80dc7efdd537 hlint-3.10/src/Test/InputOutput.hs +formatted f69b332bdb4f hlint-3.10/src/Test/Util.hs +formatted 0f5eb69b44dd hlint-3.10/src/Timing.hs +formatted 40bafe709540 hlint-3.10/src/Util.hs +formatted 14f5f9f6c72a hspec-core-2.11.17/src/GetOpt/Declarative.hs +formatted 13b54fc56d9e hspec-core-2.11.17/src/GetOpt/Declarative/Environment.hs +formatted ac874aa7540a hspec-core-2.11.17/src/GetOpt/Declarative/Interpret.hs +formatted aed8c8d69571 hspec-core-2.11.17/src/GetOpt/Declarative/Types.hs +formatted 7963314c7b2d hspec-core-2.11.17/src/GetOpt/Declarative/Util.hs +formatted c59700aebda7 hspec-core-2.11.17/src/Test/Hspec/Core/Annotations.hs +formatted aaed3a708e2b hspec-core-2.11.17/src/Test/Hspec/Core/Clock.hs +broken 043159a88536 hspec-core-2.11.17/src/Test/Hspec/Core/Compat.hs +formatted 0599f76d3382 hspec-core-2.11.17/src/Test/Hspec/Core/Config.hs +formatted d4499d7a9df1 hspec-core-2.11.17/src/Test/Hspec/Core/Config/Definition.hs +formatted 2c2affbefb39 hspec-core-2.11.17/src/Test/Hspec/Core/Config/Options.hs +formatted d65135838a37 hspec-core-2.11.17/src/Test/Hspec/Core/Example.hs +formatted 67abe1344a1b hspec-core-2.11.17/src/Test/Hspec/Core/Example/Location.hs +formatted 19c90134f072 hspec-core-2.11.17/src/Test/Hspec/Core/Extension.hs +formatted b5766e2580e3 hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Config.hs +formatted d822d438fd19 hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Config/Type.hs +formatted 5eb7b97d332b hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Item.hs +formatted 61fffea8ad44 hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Option.hs +formatted 2c1d2b4038d2 hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Spec.hs +formatted 090871045b95 hspec-core-2.11.17/src/Test/Hspec/Core/Extension/Tree.hs +formatted 9a4c4c61d167 hspec-core-2.11.17/src/Test/Hspec/Core/FailureReport.hs +formatted cb0511463c94 hspec-core-2.11.17/src/Test/Hspec/Core/Format.hs +formatted b8b03afd38ee hspec-core-2.11.17/src/Test/Hspec/Core/Formatters.hs +formatted 0f6c87760ec2 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Diff.hs +formatted da7bd7f0c6a9 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Internal.hs +formatted cd8a29b5bab7 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Pretty.hs +formatted 71e26cb11ffa hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs +formatted 07264fb33ca8 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Pretty/Unicode.hs +formatted 32564aeda195 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/V1.hs +formatted f7f280a9eab8 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/V1/Free.hs +formatted 2ade5a4b4c64 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/V1/Internal.hs +formatted 0879c2625e9f hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/V1/Monad.hs +formatted 2b46e6d892ef hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/V2.hs +formatted de2f6f0279c1 hspec-core-2.11.17/src/Test/Hspec/Core/Hooks.hs +formatted 35f4b48b53f0 hspec-core-2.11.17/src/Test/Hspec/Core/QuickCheck.hs +formatted e8c000ca0db9 hspec-core-2.11.17/src/Test/Hspec/Core/QuickCheck/Util.hs +formatted 24c9dad2d9bd hspec-core-2.11.17/src/Test/Hspec/Core/Runner.hs +formatted ce1b03ea14a3 hspec-core-2.11.17/src/Test/Hspec/Core/Runner/Eval.hs +formatted 45d877a0b59c hspec-core-2.11.17/src/Test/Hspec/Core/Runner/JobQueue.hs +formatted 3324ca8fd649 hspec-core-2.11.17/src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs +formatted dfca3a9a186c hspec-core-2.11.17/src/Test/Hspec/Core/Runner/Result.hs +formatted 9a99abc1c86d hspec-core-2.11.17/src/Test/Hspec/Core/Shuffle.hs +formatted 54648918fc16 hspec-core-2.11.17/src/Test/Hspec/Core/Spec.hs +formatted 2d50b76229a7 hspec-core-2.11.17/src/Test/Hspec/Core/Spec/Monad.hs +formatted 1b327d112974 hspec-core-2.11.17/src/Test/Hspec/Core/Timer.hs +formatted faae992d66db hspec-core-2.11.17/src/Test/Hspec/Core/Tree.hs +formatted 80d2d2b8d380 hspec-core-2.11.17/src/Test/Hspec/Core/Util.hs +formatted e06b7cc46fd9 hspec-core-2.11.17/test/GetOpt/Declarative/EnvironmentSpec.hs +formatted 6655e2e71bb3 hspec-core-2.11.17/test/GetOpt/Declarative/UtilSpec.hs +formatted c4b66f907855 hspec-core-2.11.17/test/Helper.hs +formatted 10aa2070ffb6 hspec-core-2.11.17/test/Mock.hs +formatted 42263bafabb2 hspec-core-2.11.17/test/Spec.hs +formatted 409fb8a0b5e3 hspec-core-2.11.17/test/SpecHook.hs +formatted ae9de2079048 hspec-core-2.11.17/test/Test/Hspec/Core/AnnotationsSpec.hs +formatted 1157d1650ac3 hspec-core-2.11.17/test/Test/Hspec/Core/ClockSpec.hs +formatted 819d29d3431f hspec-core-2.11.17/test/Test/Hspec/Core/CompatSpec.hs +formatted e5db68e3c868 hspec-core-2.11.17/test/Test/Hspec/Core/Config/DefinitionSpec.hs +formatted 105756fabf5e hspec-core-2.11.17/test/Test/Hspec/Core/Config/OptionsSpec.hs +formatted edfe82f15e2d hspec-core-2.11.17/test/Test/Hspec/Core/ConfigSpec.hs +formatted 035e99ae64f4 hspec-core-2.11.17/test/Test/Hspec/Core/Example/LocationSpec.hs +formatted d51ddf803043 hspec-core-2.11.17/test/Test/Hspec/Core/ExampleSpec.hs +formatted 4c0452141fce hspec-core-2.11.17/test/Test/Hspec/Core/FailureReportSpec.hs +formatted 8992979a0121 hspec-core-2.11.17/test/Test/Hspec/Core/FormatSpec.hs +formatted c2d7791f1000 hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/DiffSpec.hs +formatted cb3d38eb1461 hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/InternalSpec.hs +formatted 2ffb49f5a742 hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs +formatted afa9ffaa3bf1 hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/Pretty/UnicodeSpec.hs +formatted ac2da1dd4d6b hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/PrettySpec.hs +formatted 614ca58f541d hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/V1Spec.hs +formatted e113498e6ff6 hspec-core-2.11.17/test/Test/Hspec/Core/Formatters/V2Spec.hs +formatted b43a06946394 hspec-core-2.11.17/test/Test/Hspec/Core/HooksSpec.hs +formatted a32929c3e3b9 hspec-core-2.11.17/test/Test/Hspec/Core/QuickCheck/UtilSpec.hs +formatted 775321ce08bf hspec-core-2.11.17/test/Test/Hspec/Core/Runner/EvalSpec.hs +formatted 1a7b81d688ce hspec-core-2.11.17/test/Test/Hspec/Core/Runner/JobQueueSpec.hs +formatted 453f7a305fc2 hspec-core-2.11.17/test/Test/Hspec/Core/Runner/PrintSlowSpecItemsSpec.hs +formatted 6222147e36c5 hspec-core-2.11.17/test/Test/Hspec/Core/Runner/ResultSpec.hs +formatted fa3a7e8ed2cf hspec-core-2.11.17/test/Test/Hspec/Core/RunnerSpec.hs +formatted be08f1178641 hspec-core-2.11.17/test/Test/Hspec/Core/ShuffleSpec.hs +formatted 6c250c13b42b hspec-core-2.11.17/test/Test/Hspec/Core/SpecSpec.hs +formatted ccd964421c9d hspec-core-2.11.17/test/Test/Hspec/Core/TimerSpec.hs +formatted ad44f3bb30b2 hspec-core-2.11.17/test/Test/Hspec/Core/TreeSpec.hs +formatted a46fa24d2bd0 hspec-core-2.11.17/test/Test/Hspec/Core/UtilSpec.hs +formatted 47b3f474a58b hspec-core-2.11.17/vendor/Data/Algorithm/Diff.hs +partly-checked 0fb98ceed356 hspec-core-2.11.17/vendor/async-2.2.5/Control/Concurrent/Async.hs +formatted bea44982097a hspec-core-2.11.17/vendor/stm-2.5.0.1/Control/Concurrent/STM/TMVar.hs +formatted 4b70560a046e http-client-0.7.19/Data/KeyedPool.hs +formatted ee21d51c58b7 http-client-0.7.19/Network/HTTP/Client.hs +formatted 78f4e79070b8 http-client-0.7.19/Network/HTTP/Client/Body.hs +formatted e9db5b7dff2e http-client-0.7.19/Network/HTTP/Client/Connection.hs +formatted e02d2d7818fe http-client-0.7.19/Network/HTTP/Client/Cookies.hs +formatted f2e7c7f3925a http-client-0.7.19/Network/HTTP/Client/Core.hs +formatted 7a5aad8e01a5 http-client-0.7.19/Network/HTTP/Client/Headers.hs +formatted 44b1ad27a89e http-client-0.7.19/Network/HTTP/Client/Internal.hs +formatted 4ea11457dd48 http-client-0.7.19/Network/HTTP/Client/Manager.hs +formatted 7bbd1549c1c5 http-client-0.7.19/Network/HTTP/Client/MultipartFormData.hs +formatted 3803b865de9c http-client-0.7.19/Network/HTTP/Client/Request.hs +formatted b31b91e4e8d8 http-client-0.7.19/Network/HTTP/Client/Response.hs +formatted 3a988ae6956e http-client-0.7.19/Network/HTTP/Client/Types.hs +formatted ca6a48d5e983 http-client-0.7.19/Network/HTTP/Client/Util.hs +formatted 0cd574de49ba http-client-0.7.19/Network/HTTP/Proxy.hs +formatted e865ae48f11b http-client-0.7.19/Setup.hs +formatted b1d3bc1d8679 http-client-0.7.19/publicsuffixlist/Network/PublicSuffixList/DataStructure.hs +formatted 245d124b8415 http-client-0.7.19/publicsuffixlist/Network/PublicSuffixList/Lookup.hs +formatted 765e07adf78d http-client-0.7.19/publicsuffixlist/Network/PublicSuffixList/Serialize.hs +formatted 5696ba4166cb http-client-0.7.19/publicsuffixlist/Network/PublicSuffixList/Types.hs +formatted 5a31984d56fd http-client-0.7.19/test-nonet/Network/HTTP/Client/BodySpec.hs +formatted 329d7775ecfb http-client-0.7.19/test-nonet/Network/HTTP/Client/ConnectionSpec.hs +formatted baf77babfc94 http-client-0.7.19/test-nonet/Network/HTTP/Client/CookieSpec.hs +formatted 11f71ff1af3c http-client-0.7.19/test-nonet/Network/HTTP/Client/HeadersSpec.hs +formatted 5a9957b3a2b8 http-client-0.7.19/test-nonet/Network/HTTP/Client/RequestBodySpec.hs +formatted a8c38aff0a1a http-client-0.7.19/test-nonet/Network/HTTP/Client/RequestSpec.hs +formatted 50108fcc3e79 http-client-0.7.19/test-nonet/Network/HTTP/Client/ResponseSpec.hs +formatted ca2b9c8a628f http-client-0.7.19/test-nonet/Network/HTTP/ClientSpec.hs +formatted 2fbd14b119a4 http-client-0.7.19/test-nonet/Spec.hs +formatted ef38979ac638 http-client-0.7.19/test/Network/HTTP/ClientSpec.hs +formatted 2fbd14b119a4 http-client-0.7.19/test/Spec.hs +formatted 13d151556922 http-types-0.12.6/Network/HTTP/Types.hs +formatted e7eff6d3c526 http-types-0.12.6/Network/HTTP/Types/Header.hs +formatted 26f2850b0a92 http-types-0.12.6/Network/HTTP/Types/Method.hs +formatted 937169187cf1 http-types-0.12.6/Network/HTTP/Types/QueryLike.hs +formatted d965b24d0a62 http-types-0.12.6/Network/HTTP/Types/Status.hs +formatted 8393cb3031e8 http-types-0.12.6/Network/HTTP/Types/URI.hs +formatted f437cc36b9fa http-types-0.12.6/Network/HTTP/Types/Version.hs +formatted e865ae48f11b http-types-0.12.6/Setup.hs +formatted 7d11c2eb808e http-types-0.12.6/test/Network/HTTP/Types/HeaderSpec.hs +formatted 1816a6090b5e http-types-0.12.6/test/Network/HTTP/Types/MethodSpec.hs +formatted 848ef1c45ded http-types-0.12.6/test/Network/HTTP/Types/StatusSpec.hs +formatted 9a3fe7ad6e47 http-types-0.12.6/test/Network/HTTP/Types/URISpec.hs +formatted 5ac67585c5a1 http-types-0.12.6/test/Network/HTTP/Types/VersionSpec.hs +formatted 2fbd14b119a4 http-types-0.12.6/test/Spec.hs +formatted 6d7c004ed36a http-types-0.12.6/test/doctests.hs +declined - idris-1.3.4/Setup.hs +formatted eaad300a8c66 idris-1.3.4/codegen/idris-codegen-c/Main.hs +formatted 98c659d52656 idris-1.3.4/codegen/idris-codegen-javascript/Main.hs +formatted 1c34071e721a idris-1.3.4/codegen/idris-codegen-node/Main.hs +formatted eaa6467947db idris-1.3.4/main/Main.hs +formatted 3fd541795c69 idris-1.3.4/src/IRTS/Bytecode.hs +formatted 9c31d32e255a idris-1.3.4/src/IRTS/CodegenC.hs +formatted 9e5812762ec8 idris-1.3.4/src/IRTS/CodegenCommon.hs +formatted 563f242aebaf idris-1.3.4/src/IRTS/CodegenJavaScript.hs +formatted 2940f3b8e91c idris-1.3.4/src/IRTS/Compiler.hs +formatted 649c4334c449 idris-1.3.4/src/IRTS/Defunctionalise.hs +formatted 521a60c0c99b idris-1.3.4/src/IRTS/DumpBC.hs +formatted 67e26a69bf18 idris-1.3.4/src/IRTS/Exports.hs +formatted 9e44d172890b idris-1.3.4/src/IRTS/Inliner.hs +formatted ca2a16bd8e2f idris-1.3.4/src/IRTS/JavaScript/AST.hs +formatted f768c79df832 idris-1.3.4/src/IRTS/JavaScript/Codegen.hs +formatted b171baf09627 idris-1.3.4/src/IRTS/JavaScript/LangTransforms.hs +formatted 837e1fafadd6 idris-1.3.4/src/IRTS/JavaScript/Name.hs +formatted cd5cebdbb649 idris-1.3.4/src/IRTS/JavaScript/PrimOp.hs +formatted 5eff81bf418b idris-1.3.4/src/IRTS/JavaScript/Specialize.hs +formatted be460f171d5f idris-1.3.4/src/IRTS/Lang.hs +formatted 877532317321 idris-1.3.4/src/IRTS/LangOpts.hs +formatted 54ee13488588 idris-1.3.4/src/IRTS/Portable.hs +formatted c092168371c9 idris-1.3.4/src/IRTS/Simplified.hs +formatted 8a93ea593409 idris-1.3.4/src/IRTS/System.hs +formatted 85927651d0ed idris-1.3.4/src/Idris/ASTUtils.hs +broken d6a87f54c89d idris-1.3.4/src/Idris/AbsSyntax.hs +formatted fb61ce03a769 idris-1.3.4/src/Idris/AbsSyntaxTree.hs +formatted 9f032fa98b74 idris-1.3.4/src/Idris/Apropos.hs +formatted 71a19541ed28 idris-1.3.4/src/Idris/CaseSplit.hs +formatted 887228791bf4 idris-1.3.4/src/Idris/Chaser.hs +formatted a47646c618f2 idris-1.3.4/src/Idris/CmdOptions.hs +formatted 4da7f931a59f idris-1.3.4/src/Idris/Colours.hs +formatted f4a75f24bcf9 idris-1.3.4/src/Idris/Completion.hs +formatted 499686be90c6 idris-1.3.4/src/Idris/Core/Binary.hs +formatted 306094253161 idris-1.3.4/src/Idris/Core/CaseTree.hs +formatted 51f525230ab3 idris-1.3.4/src/Idris/Core/Constraints.hs +formatted 32e1f1dc7a41 idris-1.3.4/src/Idris/Core/DeepSeq.hs +formatted 0b062ce794a9 idris-1.3.4/src/Idris/Core/Elaborate.hs +formatted 91f9a262eab1 idris-1.3.4/src/Idris/Core/Evaluate.hs +formatted 248e1a132506 idris-1.3.4/src/Idris/Core/Execute.hs +formatted 6b1accf65b3b idris-1.3.4/src/Idris/Core/ProofState.hs +formatted 3c7bae0176ad idris-1.3.4/src/Idris/Core/ProofTerm.hs +formatted 230ce006aa2f idris-1.3.4/src/Idris/Core/TT.hs +formatted 418dc775272d idris-1.3.4/src/Idris/Core/Typecheck.hs +formatted 1125cc1a59f1 idris-1.3.4/src/Idris/Core/Unify.hs +formatted 71eb35dcc836 idris-1.3.4/src/Idris/Core/WHNF.hs +formatted e884d58256bb idris-1.3.4/src/Idris/Coverage.hs +formatted 9c0fa0df0c99 idris-1.3.4/src/Idris/DSL.hs +formatted 4ff1e76d5e39 idris-1.3.4/src/Idris/DataOpts.hs +formatted 591136fc0c25 idris-1.3.4/src/Idris/DeepSeq.hs +formatted a47430a4c0e3 idris-1.3.4/src/Idris/Delaborate.hs +formatted d26382c2ddf7 idris-1.3.4/src/Idris/Directives.hs +formatted 2b830d08f106 idris-1.3.4/src/Idris/Docs.hs +formatted a485f5642886 idris-1.3.4/src/Idris/Docstrings.hs +formatted b2d1eec4cfbd idris-1.3.4/src/Idris/Elab/AsPat.hs +formatted 6388538eb9c9 idris-1.3.4/src/Idris/Elab/Clause.hs +formatted 9e5c2909e062 idris-1.3.4/src/Idris/Elab/Data.hs +formatted 82554cd8b109 idris-1.3.4/src/Idris/Elab/Implementation.hs +formatted 3983268f06e4 idris-1.3.4/src/Idris/Elab/Interface.hs +formatted 7c5f6b45e740 idris-1.3.4/src/Idris/Elab/Provider.hs +formatted 432315b423c7 idris-1.3.4/src/Idris/Elab/Quasiquote.hs +formatted 229f49cf1c9d idris-1.3.4/src/Idris/Elab/Record.hs +formatted 967c221efde2 idris-1.3.4/src/Idris/Elab/Rewrite.hs +formatted c43e0233a370 idris-1.3.4/src/Idris/Elab/RunElab.hs +formatted 89d365a14a2b idris-1.3.4/src/Idris/Elab/Term.hs +formatted 0883dc0ae293 idris-1.3.4/src/Idris/Elab/Transform.hs +formatted 26f6a53369bb idris-1.3.4/src/Idris/Elab/Type.hs +formatted 0e0ed355579b idris-1.3.4/src/Idris/Elab/Utils.hs +formatted 9f4ab880839f idris-1.3.4/src/Idris/Elab/Value.hs +formatted 1216ba79966f idris-1.3.4/src/Idris/ElabDecls.hs +formatted 68025bd6dc21 idris-1.3.4/src/Idris/Erasure.hs +formatted 7c4b0ef95bf4 idris-1.3.4/src/Idris/ErrReverse.hs +formatted 28314a1db8cc idris-1.3.4/src/Idris/Error.hs +formatted 21bcb871fca8 idris-1.3.4/src/Idris/Help.hs +formatted ad762fec9411 idris-1.3.4/src/Idris/IBC.hs +formatted cce75249d4d5 idris-1.3.4/src/Idris/IdeMode.hs +formatted 0c615974bec1 idris-1.3.4/src/Idris/IdrisDoc.hs +formatted 8b7f62814233 idris-1.3.4/src/Idris/Imports.hs +formatted 3e21520569d8 idris-1.3.4/src/Idris/Info.hs +formatted 90f54928d9ca idris-1.3.4/src/Idris/Info/Show.hs +formatted eb72f451c8f1 idris-1.3.4/src/Idris/Inliner.hs +formatted 98284ea4cd70 idris-1.3.4/src/Idris/Interactive.hs +formatted e0647767ec17 idris-1.3.4/src/Idris/Main.hs +formatted c79bede9bfeb idris-1.3.4/src/Idris/ModeCommon.hs +formatted 28bd80263c16 idris-1.3.4/src/Idris/Options.hs +formatted 3a608b013c4d idris-1.3.4/src/Idris/Output.hs +formatted 7b5bdcbe0f57 idris-1.3.4/src/Idris/Package.hs +formatted 2a5fae85b8c9 idris-1.3.4/src/Idris/Package/Common.hs +formatted 2bcb2e55e8aa idris-1.3.4/src/Idris/Package/Parser.hs +formatted b45be2cdbede idris-1.3.4/src/Idris/Parser.hs +formatted d28684b909dc idris-1.3.4/src/Idris/Parser/Data.hs +formatted da61e7dddf50 idris-1.3.4/src/Idris/Parser/Expr.hs +formatted 656292b222ab idris-1.3.4/src/Idris/Parser/Helpers.hs +formatted 00297a830b2d idris-1.3.4/src/Idris/Parser/Ops.hs +formatted 5182dd3b924f idris-1.3.4/src/Idris/Parser/Stack.hs +formatted 4873bf37b5fc idris-1.3.4/src/Idris/PartialEval.hs +formatted 58ad84ded5d8 idris-1.3.4/src/Idris/Primitives.hs +formatted 55a7e58fbd43 idris-1.3.4/src/Idris/ProofSearch.hs +formatted d74d60292062 idris-1.3.4/src/Idris/Prover.hs +formatted b2ed059dd3da idris-1.3.4/src/Idris/Providers.hs +formatted b8a3a757c0ca idris-1.3.4/src/Idris/REPL.hs +formatted d43671c3f627 idris-1.3.4/src/Idris/REPL/Browse.hs +formatted adeb73659e58 idris-1.3.4/src/Idris/REPL/Commands.hs +formatted 73f3c0c7bf6c idris-1.3.4/src/Idris/REPL/Parser.hs +formatted 9d0eae88a108 idris-1.3.4/src/Idris/Reflection.hs +formatted a069b8d050ff idris-1.3.4/src/Idris/Termination.hs +formatted 6837e439e7d6 idris-1.3.4/src/Idris/Transforms.hs +formatted a10eb7eb6eb8 idris-1.3.4/src/Idris/TypeSearch.hs +formatted efed23bf7411 idris-1.3.4/src/Idris/Unlit.hs +formatted b613b7be20de idris-1.3.4/src/Idris/WhoCalls.hs +declined - idris-1.3.4/src/Util/DynamicLinker.hs +formatted 038d72b760c3 idris-1.3.4/src/Util/Net.hs +formatted f47f361e150a idris-1.3.4/src/Util/Pretty.hs +formatted 13363649406c idris-1.3.4/src/Util/ScreenSize.hs +formatted 7d39399c082d idris-1.3.4/src/Util/System.hs +formatted 1dbb680d7054 idris-1.3.4/test/TestData.hs +formatted a31adc2b319f idris-1.3.4/test/TestRun.hs +formatted e865ae48f11b intero-0.1.40/Setup.hs +formatted 4bbbd2876ae9 intero-0.1.40/src/Completion.hs +formatted 7440e90ebfc6 intero-0.1.40/src/GhciFind.hs +partly-checked 20ef14d3e5df intero-0.1.40/src/GhciInfo.hs +formatted 7e9ae2f7b242 intero-0.1.40/src/GhciMonad.hs +formatted e7b607350a86 intero-0.1.40/src/GhciTags.hs +formatted 72999d5c814e intero-0.1.40/src/GhciTypes.hs +declined - intero-0.1.40/src/InteractiveUI.hs +formatted d3b894941b5e intero-0.1.40/src/Intero/Compat.hs +declined - intero-0.1.40/src/Main.hs +formatted 13b22f1a2f96 intero-0.1.40/src/test/Main.hs +formatted 4fe73bbfe233 leksah-0.16.2.2/data/leksah-welcome/src/Main.hs +formatted 1cefb44a49bc leksah-0.16.2.2/data/leksah-welcome/test/Main.hs +formatted 9b1bc79c9ca2 leksah-0.16.2.2/main/Main.hs +formatted d6d376192ba6 leksah-0.16.2.2/src/IDE/BufferMode.hs +formatted f92d6d5ed01c leksah-0.16.2.2/src/IDE/Build.hs +formatted 8362830b28ae leksah-0.16.2.2/src/IDE/Command.hs +formatted 311f46674981 leksah-0.16.2.2/src/IDE/Command/Print.hs +formatted 3587f60b8002 leksah-0.16.2.2/src/IDE/Command/VCS.hs +formatted c5a7ac7f5eb1 leksah-0.16.2.2/src/IDE/Command/VCS/Common.hs +formatted 800101f9a2a4 leksah-0.16.2.2/src/IDE/Command/VCS/Common/GUI.hs +formatted 84a0ff8c4900 leksah-0.16.2.2/src/IDE/Command/VCS/Common/Helper.hs +formatted 8615cfe9c636 leksah-0.16.2.2/src/IDE/Command/VCS/Common/Workspaces.hs +formatted 703e291d1e3f leksah-0.16.2.2/src/IDE/Command/VCS/GIT.hs +formatted 5bebaffe9dd2 leksah-0.16.2.2/src/IDE/Command/VCS/Mercurial.hs +formatted bd58623b7bee leksah-0.16.2.2/src/IDE/Command/VCS/SVN.hs +formatted 092138f05183 leksah-0.16.2.2/src/IDE/Command/VCS/Types.hs +formatted a448596691a1 leksah-0.16.2.2/src/IDE/Completion.hs +formatted 3c38d16ac03e leksah-0.16.2.2/src/IDE/Core/State.hs +formatted 4192db73165d leksah-0.16.2.2/src/IDE/Core/Types.hs +formatted c997e6f71ffb leksah-0.16.2.2/src/IDE/Debug.hs +does-not-parse - leksah-0.16.2.2/src/IDE/Find.hs +formatted ce97dab05a0d leksah-0.16.2.2/src/IDE/GUIHistory.hs +formatted 8f069cee943e leksah-0.16.2.2/src/IDE/HLint.hs +formatted d257bd397599 leksah-0.16.2.2/src/IDE/ImportTool.hs +formatted 9d846a900a68 leksah-0.16.2.2/src/IDE/Keymap.hs +formatted 3f0638c605cd leksah-0.16.2.2/src/IDE/LPaste.hs +formatted 7903248aba99 leksah-0.16.2.2/src/IDE/Leksah.hs +formatted 23fd13492eb9 leksah-0.16.2.2/src/IDE/LogRef.hs +formatted ca5d19c20d5c leksah-0.16.2.2/src/IDE/Metainfo/Provider.hs +formatted 68ab2c0137cc leksah-0.16.2.2/src/IDE/NotebookFlipper.hs +formatted d441d0417158 leksah-0.16.2.2/src/IDE/OSX.hs +formatted a720dde570ba leksah-0.16.2.2/src/IDE/Package.hs +formatted 59c82086f3fb leksah-0.16.2.2/src/IDE/Pane/Breakpoints.hs +formatted 3b9a25799eee leksah-0.16.2.2/src/IDE/Pane/Errors.hs +formatted c3bd99376237 leksah-0.16.2.2/src/IDE/Pane/Files.hs +formatted eaeecabefb74 leksah-0.16.2.2/src/IDE/Pane/Grep.hs +formatted 776709b4edac leksah-0.16.2.2/src/IDE/Pane/HLint.hs +formatted fc1b596b6aca leksah-0.16.2.2/src/IDE/Pane/Info.hs +formatted f3eae8aa0577 leksah-0.16.2.2/src/IDE/Pane/Log.hs +formatted 46903fd63785 leksah-0.16.2.2/src/IDE/Pane/Modules.hs +broken 49647b5943cd leksah-0.16.2.2/src/IDE/Pane/PackageEditor.hs +formatted 0d756eaf206d leksah-0.16.2.2/src/IDE/Pane/PackageFlags.hs +formatted 47d0e3537432 leksah-0.16.2.2/src/IDE/Pane/Search.hs +formatted 2b12c871920e leksah-0.16.2.2/src/IDE/Pane/SourceBuffer.hs +formatted f60ebab7323c leksah-0.16.2.2/src/IDE/Pane/Trace.hs +formatted d1243f6e2cb2 leksah-0.16.2.2/src/IDE/Pane/Variables.hs +formatted 10d80ccd68e9 leksah-0.16.2.2/src/IDE/Pane/WebKit/Documentation.hs +formatted f066058beef4 leksah-0.16.2.2/src/IDE/Pane/WebKit/Inspect.hs +formatted c747b2fb58a0 leksah-0.16.2.2/src/IDE/Pane/WebKit/Output.hs +formatted b4a06836dbcf leksah-0.16.2.2/src/IDE/Pane/Workspace.hs +formatted 33a766cc1c7d leksah-0.16.2.2/src/IDE/PaneGroups.hs +formatted 21c053af24d4 leksah-0.16.2.2/src/IDE/Preferences.hs +formatted 2f0f2284081d leksah-0.16.2.2/src/IDE/Session.hs +formatted 277f211ae71b leksah-0.16.2.2/src/IDE/SourceCandy.hs +formatted 95169d9d3f63 leksah-0.16.2.2/src/IDE/Statusbar.hs +formatted 70eb7c99746e leksah-0.16.2.2/src/IDE/SymbolNavigation.hs +formatted 265b135c829e leksah-0.16.2.2/src/IDE/TextEditor.hs +formatted b345661c1e07 leksah-0.16.2.2/src/IDE/TextEditor/Class.hs +formatted 341ec1727c7d leksah-0.16.2.2/src/IDE/TextEditor/CodeMirror.hs +formatted 8d9cbb5030a9 leksah-0.16.2.2/src/IDE/TextEditor/GtkSourceView.hs +formatted 668535f1f6ff leksah-0.16.2.2/src/IDE/TextEditor/Yi.hs +formatted c73baf7194c2 leksah-0.16.2.2/src/IDE/TextEditor/Yi/Config.hs +formatted 007fe37642f2 leksah-0.16.2.2/src/IDE/Utils/CabalUtils.hs +formatted a1e35678dab5 leksah-0.16.2.2/src/IDE/Utils/DirectoryUtils.hs +formatted fbdb61765ca2 leksah-0.16.2.2/src/IDE/Utils/ExternalTool.hs +formatted f82cd3575fb1 leksah-0.16.2.2/src/IDE/Utils/GUIUtils.hs +formatted dba5fad6d1d6 leksah-0.16.2.2/src/IDE/Utils/ServerConnection.hs +formatted 889365128863 leksah-0.16.2.2/src/IDE/Workspaces.hs +formatted 1a17606cf12b leksah-0.16.2.2/src/IDE/Workspaces/Writer.hs +formatted 0c3ca0ef251f lens-5.3.6/benchmarks/alongside.hs +formatted 5a0e24f56d19 lens-5.3.6/benchmarks/folds.hs +formatted a5e826be2e18 lens-5.3.6/benchmarks/plated.hs +formatted 91de2eafe033 lens-5.3.6/benchmarks/traversals.hs +formatted cf0afb8efdca lens-5.3.6/benchmarks/unsafe.hs +formatted 6b5d9407288a lens-5.3.6/examples/Aeson.hs +formatted fcea15eace15 lens-5.3.6/examples/Plates.hs +formatted 42c84063ca40 lens-5.3.6/examples/Pong.hs +formatted 1e7ca6c2bac4 lens-5.3.6/examples/Turtle.hs +formatted e865ae48f11b lens-5.3.6/lens-properties/Setup.hs +formatted 03d5b652be06 lens-5.3.6/lens-properties/src/Control/Lens/Properties.hs +broken 6f66b6321d8b lens-5.3.6/src/Control/Exception/Lens.hs +formatted 4fb8b462c692 lens-5.3.6/src/Control/Lens.hs +formatted dab5fde53fc2 lens-5.3.6/src/Control/Lens/At.hs +formatted 1a555e9740b2 lens-5.3.6/src/Control/Lens/Combinators.hs +formatted 45285718981c lens-5.3.6/src/Control/Lens/Cons.hs +formatted 087aa6536345 lens-5.3.6/src/Control/Lens/Each.hs +formatted db06507f8eb3 lens-5.3.6/src/Control/Lens/Empty.hs +formatted afba13ca40b2 lens-5.3.6/src/Control/Lens/Equality.hs +formatted e63ce52c62a6 lens-5.3.6/src/Control/Lens/Extras.hs +formatted bc07f01d16f1 lens-5.3.6/src/Control/Lens/Fold.hs +formatted 1d6b4529afae lens-5.3.6/src/Control/Lens/Getter.hs +formatted be96a32da04a lens-5.3.6/src/Control/Lens/Indexed.hs +formatted f2b77c23d24e lens-5.3.6/src/Control/Lens/Internal.hs +formatted ef704ee92ff4 lens-5.3.6/src/Control/Lens/Internal/Bazaar.hs +formatted 77d72de128e9 lens-5.3.6/src/Control/Lens/Internal/ByteString.hs +formatted d8ca8cef6fef lens-5.3.6/src/Control/Lens/Internal/CTypes.hs +formatted baf096fc8d0a lens-5.3.6/src/Control/Lens/Internal/Context.hs +formatted a6d8f75d39fc lens-5.3.6/src/Control/Lens/Internal/Deque.hs +formatted 4c63a54a8aeb lens-5.3.6/src/Control/Lens/Internal/Doctest.hs +formatted 36dfae32602b lens-5.3.6/src/Control/Lens/Internal/Exception.hs +formatted a7d4a6263d7d lens-5.3.6/src/Control/Lens/Internal/FieldTH.hs +formatted 0bf84e037423 lens-5.3.6/src/Control/Lens/Internal/Fold.hs +formatted 9d8c7d9a024a lens-5.3.6/src/Control/Lens/Internal/Getter.hs +formatted 76d7f11378f9 lens-5.3.6/src/Control/Lens/Internal/Indexed.hs +formatted 74a115066cae lens-5.3.6/src/Control/Lens/Internal/Instances.hs +formatted a9257a233659 lens-5.3.6/src/Control/Lens/Internal/Iso.hs +formatted 6790556bd514 lens-5.3.6/src/Control/Lens/Internal/Level.hs +formatted 929b3db19b16 lens-5.3.6/src/Control/Lens/Internal/List.hs +formatted eae79aadfa29 lens-5.3.6/src/Control/Lens/Internal/Magma.hs +formatted e8fad9977f5a lens-5.3.6/src/Control/Lens/Internal/Prelude.hs +formatted d033545bb0fa lens-5.3.6/src/Control/Lens/Internal/Prism.hs +formatted 4dffbb5256da lens-5.3.6/src/Control/Lens/Internal/PrismTH.hs +formatted a529e2b12e5a lens-5.3.6/src/Control/Lens/Internal/Profunctor.hs +formatted a0cfb7f64915 lens-5.3.6/src/Control/Lens/Internal/Review.hs +formatted bd611b570342 lens-5.3.6/src/Control/Lens/Internal/Setter.hs +formatted cb94f36001d0 lens-5.3.6/src/Control/Lens/Internal/TH.hs +formatted 962f8a77a69c lens-5.3.6/src/Control/Lens/Internal/Zoom.hs +formatted 4d4a8b86f259 lens-5.3.6/src/Control/Lens/Iso.hs +formatted 90c89d25de5a lens-5.3.6/src/Control/Lens/Lens.hs +formatted bde563e05b67 lens-5.3.6/src/Control/Lens/Level.hs +formatted b84cf710176f lens-5.3.6/src/Control/Lens/Operators.hs +formatted 61aef519b850 lens-5.3.6/src/Control/Lens/Plated.hs +formatted cd556da34caa lens-5.3.6/src/Control/Lens/Prism.hs +formatted b465099e5056 lens-5.3.6/src/Control/Lens/Profunctor.hs +formatted f12a4f9ff0a9 lens-5.3.6/src/Control/Lens/Reified.hs +formatted 6e871d8e4385 lens-5.3.6/src/Control/Lens/Review.hs +formatted 5f1a95d65c20 lens-5.3.6/src/Control/Lens/Setter.hs +formatted dcdba8e5777c lens-5.3.6/src/Control/Lens/TH.hs +formatted e1d252b2bb3a lens-5.3.6/src/Control/Lens/Traversal.hs +formatted 3a5cbb2c959c lens-5.3.6/src/Control/Lens/Tuple.hs +formatted 181a647a9c7b lens-5.3.6/src/Control/Lens/Type.hs +formatted ff8881502434 lens-5.3.6/src/Control/Lens/Unsound.hs +declined - lens-5.3.6/src/Control/Lens/Wrapped.hs +formatted 2c3a223dec39 lens-5.3.6/src/Control/Lens/Zoom.hs +formatted d04fd074c74d lens-5.3.6/src/Control/Monad/Error/Lens.hs +formatted b9bfa6cc2ae6 lens-5.3.6/src/Control/Parallel/Strategies/Lens.hs +formatted 3580c9fdbe74 lens-5.3.6/src/Control/Seq/Lens.hs +formatted ae1408607f92 lens-5.3.6/src/Data/Array/Lens.hs +formatted 4f2a2066b52a lens-5.3.6/src/Data/Bits/Lens.hs +formatted e1c3ede72b89 lens-5.3.6/src/Data/ByteString/Lazy/Lens.hs +formatted fd83b8412797 lens-5.3.6/src/Data/ByteString/Lens.hs +formatted a0beda949826 lens-5.3.6/src/Data/ByteString/Strict/Lens.hs +formatted e7fc0d3b8334 lens-5.3.6/src/Data/Complex/Lens.hs +formatted dab824fea092 lens-5.3.6/src/Data/Data/Lens.hs +formatted ae776c45408a lens-5.3.6/src/Data/Dynamic/Lens.hs +formatted 9817c7fd06d9 lens-5.3.6/src/Data/HashSet/Lens.hs +formatted 9b6a7ea1de9a lens-5.3.6/src/Data/IntSet/Lens.hs +formatted afd0c52fb1bb lens-5.3.6/src/Data/List/Lens.hs +formatted c78898aaa504 lens-5.3.6/src/Data/Map/Lens.hs +formatted bf33871e79d3 lens-5.3.6/src/Data/Sequence/Lens.hs +formatted 3b630e1120f0 lens-5.3.6/src/Data/Set/Lens.hs +formatted 6abbc5ff2a97 lens-5.3.6/src/Data/Text/Lazy/Lens.hs +formatted c144e0a2b4d7 lens-5.3.6/src/Data/Text/Lens.hs +formatted 5ce20871a8d2 lens-5.3.6/src/Data/Text/Strict/Lens.hs +formatted a4a006800f1d lens-5.3.6/src/Data/Tree/Lens.hs +formatted bfb9f14912e5 lens-5.3.6/src/Data/Typeable/Lens.hs +formatted fa5b2f903156 lens-5.3.6/src/Data/Vector/Generic/Lens.hs +formatted 4348b84e4ed7 lens-5.3.6/src/Data/Vector/Lens.hs +formatted 7e80fcd30b07 lens-5.3.6/src/GHC/Generics/Lens.hs +declined - lens-5.3.6/src/Language/Haskell/TH/Lens.hs +formatted 6142187a095c lens-5.3.6/src/Numeric/Lens.hs +formatted 11d5331927be lens-5.3.6/src/Numeric/Natural/Lens.hs +formatted 353cf4551a49 lens-5.3.6/src/System/Exit/Lens.hs +formatted 5a4f7cf6359b lens-5.3.6/src/System/FilePath/Lens.hs +formatted e8fab2c360dd lens-5.3.6/src/System/IO/Error/Lens.hs +formatted aa93fbb09ce5 lens-5.3.6/tests/BigRecord.hs +formatted 4bb6e1258874 lens-5.3.6/tests/T1024.hs +formatted b4be82b75781 lens-5.3.6/tests/T799.hs +formatted f9a61b457a6c lens-5.3.6/tests/T917.hs +formatted c8d456a949a1 lens-5.3.6/tests/T972.hs +formatted 1e9429a79aca lens-5.3.6/tests/doctests.hs +formatted cc78a4a446ba lens-5.3.6/tests/hunit.hs +declined - lens-5.3.6/tests/properties.hs +formatted 411e9ff9fd4b lens-5.3.6/tests/templates.hs +formatted 8e582508019b megaparsec-9.8.1/Text/Megaparsec.hs +formatted aaf0968c72cf megaparsec-9.8.1/Text/Megaparsec/Byte.hs +formatted af93162c0732 megaparsec-9.8.1/Text/Megaparsec/Byte/Binary.hs +formatted 6daebd54878b megaparsec-9.8.1/Text/Megaparsec/Byte/Lexer.hs +formatted a8f12808d592 megaparsec-9.8.1/Text/Megaparsec/Char.hs +formatted fb0aa0491a35 megaparsec-9.8.1/Text/Megaparsec/Char/Lexer.hs +formatted 9ada7619d986 megaparsec-9.8.1/Text/Megaparsec/Class.hs +formatted 04c41e5e9d68 megaparsec-9.8.1/Text/Megaparsec/Common.hs +formatted 56cf25afe110 megaparsec-9.8.1/Text/Megaparsec/Debug.hs +formatted 2a0ab69a0154 megaparsec-9.8.1/Text/Megaparsec/Error.hs +formatted 6dc9b6ce5897 megaparsec-9.8.1/Text/Megaparsec/Error.hs-boot +formatted 92e848d5b88d megaparsec-9.8.1/Text/Megaparsec/Error/Builder.hs +formatted ef8c030d6d02 megaparsec-9.8.1/Text/Megaparsec/Internal.hs +formatted 2d845f6be8a2 megaparsec-9.8.1/Text/Megaparsec/Internal.hs-boot +formatted fb54b4f4cab3 megaparsec-9.8.1/Text/Megaparsec/Lexer.hs +formatted 0db88dbc985e megaparsec-9.8.1/Text/Megaparsec/Pos.hs +formatted 4f1b6ce7ca12 megaparsec-9.8.1/Text/Megaparsec/State.hs +formatted 1391285f39da megaparsec-9.8.1/Text/Megaparsec/Stream.hs +formatted 5e21ab523a4c megaparsec-9.8.1/Text/Megaparsec/Unicode.hs +formatted 882124e5ceb6 megaparsec-9.8.1/bench/memory/Main.hs +formatted d8a32e7340de megaparsec-9.8.1/bench/speed/Main.hs +formatted e865ae48f11b microlens-0.5.0.0/Setup.hs +declined - microlens-0.5.0.0/src/Lens/Micro.hs +formatted a33fe5ffd3d9 microlens-0.5.0.0/src/Lens/Micro/Extras.hs +formatted 3608b82ef46d microlens-0.5.0.0/src/Lens/Micro/FieldN.hs +declined - microlens-0.5.0.0/src/Lens/Micro/Internal.hs +formatted de09492cc927 microlens-0.5.0.0/src/Lens/Micro/Type.hs +formatted 9fd4d8759261 mtl-2.3.2/Control/Monad/Accum.hs +formatted 1c966453ae10 mtl-2.3.2/Control/Monad/Cont.hs +formatted 6543a3adf1ee mtl-2.3.2/Control/Monad/Cont/Class.hs +formatted a1002896353b mtl-2.3.2/Control/Monad/Error/Class.hs +formatted 241b9ab5b29e mtl-2.3.2/Control/Monad/Except.hs +formatted fae093b03648 mtl-2.3.2/Control/Monad/Identity.hs +formatted 8bb64ac32001 mtl-2.3.2/Control/Monad/RWS.hs +formatted f59a78122b11 mtl-2.3.2/Control/Monad/RWS/CPS.hs +formatted 853a42d0a7d0 mtl-2.3.2/Control/Monad/RWS/Class.hs +formatted 6fedd348f84f mtl-2.3.2/Control/Monad/RWS/Lazy.hs +formatted ddc740ed2ba9 mtl-2.3.2/Control/Monad/RWS/Strict.hs +formatted 70448da6c08e mtl-2.3.2/Control/Monad/Reader.hs +formatted 048f1d41ceeb mtl-2.3.2/Control/Monad/Reader/Class.hs +formatted fda85a3d8a5b mtl-2.3.2/Control/Monad/Select.hs +formatted dbf53d8970a0 mtl-2.3.2/Control/Monad/State.hs +formatted a11cb9d9968b mtl-2.3.2/Control/Monad/State/Class.hs +formatted 297011983d2c mtl-2.3.2/Control/Monad/State/Lazy.hs +formatted 77f07f071154 mtl-2.3.2/Control/Monad/State/Strict.hs +formatted 4442f9cb2755 mtl-2.3.2/Control/Monad/Trans.hs +formatted c315c681e4a7 mtl-2.3.2/Control/Monad/Writer.hs +formatted bd34c32bca35 mtl-2.3.2/Control/Monad/Writer/CPS.hs +formatted 220119ac3010 mtl-2.3.2/Control/Monad/Writer/Class.hs +formatted 26c1b816de3a mtl-2.3.2/Control/Monad/Writer/Lazy.hs +formatted e5a4e79a643b mtl-2.3.2/Control/Monad/Writer/Strict.hs +formatted e865ae48f11b mtl-2.3.2/Setup.hs +formatted 9007a7528d49 optics-0.4.2.1/benchmarks/folds.hs +formatted 6819e713d7fd optics-0.4.2.1/benchmarks/traversals.hs +formatted 39c6a1f9e980 optics-0.4.2.1/src/Optics.hs +formatted fbb3a44aca1a optics-0.4.2.1/tests/Optics/Tests.hs +formatted c6d811f3b338 optics-0.4.2.1/tests/Optics/Tests/Computation.hs +formatted 26a0cf8a6c0d optics-0.4.2.1/tests/Optics/Tests/Core.hs +formatted 714f321c1085 optics-0.4.2.1/tests/Optics/Tests/Eta.hs +formatted 1fbb1734b1b2 optics-0.4.2.1/tests/Optics/Tests/Labels/Generic.hs +formatted 0d08d0986a64 optics-0.4.2.1/tests/Optics/Tests/Labels/TH.hs +formatted 1ec08bb9f22e optics-0.4.2.1/tests/Optics/Tests/Misc.hs +formatted 9a4b74c6e2a0 optics-0.4.2.1/tests/Optics/Tests/Properties.hs +declined - optics-0.4.2.1/tests/Optics/Tests/Utils.hs +formatted e865ae48f11b optparse-applicative-0.19.0.0/Setup.hs +formatted 64905439cdc6 optparse-applicative-0.19.0.0/src/Options/Applicative.hs +formatted c906682e4329 optparse-applicative-0.19.0.0/src/Options/Applicative/Arrows.hs +formatted fa5bdd86f120 optparse-applicative-0.19.0.0/src/Options/Applicative/BashCompletion.hs +formatted fdefdf302889 optparse-applicative-0.19.0.0/src/Options/Applicative/Builder.hs +formatted b35877965cca optparse-applicative-0.19.0.0/src/Options/Applicative/Builder/Completer.hs +formatted 86de039c8195 optparse-applicative-0.19.0.0/src/Options/Applicative/Builder/Internal.hs +formatted 2677a4207b59 optparse-applicative-0.19.0.0/src/Options/Applicative/Common.hs +formatted e2a26a2c39e5 optparse-applicative-0.19.0.0/src/Options/Applicative/Extra.hs +formatted 02404b06b751 optparse-applicative-0.19.0.0/src/Options/Applicative/Help.hs +formatted 309f18523f28 optparse-applicative-0.19.0.0/src/Options/Applicative/Help/Chunk.hs +formatted 71aeb73c7d0a optparse-applicative-0.19.0.0/src/Options/Applicative/Help/Core.hs +formatted c6289fc77a0b optparse-applicative-0.19.0.0/src/Options/Applicative/Help/Levenshtein.hs +formatted dbad440603b5 optparse-applicative-0.19.0.0/src/Options/Applicative/Help/Pretty.hs +formatted ea64d277c8d8 optparse-applicative-0.19.0.0/src/Options/Applicative/Help/Types.hs +formatted 5f19dd3bfbfc optparse-applicative-0.19.0.0/src/Options/Applicative/Internal.hs +formatted cfaae94bf094 optparse-applicative-0.19.0.0/src/Options/Applicative/NonEmpty.hs +formatted 0375c798d3bc optparse-applicative-0.19.0.0/src/Options/Applicative/Types.hs +formatted 88e47dac52ad optparse-applicative-0.19.0.0/tests/Examples/Alternatives.hs +formatted 9cdd4cffe98a optparse-applicative-0.19.0.0/tests/Examples/Cabal.hs +formatted 6eb87c31763d optparse-applicative-0.19.0.0/tests/Examples/Commands.hs +formatted 3e7e8c6885db optparse-applicative-0.19.0.0/tests/Examples/Formatting.hs +formatted 63619af33822 optparse-applicative-0.19.0.0/tests/Examples/Hello.hs +formatted 515fef001627 optparse-applicative-0.19.0.0/tests/Examples/LongSub.hs +formatted c2e700c8f642 optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/AllGrouped.hs +formatted f5ab674c163c optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/Basic.hs +formatted dbff3ca47a7d optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/CommandGroups.hs +formatted 87c22c856d69 optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/DuplicateCommandGroups.hs +formatted ded6a73332cc optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/Duplicates.hs +formatted 8ea0fc79c8f6 optparse-applicative-0.19.0.0/tests/Examples/ParserGroup/Nested.hs +formatted 25bcbf4b701f optparse-applicative-0.19.0.0/tests/test.hs +formatted 037d20016ff3 pandoc-3.10.2/benchmark/benchmark-pandoc.hs +formatted e9cc6bbe8397 pandoc-3.10.2/src/Text/Pandoc.hs +formatted 45884709d219 pandoc-3.10.2/src/Text/Pandoc/App.hs +formatted 2a51cd540ed5 pandoc-3.10.2/src/Text/Pandoc/App/CommandLineOptions.hs +formatted 5c6f2514f305 pandoc-3.10.2/src/Text/Pandoc/App/Input.hs +formatted 87ef6eb61ae6 pandoc-3.10.2/src/Text/Pandoc/App/Opt.hs +formatted 3a8ec3e92f62 pandoc-3.10.2/src/Text/Pandoc/App/OutputSettings.hs +formatted 30536e2da049 pandoc-3.10.2/src/Text/Pandoc/Asciify.hs +formatted 0798d787f37f pandoc-3.10.2/src/Text/Pandoc/CSS.hs +formatted eb9916b55f28 pandoc-3.10.2/src/Text/Pandoc/CSV.hs +formatted 425285a86e63 pandoc-3.10.2/src/Text/Pandoc/Char.hs +formatted 16a677692492 pandoc-3.10.2/src/Text/Pandoc/Chunks.hs +formatted dd27f0bb68e4 pandoc-3.10.2/src/Text/Pandoc/Citeproc.hs +formatted 73b49670ac75 pandoc-3.10.2/src/Text/Pandoc/Citeproc/BibTeX.hs +formatted f4a7c604316e pandoc-3.10.2/src/Text/Pandoc/Citeproc/CslJson.hs +formatted a47804651b9d pandoc-3.10.2/src/Text/Pandoc/Citeproc/Data.hs +formatted 53e47a128316 pandoc-3.10.2/src/Text/Pandoc/Citeproc/Locator.hs +formatted f41105d87bc7 pandoc-3.10.2/src/Text/Pandoc/Citeproc/MetaValue.hs +formatted a318c7f44fea pandoc-3.10.2/src/Text/Pandoc/Citeproc/Name.hs +formatted 76559347a97c pandoc-3.10.2/src/Text/Pandoc/Citeproc/Util.hs +formatted 1b13d0dc5e1b pandoc-3.10.2/src/Text/Pandoc/Class.hs +formatted 121629e38e36 pandoc-3.10.2/src/Text/Pandoc/Class/CommonState.hs +formatted 27b0d8ea4952 pandoc-3.10.2/src/Text/Pandoc/Class/IO.hs +formatted 554e3fd3f722 pandoc-3.10.2/src/Text/Pandoc/Class/PandocIO.hs +formatted f986b2d26417 pandoc-3.10.2/src/Text/Pandoc/Class/PandocMonad.hs +formatted 7ef781658145 pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs +formatted 6704a4c38841 pandoc-3.10.2/src/Text/Pandoc/Class/Sandbox.hs +formatted 407b6ea8dcf3 pandoc-3.10.2/src/Text/Pandoc/Data.hs +formatted a40ce7ee511d pandoc-3.10.2/src/Text/Pandoc/Data/BakedIn.hs +formatted 58434b0c4602 pandoc-3.10.2/src/Text/Pandoc/Emoji.hs +formatted b6a210497f11 pandoc-3.10.2/src/Text/Pandoc/Error.hs +formatted 72ff19ca80f5 pandoc-3.10.2/src/Text/Pandoc/Extensions.hs +formatted 3bdc8aed022b pandoc-3.10.2/src/Text/Pandoc/Filter.hs +formatted 1be979d2afbf pandoc-3.10.2/src/Text/Pandoc/Filter/Environment.hs +formatted 3921a2426b07 pandoc-3.10.2/src/Text/Pandoc/Filter/JSON.hs +formatted 47f670c3a0ba pandoc-3.10.2/src/Text/Pandoc/Format.hs +formatted 3df0ace70613 pandoc-3.10.2/src/Text/Pandoc/Highlighting.hs +formatted 834edab63758 pandoc-3.10.2/src/Text/Pandoc/Image.hs +formatted fd7cafba4cb8 pandoc-3.10.2/src/Text/Pandoc/ImageSize.hs +formatted 2aebfb9a4784 pandoc-3.10.2/src/Text/Pandoc/Logging.hs +formatted 198eaaad0ea2 pandoc-3.10.2/src/Text/Pandoc/MIME.hs +formatted fc58bac11b5e pandoc-3.10.2/src/Text/Pandoc/MediaBag.hs +formatted cd7ca82c574c pandoc-3.10.2/src/Text/Pandoc/Options.hs +formatted d4caa78b9b84 pandoc-3.10.2/src/Text/Pandoc/PDF.hs +formatted 1378d4b80344 pandoc-3.10.2/src/Text/Pandoc/Parsing.hs +formatted d0bfe0ebb5ca pandoc-3.10.2/src/Text/Pandoc/Parsing/Capabilities.hs +formatted 78249fa68c58 pandoc-3.10.2/src/Text/Pandoc/Parsing/Citations.hs +formatted 9be74d6c3ee8 pandoc-3.10.2/src/Text/Pandoc/Parsing/Future.hs +formatted 854dc9763274 pandoc-3.10.2/src/Text/Pandoc/Parsing/General.hs +formatted ebf243a003b2 pandoc-3.10.2/src/Text/Pandoc/Parsing/GridTable.hs +formatted 6ae9fc28f92d pandoc-3.10.2/src/Text/Pandoc/Parsing/Lists.hs +formatted 957cafdf0f36 pandoc-3.10.2/src/Text/Pandoc/Parsing/Math.hs +formatted fad3834b08e5 pandoc-3.10.2/src/Text/Pandoc/Parsing/Smart.hs +formatted 3a6f9d5669d3 pandoc-3.10.2/src/Text/Pandoc/Parsing/State.hs +formatted a83effd57b53 pandoc-3.10.2/src/Text/Pandoc/Process.hs +formatted 5798ce9f1d3b pandoc-3.10.2/src/Text/Pandoc/Readers.hs +formatted b0383bb6bbf3 pandoc-3.10.2/src/Text/Pandoc/Readers/AsciiDoc.hs +formatted fb9989e02f4c pandoc-3.10.2/src/Text/Pandoc/Readers/BibTeX.hs +formatted 6df32968e0c9 pandoc-3.10.2/src/Text/Pandoc/Readers/CSV.hs +formatted 9daab54008b1 pandoc-3.10.2/src/Text/Pandoc/Readers/CommonMark.hs +formatted a342a5d39536 pandoc-3.10.2/src/Text/Pandoc/Readers/Creole.hs +formatted 9a91a657b202 pandoc-3.10.2/src/Text/Pandoc/Readers/CslJson.hs +formatted 8f06acca3961 pandoc-3.10.2/src/Text/Pandoc/Readers/Djot.hs +formatted 1d2ab70b7b4f pandoc-3.10.2/src/Text/Pandoc/Readers/DocBook.hs +formatted cf58716fb7b3 pandoc-3.10.2/src/Text/Pandoc/Readers/Docx.hs +formatted fc9009e1ca7b pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Combine.hs +formatted 2d1f14f169d4 pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Fields.hs +formatted 93c7c8635e18 pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Lists.hs +formatted bc3c2892099c pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Parse.hs +formatted cdafbece822b pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Parse/Styles.hs +formatted 59a529967b45 pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Symbols.hs +formatted bc3f39ebba02 pandoc-3.10.2/src/Text/Pandoc/Readers/Docx/Util.hs +formatted 40fc6fdc95bf pandoc-3.10.2/src/Text/Pandoc/Readers/DokuWiki.hs +formatted e7e64c311852 pandoc-3.10.2/src/Text/Pandoc/Readers/EPUB.hs +formatted f3a6089222df pandoc-3.10.2/src/Text/Pandoc/Readers/EndNote.hs +formatted 7db3a804d654 pandoc-3.10.2/src/Text/Pandoc/Readers/FB2.hs +formatted 4383de7c2335 pandoc-3.10.2/src/Text/Pandoc/Readers/HTML.hs +formatted dffd88697abd pandoc-3.10.2/src/Text/Pandoc/Readers/HTML/Parsing.hs +formatted 7906dc4b5ee7 pandoc-3.10.2/src/Text/Pandoc/Readers/HTML/Table.hs +formatted d02eee6a5e0a pandoc-3.10.2/src/Text/Pandoc/Readers/HTML/TagCategories.hs +formatted 70831845aec7 pandoc-3.10.2/src/Text/Pandoc/Readers/HTML/Types.hs +formatted eff46e987f16 pandoc-3.10.2/src/Text/Pandoc/Readers/Haddock.hs +formatted e0709d478a16 pandoc-3.10.2/src/Text/Pandoc/Readers/Ipynb.hs +formatted 3f4f03f7cb25 pandoc-3.10.2/src/Text/Pandoc/Readers/JATS.hs +formatted c7b531b762cd pandoc-3.10.2/src/Text/Pandoc/Readers/Jira.hs +formatted 6ef7e7e8a336 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX.hs +formatted 43d3ff6389de pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Citation.hs +formatted 42ef4f6efe29 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Inline.hs +formatted c4741ac43b79 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Lang.hs +formatted 7da4b015aff1 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Macro.hs +formatted 99583e0adb7e pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Math.hs +formatted a4f0a47266af pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Parsing.hs +formatted c5052708c057 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/SIunitx.hs +formatted 6cfc2c0c5f07 pandoc-3.10.2/src/Text/Pandoc/Readers/LaTeX/Table.hs +formatted 6b532f75206a pandoc-3.10.2/src/Text/Pandoc/Readers/Man.hs +formatted a4a565478d90 pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs +formatted a22f7f9ddf30 pandoc-3.10.2/src/Text/Pandoc/Readers/Mdoc.hs +formatted d33fca4fc582 pandoc-3.10.2/src/Text/Pandoc/Readers/Mdoc/Lex.hs +formatted 728f79b431ec pandoc-3.10.2/src/Text/Pandoc/Readers/Mdoc/Macros.hs +formatted 1a3b54c227b9 pandoc-3.10.2/src/Text/Pandoc/Readers/Mdoc/Standards.hs +formatted 930a7a29e8cd pandoc-3.10.2/src/Text/Pandoc/Readers/MediaWiki.hs +formatted 3a3c4b5afb54 pandoc-3.10.2/src/Text/Pandoc/Readers/Metadata.hs +formatted fa0c9ab8ddff pandoc-3.10.2/src/Text/Pandoc/Readers/Muse.hs +formatted b5fdcc7976c0 pandoc-3.10.2/src/Text/Pandoc/Readers/Native.hs +formatted 00dc84441dee pandoc-3.10.2/src/Text/Pandoc/Readers/ODT.hs +formatted 4b763e5899cb pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Arrows/State.hs +formatted 978b213b2283 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Arrows/Utils.hs +formatted bf610e3c1650 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Base.hs +formatted 824410efced3 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/ContentReader.hs +formatted c708199aa2c5 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Generic/Fallible.hs +formatted 3cb13f8a11b2 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Generic/Namespaces.hs +formatted 6d9540eaec43 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Generic/SetMap.hs +formatted e530287347dc pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Generic/Utils.hs +formatted b9912baa7f2d pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Generic/XMLConverter.hs +formatted 32a05a5e6b5d pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/Namespaces.hs +formatted 0e276b72ff84 pandoc-3.10.2/src/Text/Pandoc/Readers/ODT/StyleReader.hs +formatted fc024f0c1f5f pandoc-3.10.2/src/Text/Pandoc/Readers/OOXML/Shared.hs +formatted 567609e53504 pandoc-3.10.2/src/Text/Pandoc/Readers/OPML.hs +formatted f0c2a727f84e pandoc-3.10.2/src/Text/Pandoc/Readers/Org.hs +formatted b11790cf298d pandoc-3.10.2/src/Text/Pandoc/Readers/Org/BlockStarts.hs +formatted 5af99478081e pandoc-3.10.2/src/Text/Pandoc/Readers/Org/Blocks.hs +formatted 43bd91b13dca pandoc-3.10.2/src/Text/Pandoc/Readers/Org/DocumentTree.hs +formatted 845ce0261537 pandoc-3.10.2/src/Text/Pandoc/Readers/Org/ExportSettings.hs +formatted f91afc951ab9 pandoc-3.10.2/src/Text/Pandoc/Readers/Org/Inlines.hs +formatted 161b1ccc8ff6 pandoc-3.10.2/src/Text/Pandoc/Readers/Org/Meta.hs +formatted 721a0cf8a327 pandoc-3.10.2/src/Text/Pandoc/Readers/Org/ParserState.hs +formatted c16136fb606c pandoc-3.10.2/src/Text/Pandoc/Readers/Org/Parsing.hs +formatted 56b3882f7c5f pandoc-3.10.2/src/Text/Pandoc/Readers/Org/Shared.hs +formatted dc3e8e78c3f0 pandoc-3.10.2/src/Text/Pandoc/Readers/Pod.hs +formatted 53643fbdc8d6 pandoc-3.10.2/src/Text/Pandoc/Readers/Pptx.hs +formatted 9f0a1be15c9c pandoc-3.10.2/src/Text/Pandoc/Readers/Pptx/Parse.hs +formatted 06b32e0a02bb pandoc-3.10.2/src/Text/Pandoc/Readers/Pptx/Shapes.hs +formatted 68136f2cd896 pandoc-3.10.2/src/Text/Pandoc/Readers/Pptx/Slides.hs +formatted 2a1143e52057 pandoc-3.10.2/src/Text/Pandoc/Readers/Pptx/SmartArt.hs +formatted 546eac2a8514 pandoc-3.10.2/src/Text/Pandoc/Readers/RIS.hs +formatted 04715a4be3c2 pandoc-3.10.2/src/Text/Pandoc/Readers/RST.hs +formatted 0ee83c7814cd pandoc-3.10.2/src/Text/Pandoc/Readers/RTF.hs +formatted 955d2e3df5d4 pandoc-3.10.2/src/Text/Pandoc/Readers/Roff.hs +formatted a8d91c97594d pandoc-3.10.2/src/Text/Pandoc/Readers/Roff/Escape.hs +formatted 38145b00e92b pandoc-3.10.2/src/Text/Pandoc/Readers/TWiki.hs +formatted a6cf06abeac2 pandoc-3.10.2/src/Text/Pandoc/Readers/Textile.hs +formatted 64ebaf0c8d6d pandoc-3.10.2/src/Text/Pandoc/Readers/TikiWiki.hs +formatted 00edc33e277f pandoc-3.10.2/src/Text/Pandoc/Readers/Txt2Tags.hs +formatted 9dbc78144769 pandoc-3.10.2/src/Text/Pandoc/Readers/Typst.hs +formatted 2f111f50b7d1 pandoc-3.10.2/src/Text/Pandoc/Readers/Typst/Math.hs +formatted 45263032cedf pandoc-3.10.2/src/Text/Pandoc/Readers/Typst/Parsing.hs +formatted b3509cf614af pandoc-3.10.2/src/Text/Pandoc/Readers/Vimwiki.hs +formatted 5b0aec20be18 pandoc-3.10.2/src/Text/Pandoc/Readers/XML.hs +formatted 6da1519e9667 pandoc-3.10.2/src/Text/Pandoc/Readers/Xlsx.hs +formatted 835a84d727ab pandoc-3.10.2/src/Text/Pandoc/Readers/Xlsx/Cells.hs +formatted da7c96257b3c pandoc-3.10.2/src/Text/Pandoc/Readers/Xlsx/Parse.hs +formatted cec0a64a8f3d pandoc-3.10.2/src/Text/Pandoc/Readers/Xlsx/Sheets.hs +formatted a3abe5c4303a pandoc-3.10.2/src/Text/Pandoc/RoffChar.hs +formatted 3b2c2c8b4a58 pandoc-3.10.2/src/Text/Pandoc/Scripting.hs +formatted 9a1066febe5c pandoc-3.10.2/src/Text/Pandoc/SelfContained.hs +formatted 31da664c4c88 pandoc-3.10.2/src/Text/Pandoc/Shared.hs +formatted 172e62890a2c pandoc-3.10.2/src/Text/Pandoc/Slides.hs +formatted fac36a909e04 pandoc-3.10.2/src/Text/Pandoc/Sources.hs +formatted 4723b914e051 pandoc-3.10.2/src/Text/Pandoc/TeX.hs +formatted b778b3bd0b9d pandoc-3.10.2/src/Text/Pandoc/Templates.hs +formatted e7f689faf2da pandoc-3.10.2/src/Text/Pandoc/Transforms.hs +formatted fbd643d9a8d0 pandoc-3.10.2/src/Text/Pandoc/Translations.hs +formatted de44be6d90ad pandoc-3.10.2/src/Text/Pandoc/Translations/Types.hs +formatted e8b9d88b67b0 pandoc-3.10.2/src/Text/Pandoc/URI.hs +formatted 4aa82cbc83c8 pandoc-3.10.2/src/Text/Pandoc/UTF8.hs +formatted e958a4d78635 pandoc-3.10.2/src/Text/Pandoc/UUID.hs +formatted c4b212f4e18f pandoc-3.10.2/src/Text/Pandoc/Version.hs +formatted 64127df72dfc pandoc-3.10.2/src/Text/Pandoc/Writers.hs +formatted eb7cc09ed150 pandoc-3.10.2/src/Text/Pandoc/Writers/ANSI.hs +formatted a5a598c6ebd6 pandoc-3.10.2/src/Text/Pandoc/Writers/AnnotatedTable.hs +formatted a752406eebfa pandoc-3.10.2/src/Text/Pandoc/Writers/AsciiDoc.hs +formatted 9f7f40cd3260 pandoc-3.10.2/src/Text/Pandoc/Writers/BBCode.hs +formatted 74bebaa57c03 pandoc-3.10.2/src/Text/Pandoc/Writers/BibTeX.hs +formatted c3a3e99a6a7b pandoc-3.10.2/src/Text/Pandoc/Writers/Blaze.hs +formatted 2afa2a035da6 pandoc-3.10.2/src/Text/Pandoc/Writers/ChunkedHTML.hs +formatted 936b3d7e333a pandoc-3.10.2/src/Text/Pandoc/Writers/CommonMark.hs +formatted 5380c20c8b47 pandoc-3.10.2/src/Text/Pandoc/Writers/ConTeXt.hs +formatted d9b0707d098c pandoc-3.10.2/src/Text/Pandoc/Writers/CslJson.hs +formatted 22ad2f699b3c pandoc-3.10.2/src/Text/Pandoc/Writers/Djot.hs +formatted 45e80a32da2f pandoc-3.10.2/src/Text/Pandoc/Writers/DocBook.hs +formatted f9b453669273 pandoc-3.10.2/src/Text/Pandoc/Writers/Docx.hs +formatted 178a9f4e8f5b pandoc-3.10.2/src/Text/Pandoc/Writers/Docx/OpenXML.hs +formatted 3c521e018180 pandoc-3.10.2/src/Text/Pandoc/Writers/Docx/StyleMap.hs +formatted e75d942f93e2 pandoc-3.10.2/src/Text/Pandoc/Writers/Docx/Table.hs +formatted c18d8fc12f6b pandoc-3.10.2/src/Text/Pandoc/Writers/Docx/Types.hs +formatted 1a9e5464ba71 pandoc-3.10.2/src/Text/Pandoc/Writers/DokuWiki.hs +formatted e2c1380dcce6 pandoc-3.10.2/src/Text/Pandoc/Writers/EPUB.hs +formatted 77cb32a02d14 pandoc-3.10.2/src/Text/Pandoc/Writers/FB2.hs +formatted c4b4f9d5a6e4 pandoc-3.10.2/src/Text/Pandoc/Writers/GridTable.hs +formatted 8049d235acfb pandoc-3.10.2/src/Text/Pandoc/Writers/HTML.hs +formatted 41b62b0da79a pandoc-3.10.2/src/Text/Pandoc/Writers/Haddock.hs +formatted b546180b4522 pandoc-3.10.2/src/Text/Pandoc/Writers/ICML.hs +formatted 66a1ea7e86c8 pandoc-3.10.2/src/Text/Pandoc/Writers/Ipynb.hs +formatted 94c2c79c2e7d pandoc-3.10.2/src/Text/Pandoc/Writers/JATS.hs +formatted 4a683f5d9700 pandoc-3.10.2/src/Text/Pandoc/Writers/JATS/References.hs +formatted 1141a590a5a6 pandoc-3.10.2/src/Text/Pandoc/Writers/JATS/Table.hs +formatted 3aae3967440a pandoc-3.10.2/src/Text/Pandoc/Writers/JATS/Types.hs +formatted d4bd43fd7b4e pandoc-3.10.2/src/Text/Pandoc/Writers/Jira.hs +formatted a1b3438d0207 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX.hs +formatted f67e173fe943 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Caption.hs +formatted fc260b26dbb5 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Citation.hs +formatted e89e979a29e1 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Lang.hs +formatted 8c164dd5cc9c pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Notes.hs +formatted 0043c2edb649 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Table.hs +formatted a4eb629d0029 pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Types.hs +formatted a77d0a8b6cab pandoc-3.10.2/src/Text/Pandoc/Writers/LaTeX/Util.hs +formatted dd8b72ea1d45 pandoc-3.10.2/src/Text/Pandoc/Writers/Man.hs +formatted 0d826f85d47d pandoc-3.10.2/src/Text/Pandoc/Writers/Markdown.hs +formatted 9d6fe41d9669 pandoc-3.10.2/src/Text/Pandoc/Writers/Markdown/Inline.hs +formatted c57101b9ec66 pandoc-3.10.2/src/Text/Pandoc/Writers/Markdown/Table.hs +formatted 02c7eb593d88 pandoc-3.10.2/src/Text/Pandoc/Writers/Markdown/Types.hs +formatted 3d9d722a4e7e pandoc-3.10.2/src/Text/Pandoc/Writers/Math.hs +formatted e3e2e03bc6f6 pandoc-3.10.2/src/Text/Pandoc/Writers/MediaWiki.hs +formatted f08666425ec1 pandoc-3.10.2/src/Text/Pandoc/Writers/Ms.hs +formatted 0b3a871730b6 pandoc-3.10.2/src/Text/Pandoc/Writers/Muse.hs +formatted 4acde5355993 pandoc-3.10.2/src/Text/Pandoc/Writers/Native.hs +formatted 705d62226dba pandoc-3.10.2/src/Text/Pandoc/Writers/ODT.hs +formatted 0bd4c0281dd2 pandoc-3.10.2/src/Text/Pandoc/Writers/OOXML.hs +formatted 0a04485cd0b6 pandoc-3.10.2/src/Text/Pandoc/Writers/OPML.hs +formatted 38c7390489d7 pandoc-3.10.2/src/Text/Pandoc/Writers/OpenDocument.hs +formatted 461f088c8308 pandoc-3.10.2/src/Text/Pandoc/Writers/Org.hs +formatted 74e7486aeef1 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint.hs +formatted 0ee7de5d58d9 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs +formatted a991cb709520 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +formatted 9da06ad78575 pandoc-3.10.2/src/Text/Pandoc/Writers/RST.hs +formatted 76c4e973a30e pandoc-3.10.2/src/Text/Pandoc/Writers/RTF.hs +formatted d94d420d102a pandoc-3.10.2/src/Text/Pandoc/Writers/Roff.hs +formatted 170dad242971 pandoc-3.10.2/src/Text/Pandoc/Writers/Shared.hs +formatted 966f9f568486 pandoc-3.10.2/src/Text/Pandoc/Writers/TEI.hs +formatted da5f7182e705 pandoc-3.10.2/src/Text/Pandoc/Writers/Texinfo.hs +formatted df1a1a706a3d pandoc-3.10.2/src/Text/Pandoc/Writers/Textile.hs +formatted 9ea50cc6925a pandoc-3.10.2/src/Text/Pandoc/Writers/Txt2Tags.hs +formatted 745407966672 pandoc-3.10.2/src/Text/Pandoc/Writers/Typst.hs +formatted 9df037d0e0af pandoc-3.10.2/src/Text/Pandoc/Writers/Vimdoc.hs +formatted e34d3122403b pandoc-3.10.2/src/Text/Pandoc/Writers/XML.hs +formatted a11946cf7174 pandoc-3.10.2/src/Text/Pandoc/Writers/XWiki.hs +formatted 1ee6529c659c pandoc-3.10.2/src/Text/Pandoc/Writers/ZimWiki.hs +formatted c0bf42044a17 pandoc-3.10.2/src/Text/Pandoc/XML.hs +formatted 29da3381e068 pandoc-3.10.2/src/Text/Pandoc/XMLFormat.hs +formatted 9533e4f4b6c4 pandoc-3.10.2/test/Tests/Command.hs +formatted 44e0d3fa8621 pandoc-3.10.2/test/Tests/Helpers.hs +formatted 08a6d3f3d84f pandoc-3.10.2/test/Tests/MediaBag.hs +formatted 58f15e3f067a pandoc-3.10.2/test/Tests/Old.hs +formatted 7b96b4d20921 pandoc-3.10.2/test/Tests/Readers/Creole.hs +formatted 0e634958fc8c pandoc-3.10.2/test/Tests/Readers/Docx.hs +formatted dc0961425873 pandoc-3.10.2/test/Tests/Readers/DokuWiki.hs +formatted 150d1390d716 pandoc-3.10.2/test/Tests/Readers/EPUB.hs +formatted b786e572a74c pandoc-3.10.2/test/Tests/Readers/FB2.hs +formatted fa79877906a8 pandoc-3.10.2/test/Tests/Readers/HTML.hs +formatted a047fe6e2033 pandoc-3.10.2/test/Tests/Readers/JATS.hs +formatted 3ee2ef6dea11 pandoc-3.10.2/test/Tests/Readers/Jira.hs +formatted e617bc68c809 pandoc-3.10.2/test/Tests/Readers/LaTeX.hs +formatted 54c9a9360dac pandoc-3.10.2/test/Tests/Readers/Man.hs +formatted 67e0bd9ae4b8 pandoc-3.10.2/test/Tests/Readers/Markdown.hs +formatted 7aec4f85c064 pandoc-3.10.2/test/Tests/Readers/Mdoc.hs +formatted 96cc9670fdfb pandoc-3.10.2/test/Tests/Readers/Muse.hs +formatted 6d5ec7415c5d pandoc-3.10.2/test/Tests/Readers/ODT.hs +formatted 4cec297f4fab pandoc-3.10.2/test/Tests/Readers/Org.hs +formatted e5c1db2d073f pandoc-3.10.2/test/Tests/Readers/Org/Block.hs +formatted b4b9cddd5711 pandoc-3.10.2/test/Tests/Readers/Org/Block/CodeBlock.hs +formatted 8bfbfbb823bf pandoc-3.10.2/test/Tests/Readers/Org/Block/Figure.hs +formatted 1db2ce6020c8 pandoc-3.10.2/test/Tests/Readers/Org/Block/Header.hs +formatted ac82b8a4a7bf pandoc-3.10.2/test/Tests/Readers/Org/Block/List.hs +formatted 3e9d7a83d060 pandoc-3.10.2/test/Tests/Readers/Org/Block/Table.hs +formatted 5f3808eb1a55 pandoc-3.10.2/test/Tests/Readers/Org/Directive.hs +formatted bfd915a68797 pandoc-3.10.2/test/Tests/Readers/Org/Inline.hs +formatted c762e1d74166 pandoc-3.10.2/test/Tests/Readers/Org/Inline/Citation.hs +formatted b2fb48f770ee pandoc-3.10.2/test/Tests/Readers/Org/Inline/Note.hs +formatted 1ab451370fda pandoc-3.10.2/test/Tests/Readers/Org/Inline/Smart.hs +formatted 06c0169c3199 pandoc-3.10.2/test/Tests/Readers/Org/Meta.hs +formatted b1b4397e99d3 pandoc-3.10.2/test/Tests/Readers/Org/Shared.hs +formatted 1eb1a05f4635 pandoc-3.10.2/test/Tests/Readers/Pod.hs +formatted 7f0ab3cbdf98 pandoc-3.10.2/test/Tests/Readers/Pptx.hs +formatted 3b5a69d54626 pandoc-3.10.2/test/Tests/Readers/RST.hs +formatted 525c19538ad3 pandoc-3.10.2/test/Tests/Readers/RTF.hs +formatted aca713b17e29 pandoc-3.10.2/test/Tests/Readers/Txt2Tags.hs +formatted 15bd1659725f pandoc-3.10.2/test/Tests/Readers/Xlsx.hs +formatted 2692dc26ee41 pandoc-3.10.2/test/Tests/Shared.hs +formatted ad523df96992 pandoc-3.10.2/test/Tests/Writers/AnnotatedTable.hs +formatted b21e7e06def4 pandoc-3.10.2/test/Tests/Writers/AsciiDoc.hs +formatted 70088c61a9f3 pandoc-3.10.2/test/Tests/Writers/BBCode.hs +formatted 98cca991f01d pandoc-3.10.2/test/Tests/Writers/ConTeXt.hs +formatted 59de8eac5d46 pandoc-3.10.2/test/Tests/Writers/DocBook.hs +formatted 648f15c3487d pandoc-3.10.2/test/Tests/Writers/Docx.hs +formatted c93a204195d1 pandoc-3.10.2/test/Tests/Writers/FB2.hs +formatted 8485eb418c1f pandoc-3.10.2/test/Tests/Writers/HTML.hs +formatted 864ccac4606e pandoc-3.10.2/test/Tests/Writers/JATS.hs +formatted f691886863f7 pandoc-3.10.2/test/Tests/Writers/Jira.hs +formatted 2c7232780cd3 pandoc-3.10.2/test/Tests/Writers/LaTeX.hs +formatted 0d9dc37df4e1 pandoc-3.10.2/test/Tests/Writers/Markdown.hs +formatted c8345b0f787e pandoc-3.10.2/test/Tests/Writers/Markua.hs +formatted fb4d32e30070 pandoc-3.10.2/test/Tests/Writers/Ms.hs +formatted 53258d5a9e50 pandoc-3.10.2/test/Tests/Writers/Muse.hs +formatted f2f1ca1b8764 pandoc-3.10.2/test/Tests/Writers/Native.hs +formatted 16780a5a789f pandoc-3.10.2/test/Tests/Writers/OOXML.hs +formatted 3033600cbe42 pandoc-3.10.2/test/Tests/Writers/Org.hs +formatted 0e4b414e2dea pandoc-3.10.2/test/Tests/Writers/Plain.hs +formatted e496fc51153d pandoc-3.10.2/test/Tests/Writers/Powerpoint.hs +formatted 9d6e4a5505a1 pandoc-3.10.2/test/Tests/Writers/RST.hs +formatted 7f7f9e6de407 pandoc-3.10.2/test/Tests/Writers/TEI.hs +formatted 9286c785c97e pandoc-3.10.2/test/Tests/Writers/Txt2Tags.hs +formatted ad01bdc72c8e pandoc-3.10.2/test/Tests/XML.hs +formatted 16057c777a9d pandoc-3.10.2/test/command/3510-src.hs +formatted 3f023b0abbe3 pandoc-3.10.2/test/command/6466-beg.hs +formatted 06289f98fcac pandoc-3.10.2/test/command/6466-end.hs +formatted 546301610b9b pandoc-3.10.2/test/command/6466-mid.hs +formatted b6f515e00962 pandoc-3.10.2/test/command/6466-whole.hs +formatted 53aaf2e2c6e0 pandoc-3.10.2/test/test-pandoc.hs +formatted 2556d5cb9f72 pandoc-3.10.2/xml-light/Text/Pandoc/XML/Light.hs +formatted d13fc87f4907 pandoc-3.10.2/xml-light/Text/Pandoc/XML/Light/Output.hs +formatted 3f7a60f285f2 pandoc-3.10.2/xml-light/Text/Pandoc/XML/Light/Proc.hs +formatted 11f398c0d479 pandoc-3.10.2/xml-light/Text/Pandoc/XML/Light/Types.hs +formatted e865ae48f11b pandoc-types-1.23.1.2/Setup.hs +formatted 8376040e03f4 pandoc-types-1.23.1.2/benchmark/bench.hs +formatted 8e6368ed5c21 pandoc-types-1.23.1.2/src/Text/Pandoc/Arbitrary.hs +formatted 23cfca937427 pandoc-types-1.23.1.2/src/Text/Pandoc/Builder.hs +formatted 041d27bf9170 pandoc-types-1.23.1.2/src/Text/Pandoc/Definition.hs +formatted 42a13347f367 pandoc-types-1.23.1.2/src/Text/Pandoc/Generic.hs +formatted 8fad29f2adc4 pandoc-types-1.23.1.2/src/Text/Pandoc/JSON.hs +formatted 3e061e7b176e pandoc-types-1.23.1.2/src/Text/Pandoc/Walk.hs +formatted dcf10d45e788 pandoc-types-1.23.1.2/test/Data/String/QQ.hs +formatted 25a6ff086c83 pandoc-types-1.23.1.2/test/test-pandoc-types.hs +formatted 7474b7e1d4f5 parsec3-1.0.1.8/Setup.hs +formatted 48d72ad7fc59 parsec3-1.0.1.8/Text/Parsec.hs +formatted afc3d5a902fe parsec3-1.0.1.8/Text/Parsec/ByteString.hs +formatted a9c7a6dd5b30 parsec3-1.0.1.8/Text/Parsec/ByteString/Lazy.hs +formatted 5e6bdea20cf6 parsec3-1.0.1.8/Text/Parsec/Char.hs +formatted 4abab8f9ceb8 parsec3-1.0.1.8/Text/Parsec/Combinator.hs +formatted 94a0c2798c5a parsec3-1.0.1.8/Text/Parsec/Error.hs +formatted 048c32e5a768 parsec3-1.0.1.8/Text/Parsec/Expr.hs +formatted 156014d6ed26 parsec3-1.0.1.8/Text/Parsec/Language.hs +formatted 40bf4d018d51 parsec3-1.0.1.8/Text/Parsec/Perm.hs +formatted c50efff79fe5 parsec3-1.0.1.8/Text/Parsec/Pos.hs +formatted 1d4feb99b3e8 parsec3-1.0.1.8/Text/Parsec/Prim.hs +formatted c911dc63e8d5 parsec3-1.0.1.8/Text/Parsec/String.hs +formatted 72422924874a parsec3-1.0.1.8/Text/Parsec/Text.hs +formatted 6fd69590f1d3 parsec3-1.0.1.8/Text/Parsec/Text/Lazy.hs +formatted b6e8b0e16d14 parsec3-1.0.1.8/Text/Parsec/Token.hs +formatted 22b02f116512 parser-combinators-1.3.1/Control/Applicative/Combinators.hs +formatted 2b483a550d21 parser-combinators-1.3.1/Control/Applicative/Combinators/NonEmpty.hs +formatted 7d01c0dddfcd parser-combinators-1.3.1/Control/Applicative/Permutations.hs +formatted 80eb76464ce8 parser-combinators-1.3.1/Control/Monad/Combinators.hs +formatted 203c01d41bb8 parser-combinators-1.3.1/Control/Monad/Combinators/Expr.hs +formatted f63c3b21684d parser-combinators-1.3.1/Control/Monad/Combinators/NonEmpty.hs +formatted 2ce12720b575 parser-combinators-1.3.1/Control/Monad/Permutations.hs +formatted 4c7a2ed66fb7 persistent-2.18.1.0/Database/Persist.hs +formatted af7417196697 persistent-2.18.1.0/Database/Persist/Class.hs +formatted a62cb576f4b1 persistent-2.18.1.0/Database/Persist/Class/PersistConfig.hs +formatted 56f625ad1ea2 persistent-2.18.1.0/Database/Persist/Class/PersistEntity.hs +formatted 63c55d24c1a6 persistent-2.18.1.0/Database/Persist/Class/PersistField.hs +formatted 4229d83e727f persistent-2.18.1.0/Database/Persist/Class/PersistQuery.hs +formatted 194836df1fd0 persistent-2.18.1.0/Database/Persist/Class/PersistStore.hs +formatted c7df1c76c273 persistent-2.18.1.0/Database/Persist/Class/PersistUnique.hs +formatted 8411f5f4d556 persistent-2.18.1.0/Database/Persist/Compatible.hs +formatted 40afca283a80 persistent-2.18.1.0/Database/Persist/Compatible/TH.hs +formatted f77b6e49e3d3 persistent-2.18.1.0/Database/Persist/Compatible/Types.hs +formatted 4da910742f5d persistent-2.18.1.0/Database/Persist/EntityDef.hs +formatted 849d0a429195 persistent-2.18.1.0/Database/Persist/EntityDef/Internal.hs +formatted 8b9538a7e637 persistent-2.18.1.0/Database/Persist/FieldDef.hs +formatted ab8743cef9ef persistent-2.18.1.0/Database/Persist/FieldDef/Internal.hs +formatted 62ee350971e4 persistent-2.18.1.0/Database/Persist/ImplicitIdDef.hs +formatted 9051746eba78 persistent-2.18.1.0/Database/Persist/ImplicitIdDef/Internal.hs +formatted 4002aeb84669 persistent-2.18.1.0/Database/Persist/Names.hs +formatted 67c816fd5b28 persistent-2.18.1.0/Database/Persist/PersistValue.hs +formatted 3b8981721873 persistent-2.18.1.0/Database/Persist/Quasi.hs +formatted bf1548cc69c8 persistent-2.18.1.0/Database/Persist/Quasi/Internal.hs +formatted cabfd6b48df2 persistent-2.18.1.0/Database/Persist/Quasi/Internal/ModelParser.hs +formatted 7c334061474c persistent-2.18.1.0/Database/Persist/Quasi/Internal/TypeParser.hs +formatted 21110acf54fd persistent-2.18.1.0/Database/Persist/Quasi/PersistSettings.hs +formatted a65ab8f1929f persistent-2.18.1.0/Database/Persist/Quasi/PersistSettings/Internal.hs +formatted a2208d509db2 persistent-2.18.1.0/Database/Persist/Sql.hs +formatted 5eb8c1f034c5 persistent-2.18.1.0/Database/Persist/Sql/Class.hs +formatted ccfe7e6d9996 persistent-2.18.1.0/Database/Persist/Sql/Internal.hs +formatted 8961bf4b32ff persistent-2.18.1.0/Database/Persist/Sql/Migration.hs +formatted 7e371de867be persistent-2.18.1.0/Database/Persist/Sql/Orphan/PersistQuery.hs +formatted e01289d09a16 persistent-2.18.1.0/Database/Persist/Sql/Orphan/PersistStore.hs +formatted 423a6f1ddcbf persistent-2.18.1.0/Database/Persist/Sql/Orphan/PersistUnique.hs +formatted 4da2e4b129cc persistent-2.18.1.0/Database/Persist/Sql/Raw.hs +formatted 9376d473879f persistent-2.18.1.0/Database/Persist/Sql/Run.hs +formatted e899729d586e persistent-2.18.1.0/Database/Persist/Sql/Types.hs +formatted 39dcf72b8d4a persistent-2.18.1.0/Database/Persist/Sql/Types/Internal.hs +formatted b8d70cb7744c persistent-2.18.1.0/Database/Persist/Sql/Util.hs +formatted 9535b7d9a001 persistent-2.18.1.0/Database/Persist/SqlBackend.hs +formatted e5f2ff2dc144 persistent-2.18.1.0/Database/Persist/SqlBackend/Internal.hs +formatted 47acc3733907 persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/InsertSqlResult.hs +formatted 4bd5d30fe421 persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/IsolationLevel.hs +formatted c8a378801422 persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/MkSqlBackend.hs +formatted 945521fad6a2 persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/SqlPoolHooks.hs +formatted 4e0a2509487b persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/Statement.hs +formatted 1710f992776b persistent-2.18.1.0/Database/Persist/SqlBackend/Internal/StatementCache.hs +formatted 4304cc0b95bf persistent-2.18.1.0/Database/Persist/SqlBackend/SqlPoolHooks.hs +formatted 081bf168d849 persistent-2.18.1.0/Database/Persist/SqlBackend/StatementCache.hs +formatted c43972a3241b persistent-2.18.1.0/Database/Persist/TH.hs +formatted a484cb2adef0 persistent-2.18.1.0/Database/Persist/TH/Internal.hs +formatted 3eb1ab75fbdf persistent-2.18.1.0/Database/Persist/Types.hs +formatted 602702e0f86e persistent-2.18.1.0/Database/Persist/Types/Base.hs +formatted b8189bc0e07d persistent-2.18.1.0/Database/Persist/Types/SourceSpan.hs +formatted 1aec50d3544f persistent-2.18.1.0/bench/Main.hs +formatted d4e78e3f895b persistent-2.18.1.0/bench/Models.hs +formatted 1e8c8c93c976 persistent-2.18.1.0/test/Database/Persist/ClassSpec.hs +formatted 6082a8164f41 persistent-2.18.1.0/test/Database/Persist/PersistValueSpec.hs +formatted 906326245f86 persistent-2.18.1.0/test/Database/Persist/QuasiSpec.hs +formatted 8882f34c07fe persistent-2.18.1.0/test/Database/Persist/TH/CommentSpec.hs +formatted d773a41935ea persistent-2.18.1.0/test/Database/Persist/TH/CompositeKeyStyleSpec.hs +formatted f9f4014951e3 persistent-2.18.1.0/test/Database/Persist/TH/DiscoverEntitiesSpec.hs +formatted c444c6731179 persistent-2.18.1.0/test/Database/Persist/TH/EmbedSpec.hs +formatted bf23d25d4982 persistent-2.18.1.0/test/Database/Persist/TH/EntityHaddockSpec.hs +formatted 4f00a9a51fee persistent-2.18.1.0/test/Database/Persist/TH/ForeignRefSpec.hs +formatted 0c3421ff2893 persistent-2.18.1.0/test/Database/Persist/TH/ImplicitIdColSpec.hs +formatted 6d733cdba565 persistent-2.18.1.0/test/Database/Persist/TH/JsonEncodingSpec.hs +formatted 8adfe4a4228d persistent-2.18.1.0/test/Database/Persist/TH/KindEntitiesSpec.hs +formatted 5aacd109f219 persistent-2.18.1.0/test/Database/Persist/TH/KindEntitiesSpecImports.hs +formatted 95ba90d362da persistent-2.18.1.0/test/Database/Persist/TH/MaybeFieldDefsSpec.hs +formatted c4b2085e7249 persistent-2.18.1.0/test/Database/Persist/TH/MigrationOnlySpec.hs +formatted dbad9d8d922f persistent-2.18.1.0/test/Database/Persist/TH/MultiBlockSpec.hs +formatted b776165f7ac3 persistent-2.18.1.0/test/Database/Persist/TH/MultiBlockSpec/Model.hs +formatted baa7f67273ec persistent-2.18.1.0/test/Database/Persist/TH/NestedSymbolsInTypeSpec.hs +formatted f0e370f995e7 persistent-2.18.1.0/test/Database/Persist/TH/NestedSymbolsInTypeSpecImports.hs +formatted 16ab595a1cc4 persistent-2.18.1.0/test/Database/Persist/TH/NoFieldSelectorsSpec.hs +formatted e227905a242e persistent-2.18.1.0/test/Database/Persist/TH/OverloadedLabelSpec.hs +formatted ad712bcac46e persistent-2.18.1.0/test/Database/Persist/TH/PersistWith/Model.hs +formatted 8d58beb8b33c persistent-2.18.1.0/test/Database/Persist/TH/PersistWith/Model2.hs +formatted a7b8dff135f1 persistent-2.18.1.0/test/Database/Persist/TH/PersistWithSpec.hs +formatted 7b6cf72d5ecc persistent-2.18.1.0/test/Database/Persist/TH/RequireOnlyPersistImportSpec.hs +formatted 9a0756832b2d persistent-2.18.1.0/test/Database/Persist/TH/SharedPrimaryKeyImportedSpec.hs +formatted 885e1164f19c persistent-2.18.1.0/test/Database/Persist/TH/SharedPrimaryKeySpec.hs +formatted 145463b36f4d persistent-2.18.1.0/test/Database/Persist/TH/SumSpec.hs +formatted e6bfe40fd881 persistent-2.18.1.0/test/Database/Persist/TH/ToFromPersistValuesSpec.hs +formatted a18bfc6474db persistent-2.18.1.0/test/Database/Persist/TH/TypeLitFieldDefsSpec.hs +formatted 634967bdd99d persistent-2.18.1.0/test/Database/Persist/THSpec.hs +formatted f9304e426550 persistent-2.18.1.0/test/TemplateTestImports.hs +formatted 7f05465b25d5 persistent-2.18.1.0/test/main.hs +formatted e865ae48f11b pipes-4.3.16/Setup.hs +formatted bc3b140ba83c pipes-4.3.16/benchmarks/Common.hs +formatted e459e4d124d4 pipes-4.3.16/benchmarks/LiftBench.hs +formatted d100cca123ea pipes-4.3.16/benchmarks/PreludeBench.hs +formatted c30da8c52f2b pipes-4.3.16/src/Pipes.hs +formatted 332e8aaad352 pipes-4.3.16/src/Pipes/Core.hs +formatted e021398dbff3 pipes-4.3.16/src/Pipes/Internal.hs +formatted e3b36f0685b2 pipes-4.3.16/src/Pipes/Lift.hs +formatted 82bba5f85292 pipes-4.3.16/src/Pipes/Prelude.hs +formatted 436224de8a77 pipes-4.3.16/src/Pipes/Tutorial.hs +formatted 6ca40cc862a8 pipes-4.3.16/tests/Main.hs +formatted 56dca68e0a87 postgrest-9.0.1/Setup.hs +formatted 772d4f353686 postgrest-9.0.1/main/Main.hs +formatted bd3eb89beb11 postgrest-9.0.1/src/PostgREST/App.hs +formatted aeefa441d9ea postgrest-9.0.1/src/PostgREST/AppState.hs +formatted fa5f086364f2 postgrest-9.0.1/src/PostgREST/Auth.hs +formatted f42af00966e2 postgrest-9.0.1/src/PostgREST/CLI.hs +formatted 41c49c80f153 postgrest-9.0.1/src/PostgREST/Config.hs +formatted 26e0ccfa04f8 postgrest-9.0.1/src/PostgREST/Config/Database.hs +formatted 9632241317fd postgrest-9.0.1/src/PostgREST/Config/JSPath.hs +formatted b719e278251b postgrest-9.0.1/src/PostgREST/Config/PgVersion.hs +formatted 4f3444c0a949 postgrest-9.0.1/src/PostgREST/Config/Proxy.hs +formatted 65c66f863629 postgrest-9.0.1/src/PostgREST/ContentType.hs +formatted 9200d4931d04 postgrest-9.0.1/src/PostgREST/Cors.hs +formatted 4eef76b76acf postgrest-9.0.1/src/PostgREST/DbStructure.hs +formatted a0f5c884d319 postgrest-9.0.1/src/PostgREST/DbStructure/Identifiers.hs +formatted 28e71accad76 postgrest-9.0.1/src/PostgREST/DbStructure/Proc.hs +formatted 8670bffe5d4a postgrest-9.0.1/src/PostgREST/DbStructure/Relationship.hs +formatted 0951365600a0 postgrest-9.0.1/src/PostgREST/DbStructure/Table.hs +formatted 50ae92f8d312 postgrest-9.0.1/src/PostgREST/Error.hs +formatted f1b82d17eed8 postgrest-9.0.1/src/PostgREST/GucHeader.hs +formatted 2c6a7ae61af9 postgrest-9.0.1/src/PostgREST/Logger.hs +formatted 42324fca62e1 postgrest-9.0.1/src/PostgREST/Middleware.hs +formatted 9b991a36398d postgrest-9.0.1/src/PostgREST/OpenAPI.hs +formatted ccef8516712f postgrest-9.0.1/src/PostgREST/Query/QueryBuilder.hs +formatted 491a8b321ce9 postgrest-9.0.1/src/PostgREST/Query/SqlFragment.hs +formatted 5f4cbf20b7f3 postgrest-9.0.1/src/PostgREST/Query/Statements.hs +formatted 7d83276a4311 postgrest-9.0.1/src/PostgREST/RangeQuery.hs +formatted 468dcbe76687 postgrest-9.0.1/src/PostgREST/Request/ApiRequest.hs +formatted 307adfedde88 postgrest-9.0.1/src/PostgREST/Request/DbRequestBuilder.hs +formatted fc3632173741 postgrest-9.0.1/src/PostgREST/Request/Parsers.hs +formatted 8e710c5836da postgrest-9.0.1/src/PostgREST/Request/Preferences.hs +formatted c051dbc66c29 postgrest-9.0.1/src/PostgREST/Request/Types.hs +formatted 0c839dec485e postgrest-9.0.1/src/PostgREST/Unix.hs +formatted 793800bb054f postgrest-9.0.1/src/PostgREST/Version.hs +formatted 2b137fd794c3 postgrest-9.0.1/src/PostgREST/Workers.hs +formatted c719f882d27c postgrest-9.0.1/test/doc/Main.hs +formatted 5bf94bd709a7 postgrest-9.0.1/test/spec/Feature/AndOrParamsSpec.hs +formatted 000191b3349e postgrest-9.0.1/test/spec/Feature/AsymmetricJwtSpec.hs +formatted 5a86c6233052 postgrest-9.0.1/test/spec/Feature/AudienceJwtSecretSpec.hs +formatted acbe9362314e postgrest-9.0.1/test/spec/Feature/AuthSpec.hs +formatted 7cb71699f728 postgrest-9.0.1/test/spec/Feature/BinaryJwtSecretSpec.hs +formatted 2fb433681c01 postgrest-9.0.1/test/spec/Feature/ConcurrentSpec.hs +formatted db553e991f45 postgrest-9.0.1/test/spec/Feature/CorsSpec.hs +formatted 343d3e3a465e postgrest-9.0.1/test/spec/Feature/DeleteSpec.hs +formatted 112082d3da25 postgrest-9.0.1/test/spec/Feature/DisabledOpenApiSpec.hs +formatted ad7384965a9e postgrest-9.0.1/test/spec/Feature/EmbedDisambiguationSpec.hs +formatted f7a7ea3d2a87 postgrest-9.0.1/test/spec/Feature/EmbedInnerJoinSpec.hs +formatted a3dddabdb704 postgrest-9.0.1/test/spec/Feature/ExtraSearchPathSpec.hs +formatted ff20687cb475 postgrest-9.0.1/test/spec/Feature/HtmlRawOutputSpec.hs +formatted c2e75b5529a0 postgrest-9.0.1/test/spec/Feature/IgnorePrivOpenApiSpec.hs +formatted ea599ebfe99c postgrest-9.0.1/test/spec/Feature/InsertSpec.hs +formatted 9264b830952f postgrest-9.0.1/test/spec/Feature/JsonOperatorSpec.hs +formatted 12271bc52ad6 postgrest-9.0.1/test/spec/Feature/LegacyGucsSpec.hs +formatted 5228aaf9349c postgrest-9.0.1/test/spec/Feature/MultipleSchemaSpec.hs +formatted 3e8b6471e229 postgrest-9.0.1/test/spec/Feature/NoJwtSpec.hs +formatted a7144a84ab24 postgrest-9.0.1/test/spec/Feature/NonexistentSchemaSpec.hs +formatted f7d94a10d9ad postgrest-9.0.1/test/spec/Feature/OpenApiSpec.hs +formatted 1b9c2f6f5c75 postgrest-9.0.1/test/spec/Feature/OptionsSpec.hs +formatted 89a1589ff0fe postgrest-9.0.1/test/spec/Feature/ProxySpec.hs +formatted 4e889783f9ba postgrest-9.0.1/test/spec/Feature/QueryLimitedSpec.hs +formatted f305fa66460e postgrest-9.0.1/test/spec/Feature/QuerySpec.hs +formatted 146347d5ddec postgrest-9.0.1/test/spec/Feature/RangeSpec.hs +formatted 7cb746560127 postgrest-9.0.1/test/spec/Feature/RawOutputTypesSpec.hs +formatted b4a3ab5a81a9 postgrest-9.0.1/test/spec/Feature/RollbackSpec.hs +formatted dc5321d79fb3 postgrest-9.0.1/test/spec/Feature/RootSpec.hs +formatted 77a649eeb2e6 postgrest-9.0.1/test/spec/Feature/RpcPreRequestGucsSpec.hs +formatted 3a4705fe539d postgrest-9.0.1/test/spec/Feature/RpcSpec.hs +formatted 73c0ab518a3d postgrest-9.0.1/test/spec/Feature/SingularSpec.hs +formatted be03de84804f postgrest-9.0.1/test/spec/Feature/UnicodeSpec.hs +formatted 162dade8a566 postgrest-9.0.1/test/spec/Feature/UpdateSpec.hs +formatted 55bb47ad8764 postgrest-9.0.1/test/spec/Feature/UpsertSpec.hs +formatted 7a9dd3383794 postgrest-9.0.1/test/spec/Main.hs +formatted f32b163f57d7 postgrest-9.0.1/test/spec/QueryCost.hs +formatted ab30ff617540 postgrest-9.0.1/test/spec/SpecHelper.hs +formatted c136e6235ce2 postgrest-9.0.1/test/spec/TestTypes.hs +formatted 13abd8b59335 profunctors-5.6.3/src/Data/Profunctor.hs +formatted cd53a440a7f3 profunctors-5.6.3/src/Data/Profunctor/Adjunction.hs +formatted 604108a2b13e profunctors-5.6.3/src/Data/Profunctor/Cayley.hs +formatted 8b5e0d5c4b28 profunctors-5.6.3/src/Data/Profunctor/Choice.hs +formatted 4a0c88f45f54 profunctors-5.6.3/src/Data/Profunctor/Closed.hs +formatted de00ff751f38 profunctors-5.6.3/src/Data/Profunctor/Composition.hs +formatted a6085622ae89 profunctors-5.6.3/src/Data/Profunctor/Mapping.hs +formatted 59b30aaa8b06 profunctors-5.6.3/src/Data/Profunctor/Monad.hs +formatted 5b7a528834d1 profunctors-5.6.3/src/Data/Profunctor/Ran.hs +formatted dc01020464c2 profunctors-5.6.3/src/Data/Profunctor/Rep.hs +formatted a405de2f08b4 profunctors-5.6.3/src/Data/Profunctor/Sieve.hs +formatted 072c0f89a17b profunctors-5.6.3/src/Data/Profunctor/Strong.hs +formatted 1c7f87812e16 profunctors-5.6.3/src/Data/Profunctor/Traversing.hs +formatted 74b9958fedc6 profunctors-5.6.3/src/Data/Profunctor/Types.hs +formatted 6d4d49816f3c profunctors-5.6.3/src/Data/Profunctor/Unsafe.hs +formatted 074b9f00e701 profunctors-5.6.3/src/Data/Profunctor/Yoneda.hs +formatted f97b976f5a71 purescript-0.15.15/Setup.hs +formatted fc25cc9ab507 purescript-0.15.15/app/Command/Bundle.hs +formatted a46f2214fbc8 purescript-0.15.15/app/Command/Compile.hs +formatted 7219813f0a5c purescript-0.15.15/app/Command/Docs.hs +formatted 55df8737ff2c purescript-0.15.15/app/Command/Docs/Html.hs +formatted 037036ef66e1 purescript-0.15.15/app/Command/Docs/Markdown.hs +formatted eb687ab7bdfe purescript-0.15.15/app/Command/Graph.hs +formatted 60131f690f8b purescript-0.15.15/app/Command/Hierarchy.hs +formatted d627a10507ea purescript-0.15.15/app/Command/Ide.hs +formatted 2c3998824b51 purescript-0.15.15/app/Command/Publish.hs +formatted 5ed2f192bfb3 purescript-0.15.15/app/Command/REPL.hs +formatted aa128423c4fb purescript-0.15.15/app/Main.hs +formatted 8c8cfed900b8 purescript-0.15.15/app/SharedCLI.hs +formatted 18a85337fa6b purescript-0.15.15/app/Version.hs +formatted ee21446da604 purescript-0.15.15/src/Control/Monad/Logger.hs +formatted a06d72dd0adb purescript-0.15.15/src/Control/Monad/Supply.hs +formatted 4199e8087c69 purescript-0.15.15/src/Control/Monad/Supply/Class.hs +formatted 7a4d7979e1c9 purescript-0.15.15/src/Data/Text/PureScript.hs +formatted eef5dd037abf purescript-0.15.15/src/Language/PureScript.hs +formatted 64c0d4442190 purescript-0.15.15/src/Language/PureScript/AST.hs +formatted 147dc6ad6c67 purescript-0.15.15/src/Language/PureScript/AST/Binders.hs +formatted ebd8d9a20974 purescript-0.15.15/src/Language/PureScript/AST/Declarations.hs +formatted 0368132e2a7c purescript-0.15.15/src/Language/PureScript/AST/Declarations/ChainId.hs +formatted b8b152a00a9e purescript-0.15.15/src/Language/PureScript/AST/Exported.hs +formatted 16c598490b8b purescript-0.15.15/src/Language/PureScript/AST/Literals.hs +formatted 6dde4019084f purescript-0.15.15/src/Language/PureScript/AST/Operators.hs +formatted c7ebd057b2a2 purescript-0.15.15/src/Language/PureScript/AST/SourcePos.hs +formatted 1c8f80e1b700 purescript-0.15.15/src/Language/PureScript/AST/Traversals.hs +formatted cb23b5c86a87 purescript-0.15.15/src/Language/PureScript/AST/Utils.hs +formatted 64329f97de0d purescript-0.15.15/src/Language/PureScript/Bundle.hs +formatted 665ede6abf17 purescript-0.15.15/src/Language/PureScript/CST.hs +formatted 1c47033ea161 purescript-0.15.15/src/Language/PureScript/CST/Convert.hs +formatted 4c71bba856aa purescript-0.15.15/src/Language/PureScript/CST/Errors.hs +formatted c81c2ecf7ebe purescript-0.15.15/src/Language/PureScript/CST/Flatten.hs +formatted 36fe1c70493a purescript-0.15.15/src/Language/PureScript/CST/Layout.hs +formatted cce231cd663a purescript-0.15.15/src/Language/PureScript/CST/Lexer.hs +formatted aa182229b809 purescript-0.15.15/src/Language/PureScript/CST/Monad.hs +formatted fa367dbaa6aa purescript-0.15.15/src/Language/PureScript/CST/Positions.hs +formatted 2df3a82dec66 purescript-0.15.15/src/Language/PureScript/CST/Print.hs +formatted c741805ffed3 purescript-0.15.15/src/Language/PureScript/CST/Traversals.hs +formatted 81c5d151f932 purescript-0.15.15/src/Language/PureScript/CST/Traversals/Type.hs +formatted 46dd73253c21 purescript-0.15.15/src/Language/PureScript/CST/Types.hs +formatted 2bdb1cb651fc purescript-0.15.15/src/Language/PureScript/CST/Utils.hs +formatted ebd74707d2df purescript-0.15.15/src/Language/PureScript/CodeGen.hs +formatted f9bd11aadd08 purescript-0.15.15/src/Language/PureScript/CodeGen/JS.hs +formatted f10bc54be3c8 purescript-0.15.15/src/Language/PureScript/CodeGen/JS/Common.hs +formatted 9f17f1c77074 purescript-0.15.15/src/Language/PureScript/CodeGen/JS/Printer.hs +formatted acabda342dbe purescript-0.15.15/src/Language/PureScript/Comments.hs +formatted 7e1454fed47d purescript-0.15.15/src/Language/PureScript/Constants/Libs.hs +formatted 4e84deb1970c purescript-0.15.15/src/Language/PureScript/Constants/Prim.hs +formatted 08cf8657b87b purescript-0.15.15/src/Language/PureScript/Constants/TH.hs +formatted 0e372eb9e534 purescript-0.15.15/src/Language/PureScript/CoreFn.hs +formatted c133879c858f purescript-0.15.15/src/Language/PureScript/CoreFn/Ann.hs +formatted 2556afbb3bea purescript-0.15.15/src/Language/PureScript/CoreFn/Binders.hs +formatted 1141b43d30ff purescript-0.15.15/src/Language/PureScript/CoreFn/CSE.hs +formatted 6cbe0845ef8c purescript-0.15.15/src/Language/PureScript/CoreFn/Desugar.hs +formatted 2f90c3840d55 purescript-0.15.15/src/Language/PureScript/CoreFn/Expr.hs +formatted 8464185844d4 purescript-0.15.15/src/Language/PureScript/CoreFn/FromJSON.hs +formatted 1ee1c24577da purescript-0.15.15/src/Language/PureScript/CoreFn/Laziness.hs +formatted 083a81cbf5bf purescript-0.15.15/src/Language/PureScript/CoreFn/Meta.hs +formatted 2b2d42f479f2 purescript-0.15.15/src/Language/PureScript/CoreFn/Module.hs +formatted 8a65378bdb7b purescript-0.15.15/src/Language/PureScript/CoreFn/Optimizer.hs +formatted a01b08124299 purescript-0.15.15/src/Language/PureScript/CoreFn/ToJSON.hs +formatted 74e775f771b9 purescript-0.15.15/src/Language/PureScript/CoreFn/Traversals.hs +formatted 63122a31d5b9 purescript-0.15.15/src/Language/PureScript/CoreImp.hs +formatted b1fad463eff6 purescript-0.15.15/src/Language/PureScript/CoreImp/AST.hs +formatted 07f8248f1a4c purescript-0.15.15/src/Language/PureScript/CoreImp/Module.hs +formatted 76a5683510a3 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer.hs +formatted 900e45f47ef2 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/Blocks.hs +formatted 635c6dcfbee9 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/Common.hs +formatted 458709d8b573 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs +formatted d416fbf811c6 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs +formatted 3a758985a163 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/TCO.hs +formatted c3bcb1230471 purescript-0.15.15/src/Language/PureScript/CoreImp/Optimizer/Unused.hs +formatted 54228acabdeb purescript-0.15.15/src/Language/PureScript/Crash.hs +formatted d38f4a6a3f33 purescript-0.15.15/src/Language/PureScript/Docs.hs +formatted 057fb7fec258 purescript-0.15.15/src/Language/PureScript/Docs/AsHtml.hs +formatted 4113354e65ae purescript-0.15.15/src/Language/PureScript/Docs/AsMarkdown.hs +formatted 1253c947865b purescript-0.15.15/src/Language/PureScript/Docs/Collect.hs +formatted 0d989be52a8a purescript-0.15.15/src/Language/PureScript/Docs/Convert.hs +formatted 70ed8016e77f purescript-0.15.15/src/Language/PureScript/Docs/Convert/ReExports.hs +formatted 01c0ebe958e5 purescript-0.15.15/src/Language/PureScript/Docs/Convert/Single.hs +formatted d97124c1ab6a purescript-0.15.15/src/Language/PureScript/Docs/Css.hs +formatted f90d0d26dd2b purescript-0.15.15/src/Language/PureScript/Docs/Prim.hs +formatted e7ab3625ae1e purescript-0.15.15/src/Language/PureScript/Docs/Render.hs +formatted 4c98064ffe67 purescript-0.15.15/src/Language/PureScript/Docs/RenderedCode.hs +formatted 2f9857670eb2 purescript-0.15.15/src/Language/PureScript/Docs/RenderedCode/RenderType.hs +formatted a592688b187e purescript-0.15.15/src/Language/PureScript/Docs/RenderedCode/Types.hs +formatted 876b5438b748 purescript-0.15.15/src/Language/PureScript/Docs/Tags.hs +formatted 2145c65037f8 purescript-0.15.15/src/Language/PureScript/Docs/Types.hs +formatted bc381d509404 purescript-0.15.15/src/Language/PureScript/Docs/Utils/MonoidExtras.hs +formatted f3b1444d35a5 purescript-0.15.15/src/Language/PureScript/Environment.hs +formatted 27ca88d0bd04 purescript-0.15.15/src/Language/PureScript/Errors.hs +formatted 805b37c2988c purescript-0.15.15/src/Language/PureScript/Errors/JSON.hs +formatted 7a36f37df732 purescript-0.15.15/src/Language/PureScript/Externs.hs +formatted 347eb6f7f34d purescript-0.15.15/src/Language/PureScript/Glob.hs +formatted a91b6028a053 purescript-0.15.15/src/Language/PureScript/Graph.hs +formatted 0af324e42f5f purescript-0.15.15/src/Language/PureScript/Hierarchy.hs +formatted 615dd3e96d83 purescript-0.15.15/src/Language/PureScript/Ide.hs +formatted e69502626a1b purescript-0.15.15/src/Language/PureScript/Ide/CaseSplit.hs +formatted b9d2fcb8535a purescript-0.15.15/src/Language/PureScript/Ide/Command.hs +formatted e26de1f28e1b purescript-0.15.15/src/Language/PureScript/Ide/Completion.hs +formatted 7c4c157c15a2 purescript-0.15.15/src/Language/PureScript/Ide/Error.hs +formatted f831eeaf68b3 purescript-0.15.15/src/Language/PureScript/Ide/Externs.hs +formatted 925e97a78180 purescript-0.15.15/src/Language/PureScript/Ide/Filter.hs +formatted 3576f2d7de05 purescript-0.15.15/src/Language/PureScript/Ide/Filter/Declaration.hs +formatted d48adbab9be5 purescript-0.15.15/src/Language/PureScript/Ide/Filter/Imports.hs +formatted 93d2180b21af purescript-0.15.15/src/Language/PureScript/Ide/Imports.hs +formatted 395f2cbf5c2c purescript-0.15.15/src/Language/PureScript/Ide/Imports/Actions.hs +formatted dae869e09d51 purescript-0.15.15/src/Language/PureScript/Ide/Logging.hs +formatted 6495efed1636 purescript-0.15.15/src/Language/PureScript/Ide/Matcher.hs +formatted fe69a6b2ed2c purescript-0.15.15/src/Language/PureScript/Ide/Prim.hs +formatted f203b7c7db4d purescript-0.15.15/src/Language/PureScript/Ide/Rebuild.hs +formatted a65fbc555581 purescript-0.15.15/src/Language/PureScript/Ide/Reexports.hs +formatted 8dad96598473 purescript-0.15.15/src/Language/PureScript/Ide/SourceFile.hs +formatted 7c86ee11f6ae purescript-0.15.15/src/Language/PureScript/Ide/State.hs +formatted f41fbbfd0237 purescript-0.15.15/src/Language/PureScript/Ide/Types.hs +formatted a2547b22a5bd purescript-0.15.15/src/Language/PureScript/Ide/Usage.hs +formatted c5c7f0134f7c purescript-0.15.15/src/Language/PureScript/Ide/Util.hs +formatted 0c379aba42be purescript-0.15.15/src/Language/PureScript/Interactive.hs +formatted ea47006e2013 purescript-0.15.15/src/Language/PureScript/Interactive/Completion.hs +formatted 17488dfda517 purescript-0.15.15/src/Language/PureScript/Interactive/Directive.hs +formatted 2ab1349ff2ec purescript-0.15.15/src/Language/PureScript/Interactive/IO.hs +formatted f41f6e5826db purescript-0.15.15/src/Language/PureScript/Interactive/Message.hs +formatted 595ebf5e2141 purescript-0.15.15/src/Language/PureScript/Interactive/Module.hs +formatted 4b81e9100134 purescript-0.15.15/src/Language/PureScript/Interactive/Parser.hs +formatted aa71f85f0c45 purescript-0.15.15/src/Language/PureScript/Interactive/Printer.hs +formatted 2a5d0038271f purescript-0.15.15/src/Language/PureScript/Interactive/Types.hs +formatted d71ef7f9fb6c purescript-0.15.15/src/Language/PureScript/Label.hs +formatted a6c99546ca7b purescript-0.15.15/src/Language/PureScript/Linter.hs +formatted a4813ff2c614 purescript-0.15.15/src/Language/PureScript/Linter/Exhaustive.hs +formatted a875b0da533f purescript-0.15.15/src/Language/PureScript/Linter/Imports.hs +formatted eefa6de7d2e3 purescript-0.15.15/src/Language/PureScript/Linter/Wildcards.hs +formatted a91628e7f7d5 purescript-0.15.15/src/Language/PureScript/Make.hs +formatted 8ef53feca8d8 purescript-0.15.15/src/Language/PureScript/Make/Actions.hs +formatted a5c1fea38376 purescript-0.15.15/src/Language/PureScript/Make/BuildPlan.hs +formatted 2ff6ea3e0439 purescript-0.15.15/src/Language/PureScript/Make/Cache.hs +formatted 5a62260bbc36 purescript-0.15.15/src/Language/PureScript/Make/Monad.hs +formatted d32972a1d126 purescript-0.15.15/src/Language/PureScript/ModuleDependencies.hs +formatted 0415064ad3ac purescript-0.15.15/src/Language/PureScript/Names.hs +formatted 0f9b1ea22f14 purescript-0.15.15/src/Language/PureScript/Options.hs +formatted 57e5473deb15 purescript-0.15.15/src/Language/PureScript/PSString.hs +formatted 2b26a96d8bcc purescript-0.15.15/src/Language/PureScript/Pretty.hs +formatted c6838281b4ea purescript-0.15.15/src/Language/PureScript/Pretty/Common.hs +formatted 61f00923794e purescript-0.15.15/src/Language/PureScript/Pretty/Types.hs +formatted 719bfaeded1b purescript-0.15.15/src/Language/PureScript/Pretty/Values.hs +formatted 53f985a5fefa purescript-0.15.15/src/Language/PureScript/Publish.hs +formatted 79e26f16154a purescript-0.15.15/src/Language/PureScript/Publish/BoxesHelpers.hs +formatted 6bbf592abed7 purescript-0.15.15/src/Language/PureScript/Publish/ErrorsWarnings.hs +formatted 717e37e4a15e purescript-0.15.15/src/Language/PureScript/Publish/Registry/Compat.hs +formatted fba7a9e201e6 purescript-0.15.15/src/Language/PureScript/Publish/Utils.hs +formatted 7537fedb9664 purescript-0.15.15/src/Language/PureScript/Renamer.hs +formatted 9e88be14067d purescript-0.15.15/src/Language/PureScript/Roles.hs +formatted 2530d5774295 purescript-0.15.15/src/Language/PureScript/Sugar.hs +formatted 834b0e83e969 purescript-0.15.15/src/Language/PureScript/Sugar/AdoNotation.hs +formatted cea4abccd1cf purescript-0.15.15/src/Language/PureScript/Sugar/BindingGroups.hs +formatted 502cd635c402 purescript-0.15.15/src/Language/PureScript/Sugar/CaseDeclarations.hs +formatted 7efb24168510 purescript-0.15.15/src/Language/PureScript/Sugar/DoNotation.hs +formatted b4240a4449c4 purescript-0.15.15/src/Language/PureScript/Sugar/LetPattern.hs +formatted 224e99106e55 purescript-0.15.15/src/Language/PureScript/Sugar/Names.hs +formatted b2eab3efd8fe purescript-0.15.15/src/Language/PureScript/Sugar/Names/Common.hs +formatted 346caf48f81c purescript-0.15.15/src/Language/PureScript/Sugar/Names/Env.hs +formatted 48e3da823478 purescript-0.15.15/src/Language/PureScript/Sugar/Names/Exports.hs +formatted a4d64c36bc25 purescript-0.15.15/src/Language/PureScript/Sugar/Names/Imports.hs +formatted 54d278b2a1af purescript-0.15.15/src/Language/PureScript/Sugar/ObjectWildcards.hs +formatted 5fd120196aba purescript-0.15.15/src/Language/PureScript/Sugar/Operators.hs +formatted 2a167c659922 purescript-0.15.15/src/Language/PureScript/Sugar/Operators/Binders.hs +formatted 13722182a0e7 purescript-0.15.15/src/Language/PureScript/Sugar/Operators/Common.hs +formatted af45497618ed purescript-0.15.15/src/Language/PureScript/Sugar/Operators/Expr.hs +formatted 93053d3544f1 purescript-0.15.15/src/Language/PureScript/Sugar/Operators/Types.hs +formatted bf9cdccf9cd8 purescript-0.15.15/src/Language/PureScript/Sugar/TypeClasses.hs +formatted b5057db581ea purescript-0.15.15/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs +formatted 84ce0264acbb purescript-0.15.15/src/Language/PureScript/Sugar/TypeDeclarations.hs +formatted 24e5df024499 purescript-0.15.15/src/Language/PureScript/Traversals.hs +formatted 9fc0861959b2 purescript-0.15.15/src/Language/PureScript/TypeChecker.hs +formatted 2c26865167b9 purescript-0.15.15/src/Language/PureScript/TypeChecker/Deriving.hs +formatted 77af37aaf14d purescript-0.15.15/src/Language/PureScript/TypeChecker/Entailment.hs +formatted fa60a8caf03a purescript-0.15.15/src/Language/PureScript/TypeChecker/Entailment/Coercible.hs +formatted b504bbdc02b8 purescript-0.15.15/src/Language/PureScript/TypeChecker/Entailment/IntCompare.hs +formatted 2f14273075e4 purescript-0.15.15/src/Language/PureScript/TypeChecker/Kinds.hs +formatted d65280bbc8f4 purescript-0.15.15/src/Language/PureScript/TypeChecker/Monad.hs +formatted 71ace1d575fe purescript-0.15.15/src/Language/PureScript/TypeChecker/Roles.hs +formatted 5f769d073cac purescript-0.15.15/src/Language/PureScript/TypeChecker/Skolems.hs +formatted c8964442e6c6 purescript-0.15.15/src/Language/PureScript/TypeChecker/Subsumption.hs +formatted c5b309590b3d purescript-0.15.15/src/Language/PureScript/TypeChecker/Synonyms.hs +formatted 6dcac272ef52 purescript-0.15.15/src/Language/PureScript/TypeChecker/TypeSearch.hs +formatted d5153c7b177b purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs +formatted 0189781f7243 purescript-0.15.15/src/Language/PureScript/TypeChecker/Unify.hs +formatted 2d148264f334 purescript-0.15.15/src/Language/PureScript/TypeClassDictionaries.hs +formatted 9cac73392e4f purescript-0.15.15/src/Language/PureScript/Types.hs +formatted 50a45fbad08d purescript-0.15.15/src/System/IO/UTF8.hs +formatted 4533a74fbdb2 purescript-0.15.15/tests/Language/PureScript/Ide/CompletionSpec.hs +formatted 099ba0badfd6 purescript-0.15.15/tests/Language/PureScript/Ide/FilterSpec.hs +formatted 1033245eef97 purescript-0.15.15/tests/Language/PureScript/Ide/ImportsSpec.hs +formatted 028f5c10dae7 purescript-0.15.15/tests/Language/PureScript/Ide/MatcherSpec.hs +formatted e7c92690fcf3 purescript-0.15.15/tests/Language/PureScript/Ide/RebuildSpec.hs +formatted 7890facc486a purescript-0.15.15/tests/Language/PureScript/Ide/ReexportsSpec.hs +formatted 59d2a1d292e1 purescript-0.15.15/tests/Language/PureScript/Ide/SourceFileSpec.hs +formatted 904535829fba purescript-0.15.15/tests/Language/PureScript/Ide/StateSpec.hs +formatted 1698cf9a91b8 purescript-0.15.15/tests/Language/PureScript/Ide/Test.hs +formatted 67fe4d589cdb purescript-0.15.15/tests/Language/PureScript/Ide/UsageSpec.hs +formatted 0406ed28e812 purescript-0.15.15/tests/Main.hs +formatted ed333c67c3b1 purescript-0.15.15/tests/PscIdeSpec.hs +formatted a2b0f5e823b9 purescript-0.15.15/tests/TestAst.hs +formatted 856645ead459 purescript-0.15.15/tests/TestCompiler.hs +formatted 4184ded3056f purescript-0.15.15/tests/TestCoreFn.hs +formatted 3d3b4f7c14d7 purescript-0.15.15/tests/TestCst.hs +formatted 98e4356992c1 purescript-0.15.15/tests/TestDocs.hs +formatted e29c16f400a0 purescript-0.15.15/tests/TestGraph.hs +formatted 7314022489fa purescript-0.15.15/tests/TestHierarchy.hs +formatted 0874e238b9c0 purescript-0.15.15/tests/TestIde.hs +formatted df1c4148215e purescript-0.15.15/tests/TestMake.hs +formatted e782a733be50 purescript-0.15.15/tests/TestPrimDocs.hs +formatted d2998d562480 purescript-0.15.15/tests/TestPscPublish.hs +formatted e47fc0f000ee purescript-0.15.15/tests/TestPsci.hs +formatted 557206f834dc purescript-0.15.15/tests/TestPsci/CommandTest.hs +formatted a139fd3aa0c9 purescript-0.15.15/tests/TestPsci/CompletionTest.hs +formatted 5fa6ca09e4c4 purescript-0.15.15/tests/TestPsci/EvalTest.hs +formatted 1396270146b9 purescript-0.15.15/tests/TestPsci/TestEnv.hs +formatted 82c9984e8670 purescript-0.15.15/tests/TestSourceMaps.hs +formatted e6fa08547d76 purescript-0.15.15/tests/TestUtils.hs +formatted 002d52c424b7 raaz-0.3.11/api/aead/Auth/Implementation.hsig +formatted 4a86cd34c9e7 raaz-0.3.11/api/aead/Cipher/Implementation.hsig +formatted 16fa84cb7ae5 raaz-0.3.11/api/aead/Interface.hs +formatted a346882029b3 raaz-0.3.11/api/auth/Implementation.hsig +formatted 77a977c85c0d raaz-0.3.11/api/auth/Interface.hs +formatted 29b7f7e93ae5 raaz-0.3.11/api/digest/Implementation.hsig +formatted 7b45644314ef raaz-0.3.11/api/digest/Interface.hs +formatted 711ebf2e3620 raaz-0.3.11/api/encrypt/Implementation.hsig +formatted abdae110e56a raaz-0.3.11/api/encrypt/Interface.hs +formatted 10d5d9d622cd raaz-0.3.11/api/random/Entropy.hsig +formatted 83b376fec166 raaz-0.3.11/api/random/Implementation.hsig +formatted ffc859b186af raaz-0.3.11/api/random/Internal.hs +formatted 71c16f895f6c raaz-0.3.11/api/random/PRGenerator.hs +formatted a9538ed599c8 raaz-0.3.11/benchmarks/Main.hs +formatted 876b405577a3 raaz-0.3.11/benchmarks/internal/Benchmark/CSPRG.hs +formatted 20cee45b7828 raaz-0.3.11/benchmarks/internal/Benchmark/Primitive.hs +formatted 0d27567b2a16 raaz-0.3.11/benchmarks/internal/Benchmark/Types.hs +formatted 9ec4c716a238 raaz-0.3.11/core/Raaz/Core.hs +formatted 52634a64c590 raaz-0.3.11/core/Raaz/Core/ByteSource.hs +formatted a05146df1142 raaz-0.3.11/core/Raaz/Core/Constants.hs +formatted 97564cea364d raaz-0.3.11/core/Raaz/Core/CpuSupports.hs +formatted b89a1297556b raaz-0.3.11/core/Raaz/Core/Encode.hs +formatted f463b4886df2 raaz-0.3.11/core/Raaz/Core/Encode/Base16.hs +formatted e95c13b6113a raaz-0.3.11/core/Raaz/Core/Encode/Base64.hs +formatted f8721f54231f raaz-0.3.11/core/Raaz/Core/Encode/Internal.hs +formatted 45c46e35a34f raaz-0.3.11/core/Raaz/Core/Memory.hs +formatted be5bdc9fc1ae raaz-0.3.11/core/Raaz/Core/MonoidalAction.hs +formatted a44dbacd364d raaz-0.3.11/core/Raaz/Core/Parse.hs +formatted 514d08e6f301 raaz-0.3.11/core/Raaz/Core/Parse/Unsafe.hs +formatted 3d4dcaf4509d raaz-0.3.11/core/Raaz/Core/Prelude.hs +formatted 48ceb85b87f3 raaz-0.3.11/core/Raaz/Core/Primitive.hs +formatted f026c14b5cef raaz-0.3.11/core/Raaz/Core/Transfer.hs +formatted 5113d120fe4d raaz-0.3.11/core/Raaz/Core/Transfer/Unsafe.hs +formatted 03cf11da4658 raaz-0.3.11/core/Raaz/Core/Types.hs +formatted 2efdce977481 raaz-0.3.11/core/Raaz/Core/Types/Copying.hs +formatted da6a05924170 raaz-0.3.11/core/Raaz/Core/Types/Endian.hs +formatted 49cc9654b3b0 raaz-0.3.11/core/Raaz/Core/Types/Equality.hs +formatted 72aa730843b9 raaz-0.3.11/core/Raaz/Core/Types/Internal.hs +formatted 87409be71259 raaz-0.3.11/core/Raaz/Core/Types/Pointer.hs +formatted e89e04794868 raaz-0.3.11/core/Raaz/Core/Types/Tuple.hs +formatted d98d94a62e17 raaz-0.3.11/core/Raaz/Core/Util/ByteString.hs +formatted aadc37085673 raaz-0.3.11/core/Raaz/Primitive/AEAD/Internal.hs +formatted bdf59fdf9536 raaz-0.3.11/core/Raaz/Primitive/Blake2/Internal.hs +formatted 26f42c9a3385 raaz-0.3.11/core/Raaz/Primitive/ChaCha20/Internal.hs +formatted 933091143258 raaz-0.3.11/core/Raaz/Primitive/HashMemory.hs +formatted 2e41cccfd947 raaz-0.3.11/core/Raaz/Primitive/Keyed/Internal.hs +formatted 11f319d28f77 raaz-0.3.11/core/Raaz/Primitive/Poly1305/Internal.hs +formatted 662036acbd84 raaz-0.3.11/core/Raaz/Primitive/Sha2/Internal.hs +formatted d321e6f120cc raaz-0.3.11/implementation/Blake2b/CHandWritten.hs +formatted c7f7e16ff427 raaz-0.3.11/implementation/Blake2b/CPortable.hs +formatted 380071ee384a raaz-0.3.11/implementation/Blake2s/CHandWritten.hs +formatted d4911e2aba2f raaz-0.3.11/implementation/ChaCha20/CHandWritten.hs +formatted fd7ed676bf40 raaz-0.3.11/implementation/ChaCha20/CPortable.hs +formatted 2f7657c239d7 raaz-0.3.11/implementation/ChaCha20/Random/CPortable.hs +formatted e3deac8e5358 raaz-0.3.11/implementation/Poly1305/CPortable.hs +formatted 340ec557db99 raaz-0.3.11/implementation/Poly1305/Memory.hs +formatted 720f42375ee4 raaz-0.3.11/implementation/Sha256/CHandWritten.hs +formatted c064cc7a8421 raaz-0.3.11/implementation/Sha256/CPortable.hs +formatted a59c773526b4 raaz-0.3.11/implementation/Sha512/CHandWritten.hs +formatted 53529d47a59f raaz-0.3.11/implementation/Sha512/CPortable.hs +formatted e5d101450ea0 raaz-0.3.11/implementation/entropy/arc4random/Entropy.hs +formatted fe1af598e9b2 raaz-0.3.11/implementation/entropy/urandom/Entropy.hs +formatted 0a7a863b87f6 raaz-0.3.11/indef/Implementation.hsig +formatted 5b5f82999259 raaz-0.3.11/indef/Utils.hs +formatted 666dcbf885e6 raaz-0.3.11/indef/buffer/Buffer.hs +formatted 4d0bd2b93b60 raaz-0.3.11/indef/buffer/Context.hs +formatted d34b17eeb2fb raaz-0.3.11/indef/buffer/Implementation.hsig +formatted a79a9dc1ec44 raaz-0.3.11/indef/chacha20/Implementation.hsig +formatted 496eb8d3a6e9 raaz-0.3.11/indef/chacha20/XChaCha20/Implementation.hs +formatted a2c11b61575b raaz-0.3.11/indef/keyed/hash/Implementation.hsig +formatted 875f23f8f911 raaz-0.3.11/indef/keyed/hash/Mac/Implementation.hs +formatted fd3b4278ccc5 raaz-0.3.11/libverse/Raaz/Verse/Blake2b/C/Portable.hs +formatted 44b600e76f74 raaz-0.3.11/libverse/Raaz/Verse/ChaCha20/C/Portable.hs +formatted 221da1a1ba37 raaz-0.3.11/libverse/Raaz/Verse/Poly1305/C/Portable.hs +formatted 7ccb752d8b1d raaz-0.3.11/libverse/Raaz/Verse/Sha256/C/Portable.hs +formatted 695112ac1280 raaz-0.3.11/libverse/Raaz/Verse/Sha512/C/Portable.hs +formatted 2fbd14b119a4 raaz-0.3.11/monocypher/tests/Monocypher.hs +formatted 1d0ec4de7195 raaz-0.3.11/monocypher/tests/Monocypher/Blake2bSpec.hs +formatted 0c1244f02a18 raaz-0.3.11/monocypher/tests/Monocypher/ChaCha20Spec.hs +formatted e81070c8d0f4 raaz-0.3.11/monocypher/tests/Monocypher/Sha512Spec.hs +formatted 309f4011c1b9 raaz-0.3.11/raaz/Raaz.hs +formatted d7e15e03f1d7 raaz-0.3.11/raaz/Raaz/Auth.hs +formatted 44194680e191 raaz-0.3.11/raaz/Raaz/AuthEncrypt.hs +formatted 6c7dee472711 raaz-0.3.11/raaz/Raaz/AuthEncrypt/Unsafe.hs +formatted 1f2758b948a2 raaz-0.3.11/raaz/Raaz/Digest.hs +formatted fb3ff8903f10 raaz-0.3.11/raaz/Raaz/Random.hs +formatted 14ec81125123 raaz-0.3.11/raaz/Raaz/V1/Auth.hs +formatted 54d933b4519f raaz-0.3.11/raaz/Raaz/V1/AuthEncrypt.hs +formatted 9c227de3e844 raaz-0.3.11/raaz/Raaz/V1/AuthEncrypt/Unsafe.hs +formatted b221e97b02a1 raaz-0.3.11/raaz/Raaz/V1/Digest.hs +formatted a903f78514a8 raaz-0.3.11/raaz/bin/Command/Checksum.hs +formatted 6af965bca577 raaz-0.3.11/raaz/bin/Command/Info.hs +formatted 8b84f490d89a raaz-0.3.11/raaz/bin/Command/Rand.hs +formatted 2bbae784706a raaz-0.3.11/raaz/bin/Main.hs +formatted bb0aca2148f4 raaz-0.3.11/raaz/bin/Usage.hs +formatted 8955f3f595d6 raaz-0.3.11/tests/Raaz/Cipher/ChaCha20Spec.hs +formatted 66c20297d941 raaz-0.3.11/tests/Raaz/Cipher/XChaCha20Spec.hs +formatted f70ba0951ea5 raaz-0.3.11/tests/Raaz/Core/ByteSourceSpec.hs +formatted f50f5814ce13 raaz-0.3.11/tests/Raaz/Core/EncodeSpec.hs +formatted a5cc6d99aed2 raaz-0.3.11/tests/Raaz/Core/MemorySpec.hs +formatted 11c7d4db7839 raaz-0.3.11/tests/Raaz/Core/Types/WordSpec.hs +formatted e27cf91514a1 raaz-0.3.11/tests/Raaz/Core/Util/ByteStringSpec.hs +formatted 9d02caada1d9 raaz-0.3.11/tests/Raaz/Digest/Blake2Spec.hs +formatted 4f62e035aa97 raaz-0.3.11/tests/Raaz/Digest/Sha256Spec.hs +formatted ab3342a1c1c3 raaz-0.3.11/tests/Raaz/Digest/Sha512Spec.hs +formatted 57a10ec0221b raaz-0.3.11/tests/Raaz/Mac/Poly1305Spec.hs +formatted 6cdc5c00b3a8 raaz-0.3.11/tests/Raaz/RandomSpec.hs +formatted 2fbd14b119a4 raaz-0.3.11/tests/Spec.hs +formatted b1a4cba13110 raaz-0.3.11/tests/auth/Implementation.hsig +formatted ae7499e9f1a2 raaz-0.3.11/tests/auth/Tests/Auth.hs +formatted 146a3742af4d raaz-0.3.11/tests/auth/implementation/Auth/Mac/Blake2b.hs +formatted 1400f8497a4b raaz-0.3.11/tests/auth/implementation/Auth/Mac/Blake2s.hs +formatted f25bf91a517e raaz-0.3.11/tests/auth/implementation/Auth/Poly1305.hs +formatted 7123559f7c81 raaz-0.3.11/tests/cipher/Tests/Cipher.hs +formatted 0c05cee23c2f raaz-0.3.11/tests/comparative/AuthEncrypt.hs +formatted 97ef04d16217 raaz-0.3.11/tests/comparative/AuthEncrypt/ChaCha20Poly1305Spec.hs +formatted 741dc859a7b4 raaz-0.3.11/tests/comparative/Compare.hs +formatted 5a902c132987 raaz-0.3.11/tests/comparative/Digest.hs +formatted 9b0b9e470964 raaz-0.3.11/tests/comparative/Digest/Blake2bSpec.hs +formatted 5e40537778de raaz-0.3.11/tests/comparative/Digest/Sha256Spec.hs +formatted 1d23a17f155b raaz-0.3.11/tests/comparative/Digest/Sha512Spec.hs +formatted a5fa5869f401 raaz-0.3.11/tests/comparative/Encrypt.hs +formatted 43a4a9f511ea raaz-0.3.11/tests/comparative/Encrypt/ChaCha20Spec.hs +formatted 2fbd14b119a4 raaz-0.3.11/tests/comparative/Main.hs +formatted 9a4da070ca55 raaz-0.3.11/tests/core/Tests/Core.hs +formatted 2249765a4b51 raaz-0.3.11/tests/core/Tests/Core/Imports.hs +formatted c746b6855fd8 raaz-0.3.11/tests/core/Tests/Core/Instances.hs +formatted 62f66214a824 raaz-0.3.11/tests/core/Tests/Core/Utils.hs +formatted bcc780e22f03 raaz-0.3.11/tests/message-digest/Implementation.hsig +formatted 2bb252395b85 raaz-0.3.11/tests/message-digest/Tests/Digest.hs +formatted 4a8ac51676df random-1.3.1/Setup.hs +formatted f81df0c89774 random-1.3.1/bench-legacy/BinSearch.hs +formatted ec53458f4d57 random-1.3.1/bench-legacy/SimpleRNGBench.hs +formatted 0584292cc54f random-1.3.1/bench/Main.hs +formatted 3d4520480456 random-1.3.1/src/System/Random.hs +formatted 0719577a75c1 random-1.3.1/src/System/Random/Array.hs +formatted 0648347f5df7 random-1.3.1/src/System/Random/GFinite.hs +formatted 2d02e33ff4f9 random-1.3.1/src/System/Random/Internal.hs +formatted 43cf9948fc9c random-1.3.1/src/System/Random/Seed.hs +formatted 0d9957bbf13d random-1.3.1/src/System/Random/Stateful.hs +formatted 0d72e1db2b6d random-1.3.1/test-inspection/Spec.hs +formatted c6f769b56ab6 random-1.3.1/test-inspection/Spec/Inspection.hs +formatted ed91342d3f30 random-1.3.1/test-legacy/Legacy.hs +formatted 0160098f7cc5 random-1.3.1/test-legacy/Random1283.hs +formatted ad6c39289552 random-1.3.1/test-legacy/RangeTest.hs +formatted 4c1669996d8d random-1.3.1/test-legacy/T7936.hs +formatted 398febcc8a6f random-1.3.1/test-legacy/TestRandomIOs.hs +formatted 3ef25c06bdfc random-1.3.1/test-legacy/TestRandomRs.hs +formatted 170817d6d661 random-1.3.1/test/Spec.hs +formatted a65d68fad80b random-1.3.1/test/Spec/Range.hs +formatted e0e7306312ea random-1.3.1/test/Spec/Run.hs +formatted b3fd15d83ccf random-1.3.1/test/Spec/Seed.hs +formatted 53b268e9c80a random-1.3.1/test/Spec/Stateful.hs +formatted 8bcbf019c7ab recursion-schemes-5.2.3/examples/Expr.hs +formatted 0ec37f362849 recursion-schemes-5.2.3/src/Data/Functor/Base.hs +formatted 3ca7a5ae5fb0 recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs +formatted db17ac3b1e40 recursion-schemes-5.2.3/src/Data/Functor/Foldable/TH.hs +formatted 1581398eb1b5 resourcet-1.3.0/Control/Monad/Trans/Resource.hs +formatted 491af03a5ea1 resourcet-1.3.0/Control/Monad/Trans/Resource/Internal.hs +formatted 22ba33396e6e resourcet-1.3.0/Data/Acquire.hs +formatted 4a9defd159ee resourcet-1.3.0/Data/Acquire/Internal.hs +formatted 27565132aa25 resourcet-1.3.0/UnliftIO/Resource.hs +formatted 1434a2ae8bde resourcet-1.3.0/test/main.hs +formatted e865ae48f11b retry-0.9.3.1/Setup.hs +formatted d4f84e488fb0 retry-0.9.3.1/src/Control/Retry.hs +formatted cce7cb264472 retry-0.9.3.1/src/UnliftIO/Retry.hs +formatted 94b4a78445b3 retry-0.9.3.1/test/Main.hs +formatted 08af947c789a retry-0.9.3.1/test/Tests/Control/Retry.hs +formatted 0b770fc83ef2 retry-0.9.3.1/test/Tests/UnliftIO/Retry.hs +formatted e865ae48f11b safe-exceptions-0.1.7.4/Setup.hs +formatted 9dd8a8e1a75f safe-exceptions-0.1.7.4/src/Control/Exception/Safe.hs +formatted c34af7148814 safe-exceptions-0.1.7.4/test/Control/Exception/SafeSpec.hs +formatted 2fbd14b119a4 safe-exceptions-0.1.7.4/test/Spec.hs +formatted e865ae48f11b scientific-0.3.8.1/Setup.hs +formatted 6a2de24bbe1d scientific-0.3.8.1/bench/bench.hs +formatted b51f688e4f66 scientific-0.3.8.1/src/Data/ByteString/Builder/Scientific.hs +formatted a00104fdca94 scientific-0.3.8.1/src/Data/Scientific.hs +formatted 5837fdbf8485 scientific-0.3.8.1/src/Data/Text/Lazy/Builder/Scientific.hs +formatted 8e2c4142aa7f scientific-0.3.8.1/src/GHC/Integer/Compat.hs +formatted 70da6923c6d5 scientific-0.3.8.1/src/Utils.hs +formatted 511632de8f71 scientific-0.3.8.1/test/test.hs +formatted e865ae48f11b scotty-0.30/Setup.hs +formatted b4007b5fca90 scotty-0.30/Web/Scotty.hs +formatted 06db4e678a89 scotty-0.30/Web/Scotty/Action.hs +formatted 61431d95ef5b scotty-0.30/Web/Scotty/Body.hs +formatted 42bb0728a5d6 scotty-0.30/Web/Scotty/Cookie.hs +formatted 517b584372bf scotty-0.30/Web/Scotty/Internal/Types.hs +formatted ccdc72ea4dc8 scotty-0.30/Web/Scotty/Route.hs +formatted 220c453f0fd9 scotty-0.30/Web/Scotty/Session.hs +formatted 1d39c130ee80 scotty-0.30/Web/Scotty/Trans.hs +formatted e2036cbfa7c2 scotty-0.30/Web/Scotty/Trans/Lazy.hs +formatted 2645fdc50126 scotty-0.30/Web/Scotty/Trans/Strict.hs +formatted 6bad8484016a scotty-0.30/Web/Scotty/Util.hs +formatted 19a63b08e8cc scotty-0.30/bench/Main.hs +formatted ff18ebd00d97 scotty-0.30/doctest/Main.hs +formatted bfcc28288099 scotty-0.30/examples/basic.hs +formatted 128fcbdca77d scotty-0.30/examples/bodyecho.hs +formatted 0bfdeec9e9d5 scotty-0.30/examples/cookies.hs +formatted e68dfe58dd88 scotty-0.30/examples/exceptions.hs +formatted 99664eb0da8e scotty-0.30/examples/globalstate.hs +formatted 984bcbbe2aa7 scotty-0.30/examples/gzip.hs +formatted 8efdf09d4d75 scotty-0.30/examples/json_mode.hs +formatted d96b13ea35d6 scotty-0.30/examples/middleware.hs +formatted dd5796ac98ac scotty-0.30/examples/nested.hs +formatted f424d2128b4a scotty-0.30/examples/options.hs +formatted 8b1e46c9aeb7 scotty-0.30/examples/reader.hs +formatted 6750528250e9 scotty-0.30/examples/session.hs +formatted d40e0a8e64ea scotty-0.30/examples/upload.hs +formatted 94f10fda97e5 scotty-0.30/examples/urlshortener.hs +formatted 2fbd14b119a4 scotty-0.30/test/Spec.hs +formatted dd9baecda733 scotty-0.30/test/Test/Hspec/Wai/Extra.hs +formatted 409d10e2c1d9 scotty-0.30/test/Web/ScottySpec.hs +formatted 091ccbfea22a semigroupoids-6.0.2/src/Data/Bifunctor/Apply.hs +formatted 43f2fc743e76 semigroupoids-6.0.2/src/Data/Functor/Alt.hs +formatted b091ae1639ae semigroupoids-6.0.2/src/Data/Functor/Apply.hs +formatted 4322a16f4eaf semigroupoids-6.0.2/src/Data/Functor/Bind.hs +declined - semigroupoids-6.0.2/src/Data/Functor/Bind/Class.hs +formatted 82dabf65525e semigroupoids-6.0.2/src/Data/Functor/Bind/Trans.hs +formatted dbcbf10c5fed semigroupoids-6.0.2/src/Data/Functor/Contravariant/Conclude.hs +formatted a7b3bbac40b5 semigroupoids-6.0.2/src/Data/Functor/Contravariant/Decide.hs +formatted abf4c37d3996 semigroupoids-6.0.2/src/Data/Functor/Contravariant/Divise.hs +formatted 91c0a22860b9 semigroupoids-6.0.2/src/Data/Functor/Extend.hs +formatted da9d284cb9bb semigroupoids-6.0.2/src/Data/Functor/Plus.hs +formatted 2c9e2b95e1c6 semigroupoids-6.0.2/src/Data/Groupoid.hs +formatted 2a2382799a6a semigroupoids-6.0.2/src/Data/Isomorphism.hs +formatted c38d3ee4d146 semigroupoids-6.0.2/src/Data/Semigroup/Bifoldable.hs +formatted 3b69bf2b2c98 semigroupoids-6.0.2/src/Data/Semigroup/Bitraversable.hs +formatted 6ec751a395e5 semigroupoids-6.0.2/src/Data/Semigroup/Foldable.hs +formatted 15d51636f77f semigroupoids-6.0.2/src/Data/Semigroup/Foldable/Class.hs +formatted e46135ea634e semigroupoids-6.0.2/src/Data/Semigroup/Traversable.hs +formatted 5db895bd9aed semigroupoids-6.0.2/src/Data/Semigroup/Traversable/Class.hs +formatted 8288490eb6a8 semigroupoids-6.0.2/src/Data/Semigroupoid.hs +formatted b3380ca605a0 semigroupoids-6.0.2/src/Data/Semigroupoid/Categorical.hs +formatted 45153648a25d semigroupoids-6.0.2/src/Data/Semigroupoid/Dual.hs +formatted f1c21cb8613d semigroupoids-6.0.2/src/Data/Semigroupoid/Ob.hs +formatted b8cb23896bf9 semigroupoids-6.0.2/src/Data/Semigroupoid/Static.hs +formatted 9945f77c9069 semigroupoids-6.0.2/src/Data/Traversable/Instances.hs +formatted 4f91affffbe0 semigroupoids-6.0.2/src/Semigroupoids/Do.hs +formatted 689e1e042e62 semigroupoids-6.0.2/src/Semigroupoids/Internal.hs +formatted e865ae48f11b servant-0.20.3.0/Setup.hs +formatted 9153c9da89d5 servant-0.20.3.0/src/Servant/API.hs +formatted 6ca32413e226 servant-0.20.3.0/src/Servant/API/Alternative.hs +formatted c265b91e3c97 servant-0.20.3.0/src/Servant/API/BasicAuth.hs +formatted a2c409071755 servant-0.20.3.0/src/Servant/API/Capture.hs +formatted a15886878620 servant-0.20.3.0/src/Servant/API/ContentTypes.hs +formatted ae6eeb995066 servant-0.20.3.0/src/Servant/API/Description.hs +formatted 3529480c44cb servant-0.20.3.0/src/Servant/API/Empty.hs +formatted ca9f880fe9c3 servant-0.20.3.0/src/Servant/API/Experimental/Auth.hs +formatted 1cb7b7979a37 servant-0.20.3.0/src/Servant/API/Fragment.hs +formatted 0b0271e38424 servant-0.20.3.0/src/Servant/API/Generic.hs +formatted 6ace49e9ee6c servant-0.20.3.0/src/Servant/API/Header.hs +formatted a4120f74a189 servant-0.20.3.0/src/Servant/API/Host.hs +formatted 9add62e890f1 servant-0.20.3.0/src/Servant/API/HttpVersion.hs +formatted efd092f09057 servant-0.20.3.0/src/Servant/API/IsSecure.hs +formatted 714c99b4ea0e servant-0.20.3.0/src/Servant/API/Modifiers.hs +formatted 684bc7886ecb servant-0.20.3.0/src/Servant/API/MultiVerb.hs +formatted 56acb7471063 servant-0.20.3.0/src/Servant/API/NamedRoutes.hs +formatted 2a67c6814cd7 servant-0.20.3.0/src/Servant/API/QueryParam.hs +formatted c9e33c06dd4d servant-0.20.3.0/src/Servant/API/QueryString.hs +formatted d94765f780c5 servant-0.20.3.0/src/Servant/API/Range.hs +formatted 54177faefb7f servant-0.20.3.0/src/Servant/API/Raw.hs +formatted 0d8ceb92e030 servant-0.20.3.0/src/Servant/API/RemoteHost.hs +formatted fa0f8d364af9 servant-0.20.3.0/src/Servant/API/ReqBody.hs +formatted 8acf042b8234 servant-0.20.3.0/src/Servant/API/ResponseHeaders.hs +formatted c67668bb6c05 servant-0.20.3.0/src/Servant/API/ServerSentEvents.hs +formatted d944ce6b72bb servant-0.20.3.0/src/Servant/API/Status.hs +formatted 80b82bca3c39 servant-0.20.3.0/src/Servant/API/Stream.hs +formatted edf5b4aed88d servant-0.20.3.0/src/Servant/API/Sub.hs +formatted ff144efc7edd servant-0.20.3.0/src/Servant/API/TypeErrors.hs +formatted 29ad4adf0dc7 servant-0.20.3.0/src/Servant/API/TypeLevel.hs +formatted c0878f59a227 servant-0.20.3.0/src/Servant/API/TypeLevel/List.hs +formatted 9be4a4b0a678 servant-0.20.3.0/src/Servant/API/UVerb.hs +formatted 46da2eb7f65a servant-0.20.3.0/src/Servant/API/UVerb/Union.hs +formatted 635eed50f570 servant-0.20.3.0/src/Servant/API/Vault.hs +formatted 2dc0c94ac83c servant-0.20.3.0/src/Servant/API/Verbs.hs +formatted 5dcaa0e3d262 servant-0.20.3.0/src/Servant/API/WithNamedContext.hs +formatted c8d1802909fc servant-0.20.3.0/src/Servant/API/WithResource.hs +formatted 7bd50129afee servant-0.20.3.0/src/Servant/Links.hs +formatted 4a79910df177 servant-0.20.3.0/src/Servant/Test/ComprehensiveAPI.hs +formatted 72397d3bb59f servant-0.20.3.0/src/Servant/Types/Internal/Response.hs +formatted e57b2e66d9d5 servant-0.20.3.0/src/Servant/Types/SourceT.hs +formatted 8e01166db243 servant-0.20.3.0/test/Servant/API/ContentTypesSpec.hs +formatted 8d914b5e174f servant-0.20.3.0/test/Servant/API/ResponseHeadersSpec.hs +formatted 19481f24edd2 servant-0.20.3.0/test/Servant/API/StreamSpec.hs +formatted 4f1634d779c6 servant-0.20.3.0/test/Servant/LinksSpec.hs +formatted 2fbd14b119a4 servant-0.20.3.0/test/Spec.hs +formatted e865ae48f11b servant-server-0.20.3.0/Setup.hs +formatted e0bc38ee2107 servant-server-0.20.3.0/example/greet.hs +formatted a401126eeff8 servant-server-0.20.3.0/src/Servant.hs +formatted 9ef459de1886 servant-server-0.20.3.0/src/Servant/Server.hs +formatted 1f26409f3f2c servant-server-0.20.3.0/src/Servant/Server/Experimental/Auth.hs +formatted 6fc6eff93d47 servant-server-0.20.3.0/src/Servant/Server/Generic.hs +formatted a4686d4d8168 servant-server-0.20.3.0/src/Servant/Server/Internal.hs +formatted 6ece26e7e14b servant-server-0.20.3.0/src/Servant/Server/Internal/BasicAuth.hs +formatted 840da824ddc2 servant-server-0.20.3.0/src/Servant/Server/Internal/Context.hs +formatted f75d6b244e90 servant-server-0.20.3.0/src/Servant/Server/Internal/Delayed.hs +formatted b1e176cb1e12 servant-server-0.20.3.0/src/Servant/Server/Internal/DelayedIO.hs +formatted 577b2ebfe120 servant-server-0.20.3.0/src/Servant/Server/Internal/ErrorFormatter.hs +formatted a235c4a5477e servant-server-0.20.3.0/src/Servant/Server/Internal/Handler.hs +formatted bd96b8ecb097 servant-server-0.20.3.0/src/Servant/Server/Internal/ResponseRender.hs +formatted f0244940436b servant-server-0.20.3.0/src/Servant/Server/Internal/RouteResult.hs +formatted c383b059c7cd servant-server-0.20.3.0/src/Servant/Server/Internal/Router.hs +formatted 09cdf39e03b6 servant-server-0.20.3.0/src/Servant/Server/Internal/RoutingApplication.hs +formatted b15781d6d1a7 servant-server-0.20.3.0/src/Servant/Server/Internal/ServerError.hs +formatted 4be302b8cfbe servant-server-0.20.3.0/src/Servant/Server/StaticFiles.hs +formatted 7a929eb5f6c6 servant-server-0.20.3.0/src/Servant/Server/UVerb.hs +formatted d43150f68994 servant-server-0.20.3.0/src/Servant/Utils/StaticFiles.hs +formatted e9e090db95fa servant-server-0.20.3.0/test/Servant/ArbitraryMonadServerSpec.hs +formatted a92186c8737e servant-server-0.20.3.0/test/Servant/HoistSpec.hs +formatted 5a2bd30f3c12 servant-server-0.20.3.0/test/Servant/Server/ErrorSpec.hs +formatted 6f993e850de5 servant-server-0.20.3.0/test/Servant/Server/Internal/ContextSpec.hs +formatted 6979f09da111 servant-server-0.20.3.0/test/Servant/Server/Internal/RoutingApplicationSpec.hs +formatted ebf15aace7c8 servant-server-0.20.3.0/test/Servant/Server/RouterSpec.hs +formatted ca1d8b69c2d4 servant-server-0.20.3.0/test/Servant/Server/StaticFilesSpec.hs +formatted e9a7ef4fbb57 servant-server-0.20.3.0/test/Servant/Server/StreamingSpec.hs +formatted 6bd03c4fd0e6 servant-server-0.20.3.0/test/Servant/Server/UsingContextSpec.hs +formatted c68eea536d8f servant-server-0.20.3.0/test/Servant/Server/UsingContextSpec/TestCombinators.hs +formatted 52710abf0bdb servant-server-0.20.3.0/test/Servant/ServerSpec.hs +formatted 2fbd14b119a4 servant-server-0.20.3.0/test/Spec.hs +formatted e865ae48f11b shake-0.19.9/Setup.hs +formatted 85840851c997 shake-0.19.9/docs/manual/Shakefile.hs +formatted 659df897f906 shake-0.19.9/src/Development/Ninja/All.hs +formatted 3104f3ca6fe0 shake-0.19.9/src/Development/Ninja/Env.hs +formatted 7cb2becdc041 shake-0.19.9/src/Development/Ninja/Lexer.hs +formatted 750928680562 shake-0.19.9/src/Development/Ninja/Parse.hs +formatted c0a33fcdb116 shake-0.19.9/src/Development/Ninja/Type.hs +formatted 1e091717f0e4 shake-0.19.9/src/Development/Shake.hs +formatted 5a0ba406abd6 shake-0.19.9/src/Development/Shake/Classes.hs +formatted 7ae91e4024b4 shake-0.19.9/src/Development/Shake/Command.hs +formatted 5959e8996e24 shake-0.19.9/src/Development/Shake/Config.hs +formatted e9d594f06006 shake-0.19.9/src/Development/Shake/Database.hs +formatted 6a9f5286dbbd shake-0.19.9/src/Development/Shake/FilePath.hs +formatted 4da3a2b0f58b shake-0.19.9/src/Development/Shake/Forward.hs +formatted 7718900e8a44 shake-0.19.9/src/Development/Shake/Internal/Args.hs +formatted 176c017dbbd9 shake-0.19.9/src/Development/Shake/Internal/CmdOption.hs +formatted aaf913d99d5c shake-0.19.9/src/Development/Shake/Internal/CompactUI.hs +formatted f6bbbd69a477 shake-0.19.9/src/Development/Shake/Internal/Core/Action.hs +formatted 66a65bc9bc34 shake-0.19.9/src/Development/Shake/Internal/Core/Build.hs +formatted 4e75290b3b44 shake-0.19.9/src/Development/Shake/Internal/Core/Database.hs +formatted 3e4afc55b835 shake-0.19.9/src/Development/Shake/Internal/Core/Monad.hs +formatted e0107f7baea9 shake-0.19.9/src/Development/Shake/Internal/Core/Pool.hs +formatted f6fa2073bad8 shake-0.19.9/src/Development/Shake/Internal/Core/Rules.hs +formatted cf3d65d83229 shake-0.19.9/src/Development/Shake/Internal/Core/Run.hs +formatted 5af9f97a9e29 shake-0.19.9/src/Development/Shake/Internal/Core/Storage.hs +formatted ab347cc10d7a shake-0.19.9/src/Development/Shake/Internal/Core/Types.hs +formatted 30ee262fedde shake-0.19.9/src/Development/Shake/Internal/Demo.hs +formatted 1afe6f5f82c8 shake-0.19.9/src/Development/Shake/Internal/Derived.hs +formatted 09c8188aa053 shake-0.19.9/src/Development/Shake/Internal/Errors.hs +declined - shake-0.19.9/src/Development/Shake/Internal/FileInfo.hs +formatted 759fa2b54278 shake-0.19.9/src/Development/Shake/Internal/FileName.hs +formatted 4d3c15baa1e4 shake-0.19.9/src/Development/Shake/Internal/FilePattern.hs +formatted 1e054a94085b shake-0.19.9/src/Development/Shake/Internal/History/Bloom.hs +formatted 01551ed3cbf4 shake-0.19.9/src/Development/Shake/Internal/History/Cloud.hs +formatted 249ed8efaa13 shake-0.19.9/src/Development/Shake/Internal/History/Network.hs +formatted 4f537be442b0 shake-0.19.9/src/Development/Shake/Internal/History/Serialise.hs +formatted 14a6f9c117dc shake-0.19.9/src/Development/Shake/Internal/History/Server.hs +formatted bf25365673d0 shake-0.19.9/src/Development/Shake/Internal/History/Shared.hs +declined - shake-0.19.9/src/Development/Shake/Internal/History/Symlink.hs +formatted 765062af5b1e shake-0.19.9/src/Development/Shake/Internal/History/Types.hs +formatted 7a68e11d3f88 shake-0.19.9/src/Development/Shake/Internal/Options.hs +formatted c8651e83c45c shake-0.19.9/src/Development/Shake/Internal/Paths.hs +formatted 208cc40e49ba shake-0.19.9/src/Development/Shake/Internal/Profile.hs +declined - shake-0.19.9/src/Development/Shake/Internal/Progress.hs +formatted c9971fdca3e5 shake-0.19.9/src/Development/Shake/Internal/Resource.hs +formatted 5733144919c3 shake-0.19.9/src/Development/Shake/Internal/Rules/Default.hs +formatted 8a63ca21fcda shake-0.19.9/src/Development/Shake/Internal/Rules/Directory.hs +formatted f000c73ea4b7 shake-0.19.9/src/Development/Shake/Internal/Rules/File.hs +formatted 6e7322f7f7c1 shake-0.19.9/src/Development/Shake/Internal/Rules/Files.hs +formatted 18637b215cdb shake-0.19.9/src/Development/Shake/Internal/Rules/Oracle.hs +formatted b0d13ac0a3a9 shake-0.19.9/src/Development/Shake/Internal/Rules/OrderOnly.hs +formatted 941f5cc2dd1d shake-0.19.9/src/Development/Shake/Internal/Rules/Rerun.hs +formatted 25ffba5bb7e7 shake-0.19.9/src/Development/Shake/Internal/Value.hs +formatted 4f57cc655ba3 shake-0.19.9/src/Development/Shake/Rule.hs +formatted 2df0d77b7d5c shake-0.19.9/src/Development/Shake/Util.hs +formatted 796b5a76fb8c shake-0.19.9/src/General/Bilist.hs +formatted a2e9bfc4e206 shake-0.19.9/src/General/Binary.hs +formatted 0208bf728797 shake-0.19.9/src/General/Chunks.hs +formatted d8ae6dd155de shake-0.19.9/src/General/Cleanup.hs +declined - shake-0.19.9/src/General/EscCodes.hs +formatted 5c8c7f7e8bf2 shake-0.19.9/src/General/Extra.hs +formatted 6ac31a44af53 shake-0.19.9/src/General/Fence.hs +declined - shake-0.19.9/src/General/FileLock.hs +formatted 4813c23ad42d shake-0.19.9/src/General/GetOpt.hs +formatted 5efc029ad726 shake-0.19.9/src/General/Ids.hs +formatted 9126ed0fbd34 shake-0.19.9/src/General/Intern.hs +formatted 5049f87854f9 shake-0.19.9/src/General/ListBuilder.hs +formatted 54fa4898327b shake-0.19.9/src/General/Makefile.hs +formatted e1829b34f218 shake-0.19.9/src/General/Pool.hs +formatted 4e88a21092ea shake-0.19.9/src/General/Process.hs +formatted 0d39543216b1 shake-0.19.9/src/General/Template.hs +formatted 20e74944695a shake-0.19.9/src/General/Thread.hs +formatted b9b9368bdf92 shake-0.19.9/src/General/Timing.hs +formatted f1cfb5928cdc shake-0.19.9/src/General/TypeMap.hs +formatted 8d69ed0989cc shake-0.19.9/src/General/Wait.hs +formatted 4743f12ee1b5 shake-0.19.9/src/Paths.hs +formatted 80112aa74398 shake-0.19.9/src/Run.hs +formatted e59791013e00 shake-0.19.9/src/Test.hs +formatted 8559d6daa99e shake-0.19.9/src/Test/Basic.hs +formatted 93ef4d632053 shake-0.19.9/src/Test/Batch.hs +formatted 9817e09728fc shake-0.19.9/src/Test/Benchmark.hs +formatted 72e8b4ab4dea shake-0.19.9/src/Test/Builtin.hs +formatted 48ec6eca2417 shake-0.19.9/src/Test/BuiltinOverride.hs +formatted 10efc06e6c7b shake-0.19.9/src/Test/C.hs +formatted 53e433c2fd6d shake-0.19.9/src/Test/Cache.hs +formatted 2d7ccbb45ced shake-0.19.9/src/Test/Cleanup.hs +formatted 448b76c4e03f shake-0.19.9/src/Test/CloseFileHandles.hs +formatted 52e8e06b790c shake-0.19.9/src/Test/Command.hs +formatted 5ea96ce5a74d shake-0.19.9/src/Test/Config.hs +formatted 42fd949d6eef shake-0.19.9/src/Test/Database.hs +formatted e8ca948ce33e shake-0.19.9/src/Test/Digest.hs +formatted 9b70158e614d shake-0.19.9/src/Test/Directory.hs +formatted 6bbe2ff03da5 shake-0.19.9/src/Test/Docs.hs +formatted 7425a9004035 shake-0.19.9/src/Test/Errors.hs +formatted b698eeb22c5b shake-0.19.9/src/Test/Existence.hs +formatted 33dfd1039065 shake-0.19.9/src/Test/FileLock.hs +formatted 53f9a23d9106 shake-0.19.9/src/Test/FilePath.hs +formatted f735f16c91d5 shake-0.19.9/src/Test/FilePattern.hs +formatted 7f088d1e23e6 shake-0.19.9/src/Test/Files.hs +formatted f46b5feb3e77 shake-0.19.9/src/Test/Forward.hs +formatted 07a41b0c82df shake-0.19.9/src/Test/History.hs +formatted a6278c0f744f shake-0.19.9/src/Test/Journal.hs +formatted ea3088aef841 shake-0.19.9/src/Test/Lint.hs +formatted abb6b38a5148 shake-0.19.9/src/Test/Live.hs +formatted b1f4f9102098 shake-0.19.9/src/Test/Manual.hs +formatted 0ea86eab061d shake-0.19.9/src/Test/Match.hs +formatted 3358afb343e9 shake-0.19.9/src/Test/Monad.hs +formatted 30eaa5d85dba shake-0.19.9/src/Test/Ninja.hs +formatted 78f51e13afdb shake-0.19.9/src/Test/Oracle.hs +formatted 3a29cbe0f415 shake-0.19.9/src/Test/OrderOnly.hs +formatted 11c7d4112a98 shake-0.19.9/src/Test/Parallel.hs +formatted af1e17f9eab1 shake-0.19.9/src/Test/Pool.hs +formatted 278a912d8e40 shake-0.19.9/src/Test/Progress.hs +formatted 8f84d993fd5b shake-0.19.9/src/Test/Random.hs +formatted 2cbfb37c7d59 shake-0.19.9/src/Test/Rebuild.hs +formatted 685ecba8ab37 shake-0.19.9/src/Test/Reschedule.hs +formatted a4beab4d5e04 shake-0.19.9/src/Test/Resources.hs +formatted 4c2e03f5a06d shake-0.19.9/src/Test/Self.hs +formatted f161b0f0a749 shake-0.19.9/src/Test/SelfMake.hs +formatted ce7a14c40a6c shake-0.19.9/src/Test/Tar.hs +formatted 010efc5cef7a shake-0.19.9/src/Test/Targets.hs +formatted 2ada3fd9cfe5 shake-0.19.9/src/Test/Thread.hs +formatted 54ac2eb76326 shake-0.19.9/src/Test/Tup.hs +formatted 306bd01403f4 shake-0.19.9/src/Test/Type.hs +formatted 068337f03a57 shake-0.19.9/src/Test/Unicode.hs +formatted 312e45ba1b16 shake-0.19.9/src/Test/Util.hs +formatted 6649fd7b7e4a shake-0.19.9/src/Test/Verbosity.hs +formatted f32aa5af75ac shake-0.19.9/src/Test/Version.hs +formatted a7151db2ed5c split-0.2.5/src/Data/List/Split.hs +formatted 63fb58665984 split-0.2.5/src/Data/List/Split/Internals.hs +formatted 1c394a59af79 split-0.2.5/test/Properties.hs +formatted e865ae48f11b stack-9.9.9/Setup.hs +formatted e865ae48f11b stack-9.9.9/new-template/Setup.hs +formatted 76b6ff5a6856 stack-9.9.9/new-template/app/Main.hs +formatted b206a21d3b3c stack-9.9.9/new-template/src/Lib.hs +formatted ef8d1c0c14bd stack-9.9.9/new-template/test/Spec.hs +formatted 2cb36e6bb1bb stack-9.9.9/src/Control/Concurrent/Execute.hs +formatted de0bbff44bba stack-9.9.9/src/Data/Aeson/Extended.hs +formatted 45b24cbb6885 stack-9.9.9/src/Data/Attoparsec/Args.hs +formatted 6be772a6002d stack-9.9.9/src/Data/Attoparsec/Combinators.hs +formatted e4f1165dc10b stack-9.9.9/src/Data/Binary/VersionTagged.hs +formatted b0799314dce2 stack-9.9.9/src/Data/Maybe/Extra.hs +formatted 8740a5fcb2ef stack-9.9.9/src/Data/Set/Monad.hs +formatted 40389f299346 stack-9.9.9/src/Network/HTTP/Download.hs +formatted 9e93dca6ce44 stack-9.9.9/src/Network/HTTP/Download/Verified.hs +formatted d7a0d294e3c7 stack-9.9.9/src/Options/Applicative/Args.hs +formatted 0116483c0e39 stack-9.9.9/src/Options/Applicative/Builder/Extra.hs +formatted 35d5981b158d stack-9.9.9/src/Path/Find.hs +formatted eafb883091d5 stack-9.9.9/src/Path/IO.hs +formatted 2df07688f5ed stack-9.9.9/src/Stack/Build.hs +formatted bdc4f36f2c62 stack-9.9.9/src/Stack/Build/Cache.hs +formatted 846d984fa5a3 stack-9.9.9/src/Stack/Build/ConstructPlan.hs +formatted 335c39b2a711 stack-9.9.9/src/Stack/Build/Execute.hs +formatted c154ec698482 stack-9.9.9/src/Stack/Build/Haddock.hs +formatted d45c6e3e96c6 stack-9.9.9/src/Stack/Build/Installed.hs +formatted 8f851999c795 stack-9.9.9/src/Stack/Build/Source.hs +formatted 4d0e41188711 stack-9.9.9/src/Stack/Build/Types.hs +formatted c422573c7530 stack-9.9.9/src/Stack/BuildPlan.hs +formatted dc215b9523e2 stack-9.9.9/src/Stack/Config.hs +formatted db186c830bf3 stack-9.9.9/src/Stack/Constants.hs +formatted 655fc3d77d9a stack-9.9.9/src/Stack/Docker.hs +formatted 7dac02fa726c stack-9.9.9/src/Stack/Docker/GlobalDB.hs +formatted 7d15eaae39ff stack-9.9.9/src/Stack/Dot.hs +formatted e3fe02818737 stack-9.9.9/src/Stack/Exec.hs +formatted 44beb7f3ec53 stack-9.9.9/src/Stack/Fetch.hs +formatted 667b523cf3db stack-9.9.9/src/Stack/GhcPkg.hs +formatted 733ecb413de7 stack-9.9.9/src/Stack/Init.hs +formatted 9f228f8da7ce stack-9.9.9/src/Stack/New.hs +formatted ebbee12a77fc stack-9.9.9/src/Stack/Package.hs +formatted a4d6c3332390 stack-9.9.9/src/Stack/PackageDump.hs +formatted 2b3785c57355 stack-9.9.9/src/Stack/PackageIndex.hs +formatted 2814387b2b76 stack-9.9.9/src/Stack/Repl.hs +formatted 8d70e82cb03c stack-9.9.9/src/Stack/Setup.hs +formatted 68c48310e4ce stack-9.9.9/src/Stack/Solver.hs +formatted ebbf896669e4 stack-9.9.9/src/Stack/Types.hs +formatted 4f7543f1a686 stack-9.9.9/src/Stack/Types/BuildPlan.hs +formatted 38eedeb37ea4 stack-9.9.9/src/Stack/Types/Config.hs +formatted dc9a426c72cd stack-9.9.9/src/Stack/Types/Docker.hs +formatted cd2bb0d685de stack-9.9.9/src/Stack/Types/FlagName.hs +formatted d8f8b074a086 stack-9.9.9/src/Stack/Types/GhcPkgId.hs +formatted bd4be7dcc823 stack-9.9.9/src/Stack/Types/Internal.hs +formatted 6f80f79fae7e stack-9.9.9/src/Stack/Types/PackageIdentifier.hs +formatted 88a4f8bd73e5 stack-9.9.9/src/Stack/Types/PackageName.hs +formatted bcc9e5fa699d stack-9.9.9/src/Stack/Types/StackT.hs +formatted 403717ac1cf2 stack-9.9.9/src/Stack/Types/Version.hs +formatted 2f4855580908 stack-9.9.9/src/Stack/Upgrade.hs +formatted e1e4da453112 stack-9.9.9/src/Stack/Upload.hs +formatted 85d5e680f53b stack-9.9.9/src/System/Process/Log.hs +formatted 015e3efd2d86 stack-9.9.9/src/System/Process/PagerEditor.hs +formatted 3d6b7b0e58e8 stack-9.9.9/src/System/Process/Read.hs +formatted c40dad9ce8ee stack-9.9.9/src/System/Process/Run.hs +formatted fc7e2b25ab4e stack-9.9.9/src/main/Main.hs +formatted 4eec70869c80 stack-9.9.9/src/main/Plugins.hs +formatted 50b246d28182 stack-9.9.9/src/main/Plugins/Commands.hs +formatted 65c8c298f7aa stack-9.9.9/src/test/Spec.hs +formatted bbf9464a53ee stack-9.9.9/src/test/Stack/ArgsSpec.hs +formatted 41ea23b8880f stack-9.9.9/src/test/Stack/Build/ExecuteSpec.hs +formatted 38d5f430f742 stack-9.9.9/src/test/Stack/BuildPlanSpec.hs +formatted 8f505819b19a stack-9.9.9/src/test/Stack/ConfigSpec.hs +formatted 2d4cbcc98b0c stack-9.9.9/src/test/Stack/PackageDumpSpec.hs +formatted fd075df62297 stack-9.9.9/src/test/Test.hs +formatted 53953d153dfa stack-9.9.9/test/integration/Spec.hs +formatted 56e4e5258116 statistics-0.16.5.0/Statistics/Autocorrelation.hs +formatted bda03074d5aa statistics-0.16.5.0/Statistics/ConfidenceInt.hs +formatted 069d7156f594 statistics-0.16.5.0/Statistics/Correlation.hs +formatted 9ba74f547b39 statistics-0.16.5.0/Statistics/Correlation/Kendall.hs +formatted bbd4e3259f36 statistics-0.16.5.0/Statistics/Distribution.hs +formatted ae8ad80251ff statistics-0.16.5.0/Statistics/Distribution/Beta.hs +formatted 7b32fc5b6cfc statistics-0.16.5.0/Statistics/Distribution/Binomial.hs +formatted 23f140cdf9bc statistics-0.16.5.0/Statistics/Distribution/CauchyLorentz.hs +formatted dc30bfda499d statistics-0.16.5.0/Statistics/Distribution/ChiSquared.hs +formatted f4734696df71 statistics-0.16.5.0/Statistics/Distribution/DiscreteUniform.hs +formatted cc3d61a22aa0 statistics-0.16.5.0/Statistics/Distribution/Exponential.hs +formatted 5d35b356cb29 statistics-0.16.5.0/Statistics/Distribution/FDistribution.hs +formatted 1258f180d7c0 statistics-0.16.5.0/Statistics/Distribution/Gamma.hs +formatted 97a9584986c7 statistics-0.16.5.0/Statistics/Distribution/Geometric.hs +formatted e05ef1359929 statistics-0.16.5.0/Statistics/Distribution/Hypergeometric.hs +formatted ca93eabbbf15 statistics-0.16.5.0/Statistics/Distribution/Laplace.hs +formatted 1e363f04365e statistics-0.16.5.0/Statistics/Distribution/Lognormal.hs +formatted f5cce916fd78 statistics-0.16.5.0/Statistics/Distribution/NegativeBinomial.hs +formatted fb17da6ed19d statistics-0.16.5.0/Statistics/Distribution/Normal.hs +formatted 1bbb63345a51 statistics-0.16.5.0/Statistics/Distribution/Poisson.hs +formatted fb54f6de83df statistics-0.16.5.0/Statistics/Distribution/Poisson/Internal.hs +formatted f2dd661c1f1a statistics-0.16.5.0/Statistics/Distribution/StudentT.hs +formatted 06505b01e90a statistics-0.16.5.0/Statistics/Distribution/Transform.hs +formatted ead3df94c4d5 statistics-0.16.5.0/Statistics/Distribution/Uniform.hs +formatted bd8bb4f92c76 statistics-0.16.5.0/Statistics/Distribution/Weibull.hs +formatted 1a6eda2dc778 statistics-0.16.5.0/Statistics/Function.hs +formatted 4ce5ca3ee348 statistics-0.16.5.0/Statistics/Internal.hs +formatted 86e8d1a0a535 statistics-0.16.5.0/Statistics/Quantile.hs +formatted 4eb8961889ae statistics-0.16.5.0/Statistics/Regression.hs +formatted 535c5c96b342 statistics-0.16.5.0/Statistics/Resampling.hs +formatted 76d271403a9e statistics-0.16.5.0/Statistics/Resampling/Bootstrap.hs +formatted cc05168e10be statistics-0.16.5.0/Statistics/Sample.hs +formatted 24ce2ba6d88a statistics-0.16.5.0/Statistics/Sample/Histogram.hs +formatted cab9e68a7e21 statistics-0.16.5.0/Statistics/Sample/Internal.hs +formatted 43f665ddfdd4 statistics-0.16.5.0/Statistics/Sample/KernelDensity.hs +formatted 57cb926959b9 statistics-0.16.5.0/Statistics/Sample/KernelDensity/Simple.hs +formatted e7d037eb7906 statistics-0.16.5.0/Statistics/Sample/Normalize.hs +formatted 1242733971ab statistics-0.16.5.0/Statistics/Sample/Powers.hs +formatted a2b672b48aca statistics-0.16.5.0/Statistics/Test/Bartlett.hs +formatted da8b73ff5c88 statistics-0.16.5.0/Statistics/Test/ChiSquared.hs +formatted 4990518d53f6 statistics-0.16.5.0/Statistics/Test/Internal.hs +formatted e5d5a7822558 statistics-0.16.5.0/Statistics/Test/KolmogorovSmirnov.hs +formatted 68068b68b9a0 statistics-0.16.5.0/Statistics/Test/KruskalWallis.hs +formatted 6e9db487a147 statistics-0.16.5.0/Statistics/Test/Levene.hs +formatted a4c13293539e statistics-0.16.5.0/Statistics/Test/MannWhitneyU.hs +formatted 63ad198bde51 statistics-0.16.5.0/Statistics/Test/StudentT.hs +formatted 8222073f1e45 statistics-0.16.5.0/Statistics/Test/Types.hs +formatted f3c789b5cb44 statistics-0.16.5.0/Statistics/Test/WilcoxonT.hs +formatted 4dc98e7c6347 statistics-0.16.5.0/Statistics/Transform.hs +formatted f4cfb5a2aebb statistics-0.16.5.0/Statistics/Types.hs +formatted f071cb4c4814 statistics-0.16.5.0/Statistics/Types/Internal.hs +formatted b5402a2dc355 statistics-0.16.5.0/bench-papi/Bench.hs +formatted 3963835f0889 statistics-0.16.5.0/bench-time/Bench.hs +formatted 61d4105d3456 statistics-0.16.5.0/benchmark/Main.hs +formatted d80f7bf6f96d statistics-0.16.5.0/examples/kde/KDE.hs +formatted dcea40eeb511 statistics-0.16.5.0/tests/Tests/ApproxEq.hs +formatted 2ae25961f71d statistics-0.16.5.0/tests/Tests/Correlation.hs +formatted b0317e3f9b24 statistics-0.16.5.0/tests/Tests/Distribution.hs +formatted 3d4db70bc7ca statistics-0.16.5.0/tests/Tests/ExactDistribution.hs +formatted 299f43f28485 statistics-0.16.5.0/tests/Tests/Function.hs +formatted 9c5a618f3bf1 statistics-0.16.5.0/tests/Tests/Helpers.hs +formatted fec77bb7c2ff statistics-0.16.5.0/tests/Tests/KDE.hs +formatted cf822ef362eb statistics-0.16.5.0/tests/Tests/Matrix.hs +formatted 27d419347379 statistics-0.16.5.0/tests/Tests/Matrix/Types.hs +formatted ea56dc62a57a statistics-0.16.5.0/tests/Tests/NonParametric.hs +formatted 4d0172724882 statistics-0.16.5.0/tests/Tests/NonParametric/Table.hs +formatted 65adfee8e313 statistics-0.16.5.0/tests/Tests/Orphanage.hs +formatted bc01b981cd07 statistics-0.16.5.0/tests/Tests/Parametric.hs +formatted bb2edc2f982d statistics-0.16.5.0/tests/Tests/Quantile.hs +formatted 4e08d3c82170 statistics-0.16.5.0/tests/Tests/Serialization.hs +formatted d60faa0d5f6c statistics-0.16.5.0/tests/Tests/Transform.hs +formatted 55f699624c9d statistics-0.16.5.0/tests/doctest.hs +formatted f0e3d45c9159 statistics-0.16.5.0/tests/tests.hs +formatted 2c4811cee336 stm-2.5.3.1/Control/Concurrent/STM.hs +formatted fd81deb0a4a0 stm-2.5.3.1/Control/Concurrent/STM/TArray.hs +formatted 9e9c5d20cb7c stm-2.5.3.1/Control/Concurrent/STM/TBQueue.hs +formatted 643c4c4304ca stm-2.5.3.1/Control/Concurrent/STM/TChan.hs +formatted 5de1c73d983a stm-2.5.3.1/Control/Concurrent/STM/TMVar.hs +formatted 4fabec7ab606 stm-2.5.3.1/Control/Concurrent/STM/TQueue.hs +formatted 0167cfd0c06a stm-2.5.3.1/Control/Concurrent/STM/TSem.hs +formatted 6a0ece958ded stm-2.5.3.1/Control/Concurrent/STM/TVar.hs +partly-checked 6aa0575474c4 stm-2.5.3.1/Control/Monad/STM.hs +formatted 6aecb29a12ab stm-2.5.3.1/Control/Sequential/STM.hs +formatted 7474b7e1d4f5 stm-2.5.3.1/Setup.hs +formatted e290291970ca stm-2.5.3.1/testsuite/src/Issue17.hs +formatted c3343c4d48cb stm-2.5.3.1/testsuite/src/Issue9.hs +formatted 9159857aaf7c stm-2.5.3.1/testsuite/src/Main.hs +formatted 5a7bdca5eb2f stm-2.5.3.1/testsuite/src/Stm052.hs +formatted 9b30ce222d29 stm-2.5.3.1/testsuite/src/Stm064.hs +formatted 0f86f9b94d82 stm-2.5.3.1/testsuite/src/Stm065.hs +formatted 0872066614e0 swagger2-2.9.1/Setup.hs +formatted e53974342c33 swagger2-2.9.1/examples/hackage.hs +formatted bbac1d7e9767 swagger2-2.9.1/src/Data/HashMap/Strict/InsOrd/Compat.hs +formatted d71d272f220f swagger2-2.9.1/src/Data/Swagger.hs +formatted 3a66f17ffe6b swagger2-2.9.1/src/Data/Swagger/Declare.hs +formatted 3d36b503c6bf swagger2-2.9.1/src/Data/Swagger/Internal.hs +formatted 7dfa5b7b4803 swagger2-2.9.1/src/Data/Swagger/Internal/AesonUtils.hs +formatted be2b0df4ab34 swagger2-2.9.1/src/Data/Swagger/Internal/ParamSchema.hs +formatted e4da8109511e swagger2-2.9.1/src/Data/Swagger/Internal/Schema.hs +formatted eb4f3c8c3253 swagger2-2.9.1/src/Data/Swagger/Internal/Schema/Validation.hs +formatted 185e997df260 swagger2-2.9.1/src/Data/Swagger/Internal/TypeShape.hs +formatted abc8c961e8d8 swagger2-2.9.1/src/Data/Swagger/Internal/Utils.hs +formatted fac02daa06aa swagger2-2.9.1/src/Data/Swagger/Lens.hs +formatted 69c86ada5be4 swagger2-2.9.1/src/Data/Swagger/Operation.hs +formatted 385ee16b2de5 swagger2-2.9.1/src/Data/Swagger/Optics.hs +formatted b74d3f8d9ea4 swagger2-2.9.1/src/Data/Swagger/ParamSchema.hs +formatted 19a9a7c3a0de swagger2-2.9.1/src/Data/Swagger/Schema.hs +formatted 59f835605e15 swagger2-2.9.1/src/Data/Swagger/Schema/Generator.hs +formatted 7770e1fe2353 swagger2-2.9.1/src/Data/Swagger/Schema/Validation.hs +formatted 2fd313eb8746 swagger2-2.9.1/src/Data/Swagger/SchemaOptions.hs +formatted 151ebac1c141 swagger2-2.9.1/test/Data/Swagger/CommonTestTypes.hs +formatted 88ae3e07f1d6 swagger2-2.9.1/test/Data/Swagger/ParamSchemaSpec.hs +formatted ba8d29dd4929 swagger2-2.9.1/test/Data/Swagger/Schema/GeneratorSpec.hs +formatted 2bbe75a01f34 swagger2-2.9.1/test/Data/Swagger/Schema/ValidationSpec.hs +formatted bc07fee39679 swagger2-2.9.1/test/Data/Swagger/SchemaSpec.hs +formatted b59e746b8895 swagger2-2.9.1/test/Data/SwaggerSpec.hs +formatted 2fbd14b119a4 swagger2-2.9.1/test/Spec.hs +formatted 1534dc51af48 swagger2-2.9.1/test/SpecCommon.hs +formatted cc17d35cb01d swagger2-2.9.1/test/doctests.hs +formatted 2620b9109dd2 tasty-1.5.4/Control/Concurrent/Async.hs +formatted e865ae48f11b tasty-1.5.4/Setup.hs +formatted 02df8ffe2eb3 tasty-1.5.4/Test/Tasty.hs +formatted 244024ebd276 tasty-1.5.4/Test/Tasty/CmdLine.hs +formatted aaf8f6f4fdaf tasty-1.5.4/Test/Tasty/Core.hs +formatted dd00b52edeb7 tasty-1.5.4/Test/Tasty/Ingredients.hs +formatted 9e13d30f1aac tasty-1.5.4/Test/Tasty/Ingredients/Basic.hs +formatted 4ed0611c5431 tasty-1.5.4/Test/Tasty/Ingredients/ConsoleReporter.hs +formatted 8c6cf8ae3d46 tasty-1.5.4/Test/Tasty/Ingredients/IncludingOptions.hs +formatted 095b09b1c146 tasty-1.5.4/Test/Tasty/Ingredients/ListTests.hs +formatted 26649d291142 tasty-1.5.4/Test/Tasty/Options.hs +formatted ebd9fd9c2ca5 tasty-1.5.4/Test/Tasty/Options/Core.hs +formatted d9fbf61e13b4 tasty-1.5.4/Test/Tasty/Options/Env.hs +formatted bc3c7e134e5c tasty-1.5.4/Test/Tasty/Parallel.hs +formatted d8b2acdcc674 tasty-1.5.4/Test/Tasty/Patterns.hs +formatted 0d97fca4d8c9 tasty-1.5.4/Test/Tasty/Patterns/Eval.hs +formatted 4d5e43449879 tasty-1.5.4/Test/Tasty/Patterns/Expr.hs +formatted 29b2bd9b3c0c tasty-1.5.4/Test/Tasty/Patterns/Parser.hs +formatted 3b88b836a8da tasty-1.5.4/Test/Tasty/Patterns/Printer.hs +formatted 76352e15e8e6 tasty-1.5.4/Test/Tasty/Patterns/Types.hs +formatted b2ce3b3d2ba6 tasty-1.5.4/Test/Tasty/Providers.hs +formatted 1e9dd494aa0d tasty-1.5.4/Test/Tasty/Providers/ConsoleFormat.hs +formatted 00b00e15f6b6 tasty-1.5.4/Test/Tasty/Run.hs +formatted cb5862c8ea8c tasty-1.5.4/Test/Tasty/Runners.hs +formatted 2b0086f6772b tasty-1.5.4/Test/Tasty/Runners/Reducers.hs +formatted b1a27c0f0bde tasty-1.5.4/Test/Tasty/Runners/Utils.hs +formatted e865ae48f11b tensorflow-0.2.0.1/Setup.hs +formatted 1f1f98c9417e tensorflow-0.2.0.1/src/TensorFlow/Build.hs +formatted 6a8867b44ef1 tensorflow-0.2.0.1/src/TensorFlow/BuildOp.hs +formatted 77489c8b8f87 tensorflow-0.2.0.1/src/TensorFlow/ControlFlow.hs +formatted 4cc5cc869f78 tensorflow-0.2.0.1/src/TensorFlow/Core.hs +formatted 76a2093eefd8 tensorflow-0.2.0.1/src/TensorFlow/Internal/FFI.hs +formatted 62d7a0995301 tensorflow-0.2.0.1/src/TensorFlow/Internal/VarInt.hs +formatted 33a0218dc730 tensorflow-0.2.0.1/src/TensorFlow/Nodes.hs +formatted 575aa8d6acdd tensorflow-0.2.0.1/src/TensorFlow/Output.hs +formatted 969822ad8386 tensorflow-0.2.0.1/src/TensorFlow/Session.hs +formatted 2456b562c83a tensorflow-0.2.0.1/src/TensorFlow/Tensor.hs +formatted 60f3e396af96 tensorflow-0.2.0.1/src/TensorFlow/Types.hs +formatted 7786d8f90a48 tensorflow-0.2.0.1/tests/FFITest.hs +formatted 0f5db84dd77b tensorflow-0.2.0.1/tests/VarIntTest.hs +formatted 8ae0364c5862 text-2.1.4/benchmarks/haskell/Benchmarks.hs +formatted ffe091bc4536 text-2.1.4/benchmarks/haskell/Benchmarks/Builder.hs +formatted 46dcd64eb8e5 text-2.1.4/benchmarks/haskell/Benchmarks/Concat.hs +formatted 1e546a146930 text-2.1.4/benchmarks/haskell/Benchmarks/DecodeUtf8.hs +formatted 41909e2de312 text-2.1.4/benchmarks/haskell/Benchmarks/EncodeUtf8.hs +formatted 919f36b12c57 text-2.1.4/benchmarks/haskell/Benchmarks/Equality.hs +formatted a5d1f5795b29 text-2.1.4/benchmarks/haskell/Benchmarks/FileRead.hs +formatted 09b54ec2d23a text-2.1.4/benchmarks/haskell/Benchmarks/FileWrite.hs +formatted ad27e899bf04 text-2.1.4/benchmarks/haskell/Benchmarks/FoldLines.hs +formatted 983d6f9117cd text-2.1.4/benchmarks/haskell/Benchmarks/Micro.hs +formatted 78b2688949ff text-2.1.4/benchmarks/haskell/Benchmarks/Multilang.hs +formatted 6ee308d7049c text-2.1.4/benchmarks/haskell/Benchmarks/Programs/BigTable.hs +formatted b1d195224e1a text-2.1.4/benchmarks/haskell/Benchmarks/Programs/Cut.hs +formatted 2814a67c6d1b text-2.1.4/benchmarks/haskell/Benchmarks/Programs/Fold.hs +formatted 2cebf4fe82ba text-2.1.4/benchmarks/haskell/Benchmarks/Programs/Sort.hs +formatted d9f35273ed3a text-2.1.4/benchmarks/haskell/Benchmarks/Programs/StripTags.hs +formatted 760d861cf866 text-2.1.4/benchmarks/haskell/Benchmarks/Programs/Throughput.hs +formatted 5126bd0f0a93 text-2.1.4/benchmarks/haskell/Benchmarks/Pure.hs +formatted e54e95cc30f1 text-2.1.4/benchmarks/haskell/Benchmarks/ReadNumbers.hs +formatted bf7477bd4934 text-2.1.4/benchmarks/haskell/Benchmarks/Replace.hs +formatted 36cf43ee1086 text-2.1.4/benchmarks/haskell/Benchmarks/Search.hs +formatted ce632d47d038 text-2.1.4/benchmarks/haskell/Benchmarks/Stream.hs +formatted 582c824b5ff5 text-2.1.4/benchmarks/haskell/Benchmarks/WordFrequencies.hs +formatted 352931675b25 text-2.1.4/scripts/ApiCompare.hs +formatted 227860122661 text-2.1.4/scripts/Arsec.hs +formatted a2272b1457ad text-2.1.4/scripts/CaseFolding.hs +formatted a0bdad468ca4 text-2.1.4/scripts/CaseMapping.hs +formatted 50cd030932e1 text-2.1.4/scripts/SpecialCasing.hs +formatted d775bb623580 text-2.1.4/scripts/UnicodeData.hs +partly-checked 08b3c96288dc text-2.1.4/src/Data/Text.hs +formatted 5b72823ffe98 text-2.1.4/src/Data/Text/Array.hs +formatted 4970b89f4e7e text-2.1.4/src/Data/Text/Encoding.hs +formatted d6231f7ebe99 text-2.1.4/src/Data/Text/Encoding/Error.hs +formatted 7580816061c0 text-2.1.4/src/Data/Text/Foreign.hs +formatted d1ee1d8d8964 text-2.1.4/src/Data/Text/IO.hs +formatted 8c24fec0de81 text-2.1.4/src/Data/Text/IO/Utf8.hs +formatted 8c62dc2df371 text-2.1.4/src/Data/Text/Internal.hs +formatted 48c631518261 text-2.1.4/src/Data/Text/Internal/ArrayUtils.hs +formatted e5f93165747b text-2.1.4/src/Data/Text/Internal/Builder.hs +formatted 3a05c951a914 text-2.1.4/src/Data/Text/Internal/Builder/Functions.hs +formatted f5f871c975a4 text-2.1.4/src/Data/Text/Internal/Builder/Int/Digits.hs +formatted ab51e88834e1 text-2.1.4/src/Data/Text/Internal/Builder/RealFloat/Functions.hs +formatted 7fa192160c9b text-2.1.4/src/Data/Text/Internal/ByteStringCompat.hs +formatted 370cd9150da5 text-2.1.4/src/Data/Text/Internal/Encoding.hs +formatted 43a1a670b3db text-2.1.4/src/Data/Text/Internal/Encoding/Fusion.hs +formatted 07ceae987c37 text-2.1.4/src/Data/Text/Internal/Encoding/Fusion/Common.hs +formatted 875961737225 text-2.1.4/src/Data/Text/Internal/Encoding/Utf16.hs +formatted 48ea4745d7e8 text-2.1.4/src/Data/Text/Internal/Encoding/Utf32.hs +formatted 999f28ae046f text-2.1.4/src/Data/Text/Internal/Encoding/Utf8.hs +formatted 9b74d0d7d95a text-2.1.4/src/Data/Text/Internal/Fusion.hs +formatted 9ae139203b50 text-2.1.4/src/Data/Text/Internal/Fusion/CaseMapping.hs +formatted 0858f0992142 text-2.1.4/src/Data/Text/Internal/Fusion/Common.hs +formatted eb26e26b5392 text-2.1.4/src/Data/Text/Internal/Fusion/Size.hs +formatted a8149e253de6 text-2.1.4/src/Data/Text/Internal/Fusion/Types.hs +formatted e8fe9af0fd3d text-2.1.4/src/Data/Text/Internal/IO.hs +formatted e2bb47936e11 text-2.1.4/src/Data/Text/Internal/IsAscii.hs +formatted 538632ba614a text-2.1.4/src/Data/Text/Internal/Lazy.hs +formatted 513ae58ba231 text-2.1.4/src/Data/Text/Internal/Lazy/Encoding/Fusion.hs +formatted c627413119e8 text-2.1.4/src/Data/Text/Internal/Lazy/Fusion.hs +formatted a3c76abdf09c text-2.1.4/src/Data/Text/Internal/Lazy/Search.hs +formatted 7eee07692410 text-2.1.4/src/Data/Text/Internal/Measure.hs +formatted 7635d57189ea text-2.1.4/src/Data/Text/Internal/PrimCompat.hs +formatted 634f3b2cbbde text-2.1.4/src/Data/Text/Internal/Private.hs +formatted a41bd3d7edab text-2.1.4/src/Data/Text/Internal/Read.hs +formatted ec56c867ca01 text-2.1.4/src/Data/Text/Internal/Reverse.hs +formatted eff6a5ffb928 text-2.1.4/src/Data/Text/Internal/Search.hs +formatted 67bf06cca611 text-2.1.4/src/Data/Text/Internal/StrictBuilder.hs +formatted a739bca575a2 text-2.1.4/src/Data/Text/Internal/Transformation.hs +formatted 18ae86a38924 text-2.1.4/src/Data/Text/Internal/Unsafe.hs +formatted d3b144e675ef text-2.1.4/src/Data/Text/Internal/Unsafe/Char.hs +formatted 66e47e950ff0 text-2.1.4/src/Data/Text/Internal/Validate.hs +formatted ef7a4a273c4d text-2.1.4/src/Data/Text/Internal/Validate/Native.hs +formatted 530d639cfd22 text-2.1.4/src/Data/Text/Internal/Validate/Simd.hs +formatted 6d4a57a9277a text-2.1.4/src/Data/Text/Lazy.hs +formatted 38ff2d7cb674 text-2.1.4/src/Data/Text/Lazy/Builder.hs +formatted 38666af96d86 text-2.1.4/src/Data/Text/Lazy/Builder/Int.hs +formatted 29e65f5a5a13 text-2.1.4/src/Data/Text/Lazy/Builder/RealFloat.hs +formatted a19c3620d230 text-2.1.4/src/Data/Text/Lazy/Encoding.hs +formatted b420221eedf6 text-2.1.4/src/Data/Text/Lazy/IO.hs +formatted 737ca3b98c79 text-2.1.4/src/Data/Text/Lazy/Internal.hs +formatted 4053796b9111 text-2.1.4/src/Data/Text/Lazy/Read.hs +formatted 95185ba2e9b4 text-2.1.4/src/Data/Text/Read.hs +formatted 1140737c74af text-2.1.4/src/Data/Text/Show.hs +formatted 5aa1e6b706a4 text-2.1.4/src/Data/Text/Unsafe.hs +formatted 8c35444bb7ce text-2.1.4/tests/LiteralRuleTest.hs +formatted 6c129d5c79c5 text-2.1.4/tests/Tests.hs +formatted 8c9ba4deec7f text-2.1.4/tests/Tests/Lift.hs +formatted eea1f5be128d text-2.1.4/tests/Tests/Properties.hs +formatted a1795fe9db0d text-2.1.4/tests/Tests/Properties/Basics.hs +formatted 4095b24da789 text-2.1.4/tests/Tests/Properties/Builder.hs +formatted 0da554ece794 text-2.1.4/tests/Tests/Properties/CornerCases.hs +formatted 966d6896eccc text-2.1.4/tests/Tests/Properties/Folds.hs +formatted 05ba3e128127 text-2.1.4/tests/Tests/Properties/Instances.hs +formatted 85722c4277cd text-2.1.4/tests/Tests/Properties/LowLevel.hs +formatted 73ce8ac597c8 text-2.1.4/tests/Tests/Properties/Read.hs +formatted 3429b9447ca6 text-2.1.4/tests/Tests/Properties/Substrings.hs +formatted bc4a76ea99f3 text-2.1.4/tests/Tests/Properties/Text.hs +formatted 8c294303c64a text-2.1.4/tests/Tests/Properties/Transcoding.hs +formatted cd2ce6693a46 text-2.1.4/tests/Tests/Properties/Validate.hs +formatted f69fd3fb97e5 text-2.1.4/tests/Tests/QuickCheckUtils.hs +formatted c6e25a3408e0 text-2.1.4/tests/Tests/RebindableSyntaxTest.hs +formatted 939e997260ba text-2.1.4/tests/Tests/Regressions.hs +formatted b7037d3f07cc text-2.1.4/tests/Tests/ShareEmpty.hs +formatted f4e9f36f6be9 text-2.1.4/tests/Tests/SlowFunctions.hs +formatted 375091fbe743 text-2.1.4/tests/Tests/Utils.hs +formatted e865ae48f11b th-abstraction-0.7.2.0/Setup.hs +formatted 2a559d420115 th-abstraction-0.7.2.0/src/Language/Haskell/TH/Datatype.hs +formatted b67b7b9c968e th-abstraction-0.7.2.0/src/Language/Haskell/TH/Datatype/Internal.hs +formatted 0bd7defdc9f9 th-abstraction-0.7.2.0/src/Language/Haskell/TH/Datatype/TyVarBndr.hs +formatted ede8a6d3e460 th-abstraction-0.7.2.0/test/Harness.hs +partly-checked 4515e1386d50 th-abstraction-0.7.2.0/test/Main.hs +formatted dc9970880595 th-abstraction-0.7.2.0/test/Types.hs +formatted fd2ff7ad97e3 time-1.16.0.1/Setup.hs +formatted 125260959da8 time-1.16.0.1/benchmark/Main.hs +formatted 06fdc32a2b7b time-1.16.0.1/lib/Data/Format.hs +formatted 138e9cb35e13 time-1.16.0.1/lib/Data/Time.hs +formatted d808f69809c2 time-1.16.0.1/lib/Data/Time/Calendar.hs +formatted 0f617301ba5b time-1.16.0.1/lib/Data/Time/Calendar/CalendarDiffDays.hs +formatted e210a7d3456b time-1.16.0.1/lib/Data/Time/Calendar/Days.hs +formatted 03412f0b8356 time-1.16.0.1/lib/Data/Time/Calendar/Easter.hs +formatted f8d4d6f009e4 time-1.16.0.1/lib/Data/Time/Calendar/Gregorian.hs +formatted be538512fc07 time-1.16.0.1/lib/Data/Time/Calendar/Julian.hs +formatted 625e7b428153 time-1.16.0.1/lib/Data/Time/Calendar/JulianYearDay.hs +formatted 9ba18c758e02 time-1.16.0.1/lib/Data/Time/Calendar/Month.hs +formatted eee4b0761e17 time-1.16.0.1/lib/Data/Time/Calendar/MonthDay.hs +formatted fe021b5bb8e1 time-1.16.0.1/lib/Data/Time/Calendar/OrdinalDate.hs +formatted 025bb4e6307c time-1.16.0.1/lib/Data/Time/Calendar/Private.hs +formatted 7d5d5b51baca time-1.16.0.1/lib/Data/Time/Calendar/Quarter.hs +formatted 61e7261c13da time-1.16.0.1/lib/Data/Time/Calendar/Types.hs +formatted 55892c430b7b time-1.16.0.1/lib/Data/Time/Calendar/Week.hs +formatted 8d6d0ff3c8ec time-1.16.0.1/lib/Data/Time/Calendar/WeekDate.hs +formatted c2de888ee84b time-1.16.0.1/lib/Data/Time/Clock.hs +formatted 0b01b660df99 time-1.16.0.1/lib/Data/Time/Clock/Internal/AbsoluteTime.hs +declined - time-1.16.0.1/lib/Data/Time/Clock/Internal/CTimeval.hs +formatted fde88246f337 time-1.16.0.1/lib/Data/Time/Clock/Internal/DiffTime.hs +formatted 130201256efa time-1.16.0.1/lib/Data/Time/Clock/Internal/NominalDiffTime.hs +formatted 8ef6afa040bc time-1.16.0.1/lib/Data/Time/Clock/Internal/POSIXTime.hs +formatted e9a83d4e7327 time-1.16.0.1/lib/Data/Time/Clock/Internal/SystemTime.hs +formatted 310750655010 time-1.16.0.1/lib/Data/Time/Clock/Internal/UTCDiff.hs +formatted a58732cd7eb8 time-1.16.0.1/lib/Data/Time/Clock/Internal/UTCTime.hs +formatted acaedfdab698 time-1.16.0.1/lib/Data/Time/Clock/Internal/UniversalTime.hs +formatted cf441f809fdf time-1.16.0.1/lib/Data/Time/Clock/POSIX.hs +formatted 6dd6034d73b4 time-1.16.0.1/lib/Data/Time/Clock/System.hs +formatted 7cdd69049dcf time-1.16.0.1/lib/Data/Time/Clock/TAI.hs +formatted b600a5b5c744 time-1.16.0.1/lib/Data/Time/Format.hs +formatted 6c005f66f0be time-1.16.0.1/lib/Data/Time/Format/Format/Class.hs +formatted 47f1688c0787 time-1.16.0.1/lib/Data/Time/Format/Format/Instances.hs +formatted 3764319de19b time-1.16.0.1/lib/Data/Time/Format/ISO8601.hs +formatted 76aa49c9292b time-1.16.0.1/lib/Data/Time/Format/Internal.hs +formatted b7ae7592bcb6 time-1.16.0.1/lib/Data/Time/Format/Locale.hs +formatted 2cd514758801 time-1.16.0.1/lib/Data/Time/Format/Parse.hs +formatted 05a7f0bf5554 time-1.16.0.1/lib/Data/Time/Format/Parse/Class.hs +formatted cb2ccd8c40fd time-1.16.0.1/lib/Data/Time/Format/Parse/Instances.hs +formatted 4489a4cdab49 time-1.16.0.1/lib/Data/Time/LocalTime.hs +formatted 93986a8450d1 time-1.16.0.1/lib/Data/Time/LocalTime/Internal/CalendarDiffTime.hs +formatted 94f381fe1ad1 time-1.16.0.1/lib/Data/Time/LocalTime/Internal/Foreign.hs +formatted ca98c37fb34c time-1.16.0.1/lib/Data/Time/LocalTime/Internal/LocalTime.hs +formatted 9200ebaf067a time-1.16.0.1/lib/Data/Time/LocalTime/Internal/TimeOfDay.hs +formatted 74496e557585 time-1.16.0.1/lib/Data/Time/LocalTime/Internal/TimeZone.hs +formatted 343d16749a70 time-1.16.0.1/lib/Data/Time/LocalTime/Internal/ZonedTime.hs +formatted c365d1aa63cd time-1.16.0.1/test/ForeignCalls.hs +formatted fc8234c946fb time-1.16.0.1/test/ShowDefaultTZAbbreviations.hs +formatted b51274826033 time-1.16.0.1/test/ShowTime.hs +formatted 921506ceef7c time-1.16.0.1/test/main/Main.hs +formatted a04f2637edec time-1.16.0.1/test/main/Test/AddDiff.hs +formatted 5b7aef4fe245 time-1.16.0.1/test/main/Test/Arbitrary.hs +formatted a31b50175d67 time-1.16.0.1/test/main/Test/Calendar/AddDays.hs +formatted 5b09874748fc time-1.16.0.1/test/main/Test/Calendar/AddDaysRef.hs +formatted 1f2ab37cb077 time-1.16.0.1/test/main/Test/Calendar/CalendarProps.hs +formatted fe6ab3f07aa9 time-1.16.0.1/test/main/Test/Calendar/Calendars.hs +formatted ba59184d394c time-1.16.0.1/test/main/Test/Calendar/CalendarsRef.hs +formatted e4ef550ce506 time-1.16.0.1/test/main/Test/Calendar/ClipDates.hs +formatted f707c1ddaec1 time-1.16.0.1/test/main/Test/Calendar/ClipDatesRef.hs +formatted d031fd80c27f time-1.16.0.1/test/main/Test/Calendar/ConvertBack.hs +formatted 168e9526852a time-1.16.0.1/test/main/Test/Calendar/DayPeriod.hs +formatted 3347574732a8 time-1.16.0.1/test/main/Test/Calendar/Duration.hs +formatted 56b1c2b8beea time-1.16.0.1/test/main/Test/Calendar/Easter.hs +formatted 3f35f96f7337 time-1.16.0.1/test/main/Test/Calendar/LongWeekYears.hs +formatted bdfb9e546ba3 time-1.16.0.1/test/main/Test/Calendar/LongWeekYearsRef.hs +formatted b5181d1d6218 time-1.16.0.1/test/main/Test/Calendar/MonthDay.hs +formatted c01cb667a9a8 time-1.16.0.1/test/main/Test/Calendar/MonthDayRef.hs +formatted fc8caea8866a time-1.16.0.1/test/main/Test/Calendar/MonthOfYear.hs +formatted bdc7d2df472c time-1.16.0.1/test/main/Test/Calendar/Valid.hs +formatted 516d424dfa89 time-1.16.0.1/test/main/Test/Calendar/Week.hs +formatted 96f42a259e5f time-1.16.0.1/test/main/Test/Calendar/Year.hs +formatted 868a03b5a657 time-1.16.0.1/test/main/Test/Clock/Conversion.hs +formatted 5c09197a3ec5 time-1.16.0.1/test/main/Test/Clock/Pattern.hs +formatted 449c0cf9b9bd time-1.16.0.1/test/main/Test/Clock/Resolution.hs +formatted e5afef596413 time-1.16.0.1/test/main/Test/Clock/TAI.hs +formatted 56759726b4b9 time-1.16.0.1/test/main/Test/Format/Compile.hs +formatted 9a5ff5f775a0 time-1.16.0.1/test/main/Test/Format/Format.hs +formatted 8aaf7b1caf88 time-1.16.0.1/test/main/Test/Format/ISO8601.hs +formatted 37b32c4a0925 time-1.16.0.1/test/main/Test/Format/ParseTime.hs +formatted 87d53b9f2df8 time-1.16.0.1/test/main/Test/LocalTime/CalendarDiffTime.hs +formatted 3c6fcbef621e time-1.16.0.1/test/main/Test/LocalTime/Time.hs +formatted 4c37e59c357b time-1.16.0.1/test/main/Test/LocalTime/TimeOfDay.hs +formatted db61298fae47 time-1.16.0.1/test/main/Test/LocalTime/TimeRef.hs +formatted 274e9173e128 time-1.16.0.1/test/main/Test/TestUtil.hs +formatted 41cfd788db10 time-1.16.0.1/test/main/Test/Types.hs +formatted 2e8ad72db81a time-1.16.0.1/test/template/Main.hs +formatted 29972ed619e0 time-1.16.0.1/test/template/Test/TastyWrapper.hs +formatted ea580c874e6f time-1.16.0.1/test/unix/Main.hs +formatted 2259bf37c138 time-1.16.0.1/test/unix/Test/Format/Format.hs +formatted 21b333187684 time-1.16.0.1/test/unix/Test/LocalTime/TimeZone.hs +formatted 80c12af20c6e time-1.16.0.1/test/unix/Test/TestUtil.hs +formatted 7917eb9d1f66 tls-2.4.3/Benchmarks/Benchmarks.hs +formatted 489534a90c4b tls-2.4.3/Network/TLS.hs +formatted 7ce1364dcb4a tls-2.4.3/Network/TLS/Backend.hs +formatted f9d4f25241e6 tls-2.4.3/Network/TLS/Cipher.hs +formatted a0fa75894b05 tls-2.4.3/Network/TLS/Compression.hs +formatted 1a706256562f tls-2.4.3/Network/TLS/Context.hs +formatted 1eeefa415421 tls-2.4.3/Network/TLS/Context/Internal.hs +formatted bbff565b3ae1 tls-2.4.3/Network/TLS/Core.hs +formatted e1443ef58aff tls-2.4.3/Network/TLS/Credentials.hs +formatted 1e866a0b1add tls-2.4.3/Network/TLS/Crypto.hs +formatted a8fca7835f0d tls-2.4.3/Network/TLS/Crypto/DH.hs +formatted 446c8c8a07ed tls-2.4.3/Network/TLS/Crypto/IES.hs +formatted b7e6a0d5aaac tls-2.4.3/Network/TLS/Crypto/Types.hs +formatted 025f72c75341 tls-2.4.3/Network/TLS/ErrT.hs +formatted 76e7495f609c tls-2.4.3/Network/TLS/Error.hs +formatted 5f5ef96f88b3 tls-2.4.3/Network/TLS/Extension.hs +formatted a7c47ad146ac tls-2.4.3/Network/TLS/Extension.hs-boot +formatted 49db661a445a tls-2.4.3/Network/TLS/Extra.hs +formatted 31d3b677e3dd tls-2.4.3/Network/TLS/Extra/Cipher.hs +formatted 0ee5bebb0e07 tls-2.4.3/Network/TLS/Extra/CipherCBC.hs +formatted 5d51d07ab286 tls-2.4.3/Network/TLS/Extra/FFDHE.hs +formatted 0003b888622d tls-2.4.3/Network/TLS/Handshake.hs +formatted 34fa3d5f9250 tls-2.4.3/Network/TLS/Handshake/Certificate.hs +formatted 2ece306df042 tls-2.4.3/Network/TLS/Handshake/Client.hs +formatted c309df62a6dc tls-2.4.3/Network/TLS/Handshake/Client/ClientHello.hs +formatted 7f2f22708910 tls-2.4.3/Network/TLS/Handshake/Client/Common.hs +formatted 51e7fc6f4794 tls-2.4.3/Network/TLS/Handshake/Client/ServerHello.hs +formatted 3f13588f75b3 tls-2.4.3/Network/TLS/Handshake/Client/TLS12.hs +formatted cbcf509e71d1 tls-2.4.3/Network/TLS/Handshake/Client/TLS13.hs +formatted a165513e351d tls-2.4.3/Network/TLS/Handshake/Common.hs +formatted 781edf2ff067 tls-2.4.3/Network/TLS/Handshake/Common13.hs +formatted 02f97ef7593d tls-2.4.3/Network/TLS/Handshake/Control.hs +formatted 2c0676398aca tls-2.4.3/Network/TLS/Handshake/Key.hs +formatted 9dc05a147d3b tls-2.4.3/Network/TLS/Handshake/Random.hs +formatted 718a7715d422 tls-2.4.3/Network/TLS/Handshake/Server.hs +formatted 20f083ce3b73 tls-2.4.3/Network/TLS/Handshake/Server/ClientHello.hs +formatted 31d74cce1ec5 tls-2.4.3/Network/TLS/Handshake/Server/ClientHello12.hs +formatted c10c507909d1 tls-2.4.3/Network/TLS/Handshake/Server/ClientHello13.hs +formatted a2f2d3470f0f tls-2.4.3/Network/TLS/Handshake/Server/Common.hs +formatted e0d048534445 tls-2.4.3/Network/TLS/Handshake/Server/ServerHello12.hs +formatted 4f5074d8165a tls-2.4.3/Network/TLS/Handshake/Server/ServerHello13.hs +formatted b29b9f3d0ef7 tls-2.4.3/Network/TLS/Handshake/Server/TLS12.hs +formatted 06002a108581 tls-2.4.3/Network/TLS/Handshake/Server/TLS13.hs +formatted 6a8388c49af7 tls-2.4.3/Network/TLS/Handshake/Signature.hs +formatted 009f1658802d tls-2.4.3/Network/TLS/Handshake/State.hs +formatted 8533c61b72e3 tls-2.4.3/Network/TLS/Handshake/State13.hs +formatted 11825b040470 tls-2.4.3/Network/TLS/Handshake/TranscriptHash.hs +formatted 38c7f1733b3a tls-2.4.3/Network/TLS/HashAndSignature.hs +formatted 7be5df148925 tls-2.4.3/Network/TLS/Hooks.hs +formatted be666dff7b14 tls-2.4.3/Network/TLS/IO.hs +formatted f83586ff735d tls-2.4.3/Network/TLS/IO/Decode.hs +formatted b5b4ec68ca00 tls-2.4.3/Network/TLS/IO/Encode.hs +formatted 6c20cf748535 tls-2.4.3/Network/TLS/Imports.hs +formatted 21e9ce7c3507 tls-2.4.3/Network/TLS/Internal.hs +formatted 92999e90c6b3 tls-2.4.3/Network/TLS/KeySchedule.hs +formatted febba7334e9e tls-2.4.3/Network/TLS/MAC.hs +formatted 44b7f6f73115 tls-2.4.3/Network/TLS/Measurement.hs +formatted f0042ddb2e2e tls-2.4.3/Network/TLS/Packet.hs +formatted 8d74b7707cba tls-2.4.3/Network/TLS/Packet13.hs +formatted a14ea5098afd tls-2.4.3/Network/TLS/Parameters.hs +formatted 29784d509f48 tls-2.4.3/Network/TLS/PostHandshake.hs +formatted 8edf9e30c18b tls-2.4.3/Network/TLS/QUIC.hs +formatted 360a52dcf151 tls-2.4.3/Network/TLS/RNG.hs +formatted 805eb6800681 tls-2.4.3/Network/TLS/Record.hs +formatted 176fc6cb0e0b tls-2.4.3/Network/TLS/Record/Decrypt.hs +formatted 58803d051f03 tls-2.4.3/Network/TLS/Record/Encrypt.hs +formatted 3d9c53507eaa tls-2.4.3/Network/TLS/Record/Layer.hs +formatted a66c641fa8a1 tls-2.4.3/Network/TLS/Record/Recv.hs +formatted 9fa588833e07 tls-2.4.3/Network/TLS/Record/Send.hs +formatted 2af800e2c322 tls-2.4.3/Network/TLS/Record/State.hs +formatted 5bfbdf5546a3 tls-2.4.3/Network/TLS/Record/Types.hs +formatted 42bed44c3eaa tls-2.4.3/Network/TLS/Session.hs +formatted 5bef08c36337 tls-2.4.3/Network/TLS/State.hs +formatted ff17eb8d38b8 tls-2.4.3/Network/TLS/Struct.hs +formatted 2aeee057d9ff tls-2.4.3/Network/TLS/Struct13.hs +formatted ea0d39cd9f70 tls-2.4.3/Network/TLS/Types.hs +formatted 997becc4fe58 tls-2.4.3/Network/TLS/Types/Cipher.hs +formatted e6e9255220bb tls-2.4.3/Network/TLS/Types/Secret.hs +formatted 35bf4ee60be8 tls-2.4.3/Network/TLS/Types/Session.hs +formatted 741cb1c84257 tls-2.4.3/Network/TLS/Types/Version.hs +formatted be921f75cb0a tls-2.4.3/Network/TLS/Util.hs +formatted 1d021bd7e9a7 tls-2.4.3/Network/TLS/Util/ASN1.hs +formatted 9d70166f446f tls-2.4.3/Network/TLS/Util/Serialization.hs +formatted 32a205e8e871 tls-2.4.3/Network/TLS/Wire.hs +formatted 8d9038e38c2b tls-2.4.3/Network/TLS/X509.hs +formatted e865ae48f11b tls-2.4.3/Setup.hs +formatted 45a83b6cde24 tls-2.4.3/test/API.hs +formatted eaaf5def6469 tls-2.4.3/test/Arbitrary.hs +formatted ba1557ab2831 tls-2.4.3/test/Certificate.hs +formatted 37c216e39fd1 tls-2.4.3/test/CiphersSpec.hs +formatted 127368e06936 tls-2.4.3/test/ECHSpec.hs +formatted a99d04d129f7 tls-2.4.3/test/EncodeSpec.hs +formatted fe70454cad85 tls-2.4.3/test/HandshakeSpec.hs +formatted 6851deeb2440 tls-2.4.3/test/PipeChan.hs +formatted 338dcd8056de tls-2.4.3/test/PubKey.hs +formatted 9621232ed432 tls-2.4.3/test/Run.hs +formatted a550a90f6578 tls-2.4.3/test/Session.hs +formatted 2fbd14b119a4 tls-2.4.3/test/Spec.hs +formatted 9034972735e8 tls-2.4.3/test/ThreadSpec.hs +formatted 0d661eb8f9c2 tls-2.4.3/util/Client.hs +formatted c555911ae465 tls-2.4.3/util/Common.hs +formatted 7dd3b5f2e44a tls-2.4.3/util/Imports.hs +formatted 6e9aa070c533 tls-2.4.3/util/Server.hs +formatted 2e4c1c1f2132 tls-2.4.3/util/tls-client.hs +formatted cc5d29d77364 tls-2.4.3/util/tls-server.hs +partly-checked 3fb7ad77e453 transformers-0.6.3.0/Control/Applicative/Backwards.hs +partly-checked 1e0b5cb5f0b3 transformers-0.6.3.0/Control/Applicative/Lift.hs +formatted 578b0e3c1682 transformers-0.6.3.0/Control/Monad/Signatures.hs +partly-checked 903d26036ddf transformers-0.6.3.0/Control/Monad/Trans/Accum.hs +formatted dc84c86bb82a transformers-0.6.3.0/Control/Monad/Trans/Class.hs +formatted 1817d0d25545 transformers-0.6.3.0/Control/Monad/Trans/Cont.hs +partly-checked 98eeed8cf935 transformers-0.6.3.0/Control/Monad/Trans/Except.hs +partly-checked 67b62194140d transformers-0.6.3.0/Control/Monad/Trans/Identity.hs +partly-checked c166041a8c5e transformers-0.6.3.0/Control/Monad/Trans/Maybe.hs +formatted 6f7326668607 transformers-0.6.3.0/Control/Monad/Trans/RWS.hs +formatted c18cfc68a7ca transformers-0.6.3.0/Control/Monad/Trans/RWS/CPS.hs +partly-checked fa6eb9bac0a7 transformers-0.6.3.0/Control/Monad/Trans/RWS/Lazy.hs +partly-checked d7f98f96171d transformers-0.6.3.0/Control/Monad/Trans/RWS/Strict.hs +partly-checked d75058073c9e transformers-0.6.3.0/Control/Monad/Trans/Reader.hs +formatted b58555f08340 transformers-0.6.3.0/Control/Monad/Trans/Select.hs +formatted dc729d1936a2 transformers-0.6.3.0/Control/Monad/Trans/State.hs +partly-checked f062acd2848c transformers-0.6.3.0/Control/Monad/Trans/State/Lazy.hs +partly-checked 53dea27ba637 transformers-0.6.3.0/Control/Monad/Trans/State/Strict.hs +formatted 6a9857bbd181 transformers-0.6.3.0/Control/Monad/Trans/Writer.hs +formatted 1b5b2ad9e9d8 transformers-0.6.3.0/Control/Monad/Trans/Writer/CPS.hs +partly-checked 579da23e5e5b transformers-0.6.3.0/Control/Monad/Trans/Writer/Lazy.hs +partly-checked f89a27634c86 transformers-0.6.3.0/Control/Monad/Trans/Writer/Strict.hs +declined - transformers-0.6.3.0/Data/Functor/Constant.hs +partly-checked 9b1d6b4e909d transformers-0.6.3.0/Data/Functor/Reverse.hs +formatted e865ae48f11b transformers-0.6.3.0/Setup.hs +declined - transformers-0.6.3.0/legacy/pre709/Data/Functor/Identity.hs +formatted ee4ba7098a5c transformers-0.6.3.0/legacy/pre711/Control/Monad/IO/Class.hs +formatted 7d9fab9a0caf transformers-0.6.3.0/legacy/pre711/Data/Functor/Classes.hs +formatted 284d6d5fc1d3 transformers-0.6.3.0/legacy/pre711/Data/Functor/Compose.hs +partly-checked e96184ffa2ec transformers-0.6.3.0/legacy/pre711/Data/Functor/Product.hs +formatted 87f324f0c768 transformers-0.6.3.0/legacy/pre711/Data/Functor/Sum.hs +formatted e865ae48f11b typed-process-0.2.13.0/Setup.hs +formatted b26f653e6a78 typed-process-0.2.13.0/src/System/Process/Typed.hs +formatted a2f3c6df3e9b typed-process-0.2.13.0/src/System/Process/Typed/Internal.hs +formatted 2fbd14b119a4 typed-process-0.2.13.0/test/Spec.hs +formatted 7da6b9dd8336 typed-process-0.2.13.0/test/System/Process/TypedSpec.hs +formatted e865ae48f11b unliftio-0.2.25.1/Setup.hs +formatted 86399961b28a unliftio-0.2.25.1/bench/ConcBench.hs +formatted 737706872ccf unliftio-0.2.25.1/src/UnliftIO.hs +formatted 713d1458fd8d unliftio-0.2.25.1/src/UnliftIO/Async.hs +formatted 5463e06f3adf unliftio-0.2.25.1/src/UnliftIO/Chan.hs +formatted 189c6c89bb81 unliftio-0.2.25.1/src/UnliftIO/Concurrent.hs +partly-checked c708a2f3ee0e unliftio-0.2.25.1/src/UnliftIO/Directory.hs +formatted 402fb486b3cf unliftio-0.2.25.1/src/UnliftIO/Environment.hs +formatted c9305d3c9be9 unliftio-0.2.25.1/src/UnliftIO/Exception.hs +formatted e5401695da5a unliftio-0.2.25.1/src/UnliftIO/Exception/Lens.hs +formatted ff1234d6ddbd unliftio-0.2.25.1/src/UnliftIO/Foreign.hs +formatted a64a8ea6c117 unliftio-0.2.25.1/src/UnliftIO/IO.hs +formatted c940b0ac5eb1 unliftio-0.2.25.1/src/UnliftIO/IO/File.hs +formatted 8f52b4c4db23 unliftio-0.2.25.1/src/UnliftIO/IO/File/Posix.hs +formatted 2688f4b976d8 unliftio-0.2.25.1/src/UnliftIO/IORef.hs +formatted 1738f330bd77 unliftio-0.2.25.1/src/UnliftIO/Internals/Async.hs +formatted 2e37ab380c8b unliftio-0.2.25.1/src/UnliftIO/MVar.hs +formatted 25ab39f4a7d1 unliftio-0.2.25.1/src/UnliftIO/Memoize.hs +formatted 5803964631a0 unliftio-0.2.25.1/src/UnliftIO/Process.hs +formatted f17d64d4c913 unliftio-0.2.25.1/src/UnliftIO/QSem.hs +formatted 6e50df49a6ba unliftio-0.2.25.1/src/UnliftIO/QSemN.hs +formatted ee3bf4d22673 unliftio-0.2.25.1/src/UnliftIO/STM.hs +formatted 809c4f4424bb unliftio-0.2.25.1/src/UnliftIO/Temporary.hs +formatted 0f5f7167bc7b unliftio-0.2.25.1/src/UnliftIO/Timeout.hs +formatted 2fbd14b119a4 unliftio-0.2.25.1/test/Spec.hs +formatted 3118f2133668 unliftio-0.2.25.1/test/UnliftIO/AsyncSpec.hs +formatted dda4d2f1b5ef unliftio-0.2.25.1/test/UnliftIO/DirectorySpec.hs +formatted 500e291fb7a1 unliftio-0.2.25.1/test/UnliftIO/ExceptionSpec.hs +formatted a899c691b2e6 unliftio-0.2.25.1/test/UnliftIO/IO/FileSpec.hs +formatted 258e4c04879b unliftio-0.2.25.1/test/UnliftIO/IOSpec.hs +formatted 68c4411ed8f4 unliftio-0.2.25.1/test/UnliftIO/MemoizeSpec.hs +formatted f878ce9da222 unliftio-0.2.25.1/test/UnliftIO/PooledAsyncSpec.hs +formatted 2f5ad1921f27 unordered-containers-0.2.21/Data/HashMap/Internal.hs +declined - unordered-containers-0.2.21/Data/HashMap/Internal/Array.hs +formatted 7be08d5816ff unordered-containers-0.2.21/Data/HashMap/Internal/Debug.hs +formatted 25f94316b17e unordered-containers-0.2.21/Data/HashMap/Internal/List.hs +formatted 08e073c2c7dd unordered-containers-0.2.21/Data/HashMap/Internal/Strict.hs +formatted a4d22b20936f unordered-containers-0.2.21/Data/HashMap/Lazy.hs +formatted b51d84ac0257 unordered-containers-0.2.21/Data/HashMap/Strict.hs +formatted d88b52d5dce2 unordered-containers-0.2.21/Data/HashSet.hs +formatted a238b77b05ef unordered-containers-0.2.21/Data/HashSet/Internal.hs +formatted e865ae48f11b unordered-containers-0.2.21/Setup.hs +formatted e85bc02778c3 unordered-containers-0.2.21/benchmarks/Benchmarks.hs +formatted 0ed2a6102dba unordered-containers-0.2.21/benchmarks/FineGrained.hs +formatted 7e72d194e206 unordered-containers-0.2.21/benchmarks/Key/Bytes.hs +formatted de9c7b30da36 unordered-containers-0.2.21/benchmarks/Util/ByteString.hs +formatted 284694c5798b unordered-containers-0.2.21/benchmarks/Util/Int.hs +formatted 771e81db1b05 unordered-containers-0.2.21/benchmarks/Util/String.hs +formatted 2b26017dfa9e unordered-containers-0.2.21/tests/Main.hs +formatted 27005a00112e unordered-containers-0.2.21/tests/Properties.hs +formatted feff92267a82 unordered-containers-0.2.21/tests/Properties/HashMapLazy.hs +formatted f2a904c3a89a unordered-containers-0.2.21/tests/Properties/HashMapStrict.hs +formatted a612762e1b58 unordered-containers-0.2.21/tests/Properties/HashSet.hs +formatted 3584a01b2cdd unordered-containers-0.2.21/tests/Properties/List.hs +formatted 6464664cb68b unordered-containers-0.2.21/tests/Regressions.hs +formatted d094f07710f5 unordered-containers-0.2.21/tests/Strictness.hs +formatted 00cf0a5ee0ea unordered-containers-0.2.21/tests/Util/Key.hs +formatted e865ae48f11b unpacked-containers-0/Setup.hs +formatted 8523e9d3c669 unpacked-containers-0/example/Int.hs +formatted ba3a254765ca unpacked-containers-0/example/Main.hs +formatted 941a76a7e532 unpacked-containers-0/src/Key.hsig +formatted 0ab7b95772b1 unpacked-containers-0/src/Map.hs +formatted 4ab593177929 unpacked-containers-0/src/Map/Internal.hs +formatted 412fdc3e3871 unpacked-containers-0/src/Map/Internal/Debug.hs +formatted 88e3acab50fe unpacked-containers-0/src/Map/Lazy.hs +formatted d160eb88e766 unpacked-containers-0/src/Map/Merge/Lazy.hs +formatted 3401a14fe602 unpacked-containers-0/src/Map/Merge/Strict.hs +formatted 1da0e231433b unpacked-containers-0/src/Map/Strict.hs +formatted 9b01f9961f71 unpacked-containers-0/src/Map/Strict/Internal.hs +formatted bb6c9398369f unpacked-containers-0/src/Set.hs +formatted cb11e5a3315d unpacked-containers-0/src/Set/Internal.hs +formatted 867c9afd504a unpacked-containers-0/utils/Internal/BitQueue.hs +formatted 7c96e08090d5 unpacked-containers-0/utils/Internal/BitUtil.hs +formatted a1134be4230d unpacked-containers-0/utils/Internal/PtrEquality.hs +formatted 5dd1b940181c unpacked-containers-0/utils/Internal/State.hs +formatted ed12f1faf0ed unpacked-containers-0/utils/Internal/StrictFold.hs +formatted 621944df674c unpacked-containers-0/utils/Internal/StrictMaybe.hs +formatted b7a091ef4c77 unpacked-containers-0/utils/Internal/StrictPair.hs +formatted 4a8ac51676df uuid-types-1.0.6.1/Setup.hs +formatted e97eca400518 uuid-types-1.0.6.1/src/Data/UUID/Types.hs +formatted 2dc18f83b9c9 uuid-types-1.0.6.1/src/Data/UUID/Types/Internal.hs +formatted d63508f44841 uuid-types-1.0.6.1/src/Data/UUID/Types/Internal/Builder.hs +formatted 14a92dc8286f uuid-types-1.0.6.1/tests/TestUUID.hs +formatted e865ae48f11b vector-0.13.2.0/Setup.hs +formatted cb65eb293bd5 vector-0.13.2.0/benchlib/Bench/Vector/Algo/AwShCC.hs +formatted 8a7c35b680c0 vector-0.13.2.0/benchlib/Bench/Vector/Algo/FindIndexR.hs +formatted 7536358d3c8c vector-0.13.2.0/benchlib/Bench/Vector/Algo/HybCC.hs +formatted 31caf6daa18c vector-0.13.2.0/benchlib/Bench/Vector/Algo/Leaffix.hs +formatted c647f14c61cb vector-0.13.2.0/benchlib/Bench/Vector/Algo/ListRank.hs +formatted bbc9ffdd439f vector-0.13.2.0/benchlib/Bench/Vector/Algo/MutableSet.hs +formatted 49998369707c vector-0.13.2.0/benchlib/Bench/Vector/Algo/NextPermutation.hs +formatted a1d4d3d489b4 vector-0.13.2.0/benchlib/Bench/Vector/Algo/Quickhull.hs +formatted cff7efe83577 vector-0.13.2.0/benchlib/Bench/Vector/Algo/Rootfix.hs +formatted bc96aa2b8cdf vector-0.13.2.0/benchlib/Bench/Vector/Algo/Spectral.hs +formatted 438dab6789ad vector-0.13.2.0/benchlib/Bench/Vector/Algo/Tridiag.hs +formatted ec97bfaffec3 vector-0.13.2.0/benchlib/Bench/Vector/Tasty.hs +formatted 368deb66d310 vector-0.13.2.0/benchlib/Bench/Vector/TestData/Graph.hs +formatted 476c4f42945a vector-0.13.2.0/benchlib/Bench/Vector/TestData/ParenTree.hs +formatted 6b1b4aea2361 vector-0.13.2.0/benchmarks/Main.hs +formatted 77ce7d3b1eda vector-0.13.2.0/internal/GenUnboxTuple.hs +formatted 7e257cfd7468 vector-0.13.2.0/src/Data/Vector.hs +formatted 16d1d0522130 vector-0.13.2.0/src/Data/Vector/Fusion/Bundle.hs +formatted c77517ac5b6b vector-0.13.2.0/src/Data/Vector/Fusion/Bundle/Monadic.hs +formatted 281a320dd1fd vector-0.13.2.0/src/Data/Vector/Fusion/Bundle/Size.hs +formatted 8b09b3b8c680 vector-0.13.2.0/src/Data/Vector/Fusion/Stream/Monadic.hs +formatted cfc06f7907bc vector-0.13.2.0/src/Data/Vector/Fusion/Util.hs +formatted a981b8dada8f vector-0.13.2.0/src/Data/Vector/Generic.hs +formatted 24e087932bf9 vector-0.13.2.0/src/Data/Vector/Generic/Base.hs +formatted 6c34f319e085 vector-0.13.2.0/src/Data/Vector/Generic/Mutable.hs +formatted 14ab0fea35a5 vector-0.13.2.0/src/Data/Vector/Generic/Mutable/Base.hs +formatted 31ef8684e6a5 vector-0.13.2.0/src/Data/Vector/Generic/New.hs +formatted 1842a6e1d83f vector-0.13.2.0/src/Data/Vector/Internal/Check.hs +formatted 3a331752a108 vector-0.13.2.0/src/Data/Vector/Mutable.hs +formatted c77c6d8b48f1 vector-0.13.2.0/src/Data/Vector/Primitive.hs +formatted 7790a579fd85 vector-0.13.2.0/src/Data/Vector/Primitive/Mutable.hs +formatted d63a299a6982 vector-0.13.2.0/src/Data/Vector/Storable.hs +formatted f3208fa21c31 vector-0.13.2.0/src/Data/Vector/Storable/Internal.hs +formatted a312fe3ca55a vector-0.13.2.0/src/Data/Vector/Storable/Mutable.hs +formatted ca6c3919dbe4 vector-0.13.2.0/src/Data/Vector/Strict.hs +formatted 3bc69095cb4d vector-0.13.2.0/src/Data/Vector/Strict/Mutable.hs +formatted 5a349caedbaf vector-0.13.2.0/src/Data/Vector/Unboxed.hs +formatted fa9e19a0d58d vector-0.13.2.0/src/Data/Vector/Unboxed/Base.hs +formatted 58ff39d532e3 vector-0.13.2.0/src/Data/Vector/Unboxed/Mutable.hs +formatted f4e17f002657 vector-0.13.2.0/tests-inspect/Inspect.hs +formatted 992258e8ec96 vector-0.13.2.0/tests-inspect/Inspect/DerivingVia.hs +formatted 005977089309 vector-0.13.2.0/tests-inspect/Inspect/DerivingVia/OtherFoo.hs +formatted c86daf6b0506 vector-0.13.2.0/tests-inspect/main.hs +formatted b27a545b7df5 vector-0.13.2.0/tests/Boilerplater.hs +formatted 9d758ab214f1 vector-0.13.2.0/tests/Main.hs +formatted 8061fe09f977 vector-0.13.2.0/tests/Tests/Bundle.hs +formatted 1525be7e0a46 vector-0.13.2.0/tests/Tests/Move.hs +formatted 43dd4c8d5a9c vector-0.13.2.0/tests/Tests/Vector/Boxed.hs +formatted 54a741f726e9 vector-0.13.2.0/tests/Tests/Vector/Primitive.hs +formatted 4c1e86e31a44 vector-0.13.2.0/tests/Tests/Vector/Property.hs +formatted 89d6f5f286c7 vector-0.13.2.0/tests/Tests/Vector/Storable.hs +formatted cc9e0bc6f8e0 vector-0.13.2.0/tests/Tests/Vector/Strict.hs +formatted 891ffe33c45c vector-0.13.2.0/tests/Tests/Vector/Unboxed.hs +formatted 9d70a141ca8e vector-0.13.2.0/tests/Tests/Vector/UnitTests.hs +formatted 915b72919a48 vector-0.13.2.0/tests/Utilities.hs +formatted 88ed51490944 vector-0.13.2.0/tests/doctests.hs +formatted 5561dc5bc4a0 vector-algorithms-0.9.1.0/bench/simple/Blocks.hs +formatted 501fcfb24218 vector-algorithms-0.9.1.0/bench/simple/Main.hs +formatted 518a902d3c59 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms.hs +formatted 553211019f78 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/AmericanFlag.hs +formatted 5bc324a60b4f vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Common.hs +formatted a7c93d247f1d vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Heap.hs +formatted 385f1aecc6ac vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Insertion.hs +formatted eaaf49335045 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Intro.hs +formatted 4a50f751547a vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Merge.hs +formatted 9a4c2dc71a47 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Optimal.hs +formatted b7b0f718deb2 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Radix.hs +formatted 47f1d28b6145 vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Search.hs +formatted 0a376532e9cb vector-algorithms-0.9.1.0/src/Data/Vector/Algorithms/Tim.hs +formatted a9ac57f13756 vector-algorithms-0.9.1.0/tests/properties/Optimal.hs +formatted b19d49d0db4b vector-algorithms-0.9.1.0/tests/properties/Properties.hs +formatted 9b8afe81a4c6 vector-algorithms-0.9.1.0/tests/properties/Tests.hs +formatted 68c72976d14e vector-algorithms-0.9.1.0/tests/properties/Util.hs +formatted 8509e18a780a wai-3.2.5/Network/Wai.hs +formatted 7174252dda45 wai-3.2.5/Network/Wai/Internal.hs +formatted 76fdb58b6d05 wai-3.2.5/test/Network/WaiSpec.hs +formatted 2fbd14b119a4 wai-3.2.5/test/Spec.hs +formatted d069d134e586 warp-3.4.15/Network/Wai/Handler/Warp.hs +formatted 009ccfac9d51 warp-3.4.15/Network/Wai/Handler/Warp/Buffer.hs +formatted f910265f50d3 warp-3.4.15/Network/Wai/Handler/Warp/Conduit.hs +formatted c978e6eb627c warp-3.4.15/Network/Wai/Handler/Warp/Counter.hs +formatted 26b005936471 warp-3.4.15/Network/Wai/Handler/Warp/Date.hs +formatted 349d250e5826 warp-3.4.15/Network/Wai/Handler/Warp/FdCache.hs +formatted 5c8ff344b068 warp-3.4.15/Network/Wai/Handler/Warp/File.hs +formatted e56514093065 warp-3.4.15/Network/Wai/Handler/Warp/FileInfoCache.hs +formatted 2b7f4d356448 warp-3.4.15/Network/Wai/Handler/Warp/HTTP1.hs +formatted f32ce233886c warp-3.4.15/Network/Wai/Handler/Warp/HTTP2.hs +formatted a7debda99dd6 warp-3.4.15/Network/Wai/Handler/Warp/HTTP2/File.hs +formatted cd7ebbac04db warp-3.4.15/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs +formatted 40821f53b1d9 warp-3.4.15/Network/Wai/Handler/Warp/HTTP2/Request.hs +formatted 831c4440cde7 warp-3.4.15/Network/Wai/Handler/Warp/HTTP2/Response.hs +formatted 40e59aa92ecc warp-3.4.15/Network/Wai/Handler/Warp/HTTP2/Types.hs +formatted 69c55babd99e warp-3.4.15/Network/Wai/Handler/Warp/HashMap.hs +formatted cee4ba0a15b3 warp-3.4.15/Network/Wai/Handler/Warp/Header.hs +formatted a036771b5a25 warp-3.4.15/Network/Wai/Handler/Warp/IO.hs +formatted d92af26eb2ec warp-3.4.15/Network/Wai/Handler/Warp/Imports.hs +formatted 98f2e1cfdade warp-3.4.15/Network/Wai/Handler/Warp/Internal.hs +formatted e8583e08a2e4 warp-3.4.15/Network/Wai/Handler/Warp/MultiMap.hs +formatted ed16ebc20147 warp-3.4.15/Network/Wai/Handler/Warp/PackInt.hs +formatted 22e5a5d6d3c9 warp-3.4.15/Network/Wai/Handler/Warp/ReadInt.hs +formatted e29d1517c375 warp-3.4.15/Network/Wai/Handler/Warp/Request.hs +formatted c7905b72682b warp-3.4.15/Network/Wai/Handler/Warp/RequestHeader.hs +formatted 7100fbff6910 warp-3.4.15/Network/Wai/Handler/Warp/Response.hs +formatted 27cae25ae83a warp-3.4.15/Network/Wai/Handler/Warp/ResponseHeader.hs +formatted 621b343ceaa3 warp-3.4.15/Network/Wai/Handler/Warp/Run.hs +formatted 47a04a642ad1 warp-3.4.15/Network/Wai/Handler/Warp/SendFile.hs +formatted bad8f2d42358 warp-3.4.15/Network/Wai/Handler/Warp/Settings.hs +formatted bc4925a06045 warp-3.4.15/Network/Wai/Handler/Warp/ShuttingDown.hs +formatted a531dacd44be warp-3.4.15/Network/Wai/Handler/Warp/Types.hs +formatted f1ff20ab87da warp-3.4.15/Network/Wai/Handler/Warp/Windows.hs +formatted 2bef9620132e warp-3.4.15/Network/Wai/Handler/Warp/WithApplication.hs +formatted f3a2c7ee7659 warp-3.4.15/bench/Parser.hs +formatted 8f739e595518 warp-3.4.15/test/BufferSpec.hs +formatted 6d25fc643699 warp-3.4.15/test/ConduitSpec.hs +formatted 103842d1ec84 warp-3.4.15/test/ConnectionSpec.hs +formatted 7d698edc37d0 warp-3.4.15/test/EarlyHintsSpec.hs +formatted 3b37c702fe26 warp-3.4.15/test/ExceptionSpec.hs +formatted 6da076d7c2ae warp-3.4.15/test/FdCacheSpec.hs +formatted f91844cc6a8f warp-3.4.15/test/FileSpec.hs +formatted 0ba618e41ab1 warp-3.4.15/test/GracefulShutdownSpec.hs +formatted c99958718db1 warp-3.4.15/test/HTTP.hs +formatted 70bab0349402 warp-3.4.15/test/PackIntSpec.hs +formatted c0ed531ac6d7 warp-3.4.15/test/ReadIntSpec.hs +formatted 203ea20f13bf warp-3.4.15/test/RequestSpec.hs +formatted 4ef55f7e523c warp-3.4.15/test/ResponseHeaderSpec.hs +formatted ac591a85b19f warp-3.4.15/test/ResponseSpec.hs +formatted 190ad2e064b1 warp-3.4.15/test/RunSpec.hs +formatted 12d7c8bf7283 warp-3.4.15/test/SendFileSpec.hs +formatted 56bf11ebdf68 warp-3.4.15/test/ServerStateSpec.hs +formatted 2fbd14b119a4 warp-3.4.15/test/Spec.hs +formatted 6239c41d8ad7 warp-3.4.15/test/WithApplicationSpec.hs +formatted c61ebeab72e9 warp-3.4.15/test/doctests.hs +formatted c3a0978b358e xmonad-0.18.1/Main.hs +formatted 147fdbecf10c xmonad-0.18.1/man/xmonad.hs +formatted 1b9e38e5ffc2 xmonad-0.18.1/src/XMonad.hs +formatted d5ed6e53aeb6 xmonad-0.18.1/src/XMonad/Config.hs +formatted a69fbe62400f xmonad-0.18.1/src/XMonad/Core.hs +formatted 16d9eaa37934 xmonad-0.18.1/src/XMonad/Layout.hs +formatted 185beff032bf xmonad-0.18.1/src/XMonad/Main.hs +formatted fececd53a9f5 xmonad-0.18.1/src/XMonad/ManageHook.hs +formatted 1ce7bcb56804 xmonad-0.18.1/src/XMonad/Operations.hs +formatted 436b2faa58c9 xmonad-0.18.1/src/XMonad/StackSet.hs +formatted 710ec0764541 xmonad-0.18.1/tests/Instances.hs +formatted 682615fd57ec xmonad-0.18.1/tests/Properties.hs +formatted b9cbebbac632 xmonad-0.18.1/tests/Properties/Delete.hs +formatted 2b2b85b4c7fe xmonad-0.18.1/tests/Properties/Failure.hs +formatted 2825306e83f9 xmonad-0.18.1/tests/Properties/Floating.hs +formatted ae9be34908bc xmonad-0.18.1/tests/Properties/Focus.hs +formatted 1418915d6ac8 xmonad-0.18.1/tests/Properties/GreedyView.hs +formatted ff83b882ad73 xmonad-0.18.1/tests/Properties/Insert.hs +formatted 2d0f361b70f7 xmonad-0.18.1/tests/Properties/Layout/Full.hs +formatted d216f32ba806 xmonad-0.18.1/tests/Properties/Layout/Tall.hs +formatted 65709ceae761 xmonad-0.18.1/tests/Properties/Screen.hs +formatted 13ed9089c892 xmonad-0.18.1/tests/Properties/Shift.hs +formatted 879d6f9db8a2 xmonad-0.18.1/tests/Properties/Stack.hs +formatted 7384642a8941 xmonad-0.18.1/tests/Properties/StackSet.hs +formatted e48be0e8732d xmonad-0.18.1/tests/Properties/Swap.hs +formatted f6f63b59cfb0 xmonad-0.18.1/tests/Properties/View.hs +formatted ef9aade1e2ca xmonad-0.18.1/tests/Properties/Workspace.hs +formatted 87ba4b32b250 xmonad-0.18.1/tests/Utils.hs +formatted d8adcc5e8871 yesod-core-1.7.0.0/bench/widget.hs +formatted 810a9b2932db yesod-core-1.7.0.0/src/Yesod/Core.hs +formatted 76a91abab9c7 yesod-core-1.7.0.0/src/Yesod/Core/Class/Breadcrumbs.hs +formatted 5eb301cd4009 yesod-core-1.7.0.0/src/Yesod/Core/Class/Dispatch.hs +formatted 4e0e4c27884b yesod-core-1.7.0.0/src/Yesod/Core/Class/Dispatch/ToParentRoute.hs +formatted f5e77d45ac7f yesod-core-1.7.0.0/src/Yesod/Core/Class/Handler.hs +formatted b609ce0ae4aa yesod-core-1.7.0.0/src/Yesod/Core/Class/Yesod.hs +formatted 7b7185683c72 yesod-core-1.7.0.0/src/Yesod/Core/Content.hs +formatted 8f8e6e5fb762 yesod-core-1.7.0.0/src/Yesod/Core/Dispatch.hs +formatted a266e1ec29d7 yesod-core-1.7.0.0/src/Yesod/Core/Handler.hs +formatted 88d4d8c2323a yesod-core-1.7.0.0/src/Yesod/Core/Internal.hs +formatted 212235b50682 yesod-core-1.7.0.0/src/Yesod/Core/Internal/LiteApp.hs +formatted ca64c4e6d606 yesod-core-1.7.0.0/src/Yesod/Core/Internal/Request.hs +formatted bbb065ca69ff yesod-core-1.7.0.0/src/Yesod/Core/Internal/Response.hs +formatted 3032144ec1d6 yesod-core-1.7.0.0/src/Yesod/Core/Internal/Run.hs +formatted da5ec533b3d0 yesod-core-1.7.0.0/src/Yesod/Core/Internal/Session.hs +formatted 7d85bdcde5ef yesod-core-1.7.0.0/src/Yesod/Core/Internal/TH.hs +formatted a4d70c77b953 yesod-core-1.7.0.0/src/Yesod/Core/Internal/Util.hs +formatted 3c6023c01f8d yesod-core-1.7.0.0/src/Yesod/Core/Json.hs +formatted 3d3ea6cd2254 yesod-core-1.7.0.0/src/Yesod/Core/TypeCache.hs +formatted aa67fd550b47 yesod-core-1.7.0.0/src/Yesod/Core/Types.hs +formatted 38102a09e32a yesod-core-1.7.0.0/src/Yesod/Core/Types/Content.hs +formatted 49991219fbf5 yesod-core-1.7.0.0/src/Yesod/Core/Types/ErrorResponse.hs +formatted 2f42d728713c yesod-core-1.7.0.0/src/Yesod/Core/Types/HandlerContents.hs +formatted eea90c376092 yesod-core-1.7.0.0/src/Yesod/Core/Types/TypedContent.hs +formatted abfe32d3eadd yesod-core-1.7.0.0/src/Yesod/Core/Unsafe.hs +formatted 1620502b047c yesod-core-1.7.0.0/src/Yesod/Core/Widget.hs +formatted b35c9ac0daff yesod-core-1.7.0.0/src/Yesod/Routes/Class.hs +formatted 06717cf94aef yesod-core-1.7.0.0/src/Yesod/Routes/Overlap.hs +formatted 728c1336d2fd yesod-core-1.7.0.0/src/Yesod/Routes/Parse.hs +formatted 7bcf63c3b7e5 yesod-core-1.7.0.0/src/Yesod/Routes/TH.hs +formatted aba7c8cd51ca yesod-core-1.7.0.0/src/Yesod/Routes/TH/Dispatch.hs +formatted a463b5f83292 yesod-core-1.7.0.0/src/Yesod/Routes/TH/Internal.hs +formatted f88d33d3ea28 yesod-core-1.7.0.0/src/Yesod/Routes/TH/ParseRoute.hs +formatted dbc4eb3d7e58 yesod-core-1.7.0.0/src/Yesod/Routes/TH/RenderRoute.hs +formatted 3baa6af3d56d yesod-core-1.7.0.0/src/Yesod/Routes/TH/RouteAttrs.hs +formatted b435513e2c49 yesod-core-1.7.0.0/src/Yesod/Routes/TH/Types.hs +formatted 4cf83d0b0f07 yesod-core-1.7.0.0/test/Hierarchy.hs +formatted acf61854d2ec yesod-core-1.7.0.0/test/Hierarchy/Admin.hs +formatted 38126f8a1ed6 yesod-core-1.7.0.0/test/Hierarchy/Nest.hs +formatted a739150f03f1 yesod-core-1.7.0.0/test/Hierarchy/Nest2.hs +formatted 1998d7e7b6f0 yesod-core-1.7.0.0/test/Hierarchy/Nest2/NestInner.hs +formatted 6e683051218c yesod-core-1.7.0.0/test/Hierarchy/Nest3.hs +formatted 8f1d12dc181e yesod-core-1.7.0.0/test/Hierarchy/ResourceTree.hs +formatted f70ab72cd608 yesod-core-1.7.0.0/test/Route/DeepAritySpec.hs +formatted 1a22181a9cf2 yesod-core-1.7.0.0/test/Route/DeepArityTypes.hs +formatted 6cf89c893af0 yesod-core-1.7.0.0/test/Route/DiscoveryModeSpec.hs +formatted 8742e593c3d0 yesod-core-1.7.0.0/test/Route/FallthroughSpec.hs +formatted 83547078da44 yesod-core-1.7.0.0/test/Route/FocusLeafConsSpec.hs +formatted b96279c392b7 yesod-core-1.7.0.0/test/Route/InlineParseClausesSpec.hs +formatted d8f6752d05e7 yesod-core-1.7.0.0/test/Route/InstanceProbeSpec.hs +formatted 5f762e160869 yesod-core-1.7.0.0/test/Route/InstanceProbeTypes.hs +formatted 66f474c75dbf yesod-core-1.7.0.0/test/Route/MissingFocusTargetSpec.hs +formatted 4ca53b8c21db yesod-core-1.7.0.0/test/Route/MissingFocusTargetTypes.hs +formatted c4733044c565 yesod-core-1.7.0.0/test/Route/NestedParseClausesSpec.hs +formatted 96c9db79de94 yesod-core-1.7.0.0/test/Route/PureQ.hs +formatted 1084d2ca990f yesod-core-1.7.0.0/test/Route/RenderRouteSpec.hs +formatted 5cf00838dae7 yesod-core-1.7.0.0/test/Route/RouteAttrSpec.hs +formatted 9303c7a203b3 yesod-core-1.7.0.0/test/Route/SubDispatchAritySpec.hs +formatted 141148a01530 yesod-core-1.7.0.0/test/RouteSpec.hs +formatted 456251f78b44 yesod-core-1.7.0.0/test/YesodCoreTest.hs +formatted f0034c742a78 yesod-core-1.7.0.0/test/YesodCoreTest/Auth.hs +formatted 3a700bfeb45e yesod-core-1.7.0.0/test/YesodCoreTest/BangSeparatorRuntime.hs +formatted 33355032a6ea yesod-core-1.7.0.0/test/YesodCoreTest/Breadcrumb.hs +formatted 6192a640749e yesod-core-1.7.0.0/test/YesodCoreTest/Cache.hs +formatted 5731b7743f4b yesod-core-1.7.0.0/test/YesodCoreTest/CleanPath.hs +formatted 36a004c6a4e3 yesod-core-1.7.0.0/test/YesodCoreTest/Content.hs +formatted 6d11e0679e7e yesod-core-1.7.0.0/test/YesodCoreTest/Csrf.hs +formatted a73924c2a367 yesod-core-1.7.0.0/test/YesodCoreTest/ErrorHandling.hs +formatted d369eb73b47a yesod-core-1.7.0.0/test/YesodCoreTest/ErrorHandling/CustomApp.hs +formatted 75e0dffb40ce yesod-core-1.7.0.0/test/YesodCoreTest/Exceptions.hs +formatted 82e178e31f61 yesod-core-1.7.0.0/test/YesodCoreTest/FallthroughDispatch/Resources.hs +formatted e4f8f0ea3e72 yesod-core-1.7.0.0/test/YesodCoreTest/FallthroughDispatch/Runtime.hs +formatted 4d5c1d9a3551 yesod-core-1.7.0.0/test/YesodCoreTest/FallthroughMatrix/FirstFoo.hs +formatted bd497866625d yesod-core-1.7.0.0/test/YesodCoreTest/FallthroughMatrix/Resources.hs +formatted 8c70739a50e7 yesod-core-1.7.0.0/test/YesodCoreTest/FallthroughMatrix/Runtime.hs +formatted 2ec1229d8e62 yesod-core-1.7.0.0/test/YesodCoreTest/Header.hs +formatted 964ef508ce0f yesod-core-1.7.0.0/test/YesodCoreTest/InternalRequest.hs +formatted f7afe29ae117 yesod-core-1.7.0.0/test/YesodCoreTest/JsAttributes.hs +formatted 84646813873d yesod-core-1.7.0.0/test/YesodCoreTest/JsLoader.hs +formatted f8cdd188f370 yesod-core-1.7.0.0/test/YesodCoreTest/JsLoaderSites/Bottom.hs +formatted bda9b1f5f2d2 yesod-core-1.7.0.0/test/YesodCoreTest/Json.hs +formatted 23181a127cee yesod-core-1.7.0.0/test/YesodCoreTest/Links.hs +formatted ab54e89c96fb yesod-core-1.7.0.0/test/YesodCoreTest/LiteApp.hs +formatted cc9f882fd64b yesod-core-1.7.0.0/test/YesodCoreTest/Media.hs +formatted 0078c3a7e79d yesod-core-1.7.0.0/test/YesodCoreTest/MediaData.hs +formatted 46b0e2d1153d yesod-core-1.7.0.0/test/YesodCoreTest/Meta.hs +formatted d8beeb52123f yesod-core-1.7.0.0/test/YesodCoreTest/MultiPieceNestedRuntime.hs +formatted fb29902bb9c5 yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/InnerR.hs +formatted 4c9ceb4fb663 yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/NestR.hs +formatted 4aed48f429ab yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/Parent0R.hs +formatted 0f8ca6cd8fe6 yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/Parent0R/Child0R.hs +formatted 762195ad3d8f yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/ParentR.hs +formatted 7587ed701299 yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/Resources.hs +formatted 36defe4aa862 yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/Runtime.hs +formatted 2c72e04ebbc2 yesod-core-1.7.0.0/test/YesodCoreTest/NoOverloadedStrings.hs +formatted 320b6668f0c5 yesod-core-1.7.0.0/test/YesodCoreTest/NoOverloadedStringsSub.hs +formatted ab80a9a09e84 yesod-core-1.7.0.0/test/YesodCoreTest/ParamDefaultSplit/Data.hs +formatted a8472a7588f7 yesod-core-1.7.0.0/test/YesodCoreTest/ParamDefaultSplit/Runtime.hs +formatted 3b1830a98315 yesod-core-1.7.0.0/test/YesodCoreTest/ParamFallthroughRuntime.hs +formatted 9191317f2178 yesod-core-1.7.0.0/test/YesodCoreTest/ParamFocusSplit/Resources.hs +formatted 0d171db106f1 yesod-core-1.7.0.0/test/YesodCoreTest/ParamFocusSplit/Runtime.hs +formatted 6f7510d0b57c yesod-core-1.7.0.0/test/YesodCoreTest/ParamFocusSplit/SubR.hs +formatted 46dbd15fa23d yesod-core-1.7.0.0/test/YesodCoreTest/ParamNestedNoFallthroughRuntime.hs +formatted 32c5372b9148 yesod-core-1.7.0.0/test/YesodCoreTest/ParamNoExplicitArgs.hs +formatted 30470908614f yesod-core-1.7.0.0/test/YesodCoreTest/ParamNoFallthroughRuntime.hs +formatted cf6ee78ba4ee yesod-core-1.7.0.0/test/YesodCoreTest/ParamSubsite/Data.hs +formatted e0dfb958d109 yesod-core-1.7.0.0/test/YesodCoreTest/ParamSubsite/InstanceRuntime.hs +formatted 020a44aa16b1 yesod-core-1.7.0.0/test/YesodCoreTest/ParamSubsite/SplitNested.hs +formatted f8d1220c3bf2 yesod-core-1.7.0.0/test/YesodCoreTest/ParamSubsite/SplitRuntime.hs +formatted 1981b86c26db yesod-core-1.7.0.0/test/YesodCoreTest/ParamTopLevelRuntime.hs +formatted f991cd7adeb7 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite.hs +formatted 0476a7be2abf yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/Compat.hs +formatted b2b143cf4a47 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/PolyAny.hs +formatted eb56902b1432 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/PolyShow.hs +formatted acaebbfebc7a yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/SubRoute.hs +formatted 48e797fc7ef7 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubData.hs +formatted 18a74bf9331c yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubDispatch.hs +formatted eb2ad79d2f60 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubDispatch/Data.hs +formatted c0c9e30ebea8 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubDispatchRuntime.hs +formatted 09c5b840c977 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubDispatchRuntime/Data.hs +formatted 4555e2245690 yesod-core-1.7.0.0/test/YesodCoreTest/RawResponse.hs +formatted de49c81693c6 yesod-core-1.7.0.0/test/YesodCoreTest/Redirect.hs +formatted ddda63d607db yesod-core-1.7.0.0/test/YesodCoreTest/RenderRouteSpec.hs +formatted 139e78486aea yesod-core-1.7.0.0/test/YesodCoreTest/RenderRouteSpec/TH.hs +formatted 73425f7bb9ab yesod-core-1.7.0.0/test/YesodCoreTest/Reps.hs +formatted e18610f848a2 yesod-core-1.7.0.0/test/YesodCoreTest/RequestBodySize.hs +formatted bf72ad1f5d18 yesod-core-1.7.0.0/test/YesodCoreTest/RuntimeHarness.hs +formatted e78bf62c9259 yesod-core-1.7.0.0/test/YesodCoreTest/SplitSubsite/Data.hs +formatted d553ab39b43f yesod-core-1.7.0.0/test/YesodCoreTest/SplitSubsite/NestedR.hs +formatted 1f144a63c0ce yesod-core-1.7.0.0/test/YesodCoreTest/SplitSubsite/Runtime.hs +formatted a05df238a9e5 yesod-core-1.7.0.0/test/YesodCoreTest/Ssl.hs +formatted 203d5f3df4f0 yesod-core-1.7.0.0/test/YesodCoreTest/Streaming.hs +formatted 4a163efbc574 yesod-core-1.7.0.0/test/YesodCoreTest/StubLaxSameSite.hs +formatted 5831f923349c yesod-core-1.7.0.0/test/YesodCoreTest/StubSslOnly.hs +formatted 6510112ce4b4 yesod-core-1.7.0.0/test/YesodCoreTest/StubStrictSameSite.hs +formatted 9cb2274c1880 yesod-core-1.7.0.0/test/YesodCoreTest/StubUnsecured.hs +formatted 1f8bcbc31bb2 yesod-core-1.7.0.0/test/YesodCoreTest/SubSub.hs +formatted e3aad0dd9042 yesod-core-1.7.0.0/test/YesodCoreTest/SubSubData.hs +formatted dbed829ecef5 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteFallthrough/Data.hs +formatted 6ef87c226f01 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteFallthrough/Nested.hs +formatted d5e98e912280 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteFallthrough/Runtime.hs +formatted fffa6b1eb3e9 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteOptsFallthrough/Data.hs +formatted a30c02d77457 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteOptsFallthrough/Runtime.hs +formatted 353abcbca9cc yesod-core-1.7.0.0/test/YesodCoreTest/WaiSubsite.hs +formatted 67eac096b1a7 yesod-core-1.7.0.0/test/YesodCoreTest/Widget.hs +formatted a3265609217d yesod-core-1.7.0.0/test/YesodCoreTest/YesodTest.hs +formatted 4c3c5fb5bdaf yesod-core-1.7.0.0/test/YesodCoreTest/ZeroPieceShadow/FallApp.hs +formatted b332d1f4e633 yesod-core-1.7.0.0/test/YesodCoreTest/ZeroPieceShadow/ShadowApp.hs +formatted 829a6148e881 yesod-core-1.7.0.0/test/YesodCoreTest/ZeroPieceShadowRuntime.hs +formatted 23bd2996a55a yesod-core-1.7.0.0/test/test.hs diff --git a/corpora/hackage/hackage.report b/corpora/hackage/hackage.report new file mode 100644 --- /dev/null +++ b/corpora/hackage/hackage.report @@ -0,0 +1,481 @@ +Why every example of this corpus that is not `formatted` is not. + +Generated beside the manifest, and compared against nothing: this +file is the work list, and it is free to say as much as it likes. + +5202 examples, 5137 formatted. + +========================================================================== +broken (7) +========================================================================== + +Agda-2.8.0/src/full/Agda/TypeChecking/Conversion.hs + a configuration of the output does not parse: 2240:17: parse error (possibly incorrect indentation or mismatched brackets) + 2236 blocker = getBlocker s1b + 2237 -- Jesper, 2019-12-27: SizeUniv is disabled at the moment. + 2238 if + 2239 {- sizedTypesEnabled || -} | propEnabled || cubicalEnabled -> + > 2240 case funSort' s1 (Type l2) of + 2241 -- If the work we did makes the @funSort@ compute, + 2242 -- continue working. + 2243 Right s -> equalSort (Type l) s + 2244 -- Otherwise: postpone + + --- input + +++ output + @@ -1,137 +1,131 @@ + {-# LANGUAGE CPP #-} + {-# LANGUAGE NondecreasingIndentation #-} + - + #if __GLASGOW_HASKELL__ >= 810 + {-# OPTIONS_GHC -fmax-pmcheck-models=390 #-} -- Andreas, 2023-05-12, limit determined by binary search + #endif + + module Agda.TypeChecking.Conversion where + + -import Control.Arrow (second) + -import Control.Monad.Except ( MonadError(..) ) + - + -import Data.Function (on) + -import Data.Semigroup ((<>)) + -import Data.IntMap (IntMap) + - + -import qualified Data.List as List + -import qualified Data.IntMap as IntMap + -import qualified Data.IntSet as IntSet + -import qualified Data.Set as Set + - + +import Agda.Interaction.Options + import Agda.Syntax.Common + +import Agda.Syntax.Common.Pretty (prettyShow) + import Agda.Syntax.Internal + import Agda.Syntax.Internal.MetaVars + import Agda.Syntax.Translation.InternalToAbstract (reify) + - + -import Agda.TypeChecking.Monad + -import Agda.TypeChecking.MetaVars + -import Agda.TypeChecking.MetaVars.Occurs (killArgs,PruneResult(..),rigidVarsNotContainedIn) + -import Agda.TypeChecking.Names + -import Agda.TypeChecking.Reduce + -import Agda.TypeChecking.Substitute + -import qualified Agda.TypeChecking.SyntacticEquality as SynEq + -import Agda.TypeChecking.Telescope + import Agda.TypeChecking.Constraints + import Agda.TypeChecking.Conversion.Pure (pureCompareAs, runPureConversion) + +import Agda.TypeChecking.Da + +dlist-1.0/Data/DList.hs + a configuration of the input does not parse: 54:13: parse error on input `Nil' + --- input + +++ output + @@ -1,6 +1,5 @@ + {- ORMOLU_DISABLE -} + {-# LANGUAGE CPP #-} + - + -- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list + #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 800 + {-# LANGUAGE PatternSynonyms #-} + @@ -41,23 +40,33 @@ + + module Data.DList + ( -- * Difference List Type + - + --- CPP: GHC >= 8 for pattern synonyms allowed in the constructor + #if __GLASGOW_HASKELL__ >= 800 + + + + -- CPP: GHC >= 8 for pattern synonyms allowed in the constructor + DList (Nil, Cons), + + + + -- * Conversion + #else + + + + -- CPP: GHC >= 8 for pattern synonyms allowed in the constructor + DList, + + --- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list + #if __GLASGOW_HASKELL__ >= 708 + + + + -- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list + + + -- ** Bundled Patterns + pattern Nil, + pattern Cons, + -#endif + + -#endif + + -- * Conversion + +#else + + + -- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list + + + -- * Conversion + +#endif + +#endif + fromList, + toList, + apply, + +hashable-1.5.1.0/tests/Regress.hs + formatting changed how many configurations there are, from 6 to 8 + --- input + +++ output + @@ -4,126 +4,190 @@ + + module Regress (regressions) where + + -import Test.Tasty (TestTree, testGroup) + import Control.Monad (when) + -import Test.Tasty.HUnit (testCase, Assertion, assertFailure, (@?=)) + -import Test.Tasty.QuickCheck (testProperty) + -import GHC.Generics (Generic) + -import Data.List (nub) + -import Data.Fixed (Pico) + -import Data.Text (Text) + import Data.ByteString (ByteString) + - + -import qualified Data.Text.Lazy as TL + import qualified Data.ByteString.Char8 as BS8 + import qualified Data.ByteString.Lazy as BSL + import qualified Data.ByteString.Lazy.Char8 as BSL8 + - + +import Data.Fixed (Pico) + +import Data.List (nub) + +import Data.Text (Text) + +import qualified Data.Text.Lazy as TL + +import GHC.Generics (Generic) + +import Test.Tasty (TestTree, testGroup) + +import Test.Tasty.HUnit (Assertion, assertFailure, testCase, (@?=)) + +import Test.Tasty.QuickCheck (testProperty) + #ifdef HAVE_MMAP + import qualified Regress.Mmap as Mmap + #endif + - + import Data.Hashable + + #include "MachDeps.h" + + -assertInequal :: Eq a => String -> a -> a -> Assertion + +assertInequal :: (Eq a) => String -> a -> a -> Assertion + assertInequal msg x y + - | x == y = assertFailure msg + - | otherwise = return () + + | x == y = assertFailure msg + + | otherwise = return () + + regressions :: [TestTree] + -regressions = [] ++ + +regressions = + + [] + #ifdef HAVE_MMAP + - Mmap.regressions ++ + - [ testCase "Fixed" $ do + - (hash (1 :: Pico) == hash (2 :: Pico)) @?= False + - ] ++ + -#endif + - [ testGroup "Generic: sum of nullary constructors" + - [ testCase "0" $ nullaryCase 0 S0 + - , testCase "1" $ nullaryCase 1 S1 + - , testCase "2" $ nullaryCase 2 S2 + - , testCase "3" $ nullaryCase 3 S3 + - , testCase "4" $ nullaryCase 4 S4 + - ] + … and 214 more lines + +hspec-core-2.11.17/src/Test/Hspec/Core/Compat.hs + formatting is non-idempotent + --- first pass + +++ second pass + @@ -78,17 +78,21 @@ + #endif + import Control.Concurrent + import Data.Bool as Imports (bool) + +#ifndef __MHS__ + +import GHC.IO.Exception + + ( IOErrorType (..), + + ioe_type, + + ) + +#endif + import System.Environment as Imports (lookupEnv) + -import Text.Read as Imports (readMaybe) + -import + #ifndef __MHS__ + - GHC.IO.Exception + #else + - System.IO.Error + -#endif + +import System.IO.Error + ( IOErrorType (..), + ioe_type, + ) + +#endif + +import Text.Read as Imports (readMaybe) + + isUnsupportedOperation :: IOError -> Bool + isUnsupportedOperation e = ioe_type e == UnsupportedOperation + +idris-1.3.4/src/Idris/AbsSyntax.hs + formatting is non-idempotent + --- first pass + +++ second pass + @@ -1517,9 +1517,8 @@ + mkShadow (NS x s) = NS (mkShadow x) s + + en :: + - Int -- \^ The quotation level - only transform terms that are used, not terms + - -- that are merely mentioned. + - -> + + Int -> -- \^ The quotation level - only transform terms that are used, not terms + + -- that are merely mentioned. + PTerm -> + PTerm + en 0 (PLam fc n nfc t s) + +leksah-0.16.2.2/src/IDE/Pane/PackageEditor.hs + the output cannot be formatted again: too many configurations to format + +lens-5.3.6/src/Control/Exception/Lens.hs + comments, in one configuration: `{-\n$setup\n>>> :set -XNoOverloadedStrings\n>>> :set -XScopedTypeVariables\n>>> import Control.Lens\n>>> import Control.Applicative\n>>> :m + Control.Exception Control.Monad Data.List Prelude\n\n>>> :m + Control.Exception.Context\n\n-}` became `{-\n$setup\n>>> :set -XNoOverloadedStrings\n>>> :set -XScopedTypeVariables\n>>> import Control.Lens\n>>> import Control.Applicative\n>>> :m + Control.Exception Control.Monad Data.List Prelude\n\n\n>>> :m + Control.Exception.Context\n\n\n\n\n\n\n-}` + --- input + +++ output + @@ -1,12 +1,11 @@ + {-# LANGUAGE CPP #-} + -{-# LANGUAGE Rank2Types #-} + {-# LANGUAGE FlexibleInstances #-} + -{-# LANGUAGE ScopedTypeVariables #-} + {-# LANGUAGE MultiParamTypeClasses #-} + -{-# LANGUAGE NoMonomorphismRestriction #-} + {-# LANGUAGE PatternSynonyms #-} + +{-# LANGUAGE Rank2Types #-} + +{-# LANGUAGE ScopedTypeVariables #-} + {-# LANGUAGE ViewPatterns #-} + - + +{-# LANGUAGE NoMonomorphismRestriction #-} + #ifdef TRUSTWORTHY + {-# LANGUAGE Trustworthy #-} + #endif + @@ -14,6 +13,7 @@ + #include "lens-common.h" + + ----------------------------------------------------------------------------- + + + -- | + -- Module : Control.Exception.Lens + -- Copyright : (C) 2012-16 Edward Kmett + @@ -31,139 +31,177 @@ + -- The combinators in this module have been generalized to work with + -- 'MonadCatch' instead of just 'Prelude.IO'. This enables them to be used + -- more easily in 'Monad' transformer stacks. + + + ---------------------------------------------------------------------------- + module Control.Exception.Lens + - ( + - -- * Handling + - catching, catching_ + - , handling, handling_ + - -- * Trying + - , trying, trying_ + - -- * Throwing + - , throwing + - , throwing_ + - , throwingM + - , throwingTo + - -- * Mapping + - , mappedException, mappedException' + - -- * Exceptions + - , exception + - , pattern Exception + - -- * Exception Handlers + - , Handleable(..) + - -- ** IOExceptions + - , AsIOException(..) + - , pattern IOException_ + - -- ** Arithmetic Exception + +========================================================================== +does-not-parse (2) +========================================================================== + +ansi-terminal-1.1.5/win/System/Console/ANSI/Windows/Win32/Types.hs + 49:1: parse error on input `#' + +leksah-0.16.2.2/src/IDE/Find.hs + 615:36: Bang pattern in expression context: !matchIndex + Did you mean to add a space after the '!'? + +========================================================================== +partly-checked (25) +========================================================================== + +QuickCheck-2.18.0.0/src/Test/QuickCheck.hs + 512 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +QuickCheck-2.18.0.0/src/Test/QuickCheck/Exception.hs + 192 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +async-2.2.6/Control/Concurrent/Async/Internal.hs + 1024 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +cryptonite-0.30/Crypto/Number/Compat.hs + 180 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +hspec-core-2.11.17/vendor/async-2.2.5/Control/Concurrent/Async.hs + 256 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +intero-0.1.40/src/GhciInfo.hs + 72 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +stm-2.5.3.1/Control/Monad/STM.hs + 72 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +text-2.1.4/src/Data/Text.hs + 192 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +th-abstraction-0.7.2.0/test/Main.hs + 4096 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Applicative/Backwards.hs + 3072 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Applicative/Lift.hs + 96 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Monad/Trans/Accum.hs + 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Monad/Trans/Except.hs + 1536 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Monad/Trans/Identity.hs + 12288 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Monad/Trans/Maybe.hs + 1536 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Monad/Trans/RWS/Lazy.hs + 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Monad/Trans/RWS/Strict.hs + 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Monad/Trans/Reader.hs + 24576 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Monad/Trans/State/Lazy.hs + 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Monad/Trans/State/Strict.hs + 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Monad/Trans/Writer/Lazy.hs + 1024 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Control/Monad/Trans/Writer/Strict.hs + 1024 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/Data/Functor/Reverse.hs + 6144 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +transformers-0.6.3.0/legacy/pre711/Data/Functor/Product.hs + 128 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +unliftio-0.2.25.1/src/UnliftIO/Directory.hs + 1024 configurations is more than the 64 this checks, so only the ones varying a single conditional were compared + +========================================================================== +declined (31) +========================================================================== + +Agda-2.8.0/src/full/Agda/Main.hs + too many configurations to format + +QuickCheck-2.18.0.0/src/Test/QuickCheck/Arbitrary.hs + too many configurations to format + +QuickCheck-2.18.0.0/src/Test/QuickCheck/Function.hs + too many configurations to format + +QuickCheck-2.18.0.0/src/Test/QuickCheck/Modifiers.hs + too many configurations to format + +QuickCheck-2.18.0.0/src/Test/QuickCheck/Monadic.hs + too many configurations to format + +QuickCheck-2.18.0.0/src/Test/QuickCheck/Property.hs + QuickCheck-2.18.0.0/src/Test/QuickCheck/Property.hs:315:13-14: parse error on input `::', in the configuration taking #ifndef NO_TYPEABLE, then #ifndef NO_SAFE_HASKELL, then #ifndef NO_TIMEOUT, then #if defined(MIN_VERSION_base), then #ifndef NO_DEEPSEQ, then #ifdef NO_TIMEOUT + +cryptonite-0.30/Crypto/Random/Entropy/Windows.hs + cryptonite-0.30/Crypto/Random/Entropy/Windows.hs:64:16-28: parse error on input `WINDOWS_CCONV', in the configuration taking #if defined(ARCH_X86) + +dlist-1.0/Data/DList/Internal.hs + too many configurations to format + +hashable-1.5.1.0/src/Data/Hashable/Class.hs + too many configurations to format + +hlint-3.10/data/HLint_TypeCheck.hs + a pragma that moves positions, which we do not rewrite + +hlint-3.10/src/Config/Yaml.hs + too many configurations to format + +idris-1.3.4/Setup.hs + too many configurations to format + +idris-1.3.4/src/Util/DynamicLinker.hs + idris-1.3.4/src/Util/DynamicLinker.hs:43:63: parse error on input `\', in the configuration taking #ifdef IDRIS_FFI, then #ifdef mingw32_HOST_OS, then #if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) \, then #ifndef mingw32_HOST_OS, then #ifdef linux_HOST_OS + +intero-0.1.40/src/InteractiveUI.hs + too many configurations to format + +intero-0.1.40/src/Main.hs + too many configurations to format + +lens-5.3.6/src/Control/Lens/Wrapped.hs + too many configurations to format + +lens-5.3.6/src/Language/Haskell/TH/Lens.hs + too many configurations to format + +lens-5.3.6/tests/properties.hs + lens-5.3.6/tests/properties.hs:118:26-28: parse error on input `KVS' + +microlens-0.5.0.0/src/Lens/Micro.hs + too many configurations to format + +microlens-0.5.0.0/src/Lens/Micro/Internal.hs + too many configurations to format + +optics-0.4.2.1/tests/Optics/Tests/Utils.hs + optics-0.4.2.1/tests/Optics/Tests/Utils.hs:123:62: parse error on input `\', in the configuration taking #if __GLASGOW_HASKELL__ >= 802 && __GLASGOW_HASKELL__ <= 806, then #if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ <= 810, then #if __GLASGOW_HASKELL__ == 802, then #if __GLASGOW_HASKELL__ == 810, then #if __GLASGOW_HASKELL__ >= 806, then #if __GLASGOW_HASKELL__ <= 804, then #if __GLASGOW_HASKELL__ == 802 \, then #if __GLASGOW_HASKELL__ >= 900, then #if __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ <= 904, then #if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ <= 810 \ + +semigroupoids-6.0.2/src/Data/Functor/Bind/Class.hs + too many configurations to format + +shake-0.19.9/src/Development/Shake/Internal/FileInfo.hs + shake-0.19.9/src/Development/Shake/Internal/FileInfo.hs:149:16-23: parse error on input `CALLCONV', in the configuration taking #ifndef MIN_VERSION_unix, then #ifndef MIN_VERSION_time, then #elif defined(mingw32_HOST_OS), then #ifdef x86_64_HOST_ARCH + +shake-0.19.9/src/Development/Shake/Internal/History/Symlink.hs + shake-0.19.9/src/Development/Shake/Internal/History/Symlink.hs:31:16-23: parse error on input `CALLCONV', in the configuration taking #ifdef mingw32_HOST_OS, then #ifdef x86_64_HOST_ARCH + +shake-0.19.9/src/Development/Shake/Internal/Progress.hs + shake-0.19.9/src/Development/Shake/Internal/Progress.hs:44:16-23: parse error on input `CALLCONV', in the configuration taking #ifdef mingw32_HOST_OS, then #ifdef x86_64_HOST_ARCH + +shake-0.19.9/src/General/EscCodes.hs + shake-0.19.9/src/General/EscCodes.hs:52:16-23: parse error on input `CALLCONV', in the configuration taking #ifdef mingw32_HOST_OS, then #ifdef x86_64_HOST_ARCH + +shake-0.19.9/src/General/FileLock.hs + shake-0.19.9/src/General/FileLock.hs:28:16-23: parse error on input `CALLCONV', in the configuration taking #ifdef mingw32_HOST_OS, then #ifdef x86_64_HOST_ARCH + +time-1.16.0.1/lib/Data/Time/Clock/Internal/CTimeval.hs + time-1.16.0.1/lib/Data/Time/Clock/Internal/CTimeval.hs:35:16-19: parse error on input `capi', in the configuration taking no branch of #if !defined(javascript_HOST_ARCH), then #ifndef mingw32_HOST_OS, then no branch of #if defined(javascript_HOST_ARCH) || defined(__MHS__) + +transformers-0.6.3.0/Data/Functor/Constant.hs + too many configurations to format + +transformers-0.6.3.0/legacy/pre709/Data/Functor/Identity.hs + too many configurations to format + +unordered-containers-0.2.21/Data/HashMap/Internal/Array.hs + unordered-containers-0.2.21/Data/HashMap/Internal/Array.hs:(266,9)-(267,31): Unexpected case expression in function application: + case writeSmallArray# (unMArray ary) i# b s of s' -> (# s', () #), in the configuration taking #if defined(ASSERTS), then #if defined(__GLASGOW_HASKELL__) + diff --git a/corpora/vendored/declaration/class/blank-lines-between-members-out.hs b/corpora/vendored/declaration/class/blank-lines-between-members-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/class/blank-lines-between-members-out.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DefaultSignatures #-} + +class Storable a where + put :: a -> Bytes + + -- for when there is no hand-written instance + default put :: (Generic a) => a -> Bytes + + -- which is what this then uses + put = genericPut + +class Sized a where + width :: a -> Int + + height :: a -> Int + +class Packed a where + pack :: a -> Bytes + unpack :: Bytes -> a + +type family Width a where + -- the ones that fit in a machine word + Width Int = 64 + Width Word = 64 + + -- and the ones that do not + Width Integer = Unbounded + Width Rational = Unbounded diff --git a/corpora/vendored/declaration/class/blank-lines-between-members.hs b/corpora/vendored/declaration/class/blank-lines-between-members.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/class/blank-lines-between-members.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DefaultSignatures #-} + +class Storable a where + put :: a -> Bytes + + -- for when there is no hand-written instance + default put :: Generic a => a -> Bytes + + -- which is what this then uses + put = genericPut + +class Sized a where + width :: a -> Int + + height :: a -> Int + +class Packed a where + pack :: a -> Bytes + unpack :: Bytes -> a + +type family Width a where + -- the ones that fit in a machine word + Width Int = 64 + Width Word = 64 + + -- and the ones that do not + Width Integer = Unbounded + Width Rational = Unbounded diff --git a/corpora/vendored/declaration/data/comment-above-a-documented-brace-out.hs b/corpora/vendored/declaration/data/comment-above-a-documented-brace-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/data/comment-above-a-documented-brace-out.hs @@ -0,0 +1,10 @@ +module Terminal.Size where + +data Size + = MkSize + -- static + { -- | how tall the terminal is + rows :: Int, + -- | how wide it is + columns :: Int + } diff --git a/corpora/vendored/declaration/data/comment-above-a-documented-brace.hs b/corpora/vendored/declaration/data/comment-above-a-documented-brace.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/data/comment-above-a-documented-brace.hs @@ -0,0 +1,10 @@ +module Terminal.Size where + +data Size + = MkSize + -- static + { rows :: Int + -- ^ how tall the terminal is + , columns :: Int + -- ^ how wide it is + } diff --git a/corpora/vendored/declaration/data/comment-above-a-moved-haddock-out.hs b/corpora/vendored/declaration/data/comment-above-a-moved-haddock-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/data/comment-above-a-moved-haddock-out.hs @@ -0,0 +1,9 @@ +module Terminal.Size where + +data Size = Size + { rows :: Int, + -- Measured once at startup; the terminal is not resized while we run. + + -- | How wide the terminal is. + columns :: Int + } diff --git a/corpora/vendored/declaration/data/comment-above-a-moved-haddock.hs b/corpora/vendored/declaration/data/comment-above-a-moved-haddock.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/data/comment-above-a-moved-haddock.hs @@ -0,0 +1,8 @@ +module Terminal.Size where + +data Size = Size + { rows :: Int + -- Measured once at startup; the terminal is not resized while we run. + , columns :: Int + -- ^ How wide the terminal is. + } diff --git a/corpora/vendored/declaration/data/comment-in-record-braces-out.hs b/corpora/vendored/declaration/data/comment-in-record-braces-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/data/comment-in-record-braces-out.hs @@ -0,0 +1,9 @@ +data Empty = Empty + { + -- room for fields later + } + +data One = One + { only :: Int + -- and nothing else + } diff --git a/corpora/vendored/declaration/data/comment-in-record-braces.hs b/corpora/vendored/declaration/data/comment-in-record-braces.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/data/comment-in-record-braces.hs @@ -0,0 +1,7 @@ +data Empty = Empty { + -- room for fields later + } + +data One = One { only :: Int + -- and nothing else + } diff --git a/corpora/vendored/declaration/data/haddock-with-a-blank-under-it-out.hs b/corpora/vendored/declaration/data/haddock-with-a-blank-under-it-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/data/haddock-with-a-blank-under-it-out.hs @@ -0,0 +1,8 @@ +module Terminal.Size where + +data Unit + = -- | measured in rows + -- + Rows + | -- | measured in columns + Columns diff --git a/corpora/vendored/declaration/data/haddock-with-a-blank-under-it.hs b/corpora/vendored/declaration/data/haddock-with-a-blank-under-it.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/data/haddock-with-a-blank-under-it.hs @@ -0,0 +1,8 @@ +module Terminal.Size where + +data Unit + = Rows + -- ^ measured in rows + -- + | Columns + -- ^ measured in columns diff --git a/corpora/vendored/declaration/type/lone-variable-context-out.hs b/corpora/vendored/declaration/type/lone-variable-context-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/type/lone-variable-context-out.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE RequiredTypeArguments #-} + +variable :: r => Int +variable = undefined + +applied :: (Show a) => a -> a +applied = id + +pair :: (r, s) => Int +pair = undefined + +variableAndApplied :: (r, Show a) => a +variableAndApplied = undefined + +nothing :: () => Int +nothing = undefined + +quotedVariable = describe (r => Int) + +quotedApplied = describe ((Show a) => a) + +quotedPair = describe ((r, s) => Int) diff --git a/corpora/vendored/declaration/type/lone-variable-context.hs b/corpora/vendored/declaration/type/lone-variable-context.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/type/lone-variable-context.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE RequiredTypeArguments #-} + +variable :: r => Int +variable = undefined + +applied :: Show a => a -> a +applied = id + +pair :: (r, s) => Int +pair = undefined + +variableAndApplied :: (r, Show a) => a +variableAndApplied = undefined + +nothing :: () => Int +nothing = undefined + +quotedVariable = describe (r => Int) + +quotedApplied = describe (Show a => a) + +quotedPair = describe ((r, s) => Int) diff --git a/corpora/vendored/declaration/value/comment-across-a-separator-out.hs b/corpora/vendored/declaration/value/comment-across-a-separator-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-across-a-separator-out.hs @@ -0,0 +1,29 @@ +-- A block comment closes itself, so it is printed where the region that +-- carries it is printed. It must not be carried back across the token that +-- opens a body, or it comes out in front of what is being defined. +plain = + {- one at a time -} + 1 + +withArguments n m = + {- takes two -} + n + m + +inAnAlternative n = + case n of + 0 -> + {- the base case -} + stop + _ -> go n + +-- Crossing a token in the middle of a construct is another matter: it +-- neither leaves the construct nor lands in front of it. +inTheMiddle n = + case n {- worth a look -} of + 0 -> stop + _ -> go n + +-- A line comment owns the rest of its line wherever it is put, so it stays +-- at the end of the line the author wrote it on. +heldBack n = -- one at a time + n diff --git a/corpora/vendored/declaration/value/comment-across-a-separator.hs b/corpora/vendored/declaration/value/comment-across-a-separator.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-across-a-separator.hs @@ -0,0 +1,26 @@ +-- A block comment closes itself, so it is printed where the region that +-- carries it is printed. It must not be carried back across the token that +-- opens a body, or it comes out in front of what is being defined. +plain = {- one at a time -} + 1 + +withArguments n m = {- takes two -} + n + m + +inAnAlternative n = + case n of + 0 -> {- the base case -} + stop + _ -> go n + +-- Crossing a token in the middle of a construct is another matter: it +-- neither leaves the construct nor lands in front of it. +inTheMiddle n = + case n of {- worth a look -} + 0 -> stop + _ -> go n + +-- A line comment owns the rest of its line wherever it is put, so it stays +-- at the end of the line the author wrote it on. +heldBack n = -- one at a time + n diff --git a/corpora/vendored/declaration/value/comment-after-do-out.hs b/corpora/vendored/declaration/value/comment-after-do-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-after-do-out.hs @@ -0,0 +1,8 @@ +warmEverything = + entries + >>= \entry -> -- one at a time, so a failure names the entry + warm entry + +reportOn entry = do -- the counters are read once, before any of this runs + hits <- readCounter entry + pure hits diff --git a/corpora/vendored/declaration/value/comment-after-do.hs b/corpora/vendored/declaration/value/comment-after-do.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-after-do.hs @@ -0,0 +1,8 @@ +warmEverything = + entries + >>= \entry -> -- one at a time, so a failure names the entry + warm entry + +reportOn entry = do -- the counters are read once, before any of this runs + hits <- readCounter entry + pure hits diff --git a/corpora/vendored/declaration/value/comment-below-keyword-out.hs b/corpora/vendored/declaration/value/comment-below-keyword-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-below-keyword-out.hs @@ -0,0 +1,27 @@ +afterAnEquals n = + let step = -- one at a time + -- and no faster than that + 1 + in n + step + +afterAnArrow n = + case compare n 0 of + GT -> -- above zero + -- so we climb + climb n + EQ -> stay + LT -> fall n + +afterThen n = + if n > 0 + then -- the only interesting branch + -- and the only one worth a remark + climb n + else fall n + +afterElse n = + if n > 0 + then climb n + else -- everything that is left + -- which is most of it + fall n diff --git a/corpora/vendored/declaration/value/comment-below-keyword.hs b/corpora/vendored/declaration/value/comment-below-keyword.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-below-keyword.hs @@ -0,0 +1,27 @@ +afterAnEquals n = + let step = -- one at a time + -- and no faster than that + 1 + in n + step + +afterAnArrow n = + case compare n 0 of + GT -> -- above zero + -- so we climb + climb n + EQ -> stay + LT -> fall n + +afterThen n = + if n > 0 + then -- the only interesting branch + -- and the only one worth a remark + climb n + else fall n + +afterElse n = + if n > 0 + then climb n + else -- everything that is left + -- which is most of it + fall n diff --git a/corpora/vendored/declaration/value/comment-carried-on-out.hs b/corpora/vendored/declaration/value/comment-carried-on-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-carried-on-out.hs @@ -0,0 +1,40 @@ +-- A comment lined up under a line that ended in one, with nothing below it +-- at that column, carries that remark on rather than beginning one about +-- what follows. +carriedOn xs ys = + [ (a, b) + | a <- + xs + + xs -- said once + -- and never twice + | b <- ys + ] + +-- The same, where what follows is not a sibling but nothing at all. +class + a -- said once + :+ b -- said twice + -- and a third time + +-- Code below at the comment's own column is code the comment sits over, +-- however the line above ended. +sitsOver = + opening + <> -- said once + -- and never twice + closing + +-- Lined up with nothing, because the line above was blank. +afterAGap = do + a -- + + bar + +-- Lined up with a line that has a comment on it but does not end in one, so +-- there is no remark above to carry on. +codeAfterTheComment = + g + (a {- said once -} + b) + -- and this is about something else + where + h = 1 diff --git a/corpora/vendored/declaration/value/comment-carried-on.hs b/corpora/vendored/declaration/value/comment-carried-on.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-carried-on.hs @@ -0,0 +1,38 @@ +-- A comment lined up under a line that ended in one, with nothing below it +-- at that column, carries that remark on rather than beginning one about +-- what follows. +carriedOn xs ys = + [ (a, b) + | a <- xs + + xs -- said once + -- and never twice + | b <- ys + ] + +-- The same, where what follows is not a sibling but nothing at all. +class + a -- said once + :+ b -- said twice + -- and a third time + +-- Code below at the comment's own column is code the comment sits over, +-- however the line above ended. +sitsOver = + opening + <> -- said once + -- and never twice + closing + +-- Lined up with nothing, because the line above was blank. +afterAGap = do + a -- + + bar + +-- Lined up with a line that has a comment on it but does not end in one, so +-- there is no remark above to carry on. +codeAfterTheComment = g + (a {- said once -} + b) + -- and this is about something else + where + h = 1 diff --git a/corpora/vendored/declaration/value/comment-in-operator-chain-out.hs b/corpora/vendored/declaration/value/comment-in-operator-chain-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-in-operator-chain-out.hs @@ -0,0 +1,20 @@ +everyOperandAnnotated = + base -- what we started from + + delta -- what was added + - refund -- and what came back + +annotatedOperators = + base + + delta -- the adjustment + - refund -- the reimbursement + +remarkBetweenOperatorAndOperand = + opening + <> -- said once + -- and never twice + closing + +lastOperandOnly = + first + `mappend` second + `mappend` third -- and no further diff --git a/corpora/vendored/declaration/value/comment-in-operator-chain.hs b/corpora/vendored/declaration/value/comment-in-operator-chain.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-in-operator-chain.hs @@ -0,0 +1,22 @@ +everyOperandAnnotated = + base -- what we started from + + delta -- what was added + - refund -- and what came back + +annotatedOperators = + base + + -- the adjustment + delta + - -- the reimbursement + refund + +remarkBetweenOperatorAndOperand = + opening + <> -- said once + -- and never twice + closing + +lastOperandOnly = + first + `mappend` second + `mappend` third -- and no further diff --git a/corpora/vendored/declaration/value/comment-on-record-wildcard-out.hs b/corpora/vendored/declaration/value/comment-on-record-wildcard-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-on-record-wildcard-out.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE RecordWildCards #-} + +wildcardAlone = + Shape + { .. -- whatever is in scope + } + +wildcardLast = + Shape + { name = "circle", + colour = Red, + .. -- and the radius comes from above + } + +wildcardWithARemarkAbove = + Shape + { name = "square", + -- the sides are already bound + .. -- so they need no mention + } + +wildcardInAPattern Shape {..} = name -- bound by the wildcard + +wildcardInAPatternWithFields + Shape + { name, -- named outright + .. + } = name diff --git a/corpora/vendored/declaration/value/comment-on-record-wildcard.hs b/corpora/vendored/declaration/value/comment-on-record-wildcard.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/comment-on-record-wildcard.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE RecordWildCards #-} + +wildcardAlone = + Shape + { .. -- whatever is in scope + } + +wildcardLast = + Shape + { name = "circle", + colour = Red, + .. -- and the radius comes from above + } + +wildcardWithARemarkAbove = + Shape + { name = "square", + -- the sides are already bound + .. -- so they need no mention + } + +wildcardInAPattern Shape {..} = name -- bound by the wildcard + +wildcardInAPatternWithFields + Shape + { name, -- named outright + .. + } = name diff --git a/corpora/vendored/declaration/value/function/arrow/comment-after-a-command-do-out.hs b/corpora/vendored/declaration/value/function/arrow/comment-after-a-command-do-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/function/arrow/comment-after-a-command-do-out.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE Arrows #-} + +module Cache.Pipeline where + +widen f = proc entry -> do -- one stage at a time, so a failure names the stage + warmed <- f -< entry + returnA -< warmed diff --git a/corpora/vendored/declaration/value/function/arrow/comment-after-a-command-do.hs b/corpora/vendored/declaration/value/function/arrow/comment-after-a-command-do.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/function/arrow/comment-after-a-command-do.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE Arrows #-} + +module Cache.Pipeline where + +widen f = proc entry -> do -- one stage at a time, so a failure names the stage + warmed <- f -< entry + returnA -< warmed diff --git a/corpora/vendored/declaration/value/operator-chain-precedence-out.hs b/corpora/vendored/declaration/value/operator-chain-precedence-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/operator-chain-precedence-out.hs @@ -0,0 +1,25 @@ +infixl 2 `stackOn` + +infix 9 `keyedBy` + +infixr 1 `orElse` + +onOneLine = base `stackOn` middle `keyedBy` name + +tighterOperatorNestsUnderLooser = + base + `stackOn` middle + `keyedBy` name + +behindADollar = + render $ + base + `stackOn` middle + `keyedBy` name + +oneLevelStaysFlat = first `orElse` second `orElse` third + +oneLevelStaysFlatWhenSpread = + first + `orElse` second + `orElse` third diff --git a/corpora/vendored/declaration/value/operator-chain-precedence.hs b/corpora/vendored/declaration/value/operator-chain-precedence.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/operator-chain-precedence.hs @@ -0,0 +1,21 @@ +infixl 2 `stackOn` + +infix 9 `keyedBy` + +infixr 1 `orElse` + +onOneLine = base `stackOn` middle `keyedBy` name + +tighterOperatorNestsUnderLooser = base + `stackOn` middle + `keyedBy` name + +behindADollar = render $ base + `stackOn` middle + `keyedBy` name + +oneLevelStaysFlat = first `orElse` second `orElse` third + +oneLevelStaysFlatWhenSpread = first + `orElse` second + `orElse` third diff --git a/corpora/vendored/declaration/value/quoted-type-arguments-out.hs b/corpora/vendored/declaration/value/quoted-type-arguments-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/quoted-type-arguments-out.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE LinearTypes #-} +{-# LANGUAGE RequiredTypeArguments #-} +{-# LANGUAGE UnicodeSyntax #-} + +plain = describe (Bool) + +arrow = describe (Char -> Bool) + +quantified = describe (forall k. Holder k) + +constrained = describe ((Readable r) => r) + +constrainedTwice = describe ((Readable r, Countable r) => r) + +linear = describe (Char %1 -> Bool) + +linearUnicode = describe (Char %1 -> Bool) + +multiplicity = describe (forall n. Char %n -> Bool) + +wrapped = + describe + ( ( forall k. + Holder k + ) + ) + +sprawling = + describe + ( forall k n. + (Readable k, Countable k) => + Holder k %n -> + Maybe + (Char, Word) %1 -> + Text + ) diff --git a/corpora/vendored/declaration/value/quoted-type-arguments.hs b/corpora/vendored/declaration/value/quoted-type-arguments.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/quoted-type-arguments.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE LinearTypes #-} +{-# LANGUAGE RequiredTypeArguments #-} +{-# LANGUAGE UnicodeSyntax #-} + +plain = describe (Bool) + +arrow = describe (Char -> Bool) + +quantified = describe (forall k. Holder k) + +constrained = describe (Readable r => r) + +constrainedTwice = describe ((Readable r, Countable r) => r) + +linear = describe (Char %1 -> Bool) + +linearUnicode = describe (Char ⊸ Bool) + +multiplicity = describe (forall n. Char %n -> Bool) + +wrapped = + describe + ( ( forall k. + Holder k + ) + ) + +sprawling = describe (forall k n. (Readable k, Countable k) + => Holder k + %n -> Maybe + (Char , Word) + ⊸ Text) diff --git a/corpora/vendored/import/a-comment-with-no-name-after-it-out.hs b/corpora/vendored/import/a-comment-with-no-name-after-it-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/a-comment-with-no-name-after-it-out.hs @@ -0,0 +1,10 @@ +module Ledger.Journal where + +import Ledger.Entry (entryDate) +import Ledger.Entry + ( entryNarration, + -- kept as written, trailing spaces and all + ) + +dated :: Entry -> Int +dated = entryDate diff --git a/corpora/vendored/import/a-comment-with-no-name-after-it.hs b/corpora/vendored/import/a-comment-with-no-name-after-it.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/a-comment-with-no-name-after-it.hs @@ -0,0 +1,10 @@ +module Ledger.Journal where + +import Ledger.Entry (entryDate) +import Ledger.Entry + ( entryNarration + -- kept as written, trailing spaces and all + ) + +dated :: Entry -> Int +dated = entryDate diff --git a/corpora/vendored/import/comment-in-import-list-out.hs b/corpora/vendored/import/comment-in-import-list-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/comment-in-import-list-out.hs @@ -0,0 +1,8 @@ +import Alpha + ( + -- nothing taken yet + ) +import Beta + ( one, + -- and nothing else + ) diff --git a/corpora/vendored/import/comment-in-import-list.hs b/corpora/vendored/import/comment-in-import-list.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/comment-in-import-list.hs @@ -0,0 +1,6 @@ +import Alpha ( + -- nothing taken yet + ) +import Beta (one + -- and nothing else + ) diff --git a/corpora/vendored/import/comment-inside-a-repeated-import-out.hs b/corpora/vendored/import/comment-inside-a-repeated-import-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/comment-inside-a-repeated-import-out.hs @@ -0,0 +1,17 @@ +module Cache.Report where + +import Cache.Entry + ( Entry + ( key + -- the path the entry was read from + ), + ) +import Cache.Entry + ( Entry + ( hits + -- counted since the last eviction + ), + ) + +describe :: Entry -> String +describe _ = "entry" diff --git a/corpora/vendored/import/comment-inside-a-repeated-import.hs b/corpora/vendored/import/comment-inside-a-repeated-import.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/comment-inside-a-repeated-import.hs @@ -0,0 +1,17 @@ +module Cache.Report where + +import Cache.Entry + ( Entry + ( key + -- the path the entry was read from + ) + ) +import Cache.Entry + ( Entry + ( hits + -- counted since the last eviction + ) + ) + +describe :: Entry -> String +describe _ = "entry" diff --git a/corpora/vendored/import/comment-inside-import-out.hs b/corpora/vendored/import/comment-inside-import-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/comment-inside-import-out.hs @@ -0,0 +1,3 @@ +import qualified + -- on a line of its own + Gamma diff --git a/corpora/vendored/import/comment-inside-import.hs b/corpora/vendored/import/comment-inside-import.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/comment-inside-import.hs @@ -0,0 +1,3 @@ +import qualified + -- on a line of its own + Gamma diff --git a/corpora/vendored/import/merging-around-an-anchored-comment-out.hs b/corpora/vendored/import/merging-around-an-anchored-comment-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/merging-around-an-anchored-comment-out.hs @@ -0,0 +1,13 @@ +module Ledger.Rules where + +import Ledger.Rule + ( ruleName, + rulePriority, + ) +import Ledger.Rule + ( ruleMatcher, + -- matched against the whole description + ) + +named :: Rule -> String +named = ruleName diff --git a/corpora/vendored/import/merging-around-an-anchored-comment.hs b/corpora/vendored/import/merging-around-an-anchored-comment.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/merging-around-an-anchored-comment.hs @@ -0,0 +1,11 @@ +module Ledger.Rules where + +import Ledger.Rule (ruleName) +import Ledger.Rule + ( ruleMatcher + -- matched against the whole description + ) +import Ledger.Rule (rulePriority) + +named :: Rule -> String +named = ruleName diff --git a/corpora/vendored/import/merging-keeps-a-comment-above-a-name-out.hs b/corpora/vendored/import/merging-keeps-a-comment-above-a-name-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/merging-keeps-a-comment-above-a-name-out.hs @@ -0,0 +1,11 @@ +module Ledger.Balance where + +import Ledger.Account + ( accountKind, + accountName, + -- carried in from the period before this one + accountOpening, + ) + +label :: Account -> String +label = accountName diff --git a/corpora/vendored/import/merging-keeps-a-comment-above-a-name.hs b/corpora/vendored/import/merging-keeps-a-comment-above-a-name.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/merging-keeps-a-comment-above-a-name.hs @@ -0,0 +1,11 @@ +module Ledger.Balance where + +import Ledger.Account (accountName) +import Ledger.Account + ( -- carried in from the period before this one + accountOpening, + accountKind + ) + +label :: Account -> String +label = accountName diff --git a/corpora/vendored/import/merging-keeps-a-comment-above-the-block-out.hs b/corpora/vendored/import/merging-keeps-a-comment-above-the-block-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/merging-keeps-a-comment-above-the-block-out.hs @@ -0,0 +1,10 @@ +module Telemetry.Report where + +-- both halves of a sink live in the one module +import Telemetry.Sink + ( sinkFlush, + sinkName, + ) + +describe :: Sink -> String +describe = sinkName diff --git a/corpora/vendored/import/merging-keeps-a-comment-above-the-block.hs b/corpora/vendored/import/merging-keeps-a-comment-above-the-block.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/merging-keeps-a-comment-above-the-block.hs @@ -0,0 +1,8 @@ +module Telemetry.Report where + +-- both halves of a sink live in the one module +import Telemetry.Sink (sinkName) +import Telemetry.Sink (sinkFlush) + +describe :: Sink -> String +describe = sinkName diff --git a/corpora/vendored/import/merging-keeps-a-comment-inside-a-thing-out.hs b/corpora/vendored/import/merging-keeps-a-comment-inside-a-thing-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/merging-keeps-a-comment-inside-a-thing-out.hs @@ -0,0 +1,12 @@ +module Survey.Render where + +import Survey.Form + ( Form + ( formLocale, + formPages, -- in the order they are shown + formTitle + ), + ) + +title :: Form -> String +title = formTitle diff --git a/corpora/vendored/import/merging-keeps-a-comment-inside-a-thing.hs b/corpora/vendored/import/merging-keeps-a-comment-inside-a-thing.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/merging-keeps-a-comment-inside-a-thing.hs @@ -0,0 +1,12 @@ +module Survey.Render where + +import Survey.Form (Form (formTitle)) +import Survey.Form + ( Form + ( formPages, -- in the order they are shown + formLocale + ) + ) + +title :: Form -> String +title = formTitle diff --git a/corpora/vendored/import/merging-keeps-a-trailing-comment-out.hs b/corpora/vendored/import/merging-keeps-a-trailing-comment-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/merging-keeps-a-trailing-comment-out.hs @@ -0,0 +1,10 @@ +module Ledger.Summary where + +import Ledger.Posting + ( postingAccount, + postingAmount, -- signed, negative for credits + postingDate, + ) + +total :: [Posting] -> Int +total = sum . map postingAmount diff --git a/corpora/vendored/import/merging-keeps-a-trailing-comment.hs b/corpora/vendored/import/merging-keeps-a-trailing-comment.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/merging-keeps-a-trailing-comment.hs @@ -0,0 +1,10 @@ +module Ledger.Summary where + +import Ledger.Posting (postingDate) +import Ledger.Posting + ( postingAccount, + postingAmount -- signed, negative for credits + ) + +total :: [Posting] -> Int +total = sum . map postingAmount diff --git a/corpora/vendored/import/sorting-keeps-comments-with-their-names-out.hs b/corpora/vendored/import/sorting-keeps-comments-with-their-names-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/sorting-keeps-comments-with-their-names-out.hs @@ -0,0 +1,11 @@ +module Survey.Answer where + +import Survey.Question + ( questionId, -- unique within a survey, not across surveys + -- answered before the respondent may go on + questionRequired, + questionText, + ) + +ask :: Question -> String +ask = questionText diff --git a/corpora/vendored/import/sorting-keeps-comments-with-their-names.hs b/corpora/vendored/import/sorting-keeps-comments-with-their-names.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/import/sorting-keeps-comments-with-their-names.hs @@ -0,0 +1,11 @@ +module Survey.Answer where + +import Survey.Question + ( questionText, + questionId, -- unique within a survey, not across surveys + -- answered before the respondent may go on + questionRequired + ) + +ask :: Question -> String +ask = questionText diff --git a/corpora/vendored/other/block-comment-above-a-haddock-out.hs b/corpora/vendored/other/block-comment-above-a-haddock-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/block-comment-above-a-haddock-out.hs @@ -0,0 +1,6 @@ +module Cache.Cold where + +{- Not exported: the eviction order is Cache.Warm's business. -} +-- | Drop everything the cache is holding. +cool :: IO () +cool = pure () diff --git a/corpora/vendored/other/block-comment-above-a-haddock.hs b/corpora/vendored/other/block-comment-above-a-haddock.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/block-comment-above-a-haddock.hs @@ -0,0 +1,6 @@ +module Cache.Cold where + +{- Not exported: the eviction order is Cache.Warm's business. -} +-- | Drop everything the cache is holding. +cool :: IO () +cool = pure () diff --git a/corpora/vendored/other/block-comment-under-a-haddock-out.hs b/corpora/vendored/other/block-comment-under-a-haddock-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/block-comment-under-a-haddock-out.hs @@ -0,0 +1,6 @@ +module Cache.Size where + +-- | How many entries the cache holds, which the type already fixes. +{-@ entries :: Cache n a -> {k : Int | k == n} @-} +entries :: Cache n a -> Int +entries = const 0 diff --git a/corpora/vendored/other/block-comment-under-a-haddock.hs b/corpora/vendored/other/block-comment-under-a-haddock.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/block-comment-under-a-haddock.hs @@ -0,0 +1,6 @@ +module Cache.Size where + +-- | How many entries the cache holds, which the type already fixes. +{-@ entries :: Cache n a -> {k : Int | k == n} @-} +entries :: Cache n a -> Int +entries = const 0 diff --git a/corpora/vendored/other/comment-above-the-first-binding-out.hs b/corpora/vendored/other/comment-above-the-first-binding-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-above-the-first-binding-out.hs @@ -0,0 +1,9 @@ +module Route.Fare where + +fare :: Int -> Int +fare riders = + let + -- the share the operator keeps + operator = 3 + levy = 1 + in operator * riders + levy diff --git a/corpora/vendored/other/comment-above-the-first-binding.hs b/corpora/vendored/other/comment-above-the-first-binding.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-above-the-first-binding.hs @@ -0,0 +1,9 @@ +module Route.Fare where + +fare :: Int -> Int +fare riders = + let + -- the share the operator keeps + operator = 3 + levy = 1 + in operator * riders + levy diff --git a/corpora/vendored/other/comment-above-the-in-keyword-out.hs b/corpora/vendored/other/comment-above-the-in-keyword-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-above-the-in-keyword-out.hs @@ -0,0 +1,8 @@ +module Route.Total where + +total :: Int -> Int +total stops = + let each = 12 + in + -- the sum every caller ends up wanting + each * stops diff --git a/corpora/vendored/other/comment-above-the-in-keyword.hs b/corpora/vendored/other/comment-above-the-in-keyword.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-above-the-in-keyword.hs @@ -0,0 +1,7 @@ +module Route.Total where + +total :: Int -> Int +total stops = + let each = 12 + -- the sum every caller ends up wanting + in each * stops diff --git a/corpora/vendored/other/comment-after-closing-bracket-out.hs b/corpora/vendored/other/comment-after-closing-bracket-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-after-closing-bracket-out.hs @@ -0,0 +1,27 @@ +tupleOfHalves = + combine + ( north, + south + ) -- the two halves + ( east, + west + ) -- and the other two + +nestedRuns = + render + [ [ alpha, + beta + ] -- the inner run + ] -- the outer run + +runningTotal = + weigh + ( heavier + + lighter + ) -- everything so far + +blockAfterBracket = + measure + ( width, + height + ) {- taken at the widest point -} diff --git a/corpora/vendored/other/comment-after-closing-bracket.hs b/corpora/vendored/other/comment-after-closing-bracket.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-after-closing-bracket.hs @@ -0,0 +1,22 @@ +tupleOfHalves = + combine + ( north, + south ) -- the two halves + ( east, + west ) -- and the other two + +nestedRuns = + render + [ [ alpha, + beta ] -- the inner run + ] -- the outer run + +runningTotal = + weigh + ( heavier + + lighter ) -- everything so far + +blockAfterBracket = + measure + ( width, + height ) {- taken at the widest point -} diff --git a/corpora/vendored/other/comment-after-header-pragma-out.hs b/corpora/vendored/other/comment-after-header-pragma-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-after-header-pragma-out.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} -- Foldable and Functor come with it +-- said about the pragma below, not about the module +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- until the instances move upstream +{-# OPTIONS_HADDOCK not-home #-} + +module Header where diff --git a/corpora/vendored/other/comment-after-header-pragma.hs b/corpora/vendored/other/comment-after-header-pragma.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-after-header-pragma.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DeriveTraversable #-} -- Foldable and Functor come with it +{-# LANGUAGE DeriveFunctor #-} + +-- said about the pragma below, not about the module +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- until the instances move upstream +{-# OPTIONS_HADDOCK not-home #-} + +module Header where diff --git a/corpora/vendored/other/comment-after-opening-bracket-out.hs b/corpora/vendored/other/comment-after-opening-bracket-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-after-opening-bracket-out.hs @@ -0,0 +1,37 @@ +import Data.List + ( + -- on a line of its own + sort, + ) + +parenthesised = + ( + -- on a line of its own + value + ) + +listed = + [ + -- on a line of its own + first, + second + ] + +typed :: + ( + -- on a line of its own + Int + ) +typed = 0 + +data Colour + = Red + | + -- on a line of its own + Green + +data Shape = Circle + { + -- on a line of its own + radius :: Int + } diff --git a/corpora/vendored/other/comment-after-opening-bracket.hs b/corpora/vendored/other/comment-after-opening-bracket.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-after-opening-bracket.hs @@ -0,0 +1,26 @@ +import Data.List + ( + -- on a line of its own + sort) + +parenthesised = ( + -- on a line of its own + value) + +listed = [ + -- on a line of its own + first, second] + +typed :: ( + -- on a line of its own + Int) +typed = 0 + +data Colour = + Red + -- on a line of its own + | Green + +data Shape = Circle { + -- on a line of its own + radius :: Int } diff --git a/corpora/vendored/other/comment-after-the-in-keyword-out.hs b/corpora/vendored/other/comment-after-the-in-keyword-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-after-the-in-keyword-out.hs @@ -0,0 +1,7 @@ +module Route.Trim where + +trim :: Int -> Int +trim n = + let kept = n - 1 + in -- rounded down on purpose + kept diff --git a/corpora/vendored/other/comment-after-the-in-keyword.hs b/corpora/vendored/other/comment-after-the-in-keyword.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-after-the-in-keyword.hs @@ -0,0 +1,7 @@ +module Route.Trim where + +trim :: Int -> Int +trim n = + let kept = n - 1 + in -- rounded down on purpose + kept diff --git a/corpora/vendored/other/comment-after-the-let-keyword-out.hs b/corpora/vendored/other/comment-after-the-let-keyword-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-after-the-let-keyword-out.hs @@ -0,0 +1,8 @@ +module Route.Cost where + +leg :: Int -> Int +leg n = + let -- charged once, whatever the distance + base = 40 + perStop = 7 + in base + perStop * n diff --git a/corpora/vendored/other/comment-after-the-let-keyword.hs b/corpora/vendored/other/comment-after-the-let-keyword.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-after-the-let-keyword.hs @@ -0,0 +1,8 @@ +module Route.Cost where + +leg :: Int -> Int +leg n = + let -- charged once, whatever the distance + base = 40 + perStop = 7 + in base + perStop * n diff --git a/corpora/vendored/other/comment-before-closing-bracket-out.hs b/corpora/vendored/other/comment-before-closing-bracket-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-before-closing-bracket-out.hs @@ -0,0 +1,23 @@ +oneElement = + [ first + -- and nothing after it + ] + +severalElements = + [ first, + second + -- and nothing after them + ] + +blockComment = + [ first + {- room + for more -} + ] + +nested = + [ outer, + [ inner + -- innermost + ] + ] diff --git a/corpora/vendored/other/comment-before-closing-bracket.hs b/corpora/vendored/other/comment-before-closing-bracket.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-before-closing-bracket.hs @@ -0,0 +1,17 @@ +oneElement = [ first + -- and nothing after it + ] + +severalElements = [ first, second + -- and nothing after them + ] + +blockComment = [ first + {- room + for more -} + ] + +nested = [ outer, [ inner + -- innermost + ] + ] diff --git a/corpora/vendored/other/comment-between-let-bindings-out.hs b/corpora/vendored/other/comment-between-let-bindings-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-between-let-bindings-out.hs @@ -0,0 +1,8 @@ +module Route.Split where + +split :: Int -> Int +split total = + let outward = total `div` 2 + -- whatever is left over rides home + homeward = total - outward + in homeward diff --git a/corpora/vendored/other/comment-between-let-bindings.hs b/corpora/vendored/other/comment-between-let-bindings.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-between-let-bindings.hs @@ -0,0 +1,8 @@ +module Route.Split where + +split :: Int -> Int +split total = + let outward = total `div` 2 + -- whatever is left over rides home + homeward = total - outward + in homeward diff --git a/corpora/vendored/other/comment-carried-on-past-its-second-line-out.hs b/corpora/vendored/other/comment-carried-on-past-its-second-line-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-carried-on-past-its-second-line-out.hs @@ -0,0 +1,21 @@ +module Kiln.Schedule where + +rampRate :: Int -> Int +rampRate held = + clamp + ( between + (floorOf held) + (ceilingOf held) -- the kiln never reports + -- a reading below this + -- once the burners are lit + ) + +soakTime :: Int -> Int +soakTime held = + clamp + ( between + (floorOf held) + (ceilingOf held) + -- a remark of its own, begun here + -- and carried on to a second line + ) diff --git a/corpora/vendored/other/comment-carried-on-past-its-second-line.hs b/corpora/vendored/other/comment-carried-on-past-its-second-line.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-carried-on-past-its-second-line.hs @@ -0,0 +1,21 @@ +module Kiln.Schedule where + +rampRate :: Int -> Int +rampRate held = + clamp + ( between + (floorOf held) + (ceilingOf held) -- the kiln never reports + -- a reading below this + -- once the burners are lit + ) + +soakTime :: Int -> Int +soakTime held = + clamp + ( between + (floorOf held) + (ceilingOf held) + -- a remark of its own, begun here + -- and carried on to a second line + ) diff --git a/corpora/vendored/other/comment-held-off-a-haddock-out.hs b/corpora/vendored/other/comment-held-off-a-haddock-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-held-off-a-haddock-out.hs @@ -0,0 +1,8 @@ +module Cache.Hit where + +hits :: Int +hits = 0 -- counted since the last eviction + +-- | Whether the last lookup found anything. +found :: Bool +found = True diff --git a/corpora/vendored/other/comment-held-off-a-haddock.hs b/corpora/vendored/other/comment-held-off-a-haddock.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-held-off-a-haddock.hs @@ -0,0 +1,7 @@ +module Cache.Hit where + +hits :: Int +hits = 0 -- counted since the last eviction +-- | Whether the last lookup found anything. +found :: Bool +found = True diff --git a/corpora/vendored/other/comment-in-a-do-let-out.hs b/corpora/vendored/other/comment-in-a-do-let-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-in-a-do-let-out.hs @@ -0,0 +1,8 @@ +module Route.Plan where + +plan :: IO Int +plan = do + let -- worked out before anything is printed + stops = 9 + print stops + pure stops diff --git a/corpora/vendored/other/comment-in-a-do-let.hs b/corpora/vendored/other/comment-in-a-do-let.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-in-a-do-let.hs @@ -0,0 +1,8 @@ +module Route.Plan where + +plan :: IO Int +plan = do + let -- worked out before anything is printed + stops = 9 + print stops + pure stops diff --git a/corpora/vendored/other/comment-in-a-one-line-let-out.hs b/corpora/vendored/other/comment-in-a-one-line-let-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-in-a-one-line-let-out.hs @@ -0,0 +1,4 @@ +module Route.Once where + +once :: Int +once = let n = 1 {- settled when the timetable is built -} in n diff --git a/corpora/vendored/other/comment-in-a-one-line-let.hs b/corpora/vendored/other/comment-in-a-one-line-let.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-in-a-one-line-let.hs @@ -0,0 +1,4 @@ +module Route.Once where + +once :: Int +once = let n = 1 {- settled when the timetable is built -} in n diff --git a/corpora/vendored/other/comment-over-a-hoisted-pragma-out.hs b/corpora/vendored/other/comment-over-a-hoisted-pragma-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-over-a-hoisted-pragma-out.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} +-- eviction order is Cache.Warm's business +{-# OPTIONS_GHC -Wno-unused-imports #-} + +-- | Cooling the cache. +module Cache.Cool where + +cool :: IO () +cool = pure () diff --git a/corpora/vendored/other/comment-over-a-hoisted-pragma.hs b/corpora/vendored/other/comment-over-a-hoisted-pragma.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-over-a-hoisted-pragma.hs @@ -0,0 +1,11 @@ +-- | Cooling the cache. + +{-# LANGUAGE OverloadedStrings #-} + +-- eviction order is Cache.Warm's business +{-# OPTIONS_GHC -Wno-unused-imports #-} + +module Cache.Cool where + +cool :: IO () +cool = pure () diff --git a/corpora/vendored/other/comment-paragraph-trailing-the-module-out.hs b/corpora/vendored/other/comment-paragraph-trailing-the-module-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-paragraph-trailing-the-module-out.hs @@ -0,0 +1,12 @@ +module Kiln.Firing where + +holdFor :: Int -> Int -> Int +holdFor minutes degrees = minutes * degrees + +-- The lines of this paragraph belong to one another, and the lexer hands +-- each of them over on its own. An empty line written over every one would +-- take the paragraph apart and set out each line as a remark of its own. + +-- A second paragraph, which the empty line above it does set apart. The +-- spacing between the two is the author's, and so is the lack of it within +-- either. diff --git a/corpora/vendored/other/comment-paragraph-trailing-the-module.hs b/corpora/vendored/other/comment-paragraph-trailing-the-module.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-paragraph-trailing-the-module.hs @@ -0,0 +1,12 @@ +module Kiln.Firing where + +holdFor :: Int -> Int -> Int +holdFor minutes degrees = minutes * degrees + +-- The lines of this paragraph belong to one another, and the lexer hands +-- each of them over on its own. An empty line written over every one would +-- take the paragraph apart and set out each line as a remark of its own. + +-- A second paragraph, which the empty line above it does set apart. The +-- spacing between the two is the author's, and so is the lack of it within +-- either. diff --git a/corpora/vendored/other/comment-spliced-into-a-line-out.hs b/corpora/vendored/other/comment-spliced-into-a-line-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-spliced-into-a-line-out.hs @@ -0,0 +1,7 @@ +module Terminal.Size where + +resize d = case d of + Size + { rows = r, + columns = c {-, depth = d-} + } -> r + c diff --git a/corpora/vendored/other/comment-spliced-into-a-line.hs b/corpora/vendored/other/comment-spliced-into-a-line.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-spliced-into-a-line.hs @@ -0,0 +1,5 @@ +module Terminal.Size where + +resize d = case d of + Size{ rows = r, columns = c + {-, depth = d-} } -> r + c diff --git a/corpora/vendored/other/comment-trailing-a-let-binding-out.hs b/corpora/vendored/other/comment-trailing-a-let-binding-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-trailing-a-let-binding-out.hs @@ -0,0 +1,7 @@ +module Route.Delay where + +delay :: Int -> Int +delay minutes = + let slack = 4 -- padding the timetable already allows + late = minutes - slack + in max 0 late diff --git a/corpora/vendored/other/comment-trailing-a-let-binding.hs b/corpora/vendored/other/comment-trailing-a-let-binding.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-trailing-a-let-binding.hs @@ -0,0 +1,7 @@ +module Route.Delay where + +delay :: Int -> Int +delay minutes = + let slack = 4 -- padding the timetable already allows + late = minutes - slack + in max 0 late diff --git a/corpora/vendored/other/comment-trailing-the-last-let-binding-out.hs b/corpora/vendored/other/comment-trailing-the-last-let-binding-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-trailing-the-last-let-binding-out.hs @@ -0,0 +1,7 @@ +module Route.Final where + +final :: Int -> Int +final n = + let first = n + second = first + 1 -- the one the caller actually gets + in second diff --git a/corpora/vendored/other/comment-trailing-the-last-let-binding.hs b/corpora/vendored/other/comment-trailing-the-last-let-binding.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-trailing-the-last-let-binding.hs @@ -0,0 +1,7 @@ +module Route.Final where + +final :: Int -> Int +final n = + let first = n + second = first + 1 -- the one the caller actually gets + in second diff --git a/corpora/vendored/other/comment-under-a-block-haddock-out.hs b/corpora/vendored/other/comment-under-a-block-haddock-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-under-a-block-haddock-out.hs @@ -0,0 +1,6 @@ +module Cache.Warm where + +{- | Fill the cache before the first request arrives. -} +-- TODO: measure whether this still earns its keep +warm :: IO () +warm = pure () diff --git a/corpora/vendored/other/comment-under-a-block-haddock.hs b/corpora/vendored/other/comment-under-a-block-haddock.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-under-a-block-haddock.hs @@ -0,0 +1,6 @@ +module Cache.Warm where + +{- | Fill the cache before the first request arrives. -} +-- TODO: measure whether this still earns its keep +warm :: IO () +warm = pure () diff --git a/corpora/vendored/other/comment-under-a-hoisted-pragma-out.hs b/corpora/vendored/other/comment-under-a-hoisted-pragma-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-under-a-hoisted-pragma-out.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} + +-- | Warming the cache. +-- +-- Usage: +-- @ +-- +-- import qualified Cache.Warm as Warm +-- +-- @ + +-- the shapes below are exhaustive, but not obviously so + +module Cache.Warm where + +warm :: IO () +warm = pure () diff --git a/corpora/vendored/other/comment-under-a-hoisted-pragma.hs b/corpora/vendored/other/comment-under-a-hoisted-pragma.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/comment-under-a-hoisted-pragma.hs @@ -0,0 +1,16 @@ +-- | Warming the cache. +-- +-- Usage: +-- @ +-- +-- import qualified Cache.Warm as Warm +-- +-- @ + +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} + -- the shapes below are exhaustive, but not obviously so + +module Cache.Warm where + +warm :: IO () +warm = pure () diff --git a/corpora/vendored/other/cpp/branch-with-a-where-clause-out.hs b/corpora/vendored/other/cpp/branch-with-a-where-clause-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/branch-with-a-where-clause-out.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE CPP #-} + +module Cache.Warm where + +warm :: IO () +warm = do +#if TRACING + report (label 1) + where + label n = "warm " <> show n +#else + pure () +#endif diff --git a/corpora/vendored/other/cpp/branch-with-a-where-clause.hs b/corpora/vendored/other/cpp/branch-with-a-where-clause.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/branch-with-a-where-clause.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE CPP #-} + +module Cache.Warm where + +warm :: IO () +warm = do +#if TRACING + report (label 1) + where + label n = "warm " <> show n +#else + pure () +#endif diff --git a/corpora/vendored/other/cpp/comments-in-branches-out.hs b/corpora/vendored/other/cpp/comments-in-branches-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/comments-in-branches-out.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Timing where + +-- | How long to wait for a response. +timeout :: Int +#ifdef SLOW_LINK +-- A serial line needs a great deal longer than a pipe does. +timeout = 30000 -- milliseconds +#else +timeout = 250 +#endif + +-- | Retries before giving up. +retries :: Int +retries = 3 diff --git a/corpora/vendored/other/cpp/comments-in-branches.hs b/corpora/vendored/other/cpp/comments-in-branches.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/comments-in-branches.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Timing where + +-- | How long to wait for a response. +timeout :: Int +#ifdef SLOW_LINK +-- A serial line needs a great deal longer than a pipe does. +timeout = 30000 -- milliseconds +#else +timeout = 250 +#endif + +-- | Retries before giving up. +retries :: Int +retries = 3 diff --git a/corpora/vendored/other/cpp/conditional-imports-out.hs b/corpora/vendored/other/cpp/conditional-imports-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/conditional-imports-out.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Encode (encode) where + +import Data.List (intercalate) +#if MIN_VERSION_base(4,20,0) +import Data.Foldable (foldl') +#endif +import Data.Char (ord) + +encode :: String -> String +encode = intercalate ";" . map (show . ord) diff --git a/corpora/vendored/other/cpp/conditional-imports.hs b/corpora/vendored/other/cpp/conditional-imports.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/conditional-imports.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Encode (encode) where + +import Data.List (intercalate) +#if MIN_VERSION_base(4,20,0) +import Data.Foldable (foldl') +#endif +import Data.Char (ord) + +encode :: String -> String +encode = intercalate ";" . map (show . ord) diff --git a/corpora/vendored/other/cpp/define-across-lines-out.hs b/corpora/vendored/other/cpp/define-across-lines-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/define-across-lines-out.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Wrapped where + +#define WRAP(a,b) \ + ("<" ++ a \ + ++ b ++ ">") + +both :: String +both = WRAP ("x", "y") diff --git a/corpora/vendored/other/cpp/define-across-lines.hs b/corpora/vendored/other/cpp/define-across-lines.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/define-across-lines.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Wrapped where + +#define WRAP(a,b) \ + ("<" ++ a \ + ++ b ++ ">") + +both :: String +both = WRAP("x","y") diff --git a/corpora/vendored/other/cpp/define-ended-by-a-blank-line-out.hs b/corpora/vendored/other/cpp/define-ended-by-a-blank-line-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/define-ended-by-a-blank-line-out.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Derived where + +class Described a + +#define describe(ty) \ +instance Described ty where { \ + } \ + +describe (Int) +describe (Bool) diff --git a/corpora/vendored/other/cpp/define-ended-by-a-blank-line.hs b/corpora/vendored/other/cpp/define-ended-by-a-blank-line.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/define-ended-by-a-blank-line.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Derived where + +class Described a + +#define describe(ty) \ +instance Described ty where { \ + } \ + +describe(Int) +describe(Bool) diff --git a/corpora/vendored/other/cpp/define-in-a-quasiquote.hs b/corpora/vendored/other/cpp/define-in-a-quasiquote.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/define-in-a-quasiquote.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE QuasiQuotes #-} + +module Terminal.Template where + +import Terminal.Quoter (template) + +banner :: String +banner = + [template| +#include "banner.txt" +|] diff --git a/corpora/vendored/other/cpp/define-out.hs b/corpora/vendored/other/cpp/define-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/define-out.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Macro where + +#define ESCAPE(n) ("\ESC[" ++ show n ++ "m") + +plain :: String +plain = ESCAPE (0) diff --git a/corpora/vendored/other/cpp/define.hs b/corpora/vendored/other/cpp/define.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/define.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Macro where + +#define ESCAPE(n) ("\ESC[" ++ show n ++ "m") + +plain :: String +plain = ESCAPE(0) diff --git a/corpora/vendored/other/cpp/directive-above-a-trailing-comment-out.hs b/corpora/vendored/other/cpp/directive-above-a-trailing-comment-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/directive-above-a-trailing-comment-out.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Size where + +#ifndef NO_CALLSTACK +import GHC.Stack +#define TRACED(ty) HasCallStack => ty +#endif + +newtype Size = Size Int + +-- A comment with nothing written under it. diff --git a/corpora/vendored/other/cpp/directive-above-a-trailing-comment.hs b/corpora/vendored/other/cpp/directive-above-a-trailing-comment.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/directive-above-a-trailing-comment.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Size where + +#ifndef NO_CALLSTACK +import GHC.Stack +#define TRACED(ty) HasCallStack => ty +#endif + +newtype Size = Size Int + +-- A comment with nothing written under it. diff --git a/corpora/vendored/other/cpp/directive-after-a-conditional-out.hs b/corpora/vendored/other/cpp/directive-after-a-conditional-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/directive-after-a-conditional-out.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} +#ifdef TRUSTWORTHY +{-# LANGUAGE Trustworthy #-} +#endif + +#include "terminal.h" + +module Terminal.Size where + +#if MIN_VERSION_base(4, 20, 0) +rows :: Int +rows = 24 +#endif + +#if MIN_VERSION_base(4, 18, 0) +columns :: Int +columns = 80 +#endif diff --git a/corpora/vendored/other/cpp/directive-after-a-conditional.hs b/corpora/vendored/other/cpp/directive-after-a-conditional.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/directive-after-a-conditional.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} +#ifdef TRUSTWORTHY +{-# LANGUAGE Trustworthy #-} +#endif + +#include "terminal.h" + +module Terminal.Size where + +#if MIN_VERSION_base(4, 20, 0) +rows :: Int +rows = 24 +#endif + +#if MIN_VERSION_base(4, 18, 0) +columns :: Int +columns = 80 +#endif diff --git a/corpora/vendored/other/cpp/directive-outside-conditionals-out.hs b/corpora/vendored/other/cpp/directive-outside-conditionals-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/directive-outside-conditionals-out.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Size where + +#include "terminal.h" + +#if defined(HAVE_IOCTL) +rows :: Int +rows = 24 +#else +rows :: Int +rows = 0 +#endif + +#if defined(HAVE_TERMCAP) +columns :: Int +columns = 80 +#else +columns :: Int +columns = 0 +#endif diff --git a/corpora/vendored/other/cpp/directive-outside-conditionals.hs b/corpora/vendored/other/cpp/directive-outside-conditionals.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/directive-outside-conditionals.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Size where + +#include "terminal.h" + +#if defined(HAVE_IOCTL) +rows :: Int +rows = 24 +#else +rows :: Int +rows = 0 +#endif + +#if defined(HAVE_TERMCAP) +columns :: Int +columns = 80 +#else +columns :: Int +columns = 0 +#endif diff --git a/corpora/vendored/other/cpp/elif-chain-out.hs b/corpora/vendored/other/cpp/elif-chain-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/elif-chain-out.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Newline where + +newline :: String +#if defined(TARGET_WINDOWS) +newline = "\r\n" +#elif defined(TARGET_CLASSIC_MAC) +newline = "\r" +#else +newline = "\n" +#endif + +indent :: Int +indent = 2 diff --git a/corpora/vendored/other/cpp/elif-chain.hs b/corpora/vendored/other/cpp/elif-chain.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/elif-chain.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Newline where + +newline :: String +#if defined(TARGET_WINDOWS) +newline = "\r\n" +#elif defined(TARGET_CLASSIC_MAC) +newline = "\r" +#else +newline = "\n" +#endif + +indent :: Int +indent = 2 diff --git a/corpora/vendored/other/cpp/imports-in-both-branches-out.hs b/corpora/vendored/other/cpp/imports-in-both-branches-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/imports-in-both-branches-out.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Capability (probe) where + +import Data.Maybe (fromMaybe) +import Terminal.Encode (encode) +#ifdef WITH_TERMINFO +import Data.List (isPrefixOf) +import Terminal.Terminfo (lookupCapability) +#else +import Terminal.Static (staticCapability) +#endif + +probe :: String -> String +#ifdef WITH_TERMINFO +probe name + | "x" `isPrefixOf` name = encode name + | otherwise = fromMaybe "" (lookupCapability name) +#else +probe name = fromMaybe (encode name) (staticCapability name) +#endif diff --git a/corpora/vendored/other/cpp/imports-in-both-branches.hs b/corpora/vendored/other/cpp/imports-in-both-branches.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/imports-in-both-branches.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Capability (probe) where + +import Data.Maybe (fromMaybe) +import Terminal.Encode (encode) +#ifdef WITH_TERMINFO +import Data.List (isPrefixOf) +import Terminal.Terminfo (lookupCapability) +#else +import Terminal.Static (staticCapability) +#endif + +probe :: String -> String +#ifdef WITH_TERMINFO +probe name + | "x" `isPrefixOf` name = encode name + | otherwise = fromMaybe "" (lookupCapability name) +#else +probe name = fromMaybe (encode name) (staticCapability name) +#endif diff --git a/corpora/vendored/other/cpp/inside-a-binding-group-out.hs b/corpora/vendored/other/cpp/inside-a-binding-group-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/inside-a-binding-group-out.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Describe where + +describe :: Int -> String +describe n = go n + where + go 0 = "none" +#ifdef VERBOSE + go 1 = "exactly one" +#else + go 1 = "1" +#endif + go k = show k diff --git a/corpora/vendored/other/cpp/inside-a-binding-group.hs b/corpora/vendored/other/cpp/inside-a-binding-group.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/inside-a-binding-group.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Describe where + +describe :: Int -> String +describe n = go n + where + go 0 = "none" +#ifdef VERBOSE + go 1 = "exactly one" +#else + go 1 = "1" +#endif + go k = show k diff --git a/corpora/vendored/other/cpp/inside-a-signature-out.hs b/corpora/vendored/other/cpp/inside-a-signature-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/inside-a-signature-out.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Trace where + +import GHC.Stack (HasCallStack) + +traceMessage :: +#ifdef WITH_CALLSTACK + (HasCallStack) => +#endif + String -> [(String, Int)] -> Maybe String -> Either String Int -> IO () +traceMessage message _pairs _fallback _outcome = putStrLn message diff --git a/corpora/vendored/other/cpp/inside-a-signature.hs b/corpora/vendored/other/cpp/inside-a-signature.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/inside-a-signature.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Trace where + +import GHC.Stack (HasCallStack) + +traceMessage :: +#ifdef WITH_CALLSTACK + (HasCallStack) => +#endif + String -> [(String, Int)] -> Maybe String -> Either String Int -> IO () +traceMessage message _pairs _fallback _outcome = putStrLn message diff --git a/corpora/vendored/other/cpp/inside-an-expression-out.hs b/corpora/vendored/other/cpp/inside-an-expression-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/inside-an-expression-out.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Width where + +base :: Int +base = 80 + +width :: Int +width = + base +#ifdef WITH_MARGIN + + 4 +#endif + +height :: Int +height = 24 diff --git a/corpora/vendored/other/cpp/inside-an-expression.hs b/corpora/vendored/other/cpp/inside-an-expression.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/inside-an-expression.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Width where + +base :: Int +base = 80 + +width :: Int +width = + base +#ifdef WITH_MARGIN + + 4 +#endif + +height :: Int +height = 24 diff --git a/corpora/vendored/other/cpp/more-configurations-than-formattings-out.hs b/corpora/vendored/other/cpp/more-configurations-than-formattings-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/more-configurations-than-formattings-out.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE CPP #-} + +module Build.Flags where + +#ifdef WITH_MOUSE +mouse :: Bool +mouse = True +#else +mouse :: Bool +mouse = False +#endif + +#ifdef WITH_PASTE +paste :: Bool +paste = True +#else +paste :: Bool +paste = False +#endif + +#ifdef WITH_COLOUR +colour :: Bool +colour = True +#else +colour :: Bool +colour = False +#endif + +#ifdef WITH_TITLE +title :: Bool +title = True +#else +title :: Bool +title = False +#endif + +#ifdef WITH_CURSOR +cursor :: Bool +cursor = True +#else +cursor :: Bool +cursor = False +#endif + +#ifdef WITH_RESIZE +resize :: Bool +resize = True +#else +resize :: Bool +resize = False +#endif + +#ifdef WITH_UNICODE +unicode :: Bool +unicode = True +#else +unicode :: Bool +unicode = False +#endif + +everything :: [Bool] +everything = [mouse, paste, colour, title, cursor, resize, unicode] diff --git a/corpora/vendored/other/cpp/more-configurations-than-formattings.hs b/corpora/vendored/other/cpp/more-configurations-than-formattings.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/more-configurations-than-formattings.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE CPP #-} + +module Build.Flags where + +#ifdef WITH_MOUSE +mouse :: Bool +mouse = True +#else +mouse :: Bool +mouse = False +#endif + +#ifdef WITH_PASTE +paste :: Bool +paste = True +#else +paste :: Bool +paste = False +#endif + +#ifdef WITH_COLOUR +colour :: Bool +colour = True +#else +colour :: Bool +colour = False +#endif + +#ifdef WITH_TITLE +title :: Bool +title = True +#else +title :: Bool +title = False +#endif + +#ifdef WITH_CURSOR +cursor :: Bool +cursor = True +#else +cursor :: Bool +cursor = False +#endif + +#ifdef WITH_RESIZE +resize :: Bool +resize = True +#else +resize :: Bool +resize = False +#endif + +#ifdef WITH_UNICODE +unicode :: Bool +unicode = True +#else +unicode :: Bool +unicode = False +#endif + +everything :: [Bool] +everything = [mouse, paste, colour, title, cursor, resize, unicode] diff --git a/corpora/vendored/other/cpp/nested-out.hs b/corpora/vendored/other/cpp/nested-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/nested-out.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Cursor where + +#ifdef ANSI +home :: String +home = "\ESC[H" + +#ifdef ANSI_PRIVATE +hide :: String +hide = "\ESC[?25l" +#endif +#else +home :: String +home = "\r" +#endif + +bell :: String +bell = "\a" diff --git a/corpora/vendored/other/cpp/nested.hs b/corpora/vendored/other/cpp/nested.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/nested.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Cursor where + +#ifdef ANSI +home :: String +home = "\ESC[H" +# ifdef ANSI_PRIVATE +hide :: String +hide = "\ESC[?25l" +# endif +#else +home :: String +home = "\r" +#endif + +bell :: String +bell = "\a" diff --git a/corpora/vendored/other/cpp/no-alternative-out.hs b/corpora/vendored/other/cpp/no-alternative-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/no-alternative-out.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Legacy where + +columns :: Int +columns = 80 + +#if !MIN_VERSION_base(4,19,0) +rows :: Int +rows = 24 +#endif + +title :: String +title = "session" diff --git a/corpora/vendored/other/cpp/no-alternative.hs b/corpora/vendored/other/cpp/no-alternative.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/no-alternative.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Legacy where + +columns :: Int +columns = 80 + +#if !MIN_VERSION_base(4,19,0) +rows :: Int +rows = 24 +#endif + +title :: String +title = "session" diff --git a/corpora/vendored/other/cpp/one-guard-asked-twice-out.hs b/corpora/vendored/other/cpp/one-guard-asked-twice-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/one-guard-asked-twice-out.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE CPP #-} +#if defined(HAVE_PATTERNS) +{-# LANGUAGE PatternSynonyms #-} +#endif + +module Terminal.Key + ( Key (..), + keyCode, +#if defined(HAVE_PATTERNS) +#ifndef NO_NAMES + keyName, + keyLabel, + pattern Escape, + pattern Enter, + keyGlyph, +#endif +#else +#ifndef NO_NAMES + keyName, + keyLabel, + keyGlyph, +#endif +#endif + ) +where + +data Key = Key Int + +keyCode :: Key -> Int +keyCode (Key c) = c + +#ifndef NO_NAMES +keyName :: Key -> String +keyName (Key c) = "key" <> show c + +keyLabel :: Key -> String +keyLabel k = "<" <> keyName k <> ">" + +keyGlyph :: Key -> Char +keyGlyph (Key c) = toEnum c +#endif + +#if defined(HAVE_PATTERNS) +pattern Escape :: Key +pattern Escape = Key 27 + +pattern Enter :: Key +pattern Enter = Key 13 +#endif diff --git a/corpora/vendored/other/cpp/one-guard-asked-twice.hs b/corpora/vendored/other/cpp/one-guard-asked-twice.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/one-guard-asked-twice.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE CPP #-} +#if defined(HAVE_PATTERNS) +{-# LANGUAGE PatternSynonyms #-} +#endif + +module Terminal.Key + ( Key (..), + keyCode, +#ifndef NO_NAMES + keyName, + keyLabel, +#if defined(HAVE_PATTERNS) + pattern Escape, + pattern Enter, +#endif + keyGlyph, +#endif + ) +where + +data Key = Key Int + +keyCode :: Key -> Int +keyCode (Key c) = c + +#ifndef NO_NAMES +keyName :: Key -> String +keyName (Key c) = "key" <> show c + +keyLabel :: Key -> String +keyLabel k = "<" <> keyName k <> ">" + +keyGlyph :: Key -> Char +keyGlyph (Key c) = toEnum c +#endif + +#if defined(HAVE_PATTERNS) +pattern Escape :: Key +pattern Escape = Key 27 + +pattern Enter :: Key +pattern Enter = Key 13 +#endif diff --git a/corpora/vendored/other/cpp/same-guard-twice-out.hs b/corpora/vendored/other/cpp/same-guard-twice-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/same-guard-twice-out.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} + +module Terminal.Run (runFrame) where + +import Control.Monad.ST (ST, runST) +import Terminal.Buffer (Buffer, freeze, shrink) +#if defined(ASSERTS) +import GHC.Stack (HasCallStack) +#endif + +runFrame :: +#if defined(ASSERTS) + (HasCallStack) => +#endif + (forall s. (Buffer s -> Int -> ST s Buffer) -> ST s Buffer) -> Buffer +runFrame act = runST (act (\buffer used -> shrink buffer used >> freeze buffer)) diff --git a/corpora/vendored/other/cpp/same-guard-twice.hs b/corpora/vendored/other/cpp/same-guard-twice.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/same-guard-twice.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} + +module Terminal.Run (runFrame) where + +import Control.Monad.ST (ST, runST) +import Terminal.Buffer (Buffer, freeze, shrink) + +#if defined(ASSERTS) +import GHC.Stack (HasCallStack) +#endif + +runFrame :: +#if defined(ASSERTS) + (HasCallStack) => +#endif + (forall s. (Buffer s -> Int -> ST s Buffer) -> ST s Buffer) -> Buffer +runFrame act = runST (act (\buffer used -> shrink buffer used >> freeze buffer)) diff --git a/corpora/vendored/other/cpp/side-by-side-out.hs b/corpora/vendored/other/cpp/side-by-side-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/side-by-side-out.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Feature where + +#ifdef WITH_MOUSE +mouse :: Bool +mouse = True +#else +mouse :: Bool +mouse = False +#endif + +always :: Bool +always = True + +#ifdef WITH_BRACKETED_PASTE +paste :: Bool +paste = True +#endif + +version :: Int +version = 3 diff --git a/corpora/vendored/other/cpp/side-by-side.hs b/corpora/vendored/other/cpp/side-by-side.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/side-by-side.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Feature where + +#ifdef WITH_MOUSE +mouse :: Bool +mouse = True +#else +mouse :: Bool +mouse = False +#endif + +always :: Bool +always = True + +#ifdef WITH_BRACKETED_PASTE +paste :: Bool +paste = True +#endif + +version :: Int +version = 3 diff --git a/corpora/vendored/other/cpp/spaced-hash-out.hs b/corpora/vendored/other/cpp/spaced-hash-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/spaced-hash-out.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Signal where + +interrupt :: Int +interrupt = 2 + +#if defined(HAS_SIGWINCH) +resize :: Int +resize = 28 +#else +resize :: Int +resize = 0 +#endif diff --git a/corpora/vendored/other/cpp/spaced-hash.hs b/corpora/vendored/other/cpp/spaced-hash.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/spaced-hash.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Signal where + +interrupt :: Int +interrupt = 2 + +# if defined(HAS_SIGWINCH) +resize :: Int +resize = 28 +# else +resize :: Int +resize = 0 +# endif diff --git a/corpora/vendored/other/cpp/unbalanced.hs b/corpora/vendored/other/cpp/unbalanced.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/unbalanced.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Truncated where + +#ifdef SOMETHING +value :: Int +value = 1 diff --git a/corpora/vendored/other/cpp/whole-declarations-out.hs b/corpora/vendored/other/cpp/whole-declarations-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/whole-declarations-out.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Palette where + +reset :: String +reset = "\ESC[0m" + +#ifdef TRUECOLOUR +paint :: Int -> Int -> Int -> String +paint r g b = "\ESC[38;2;" ++ show r ++ ";" ++ show g ++ ";" ++ show b ++ "m" +#else +paint :: Int -> Int -> Int -> String +paint _ _ _ = "" +#endif + +clear :: String +clear = "\ESC[2J" diff --git a/corpora/vendored/other/cpp/whole-declarations.hs b/corpora/vendored/other/cpp/whole-declarations.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/whole-declarations.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE CPP #-} + +module Terminal.Palette where + +reset :: String +reset = "\ESC[0m" + +#ifdef TRUECOLOUR +paint :: Int -> Int -> Int -> String +paint r g b = "\ESC[38;2;" ++ show r ++ ";" ++ show g ++ ";" ++ show b ++ "m" +#else +paint :: Int -> Int -> Int -> String +paint _ _ _ = "" +#endif + +clear :: String +clear = "\ESC[2J" diff --git a/corpora/vendored/other/deriving-blocks-the-author-grouped-out.hs b/corpora/vendored/other/deriving-blocks-the-author-grouped-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/deriving-blocks-the-author-grouped-out.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE StandaloneDeriving #-} + +module Ledger.Posting where + +newtype Tallied a = Tallied a + +deriving via Tallied Receipt instance Eq Receipt +deriving via Tallied Receipt instance Ord Receipt +deriving via Tallied Receipt instance Show Receipt + +deriving via Tallied Invoice instance Eq Invoice +deriving via Tallied Invoice instance Ord Invoice +-- A note written against the block it stands in, and staying inside it. +deriving via Tallied Invoice instance Show Invoice + +deriving via Tallied Memo instance Eq Memo diff --git a/corpora/vendored/other/deriving-blocks-the-author-grouped.hs b/corpora/vendored/other/deriving-blocks-the-author-grouped.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/deriving-blocks-the-author-grouped.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE StandaloneDeriving #-} + +module Ledger.Posting where + +newtype Tallied a = Tallied a + +deriving via Tallied Receipt instance Eq Receipt +deriving via Tallied Receipt instance Ord Receipt +deriving via Tallied Receipt instance Show Receipt + +deriving via Tallied Invoice instance Eq Invoice +deriving via Tallied Invoice instance Ord Invoice +-- A note written against the block it stands in, and staying inside it. +deriving via Tallied Invoice instance Show Invoice + +deriving via Tallied Memo instance Eq Memo diff --git a/corpora/vendored/other/haddock-held-off-a-comment-out.hs b/corpora/vendored/other/haddock-held-off-a-comment-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/haddock-held-off-a-comment-out.hs @@ -0,0 +1,7 @@ +module Cache.Evict where + +-- | Drop the entries nothing has asked for lately. + +-- TODO: the threshold wants to come from the configuration +evict :: IO () +evict = pure () diff --git a/corpora/vendored/other/haddock-held-off-a-comment.hs b/corpora/vendored/other/haddock-held-off-a-comment.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/haddock-held-off-a-comment.hs @@ -0,0 +1,7 @@ +module Cache.Evict where + +-- | Drop the entries nothing has asked for lately. + +-- TODO: the threshold wants to come from the configuration +evict :: IO () +evict = pure () diff --git a/corpora/vendored/other/haddock-with-a-tight-trigger-out.hs b/corpora/vendored/other/haddock-with-a-tight-trigger-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/haddock-with-a-tight-trigger-out.hs @@ -0,0 +1,5 @@ +module Terminal.Size where + +-- | Rows and columns, as the terminal reported them when we +-- started up. +data Size = Size Int Int diff --git a/corpora/vendored/other/haddock-with-a-tight-trigger.hs b/corpora/vendored/other/haddock-with-a-tight-trigger.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/haddock-with-a-tight-trigger.hs @@ -0,0 +1,5 @@ +module Terminal.Size where + +-- |Rows and columns, as the terminal reported them when we +-- started up. +data Size = Size Int Int diff --git a/corpora/vendored/other/named-chunk-under-a-haddock-out.hs b/corpora/vendored/other/named-chunk-under-a-haddock-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/named-chunk-under-a-haddock-out.hs @@ -0,0 +1,10 @@ +module Cache.Doctest where + +-- | The examples below are run by doctest. + +-- $setup +-- >>> import Cache.Warm + +-- | Warm the cache and say how long it took. +timed :: IO () +timed = pure () diff --git a/corpora/vendored/other/named-chunk-under-a-haddock.hs b/corpora/vendored/other/named-chunk-under-a-haddock.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/named-chunk-under-a-haddock.hs @@ -0,0 +1,10 @@ +module Cache.Doctest where + +-- | The examples below are run by doctest. + +-- $setup +-- >>> import Cache.Warm + +-- | Warm the cache and say how long it took. +timed :: IO () +timed = pure () diff --git a/corpora/vendored/other/position-pragma-only-mentioned-out.hs b/corpora/vendored/other/position-pragma-only-mentioned-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/position-pragma-only-mentioned-out.hs @@ -0,0 +1,12 @@ +-- | Talking about @{-# LINE #-}@ is not carrying one. +module Woven.Notes where + +{- A block comment may name {-# COLUMN #-} too, nested {- and all -}. -} + +-- | The text a generator would emit. +marker :: String +marker = "{-# LINE 40 \"Template.hs\" #-}" + +-- Nor is --> a comment opener, so a pragma after it still counts. +described :: Int +described = 1 diff --git a/corpora/vendored/other/position-pragma-only-mentioned.hs b/corpora/vendored/other/position-pragma-only-mentioned.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/position-pragma-only-mentioned.hs @@ -0,0 +1,12 @@ +-- | Talking about @{-# LINE #-}@ is not carrying one. +module Woven.Notes where + +{- A block comment may name {-# COLUMN #-} too, nested {- and all -}. -} + +-- | The text a generator would emit. +marker :: String +marker = "{-# LINE 40 \"Template.hs\" #-}" + +-- Nor is --> a comment opener, so a pragma after it still counts. +described :: Int +described = 1 diff --git a/corpora/vendored/other/position-pragmas.hs b/corpora/vendored/other/position-pragmas.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/position-pragmas.hs @@ -0,0 +1,15 @@ +-- | Generated code, which says where each part of it came from. +module Woven where + +ownLine :: Int -> Int +ownLine n = n + 1 + +{-# LINE 40 "Template.hs" #-} + +fromTheTemplate :: Int -> Int +fromTheTemplate n = n + +{-# LINE 12 "Woven.hs" #-} + +andBackAgain :: Int -> Int +andBackAgain n = n - 1 diff --git a/corpora/vendored/other/section-anchor-with-a-blank-line-out.hs b/corpora/vendored/other/section-anchor-with-a-blank-line-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/section-anchor-with-a-blank-line-out.hs @@ -0,0 +1,17 @@ +module Terminal.Size + ( -- * Getting started + -- $intro + -- + + -- * Measuring + -- $measuring + rows, + columns, + ) +where + +rows :: Int +rows = 24 + +columns :: Int +columns = 80 diff --git a/corpora/vendored/other/section-anchor-with-a-blank-line.hs b/corpora/vendored/other/section-anchor-with-a-blank-line.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/section-anchor-with-a-blank-line.hs @@ -0,0 +1,17 @@ +module Terminal.Size + ( -- * Getting started + -- $intro + -- + + -- * Measuring + -- $measuring + rows, + columns, + ) +where + +rows :: Int +rows = 24 + +columns :: Int +columns = 80 diff --git a/corpora/vendored/other/section-heading-under-a-haddock-out.hs b/corpora/vendored/other/section-heading-under-a-haddock-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/section-heading-under-a-haddock-out.hs @@ -0,0 +1,9 @@ +module Cache.Report where + +-- | Everything under here is about reporting, not about the cache itself. + +-- * Counters + +-- | How many lookups found something. +hits :: Int +hits = 0 diff --git a/corpora/vendored/other/section-heading-under-a-haddock.hs b/corpora/vendored/other/section-heading-under-a-haddock.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/section-heading-under-a-haddock.hs @@ -0,0 +1,9 @@ +module Cache.Report where + +-- | Everything under here is about reporting, not about the cache itself. + +-- * Counters + +-- | How many lookups found something. +hits :: Int +hits = 0 diff --git a/corpora/vendored/other/trailing-comment-over-a-moved-haddock-out.hs b/corpora/vendored/other/trailing-comment-over-a-moved-haddock-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/trailing-comment-over-a-moved-haddock-out.hs @@ -0,0 +1,9 @@ +module Cache.Stats where + +data Stats = Stats + { hits :: Int, + -- Misc + + -- | lookups that found nothing + misses :: Int + } diff --git a/corpora/vendored/other/trailing-comment-over-a-moved-haddock.hs b/corpora/vendored/other/trailing-comment-over-a-moved-haddock.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/trailing-comment-over-a-moved-haddock.hs @@ -0,0 +1,8 @@ +module Cache.Stats where + +data Stats = Stats + { hits :: Int + , -- Misc + misses :: Int + -- ^ lookups that found nothing + } diff --git a/corpora/vendored/other/trailing-comment-with-a-gap-under-it-out.hs b/corpora/vendored/other/trailing-comment-with-a-gap-under-it-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/trailing-comment-with-a-gap-under-it-out.hs @@ -0,0 +1,9 @@ +module Cache.Probe where + +probe :: [Int] +probe = + [ -- the first of these is the one that regressed + + 1, + 2 + ] diff --git a/corpora/vendored/other/trailing-comment-with-a-gap-under-it.hs b/corpora/vendored/other/trailing-comment-with-a-gap-under-it.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/trailing-comment-with-a-gap-under-it.hs @@ -0,0 +1,9 @@ +module Cache.Probe where + +probe :: [Int] +probe = + [ -- the first of these is the one that regressed + + 1 + , 2 + ] diff --git a/src/Tilia/Comments.hs b/src/Tilia/Comments.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Comments.hs @@ -0,0 +1,387 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Extracting comments from a parsed module. +module Tilia.Comments + ( Comment (..), + CommentStyle (..), + Above (..), + commentsOf, + renderComment, + closesItself, + bracketed, + commentTrailing, + singleLine, + widenTrigger, + escapeTrigger, + triggerEscaped, + opensHaddock, + commentsWithin, + + -- * Pragmas + Pragma (..), + commentPragma, + ) +where + +import Data.Char (isSpace) +import Data.Generics.Schemes (listify) +import Data.List (sortOn) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NE +import Data.Maybe (isJust, mapMaybe) +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Hs (HsModule) +import GHC.Hs.Extension (GhcPs) +import GHC.Parser.Annotation qualified as GHC +import GHC.Types.SrcLoc qualified as GHC +import Tilia.Source.Lines (Lines, blankAt, lineAt, lineTexts) +import Tilia.Span (Span, endPoint, startPoint) +import Tilia.Span.Ghc (spanOfReal) + +-- | One comment. +data Comment = Comment + { -- | Where it was in the input. + commentSpan :: Span, + -- | Its lines, dedented, without trailing whitespace. A line comment + -- has one; a block comment has one per line it spanned. + commentBody :: NonEmpty Text, + -- | How it was written. + commentStyle :: CommentStyle, + -- | What was on the line above it. + -- + -- What a comment lines up with is how its author said what it is about, + -- and the line above is the only thing it can line up with. + commentAbove :: Above, + -- | Where the code before it on its opening line stops: the column one + -- past the last character of that code, or 'Nothing' when the comment + -- had the line to itself. + commentCodeBeforeStopsAt :: Maybe Int, + -- | Whether anything other than whitespace follows it on its closing + -- line. + commentFollowed :: Bool, + -- | Whether to leave an empty line above it when it is printed. + commentGapAbove :: Bool, + -- | Whether to leave an empty line below it when it is printed. + commentGapBelow :: Bool + } + deriving (Eq, Show) + +-- | How a comment was written. The distinction is kept because it +-- constrains what may be done with the comment. +data CommentStyle + = -- | @-- …@ + LineComment + | -- | @{- … -}@ + BlockComment + | -- | @-- |@, @-- ^@, @-- *@, @-- $@ and the block forms + DocComment + deriving (Eq, Show) + +-- | What was on the line above a comment. +data Above + = -- | Nothing was: the comment begins on the first line of the file. + TopOfFile + | -- | An empty line. + BlankLine + | -- | Something, beginning at this column. + ContentAt !Int + deriving (Eq, Show) + +-- | Every comment in a module, in source order. +commentsOf :: + -- | The module's lines, which every comment is read against + Lines -> + -- | Comments the tree does not carry + -- + -- Everything above a signature's @signature@ keyword: the parser leaves + -- those in its own state rather than in an annotation. + [GHC.LEpaComment] -> + -- | Parsed module + HsModule GhcPs -> + [Comment] +commentsOf ls loose hsModule = + map (uncurry (mkComment ls)) + . dedupeOnSpan + . sortOn (GHC.realSrcSpanStart . fst) + . mapMaybe located + $ loose <> concatMap annComments (listify anyAnnComments hsModule) + where + dedupeOnSpan = \case + (x : y : rest) | fst x == fst y -> dedupeOnSpan (x : rest) + (x : rest) -> x : dedupeOnSpan rest + [] -> [] + anyAnnComments :: GHC.EpAnnComments -> Bool + anyAnnComments _ = True + annComments = \case + GHC.EpaComments xs -> xs + GHC.EpaCommentsBalanced xs ys -> xs <> ys + located (GHC.L anchor (GHC.EpaComment tok _)) = case anchor of + GHC.EpaSpan (GHC.RealSrcSpan s _) -> Just (s, tok) + _ -> Nothing + +-- | Build a comment from a token and the span it occupied. +mkComment :: Lines -> GHC.RealSrcSpan -> GHC.EpaCommentTok -> Comment +mkComment ls spn tok = + Comment + { commentSpan = spanOfReal spn, + commentBody = normalizeBody startColumn style raw, + commentStyle = style, + commentAbove = above, + commentCodeBeforeStopsAt = codeBeforeStopsAt, + commentFollowed = followed, + commentGapAbove = above == BlankLine, + commentGapBelow = blankAt (GHC.srcSpanEndLine spn + 1) ls + } + where + (style, raw) = case tok of + GHC.EpaLineComment s -> (LineComment, T.pack s) + GHC.EpaBlockComment s -> (BlockComment, T.pack s) + GHC.EpaDocComment _ -> (DocComment, sliceSpan (lineTexts ls) spn) + GHC.EpaDocOptions s -> (LineComment, T.pack s) + + -- The lines the answers are read off, and where on the opening one the + -- comment starts. Indentation is how many characters precede, which is + -- not the column: see 'offsetOf'. + startColumn = maybe 0 (`offsetOf` GHC.srcSpanStartCol spn) openingLine + openingLine = lineAt (GHC.srcSpanStartLine spn) ls + lineAbove + | GHC.srcSpanStartLine spn <= 1 = Nothing + | otherwise = lineAt (GHC.srcSpanStartLine spn - 1) ls + + -- The rest in the order the fields are declared in. + above = case lineAbove of + Nothing -> TopOfFile + Just l + | T.all isSpace l -> BlankLine + | otherwise -> ContentAt (columnOf l (T.length (T.takeWhile isSpace l))) + codeBeforeStopsAt = do + l <- openingLine + let before' = T.stripEnd (T.take startColumn l) + if T.null before' then Nothing else Just (columnOf l (T.length before')) + followed = case lineAt (GHC.srcSpanEndLine spn) ls of + Just l -> not (T.all isSpace (T.drop (offsetOf l (GHC.srcSpanEndCol spn)) l)) + Nothing -> False + +-- | Apply the normalizations, in the only order that works: dedent before +-- stripping, since a line of nothing but spaces has to still count as +-- indented when the common indentation is measured. +normalizeBody :: Int -> CommentStyle -> Text -> NonEmpty Text +normalizeBody startColumn style raw = + case NE.nonEmpty (T.lines raw) of + Nothing -> spaceAfterDashes style raw :| [] + Just (first' :| rest) -> + fmap T.stripEnd (spaceAfterDashes style first' :| map dedent rest) + where + dedent l = T.drop (min startColumn (T.length (T.takeWhile isSpace l))) l + +-- | @--foo@ becomes @-- foo@; @----@ and @-- foo@ are left alone. +-- +-- Only the opening line of a line comment is eligible. Inside a block +-- comment a @--@ is just two characters the author wrote. +spaceAfterDashes :: CommentStyle -> Text -> Text +spaceAfterDashes BlockComment t = t +spaceAfterDashes _ t = case T.stripPrefix "--" t of + Nothing -> t + Just rest -> case T.uncons rest of + Nothing -> t + Just (c, _) + | c == ' ' || c == '-' -> t + | otherwise -> "-- " <> rest + +-- | The text a span covers. +sliceSpan :: [Text] -> GHC.RealSrcSpan -> Text +sliceSpan sourceLines spn = + T.intercalate "\n" (zipWith clip [startLine ..] covered) + where + covered = + take (endLine - startLine + 1) (drop (startLine - 1) sourceLines) + clip n l = + (if n == startLine then T.drop (offsetOf l startCol) else id) + . (if n == endLine then T.take (offsetOf l endCol) else id) + $ l + + startLine = GHC.srcSpanStartLine spn + endLine = GHC.srcSpanEndLine spn + startCol = GHC.srcSpanStartCol spn + endCol = GHC.srcSpanEndCol spn + +-- | Put a comment back together as it will appear in the output. +renderComment :: Comment -> Text +renderComment = T.intercalate "\n" . NE.toList . commentBody + +-- | Does this comment let code follow it on the same line? +closesItself :: Comment -> Bool +closesItself c = commentStyle c == BlockComment && singleLine c + +-- | Was this comment written between brackets rather than as @--@ lines? +bracketed :: Comment -> Bool +bracketed c = "{-" `T.isPrefixOf` T.stripStart (NE.head (commentBody c)) + +-- | Was the comment written after code on its line? +commentTrailing :: Comment -> Bool +commentTrailing = isJust . commentCodeBeforeStopsAt + +-- | Is this comment a single line? +singleLine :: Comment -> Bool +singleLine c = case commentBody c of + (_ :| []) -> True + _ -> False + +-- | Put a space between a doc comment's trigger and the text after it, so +-- that @-- |Foo@ comes out as @-- | Foo@. +-- +-- Only doc comments have triggers; on anything else this is a no-op. +widenTrigger :: Comment -> Comment +widenTrigger c + | DocComment <- commentStyle c, + (headLine :| rest) <- commentBody c, + Just (upToTrigger, body) <- splitTrigger headLine, + not (T.null body), + not (" " `T.isPrefixOf` body) = + c {commentBody = (upToTrigger <> " " <> body) :| map shiftOne rest} + | otherwise = c + where + shiftOne l = case openerWidth l of + Just _ -> l + Nothing -> " " <> l + +-- | Put a backslash in front of a doc comment's trigger. +-- +-- For a doc comment the compiler did not manage to attach to anything: it +-- is going to come back out as an ordinary comment, and written as it +-- stands it would be lexed as a doc comment again on the next pass, so the +-- formatter would not have a fixed point. The backslash is what Haddock +-- reads as \"this is not a trigger\". +escapeTrigger :: Comment -> Comment +escapeTrigger c = case commentStyle c of + DocComment -> + c + { commentBody = fmap escape (commentBody c), + commentStyle = ordinaryStyle + } + _ -> c + where + ordinaryStyle + | "{-" `T.isPrefixOf` NE.head (commentBody c) = BlockComment + | otherwise = LineComment + + escape l = case openerWidth l of + Just n + | (gap, rest) <- T.span (== ' ') (T.drop n l), + triggered rest -> + T.take n l <> (if T.null gap then " " else gap) <> "\\" <> rest + _ -> l + +-- | Has this comment been through 'escapeTrigger'? +-- +-- What it was written as cannot be read off the comment any more—that is +-- the point of escaping—so anything wanting to know whether a comment +-- started life as a Haddock has to ask this. +triggerEscaped :: Comment -> Bool +triggerEscaped c = case openerWidth headLine of + Nothing -> False + Just n -> case T.uncons (T.dropWhile (== ' ') (T.drop n headLine)) of + Just ('\\', rest) -> triggered rest + _ -> False + where + headLine = NE.head (commentBody c) + +-- | Does this text begin with one of the characters that opens a Haddock? +triggered :: Text -> Bool +triggered t = case T.uncons t of + Just (ch, _) -> ch `elem` ("|^*$" :: String) + Nothing -> False + +-- | Does this line open a Haddock? +opensHaddock :: Text -> Bool +opensHaddock = isJust . splitTrigger + +-- | Split a doc comment's opening line into everything up to and including +-- its trigger, and whatever follows. +splitTrigger :: Text -> Maybe (Text, Text) +splitTrigger l = do + n <- openerWidth l + let (opener, afterOpener) = T.splitAt n l + (gap, rest) = T.span (== ' ') afterOpener + (trigger, body) <- case T.uncons rest of + Just ('|', b) -> Just ("|", b) + Just ('^', b) -> Just ("^", b) + Just ('*', _) -> Just (T.span (== '*') rest) + _ -> Nothing + pure (opener <> gap <> trigger, body) + +-- | How many characters open a comment, if it opens one. +openerWidth :: Text -> Maybe Int +openerWidth l + | "--" `T.isPrefixOf` l = Just 2 + | "{-" `T.isPrefixOf` l = Just 2 + | otherwise = Nothing + +-- | The comments written inside a region. +commentsWithin :: Span -> [Comment] -> [Comment] +commentsWithin s = filter (within . commentSpan) + where + within c = startPoint s <= startPoint c && endPoint c <= endPoint s + +---------------------------------------------------------------------------- +-- Pragmas + +-- | A compiler pragma, which is written as a block comment but is not one. +-- +-- GHC reads pragmas only from the file header, so where a pragma sits +-- decides whether it does anything at all. That is why recognising one is +-- not enough on its own: see 'Tilia.Parser.pmHeaderEnd' for the boundary +-- that says which pragmas are real. +data Pragma = Pragma + { -- | The name, upper-cased as GHC expects it, e.g. @LANGUAGE@. + pragmaName :: Text, + -- | Everything between the name and the closing @#-}@, with the + -- surrounding whitespace removed but nothing else touched. + pragmaBody :: Text + } + deriving (Eq, Show) + +-- | Recognise a pragma. +commentPragma :: Comment -> Maybe Pragma +commentPragma c = do + inner <- T.stripSuffix "#-}" =<< T.stripPrefix "{-#" oneLine + let (name, body) = T.break isSpace (T.stripStart inner) + if T.null name + then Nothing + else + Just + Pragma + { pragmaName = T.toUpper name, + pragmaBody = T.strip body + } + where + oneLine = T.unwords (map T.strip (NE.toList (commentBody c))) + +---------------------------------------------------------------------------- +-- Columns and offsets + +-- | How many characters of a line come before the compiler's column. +-- +-- A column is not a character offset. The lexer counts a tab as advancing to +-- the next multiple of eight, so a line with a tab in it has more columns +-- than it has characters, and cutting the text at a column would cut in the +-- wrong place. In a file indented with tabs that is every line. +offsetOf :: Text -> Int -> Int +offsetOf line column = T.length (T.take (walk 0 1) line) + where + walk i c + | c >= column = i + | i >= T.length line = i + (column - c) + | otherwise = walk (i + 1) (afterChar (T.index line i) c) + +-- | The compiler's column for the character at this offset. +columnOf :: Text -> Int -> Int +columnOf line offset = T.foldl' (flip afterChar) 1 (T.take offset line) + +-- | Where the column moves to once this character has been read. +afterChar :: Char -> Int -> Int +afterChar ch c + | ch == '\t' = ((c - 1) `div` 8 + 1) * 8 + 1 + | otherwise = c + 1 diff --git a/src/Tilia/Comments/Attach.hs b/src/Tilia/Comments/Attach.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Comments/Attach.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE LambdaCase #-} + +-- | Putting comments into the document. +-- +-- Attachment happens once, on the finished document, before anything is +-- rendered. A comment becomes an ordinary part of the document like any +-- other, and from then on nothing distinguishes it. +module Tilia.Comments.Attach + ( attachComments, + ) +where + +import Data.Bifunctor (first, second) +import Data.List (mapAccumL, unsnoc) +import Data.List.NonEmpty qualified as NE +import Data.Maybe (listToMaybe) +import Data.Text (Text) +import Tilia.Comments +import Tilia.Comments.Place +import Tilia.Doc.Combinators +import Tilia.Doc.Internal (Doc (..)) +import Tilia.Span + +-- | Put every comment into the document. +attachComments :: [Comment] -> Doc -> Doc +attachComments cs doc = written <> afterEverything (unplaced left) + where + (written, left) = walk (placeComments regions fences cs) doc + (regions, fences) = markedSpans doc + +-- | The comments nothing came to collect, written after everything. +afterEverything :: [Comment] -> Doc +afterEverything = \case + [] -> mempty + (opening : rest) -> atEnd True opening <> foldMap (atEnd False) rest + +-- | The spans of every 'DLocated' in the document, and of every 'DFence', +-- in that order. +markedSpans :: Doc -> ([Span], [Span]) +markedSpans = \case + DLocated s d -> first (s :) (markedSpans d) + DFence s d -> second (s :) (markedSpans d) + DCat a b -> markedSpans a <> markedSpans b + DNest _ d -> markedSpans d + DAlign d -> markedSpans d + DGroup _ d -> markedSpans d + DVariant a _ -> markedSpans a + DCppChoice bs e -> foldMap (markedSpans . snd) bs <> markedSpans e + _ -> ([], []) + +-- | Walk the document, giving each region what it was given. +walk :: Placements -> Doc -> (Doc, Placements) +walk = go + where + go p = \case + DCat a b -> + let (a', p') = go p a + (b', p'') = go p' b + in (DCat a' b', p'') + DLocated s d -> + let (mine, p') = takePlaced s p + (d', p'') = go p' d + write position cs = + foldMap (writtenAs (endOfAConstruct s) position) cs + before' = heldOffFrom d [c | (q, c) <- mine, q == Before] + after' = [c | (q, c) <- mine, q == After] + in (write Before before' <> DLocated s d' <> write After after', p'') + DFence s d -> first (DFence s) (go p d) + DCppChoice bs e -> + let branch q (c, d) = let (d', q') = go q d in (q', (c, d')) + (p', bs') = mapAccumL branch p bs + (e', p'') = go p' e + in (DCppChoice bs' e', p'') + DNest n d -> first (DNest n) (go p d) + DAlign d -> first DAlign (go p d) + DGroup l d -> first (DGroup l) (go p d) + DVariant a b -> + let (a', p') = go p a + (b', _) = go p b + in (DVariant a' b', p') + d -> (d, p) + +-- | Hold the last comment off a Haddock about to be written under it. +-- +-- Only a comment written as @--@ lines needs holding off: the lexer would +-- read it and the Haddock under it as one comment. A @{- … -}@ ends at its +-- own bracket and may sit against whatever follows. +heldOffFrom :: Doc -> [Comment] -> [Comment] +heldOffFrom d cs = case unsnoc cs of + Just (earlier, c) + | not (bracketed c), + opensWithHaddock d -> + earlier <> [c {commentGapBelow = True}] + _ -> cs + +-- | Does this region begin its first line with a Haddock? +opensWithHaddock :: Doc -> Bool +opensWithHaddock = maybe False opensHaddock . listToMaybe . fst . firstLine Broken + where + firstLine layout = \case + DText t -> ([t], False) + DCat a b -> case firstLine layout a of + (before, True) -> (before, True) + (before, False) -> first (before <>) (firstLine layout b) + DNest _ x -> firstLine layout x + DAlign x -> firstLine layout x + DLocated _ x -> firstLine layout x + DFence _ x -> firstLine layout x + DGroup l x -> firstLine l x + DVariant a b -> firstLine layout (case layout of Flat -> a; Broken -> b) + DHardBreak -> ([], True) + DCloseLine -> ([], True) + DBreak -> ([], layout == Broken) + DSoftBreak -> ([], layout == Broken) + _ -> ([], False) + +-- | Does this region stand for where a construct stops rather than for +-- anything written? +endOfAConstruct :: Span -> Bool +endOfAConstruct s = startPoint s == endPoint s + +---------------------------------------------------------------------------- +-- What a comment looks like + +-- | One comment, written where it was placed. +writtenAs :: + -- | Does what follows only mark where the construct ends? + Bool -> + Position -> + Comment -> + Doc +writtenAs atTheEnd position c = commentDoc c $ case shapeOf position c of + InPlace -> case position of + Before -> includeWhen (not (commentTrailing c)) space <> body <> space + After -> space <> body <> space + EndsTheLine -> space <> body <> closeLine <> gapBelow + HeldBack -> holdBack (renderComment c) + OnItsOwnLines -> gapAbove <> closeLine <> body <> closeLine <> gapBelow + where + body = commentText c + gapAbove = includeWhen (commentGapAbove c) (closeLine <> blankLine) + gapBelow = includeWhen (commentGapBelow c && not atTheEnd) blankLine + +-- | Turn a 'Comment' that trails the document into a 'Doc'. +atEnd :: + -- | Is this the first of them, and so the one held off the code above? + Bool -> + Comment -> + Doc +atEnd opensTheRun c = + commentDoc c $ + closeLine + <> includeWhen (opensTheRun || commentGapAbove c) blankLine + <> commentText c + <> closeLine + +-- | A comment, and the spacing that goes with it, as one region. +-- +-- One region and not several, because the empty line a comment is held off +-- by belongs to the comment and not to whatever it happens to sit next to. +-- Anything that takes a document apart and puts it back together—the merge +-- in "Tilia.Cpp" above all—works on what a region holds, and would +-- otherwise be free to keep the spacing and move the comment, which is how +-- a blank line comes to be left behind in a place that cannot produce it +-- again. +commentDoc :: Comment -> Doc -> Doc +commentDoc = located . commentSpan + +-- | The text of a comment, laid out as it was written. +commentText :: Comment -> Doc +commentText c = + align $ sepBy (verbatimBreak AtIndent) (map txt (NE.toList (commentBody c))) + +---------------------------------------------------------------------------- +-- The two document atoms that exist for comments + +-- | Text put at the end of the line this position falls on. +-- +-- The argument must not contain a line break. +holdBack :: Text -> Doc +holdBack = DHoldBack + +-- | Close the line, absorbing a break that immediately follows. +closeLine :: Doc +closeLine = DCloseLine diff --git a/src/Tilia/Comments/Place.hs b/src/Tilia/Comments/Place.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Comments/Place.hs @@ -0,0 +1,191 @@ +-- | Deciding where each comment goes. +module Tilia.Comments.Place + ( -- * Where a comment goes + Position (..), + Shape (..), + shapeOf, + + -- * The answers + Placements, + placeComments, + takePlaced, + unplaced, + ) +where + +import Data.IntMap.Strict qualified as IntMap +import Data.IntSet qualified as IntSet +import Data.List (sortOn) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Ord (Down (..)) +import Data.Set qualified as Set +import Tilia.Comments + ( Above (..), + Comment (..), + closesItself, + commentTrailing, + singleLine, + ) +import Tilia.Span + +-- | Which side of its region a comment is emitted on. +data Position + = -- | Before the region. + Before + | -- | After the region. + After + deriving (Eq, Show) + +-- | How a comment is printed in relation to the region carrying it. +data Shape + = -- | Spliced where the region prints, with code able to follow it on the + -- same line. + InPlace + | -- | Printed where the region is, and the line closed after it. + EndsTheLine + | -- | Held back to the end of whatever line of output it lands on, + -- however much of that line is still to be written. + HeldBack + | -- | On lines of its own, keeping the empty lines the author left around + -- it. + OnItsOwnLines + deriving (Eq, Show) + +-- | What a comment given to a region at this position will look like. +shapeOf :: Position -> Comment -> Shape +shapeOf position c = case position of + Before + | closesItself c && commentFollowed c -> InPlace + | commentTrailing c -> EndsTheLine + | otherwise -> OnItsOwnLines + After + | closesItself c -> InPlace + | singleLine c -> HeldBack + | otherwise -> EndsTheLine + +-- | What each region was given, and what nothing could be found for. +data Placements = Placements + { placedAt :: Map Span [(Position, Comment)], + placedNowhere :: [Comment] + } + +-- | Give every comment to a region. +placeComments :: + -- | The regions a comment may be given to + [Span] -> + -- | The boundaries a comment printed in place may not be carried across + [Span] -> + [Comment] -> + Placements +placeComments regions fences comments = + Placements + { placedAt = Map.fromListWith (flip (<>)) [(r, [(p, c)]) | (Just (r, p), c) <- decided], + placedNowhere = [c | (Nothing, c) <- decided] + } + where + decided = [(against c, c) | c <- comments] + + linesEndingInAComment = + IntSet.fromList + [ spanEndLine (commentSpan c) + | c <- comments, + commentTrailing c, + not (commentFollowed c) + ] + + ownLineComments = + IntMap.fromList + [ (spanStartLine s, (spanStartColumn s, commentAbove c)) + | c <- comments, + not (commentTrailing c), + not (commentFollowed c), + let s = commentSpan c + ] + + carriedOnFrom column = go + where + go line + | IntSet.member line linesEndingInAComment = Just line + | Just (col, above) <- IntMap.lookup line ownLineComments, + col == column, + above == ContentAt column = + go (line - 1) + | otherwise = Nothing + + regionsByEndLine = + IntMap.fromListWith (<>) [(spanEndLine r, [r]) | r <- regions] + + regionEndPoints = Set.fromList (map endPoint regions) + + regionsByStartPoint = + Map.fromListWith wider [(startPoint r, r) | r <- regions] + where + wider a b = if endPoint a >= endPoint b then a else b + + against c + | commentTrailing c, Just r <- trailed = Just (r, After) + | not (commentTrailing c), Just r <- continues = Just (r, After) + | Just r <- next = Just (r, Before) + | otherwise = Nothing + where + here = commentSpan c + trailed + | writtenAgainst || not (commentFollowed c) = endingOn (spanStartLine here) + | otherwise = Nothing + endingOn line = + nearest (\r -> (Down (endPoint r), startPoint r)) (filter candidate onThatLine) + where + onThatLine = IntMap.findWithDefault [] line regionsByEndLine + candidate r = endPoint r <= startPoint here && not (fencedOff r) + + writtenAgainst = maybe False (`Set.member` regionEndPoints) stopsAt + stopsAt = (,) (spanStartLine here) <$> commentCodeBeforeStopsAt c + + enclosingRegions = filter (here `inside`) regions + enclosingFences = filter (here `inside`) fences + + fencedOff r = outside enclosingRegions || (printedInPlace && outside enclosingFences) + where + outside = any (not . (r `inside`)) + + printedInPlace = shapeOf After c == InPlace + + next = snd <$> Map.lookupGE (endPoint here) regionsByStartPoint + + continues + | ContentAt column <- commentAbove c, + column == spanStartColumn here, + nothingBelowItLinesUp, + Just anchor <- carriedOnFrom column (spanStartLine here - 1) = + endingOn anchor + | otherwise = Nothing + + nothingBelowItLinesUp = + all (\r -> spanStartColumn r < spanStartColumn here) next + + -- Folded rather than sorted: this runs for every comment against every + -- region, and only the first of the order is ever wanted. + nearest :: (Ord k) => (Span -> k) -> [Span] -> Maybe Span + nearest key = fmap fst . foldl' closer Nothing + where + closer best s = case best of + Just (_, k) | k <= key s -> best + _ -> Just (s, key s) + +-- | Does the first region fall within the second? +inside :: Span -> Span -> Bool +inside a b = startPoint b <= startPoint a && endPoint a <= endPoint b + +-- | Take what a region was given, so that nothing can take it again. +takePlaced :: Span -> Placements -> ([(Position, Comment)], Placements) +takePlaced s p = case Map.updateLookupWithKey forget s (placedAt p) of + (found, rest) -> (concat found, p {placedAt = rest}) + where + forget _ _ = Nothing + +-- | The comments no region ever came to collect. +unplaced :: Placements -> [Comment] +unplaced p = + sortOn (startPoint . commentSpan) $ + placedNowhere p <> [c | (_, c) <- concat (Map.elems (placedAt p))] diff --git a/src/Tilia/Cpp.hs b/src/Tilia/Cpp.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Cpp.hs @@ -0,0 +1,1677 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Formatting a module with the C preprocessor involved. +module Tilia.Cpp + ( -- * Formatting + formatWithCpp, + usesCpp, + blankCpp, + withoutRuledOut, + CppError (..), + describeCppError, + + -- * Splitting + Guard (..), + Configurations (..), + configurations, + leaves, + branchLeaves, + linearLeaves, + countLeaves, + answeredLeaves, + answeredLinearLeaves, + + -- * Diagnostics + regions, + ) +where + +import Data.Char (isAsciiLower) +import Data.List (maximumBy, sortOn, transpose, unsnoc) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Maybe (isJust, listToMaybe, maybeToList) +import Data.Ord (comparing) +import Data.Text (Text) +import Data.Text qualified as T +import GHC.LanguageExtensions.Type (Extension (..)) +import Tilia.Cpp.Macros (Macros, answerTo) +import Tilia.Doc (defaultRenderOptions, printDoc) +import Tilia.Doc.Combinators qualified as Doc +import Tilia.Doc.Internal (Doc (..), Layout (..)) +import Tilia.Parser + ( ParseError, + ParserConfig, + describeParseError, + parseConfiguration, + ) +import Tilia.Render (RenderConfig (..), renderModule) +import Tilia.Source + ( Lines, + Written (..), + blankAt, + blankBelow, + closesABranch, + dropping, + lineTexts, + linesOf, + ) +import Tilia.Span (Span, covers, meets, mkSpan, spanEndLine, spanStartLine) + +---------------------------------------------------------------------------- +-- Formatting + +-- | Format a module which uses the C preprocessor. +-- +-- Each configuration is formatted by the ordinary printer. The resulting +-- documents are then merged. +formatWithCpp :: + -- | What to parse each configuration with + ParserConfig -> + -- | What to print each configuration with + RenderConfig -> + -- | The file this is, for the positions in an error + FilePath -> + -- | The module, directives and all + Text -> + -- | The formatted module, or why not + Either CppError Text +formatWithCpp parser render path source = + printDoc defaultRenderOptions . fst + <$> formatAllConfigs + parser + (knowing render) + path + (noAnswers source) + configurationBudget + source + where + knowing c = + c {rcImportBarriers = maybe [] (map dLine) (scanDirectives source)} + +-- | Format every configuration of a module, and merge them into one +-- document. +formatAllConfigs :: + -- | What to parse a configuration with + ParserConfig -> + -- | What to print it with + RenderConfig -> + -- | The file this is, for the positions in a parse error + FilePath -> + -- | How this configuration was reached + Reached -> + -- | Formattings left to spend + Int -> + Text -> + Either CppError (Doc, Int) +formatAllConfigs parser render path reached budget source = case variations source of + Nothing + | any isDirective (T.lines left) -> Left (UnhandledDirective (unhandledIn left)) + | budget <= 0 -> Left TooManyConfigurations + | otherwise -> do + document <- + formatSingleConfig + parser + render + path + reached + left + (,budget - 1) + <$> replacing + (reachedLines reached) + (reachedAnswers reached) + opaque + document + where + opaque = opaqueDirectives source + left = withoutOpaque source + Just apart -> case linearly apart of + Right built -> Right built + Left (Refused TooManyConfigurations, _) -> Left TooManyConfigurations + Left (_, left') + | Right many <- countLeaves source, + many > configurationsWorthTrying -> + Left TooManyConfigurations + | otherwise -> + maybe + (Left UnsplittableConditional) + (together parser render path reached left') + (configurations source) + where + linearly v = + case separately parser render path reached budget v of + Left why -> Left (Refused why, budget) + Right (baseDoc, merged, budget') -> + case combine Broken baseDoc (zip (map cfgWholes (vaGroups v)) merged) of + Just d -> Right (d, budget') + Nothing -> Left (InOneConstruct, budget') + +-- | Why the linear form did not work. +data Linearly + = -- | A configuration under it was refused, and this is what for. + Refused CppError + | -- | The merge came back a bare choice, so the conditionals' differences + -- land on one construct and cannot be put back one at a time. + InOneConstruct + +-- | What every question asked at the top level of a module splits it into, +-- each taken on its own. +data Variation = Variation + { -- | Every question answered with its first branch. + vaBaseline :: Text, + -- | The branches that answer left out. See 'Tilia.Source.dropping'. + vaBaselineDropped :: [(Int, Int)], + -- | One question varied, with all the others held at the baseline. + vaGroups :: [Configurations] + } + +-- | Split a module on every conditional at its top level, one at a time. +variations :: Text -> Maybe Variation +variations source = do + ds <- scanDirectives source + specs <- traverse groupSpec (groupsAtLevel 0 ds) + case [[gs] | gs <- specs] of + [] -> Nothing + dimensions -> + let blanked at = + concat [blankingFor g (at k) | (k, dim) <- zip [0 :: Int ..] dimensions, g <- dim] + gone at = + concat [droppedFor g (at k) | (k, dim) <- zip [0 :: Int ..] dimensions, g <- dim] + held at = blanking (blanked at) source + in Just + Variation + { vaBaseline = held (const 0), + vaBaselineDropped = gone (const 0), + vaGroups = + [ Configurations + { cfgGuards = gsGuards gs, + cfgTexts = + [ held (\j -> if j == k then i else 0) + | i <- [0 .. gsCount gs - 1] + ], + cfgDropped = + [ gone (\j -> if j == k then i else 0) + | i <- [0 .. gsCount gs - 1] + ], + cfgWholes = Varied (map gsWhole dim) + } + | (k, dim@(gs : _)) <- zip [0 :: Int ..] dimensions + ] + } + +-- | Vary each conditional on its own, holding the others at their first +-- branch. +separately :: + -- | What to parse a configuration with + ParserConfig -> + -- | What to print it with + RenderConfig -> + -- | The file this is, for the positions in a parse error + FilePath -> + -- | How this configuration was reached + Reached -> + -- | Formattings left to spend + Int -> + -- | The conditionals to vary, and the baseline to hold them against + Variation -> + Either CppError (Doc, [Doc], Int) +separately parser render path reached budget v = do + (baseDoc, spent) <- + formatAllConfigs + parser + render + path + (without (vaBaselineDropped v) reached) + budget + (vaBaseline v) + (merged, left) <- eachGroup baseDoc spent (vaGroups v) + pure (baseDoc, merged, left) + where + free = freeOf reached + + eachGroup _ b [] = Right ([], b) + eachGroup baseDoc b (c : cs) = do + (docs, b') <- eachBranch c baseDoc b (zip [0 ..] (cfgTexts c)) + (rest, b'') <- eachGroup baseDoc b' cs + pure (merge free (cfgGuards c) (cfgWholes c) docs : rest, b'') + + eachBranch _ _ b [] = Right ([], b) + eachBranch c baseDoc b ((i, t) : ts) = do + (d, b') <- + if t == vaBaseline v + then Right (baseDoc, b) + else formatAllConfigs parser render path (answering c i reached) b t + (ds, b'') <- eachBranch c baseDoc b' ts + pure (d : ds, b'') + +-- | Vary the conditionals together, one group at a time. +together :: + -- | What to parse a configuration with + ParserConfig -> + -- | What to print it with + RenderConfig -> + -- | The file this is, for the positions in a parse error + FilePath -> + -- | How this configuration was reached + Reached -> + -- | Formattings left to spend + Int -> + -- | The group to split on, and the branch texts to split it into + Configurations -> + Either CppError (Doc, Int) +together parser render path reached budget c = do + (docs, budget') <- eachBranch budget (zip [0 ..] (cfgTexts c)) + pure (merge (freeOf reached) (cfgGuards c) (cfgWholes c) docs, budget') + where + inside = reached + eachBranch b [] = Right ([], b) + eachBranch b ((i, t) : ts) = do + (d, b') <- formatAllConfigs parser render path (answering c i inside) b t + (ds, b'') <- eachBranch b' ts + pure (d : ds, b'') + +-- | Format one configuration with the ordinary printer. +formatSingleConfig :: + -- | What to parse it with + ParserConfig -> + -- | What to print it with + RenderConfig -> + -- | The file this is, for the positions in a parse error + FilePath -> + -- | How this configuration was reached + Reached -> + -- | The configuration itself, with no directives left in it + Text -> + Either CppError Doc +formatSingleConfig parser render path reached text = + case parseConfiguration parser path (reachedLines reached) text of + Left e -> Left (ConfigurationNotParsed (reachedAnswers reached) e) + Right parsed -> Right (renderModule render parsed) + +-- | How a configuration was reached, and what to call it. +data Reached = Reached + { -- | Which branch each question was answered with, outermost first. + reachedAnswers :: [([Guard], Int)], + -- | Every line the author wrote, except for those written inside a + -- branch this configuration did not take. + reachedLines :: Lines + } + +-- | The configuration nothing has been decided about yet. +noAnswers :: Text -> Reached +noAnswers source = + Reached + { reachedAnswers = [], + reachedLines = linesOf (Written source) + } + +-- | Answer one group's question with the branch at the given index. +answering :: Configurations -> Int -> Reached -> Reached +answering c i reached = + reached + { reachedAnswers = reachedAnswers reached <> [(cfgGuards c, i)], + reachedLines = dropping (concat (take 1 (drop i (cfgDropped c)))) (reachedLines reached) + } + +-- | Leave out the branches a baseline does not take, without answering +-- anything: the baseline is every question taken at its first branch, and +-- which question is being varied is not settled until 'answering'. +without :: [(Int, Int)] -> Reached -> Reached +without gone reached = + reached {reachedLines = dropping gone (reachedLines reached)} + +-- | How many whole formattings of a module one call may spend. +configurationBudget :: Int +configurationBudget = 64 + +-- | How many configurations a module may have and still be worth trying the +-- product on. +configurationsWorthTrying :: Integer +configurationsWorthTrying = 4096 + +-- | Put the directives that do not introduce new configurations back where +-- they were written. +replacing :: Lines -> [([Guard], Int)] -> [Opaque] -> Doc -> Either CppError Doc +replacing written answers opaque doc = foldl step (Right doc) opaque + where + step acc d + | reproducedAt n doc = Left (DirectiveInQuotedText answers (keyword t)) + | otherwise = + acc + >>= maybe (Left (DirectiveUnplaceable answers (keyword t))) Right + . place d + where + n = opLine d + t = opText d + keyword = T.takeWhile (/= ' ') + reproducedAt n = any inside . located + where + inside (s, x) = + spanStartLine s < n && n <= spanEndLine s && reproduced x + + located = \case + DLocated s x -> (s, x) : located x + DFence s x -> (s, x) : located x + DNest _ x -> located x + DAlign x -> located x + DGroup _ x -> located x + DVariant _ b -> located b + DCat a b -> located a <> located b + _ -> [] + + reproduced = \case + DVerbatimBreak _ -> True + DNest _ x -> reproduced x + DAlign x -> reproduced x + DGroup _ x -> reproduced x + DVariant _ b -> reproduced b + DCat a b -> reproduced a || reproduced b + _ -> False + + place directive = go + where + n = opLine directive + + body = + DCppDirective (opSpan directive) (opText directive) + <> if gapUnder written directive then Doc.blankLine else mempty + + go d = case d of + DNest k x -> DNest k <$> go x + DAlign x -> DAlign <$> go x + DGroup l x -> DGroup l <$> go x + DVariant a b -> DVariant <$> go a <*> go b + DLocated s x | spanEndLine s >= n -> DLocated s <$> go x + DFence s x | spanEndLine s >= n -> DFence s <$> go x + DCat _ _ -> inSpine (spine d) + _ -> Nothing + + inSpine parts = case break startsAfter parts of + (before, after) + | Just (earlier, holder, spacing) <- holding before, + maybe False (>= n) (endOf holder) -> + (\x -> mconcat (earlier <> [x] <> spacing <> after)) <$> go holder + | Just (printed, anchor, spacing) <- tight before, + Just from <- endOf anchor, + not (gapWritten written (from + 1) (n - 1)) -> + Just (mconcat (printed <> [anchor, body] <> spacing <> after)) + | otherwise -> Just (mconcat (before <> [body] <> after)) + where + startsAfter x = maybe False (>= n) (startOf x) + + holding ds = case break (isJust . endOf) (reverse ds) of + (spacing, holder : earlier) -> Just (reverse earlier, holder, reverse spacing) + _ -> Nothing + + tight ds = case break (isJust . endOf) (reverse ds) of + (spacing, anchor : earlier) -> Just (reverse earlier, anchor, reverse spacing) + _ -> Nothing + + startOf = fmap fst . boundsOf + + endOf = fmap snd . boundsOf + + boundsOf = \case + DLocated s _ -> Just (spanStartLine s, spanEndLine s) + DFence s _ -> Just (spanStartLine s, spanEndLine s) + DCppDirective s _ -> Just (spanStartLine s, spanEndLine s) + DNest _ x -> boundsOf x + DAlign x -> boundsOf x + DGroup _ x -> boundsOf x + DVariant _ b -> boundsOf b + DCat a b -> case (boundsOf a, boundsOf b) of + (Just (from, _), Just (_, to)) -> Just (from, to) + (found, Nothing) -> found + (Nothing, found) -> found + _ -> Nothing + +-- | A module with the directives that ask nothing blanked out of it. +-- +-- The same blanking every branch gets, and for the same reason: what is +-- left occupies the lines it always did, so everything downstream can go on +-- lining documents up by where they came from. +withoutOpaque :: Text -> Text +withoutOpaque source = + blanking [(opLine d, opLastLine d) | d <- opaqueDirectives source] source + +-- | Merge the documents one conditional's branches printed to. +-- +-- A structural walk that keeps what they all agree on and puts a choice +-- where they part. +merge :: [(Span, Text)] -> [Guard] -> Varied -> [Doc] -> Doc +merge free guards varied = go Broken + where + go _ [] = mempty + go layout ds@(d : rest) + | all (agree varied layout d) rest = d + | Just xs <- traverse only spines = alongside layout xs + | otherwise = factored layout spines + where + spines = map (spineAt layout) ds + + alongside _ [] = mempty + alongside layout xs@(x : _) = case x of + DLocated s _ + | Just tds <- every (\case DLocated t d -> Just (t, d); _ -> Nothing), + all (meets s . fst) tds -> + case go layout (map snd tds) of + DCppChoice _ _ + | Just opened <- unwrapping layout (map fst tds) xs -> opened + descended -> DLocated (hull s tds) descended + DFence s _ + | Just tds <- every (\case DFence t d -> Just (t, d); _ -> Nothing), + all (meets s . fst) tds -> + DFence (hull s tds) (go layout (map snd tds)) + DNest n _ | Just ds <- every (\case DNest m d | m == n -> Just d; _ -> Nothing) -> DNest n (go layout ds) + DGroup _ _ + | Just ls <- every (\case DGroup l _ -> Just l; _ -> Nothing), + Just ds@(d : rest) <- every (\case DGroup _ d -> Just d; _ -> Nothing) -> + let inside = if Broken `elem` ls then Broken else Flat + merged = go inside ds + in case merged of + DCppChoice _ _ + | not (all (== inside) ls), + not (all (agree varied inside d) rest) -> + choice xs + _ -> DGroup inside merged + DAlign _ | Just ds <- every (\case DAlign d -> Just d; _ -> Nothing) -> DAlign (go layout ds) + _ -> choice xs + where + every f = traverse f xs + + unwrapping layout spans xs = do + inside <- sole [i | (i, s) <- zip [0 :: Int ..] spans, all (covers s) spans] + wrapper <- listToMaybe (drop inside xs) + if opens layout wrapper then Just (openedAgainst layout inside wrapper) else Nothing + where + sole [i] = Just i + sole _ = Nothing + + openedAgainst l inside' d = case d of + DLocated s x -> DLocated s (openedAgainst l inside' x) + DFence s x -> DFence s (openedAgainst l inside' x) + DNest n x -> DNest n (openedAgainst l inside' x) + DAlign x -> DAlign (openedAgainst l inside' x) + DGroup m x -> DGroup m (openedAgainst m inside' x) + _ -> case spineAt l d of + parts@(_ : _ : _) -> + factored l [if k == inside' then parts else [e] | (k, e) <- zip [0 :: Int ..] xs] + _ -> choice xs + + opens layout = \case + DLocated _ x -> opens layout x + DFence _ x -> opens layout x + DNest _ x -> opens layout x + DAlign x -> opens layout x + DGroup l x -> opens l x + d -> case spineAt layout d of + _ : _ : _ -> True + _ -> False + + factored layout ss = + let exposed = map (exposing (filter split' (sharedDirectives ss))) ss + split' d = d `elem` free && any (holds d) ss && not (all (holds d) ss) + holds d = any (isNamed d) + lining = alignable varied layout + shared = foldl1 (lcs lining) exposed + cut = map (segments (anchored lining) shared) exposed + stretches = transpose (map fst cut) + anchors = transpose (map snd cut) + in mconcat (woven layout stretches (map (go layout) anchors)) + + woven layout (s : ss) (c : cs) = varying layout s : c : woven layout ss cs + woven layout ss [] = map (varying layout) ss + woven _ [] _ = [] + + varying layout ss = + let (opening, ss1) = sharedStart layout ss + (ss2, closing) = sharedEnd layout ss1 + (lead, ss3, trail) = hoisted layout ss2 + in mconcat opening + <> mconcat lead + <> middle layout ss3 + <> mconcat trail + <> mconcat closing + + sharedStart layout ss + | Just (h : hs) <- traverse listToMaybe ss, + all (agree varied layout h) hs = + let (c, ss') = sharedStart layout (map (drop 1) ss) in (h : c, ss') + | otherwise = ([], ss) + + sharedEnd layout ss = + let (c, ss') = sharedStart layout (map reverse ss) + in (map reverse ss', reverse c) + + middle _ [] = mempty + middle layout ss@(s : rest) + | all (alike layout s) rest = mconcat s + | Just xs <- traverse only ss = go layout xs + | Just merged <- alongsideHeads layout ss, + weigh layout merged < weigh layout apart = + merged + | otherwise = apart + where + apart = choice (map mconcat ss) + + alongsideHeads layout ss = do + heads <- traverse listToMaybe ss + let tails = map (drop 1) ss + case heads of + (h : hs) + | all (sameKind h) hs, + all breaksFirst tails -> + Just (joined (go layout heads) (middle layout tails)) + _ -> Nothing + where + breaksFirst t = case dropWhile ((== 0) . weigh layout) t of + [] -> True + (d : _) -> opensWithBreak layout d + + joined before after = case (endingChoice before, startingChoice after) of + (Just (opening, bs, e, gap), Just (gap', cs, e', closing)) + | map fst bs == map fst cs -> + opening + <> Doc.cppChoice + [(g, x <> between <> y) | ((g, x), (_, y)) <- zip bs cs] + (e <> between <> e') + <> closing + where + between = gap <> gap' + _ -> before <> after + + sameKind x y = case (x, y) of + (DLocated s t, DLocated u v) -> meets s u && bothWritten t v + (DFence s t, DFence u v) -> meets s u && bothWritten t v + (DNest n t, DNest m v) -> n == m && bothWritten t v + (DGroup _ t, DGroup _ v) -> bothWritten t v + (DAlign t, DAlign v) -> bothWritten t v + _ -> False + where + bothWritten t v = not (empty' t) && not (empty' v) + empty' DEmpty = True + empty' _ = False + + alike layout xs ys = + length xs == length ys && and (zipWith (agree varied layout) xs ys) + + hoisted layout ss = case filter (not . null . middleOf) peeled of + [] -> + ( widest [l | (l, _, _) <- peeled], + map (const []) ss, + widest [r | (_, _, r) <- peeled] + ) + speaking -> + ( widest [l | (l, _, _) <- speaking], + map middleOf peeled, + widest [r | (_, _, r) <- speaking] + ) + where + peeled = map peel ss + middleOf (_, m, _) = m + widest = \case + [] -> [] + runs -> maximumBy (comparing (spaceOf layout)) runs + + peel ds = + let (l, rest) = span spacing ds + (r, m) = span spacing (reverse rest) + in (l, reverse m, reverse r) + + spacing = \case + DEmpty -> True + DBreak -> True + DSoftBreak -> True + DHardBreak -> True + DCloseLine -> True + _ -> False + + choice ds = case unsnoc ds of + Just (branches, fallback) -> Doc.cppChoice (zip (map guardText guards) branches) fallback + Nothing -> mempty + + only [d] = Just d + only _ = Nothing + +-- | 'freeDirectives' of the module as its author wrote it. +freeOf :: Reached -> [(Span, Text)] +freeOf = freeDirectives . T.unlines . lineTexts . reachedLines + +-- | The opaque directives written outside every conditional. +freeDirectives :: Text -> [(Span, Text)] +freeDirectives source = + [ (opSpan d, opText d) + | d <- opaqueDirectives source, + Map.findWithDefault 0 (opLine d) depths == (0 :: Int) + ] + where + depths = Map.fromList (zip [1 ..] (scanl step 0 (T.lines source))) + step depth l + | not (isDirective l) = depth + | keyword `elem` ["if", "ifdef", "ifndef"] = depth + 1 + | keyword == "endif" = max 0 (depth - 1) + | otherwise = depth + where + keyword = T.takeWhile isAsciiLower (T.stripStart (T.drop 1 (T.stripStart l))) + +-- | Is this spine element the named directive itself, bare? +isNamed :: (Span, Text) -> Doc -> Bool +isNamed (s, t) = \case + DCppDirective u v -> u == s && v == t + _ -> False + +-- | The directives every one of these spines holds. +sharedDirectives :: [[Doc]] -> [(Span, Text)] +sharedDirectives = \case + [] -> [] + s : ss -> foldl (\acc t -> filter (`elem` namesIn t) acc) (namesIn s) ss + where + namesIn = concatMap named + +-- | The directives a document holds, as far down as one may be brought out +-- from. +named :: Doc -> [(Span, Text)] +named = \case + DCppDirective s t -> [(s, t)] + DCat a b -> named a <> named b + DNest _ x -> named x + DAlign x -> named x + DGroup _ x -> named x + DVariant _ b -> named b + _ -> [] + +-- | Bring the given directives out to the top of the spine. +exposing :: [(Span, Text)] -> [Doc] -> [Doc] +exposing wanted + | null wanted = id + | otherwise = concatMap out + where + out d + | not (any here (named d)) = [d] + | otherwise = case d of + DCat a b -> out a <> out b + DNest k x -> split (DNest k) (out x) + DAlign x -> split DAlign (out x) + DGroup l x -> split (DGroup l) (out x) + DVariant a b -> varied (out a) (out b) + _ -> [d] + + here (s, t) = (s, t) `elem` wanted + + bare = \case + DCppDirective s t -> here (s, t) + _ -> False + + split w ps = case break bare ps of + (before, []) -> [w (mconcat before) | not (null before)] + (before, x : rest) -> + [w (mconcat before) | not (null before)] <> [x] <> split w rest + + varied as bs = + let (xs, ds) = chunk as + (ys, es) = chunk bs + in if ds == es && length xs == length ys + then interleave xs ys ds + else [DVariant (mconcat as) (mconcat bs)] + + chunk ps = case break bare ps of + (before, []) -> ([mconcat before], []) + (before, x : rest) -> + let (cs, ds) = chunk rest in (mconcat before : cs, x : ds) + + interleave (x : xs) (y : ys) ds = case ds of + [] -> [DVariant x y] + z : zs -> DVariant x y : z : interleave xs ys zs + interleave _ _ _ = [] + +-- | Would these two documents print the same, laid out like this? +agree :: Varied -> Layout -> Doc -> Doc -> Bool +agree varied layout a b = alike (chunked (spineAt layout a)) (chunked (spineAt layout b)) + where + alike (Left s : xs) (Left t : ys) = s == t && alike xs ys + alike (Right x : xs) (Right y : ys) = here x y && alike xs ys + alike [] [] = True + alike _ _ = False + + chunked ds = + let (space, rest) = span isSpace' ds + in Left (spaceOf layout space) : case rest of + [] -> [] + x : more -> Right x : chunked more + + isSpace' = \case + DEmpty -> True + DSpace -> True + DBreak -> True + DSoftBreak -> True + DHardBreak -> True + DCloseLine -> True + _ -> False + + inside x y = agree varied layout x y + + here x y = case (x, y) of + (DGroup l x', DGroup m y') -> l == m && agree varied l x' y' + (DNest n x', DNest m y') -> n == m && inside x' y' + (DAlign x', DAlign y') -> inside x' y' + (DLocated s x', DLocated t y') -> + s == t && (untouched varied s || inside x' y') + (DFence s x', DFence t y') -> s == t && inside x' y' + (DCppChoice bs x', DCppChoice cs y') -> + length bs == length cs + && and [g == h && inside p q | ((g, p), (h, q)) <- zip bs cs] + && inside x' y' + (DText s, DText t) -> s == t + (DCppDirective s u, DCppDirective t v) -> s == t && u == v + (DHoldBack s, DHoldBack t) -> s == t + (DVerbatimBreak r, DVerbatimBreak q) -> r == q + (DSpace, DSpace) -> True + (DBreak, DBreak) -> True + (DSoftBreak, DSoftBreak) -> True + (DHardBreak, DHardBreak) -> True + (DCloseLine, DCloseLine) -> True + _ -> False + +-- | What a run of space comes to on the page. +-- +-- How many lines it ends, which is all that can be told of it afterwards +-- since the printer never writes two empty lines in a row, and whether it +-- holds the text either side of it apart on a line it did not end. +-- +-- The 'Ord' instance is how much space it is, which is why the fields are in +-- that order: nothing, then a space, then a line ended, then two. +data Space = Space !Int !Bool + deriving (Eq, Ord) + +-- | Read a run of space, the way 'Tilia.Doc.Internal.breakLine' does. +spaceOf :: Layout -> [Doc] -> Space +spaceOf layout = go 0 False False + where + go ended closed apart = \case + [] -> Space (min 2 ended) (apart && ended == 0) + d : ds -> case d of + DSpace -> go ended closed True ds + DCloseLine + | closed -> go ended closed apart ds + | otherwise -> go (ended + 1) True apart ds + DHardBreak -> broke ds + DBreak + | layout == Broken -> broke ds + | otherwise -> go ended closed True ds + DSoftBreak + | layout == Broken -> broke ds + | otherwise -> go ended closed apart ds + _ -> go ended closed apart ds + where + broke rest + | closed = go ended False apart rest + | otherwise = go (ended + 1) False apart rest + +-- | The lines one conditional could have printed differently. +newtype Varied = Varied {variedLines :: [(Int, Int)]} + deriving (Eq, Show) + +-- | Was this region printed from lines the conditional left alone? +untouched :: Varied -> Span -> Bool +untouched (Varied ranges) s = not (any reaches ranges) + where + reaches (from, to) = spanStartLine s <= to && from <= spanEndLine s + +-- | Put several documents' differences from a baseline into one document. +-- +-- Each of them is the baseline except inside one conditional's lines, and +-- those lines do not overlap, so their differences can be applied side by +-- side rather than chosen between. Which is what makes varying the +-- conditionals one at a time add up to varying them together, and so what +-- makes the cost linear. +combine :: Layout -> Doc -> [(Varied, Doc)] -> Maybe Doc +combine layout base ds = case filter (\(v, d) -> not (agree v layout base d)) ds of + [] -> Just base + [(_, only)] -> Just only + many -> case (spineAt layout base, [(v, spineAt layout d) | (v, d) <- many]) of + ([b], ss) | Just xs <- traverse (\(v, s) -> (,) v <$> single s) ss -> descend b xs + (bs, ss) -> spliced bs ss + where + single [d] = Just d + single _ = Nothing + + descend b xs = case b of + DLocated s i + | Just tds <- every (\case DLocated t d -> Just (t, d); _ -> Nothing), + all (meets s . fst . snd) tds -> + DLocated (hull s (map snd tds)) <$> combine layout i (inner tds) + DFence s i + | Just tds <- every (\case DFence t d -> Just (t, d); _ -> Nothing), + all (meets s . fst . snd) tds -> + DFence (hull s (map snd tds)) <$> combine layout i (inner tds) + DNest n i | Just is <- every (\case DNest m d | m == n -> Just d; _ -> Nothing) -> DNest n <$> combine layout i is + DAlign i | Just is <- every (\case DAlign d -> Just d; _ -> Nothing) -> DAlign <$> combine layout i is + DGroup l i + | Just ls <- every (\case DGroup m _ -> Just m; _ -> Nothing), + Just is <- every (\case DGroup _ d -> Just d; _ -> Nothing) -> + let inside = if Broken `elem` (l : map snd ls) then Broken else Flat + in DGroup inside <$> combine inside i is + _ -> Nothing + where + every f = traverse (\(v, d) -> (,) v <$> f d) xs + inner tds = [(v, d) | (v, (_, d)) <- tds] + + spliced bs ss = do + clustered <- + traverse + (cluster bs) + ( overlapping + ( sortOn + chFrom + ( concat + [ changesAgainst v (alignable v layout) (agree v layout) bs s + | (v, s) <- ss + ] + ) + ) + ) + pure (mconcat (applied bs clustered)) + + cluster _ [c] = Just c + cluster bs cs + | to - from == 1, + Just xs <- traverse (\c -> (,) (chVaried c) <$> single (chWith c)) cs, + (b : _) <- drop from bs = + ( \d -> + Change + { chFrom = from, + chTo = to, + chWith = [d], + chVaried = Varied (concatMap (variedLines . chVaried) cs) + } + ) + <$> combine layout b xs + | otherwise = Nothing + where + from = minimum (map chFrom cs) + to = maximum (map chTo cs) + + applied bs = go 0 + where + go i [] = drop i bs + go i (c : cs) = + take (chFrom c - i) (drop i bs) <> chWith c <> go (chTo c) cs + +-- | The smallest span covering a node's own and those of everything merged +-- into it. +hull :: Span -> [(Span, Doc)] -> Span +hull = foldr ((<>) . fst) + +-- | A stretch of the baseline, and what one document put there instead. +data Change = Change + { chFrom :: !Int, + chTo :: !Int, + chWith :: [Doc], + -- | The lines the conditional this change came from could have reached. + -- Carried so that a cluster of two of them can be combined without + -- losing which conditional each half belongs to. See 'Varied'. + chVaried :: Varied + } + +-- | What one document changed about the baseline, as the stretches it +-- replaced and what it put in each of their places. +changesAgainst :: + Varied -> + -- | Whether two elements stand for the same thing, which lines the spines up + (Doc -> Doc -> Bool) -> + -- | Whether two elements print the same, which says nothing changed + (Doc -> Doc -> Bool) -> + [Doc] -> + [Doc] -> + [Change] +changesAgainst varied lining plain bs xs = go 0 bs xs (lcs lining bs xs) + where + anchor = anchored lining + + go i b x [] = between i b x + go i b x (c : cs) = + let (b', b'') = break (anchor c) b + (x', x'') = break (anchor c) x + j = i + length b' + in between i b' x' + <> held j (listToMaybe b'') (listToMaybe x'') + <> go (j + 1) (drop 1 b'') (drop 1 x'') cs + + held j (Just b') (Just x') + | not (plain b' x') = + [Change {chFrom = j, chTo = j + 1, chWith = [x'], chVaried = varied}] + held _ _ _ = [] + + between i b x = + [ Change + { chFrom = i + shared, + chTo = i + shared + length b', + chWith = x', + chVaried = varied + } + | not (null b' && null x') + ] + where + shared = length (takeWhile id (zipWith plain b x)) + atEnd = length (takeWhile id (zipWith plain (reverse b) (reverse x))) + kept = min atEnd (min (length b) (length x) - shared) + b' = take (length b - kept - shared) (drop shared b) + x' = take (length x - kept - shared) (drop shared x) + +-- | Group changes that reach the same stretch of the baseline. +-- +-- Ones that merely touch are left apart: a change ending where the next +-- begins has not reached into it. +overlapping :: [Change] -> [[Change]] +overlapping [] = [] +overlapping (c : cs) = go [c] (chTo c) cs + where + go acc _ [] = [reverse acc] + go acc end (x : xs) + | chFrom x < end = go (x : acc) (max end (chTo x)) xs + | otherwise = reverse acc : go [x] (chTo x) xs + +-- | What a document prints before its final choice, and that choice. +endingChoice :: Doc -> Maybe (Doc, [(Text, Doc)], Doc, Doc) +endingChoice d = case span onlySpacing (reverse (spine d)) of + (trailing, x : earlier) -> + let opening = mconcat (reverse earlier) + gap = mconcat (reverse trailing) + around w (o, bs, e, g) = + (opening <> w o, map (fmap w) bs, w e, w g <> gap) + in case x of + DCppChoice bs e -> Just (opening, bs, e, gap) + DGroup l y -> around (DGroup l) <$> endingChoice y + DNest n y -> around (DNest n) <$> endingChoice y + DLocated s y -> around (DLocated s) <$> endingChoice y + DFence s y -> around (DFence s) <$> endingChoice y + _ -> Nothing + _ -> Nothing + +-- | The mirror of 'endingChoice': a document's opening choice, and the rest. +startingChoice :: Doc -> Maybe (Doc, [(Text, Doc)], Doc, Doc) +startingChoice d = case span onlySpacing (spine d) of + (leading, x : later) -> + let gap = mconcat leading + closing = mconcat later + around w (g, bs, e, c) = + (gap <> w g, map (fmap w) bs, w e, w c <> closing) + in case x of + DCppChoice bs e -> Just (gap, bs, e, closing) + DGroup l y -> around (DGroup l) <$> startingChoice y + DNest n y -> around (DNest n) <$> startingChoice y + DLocated s y -> around (DLocated s) <$> startingChoice y + DFence s y -> around (DFence s) <$> startingChoice y + _ -> Nothing + _ -> Nothing + +-- | Nothing but the whitespace that separates one thing from the next. +onlySpacing :: Doc -> Bool +onlySpacing = \case + DEmpty -> True + DSpace -> True + DBreak -> True + DSoftBreak -> True + DHardBreak -> True + DCloseLine -> True + _ -> False + +-- | Does the first thing this document puts on the page end a line? +opensWithBreak :: Layout -> Doc -> Bool +opensWithBreak layout d = case dropWhile quiet (spineAt layout d) of + (x : _) -> case x of + DNest _ y -> opensWithBreak layout y + DAlign y -> opensWithBreak layout y + DGroup l y -> opensWithBreak l y + DLocated _ y -> opensWithBreak layout y + DFence _ y -> opensWithBreak layout y + DHardBreak -> True + DCloseLine -> True + DBreak -> layout == Broken + DSoftBreak -> layout == Broken + DCppDirective _ _ -> True + DCppChoice _ _ -> True + _ -> False + [] -> False + where + quiet = \case + DEmpty -> True + DSpace -> True + _ -> False + +-- | How much text this document holds, counting what a choice repeats once +-- for each alternative that repeats it. +weigh :: Layout -> Doc -> Int +weigh layout = go + where + go = \case + DCat a b -> go a + go b + DNest _ d -> go d + DAlign d -> go d + DGroup l d -> weigh l d + DVariant flatD brokenD -> + go (case layout of Flat -> flatD; Broken -> brokenD) + DLocated _ d -> go d + DFence _ d -> go d + DCppChoice bs e -> sum (map (go . snd) bs) + go e + DText t -> T.length t + DCppDirective _ t -> T.length t + DHoldBack t -> T.length t + _ -> 0 + +-- | A document as the sequence of things it concatenates. +spine :: Doc -> [Doc] +spine = \case + DEmpty -> [] + DCat a b -> spine a <> spine b + d -> [d] + +-- | 'spine', with the variants resolved the way this layout will print them. +spineAt :: Layout -> Doc -> [Doc] +spineAt layout = go + where + go = \case + DEmpty -> [] + DCat a b -> go a <> go b + DVariant flatD brokenD -> + go (case layout of Flat -> flatD; Broken -> brokenD) + d -> [d] + +-- | The longest run of elements two spines have in common, in order, +-- allowing for anything either of them has that the other does not. +lcs :: (Doc -> Doc -> Bool) -> [Doc] -> [Doc] -> [Doc] +lcs same xs ys = + filter anchoring opening <> table middleX middleY <> filter anchoring closing + where + agreeing as bs = length (takeWhile id (zipWith same as bs)) + + ahead = agreeing xs ys + (opening, xs1) = splitAt ahead xs + ys1 = drop ahead ys + behind = agreeing (reverse xs1) (reverse ys1) + (middleX, closing) = splitAt (length xs1 - behind) xs1 + middleY = take (length ys1 - behind) ys1 + + table [] _ = [] + table _ [] = [] + table as bs = reverse (snd (last (foldl' (row bs) (start bs) as))) + where + start cs = replicate (length cs + 1) (0 :: Int, []) + row cs previous x = cells 0 [] (zip3 cs previous (drop 1 previous)) + where + cells !n acc rest = + (n, acc) : case rest of + [] -> [] + ((y, (dn, ds), (an, as')) : more) + | anchoring x, same x y -> cells (dn + 1) (x : ds) more + | n >= an -> cells n acc more + | otherwise -> cells an as' more + +-- | Do these two documents stand for the same thing? +alignable :: Varied -> Layout -> Doc -> Doc -> Bool +alignable = agree + +-- | Only let something that was printed line two spines up. +anchored :: (Doc -> Doc -> Bool) -> Doc -> Doc -> Bool +anchored same a b = anchoring a && same a b + +-- | Could this element hold two spines together, if it turned up in both? +anchoring :: Doc -> Bool +anchoring = \case + DEmpty -> False + DSpace -> False + DBreak -> False + DSoftBreak -> False + DHardBreak -> False + DCloseLine -> False + DVerbatimBreak _ -> False + _ -> True + +-- | A spine cut at the elements it shares with the others: one stretch +-- before each of them, and one after the last, and the elements themselves. +-- +-- Always one more stretch than there are shared elements, either end of +-- which may be empty. Leftmost matching is enough to find each of them, +-- since what is being matched is a subsequence of this spine to begin with. +-- +-- The matched elements come back rather than being dropped because the +-- caller cannot assume they are interchangeable: what lined them up is +-- 'alignable', and only 'agree' would say they print the same. +segments :: (Doc -> Doc -> Bool) -> [Doc] -> [Doc] -> ([[Doc]], [Doc]) +segments same = go + where + go [] s = ([s], []) + go (c : cs) s = case break (same c) s of + (before', matched : rest) -> keeping before' matched (go cs rest) + (before', []) -> keeping before' c (go cs []) + where + keeping before' matched (stretches, anchors) = + (before' : stretches, matched : anchors) + +-- | Would the preprocessor be run over this module, and find anything to +-- do? +usesCpp :: [Extension] -> Text -> Bool +usesCpp extensions source = + Cpp `elem` extensions && any isDirective (T.lines source) + +-- | Blank out the directive lines, keeping every branch. +blankCpp :: Text -> Text +blankCpp = T.unlines . go False . T.lines + where + go _ [] = [] + go continuing (l : ls) + | continuing || isDirective l = "" : go (runsOn l) ls + | otherwise = l : go False ls + runsOn = T.isSuffixOf "\\" . T.stripEnd + +-- | Blank out every branch the macros rule out, and the conditionals that +-- ask about them. +-- +-- This is for reading a module, not for printing one. What it takes out is +-- text the file contains and the output must keep, so nothing that builds +-- the output may be given the result. +withoutRuledOut :: Macros -> Text -> Text +withoutRuledOut macros source = case scanDirectives source of + Nothing -> source + Just ds -> + blanking + [ range + | group <- allGroups ds, + Just gs <- [groupSpec group], + Just taken <- [branchTaken macros gs], + range <- blankingFor gs taken + ] + source + +-- | Which branch of a conditional the macros settle on, where they settle +-- one. +-- +-- A branch is taken when its own condition holds and every condition before +-- it failed, so one unanswered condition leaves every branch after it +-- unanswered too. Where they all fail the answer is the last branch, which +-- is the @#else@ where there is one and nothing at all where there is not: +-- the same numbering 'blankingFor' uses. +branchTaken :: Macros -> GroupSpec -> Maybe Int +branchTaken macros = go 0 . gsGuards + where + go i = \case + [] -> Just i + g : rest -> case answerTo macros (guardText g) of + Just True -> Just i + Just False -> go (i + 1) rest + Nothing -> Nothing + +-- | Why a module using the preprocessor could not be formatted. +data CppError + = -- | A directive we do not handle, and its keyword. + UnhandledDirective Text + | -- | Conditionals that do not nest, or an @#else@ out of place. + UnsplittableConditional + | -- | More configurations than 'configurationBudget' allows. + TooManyConfigurations + | -- | A configuration the parser rejected, and which one it was. + ConfigurationNotParsed [([Guard], Int)] ParseError + | -- | A directive whose place in the document could not be found. + DirectiveUnplaceable [([Guard], Int)] Text + | -- | A directive written inside a quasiquote or other verbatim text. + DirectiveInQuotedText [([Guard], Int)] Text + +-- | Say what went wrong, in one line. The edge of the system. +describeCppError :: CppError -> Text +describeCppError = \case + UnhandledDirective k -> "a #" <> k <> " directive, which we do not handle" + UnsplittableConditional -> "conditionals that do not nest, or an #else out of place" + TooManyConfigurations -> "too many configurations to format" + ConfigurationNotParsed c e -> describeParseError e <> inConfiguration c + DirectiveUnplaceable c k -> "nowhere to put the #" <> k <> inConfiguration c + DirectiveInQuotedText c k -> + "a #" <> k <> " inside something quoted verbatim" <> inConfiguration c + +-- | Which configuration, in words. Empty where there is only one. +inConfiguration :: [([Guard], Int)] -> Text +inConfiguration [] = "" +inConfiguration answers = + ", in the configuration taking " <> T.intercalate ", then " (map said answers) + where + said (guards, i) = case (drop i guards, guards) of + (g : _, _) -> "#" <> guardText g + ([], g : _) -> "no branch of #" <> guardText g + ([], []) -> "no branch" + +-- | The keyword of the first directive here that we do not handle. +unhandledIn :: Text -> Text +unhandledIn source = + case [keywordOf l | l <- T.lines source, isDirective l] of + k : _ -> k + [] -> "" + where + keywordOf = T.takeWhile isAsciiLower . T.stripStart . T.drop 1 . T.stripStart + +---------------------------------------------------------------------------- +-- Splitting + +-- | One conditional directive, as written after its hash. +newtype Guard = Guard {guardText :: Text} + deriving (Eq, Ord, Show) + +-- | What one conditional splits a module into. +data Configurations = Configurations + { -- | The directives: the @#if@ of the group, and then one per @#elif@. + cfgGuards :: [Guard], + -- | One module text per branch, in the same order as the directives, and + -- then one more for the @#else@. + cfgTexts :: [Text], + -- | What each of those branches leaves out, in the same order. + cfgDropped :: [[(Int, Int)]], + -- | From each tied group's @#if@ to its @#endif@, inclusive. + -- + -- Everything a branch of this conditional can be responsible for lies + -- between one of these pairs, because that is what a group /is/. What + -- reads them is 'Varied', and what it does with them is skip the rest of + -- the module. + cfgWholes :: Varied + } + deriving (Eq, Show) + +-- | Split a module on its first outermost conditional, and on every other one +-- written behind the same directives, wherever in the module it sits. +configurations :: Text -> Maybe Configurations +configurations source = do + ds <- scanDirectives source + gs <- groupSpec =<< listToMaybe (groupsAtLevel 0 ds) + let tied = sameGuard gs ds + pure + Configurations + { cfgGuards = gsGuards gs, + cfgTexts = + [ blanking (concatMap (`blankingFor` i) tied) source + | i <- [0 .. gsCount gs - 1] + ], + cfgDropped = + [concatMap (`droppedFor` i) tied | i <- [0 .. gsCount gs - 1]], + cfgWholes = Varied (map gsWhole tied) + } + +-- | One conditional group, read off the directives that make it up. +data GroupSpec = GroupSpec + { gsGuards :: [Guard], + gsHasElse :: Bool, + gsOwnLines :: [Int], + gsBranches :: [(Int, Int)], + gsWhole :: (Int, Int) + } + +-- | Read a group off its directives, refusing one that is malformed. +groupSpec :: [Directive] -> Maybe GroupSpec +groupSpec group = do + (separators, end) <- unsnoc group + opener <- listToMaybe separators + require (dKeyword opener `elem` opensGroup) + require (dKeyword end == "endif") + require (all ((`elem` continuesGroup) . dKeyword) (drop 1 separators)) + require (all ((/= "else") . dKeyword) (drop 1 (reverse separators))) + pure + GroupSpec + { gsGuards = [dGuard d | d <- separators, dKeyword d /= "else"], + gsHasElse = any ((== "else") . dKeyword) separators, + gsOwnLines = map dLine group, + gsBranches = [(dLine a + 1, dLine b - 1) | (a, b) <- zip group (drop 1 group)], + gsWhole = (dLine opener, dLine end) + } + where + require b = if b then Just () else Nothing + +-- | How many configurations a group has: one per condition, and one more +-- for when none of them holds. +gsCount :: GroupSpec -> Int +gsCount gs = length (gsGuards gs) + 1 + +-- | The lines to blank so that configuration @i@ of a group is what is left. +-- +-- The branches this configuration does not take, and the directives +-- themselves: a directive belongs to no configuration, which is the whole of +-- what separates this from 'droppedFor'. +blankingFor :: GroupSpec -> Int -> [(Int, Int)] +blankingFor gs i = droppedFor gs i <> [(n, n) | n <- gsOwnLines gs] + +-- | The lines a configuration of a group is not including. +droppedFor :: GroupSpec -> Int -> [(Int, Int)] +droppedFor gs i + | i < length (gsGuards gs) || gsHasElse gs = + [r | (k, r) <- zip [0 :: Int ..] (gsBranches gs), k /= i] + | otherwise = gsBranches gs + +-- | Every conditional in a module, at whatever depth it sits. +allGroups :: [Directive] -> [[Directive]] +allGroups ds = concat [groupsAtLevel l ds | l <- [0 .. deepest]] + where + deepest = maximum (0 : map dLevel ds) + +-- | Every group in a module written behind the same directives as this one. +sameGuard :: GroupSpec -> [Directive] -> [GroupSpec] +sameGuard gs ds = + [g | grp <- allGroups ds, Just g <- [groupSpec grp], gsGuards g == gsGuards gs] + +-- | The directives at one level of nesting, split into the groups they make +-- up. +groupsAtLevel :: Int -> [Directive] -> [[Directive]] +groupsAtLevel level = split . filter ((== level) . dLevel) + where + split ds = case break ((== "endif") . dKeyword) ds of + (_, []) -> [] + (before', end : rest) -> (before' <> [end]) : split rest + +-- | One preprocessor directive, and how deep in the conditionals it sits. +data Directive = Directive + { dLine :: !Int, + dKeyword :: !Text, + dGuard :: !Guard, + dLevel :: !Int + } + deriving (Eq, Show) + +-- | Every conditional directive in a module, or 'Nothing' if its +-- conditionals do not make sense. +scanDirectives :: Text -> Maybe [Directive] +scanDirectives source = go 0 (zip [1 ..] (T.lines source)) + where + go 0 [] = Just [] + go _ [] = Nothing -- the lines ran out inside a conditional + go level ((n, l) : ls) + | not (isDirective l) = go level ls + | keyword `elem` opensGroup = at level (level + 1) + | keyword `elem` continuesGroup, level > 0 = at (level - 1) level + | keyword == "endif", level > 0 = at (level - 1) (level - 1) + | keyword `notElem` conditionalKeywords = go level ls + | otherwise = Nothing + where + at here next = + (Directive {dLine = n, dKeyword = keyword, dGuard = Guard (T.stripEnd body), dLevel = here} :) + <$> go next ls + keyword = T.takeWhile isAsciiLower body + body = T.stripStart (T.drop 1 (T.stripStart l)) + +-- | Every directive the C preprocessor takes, whether or not this module +-- can do anything with the ones it names. +directiveKeywords :: [Text] +directiveKeywords = conditionalKeywords <> opaqueKeywords + +-- | The directives that ask a question, and so split a module in two. +conditionalKeywords :: [Text] +conditionalKeywords = opensGroup <> continuesGroup <> ["endif"] + +-- | The keywords that open a group, continue one, and close one. +opensGroup, continuesGroup :: [Text] +opensGroup = ["if", "ifdef", "ifndef"] +continuesGroup = ["elif", "elifdef", "elifndef", "else"] + +opaqueKeywords :: [Text] +opaqueKeywords = + ["define", "undef", "include", "line", "error", "warning", "pragma"] + +-- | Does this line begin with a preprocessor directive? +-- +-- A hash at the start of a line is not enough to say so, which is worth +-- being careful about: the closing @#-}@ of a pragma written across several +-- lines begins one too, and that is Haskell. What settles it is the word +-- after the hash. +isDirective :: Text -> Bool +isDirective l = case T.stripPrefix "#" (T.stripStart l) of + Just rest -> T.takeWhile isAsciiLower (T.stripStart rest) `elem` directiveKeywords + Nothing -> False + +-- | Directives that do not introduce configurations. +opaqueDirectives :: Text -> [Opaque] +opaqueDirectives source = + [ Opaque + { opLine = n, + opLastLine = end n, + opText = T.stripEnd (T.intercalate "\n" (body : map lineOf below)) + } + | (n, l) <- numbered, + isDirective l, + let body = T.stripStart (T.drop 1 (T.stripStart l)), + T.takeWhile isAsciiLower body `elem` opaqueKeywords, + let below = continuing n + ] + where + numbered = zip [1 ..] (T.lines source) + byLine = Map.fromList numbered + lineOf n = Map.findWithDefault "" n byLine + end n = last (n : continuing n) + continuing n + | maybe False runsOn (Map.lookup n byLine) = n + 1 : continuing (n + 1) + | otherwise = [] + runsOn = T.isSuffixOf "\\" . T.stripEnd + +-- | Did the author leave an empty line anywhere between these two lines? +gapWritten :: Lines -> Int -> Int -> Bool +gapWritten written from to = any (`blankAt` written) [from .. to] + +-- | One directive that asks nothing, and what is known about it. +data Opaque = Opaque + { -- | The line it was written on. + opLine :: Int, + -- | The last line it takes up, which is 'opLine' unless it was written + -- across several with backslashes. + opLastLine :: Int, + -- | What follows its hash, kept whole and never read. + opText :: Text + } + deriving (Eq, Show) + +-- | The lines a directive was written on, as a span, which is what the +-- document carries so that two directives written the same can be told +-- apart. +opSpan :: Opaque -> Span +opSpan d = mkSpan (opLine d, 1) (opLastLine d, 1) + +-- | Did the author leave an empty line under this directive? +-- +-- Not one that stands at the end of a branch: see 'closesABranch'. +gapUnder :: Lines -> Opaque -> Bool +gapUnder written d = + (blankAt n written || blankBelow n written) && not (closesABranch n written) + where + n = opLastLine d + +-- | Replace the given line ranges with empty lines, keeping every other line +-- where it was. +blanking :: [(Int, Int)] -> Text -> Text +blanking ranges source = + T.unlines + [ if any (holds n) ranges then "" else l + | (n, l) <- zip [1 ..] (T.lines source) + ] + where + holds n (from, to) = from <= n && n <= to + +-- | One configuration for every branch of every conditional, and no more. +-- +-- 'leaves' takes every combination of answers, of which there are as many as +-- the branches multiplied together: a module of moderate size can have tens +-- of thousands, and a reader that has to look at all of them cannot look at +-- it at all. These are the sum instead of the product—one configuration per +-- branch, with every other conditional taking its first—which is few enough +-- to read even for the worst of them. +-- +-- What that buys is coverage rather than completeness: every line of the +-- module appears in at least one of these, so nothing written under a +-- directive goes unseen. What it does not buy is every /combination/ of +-- lines, so this answers questions asked of the parts and not of the whole. +-- Conditionals asking the same question are answered the same way +-- throughout, as they are everywhere else here, so no configuration +-- contradicts itself. +branchLeaves :: Text -> Either CppError [Text] +branchLeaves source = case scanDirectives source of + Nothing -> Left (UnhandledDirective (unhandledIn source)) + Just ds -> case nesting 0 ds of + Nothing -> Left UnsplittableConditional + Just forest -> traverse resolved (distinct (map configuration (assignments forest))) + where + reachable = go Map.empty + where + go asked ns = + concat + [ (asked, gs) + : concat + [ go (Map.insert (gsGuards gs) i asked) nested + | (i, nested) <- zip [0 ..] branches + ] + | Nest gs branches <- ns + ] + assignments forest = + Map.empty + : [ Map.insert (gsGuards gs) i asked + | (asked, gs) <- reachable forest, + i <- [0 .. gsCount gs - 1] + ] + configuration answers = + blanking + [ r + | grp <- allGroups (concat (maybeToList (scanDirectives source))), + Just gs <- [groupSpec grp], + r <- blankingFor gs (Map.findWithDefault 0 (gsGuards gs) answers) + ] + source + + distinct = Map.elems . Map.fromList . map (\t -> (t, t)) + +-- | Every configuration of a module, with every conditional resolved. +-- +-- What 'formatWithCpp' formats, without the formatting. This is what the +-- @forall cfg@ quantifies over, and keeping it apart from the building is +-- what lets a test ask whether the building agreed with it. +leaves :: Text -> Either CppError [Text] +leaves = fmap (map snd) . answeredLeaves + +-- | The configurations reached by varying one conditional at a time. +linearLeaves :: Text -> Either CppError [Text] +linearLeaves = fmap (map snd) . answeredLinearLeaves + +-- | How many configurations a module has, without building any of them. +countLeaves :: Text -> Either CppError Integer +countLeaves source = case scanDirectives source of + Nothing -> Left (UnhandledDirective (unhandledIn source)) + Just ds -> case nesting 0 ds of + Nothing -> Left UnsplittableConditional + Just forest -> + Right (sum [across answers forest | answers <- combinations (afforded forest)]) + where + across answers = product . map (one answers) + one answers (Nest gs nested) = case lookup (gsGuards gs) answers of + Just i -> across answers (branch nested i) + Nothing -> sum [across answers (branch nested i) | i <- [0 .. gsCount gs - 1]] + branch nested i = concat (take 1 (drop i nested)) + combinations = traverse (\(g, k) -> [(g, i) | i <- [0 .. k - 1]]) + afforded forest = go 1 (repeated forest) + where + go _ [] = [] + go n ((g, k) : rest) + | n * toInteger k <= guardsToTie = (g, k) : go (n * toInteger k) rest + | otherwise = [] + +-- | A module's conditionals as a forest: each group, with the groups nested +-- inside each of its branches. +data Nest = Nest GroupSpec [[Nest]] + +-- | Read the forest off the directives, refusing a group 'groupSpec' refuses. +nesting :: Int -> [Directive] -> Maybe [Nest] +nesting level ds = traverse one (groupsAtLevel level ds) + where + one group = do + gs <- groupSpec group + Nest gs <$> traverse (\r -> nesting (level + 1) (inside r ds)) (gsBranches gs) + inside (from, to) = filter (\d -> from <= dLine d && dLine d <= to) + +-- | The guards a module asks more than once, and how many answers each has. +-- +-- In the order they were written, and each named once however often it +-- appears. +repeated :: [Nest] -> [([Guard], Int)] +repeated forest = distinct Map.empty [q | q@(g, _) <- asked forest, twice g] + where + asked ns = concat [(gsGuards gs, gsCount gs) : asked (concat nested) | Nest gs nested <- ns] + times = Map.fromListWith (+) [(g, 1 :: Int) | (g, _) <- asked forest] + twice g = Map.findWithDefault 0 g times >= 2 + + distinct _ [] = [] + distinct seen (q@(g, _) : rest) + | Map.member g seen = distinct seen rest + | otherwise = q : distinct (Map.insert g () seen) rest + +-- | How many combinations of answers 'countLeaves' will enumerate. +guardsToTie :: Integer +guardsToTie = 4096 + +-- | Which branch every question was answered with to reach a configuration. +type Answers = Map [Guard] Int + +-- | Every configuration, and the answers that reach it. +answeredLeaves :: Text -> Either CppError [(Answers, Text)] +answeredLeaves = go Map.empty + where + go answers source = case configurations source of + Nothing -> (\t -> [(answers, t)]) <$> resolved source + Just c -> + concat + <$> traverse + (\(i, t) -> go (Map.insert (cfgGuards c) i answers) t) + (zip [0 ..] (cfgTexts c)) + +-- | The same, labelled by the answers that reach each one, and for the same +-- reason as 'answeredLeaves'. +answeredLinearLeaves :: Text -> Either CppError [(Answers, Text)] +answeredLinearLeaves = go Map.empty + where + go answers source = case configurations source of + Nothing -> (\t -> [(answers, t)]) <$> resolved source + Just c -> case zip [0 ..] (cfgTexts c) of + [] -> Right [] + (i, first) : rest -> + (<>) + <$> go (Map.insert (cfgGuards c) i answers) first + <*> traverse (held answers (cfgGuards c)) rest + where + held before gs (i, t) = answeredBaseline (Map.insert gs i before) t + +-- | The configuration in which every question still to be asked takes its +-- first branch, and the answers that gives. +answeredBaseline :: Answers -> Text -> Either CppError (Answers, Text) +answeredBaseline answers source = case configurations source of + Nothing -> (answers,) <$> resolved source + Just c -> case cfgTexts c of + [] -> Right (answers, source) + t : _ -> answeredBaseline (Map.insert (cfgGuards c) 0 answers) t + +-- | A module with no conditionals left in it, or the reason it is not one. +resolved :: Text -> Either CppError Text +resolved source + | any isDirective (T.lines left) = + Left (UnhandledDirective (unhandledIn left)) + | otherwise = Right left + where + left = withoutOpaque source + +---------------------------------------------------------------------------- +-- Diagnostics + +-- | Every region a document records provenance for, with what was printed +-- there. +-- +-- The outermost wins where a span appears twice, which is the one 'walk' +-- would have given a comment to. +regions :: Doc -> Map Span Doc +regions = Map.fromListWith (\_ outer -> outer) . go + where + go = \case + DLocated s d -> (s, d) : go d + DFence _ d -> go d + DCat a b -> go a <> go b + DNest _ d -> go d + DAlign d -> go d + DGroup _ d -> go d + DVariant a _ -> go a + DCppChoice bs e -> foldMap (go . snd) bs <> go e + _ -> [] diff --git a/src/Tilia/Cpp/Macros.hs b/src/Tilia/Cpp/Macros.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Cpp/Macros.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | The questions a module's conditionals ask that the build plan has +-- already answered. +module Tilia.Cpp.Macros + ( Macros (..), + answerTo, + ) +where + +import Data.Char (isAsciiLower, isAsciiUpper, isDigit) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Text (Text) +import Data.Text qualified as T + +-- | What the preprocessor would have been told. +data Macros = Macros + { -- | The macros that take a version apart and compare it: + -- @MIN_VERSION_containers@ and its like, each under the version the + -- plan resolved that package to. @MIN_VERSION_GLASGOW_HASKELL@ is one + -- of these, under the compiler's four-part version. + macroVersions :: Map Text [Integer], + -- | The macros that stand for a number, which is @__GLASGOW_HASKELL__@ + -- and its patch levels. + macroNumbers :: Map Text Integer + } + deriving (Eq, Show) + +-- | What a conditional's guard comes to, where what is known settles it. +-- +-- The text is the whole directive as it was written after its hash, keyword +-- and all, because @#if@ and @#ifdef@ ask about their rest in different +-- ways. +answerTo :: Macros -> Text -> Maybe Bool +answerTo macros written = case T.span isNameChar (T.stripStart written) of + (keyword, rest) -> case keyword of + "if" -> (/= 0) <$> evaluate macros rest + "elif" -> (/= 0) <$> evaluate macros rest + "ifdef" -> nameIsKnown rest + "elifdef" -> nameIsKnown rest + "ifndef" -> not <$> nameIsKnown rest + "elifndef" -> not <$> nameIsKnown rest + _ -> Nothing + where + nameIsKnown rest = case tokensOf rest of + Just [Name n] | known macros n -> Just True + _ -> Nothing + +-- | Is this a macro whose value we know? +known :: Macros -> Text -> Bool +known macros n = + Map.member n (macroVersions macros) || Map.member n (macroNumbers macros) + +---------------------------------------------------------------------------- +-- The expression + +-- | What an expression came to, where it came to anything. +evaluate :: Macros -> Text -> Maybe Integer +evaluate macros written = case tokensOf written of + Nothing -> Nothing + Just ts -> case orExpr macros ts of + Just (value, []) -> value + _ -> Nothing + +-- | An expression, and what is left of the tokens after it. +-- +-- The outer 'Maybe' is whether it could be read at all; the inner one is +-- whether what it means is known. +type Reading = Maybe (Maybe Integer, [Token]) + +orExpr :: Macros -> [Token] -> Reading +orExpr macros ts = do + (left, rest) <- andExpr macros ts + more left rest + where + more left = \case + Punct "||" : rest -> do + (right, rest') <- andExpr macros rest + more (either' left right) rest' + rest -> Just (left, rest) + either' a b + | any true [a, b] = Just 1 + | all false [a, b] = Just 0 + | otherwise = Nothing + +andExpr :: Macros -> [Token] -> Reading +andExpr macros ts = do + (left, rest) <- compared macros ts + more left rest + where + more left = \case + Punct "&&" : rest -> do + (right, rest') <- compared macros rest + more (both left right) rest' + rest -> Just (left, rest) + both a b + | any false [a, b] = Just 0 + | all true [a, b] = Just 1 + | otherwise = Nothing + +true, false :: Maybe Integer -> Bool +true = maybe False (/= 0) +false = maybe False (== 0) + +compared :: Macros -> [Token] -> Reading +compared macros ts = do + (left, rest) <- unary macros ts + case rest of + Punct op : rest' | Just test <- comparison op -> do + (right, rest'') <- unary macros rest' + pure (fromBool . uncurry test <$> pair left right, rest'') + _ -> Just (left, rest) + where + pair a b = (,) <$> a <*> b + fromBool b = if b then 1 else 0 + comparison = \case + "==" -> Just (==) + "!=" -> Just (/=) + "<" -> Just (<) + ">" -> Just (>) + "<=" -> Just (<=) + ">=" -> Just (>=) + _ -> Nothing + +unary :: Macros -> [Token] -> Reading +unary macros = \case + Punct "!" : rest -> do + (value, rest') <- unary macros rest + pure (negated <$> value, rest') + Punct "(" : rest -> do + (value, rest') <- orExpr macros rest + case rest' of + Punct ")" : rest'' -> Just (value, rest'') + _ -> Nothing + Name "defined" : rest -> case rest of + Name n : rest' -> Just (asKnown n, rest') + Punct "(" : Name n : Punct ")" : rest' -> Just (asKnown n, rest') + _ -> Nothing + Name n : Punct "(" : rest -> do + (arguments, rest') <- argumentList rest + pure (atLeast <$> Map.lookup n (macroVersions macros) <*> arguments, rest') + Name n : rest -> Just (Map.lookup n (macroNumbers macros), rest) + Number n : rest -> Just (Just n, rest) + _ -> Nothing + where + negated n = if n == 0 then 1 else 0 + asKnown n = if known macros n then Just 1 else Nothing + atLeast held wanted = if pad held >= pad wanted then 1 else 0 + where + width = max (length held) (length wanted) + pad v = take width (v <> repeat 0) + +-- | What an application was given, and what follows its closing bracket. +-- +-- Every argument has to be a plain number. One written as an expression is +-- not something to work out—a module that writes one is not asking the +-- question this can answer—but its brackets are still counted through, so +-- that the rest of the guard can be read and go on deciding what it can. +argumentList :: [Token] -> Maybe (Maybe [Integer], [Token]) +argumentList ts = do + (inside, rest) <- upToClose (0 :: Int) [] ts + pure (numbersOf inside, rest) + where + upToClose depth acc = \case + Punct ")" : rest + | depth == 0 -> Just (reverse acc, rest) + | otherwise -> upToClose (depth - 1) (Punct ")" : acc) rest + Punct "(" : rest -> upToClose (depth + 1) (Punct "(" : acc) rest + t : rest -> upToClose depth (t : acc) rest + [] -> Nothing + numbersOf = \case + [Number n] -> Just [n] + Number n : Punct "," : rest -> (n :) <$> numbersOf rest + _ -> Nothing + +---------------------------------------------------------------------------- +-- The tokens + +-- | One piece of a guard. +data Token + = Name Text + | Number Integer + | Punct Text + deriving (Eq, Show) + +-- | Take a guard apart, or refuse it whole. +-- +-- Refusing is not a failure. A guard with arithmetic in it, or a character +-- literal, or a hexadecimal constant, is one this does not read, and a +-- guard it does not read is a question left open. +tokensOf :: Text -> Maybe [Token] +tokensOf = go . T.stripStart + where + go t + | T.null t = Just [] + | Just (c, _) <- T.uncons t, + isNameStart c = + let (n, rest) = T.span isNameChar t in (Name n :) <$> next rest + | Just (c, _) <- T.uncons t, + isDigit c = + let (digits, rest) = T.span isDigit t + rest' = T.dropWhile (`T.elem` "uUlL") rest + in case T.uncons rest' of + Just (c', _) | isNameChar c' || c' == '.' -> Nothing + _ -> (Number (readDigits digits) :) <$> next rest' + | Just punct <- firstThat (`T.stripPrefix` t) punctuation = + (Punct (T.take (T.length t - T.length punct) t) :) <$> next punct + | otherwise = Nothing + next = go . T.stripStart + firstThat f = foldr (\x acc -> maybe acc Just (f x)) Nothing + readDigits = T.foldl' (\n c -> n * 10 + toInteger (fromEnum c - fromEnum '0')) 0 + +-- | The punctuation of the expressions we read, longest first so that @<=@ +-- is never taken for @<@. +punctuation :: [Text] +punctuation = ["&&", "||", "==", "!=", "<=", ">=", "(", ")", ",", "!", "<", ">"] + +isNameStart :: Char -> Bool +isNameStart c = isAsciiLower c || isAsciiUpper c || c == '_' + +isNameChar :: Char -> Bool +isNameChar c = isNameStart c || isDigit c diff --git a/src/Tilia/Diff.hs b/src/Tilia/Diff.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Diff.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Showing what changed. +module Tilia.Diff + ( diff, + diffInFull, + ) +where + +import Data.Algorithm.Diff qualified as D +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Text qualified as T +import Tilia.Palette (Color (..), Palette, paint) + +-- | One line of the comparison, with the number it has on each side. +data Line = Line !Mark !Int !Int !Text + +-- | The type of mark. +data Mark = Context | Removed | Added + deriving (Eq) + +-- | A unified diff of two texts, cut short once it has said enough. +diff :: + Palette -> + -- | What to call the two sides + (Text, Text) -> + -- | Before + Text -> + -- | After + Text -> + Text +diff palette = unified palette (Just roomFor) [] + +-- | The whole of a unified diff of one file against its formatted self, +-- headed the way @git diff@ heads one. +diffInFull :: + Palette -> + -- | The file, named as it was given on the command line + FilePath -> + -- | What is in it + Text -> + -- | What would be + Text -> + Text +diffInFull palette path = + unified + palette + Nothing + [paint palette Place ("diff --git " <> before <> " " <> after)] + (before, after) + where + before = "a/" <> T.pack path + after = "b/" <> T.pack path + +unified :: + Palette -> + -- | How many lines are worth printing, where there is a limit at all + Maybe Int -> + -- | Whatever goes above the two file names + [Text] -> + -- | What to call the two sides + (Text, Text) -> + -- | Before + Text -> + -- | After + Text -> + Text +unified palette limit above (beforeName, afterName) before after + | null hunks, + before /= after = + "(the two differ only in how they end their lines)" + | null hunks = + "(the two are identical as text, so the difference is in something\ + \ the text does not show)" + | otherwise = T.intercalate "\n" (above <> heading <> shown) + where + heading = + [ paint palette (Header Gone) ("--- " <> beforeName), + paint palette (Header New) ("+++ " <> afterName) + ] + + shown = case limit of + Just room | length body > room -> take room body <> [omitted room] + _ -> body + where + omitted room = + paint palette Meta $ + "… and " <> T.pack (show (length body - room)) <> " more lines" + + body = concatMap render hunks + + render range = hunkHeading range : map line (slice range) + + hunkHeading range = + paint palette Meta $ + "@@ -" + <> span' beforeOf (countingBefore (slice range)) + <> " +" + <> span' afterOf (countingAfter (slice range)) + <> " @@" + where + span' which n = case slice range of + (l : _) -> T.pack (show (which l)) <> "," <> T.pack (show n) + [] -> "0,0" + + line (Line mark _ _ text) = case mark of + Context -> paint palette Unchanged (" " <> text) + Removed -> paint palette Gone ("-" <> text) + Added -> paint palette New ("+" <> text) + + slice (from, to) = take (to - from + 1) (drop from lines') + + countingBefore = length . filter (\(Line m _ _ _) -> m /= Added) + countingAfter = length . filter (\(Line m _ _ _) -> m /= Removed) + beforeOf (Line _ b _ _) = b + afterOf (Line _ _ a _) = a + + hunks = merge [(max 0 (i - margin), min (total - 1) (i + margin)) | i <- changed] + changed = [i | (i, Line m _ _ _) <- zip [0 ..] lines', m /= Context] + total = length lines' + lines' = tag (D.getGroupedDiff (split before) (split after)) + split = map withoutReturn . T.splitOn "\n" + withoutReturn l = fromMaybe l (T.stripSuffix "\r" l) + +-- | How many unchanged lines to show either side of a change. +margin :: Int +margin = 3 + +-- | How many lines of diff are worth printing before it stops being read. +roomFor :: Int +roomFor = 60 + +-- | Join hunks that have grown into one another. +merge :: [(Int, Int)] -> [(Int, Int)] +merge = \case + ((a, b) : (c, d) : rest) + | c <= b + 1 -> merge ((a, max b d) : rest) + | otherwise -> (a, b) : merge ((c, d) : rest) + xs -> xs + +-- | Number the lines of a grouped diff on both sides at once. +tag :: [D.Diff [Text]] -> [Line] +tag = go 1 1 + where + go _ _ [] = [] + go !b !a (d : ds) = case d of + D.Both xs _ -> + [Line Context (b + i) (a + i) x | (i, x) <- zip [0 ..] xs] + <> go (b + length xs) (a + length xs) ds + D.First xs -> + [Line Removed (b + i) a x | (i, x) <- zip [0 ..] xs] + <> go (b + length xs) a ds + D.Second xs -> + [Line Added b (a + i) x | (i, x) <- zip [0 ..] xs] + <> go b (a + length xs) ds diff --git a/src/Tilia/Doc.hs b/src/Tilia/Doc.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Doc.hs @@ -0,0 +1,23 @@ +-- | Turning a printed document into source text. +module Tilia.Doc + ( -- * Documents + Doc, + + -- * Rendering + RenderOptions (..), + defaultRenderOptions, + printDoc, + ) +where + +import Data.Text (Text) +import Tilia.Doc.Internal + ( Doc, + RenderOptions (..), + defaultRenderOptions, + render, + ) + +-- | Render a document to source text. +printDoc :: RenderOptions -> Doc -> Text +printDoc = render diff --git a/src/Tilia/Doc/Body.hs b/src/Tilia/Doc/Body.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Doc/Body.hs @@ -0,0 +1,24 @@ +-- | Constructs that can stand as the body of an enclosing one. +module Tilia.Doc.Body + ( Body (..), + attachBody, + ) +where + +import Tilia.Doc.Combinators + +-- | Something that can appear as the body of an enclosing construct. +class Body a where + -- | Print it. + printBody :: a -> Doc + + -- | Whether it absorbs its own line break. + bodyPlacement :: a -> Placement + +-- | Print a body and join it to whatever precedes it. +-- +-- This is the whole of what an enclosing construct needs, which is why it +-- is worth having: a caller that reaches for 'printBody' and +-- 'bodyPlacement' separately is about to reimplement it. +attachBody :: (Body a) => a -> Doc +attachBody x = attach (bodyPlacement x) (printBody x) diff --git a/src/Tilia/Doc/Combinators.hs b/src/Tilia/Doc/Combinators.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Doc/Combinators.hs @@ -0,0 +1,447 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | The vocabulary for writing printing code. +module Tilia.Doc.Combinators + ( -- * Documents + Doc, + + -- * Atoms + txt, + space, + breakOrSpace, + breakOrNothing, + hardBreak, + blankLine, + Resume (..), + verbatimBreak, + verbatim, + emptyAnchor, + + -- * Layout + Layout (..), + group, + flat, + broken, + variant, + located, + fence, + cppChoice, + + -- * Attachment + Placement (..), + attach, + hangingIfSingleLine, + + -- * Indentation + nest, + indent, + align, + + -- * Combining + hsep, + vsep, + sepBy, + joinedBy, + punctuate, + + -- * Wrapping + ClosingIndent (..), + bracket, + parens, + parensWith, + brackets, + bracketsWith, + braces, + bananaWith, + unboxed, + unboxedWith, + backticks, + + -- * Punctuation + comma, + commaSep, + semi, + + -- * Conditionals + includeWhen, + includeUnless, + ) +where + +import Data.List (intersperse) +import Data.Text (Text) +import Data.Text qualified as T +import Tilia.Doc.Internal + ( Doc (..), + Layout (..), + Resume (..), + groupLayout, + ) +import Tilia.Span (Span, isSingleLine) + +---------------------------------------------------------------------------- +-- Atoms + +-- | A literal fragment of output. +-- +-- The argument must not contain a line break; use 'hardBreak'. This is for +-- keywords, punctuation and names—anything whose spelling is fixed. +txt :: Text -> Doc +txt = DText + +-- | A space. Repeated spaces collapse and a space before a line break is +-- dropped. +space :: Doc +space = DSpace + +-- | A place the line may break. It becomes a line break if the enclosing +-- 'group' is broken, and a space if it is flat. This is the workhorse: it +-- is what lets one printer serve both layouts. +breakOrSpace :: Doc +breakOrSpace = DBreak + +-- | A place the line may break, leaving nothing behind if it does not. For +-- the positions where the two layouts differ by a break rather than by a +-- space, such as immediately inside a bracket. +breakOrNothing :: Doc +breakOrNothing = DSoftBreak + +-- | A line break, whatever the enclosing group decided. +hardBreak :: Doc +hardBreak = DHardBreak + +-- | An empty line. +blankLine :: Doc +blankLine = hardBreak <> hardBreak + +-- | A line break between two lines of text that is being reproduced. +-- +-- Only for text that is being reproduced rather than laid out: the lines of +-- a block comment, of a multi-line string literal, of a quasi-quotation. +-- Unlike every other break this one collapses nothing, because an empty line +-- among those is the author's and not spacing. +verbatimBreak :: Resume -> Doc +verbatimBreak = DVerbatimBreak + +-- | Text reproduced exactly, line breaks and all. +verbatim :: Text -> Doc +verbatim = sepBy (verbatimBreak AtMargin) . map txt . T.splitOn "\n" + +-- | An anchor for a construct that contains nothing. +emptyAnchor :: Span -> Doc +emptyAnchor s = located s mempty + +---------------------------------------------------------------------------- +-- Layout + +-- | Lay the document out as the input had it: flat if the construct was +-- written on one line, broken if it was spread across several. +group :: Span -> Doc -> Doc +group s = DGroup (groupLayout (Just s)) + +-- | Force flat layout. +flat :: Doc -> Doc +flat = DGroup Flat + +-- | Force broken layout. +broken :: Doc -> Doc +broken = DGroup Broken + +-- | Choose according to the layout the enclosing 'group' settled on. +-- +-- Reach for this only when the two layouts differ by more than where the +-- breaks fall; when they differ only in that, 'breakOrSpace' and +-- 'breakOrNothing' already say so and read better. +variant :: + -- | When flat + Doc -> + -- | When broken + Doc -> + Doc +variant = DVariant + +-- | Record where the output is coming from in the input. +-- +-- This has no effect on layout. It is provenance, kept so that later +-- passes—comment attachment above all—can ask which region of the input a +-- piece of the document corresponds to. +located :: Span -> Doc -> Doc +located = DLocated + +-- | Fence prevents comments inside from floating out and attaching to +-- elements they are not supposed to attach to. +fence :: Span -> Doc -> Doc +fence = DFence + +-- | Alternatives the preprocessor chooses between. +cppChoice :: + -- | One alternative per directive, each directive as written after its + -- hash + [(Text, Doc)] -> + -- | What holds when none of them applies + Doc -> + Doc +cppChoice branches fallback + | all (silent . snd) branches && silent fallback = DEmpty + | otherwise = DCppChoice branches (if silent fallback then DEmpty else fallback) + +-- | Does this document put nothing at all on the page? +silent :: Doc -> Bool +silent = \case + DEmpty -> True + DCat a b -> silent a && silent b + DNest _ d -> silent d + DAlign d -> silent d + DGroup _ d -> silent d + DLocated _ d -> silent d + DFence _ d -> silent d + DVariant flatD brokenD -> silent flatD && silent brokenD + _ -> False + +---------------------------------------------------------------------------- +-- Attachment + +-- | Whether a construct absorbs its own line break. +data Placement + = -- | The preceding construct breaks and indents. + Normal + | -- | The construct is handed the rest of the line and breaks itself. + Hanging + deriving (Eq, Show) + +-- | Join a body to whatever precedes it, according to its 'Placement'. +attach :: Placement -> Doc -> Doc +attach Hanging body = space <> body +attach Normal body = breakOrSpace <> indent body + +-- | 'Hanging' if the span was a single line in the input, 'Normal' +-- otherwise. +-- +-- A handful of constructs hang only when what comes before their own break +-- was written on one line—a lambda whose parameters ran on, for instance, +-- would leave the body indented under nothing legible. Those constructs +-- consult the input, exactly as 'group' does, and this is the shared +-- spelling of that question so that it reads as policy rather than as a +-- special case repeated in each classifier. +hangingIfSingleLine :: Span -> Placement +hangingIfSingleLine s = if isSingleLine s then Hanging else Normal + +---------------------------------------------------------------------------- +-- Indentation + +-- | Indent by the given number of steps, relative to the current level. +nest :: Int -> Doc -> Doc +nest = DNest + +-- | Indent by one step. +indent :: Doc -> Doc +indent = DNest 1 + +-- | Indent to the column the line has already reached, so that a broken +-- construct lines up under its own beginning rather than under the start of +-- the line. +align :: Doc -> Doc +align = DAlign + +---------------------------------------------------------------------------- +-- Combining + +-- | Concatenate, separated by 'space'. +hsep :: [Doc] -> Doc +hsep = sepBy space + +-- | Concatenate, separated by 'hardBreak'. +vsep :: [Doc] -> Doc +vsep = sepBy hardBreak + +-- | Concatenate, separated by the given document. +sepBy :: Doc -> [Doc] -> Doc +sepBy s = mconcat . intersperse s + +-- | The token that joins two parts of a construct: a space, the token, and +-- then the place the line may break. +joinedBy :: Text -> Doc +joinedBy t = space <> txt t <> breakOrSpace + +-- | Append the separator to every element but the last. +-- +-- For the cases where the separator has to travel with the element rather +-- than sit between elements, such as a trailing comma that must stay on the +-- line above a break. +punctuate :: Doc -> [Doc] -> [Doc] +punctuate _ [] = [] +punctuate _ [x] = [x] +punctuate s (x : xs) = (x <> s) : punctuate s xs + +---------------------------------------------------------------------------- +-- Wrapping + +-- | Surround with the given opening and closing documents, adding nothing +-- of its own. +enclose :: + -- | Opening bracket + Doc -> + -- | Closing bracket + Doc -> + -- | Body + Doc -> + Doc +enclose open close body = open <> body <> close + +-- | Where the closing bracket of a broken bracket pair goes. +data ClosingIndent + = -- | Back out to the level the opening bracket is on. + Outdented + | -- | Kept one step in. + Indented + deriving (Eq, Show) + +-- | Surround with a bracket pair that opens up when broken. +-- +-- Flat, this is @open body close@ with nothing added. Broken, the opening +-- bracket keeps the first line of the body company and the rest of the body +-- lines up under it, with the closing bracket alone on the last line: +-- +-- > ( first, +-- > second +-- > ) +bracket :: + -- | Opening bracket + Text -> + -- | Closing bracket + Text -> + -- | Body + Doc -> + Doc +bracket = bracketWith Outdented + +-- | 'bracket', with a say in where the closing bracket goes. +bracketWith :: + -- | Where the closing bracket goes + ClosingIndent -> + -- | Opening bracket + Text -> + -- | Closing bracket + Text -> + -- | Body + Doc -> + Doc +bracketWith closing open close body = + -- The pair is aligned as a whole so that the closing bracket comes back + -- out to the column the opening one is on, wherever on its line that was. + align $ + txt open + <> variant body (space <> align body <> hardBreak) + <> nest (closingSteps closing) (txt close) + +-- | Surround with a bracket pair whose brackets are held off the body. +-- +-- For the brackets that are more than one character wide—@(#@, @(|@—where +-- running the body up against them makes both harder to pick out, and where +-- an operator beginning with @#@ would lex as part of the bracket. Broken, +-- the body goes on its own indented lines. +spacedBracket :: + -- | Where the closing bracket goes + ClosingIndent -> + -- | Opening bracket + Text -> + -- | Closing bracket + Text -> + -- | Body + Doc -> + Doc +spacedBracket closing open close body = + align $ + txt open + <> variant (space <> body <> space) (hardBreak <> indent body <> hardBreak) + <> nest (closingSteps closing) (txt close) + +closingSteps :: ClosingIndent -> Int +closingSteps = \case + Outdented -> 0 + Indented -> 1 + +-- | @(@ and @)@. +parens :: Doc -> Doc +parens = bracket "(" ")" + +-- | @(@ and @)@, with a say in where the closing bracket goes. +parensWith :: + -- | Where the closing parenthesis goes + ClosingIndent -> + -- | Body + Doc -> + Doc +parensWith closing = bracketWith closing "(" ")" + +-- | @[@ and @]@. +brackets :: Doc -> Doc +brackets = bracket "[" "]" + +-- | @[@ and @]@, with a say in where the closing bracket goes. +bracketsWith :: + -- | Where the closing bracket goes + ClosingIndent -> + -- | Body + Doc -> + Doc +bracketsWith closing = bracketWith closing "[" "]" + +-- | @{@ and @}@. +braces :: Doc -> Doc +braces = bracket "{" "}" + +-- | @(|@ and @|)@, from arrow notation, with a say in where the closing +-- bracket goes. +bananaWith :: + -- | Where the closing banana goes + ClosingIndent -> + -- | Body + Doc -> + Doc +bananaWith closing = spacedBracket closing "(|" "|)" + +-- | @(#@ and @#)@, for unboxed tuples and sums. +unboxed :: Doc -> Doc +unboxed = unboxedWith Outdented + +-- | @(#@ and @#)@, with a say in where the closing bracket goes. +unboxedWith :: + -- | Where the closing bracket goes + ClosingIndent -> + -- | Body + Doc -> + Doc +unboxedWith closing = spacedBracket closing "(#" "#)" + +-- | Surround with backticks. +backticks :: Doc -> Doc +backticks = enclose (txt "`") (txt "`") + +---------------------------------------------------------------------------- +-- Punctuation + +-- | @,@. +comma :: Doc +comma = txt "," + +-- | @;@. +semi :: Doc +semi = txt ";" + +-- | Separate by a comma and a 'breakOrSpace', so that a broken list puts each +-- element on its own line with the comma left behind on the one above. +commaSep :: [Doc] -> Doc +commaSep = sepBy (comma <> breakOrSpace) + +---------------------------------------------------------------------------- +-- Conditionals + +-- | The document if the condition holds, nothing otherwise. +includeWhen :: Bool -> Doc -> Doc +includeWhen b d = if b then d else mempty + +-- | The document unless the condition holds. +includeUnless :: Bool -> Doc -> Doc +includeUnless b = includeWhen (not b) diff --git a/src/Tilia/Doc/Internal.hs b/src/Tilia/Doc/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Doc/Internal.hs @@ -0,0 +1,478 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | The document representation and the engine that turns it into text. +-- +-- Printing code should not import this module; import +-- "Tilia.Doc.Combinators" instead, which exposes 'Doc' abstractly along +-- with the vocabulary for building one. What needs the constructors is the +-- engine below, the passes that walk a finished document rather than build +-- one — comment attachment in "Tilia.Comments.Attach", and the merge in +-- "Tilia.Cpp", which takes the documents of several configurations apart and +-- puts one back together — and tests that look inside a document. +-- Those three take a document apart rather than build one, which is the +-- thing the vocabulary cannot express. +-- +-- The printer is split in two halves that meet at 'Doc'. Code that walks +-- the syntax tree builds a 'Doc', which is an ordinary immutable value with +-- no notion of columns, indentation or what has already been written. The +-- engine in this module is the only thing that knows about those, and it +-- learns them by walking the finished document. Nothing in the first half +-- can observe the second, which is what keeps printing code from having to +-- reason about emission order. +module Tilia.Doc.Internal + ( -- * Documents + Doc (..), + Layout (..), + Resume (..), + groupLayout, + + -- * Rendering + RenderOptions (..), + defaultRenderOptions, + render, + ) +where + +import Data.Maybe (listToMaybe) +import Data.Text (Text) +import Data.Text qualified as T +import Tilia.Span (Span, isSingleLine) + +---------------------------------------------------------------------------- +-- Documents + +-- | A description of what to print. +data Doc + = -- | Print nothing. + DEmpty + | -- | A literal fragment. Must not contain a line break: the engine + -- tracks columns by counting characters, and an embedded newline would + -- make that count wrong. Use 'DHardBreak'. + DText !Text + | -- | A space. Repeats collapse, and one at the end of a line is dropped, + -- so printing code may emit them freely rather than working out whether + -- one is already there. + DSpace + | -- | A space when the enclosing group is flat, a line break when it is + -- broken. + DBreak + | -- | Nothing when the enclosing group is flat, a line break when it is + -- broken. + DSoftBreak + | -- | A line break regardless of the enclosing group. + -- + -- Two in a row leave one empty line between what surrounds them, which + -- is all a blank line is; there is deliberately no separate constructor + -- for one. Further breaks add nothing. + DHardBreak + | -- | Text to be put at the end of the line this position falls on, + -- however much of the line is still to be written. + -- + -- For a comment the author wrote at the end of a line. Where it belongs + -- is not a position in the document but a position in the /output/: it + -- has to come after everything else on its line, including punctuation + -- the printer has not emitted yet. Putting it in the document where the + -- node it trails happens to sit would push a comma, an arrow or a + -- closing bracket onto the next line. + -- + -- One line holds one of these at its end. A second means two comments + -- trailing what turned out to be a single line of output, and it goes on + -- a line of its own underneath rather than being run together with the + -- first into a comment neither author wrote. + DHoldBack !Text + | -- | Close the line, and let a break that immediately follows know that + -- it has nothing left to do. + -- + -- A comment owns the rest of its line, so something has to end that + -- line; but whatever the comment was attached to very often ends it + -- too, and two breaks in a row are a blank line. This is the break that + -- says \"the line is finished\" rather than \"break here\", so the two + -- do not add up to an empty line nobody asked for. + DCloseLine + | -- | A line break between two lines of text that is being reproduced + -- rather than laid out. + -- + -- Collapsing nothing and skipping nothing, unlike every other break + -- here: the lines either side are the author's, so an empty one among + -- them is content and not spacing. Where the next line begins is the + -- only thing left to decide, and 'Resume' decides it. + DVerbatimBreak !Resume + | -- | Concatenation. See the 'Semigroup' instance. + DCat !Doc !Doc + | -- | Indent the enclosed document by the given number of steps, relative + -- to the current indentation. + DNest !Int !Doc + | -- | Indent the enclosed document to whatever column the line has + -- reached, so that it lines up under itself when broken. + DAlign !Doc + | -- | Lay the enclosed document out flat or broken. + -- + -- The decision is already made by the time it reaches the engine. + -- 'groupLayout' is what makes it, from the span the construct occupied + -- in the input, and it lives in the combinator layer's vocabulary + -- rather than here so that the engine has no policy in it at all. + DGroup !Layout !Doc + | -- | Choose between two documents according to the enclosing group: the + -- first when it is flat, the second when it is broken. For the + -- constructs whose two layouts differ by more than where the breaks + -- fall. + -- + -- Both fields are lazy, and that is not an oversight. The engine walks + -- one of them and never looks at the other, so the branch not taken + -- should cost nothing. Were they strict, building a variant would build + -- both layouts of everything inside it; a construct nested @n@ deep + -- would be built @2^n@ times. + DVariant Doc Doc + | -- | Record that the enclosed document was produced from the given + -- region of the input. + -- + -- This carries no layout meaning at all and the engine ignores it. + -- Keeping provenance separate from grouping is deliberate: the two + -- coincide often, but a construct can need one without the other, and + -- fusing them is what forces a printer to grow an escape hatch for each + -- case where they come apart. + DLocated !Span !Doc + | -- | Fence prevents comments inside from floating out and attaching to + -- elements they are not supposed to attach to. + DFence !Span !Doc + | -- | Alternatives the preprocessor chooses between, and the condition it + -- chooses on. + DCppChoice ![(Text, Doc)] !Doc + | -- | A preprocessor line that is not a conditional, reproduced, and the + -- region of the input it was written in. + -- + -- The span is included so that two directives can be told apart. + DCppDirective !Span !Text + deriving (Eq, Show) + +-- | Documents concatenate. @'DEmpty'@ is the unit, so a document is a +-- monoid and printing code can use @'mconcat'@, @'foldMap'@ and the rest of +-- the ordinary vocabulary instead of a bespoke sequencing operator. +instance Semigroup Doc where + DEmpty <> b = b + a <> DEmpty = a + a <> b = DCat a b + +instance Monoid Doc where + mempty = DEmpty + +-- | Whether a group is laid out on one line or across several. +data Layout + = Flat + | Broken + deriving (Eq, Show) + +-- | Where the line after a 'DVerbatimBreak' begins. +data Resume + = -- | At the indentation in force, as any other break would. + AtIndent + | -- | At column zero, whatever the indentation. + AtMargin + deriving (Eq, Show) + +-- | Decide how to lay a group out. +-- +-- This is the whole of the policy, in one place on purpose. Layout follows +-- the input: a construct written on one line stays on one line, and one +-- that was spread out stays spread out. A group with no span is one the +-- printer synthesised rather than read, and has nothing to follow, so it +-- goes flat. +-- +-- Notably absent is any notion of a maximum line width. Nothing in the +-- engine measures the result against a limit, so a long line that was +-- written as one line is reproduced as one line. +groupLayout :: Maybe Span -> Layout +groupLayout = \case + Nothing -> Flat + Just s + | isSingleLine s -> Flat + | otherwise -> Broken + +---------------------------------------------------------------------------- +-- Rendering + +-- | Knobs for 'render'. +newtype RenderOptions = RenderOptions + { -- | Columns per indentation step. + roIndentStep :: Int + } + deriving (Eq, Show) + +-- | Two columns per step. +defaultRenderOptions :: RenderOptions +defaultRenderOptions = RenderOptions {roIndentStep = 2} + +-- | What the engine carries while walking a document. +-- +-- Indentation and layout flow downwards and are restored on the way out, so +-- they are passed as arguments. Everything else is output being +-- accumulated. +data Env = Env + { envIndent :: !Int, + envLayout :: !Layout, + envIndentStep :: !Int + } + +-- | Output built so far. +-- +-- Lines are finished one at a time and never revisited, so the current line +-- is kept as a reversed list of fragments and completed lines as a reversed +-- list of lines. +data Out = Out + { -- | Completed lines, most recent first. + outLines :: [Text], + -- | Fragments of the line being built, most recent first. + outCurrent :: [Text], + -- | Column the current line has reached. + outColumn :: !Int, + -- | Whether anything has been written to the current line. Indentation + -- is emitted lazily, when the first fragment arrives, so that a line + -- with nothing on it stays genuinely empty. + outStarted :: !Bool, + -- | Fragments held back until the line ends, in the order they were + -- given. The first goes at the end of the line; any after it get lines + -- of their own under it, since two comments run together would be one + -- comment neither author wrote. + outHeldBack :: ![Text], + -- | Whether the line was closed by something that already knew it was + -- ending it, so that a break arriving now would add an empty line rather + -- than end anything. + outClosed :: !Bool + } + +emptyOut :: Out +emptyOut = + Out + { outLines = [], + outCurrent = [], + outColumn = 0, + outStarted = False, + outHeldBack = [], + outClosed = False + } + +-- | Turn a document into text. +render :: RenderOptions -> Doc -> Text +render opts doc = finish (go env doc emptyOut) + where + env = + Env + { envIndent = 0, + envLayout = Broken, + envIndentStep = roIndentStep opts + } + +-- | Walk a document, accumulating output. +go :: Env -> Doc -> Out -> Out +go env = \case + DEmpty -> id + DText t -> putText (envIndent env) t + DSpace -> putSpace + DBreak -> case envLayout env of + Flat -> putSpace + Broken -> breakLine (envIndent env) + DSoftBreak -> case envLayout env of + Flat -> id + Broken -> breakLine (envIndent env) + DHoldBack t -> putHeldBack (envIndent env) t + DCloseLine -> closeLine (envIndent env) + DHardBreak -> breakLine (envIndent env) + DVerbatimBreak resume -> verbatimBreakLine resume + DCat a b -> go env b . go env a + DNest n d -> go env {envIndent = envIndent env + n * envIndentStep env} d + DAlign d -> \out -> + go env {envIndent = max (envIndent env) (outColumn out)} d out + DGroup l d -> go env {envLayout = l} d + DVariant flatD brokenD -> case envLayout env of + Flat -> go env flatD + Broken -> go env brokenD + DLocated _ d -> go env d + DFence _ d -> go env d + DCppChoice branches fallback -> + foldr (flip (.)) id . concat $ + [ [atMargin ("#" <> guard'), go env taken] + | (guard', taken) <- branches + ] + <> [[atMargin "#else", go env fallback] | fallback /= DEmpty] + <> [[atMargin "#endif"]] + DCppDirective _ t -> atMargin ("#" <> t) + +-- | Put a line of text at the margin, on a line of its own. +-- +-- A preprocessor directive is not part of the program's layout and does not +-- take its indentation: it begins where the line begins, whatever is in +-- force around it. The line before it is closed only if anything was +-- written to it, so a directive following something that already ended its +-- line does not leave an empty one behind. +atMargin :: Text -> Out -> Out +atMargin t = closeLine 0 . putText 0 t . closeLine 0 + +-- | Append a fragment, emitting the line's indentation first if this is the +-- first thing on it. +putText :: Int -> Text -> Out -> Out +putText indent t out0 + | T.null t = out0 + | outStarted out = + out + { outCurrent = t : outCurrent out, + outColumn = outColumn out + T.length t + } + | otherwise = + out + { outCurrent = [t, T.replicate indent " "], + outColumn = indent + T.length t, + outStarted = True + } + where + out = out0 {outClosed = False} + +-- | Hold a fragment back until the line ends. +putHeldBack :: Int -> Text -> Out -> Out +putHeldBack indent t out + | outStarted out || not (null (outHeldBack out)) = + out {outHeldBack = outHeldBack out <> [t], outClosed = False} + | otherwise = closeLine indent (putText indent t out) + +-- | Append a space, unless the line has not started or already ends in one. +putSpace :: Out -> Out +putSpace out + | not (outStarted out) = out + | endsWithSpace out = out + | otherwise = + out + { outCurrent = " " : outCurrent out, + outColumn = outColumn out + 1 + } + +endsWithSpace :: Out -> Bool +endsWithSpace out = case outCurrent out of + (t : _) -> maybe False ((== ' ') . snd) (T.unsnoc t) + [] -> False + +-- | Close the current line, if there is anything on it. +-- +-- Unlike 'breakLine' this leaves a mark: the next break sees that the line +-- was already ended on purpose and does nothing, so a comment that ends its +-- own line and a construct that would have ended it anyway do not between +-- them leave an empty one. +closeLine :: + -- | Where the line after this one begins + Int -> + Out -> + Out +closeLine indent out + | hasContent out = (breakLine indent out) {outClosed = True} + | otherwise = out + +-- | Finish the current line. +-- +-- Two breaks in a row leave one empty line between the text either side of +-- them, which is a blank line the author asked for. Further breaks add +-- nothing: the output never carries two blank lines in a row, however many +-- times printing code breaks. Breaking before anything has been written is +-- dropped for the same reason, since 'finish' strips empty lines only from +-- the end. Nor is an empty line written at the top of a block, where there +-- is nothing above it to be held off. +-- +-- Between them these rules mean printing code may break wherever a break +-- might be wanted without first working out what it already emitted. +breakLine :: + -- | Where the line after this one begins + Int -> + Out -> + Out +breakLine indent out + | outClosed out = out {outClosed = False} + | atStart out = out + | not (hasContent out), repeatsBlank out || opensABlock indent out = discarded + | otherwise = discarded {outLines = overflow indent out <> outLines out} + where + discarded = + out {outCurrent = [], outColumn = 0, outStarted = False, outHeldBack = []} + +-- | Every line the break that has just happened produces. +-- +-- Usually one: the line that was being built. There are more when several +-- fragments were held back for it, because only the first of them can go at +-- its end and the rest need lines of their own. Held-back fragments are +-- always comments, so several mean several comments that trailed different +-- things in the input which have turned out to share a line of output; run +-- together they would read as one comment nobody wrote, so each of the +-- others gets a line below. +-- +-- Held back until here rather than written when it arrived, because the +-- line was not finished then. A comma or a closing bracket still to come +-- would have been pushed underneath the comment. +-- +-- Ordered as 'outLines' is, most recent first, ready to be put in front +-- of it. +overflow :: + -- | Where the line after these would begin, used only if there is no line + -- to take the indentation from + Int -> + Out -> + [Text] +overflow indent out = reverse (finished : map below spilled) + where + finished = currentLine out + spilled = drop 1 (outHeldBack out) + + -- Indented to match the line they spilled from rather than to the + -- indentation in force, so that they stay under the thing they were + -- written against instead of under whatever encloses it. + below t = T.replicate column " " <> T.stripEnd t + column + | T.null finished = indent + | otherwise = T.length (T.takeWhile (== ' ') finished) + +-- | Would an empty line here be the first thing inside a block? +opensABlock :: Int -> Out -> Bool +opensABlock indent out = case outLines out of + (l : _) -> T.length l <= indent + [] -> False + +-- | Finish the current line between two lines of reproduced text. +verbatimBreakLine :: Resume -> Out -> Out +verbatimBreakLine resume out = + out + { outLines = overflow 0 out <> outLines out, + outCurrent = [], + outColumn = 0, + outStarted = resume == AtMargin, + outHeldBack = [], + outClosed = False + } + +-- | Would this empty line be a second one in a row? +repeatsBlank :: Out -> Bool +repeatsBlank out = case outLines out of + ("" : _) -> True + _ -> False + +-- | Is the output still empty? +atStart :: Out -> Bool +atStart out = null (outLines out) && not (hasContent out) + +-- | Is there anything on the current line, written or held back? +hasContent :: Out -> Bool +hasContent out = outStarted out || not (null (outHeldBack out)) + +-- | The current line: what was written to it, then whatever was held back +-- for its end, with one space between them and no trailing whitespace. +currentLine :: Out -> Text +currentLine out + | T.null written = heldBack + | T.null heldBack = written + | otherwise = written <> " " <> heldBack + where + written = T.stripEnd (T.concat (reverse (outCurrent out))) + heldBack = maybe "" T.stripEnd (listToMaybe (outHeldBack out)) + +-- | Assemble the final text: one trailing newline, no blank lines at the +-- end, no trailing whitespace anywhere. +finish :: Out -> Text +finish out = + case dropWhile T.null (outLines (breakLine 0 out)) of + [] -> "" + ls -> T.unlines (reverse ls) diff --git a/src/Tilia/Equivalence.hs b/src/Tilia/Equivalence.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Equivalence.hs @@ -0,0 +1,675 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- | Whether formatting changed what a module says. +module Tilia.Equivalence + ( syntaxDifference, + commentDifference, + ) +where + +import Control.Applicative ((<|>)) +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.Choice (pattern Is) +import Data.Data +import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) +import Data.List (sortOn) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NE +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Maybe (catMaybes, isNothing, listToMaybe, mapMaybe) +import Data.Set (Set) +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Data.FastString (FastString) +import GHC.Hs (HsModule (..), XModulePs (..)) +import GHC.Hs.Decls (DerivClauseTys (..), DocDecl (..), HsDecl (..), LHsDecl) +import GHC.Hs.Doc (LHsDoc, WithHsDocIdentifiers (..)) +import GHC.Hs.DocString + ( HsDocString (..), + HsDocStringChunk (..), + HsDocStringDecorator (..), + ) +import GHC.Hs.Expr (HsExpr (..), LHsExpr) +import GHC.Hs.Extension (GhcPs) +import GHC.Hs.ImpExp + ( IE (..), + ImportDeclQualifiedStyle, + LIE, + LImportDecl, + isImportDeclQualified, + ) +import GHC.Hs.Type (HsType (..), LHsContext, LHsSigType) +import GHC.Types.Name (Name) +import GHC.Types.Name.Occurrence (OccName) +import GHC.Types.SrcLoc (unLoc) +import GHC.Unit.Types (Unit) +import Language.Haskell.Syntax.Extension (XRec) +import Language.Haskell.Syntax.Module.Name (ModuleName) +import System.IO.Unsafe (unsafePerformIO) +import Tilia.Comments + ( Comment (..), + CommentStyle (..), + Pragma (..), + commentPragma, + commentTrailing, + escapeTrigger, + triggerEscaped, + ) +import Tilia.Imports (normalizeImports) +import Tilia.Span (Span (..)) +import Tilia.Span.Ghc (spanOf, spansOf) + +---------------------------------------------------------------------------- +-- Syntax + +-- | Where two fragments of syntax stop saying the same thing. +-- +-- Everything is compared but the annotations, which is what makes this a +-- question about the program rather than about its layout: a span, a +-- token's position and the comments hung off a node all change when the +-- module is reformatted, and are supposed to. +-- +-- 'Nothing' when they agree. Otherwise the constructors on the way down to +-- the first disagreement, ending in what the two sides had there. A bare +-- \"these differ\" is no use against ten thousand files: what makes a +-- corpus worth running is being able to see that six hundred failures are +-- four causes. +syntaxDifference :: (Data a) => a -> a -> Maybe Text +syntaxDifference = differ [] + +-- | The constructors on the way down to where the walk has got to, +-- innermost first. +-- +-- Innermost first because it is built by consing. The walk visits some +-- millions of nodes for every one it reports on, and appending to the end of +-- a list that grows with the depth — at every node, packing a constructor's +-- name into 'Text' to do it — was a large part of what a comparison cost. +-- 'describe' puts it back in reading order, and only for a difference that +-- is really being reported. +type Path = [Constr] + +differ :: forall a. (Data a) => Path -> a -> a -> Maybe Text +differ path x y = case classify (typeOf x) of + Incidental -> Nothing + Special + | Just outcome <- asStandaloneDoc path x y -> outcome + | Just outcome <- asExportItems path x y -> outcome + | Just outcome <- asDeclarations path x y -> outcome + | Just outcome <- asDerivingClause path x y -> outcome + | Just outcome <- asQualifiedStyle path x y -> outcome + | Just outcome <- asDocString path x y -> outcome + | Just outcome <- asContext path x y -> outcome + | Just outcome <- asImports path x y -> outcome + | otherwise -> structurally + Ordinary -> structurally + where + structurally = case dataTypeRep (dataTypeOf x) of + AlgRep _ + | toConstr x /= toConstr y -> Just disagreement + | settledByConstructor (toConstr x) -> Nothing + | otherwise -> + firstOf + ( zipWith + (cellDiffer (toConstr x : path)) + (gmapQ Cell x) + (gmapQ Cell y) + ) + NoRep + | opaque x y -> Nothing + | otherwise -> + Just (describe path (T.pack (typeNameOf x) <> " changed")) + _ + | toConstr x == toConstr y -> Nothing + | otherwise -> Just disagreement + + disagreement = + describe path (named (toConstr x) <> " became " <> named (toConstr y)) + +-- | What is known about a type before either value of it is looked at. +data Verdict + = -- | Records only how or where something was written. See 'incidental'. + Incidental + | -- | One of the types the @as…@ functions below compare by hand. + Special + | -- | Compared by its constructor and then field by field. + Ordinary + +-- | Which of the three a type is, worked out once. +-- +-- Worth memoising rather than recomputing: 'incidental' is string +-- manipulation over a type's module and name, and the question is asked at +-- every node of every configuration of every module. There are a few +-- hundred types in a parse tree and tens of millions of nodes. +-- +-- The cache races harmlessly. A reader that misses an entry another thread +-- has just written recomputes a pure function of the key and writes the +-- same answer. +classify :: TypeRep -> Verdict +classify rep = unsafePerformIO $ do + known <- readIORef classified + case Map.lookup rep known of + Just verdict -> pure verdict + Nothing -> do + let verdict = worked + atomicModifyIORef' classified (\m -> (Map.insert rep verdict m, ())) + pure verdict + where + worked + | incidental rep = Incidental + | rep `Set.member` spokenFor = Special + | otherwise = Ordinary + +classified :: IORef (Map TypeRep Verdict) +classified = unsafePerformIO (newIORef Map.empty) +{-# NOINLINE classified #-} + +-- | The types compared by hand, which is to say the ones the @as…@ chain in +-- 'differ' can match. +-- +-- Kept beside that chain and in the same order. A type here with nothing to +-- match it costs one failed run down the chain; a type in the chain and not +-- here is never reached at all, which is why the corpora are what says this +-- list is right. +spokenFor :: Set TypeRep +spokenFor = + Set.fromList + [ typeRep (Proxy @(Maybe (LHsDoc GhcPs))), + typeRep (Proxy @[LIE GhcPs]), + typeRep (Proxy @[LHsDecl GhcPs]), + typeRep (Proxy @(DerivClauseTys GhcPs)), + typeRep (Proxy @ImportDeclQualifiedStyle), + typeRep (Proxy @HsDocString), + typeRep (Proxy @(Maybe (LHsContext GhcPs))), + typeRep (Proxy @(LHsContext GhcPs)), + typeRep (Proxy @(XRec GhcPs [LHsExpr GhcPs])), + typeRep (Proxy @[LImportDecl GhcPs]) + ] + +-- | Constructors whose fields say only how they were written. +-- +-- @HsStarTy@ carries a flag for whether the @*@ was typed as @★@. Both are +-- the same kind; which one the author reached for is spelling. +settledByConstructor :: Constr -> Bool +settledByConstructor c = showConstr c == "HsStarTy" + +named :: Constr -> Text +named = T.pack . showConstr + +-- | The tail of the path, and what was found at the end of it. +describe :: Path -> Text -> Text +describe path leaf = + T.intercalate " > " (map named (reverse (take 5 path)) <> [leaf]) + +firstOf :: [Maybe a] -> Maybe a +firstOf = listToMaybe . catMaybes + +-- | One field of a value, with its type hidden. +data Cell = forall d. (Data d) => Cell d + +cellDiffer :: Path -> Cell -> Cell -> Maybe Text +cellDiffer path (Cell a) (Cell b) = case cast b of + Just b' -> differ path a b' + Nothing -> Just (describe path "fields of different types") + +-- | Two lists compared one element at a time. +-- +-- Handed back to 'differ' whole they would arrive at the same @as…@ function +-- again and never stop, which is why the lengths are settled here and only +-- the elements go back round. +elementwise :: (Data b) => Path -> Text -> [b] -> [b] -> Maybe Text +elementwise path what before after + | length before /= length after = Just (describe path what) + | otherwise = firstOf (zipWith (differ path) before after) + +-- | Does this documentation comment say anything? +saysNothing :: HsDocString -> Bool +saysNothing = null . docWords + +-- | A documentation comment with no words in it is no comment at all. +-- +-- @-- |@ on a line of its own attaches an empty doc string to whatever +-- follows, and the formatter drops it, which is not a change to what the +-- module says. +-- +-- This and the two below were a pass over both trees with @everywhere@ +-- before the comparison started. That rebuilt two whole parse trees per +-- configuration in order to remove a handful of nodes from each; done here, +-- the same normalisation costs nothing until the walk arrives at one. +asStandaloneDoc :: (Data a) => Path -> a -> a -> Maybe (Maybe Text) +asStandaloneDoc path x y = case (cast x, cast y) of + (Just before, Just after) -> Just (compared (kept before) (kept after)) + _ -> Nothing + where + kept :: Maybe (LHsDoc GhcPs) -> Maybe (LHsDoc GhcPs) + kept d = if any (saysNothing . hsDocString . unLoc) d then Nothing else d + + compared before after = case (before, after) of + (Nothing, Nothing) -> Nothing + (Just b, Just a) -> differ (toConstr before : path) b a + _ -> + Just + ( describe + path + (named (toConstr before) <> " became " <> named (toConstr after)) + ) + +-- | An export list, minus the documentation that says nothing. +asExportItems :: (Data a) => Path -> a -> a -> Maybe (Maybe Text) +asExportItems path x y = case (cast x, cast y) of + (Just before, Just after) -> + Just (elementwise path "the module exports a different list" (kept before) (kept after)) + _ -> Nothing + where + kept :: [LIE GhcPs] -> [LIE GhcPs] + kept = filter (not . emptyExport . unLoc) + emptyExport = \case + IEDoc _ doc -> saysNothing (hsDocString (unLoc doc)) + _ -> False + +-- | A block of declarations, minus the documentation that says nothing. +asDeclarations :: (Data a) => Path -> a -> a -> Maybe (Maybe Text) +asDeclarations path x y = case (cast x, cast y) of + (Just before, Just after) -> + Just (elementwise path "a different number of declarations" (kept before) (kept after)) + _ -> Nothing + where + kept :: [LHsDecl GhcPs] -> [LHsDecl GhcPs] + kept = filter (not . emptyDecl . unLoc) + emptyDecl = \case + DocD _ d -> case d of + DocCommentNext doc -> saysNothing (hsDocString (unLoc doc)) + DocCommentPrev doc -> saysNothing (hsDocString (unLoc doc)) + _ -> False + _ -> False + +-- | Does this type record only how or where something was written? +incidental :: TypeRep -> Bool +incidental rep = case splitTyConApp rep of + (con, args) + | qualified con == "GHC.Types.SrcLoc.GenLocated" -> False + | notation con -> True + | structural con -> not (null args) && all incidental args + | otherwise -> False + where + qualified con = tyConModule con <> "." <> tyConName con + +-- | Types that exist to record punctuation, position or spelling. +notation :: TyCon -> Bool +notation con = + tyConModule con == "GHC.Parser.Annotation" + || tyConModule con == "GHC.Types.SrcLoc" + || ("GHC.Hs." `isPrefix` tyConModule con && "Ann" `isPrefix` tyConName con) + || qualified `Set.member` alsoNotation + where + qualified = tyConModule con <> "." <> tyConName con + isPrefix p t = take (length p) t == p + +-- | The stragglers, named in full. +alsoNotation :: Set String +alsoNotation = + Set.fromList + [ -- Where a layout block's column was, which is the whole of what + -- reformatting changes. + "GHC.Hs.Extension.EpLayout", + "Language.Haskell.Syntax.Extension.EpLayout", + -- The text GHC keeps beside a literal or a pragma so that it can + -- reproduce what was typed: the spaces inside @{-# INLINE f #-}@, + -- whether an integer was written in hex, how a multi-line string was + -- indented. The value itself is in the next field along. + "GHC.Types.SourceText.SourceText", + -- Whether a linear arrow was written @%1 ->@ or @⊸@. The multiplicity + -- it stands for is a different field, and is compared. + "GHC.Hs.Type.EpLinear" + ] + +-- | Containers that are transparent to the question. +structural :: TyCon -> Bool +structural con = + tyConName con + `elem` ["Maybe", "List", "NonEmpty", "Tuple2", "Tuple3", "Tuple4", "Tuple5"] + +-- | Which side of the module name @qualified@ was written on. +-- +-- @import qualified M@ and @import M qualified@ are the same import. Which +-- spelling is allowed is settled by @ImportQualifiedPost@ and the formatter +-- writes whichever the extension calls for, so the two are not expected to +-- survive as they were. Whether the import is qualified at all is another +-- matter, and that is what is compared. +asQualifiedStyle :: (Data a) => Path -> a -> a -> Maybe (Maybe Text) +asQualifiedStyle path x y = case (cast x, cast y) of + (Just before, Just after) -> Just (compared before after) + _ -> Nothing + where + compared :: ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Maybe Text + compared before after + | isImportDeclQualified before == isImportDeclQualified after = Nothing + | otherwise = Just (describe path "the import stopped being qualified") + +-- | A @deriving@ clause, however it was punctuated. +-- +-- @deriving Eq@ and @deriving (Eq)@ are one clause written two ways, and +-- they are held in two different constructors with two different shapes, so +-- the generic comparison cannot see past the brackets. The formatter always +-- writes the brackets, so what is compared is the list of types being +-- derived. +asDerivingClause :: (Data a) => Path -> a -> a -> Maybe (Maybe Text) +asDerivingClause path x y = case (cast x, cast y) of + (Just before, Just after) -> + Just (differ path (derived before) (derived after)) + _ -> Nothing + where + derived :: DerivClauseTys GhcPs -> [LHsSigType GhcPs] + derived = \case + DctSingle _ t -> [t] + DctMulti _ ts -> ts + +-- | A module's imports, compared as the set they are. +-- +-- The formatter sorts them and folds together the ones that say the same +-- thing, because the compiler reads imports as a set and the order they were +-- written in is the order somebody happened to add them. Comparing them in +-- sequence would report every module whose imports +-- were not already sorted. +-- +-- Both sides are put through the same normalisation rather than being +-- compared loosely, so an import that was genuinely lost or whose list lost +-- an entry still shows up. +asImports :: (Data a) => Path -> a -> a -> Maybe (Maybe Text) +asImports path x y = case (cast x, cast y) of + (Just before, Just after) -> Just (alongside (normalised before) (normalised after)) + _ -> Nothing + where + -- No comments are offered, so both sides are always reordered. That is + -- what makes this comparison indifferent to the order: the formatter + -- may have declined to sort a particular module, and the question here + -- is whether it imports the same things either way. For the same reason + -- it does not matter what is said about the Prelude, only that the same + -- thing is said about both sides. + normalised :: [LImportDecl GhcPs] -> [LImportDecl GhcPs] + normalised = normalizeImports (Is #implicitPrelude) [] [] + + -- Compared one import at a time rather than as two lists, because a + -- list of imports is what this function is called on: handing it back + -- to `differ` whole would arrive here again and never stop. + alongside before after + | length before /= length after = + Just (describe path "the module imports a different set of modules") + | otherwise = firstOf (zipWith (differ path) before after) + +-- | A context, compared for the constraints it holds. +-- +-- Two things are levelled. @class () => Foo a@ and @class Foo a@ say the +-- same thing, and the formatter writes the second; the tree keeps them +-- apart because one has brackets in it. And a constraint may be written +-- bracketed or bare—@(Show a) =>@ against @Show a =>@—where the brackets +-- are the context's own punctuation rather than part of the constraint, so +-- the formatter writes them whether or not the author did. +-- +-- Only the brackets directly around a constraint are dropped. Brackets +-- inside one group a type and are compared like any others. +asContext :: (Data a) => Path -> a -> a -> Maybe (Maybe Text) +asContext path x y = compared optional <|> compared written <|> compared quoted + where + compared :: forall b c. (Typeable b, Data c) => (b -> c) -> Maybe (Maybe Text) + compared strip = case (cast x, cast y) of + (Just before, Just after) -> Just (differ path (strip before) (strip after)) + _ -> Nothing + + optional :: Maybe (LHsContext GhcPs) -> [HsType GhcPs] + optional = maybe [] written + + written :: LHsContext GhcPs -> [HsType GhcPs] + written = map (unbracket . unLoc) . unLoc + + -- With @RequiredTypeArguments@ a constraint may stand where a term + -- does, and until it is elaborated it is an expression. The brackets + -- there are the context's own just as much as anywhere else. + quoted :: XRec GhcPs [LHsExpr GhcPs] -> [HsExpr GhcPs] + quoted = map (unparenthesised . unLoc) . unLoc + + unbracket = \case + HsParTy _ t -> unbracket (unLoc t) + t -> t + + unparenthesised = \case + HsPar _ e -> unparenthesised (unLoc e) + e -> e + +-- | A Haddock, compared for what it documents. +-- +-- What must survive is the words, in order, and what kind of Haddock it is: +-- a @$section@ and a @* heading@ say more than which way a comment points, +-- so those stay distinct while @|@ and @^@ do not. +asDocString :: (Data a) => Path -> a -> a -> Maybe (Maybe Text) +asDocString path x y = case (cast x, cast y) of + (Just before, Just after) + | summarised before == summarised after -> Just Nothing + | otherwise -> + Just (Just (describe path "a documentation comment changed")) + _ -> Nothing + where + summarised :: HsDocString -> (Text, [ByteString]) + summarised d = (kindOf d, docWords d) + + kindOf = \case + MultiLineDocString dec _ -> decorator dec + NestedDocString dec _ -> decorator dec + GeneratedDocString _ -> "generated" + + decorator = \case + HsDocStringNext -> "pointer" + HsDocStringPrevious -> "pointer" + HsDocStringNamed n -> "named " <> T.pack n + HsDocStringGroup n -> "group " <> T.pack (show n) + +-- | What a doc string says, with the whitespace thrown away. +docWords :: HsDocString -> [ByteString] +docWords = + concatMap chunkWords . \case + MultiLineDocString _ cs -> map unLoc (NE.toList cs) + NestedDocString _ c -> [unLoc c] + GeneratedDocString c -> [c] + where + chunkWords (HsDocStringChunk bytes) = + filter (not . BS.null) (BS.splitWith isAsciiSpace bytes) + isAsciiSpace w = w == 32 || w == 9 || w == 10 || w == 13 + +-- | Compare two values of a type that will not be taken apart. +opaque :: forall a b. (Data a, Data b) => a -> b -> Bool +opaque x y = case dataTypeName (dataTypeOf x) of + -- How every name and every literal is spelled. + "FastString" -> by @FastString + "OccName" -> by @OccName + "ModuleName" -> by @ModuleName + "Name" -> by @Name + "Unit" -> by @Unit + "Data.ByteString.ByteString" -> by @ByteString + name -> + error $ + "Tilia.Equivalence: " + <> name + <> " does not expose its structure and is not one of the types this\ + \ knows how to compare. Decide whether it carries meaning and add\ + \ it to `opaque`, or to `alsoOnlyAboutPlacement` if it is a\ + \ position." + where + by :: forall t. (Typeable t, Eq t) => Bool + by = case (cast x, cast y) of + (Just p, Just q) -> p == (q :: t) + _ -> False + +typeNameOf :: (Data a) => a -> String +typeNameOf = dataTypeName . dataTypeOf + +---------------------------------------------------------------------------- +-- Comments + +-- | Did every comment survive, and if not, which one and how? +-- +-- Ordinary comments are compared as they will be printed, in order: the text +-- is normalised on the way in, so a comment that came out unchanged reads +-- back identically, and one that was mangled or moved past its neighbour +-- does not. +-- +-- Except in the header, where the order says nothing. The pragmas are +-- sorted and so are the imports, and a comment written against either +-- travels with it, so the two streams are put in a settled order there +-- before being compared. What is still asked of that stretch is that the +-- same comments come out of it. +-- +-- Documentation comments are counted rather than compared. The printer may +-- legitimately rewrite one—a @-- ^ x@ that moves in front of what it +-- documents has to become @-- | x@—so the text is not expected to survive, +-- but the comment is. +commentDifference :: + -- | The module each stream came from, which is asked only how far down its + -- header reaches + (HsModule GhcPs, HsModule GhcPs) -> + [Comment] -> + [Comment] -> + Maybe Text +commentDifference (moduleBefore, moduleAfter) before0 after0 + | not (Set.null lost) = Just ("lost the pragma " <> pragmaList lost) + | not (Set.null gained) = Just ("invented the pragma " <> pragmaList gained) + | docsBefore /= docsAfter = + Just $ + "the module's " + <> tshow docsBefore + <> " documentation comments became " + <> tshow docsAfter + | otherwise = + diverge (belowHeader moduleBefore before) (belowHeader moduleAfter after) + <|> diverge + (settled (withinHeader moduleBefore before)) + (settled (withinHeader moduleAfter after)) + where + before = escapedAndSplit before0 + after = escapedAndSplit after0 + + belowHeader m = filter (not . inHeader m) . ordinary + withinHeader m = filter (inHeader m) . ordinary + settled = sortOn bodyKey + + inHeader m c = case rearranged m of + Nothing -> False + Just lastLine -> spanStartLine (commentSpan c) <= lastLine + + escapedAndSplit = concatMap explode + + explode c = case commentStyle c of + DocComment + | "--" `T.isPrefixOf` NE.head (commentBody c) -> + [ c {commentBody = l :| [], commentCodeBeforeStopsAt = before'} + | (n, l) <- zip [0 :: Int ..] (NE.toList (body (escapeTrigger c))), + let before' = + if n == 0 then commentCodeBeforeStopsAt c else Nothing + ] + | otherwise -> [escapeTrigger c] + _ -> [c] + body = commentBody + + lost = pragmasOf before `Set.difference` pragmasOf after + gained = pragmasOf after `Set.difference` pragmasOf before + docsBefore = length (documentation before) + docsAfter = length (documentation after) + + documentation = filter isDocumentation + isDocumentation = triggerEscaped + + -- Pragmas are held apart from the comments they are written as, because + -- the formatter moves them on purpose: it hoists them to the top, sorts + -- them, drops duplicates and splits a @{-# LANGUAGE A, B #-}@ in two. So + -- what has to survive is the set of them, not the order, and comparing + -- them in sequence with everything else would report every module that + -- did not already have them in sorted order. + ordinary = + filter (\c -> not (isDocumentation c) && isNothing (commentPragma c)) + + diverge [] [] = Nothing + diverge (b : _) [] = Just ("lost " <> quoted b) + diverge [] (a : _) = Just ("gained " <> quoted a) + diverge (b : bs) (a : as) + | bodyKey b == bodyKey a = diverge bs as + | Just (bs', as') <- crossed (b : bs) (a : as) = diverge bs' as' + | otherwise = Just (quoted b <> " became " <> quoted a) + + -- A Haddock written after what it documents comes out before it, which + -- lifts its lines over a comment trailing the same construct: + -- + -- > _terSizeDepth :: Int -- lazy by intention! + -- > -- ^ How many @SIZELT@ relations are in the context + -- > -- (= clause telescope). + -- + -- The comments have not moved and neither has the documentation; they + -- have swapped, and the lines the Haddock runs on to are read here as + -- comments like any other. Only comments that trail code may be crossed, + -- only by comments that do not, and only where each block turns up whole + -- and in order on the other side—so this says \"these two swapped\" and + -- not \"these are the same comments in some order\". + crossed written printed = + listToMaybe + [ (drop (j + k) written, drop (j + k) printed) + | j <- [1 .. length (takeWhile commentTrailing written)], + let lifted = drop j written, + let shared = length (takeWhile id (zipWith alike printed lifted)), + k <- [shared, shared - 1 .. 1], + all (not . commentTrailing) (take k lifted), + map bodyKey (take j (drop k printed)) == map bodyKey (take j written) + ] + + alike x y = bodyKey x == bodyKey y + + quoted c = "`" <> T.intercalate "\\n" (NE.toList (commentBody c)) <> "`" + tshow = T.pack . show + pragmaList = + T.intercalate ", " + . map (\(n, b) -> "{-# " <> n <> " " <> b <> " #-}") + . Set.toList + +-- | A comment's lines, as they are compared. +bodyKey :: Comment -> NonEmpty Text +bodyKey c = case commentBody c of + (l :| []) -> T.stripStart l :| [] + ls -> ls + +-- | How far down the file the formatter rearranges things. +-- +-- Everything from the top down to the last import: the pragmas are sorted, +-- the imports are sorted and folded together, and the comments written +-- against them travel along. Below that nothing is reordered, and there the +-- order of the comment stream is exactly what has to be checked. +rearranged :: HsModule GhcPs -> Maybe Int +rearranged m = spanEndLine <$> (spansOf (hsmodImports m) <> header) + where + header = + foldMap spanOf (hsmodName m) + <> foldMap spanOf (hsmodDeprecMessage (hsmodExt m)) + <> foldMap spanOf (hsmodExports m) + +-- | The pragmas a module carries, however they were written. +-- +-- A @{-# LANGUAGE A, B #-}@ counts as two, because that is what the +-- formatter turns it into, and the name is upper-cased and the body trimmed +-- so that two spellings of the same pragma are the same pragma. +pragmasOf :: [Comment] -> Set (Text, Text) +pragmasOf = Set.fromList . concatMap entries . mapMaybe commentPragma + where + entries p + | pragmaName p == "LANGUAGE" = + [ ("LANGUAGE", extension) + | e <- T.splitOn "," (pragmaBody p), + let extension = T.strip e, + not (T.null extension) + ] + | otherwise = [(pragmaName p, pragmaBody p)] diff --git a/src/Tilia/Fixity.hs b/src/Tilia/Fixity.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Fixity.hs @@ -0,0 +1,964 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Working out the fixity of the operators a module uses. +module Tilia.Fixity + ( -- * Fixities + OpName (..), + Direction (..), + Fixity (..), + defaultFixity, + + -- * What a module declares + declaredFixities, + declaredNames, + moduleName, + + -- * What a module passes on + ExportItem (..), + moduleExports, + exportedOperators, + declaredChildren, + moduleChildren, + + -- * What a module can see + Import (..), + ImportItem (..), + moduleImports, + mightBring, + surelyNames, + Known (..), + nothingKnown, + Namespace (..), + Fixities, + inBothNamespaces, + Unread (..), + ModuleChain (..), + spellModuleChain, + Scope (..), + Reach (..), + reachIn, + resolveScope, + + -- * Answers + Provenance (..), + Resolution (..), + lookupFixity, + + -- * What could not be answered + Unknown (..), + operatorsUsed, + unknownOperators, + operatorSpelling, + spellUnreadIn, + + -- * What reading a module established + Established (..), + Exported (..), + exportedNames, + asExported, + ) +where + +import Data.Choice (Choice, isTrue) +import Data.Foldable (toList) +import Data.Generics.Schemes (listify) +import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Set (Set) +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Hs hiding (Fixity, OpName) +import GHC.Types.Fixity qualified as GHC +import GHC.Types.Name.Occurrence (occNameString) +import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc) +import GHC.Types.SrcLoc (GenLocated (..), unLoc) +import Tilia.Palette (Color (Place), Palette, paint) + +---------------------------------------------------------------------------- +-- Fixities + +-- | An operator, spelled as it appears in an @infix@ declaration: @<+>@, or +-- @div@ for a function used infix in backticks. +newtype OpName = OpName Text + deriving (Eq, Ord, Show) + +-- | Which way an operator associates. +data Direction = LeftAssoc | RightAssoc | NoAssoc + deriving (Eq, Show) + +-- | A fixity: how tightly an operator binds, and which way it associates. +data Fixity = Fixity + { fixityDirection :: Direction, + fixityPrecedence :: Int + } + deriving (Eq, Show) + +-- | What an operator with no declaration in scope means: @infixl 9@. +defaultFixity :: Fixity +defaultFixity = Fixity LeftAssoc 9 + +---------------------------------------------------------------------------- +-- What a module declares + +-- | Which of Haskell's two namespaces an operator is written in. +data Namespace = InTypes | InTerms + deriving (Eq, Ord, Show) + +-- | The fixities a module offers, by the namespace each is written in. +type Fixities = Map (Namespace, OpName) Fixity + +-- | Take fixities that say nothing about namespaces to govern both. +inBothNamespaces :: Map OpName Fixity -> Fixities +inBothNamespaces declared = + Map.fromList + [ ((namespace, op), fixity) + | (op, fixity) <- Map.toList declared, + namespace <- [InTypes, InTerms] + ] + +-- | The fixities in one namespace, by the operator alone. +fixitiesIn :: Namespace -> Fixities -> Map OpName Fixity +fixitiesIn namespace declared = + Map.fromList [(op, fixity) | ((n, op), fixity) <- Map.toList declared, n == namespace] + +-- | The fixities a module declares for its own operators. +declaredFixities :: HsModule GhcPs -> Fixities +declaredFixities hsModule = + Map.fromList + [ ((namespace, op), fixity) + | (specifier, op, fixity) <- concatMap (fromDecl . unLoc) (hsmodDecls hsModule), + namespace <- namespacesOf specifier op + ] + where + (types, terms) = declaredNamespaces hsModule + namespacesOf specifier op = case specifier of + TypeNamespaceSpecifier _ -> [InTypes] + DataNamespaceSpecifier _ -> [InTerms] + NoNamespaceSpecifier -> + case ([InTypes | Set.member op types] <> [InTerms | Set.member op terms]) of + [] -> [InTypes, InTerms] + found -> found + + fromDecl = \case + SigD _ sig -> fromSig sig + TyClD _ ClassDecl {tcdSigs} -> concatMap (fromSig . unLoc) tcdSigs + _ -> [] + fromSig = \case + FixSig _ (FixitySig specifier names fixity) -> + [(specifier, opName (unLoc n), fromGhcFixity fixity) | n <- names] + _ -> [] + +-- | The names a module declares among types, and those it declares among +-- terms. +declaredNamespaces :: HsModule GhcPs -> (Set OpName, Set OpName) +declaredNamespaces hsModule = + ( Set.fromList (concatMap (types . unLoc) decls), + Set.fromList (concatMap (terms . unLoc) decls) + ) + where + decls = hsmodDecls hsModule + types = \case + TyClD _ d -> case d of + FamDecl _ FamilyDecl {fdLName} -> [opName (unLoc fdLName)] + SynDecl {tcdLName} -> [opName (unLoc tcdLName)] + DataDecl {tcdLName} -> [opName (unLoc tcdLName)] + ClassDecl {tcdLName, tcdATs} -> + opName (unLoc tcdLName) + : [opName (unLoc (fdLName (unLoc f))) | f <- tcdATs] + _ -> [] + terms = \case + ValD _ b -> boundNames b + SigD _ sig -> signedNames sig + ForD _ f -> [opName (unLoc (fd_name f))] + TyClD _ d@DataDecl {} -> membersOf d + TyClD _ ClassDecl {tcdSigs} -> concatMap (classMethods . unLoc) tcdSigs + _ -> [] + +-- | Every name a module defines itself. +-- +-- Not the same question as 'declaredFixities', which is about @infix@ +-- declarations. This one is asked of an export list: a name a module +-- exports and also defines needs no chasing, and one it merely passes on +-- does. Getting the two confused makes a module appear to re-export +-- everything it exports, and then a single dependency whose source is +-- missing makes the whole module unanswerable. +-- +-- Erring towards too few is safe and towards too many is not: a name left +-- out here is chased when it need not have been, whereas one wrongly +-- included is a fixity nobody looked for. +declaredNames :: HsModule GhcPs -> Set OpName +declaredNames = Set.fromList . concatMap (fromDecl . unLoc) . hsmodDecls + where + fromDecl = \case + ValD _ b -> fromBind b + SigD _ sig -> fromSig sig + TyClD _ t -> fromTyCl t + ForD _ f -> [opName (unLoc (fd_name f))] + _ -> [] + + fromBind = boundNames + + fromSig = \case + FixSig _ (FixitySig _ ns _) -> map (opName . unLoc) ns + sig -> signedNames sig + + fromTyCl = \case + FamDecl _ (FamilyDecl {fdLName}) -> [opName (unLoc fdLName)] + SynDecl {tcdLName} -> [opName (unLoc tcdLName)] + d@DataDecl {tcdLName} -> opName (unLoc tcdLName) : membersOf d + d@ClassDecl {tcdLName} -> opName (unLoc tcdLName) : membersOf d + +-- | The names a binding brings into being. +boundNames :: HsBind GhcPs -> [OpName] +boundNames = \case + FunBind _ n _ -> [opName (unLoc n)] + PatBind _ p _ _ -> [opName n | VarPat _ (L _ n) <- listify isVarPat p] + PatSynBind _ (PSB _ n _ _ _) -> [opName (unLoc n)] + _ -> [] + where + isVarPat :: Pat GhcPs -> Bool + isVarPat = \case + VarPat {} -> True + _ -> False + +-- | The names a signature is about, leaving fixity declarations aside. +signedNames :: Sig GhcPs -> [OpName] +signedNames = \case + TypeSig _ ns _ -> map (opName . unLoc) ns + ClassOpSig _ _ ns _ -> map (opName . unLoc) ns + PatSynSig _ ns _ -> map (opName . unLoc) ns + _ -> [] + +-- | The methods a class signature declares. +classMethods :: Sig GhcPs -> [OpName] +classMethods = \case + TypeSig _ ns _ -> map (opName . unLoc) ns + ClassOpSig _ _ ns _ -> map (opName . unLoc) ns + _ -> [] + +-- | The names a declaration carries under the name it declares: a data +-- type's constructors and record fields, a class's methods and the +-- families it keeps. +-- +-- These are what @T(..)@ stands for, and each of them can carry a fixity of +-- its own—@:|@ is a constructor and @infixr 5@ all the same. +membersOf :: TyClDecl GhcPs -> [OpName] +membersOf = \case + DataDecl {tcdDataDefn} -> concatMap (fromCon . unLoc) (consOf (dd_cons tcdDataDefn)) + ClassDecl {tcdSigs, tcdATs} -> + concatMap (classMethods . unLoc) tcdSigs + <> [opName (unLoc (fdLName (unLoc f))) | f <- tcdATs] + _ -> [] + where + consOf :: DataDefnCons (LConDecl GhcPs) -> [LConDecl GhcPs] + consOf = toList + + fromCon :: ConDecl GhcPs -> [OpName] + fromCon = \case + ConDeclGADT {con_names} -> map (opName . unLoc) (toList con_names) + ConDeclH98 {con_name, con_args} -> + opName (unLoc con_name) : fieldNames con_args + + -- A record field is a name the type carries too, and it may be an + -- operator. + fieldNames :: HsConDeclH98Details GhcPs -> [OpName] + fieldNames = \case + RecCon fields -> + [ opName (unLoc (foLabel (unLoc n))) + | f <- unLoc fields, + n <- cdrf_names (unLoc f) + ] + _ -> [] + +-- | What each type or class a module declares carries with it. +-- +-- What @T(..)@ stands for where the module declares @T@ itself. Where it +-- does not—a type it merely passes on—there is nothing here, and a caller +-- that finds nothing must not conclude that @T@ brings nothing. +declaredChildren :: HsModule GhcPs -> Map OpName (Set OpName) +declaredChildren = + Map.fromListWith Set.union . concatMap (fromDecl . unLoc) . hsmodDecls + where + fromDecl = \case + TyClD _ d@DataDecl {tcdLName} -> [entry tcdLName d] + TyClD _ d@ClassDecl {tcdLName} -> [entry tcdLName d] + _ -> [] + entry name d = (opName (unLoc name), Set.fromList (membersOf d)) + +-- | What a module offers under each name, as its export list offers it. +-- +-- @T(..)@ in the list hands on everything the module has under @T@; @T(A, +-- B)@ hands on only what it names; no export list at all hands on every +-- member of everything the module declares. This is the answer to \"what +-- does @T(..)@ bring in\" asked of the module being imported from, which is +-- the only place the answer is. +moduleChildren :: HsModule GhcPs -> Map OpName (Set OpName) +moduleChildren hsModule = case hsmodExports hsModule of + Nothing -> declared + Just items -> Map.fromListWith Set.union (concatMap (fromIE . unLoc) (unLoc items)) + where + declared = declaredChildren hsModule + fromIE = \case + IEThingAll _ n _ -> + [(nameOf n, Map.findWithDefault Set.empty (nameOf n) declared)] + IEThingWith _ n _ ns _ -> [(nameOf n, Set.fromList (map nameOf ns))] + _ -> [] + nameOf = opName . ieWrappedName . unLoc + +-- | Render a parsed name as an operator name. +opName :: RdrName -> OpName +opName = OpName . T.pack . occNameString . rdrNameOcc + +fromGhcFixity :: GHC.Fixity -> Fixity +fromGhcFixity (GHC.Fixity prec dir) = Fixity (fromGhcDirection dir) prec + +fromGhcDirection :: GHC.FixityDirection -> Direction +fromGhcDirection = \case + GHC.InfixL -> LeftAssoc + GHC.InfixR -> RightAssoc + GHC.InfixN -> NoAssoc + +-- | The module's own name, if it declares one. +moduleName :: HsModule GhcPs -> Maybe Text +moduleName = fmap (T.pack . moduleNameString . unLoc) . hsmodName + +---------------------------------------------------------------------------- +-- What a module passes on + +-- | One entry of a module's export list. +data ExportItem + = -- | A name, which may or may not be declared in this module, under the + -- qualifier it was written with if it was written with one. + ExportName (Maybe Text) OpName + | -- | @T(..)@: the name, and with it whatever the module has to give + -- under that name. Which names those are cannot be read off the list; + -- it takes the declaration of @T@, or the module @T@ came from. + ExportAll (Maybe Text) OpName + | -- | @module M@, re-exporting everything that module brought in. + ExportModule Text + deriving (Eq, Show) + +-- | The operators a module's export list names, where that list can be +-- enumerated without reading what the module passes on. +-- +-- 'Nothing' is a module that keeps its own counsel: one whose export list +-- hands whole modules on, so that what it exports cannot be known without +-- reading them. A module with no export list at all exports what it +-- declares, and the fixities it declares are everything it could supply. +-- +-- What this is for: an operator nobody could settle is blamed on the +-- imports that might have declared it, and a module that plainly exports no +-- such name is not one of them. See 'unreadFor'. +exportedOperators :: HsModule GhcPs -> Maybe (Set OpName) +exportedOperators hsModule = case moduleExports hsModule of + Nothing -> Just (Set.fromList [op | (_, op) <- Map.keys (declaredFixities hsModule)]) + Just items + | any beyondUs items -> Nothing + | otherwise -> Just (Set.unions (map named items)) + where + declared = declaredChildren hsModule + beyondUs = \case + ExportModule _ -> True + ExportAll _ parent -> not (Map.member parent declared) + ExportName _ _ -> False + named = \case + ExportName _ op -> Set.singleton op + ExportAll _ parent -> + Set.insert parent (Map.findWithDefault Set.empty parent declared) + ExportModule _ -> Set.empty + +-- | The qualifier a name was written under. +qualifierOf :: RdrName -> Maybe Text +qualifierOf = \case + Qual m _ -> Just (T.pack (moduleNameString m)) + _ -> Nothing + +-- | A module's export list, or 'Nothing' if it has none. +-- +-- The distinction matters. A module with no export list exports exactly +-- what it defines, so its own declarations are the whole answer. A module +-- with one may be passing on names it never declared, and those are what +-- re-export resolution has to chase. +moduleExports :: HsModule GhcPs -> Maybe [ExportItem] +moduleExports = + fmap (concatMap (fromIE . unLoc) . unLoc) . hsmodExports + where + fromIE = \case + IEVar _ n _ -> [named n] + IEThingAbs _ n _ -> [named n] + IEThingAll _ n _ -> [as ExportAll n] + -- The type itself and every member listed with it; a class exports + -- its operators this way. + IEThingWith _ n _ ns _ -> named n : map named ns + IEModuleContents _ m -> [ExportModule (T.pack (moduleNameString (unLoc m)))] + _ -> [] + named = as ExportName + as item n = + let rdr = ieWrappedName (unLoc n) + in item (qualifierOf rdr) (opName rdr) + +---------------------------------------------------------------------------- +-- What a module can see + +-- | One import declaration, reduced to what bears on fixity. +data Import = Import + { -- | The module being imported. + importModule :: Text, + -- | Whether unqualified names are brought into scope. An import that is + -- @qualified@ brings none. + importQualified :: Bool, + -- | The name qualified uses go through: the alias if there is one, + -- otherwise the module's own name. + importAlias :: Text, + -- | The explicit list, if there is one, and whether it is a @hiding@ + -- list. + -- + -- Kept as written rather than as a set of names, because @T(..)@ says + -- what it brings in only once the module it comes from has been asked. + importNames :: Maybe (Bool, [ImportItem]) + } + deriving (Eq, Show) + +-- | One entry of an import list. +data ImportItem + = -- | A plain name. + ImportedName OpName + | -- | @T(..)@: the name, and everything the module offers under it. + ImportedAll OpName + | -- | @T(a, b)@: the name and the members written out beside it. + ImportedSome OpName [OpName] + deriving (Eq, Show) + +-- | Could this list bring the operator in? +-- +-- Told what the module keeps under each of its names, this is exact. Told +-- nothing about a @T(..)@'s @T@, it answers yes, because ruling the +-- operator out would mean knowing what @T@ has under it and we do not. Used +-- where being wrong the other way—deciding an operator could not have +-- arrived through a list that in fact brings it—would settle a fixity that +-- was never established. +mightBring :: Map OpName (Set OpName) -> OpName -> [ImportItem] -> Bool +mightBring carries op = any $ \case + ImportedName n -> n == op + ImportedSome parent ns -> parent == op || op `elem` ns + ImportedAll parent -> maybe True (names parent) (Map.lookup parent carries) + where + names parent kids = parent == op || Set.member op kids + +-- | Does this list certainly name the operator? +-- +-- The other side of 'mightBring', for a @hiding@ list: a name is hidden +-- only where the list says so outright. Told what a @T(..)@ carries this +-- is again exact; told nothing, it still holds that @T(..)@ hides @T@. +surelyNames :: Map OpName (Set OpName) -> OpName -> [ImportItem] -> Bool +surelyNames carries op = any $ \case + ImportedName n -> n == op + ImportedSome parent ns -> parent == op || op `elem` ns + ImportedAll parent -> maybe (parent == op) (names parent) (Map.lookup parent carries) + where + names parent kids = parent == op || Set.member op kids + +-- | The imports of a module. +moduleImports :: + -- | Whether @ImplicitPrelude@ is on + Choice "implicitPrelude" -> + HsModule GhcPs -> + [Import] +moduleImports implicitPrelude hsModule = prelude <> written + where + written = map (fromDecl . unLoc) (hsmodImports hsModule) + prelude + | not (isTrue implicitPrelude) = [] + | any ((== "Prelude") . importModule) written = [] + | otherwise = + [ Import + { importModule = "Prelude", + importQualified = False, + importAlias = "Prelude", + importNames = Nothing + } + ] + + fromDecl d = + Import + { importModule = modName (unLoc (ideclName d)), + importQualified = ideclQualified d /= NotQualified, + importAlias = maybe (modName (unLoc (ideclName d))) (modName . unLoc) (ideclAs d), + importNames = fromList <$> ideclImportList d + } + fromList (interpretation, names) = + ( interpretation == EverythingBut, + mapMaybe (importedItem . unLoc) (unLoc names) + ) + modName = T.pack . moduleNameString + +-- | One entry of an import list, as written. +importedItem :: IE GhcPs -> Maybe ImportItem +importedItem = \case + IEVar _ n _ -> Just (ImportedName (nameOf n)) + IEThingAbs _ n _ -> Just (ImportedName (nameOf n)) + IEThingAll _ n _ -> Just (ImportedAll (nameOf n)) + IEThingWith _ n _ ns _ -> Just (ImportedSome (nameOf n) (map nameOf ns)) + _ -> Nothing + where + nameOf :: LIEWrappedName GhcPs -> OpName + nameOf = opName . ieWrappedName . unLoc + +-- | An import whose module could not be read, and what is known about it +-- regardless. +-- +-- Unread is not the same as unknown. Failing to establish a module's +-- fixities does not stop us reading its export list or its declarations, +-- and either can rule the module out as the source of an operator. Ruling +-- it out is what keeps one unreachable package from unsettling a whole +-- file. +data Unread = Unread + { -- | The import as written. + unreadImport :: Import, + -- | The operators its export list names, where that list can be + -- enumerated. 'Nothing' is a module that keeps its own counsel—one + -- whose list passes whole modules on, or that could not be parsed—and + -- which therefore has to be suspected of everything. + unreadExports :: Maybe (Set OpName), + -- | What it keeps under each of its names, for expanding a @T(..)@ in + -- the import list. Empty is ignorance, and leaves such a list + -- suspected of bringing in anything. + unreadCarries :: Map OpName (Set OpName), + -- | The modules below this one that reading went through, ending at + -- the one that actually stopped it. Empty where the import is itself + -- what could not be read. Diagnostic only. + unreadBelow :: [Text] + } + deriving (Eq, Show) + +-- | An import that could not be read, and the way down to the module that +-- actually stopped us. The head is the import as the file being formatted +-- writes it, and the last name is where reading gave up. +newtype ModuleChain = ModuleChain (NonEmpty Text) + deriving (Eq, Show) + +-- | A chain as it is shown, with the modules painted and arrows between +-- them. +spellModuleChain :: Palette -> ModuleChain -> Text +spellModuleChain palette (ModuleChain modules) = + T.intercalate " → " (map (paint palette Place) (toList modules)) + +-- | Every fixity a module can see, and how. +data Scope = Scope + { -- | What is in scope for an operator written among types. + scopeInTypes :: Reach, + -- | What is in scope for one written among terms. + scopeInTerms :: Reach, + -- | The imports whose modules could not be read, and what is + -- nonetheless known about each. + -- + -- These are what separate \"no declaration exists\" from \"we did not + -- manage to look\". An operator that was not found is settled only if no + -- unread import could have brought it in, and deciding that needs the + -- whole import rather than the module's name: see 'unreadFor'. + -- + -- One list for both namespaces: a module that could not be read could + -- not be read for either. + scopeUnread :: [Unread] + } + deriving (Eq, Show) + +-- | What one namespace of a scope holds. +data Reach = Reach + { -- | Reachable without qualification, with where it came from. + reachUnqualified :: Map OpName (Fixity, Provenance), + -- | Reachable as @M.op@, keyed by the alias actually written—or by the + -- module's own name, under which its own declarations are reachable. + reachQualified :: Map (Text, OpName) (Fixity, Provenance), + -- | Operators the imports bring in with two different fixities, as they + -- would have to be written to run into it: without a qualifier, or under + -- the alias the disagreeing imports share. + reachAmbiguous :: [(Maybe Text, OpName)] + } + deriving (Eq, Show) + +-- | The half of a scope an operator written in this namespace is settled +-- against. +reachIn :: Namespace -> Scope -> Reach +reachIn = \case + InTypes -> scopeInTypes + InTerms -> scopeInTerms + +-- | What is known about the modules a module imports. +-- +-- Everything 'resolveScope' cannot read off the module in front of it, +-- gathered into one place. 'nothingKnown' answers none of them, which is +-- legitimate—it costs coverage, never correctness. +data Known = Known + { -- | What a module exports, or 'Nothing' if that could not be + -- determined. 'Nothing' means the module could not be read, which is + -- not the same as its exporting nothing; see 'resolveScope'. + knownFixities :: Text -> Maybe Fixities, + -- | What a module keeps under each of its names, so that a @T(..)@ in + -- an import list can be told what it brings in. An empty map is + -- ignorance as much as it is emptiness, and understates a list rather + -- than overstating it. + knownChildren :: Text -> Map OpName (Set OpName), + -- | The operators a module's export list names, where that list can be + -- enumerated without reading what it passes on. Asked only about + -- modules 'knownFixities' could not answer for, and only to decide + -- which of them an unsettled operator can be blamed on. + knownExportNames :: Text -> Maybe (Set OpName), + -- | The modules reading a module went through before giving up, the one + -- it gave up on last. Asked only about modules 'knownFixities' could + -- not answer for, and only so that a message can name the module that + -- is really in the way. + knownChain :: Text -> [Text] + } + +-- | Knowing nothing about anything: every question answered with a shrug. +-- +-- A scope built on this settles what the module itself declares and +-- nothing more. Fill in the fields that can be answered. +nothingKnown :: Known +nothingKnown = + Known + { knownFixities = const Nothing, + knownChildren = const Map.empty, + knownExportNames = const Nothing, + knownChain = const [] + } + +-- | Work out what a module can see. +-- +-- The lookup function supplies what each imported module exports, and +-- 'Nothing' means it could not be determined—the package was not +-- downloaded, the source did not parse. That distinction is the whole point +-- of its type: an empty map is a fact about a module, whereas 'Nothing' is +-- an admission about us, and conflating them is how a formatter ends up +-- asserting a fixity it never established. +-- +-- Not handled here: operators arriving through @T(..)@. That is syntactic +-- and so belongs to the lookup function, as re-export chains do—and those +-- "Tilia.Fixity.Plan" already follows, through export lists in source and +-- through the export section of an interface. +resolveScope :: + -- | Whether @ImplicitPrelude@ is on + Choice "implicitPrelude" -> + -- | What is known about the modules this one imports + Known -> + HsModule GhcPs -> + Scope +resolveScope implicitPrelude known hsModule = + Scope + { scopeInTypes = reachAmong InTypes, + scopeInTerms = reachAmong InTerms, + scopeUnread = unread + } + where + Known {knownFixities = exportsOf, knownChildren, knownExportNames, knownChain} = known + exportNamesOf = knownExportNames + imports = moduleImports implicitPrelude hsModule + declared = declaredFixities hsModule + + reachAmong namespace = + Reach + { reachUnqualified = Map.union own (Map.map fst unqualified), + reachQualified = qualified, + reachAmbiguous = + [(Nothing, op) | op <- Map.keys (Map.filter snd unqualified)] + <> [(Just alias, op) | (alias, op) <- Map.keys (Map.filter snd qualifiedFrom)] + } + where + own = Map.map (,DeclaredHere) (fixitiesIn namespace declared) + offered m = fixitiesIn namespace <$> exportsOf m + unqualified = + Map.unionsWith + disagree + [ Map.map (,False) (visible offered i) + | i <- imports, + not (importQualified i) + ] + qualified = Map.union ownQualified (Map.map fst qualifiedFrom) + ownQualified = + Map.fromList + [ ((m, op), entry) + | m <- toList (moduleName hsModule), + (op, entry) <- Map.toList own + ] + qualifiedFrom = + Map.unionsWith + disagree + [ Map.mapKeys (importAlias i,) (Map.map (,False) (visible offered i)) + | i <- imports + ] + + unread = + [ Unread + { unreadImport = i, + unreadExports = exportNamesOf (importModule i), + unreadCarries = knownChildren (importModule i), + unreadBelow = knownChain (importModule i) + } + | i <- imports, + Nothing <- [exportsOf (importModule i)] + ] + + -- Paired with a flag saying whether two imports disagreed about it. + disagree (a, aBad) (b, bBad) = (a, aBad || bBad || fst a /= fst b) + + visible offered i = + let exported = + Map.map (,DeclaredIn (importModule i)) $ + fromMaybe Map.empty (offered (importModule i)) + carries = knownChildren (importModule i) + in case importNames i of + Nothing -> exported + Just (True, hidden) -> + Map.filterWithKey + (\op _ -> not (surelyNames carries op hidden)) + exported + Just (False, shown) -> + Map.filterWithKey (\op _ -> mightBring carries op shown) exported + +---------------------------------------------------------------------------- +-- Answers + +-- | Where a fixity came from. +-- +-- Kept so that an answer can be explained, and so that +-- 'ReportDefault'—which is a real answer, not a guess—cannot be confused +-- with not having one. +data Provenance + = -- | An @infix@ declaration in the module being formatted. + DeclaredHere + | -- | An @infix@ declaration in the named imported module. + DeclaredIn Text + | -- | No declaration exists anywhere in scope, and every module in scope + -- was successfully consulted, so the Report's @infixl 9@ applies. + ReportDefault + deriving (Eq, Show) + +-- | What is known about an operator at a use site. +data Resolution + = -- | Established, and here is where from. + Resolved Fixity Provenance + | -- | Not established. Each chain is an import that could not be read, + -- down to the module that actually stopped us, and the answer may be in + -- any of them. + -- + -- A printer that receives this must not restructure the operator chain: + -- it has to lay it out as the input had it. Rearranging on a guess is + -- exactly what this type exists to prevent. + Unresolved (NonEmpty ModuleChain) + deriving (Eq, Show) + +-- | The fixity of an operator as this module sees it. +lookupFixity :: + -- | The scope + Scope -> + -- | The namespace the operator is written in + Namespace -> + -- | The qualifier written at the use site, if any + Maybe Text -> + -- | Operator to resolve + OpName -> + -- | The resolution + Resolution +lookupFixity scope namespace qualifier op = + case settledFor scope namespace qualifier op of + Just (_, (fixity, provenance)) -> Resolved fixity provenance + Nothing -> case nonEmpty (unreadFor scope qualifier op) of + Nothing -> Resolved defaultFixity ReportDefault + Just missing -> Unresolved missing + +-- | What settles a use, and the namespace that settled it. +settledFor :: + Scope -> + Namespace -> + Maybe Text -> + OpName -> + Maybe (Namespace, (Fixity, Provenance)) +settledFor scope namespace qualifier op = + case mapMaybe found (namespace : promotedFrom namespace) of + (answer : _) -> Just answer + [] -> Nothing + where + promotedFrom = \case + InTypes -> [InTerms] + InTerms -> [] + found n = + (n,) <$> case qualifier of + Nothing -> Map.lookup op (reachUnqualified (reachIn n scope)) + Just q -> Map.lookup (q, op) (reachQualified (reachIn n scope)) + +-- | The modules of the unread imports that could have settled this use. +-- +-- Empty means an operator that was not found really is undeclared, rather +-- than declared somewhere we failed to look. Getting this narrow matters: +-- an import that is @qualified as M@ has no bearing on an operator written +-- without a qualifier, and one with an import list has none on an operator +-- the list does not name. Were every unread import to count against every +-- operator, one unreachable package deep in a dependency tree would +-- unsettle a whole file. +unreadFor :: + -- | The scope + Scope -> + -- | The qualifier written at the use site, if any + Maybe Text -> + -- | Operator being resolved + OpName -> + -- | The imports that could hold the answer, each down to the module that + -- actually stopped us + [ModuleChain] +unreadFor scope qualifier op = + [ ModuleChain (importModule (unreadImport u) :| unreadBelow u) + | u <- scopeUnread scope, + reaches (unreadImport u), + brings u, + exports u + ] + where + -- A module that says what it exports is taken at its word. + exports u = maybe True (Set.member op) (unreadExports u) + reaches i = case qualifier of + Nothing -> not (importQualified i) + Just q -> q == importAlias i + -- What a @T(..)@ in the list stands for is often knowable even where + -- the module's fixities are not: reading a module's declarations is + -- one thing and settling every operator it passes on is another. + brings u = case importNames (unreadImport u) of + Nothing -> True + Just (True, hidden) -> not (surelyNames (unreadCarries u) op hidden) + Just (False, shown) -> mightBring (unreadCarries u) op shown + +---------------------------------------------------------------------------- +-- What could not be answered + +-- | Why an operator's fixity could not be settled. +data Unknown + = -- | These imports could not be read, each given down to the module that + -- actually stopped us, and the declaration the answer depends on may be + -- in any of them. + NotRead (NonEmpty ModuleChain) + | -- | Two modules in scope bring it in with different fixities, so which + -- one applies cannot be read off the imports alone. + Ambiguous + deriving (Eq, Show) + +-- | Every operator the module uses where its fixity decides the layout. +-- +-- Only these positions. An operator chain in an expression and one in a type +-- are regrouped by precedence, so getting the precedence wrong changes what +-- the code means. Everywhere else—a section, the left-hand side of a +-- definition, an @infix@ declaration—the operator stands on its own and +-- nothing is regrouped around it. +operatorsUsed :: HsModule GhcPs -> [(Namespace, (Maybe Text, OpName))] +operatorsUsed hsModule = + map (named InTerms) inExpressions <> map (named InTypes) inTypes + where + inExpressions = + [ n + | e :: HsExpr GhcPs <- listify (const True) hsModule, + OpApp _ _ op _ <- [e], + HsVar _ (L _ n) <- [unLoc op] + ] + inTypes = + [ n + | t :: HsType GhcPs <- listify (const True) hsModule, + HsOpTy _ _ _ (L _ n) _ <- [t] + ] + named namespace n = + (namespace, (qualifierOf n, OpName (T.pack (occNameString (rdrNameOcc n))))) + +-- | The operators this module uses that the scope cannot settle, as the +-- module writes them. +-- +-- Empty is the only acceptable answer: an operator whose fixity is not +-- known cannot be laid out, only guessed at. +unknownOperators :: Scope -> HsModule GhcPs -> [((Maybe Text, OpName), Unknown)] +unknownOperators scope hsModule = + Map.toList (Map.fromList (mapMaybe unsettled (operatorsUsed hsModule))) + where + ambiguous namespace = Set.fromList (reachAmbiguous (reachIn namespace scope)) + unsettled (namespace, (qualifier, op)) = + case settledFor scope namespace qualifier op of + Just (answering, _) + | Set.member (qualifier, op) (ambiguous answering) -> + Just ((qualifier, op), Ambiguous) + | otherwise -> Nothing + Nothing -> case nonEmpty (unreadFor scope qualifier op) of + Just missing -> Just ((qualifier, op), NotRead missing) + Nothing -> Nothing + +-- | An operator as a use site writes it, qualifier and all. +operatorSpelling :: Maybe Text -> OpName -> Text +operatorSpelling qualifier (OpName op) = maybe "" (<> ".") qualifier <> op + +-- | Spell out where an unsettled operator may have come from, and the fact +-- that this run could not read any of it. +spellUnreadIn :: + -- | Whether there is anybody there to see color + Palette -> + -- | The chains, as 'Unresolved' gives them + NonEmpty ModuleChain -> + Text +spellUnreadIn palette missing = + T.intercalate " or " (map (spellModuleChain palette) (toList missing)) + <> ", " + <> ofThose + where + ofThose = case toList missing of + [_] -> "which this run could not read" + [_, _] -> "neither of which this run could read" + _ -> "none of which this run could read" + +---------------------------------------------------------------------------- +-- What reading a module established + +-- | What reading a module established about its operators. +-- +-- Declaring nothing is something a module did; being unreadable is +-- something that happened to us. Everything here turns on keeping those +-- apart, which is why this is two constructors rather than a map that +-- might be empty. +data Established + = -- | It was read, and declares these. + Declares Fixities + | -- | It could not be read. The expensive answer of the two, because + -- reaching it means exhausting every way of reading the module. + -- + -- The name is the module below this one that stopped us, where the + -- failure was not this module's own. One hop only: the module named + -- carries its own, and following them is how a whole chain is got back. + -- It is kept because it has to outlive the run that found it — a + -- verdict of unreadable is cached, and a reason that were not cached + -- with it would leave the second run with a worse account than the + -- first. + Unreadable (Maybe Text) + deriving (Eq, Show) + +-- | What reading a module established about its export list. +-- +-- 'exportedOperators' answers the same question as @'Maybe' ('Set' +-- 'OpName')@, which is the shape 'resolveScope' wants. This is that answer +-- given a name, so that having one and never having asked can be told apart +-- where both have to be written down. +data Exported + = -- | The list names these, and they are all the module can supply. + Exports (Set OpName) + | -- | Nothing that can be enumerated: the list hands whole modules on, or + -- the source would not parse. + Untellable + deriving (Eq, Show) + +-- | What 'resolveScope' makes of it. +exportedNames :: Exported -> Maybe (Set OpName) +exportedNames = \case + Exports names -> Just names + Untellable -> Nothing + +-- | What to write down for an answer 'exportedOperators' gave. +asExported :: Maybe (Set OpName) -> Exported +asExported = maybe Untellable Exports diff --git a/src/Tilia/Fixity/Builtin.hs b/src/Tilia/Fixity/Builtin.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Fixity/Builtin.hs @@ -0,0 +1,1182 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Fixities of the operators that ship with the compiler. +-- +-- Generated by @generate-builtin-fixities.py@ in the root of the +-- repository, from GHC 9.14.1. Run that script again to update this table. +module Tilia.Fixity.Builtin + ( builtinFixities, + ) +where + +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Text (Text) +import Tilia.Fixity + +-- | Every module the boot packages expose, with the operators it exports. +builtinFixities :: Map Text Fixities +builtinFixities = + Map.fromList + [ entry + "Control.Applicative" + [("*>", [InTerms], LeftAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<$>", [InTerms], LeftAssoc, 4), ("<*", [InTerms], LeftAssoc, 4), ("<**>", [InTerms], LeftAssoc, 4), ("<*>", [InTerms], LeftAssoc, 4), ("<|>", [InTerms], LeftAssoc, 3)], + entry "Control.Applicative.Backwards" [], + entry "Control.Applicative.Lift" [], + entry + "Control.Arrow" + [("&&&", [InTerms], RightAssoc, 3), ("***", [InTerms], RightAssoc, 3), ("+++", [InTerms], RightAssoc, 2), ("<+>", [InTerms], RightAssoc, 5), ("<<<", [InTerms], RightAssoc, 1), ("<<^", [InTerms], RightAssoc, 1), (">>>", [InTerms], RightAssoc, 1), (">>^", [InTerms], RightAssoc, 1), ("^<<", [InTerms], RightAssoc, 1), ("^>>", [InTerms], RightAssoc, 1), ("|||", [InTerms], RightAssoc, 2)], + entry + "Control.Category" + [(".", [InTerms], RightAssoc, 9), ("<<<", [InTerms], RightAssoc, 1), (">>>", [InTerms], RightAssoc, 1)], + entry "Control.Concurrent" [], + entry "Control.Concurrent.Chan" [], + entry "Control.Concurrent.MVar" [], + entry "Control.Concurrent.QSem" [], + entry "Control.Concurrent.QSemN" [], + entry "Control.Concurrent.STM" [], + entry "Control.Concurrent.STM.TArray" [], + entry "Control.Concurrent.STM.TBQueue" [], + entry "Control.Concurrent.STM.TChan" [], + entry "Control.Concurrent.STM.TMVar" [], + entry "Control.Concurrent.STM.TQueue" [], + entry "Control.Concurrent.STM.TSem" [], + entry "Control.Concurrent.STM.TVar" [], + entry + "Control.DeepSeq" + [("$!!", [InTerms], RightAssoc, 0), ("<$!!>", [InTerms], LeftAssoc, 4), ("deepseq", [InTerms], RightAssoc, 0)], + entry "Control.Exception" [], + entry "Control.Exception.Annotation" [], + entry "Control.Exception.Backtrace" [], + entry "Control.Exception.Base" [], + entry "Control.Exception.Context" [], + entry + "Control.Monad" + [("<$", [InTerms], LeftAssoc, 4), ("<$!>", [InTerms], LeftAssoc, 4), ("<=<", [InTerms], RightAssoc, 1), ("=<<", [InTerms], RightAssoc, 1), (">=>", [InTerms], RightAssoc, 1), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1)], + entry "Control.Monad.Accum" [], + entry "Control.Monad.Catch" [], + entry "Control.Monad.Catch.Pure" [], + entry "Control.Monad.Cont" [], + entry "Control.Monad.Cont.Class" [], + entry "Control.Monad.Error.Class" [], + entry "Control.Monad.Except" [], + entry "Control.Monad.Fail" [], + entry "Control.Monad.Fix" [], + entry "Control.Monad.IO.Class" [], + entry "Control.Monad.Identity" [], + entry + "Control.Monad.Instances" + [("<$", [InTerms], LeftAssoc, 4), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1)], + entry "Control.Monad.RWS" [], + entry "Control.Monad.RWS.CPS" [], + entry "Control.Monad.RWS.Class" [], + entry "Control.Monad.RWS.Lazy" [], + entry "Control.Monad.RWS.Strict" [], + entry "Control.Monad.Reader" [], + entry "Control.Monad.Reader.Class" [], + entry "Control.Monad.ST" [], + entry "Control.Monad.ST.Lazy" [], + entry "Control.Monad.ST.Lazy.Safe" [], + entry "Control.Monad.ST.Lazy.Unsafe" [], + entry "Control.Monad.ST.Safe" [], + entry "Control.Monad.ST.Strict" [], + entry "Control.Monad.ST.Unsafe" [], + entry "Control.Monad.STM" [], + entry "Control.Monad.Select" [], + entry "Control.Monad.Signatures" [], + entry "Control.Monad.State" [], + entry "Control.Monad.State.Class" [], + entry "Control.Monad.State.Lazy" [], + entry "Control.Monad.State.Strict" [], + entry "Control.Monad.Trans" [], + entry "Control.Monad.Trans.Accum" [], + entry "Control.Monad.Trans.Class" [], + entry "Control.Monad.Trans.Cont" [], + entry "Control.Monad.Trans.Except" [], + entry "Control.Monad.Trans.Identity" [], + entry "Control.Monad.Trans.Maybe" [], + entry "Control.Monad.Trans.RWS" [], + entry "Control.Monad.Trans.RWS.CPS" [], + entry "Control.Monad.Trans.RWS.Lazy" [], + entry "Control.Monad.Trans.RWS.Strict" [], + entry "Control.Monad.Trans.Reader" [], + entry "Control.Monad.Trans.Select" [], + entry "Control.Monad.Trans.State" [], + entry "Control.Monad.Trans.State.Lazy" [], + entry "Control.Monad.Trans.State.Strict" [], + entry "Control.Monad.Trans.Writer" [], + entry "Control.Monad.Trans.Writer.CPS" [], + entry "Control.Monad.Trans.Writer.Lazy" [], + entry "Control.Monad.Trans.Writer.Strict" [], + entry "Control.Monad.Writer" [], + entry "Control.Monad.Writer.CPS" [], + entry "Control.Monad.Writer.Class" [], + entry "Control.Monad.Writer.Lazy" [], + entry "Control.Monad.Writer.Strict" [], + entry "Control.Monad.Zip" [], + entry + "Data.Array" + [("!", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)], + entry + "Data.Array.Base" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)], + entry "Data.Array.Byte" [], + entry + "Data.Array.IArray" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)], + entry "Data.Array.IO" [], + entry "Data.Array.IO.Internals" [], + entry "Data.Array.IO.Safe" [], + entry "Data.Array.MArray" [], + entry "Data.Array.MArray.Safe" [], + entry "Data.Array.ST" [], + entry "Data.Array.ST.Safe" [], + entry "Data.Array.Storable" [], + entry "Data.Array.Storable.Internals" [], + entry "Data.Array.Storable.Safe" [], + entry + "Data.Array.Unboxed" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)], + entry "Data.Array.Unsafe" [], + entry "Data.Bifoldable" [], + entry "Data.Bifoldable1" [], + entry "Data.Bifunctor" [], + entry "Data.Binary" [], + entry "Data.Binary.Builder" [], + entry "Data.Binary.Get" [], + entry "Data.Binary.Get.Internal" [], + entry "Data.Binary.Put" [], + entry "Data.Bitraversable" [], + entry + "Data.Bits" + [("!<<.", [InTerms], LeftAssoc, 8), ("!>>.", [InTerms], LeftAssoc, 8), (".&.", [InTerms], LeftAssoc, 7), (".<<.", [InTerms], LeftAssoc, 8), (".>>.", [InTerms], LeftAssoc, 8), (".^.", [InTerms], LeftAssoc, 6), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)], + entry + "Data.Bool" + [("&&", [InTerms], RightAssoc, 3), ("||", [InTerms], RightAssoc, 2)], + entry "Data.Bounded" [], + entry + "Data.ByteString" + [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)], + entry "Data.ByteString.Builder" [], + entry "Data.ByteString.Builder.Extra" [], + entry "Data.ByteString.Builder.Internal" [], + entry + "Data.ByteString.Builder.Prim" + [(">$<", [InTerms], LeftAssoc, 4), (">*<", [InTerms], RightAssoc, 5)], + entry + "Data.ByteString.Builder.Prim.Internal" + [(">$<", [InTerms], LeftAssoc, 4), (">*<", [InTerms], RightAssoc, 5)], + entry "Data.ByteString.Builder.RealFloat" [], + entry + "Data.ByteString.Char8" + [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)], + entry "Data.ByteString.Internal" [], + entry + "Data.ByteString.Lazy" + [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("cons'", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)], + entry + "Data.ByteString.Lazy.Char8" + [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("cons'", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)], + entry "Data.ByteString.Lazy.Internal" [], + entry + "Data.ByteString.Short" + [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)], + entry + "Data.ByteString.Short.Internal" + [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)], + entry "Data.ByteString.Unsafe" [], + entry "Data.Char" [], + entry "Data.Coerce" [], + entry + "Data.Complex" + [(":+", [InTerms], NoAssoc, 6)], + entry "Data.Containers.ListUtils" [], + entry + "Data.Data" + [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4)], + entry "Data.Dynamic" [], + entry "Data.Either" [], + entry "Data.Enum" [], + entry + "Data.Eq" + [("/=", [InTerms], NoAssoc, 4), ("==", [InTerms], NoAssoc, 4)], + entry "Data.Fixed" [], + entry + "Data.Foldable" + [("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)], + entry "Data.Foldable1" [], + entry + "Data.Function" + [("$", [InTerms], RightAssoc, 0), ("&", [InTerms], LeftAssoc, 1), (".", [InTerms], RightAssoc, 9), ("on", [InTerms], LeftAssoc, 0)], + entry + "Data.Functor" + [("$>", [InTerms], LeftAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<$>", [InTerms], LeftAssoc, 4), ("<&>", [InTerms], LeftAssoc, 1)], + entry "Data.Functor.Classes" [], + entry + "Data.Functor.Compose" + [("Compose", [InTypes, InTerms], RightAssoc, 9)], + entry "Data.Functor.Const" [], + entry "Data.Functor.Constant" [], + entry + "Data.Functor.Contravariant" + [("$<", [InTerms], LeftAssoc, 4), (">$", [InTerms], LeftAssoc, 4), (">$$<", [InTerms], LeftAssoc, 4), (">$<", [InTerms], LeftAssoc, 4)], + entry "Data.Functor.Identity" [], + entry "Data.Functor.Product" [], + entry "Data.Functor.Reverse" [], + entry "Data.Functor.Sum" [], + entry "Data.Graph" [], + entry "Data.IORef" [], + entry "Data.Int" [], + entry + "Data.IntMap" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)], + entry + "Data.IntMap.Internal" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)], + entry "Data.IntMap.Internal.Debug" [], + entry + "Data.IntMap.Lazy" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)], + entry "Data.IntMap.Merge.Lazy" [], + entry "Data.IntMap.Merge.Strict" [], + entry + "Data.IntMap.Strict" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)], + entry + "Data.IntMap.Strict.Internal" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)], + entry + "Data.IntSet" + [("\\\\", [InTerms], LeftAssoc, 9)], + entry + "Data.IntSet.Internal" + [("\\\\", [InTerms], LeftAssoc, 9)], + entry "Data.IntSet.Internal.IntTreeCommons" [], + entry "Data.Ix" [], + entry "Data.Kind" [], + entry + "Data.List" + [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("\\\\", [InTerms], NoAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)], + entry + "Data.List.NonEmpty" + [("!!", [InTerms], LeftAssoc, 9), (":|", [InTypes, InTerms], RightAssoc, 5), ("<|", [InTerms], RightAssoc, 5)], + entry + "Data.Map" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)], + entry + "Data.Map.Internal" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)], + entry "Data.Map.Internal.Debug" [], + entry + "Data.Map.Lazy" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)], + entry "Data.Map.Merge.Lazy" [], + entry "Data.Map.Merge.Strict" [], + entry + "Data.Map.Strict" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)], + entry + "Data.Map.Strict.Internal" + [("!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("\\\\", [InTerms], LeftAssoc, 9)], + entry "Data.Maybe" [], + entry + "Data.Monoid" + [("<>", [InTerms], RightAssoc, 6)], + entry + "Data.Ord" + [("<", [InTerms], NoAssoc, 4), ("<=", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4)], + entry "Data.Proxy" [], + entry + "Data.Ratio" + [("%", [InTerms], LeftAssoc, 7)], + entry "Data.STRef" [], + entry "Data.STRef.Lazy" [], + entry "Data.STRef.Strict" [], + entry + "Data.Semigroup" + [("<>", [InTerms], RightAssoc, 6)], + entry + "Data.Sequence" + [("!?", [InTerms], LeftAssoc, 9), (":<", [InTerms], RightAssoc, 5), (":<|", [InTerms], RightAssoc, 5), (":>", [InTerms], LeftAssoc, 5), (":|>", [InTerms], LeftAssoc, 5), ("<|", [InTerms], RightAssoc, 5), ("><", [InTerms], RightAssoc, 5), ("|>", [InTerms], LeftAssoc, 5)], + entry + "Data.Sequence.Internal" + [("!?", [InTerms], LeftAssoc, 9), (":<", [InTerms], RightAssoc, 5), (":<|", [InTerms], RightAssoc, 5), (":>", [InTerms], LeftAssoc, 5), (":|>", [InTerms], LeftAssoc, 5), ("<|", [InTerms], RightAssoc, 5), ("><", [InTerms], RightAssoc, 5), ("|>", [InTerms], LeftAssoc, 5)], + entry + "Data.Sequence.Internal.Sorting" + [("IQCons", [InTypes, InTerms], RightAssoc, 8), ("ITQCons", [InTypes, InTerms], RightAssoc, 8), ("QCons", [InTerms], RightAssoc, 8), ("TQCons", [InTypes, InTerms], RightAssoc, 8)], + entry + "Data.Set" + [("\\\\", [InTerms], LeftAssoc, 9)], + entry + "Data.Set.Internal" + [("\\\\", [InTerms], LeftAssoc, 9)], + entry "Data.String" [], + entry + "Data.Text" + [(":<", [InTerms], RightAssoc, 5), (":>", [InTerms], LeftAssoc, 5), ("cons", [InTerms], RightAssoc, 5)], + entry "Data.Text.Array" [], + entry "Data.Text.Encoding" [], + entry "Data.Text.Encoding.Error" [], + entry "Data.Text.Foreign" [], + entry "Data.Text.IO" [], + entry "Data.Text.IO.Utf8" [], + entry + "Data.Text.Internal" + [("mul", [InTerms], LeftAssoc, 7), ("mul32", [InTerms], LeftAssoc, 7), ("mul64", [InTerms], LeftAssoc, 7)], + entry "Data.Text.Internal.ArrayUtils" [], + entry "Data.Text.Internal.Builder" [], + entry + "Data.Text.Internal.Builder.Functions" + [("<>", [InTerms], RightAssoc, 4)], + entry "Data.Text.Internal.Builder.Int.Digits" [], + entry "Data.Text.Internal.Builder.RealFloat.Functions" [], + entry "Data.Text.Internal.ByteStringCompat" [], + entry "Data.Text.Internal.Encoding" [], + entry "Data.Text.Internal.Encoding.Fusion" [], + entry "Data.Text.Internal.Encoding.Fusion.Common" [], + entry "Data.Text.Internal.Encoding.Utf16" [], + entry "Data.Text.Internal.Encoding.Utf32" [], + entry "Data.Text.Internal.Encoding.Utf8" [], + entry "Data.Text.Internal.Fusion" [], + entry "Data.Text.Internal.Fusion.CaseMapping" [], + entry "Data.Text.Internal.Fusion.Common" [], + entry "Data.Text.Internal.Fusion.Size" [], + entry + "Data.Text.Internal.Fusion.Types" + [(":*:", [InTerms], LeftAssoc, 2)], + entry "Data.Text.Internal.IO" [], + entry "Data.Text.Internal.Lazy" [], + entry "Data.Text.Internal.Lazy.Encoding.Fusion" [], + entry "Data.Text.Internal.Lazy.Fusion" [], + entry "Data.Text.Internal.Lazy.Search" [], + entry "Data.Text.Internal.PrimCompat" [], + entry "Data.Text.Internal.Private" [], + entry "Data.Text.Internal.Read" [], + entry "Data.Text.Internal.Search" [], + entry "Data.Text.Internal.StrictBuilder" [], + entry "Data.Text.Internal.Unsafe" [], + entry "Data.Text.Internal.Unsafe.Char" [], + entry "Data.Text.Internal.Validate" [], + entry "Data.Text.Internal.Validate.Native" [], + entry + "Data.Text.Lazy" + [(":<", [InTerms], RightAssoc, 5), (":>", [InTerms], LeftAssoc, 5), ("cons", [InTerms], RightAssoc, 5)], + entry "Data.Text.Lazy.Builder" [], + entry "Data.Text.Lazy.Builder.Int" [], + entry "Data.Text.Lazy.Builder.RealFloat" [], + entry "Data.Text.Lazy.Encoding" [], + entry "Data.Text.Lazy.IO" [], + entry "Data.Text.Lazy.Internal" [], + entry "Data.Text.Lazy.Read" [], + entry "Data.Text.Read" [], + entry "Data.Text.Unsafe" [], + entry "Data.Time" [], + entry "Data.Time.Calendar" [], + entry "Data.Time.Calendar.Easter" [], + entry "Data.Time.Calendar.Julian" [], + entry "Data.Time.Calendar.Month" [], + entry "Data.Time.Calendar.MonthDay" [], + entry "Data.Time.Calendar.OrdinalDate" [], + entry "Data.Time.Calendar.Quarter" [], + entry "Data.Time.Calendar.WeekDate" [], + entry "Data.Time.Clock" [], + entry "Data.Time.Clock.POSIX" [], + entry "Data.Time.Clock.System" [], + entry "Data.Time.Clock.TAI" [], + entry "Data.Time.Format" [], + entry "Data.Time.Format.ISO8601" [], + entry "Data.Time.LocalTime" [], + entry "Data.Traversable" [], + entry "Data.Tree" [], + entry "Data.Tuple" [], + entry + "Data.Type.Bool" + [("&&", [InTypes], RightAssoc, 3), ("||", [InTypes], RightAssoc, 2)], + entry "Data.Type.Coercion" [], + entry + "Data.Type.Equality" + [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4), ("==", [InTypes], NoAssoc, 4), ("~~", [InTypes], NoAssoc, 4)], + entry + "Data.Type.Ord" + [("<", [InTypes], NoAssoc, 4), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("", [InTypes], NoAssoc, 4), (">=", [InTypes], NoAssoc, 4), (">=?", [InTypes], NoAssoc, 4), (">?", [InTypes], NoAssoc, 4)], + entry + "Data.Typeable" + [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4)], + entry "Data.Unique" [], + entry "Data.Version" [], + entry "Data.Void" [], + entry "Data.Word" [], + entry "Debug.Trace" [], + entry + "Foreign" + [("!<<.", [InTerms], LeftAssoc, 8), ("!>>.", [InTerms], LeftAssoc, 8), (".&.", [InTerms], LeftAssoc, 7), (".<<.", [InTerms], LeftAssoc, 8), (".>>.", [InTerms], LeftAssoc, 8), (".^.", [InTerms], LeftAssoc, 6), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)], + entry "Foreign.C" [], + entry "Foreign.C.ConstPtr" [], + entry "Foreign.C.Error" [], + entry "Foreign.C.String" [], + entry "Foreign.C.Types" [], + entry "Foreign.Concurrent" [], + entry "Foreign.ForeignPtr" [], + entry "Foreign.ForeignPtr.Safe" [], + entry "Foreign.ForeignPtr.Unsafe" [], + entry "Foreign.Marshal" [], + entry "Foreign.Marshal.Alloc" [], + entry "Foreign.Marshal.Array" [], + entry "Foreign.Marshal.Error" [], + entry "Foreign.Marshal.Pool" [], + entry "Foreign.Marshal.Safe" [], + entry "Foreign.Marshal.Unsafe" [], + entry "Foreign.Marshal.Utils" [], + entry "Foreign.Ptr" [], + entry + "Foreign.Safe" + [("!<<.", [InTerms], LeftAssoc, 8), ("!>>.", [InTerms], LeftAssoc, 8), (".&.", [InTerms], LeftAssoc, 7), (".<<.", [InTerms], LeftAssoc, 8), (".>>.", [InTerms], LeftAssoc, 8), (".^.", [InTerms], LeftAssoc, 6), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)], + entry "Foreign.StablePtr" [], + entry "Foreign.Storable" [], + entry + "GHC.Arr" + [("!", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)], + entry "GHC.ArrayArray" [], + entry + "GHC.Base" + [("$", [InTerms], RightAssoc, 0), ("$!", [InTerms], RightAssoc, 0), ("&&", [InTerms], RightAssoc, 3), ("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("*>", [InTerms], LeftAssoc, 4), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("++", [InTerms], RightAssoc, 5), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), (".", [InTerms], RightAssoc, 9), ("/##", [InTerms], LeftAssoc, 7), ("/=", [InTerms], NoAssoc, 4), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), (":|", [InTypes, InTerms], RightAssoc, 5), ("<", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<*", [InTerms], LeftAssoc, 4), ("<**>", [InTerms], LeftAssoc, 4), ("<*>", [InTerms], LeftAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("<>", [InTerms], RightAssoc, 6), ("<|>", [InTerms], LeftAssoc, 3), ("=<<", [InTerms], RightAssoc, 1), ("==", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1), ("seq", [InTerms], RightAssoc, 0), ("||", [InTerms], RightAssoc, 2), ("~~", [InTypes], NoAssoc, 4)], + entry + "GHC.Bits" + [(".&.", [InTerms], LeftAssoc, 7), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)], + entry "GHC.Boot.TH.Lib" [], + entry "GHC.Boot.TH.Lib.Map" [], + entry "GHC.Boot.TH.Lift" [], + entry "GHC.Boot.TH.Ppr" [], + entry + "GHC.Boot.TH.PprLib" + [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)], + entry "GHC.Boot.TH.Quote" [], + entry "GHC.Boot.TH.Syntax" [], + entry "GHC.ByteOrder" [], + entry "GHC.CString" [], + entry "GHC.Char" [], + entry + "GHC.Classes" + [("&&", [InTerms], RightAssoc, 3), ("/=", [InTerms], NoAssoc, 4), ("<", [InTerms], NoAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("==", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), ("||", [InTerms], RightAssoc, 2)], + entry "GHC.Clock" [], + entry + "GHC.Conc" + [("par", [InTerms], RightAssoc, 0), ("pseq", [InTerms], RightAssoc, 0)], + entry "GHC.Conc.IO" [], + entry "GHC.Conc.Signal" [], + entry + "GHC.Conc.Sync" + [("par", [InTerms], RightAssoc, 0), ("pseq", [InTerms], RightAssoc, 0)], + entry "GHC.ConsoleHandler" [], + entry "GHC.Constants" [], + entry "GHC.Debug" [], + entry + "GHC.Desugar" + [(">>>", [InTerms], LeftAssoc, 9)], + entry "GHC.Encoding.UTF8" [], + entry "GHC.Enum" [], + entry "GHC.Environment" [], + entry "GHC.Err" [], + entry "GHC.Event" [], + entry "GHC.Event.TimeOut" [], + entry "GHC.Exception" [], + entry "GHC.Exception.Type" [], + entry "GHC.ExecutionStack" [], + entry + "GHC.Exts" + [("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), ("/##", [InTerms], LeftAssoc, 7), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), ("seq", [InTerms], RightAssoc, 0), ("~~", [InTypes], NoAssoc, 4)], + entry "GHC.Fingerprint" [], + entry "GHC.Fingerprint.Type" [], + entry + "GHC.Float" + [("**", [InTerms], RightAssoc, 8)], + entry "GHC.Float.ConversionUtils" [], + entry "GHC.Float.RealFracMethods" [], + entry "GHC.Foreign" [], + entry "GHC.ForeignPtr" [], + entry "GHC.ForeignSrcLang.Type" [], + entry "GHC.GHCi" [], + entry "GHC.GHCi.Helpers" [], + entry + "GHC.Generics" + [(":*:", [InTypes, InTerms], RightAssoc, 6), (":+:", [InTypes], RightAssoc, 5), (":.:", [InTypes], RightAssoc, 7)], + entry "GHC.IO" [], + entry "GHC.IO.Buffer" [], + entry "GHC.IO.BufferedIO" [], + entry "GHC.IO.Device" [], + entry "GHC.IO.Encoding" [], + entry "GHC.IO.Encoding.CodePage" [], + entry "GHC.IO.Encoding.Failure" [], + entry "GHC.IO.Encoding.Iconv" [], + entry "GHC.IO.Encoding.Latin1" [], + entry "GHC.IO.Encoding.Types" [], + entry "GHC.IO.Encoding.UTF16" [], + entry "GHC.IO.Encoding.UTF32" [], + entry "GHC.IO.Encoding.UTF8" [], + entry "GHC.IO.Exception" [], + entry "GHC.IO.FD" [], + entry "GHC.IO.Handle" [], + entry "GHC.IO.Handle.FD" [], + entry "GHC.IO.Handle.Internals" [], + entry "GHC.IO.Handle.Lock" [], + entry "GHC.IO.Handle.Text" [], + entry "GHC.IO.Handle.Types" [], + entry "GHC.IO.IOMode" [], + entry "GHC.IO.StdHandles" [], + entry + "GHC.IO.SubSystem" + [("", [InTerms], LeftAssoc, 7)], + entry "GHC.IO.Unsafe" [], + entry "GHC.IOArray" [], + entry "GHC.IORef" [], + entry "GHC.InfoProv" [], + entry "GHC.Int" [], + entry "GHC.Integer" [], + entry "GHC.Integer.Logarithms" [], + entry "GHC.Internal.AllocationLimitHandler" [], + entry + "GHC.Internal.Arr" + [("!", [InTerms], LeftAssoc, 9), ("//", [InTerms], LeftAssoc, 9)], + entry "GHC.Internal.ArrayArray" [], + entry + "GHC.Internal.Base" + [("$", [InTerms], RightAssoc, 0), ("$!", [InTerms], RightAssoc, 0), ("&&", [InTerms], RightAssoc, 3), ("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("*>", [InTerms], LeftAssoc, 4), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("++", [InTerms], RightAssoc, 5), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), (".", [InTerms], RightAssoc, 9), ("/##", [InTerms], LeftAssoc, 7), ("/=", [InTerms], NoAssoc, 4), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), (":|", [InTypes, InTerms], RightAssoc, 5), ("<", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<*", [InTerms], LeftAssoc, 4), ("<**>", [InTerms], LeftAssoc, 4), ("<*>", [InTerms], LeftAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("<>", [InTerms], RightAssoc, 6), ("<|>", [InTerms], LeftAssoc, 3), ("=<<", [InTerms], RightAssoc, 1), ("==", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1), ("seq", [InTerms], RightAssoc, 0), ("||", [InTerms], RightAssoc, 2), ("~~", [InTypes], NoAssoc, 4)], + entry "GHC.Internal.Bignum.Backend" [], + entry "GHC.Internal.Bignum.Backend.Native" [], + entry "GHC.Internal.Bignum.Backend.Selected" [], + entry "GHC.Internal.Bignum.BigNat" [], + entry "GHC.Internal.Bignum.Integer" [], + entry "GHC.Internal.Bignum.Natural" [], + entry + "GHC.Internal.Bignum.Primitives" + [("&&#", [InTerms], RightAssoc, 3), ("||#", [InTerms], RightAssoc, 2)], + entry "GHC.Internal.Bignum.WordArray" [], + entry + "GHC.Internal.Bits" + [(".&.", [InTerms], LeftAssoc, 7), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)], + entry "GHC.Internal.ByteOrder" [], + entry "GHC.Internal.CString" [], + entry "GHC.Internal.Char" [], + entry + "GHC.Internal.Classes" + [("&&", [InTerms], RightAssoc, 3), ("/=", [InTerms], NoAssoc, 4), ("<", [InTerms], NoAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("==", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), ("||", [InTerms], RightAssoc, 2)], + entry "GHC.Internal.Clock" [], + entry "GHC.Internal.ClosureTypes" [], + entry "GHC.Internal.Conc.Bound" [], + entry "GHC.Internal.Conc.IO" [], + entry "GHC.Internal.Conc.Signal" [], + entry + "GHC.Internal.Conc.Sync" + [("par", [InTerms], RightAssoc, 0), ("pseq", [InTerms], RightAssoc, 0)], + entry "GHC.Internal.ConsoleHandler" [], + entry + "GHC.Internal.Control.Arrow" + [("&&&", [InTerms], RightAssoc, 3), ("***", [InTerms], RightAssoc, 3), ("+++", [InTerms], RightAssoc, 2), ("<+>", [InTerms], RightAssoc, 5), ("<<<", [InTerms], RightAssoc, 1), ("<<^", [InTerms], RightAssoc, 1), (">>>", [InTerms], RightAssoc, 1), (">>^", [InTerms], RightAssoc, 1), ("^<<", [InTerms], RightAssoc, 1), ("^>>", [InTerms], RightAssoc, 1), ("|||", [InTerms], RightAssoc, 2)], + entry + "GHC.Internal.Control.Category" + [(".", [InTerms], RightAssoc, 9), ("<<<", [InTerms], RightAssoc, 1), (">>>", [InTerms], RightAssoc, 1)], + entry "GHC.Internal.Control.Concurrent.MVar" [], + entry "GHC.Internal.Control.Exception" [], + entry "GHC.Internal.Control.Exception.Base" [], + entry + "GHC.Internal.Control.Monad" + [("<$", [InTerms], LeftAssoc, 4), ("<$!>", [InTerms], LeftAssoc, 4), ("<=<", [InTerms], RightAssoc, 1), ("=<<", [InTerms], RightAssoc, 1), (">=>", [InTerms], RightAssoc, 1), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1)], + entry "GHC.Internal.Control.Monad.Fail" [], + entry "GHC.Internal.Control.Monad.Fix" [], + entry "GHC.Internal.Control.Monad.IO.Class" [], + entry "GHC.Internal.Control.Monad.ST" [], + entry "GHC.Internal.Control.Monad.ST.Imp" [], + entry "GHC.Internal.Control.Monad.ST.Lazy" [], + entry "GHC.Internal.Control.Monad.ST.Lazy.Imp" [], + entry "GHC.Internal.Control.Monad.Zip" [], + entry + "GHC.Internal.Data.Bits" + [("!<<.", [InTerms], LeftAssoc, 8), ("!>>.", [InTerms], LeftAssoc, 8), (".&.", [InTerms], LeftAssoc, 7), (".<<.", [InTerms], LeftAssoc, 8), (".>>.", [InTerms], LeftAssoc, 8), (".^.", [InTerms], LeftAssoc, 6), (".|.", [InTerms], LeftAssoc, 5), ("rotate", [InTerms], LeftAssoc, 8), ("rotateL", [InTerms], LeftAssoc, 8), ("rotateR", [InTerms], LeftAssoc, 8), ("shift", [InTerms], LeftAssoc, 8), ("shiftL", [InTerms], LeftAssoc, 8), ("shiftR", [InTerms], LeftAssoc, 8), ("xor", [InTerms], LeftAssoc, 6)], + entry + "GHC.Internal.Data.Bool" + [("&&", [InTerms], RightAssoc, 3), ("||", [InTerms], RightAssoc, 2)], + entry "GHC.Internal.Data.Coerce" [], + entry "GHC.Internal.Data.Data" [], + entry "GHC.Internal.Data.Dynamic" [], + entry "GHC.Internal.Data.Either" [], + entry + "GHC.Internal.Data.Eq" + [("/=", [InTerms], NoAssoc, 4), ("==", [InTerms], NoAssoc, 4)], + entry + "GHC.Internal.Data.Foldable" + [("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)], + entry + "GHC.Internal.Data.Function" + [("$", [InTerms], RightAssoc, 0), ("&", [InTerms], LeftAssoc, 1), (".", [InTerms], RightAssoc, 9), ("on", [InTerms], LeftAssoc, 0)], + entry + "GHC.Internal.Data.Functor" + [("$>", [InTerms], LeftAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<$>", [InTerms], LeftAssoc, 4), ("<&>", [InTerms], LeftAssoc, 1)], + entry "GHC.Internal.Data.Functor.Const" [], + entry "GHC.Internal.Data.Functor.Identity" [], + entry + "GHC.Internal.Data.Functor.Utils" + [("#.", [InTypes, InTerms], LeftAssoc, 9)], + entry "GHC.Internal.Data.IORef" [], + entry "GHC.Internal.Data.Ix" [], + entry + "GHC.Internal.Data.List" + [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("\\\\", [InTerms], NoAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)], + entry + "GHC.Internal.Data.List.NonEmpty" + [(":|", [InTypes, InTerms], RightAssoc, 5)], + entry "GHC.Internal.Data.Maybe" [], + entry + "GHC.Internal.Data.Monoid" + [("<>", [InTerms], RightAssoc, 6)], + entry + "GHC.Internal.Data.NonEmpty" + [(":|", [InTypes, InTerms], RightAssoc, 5)], + entry + "GHC.Internal.Data.OldList" + [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("\\\\", [InTerms], NoAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)], + entry + "GHC.Internal.Data.Ord" + [("<", [InTerms], NoAssoc, 4), ("<=", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4)], + entry "GHC.Internal.Data.Proxy" [], + entry "GHC.Internal.Data.STRef" [], + entry "GHC.Internal.Data.STRef.Strict" [], + entry "GHC.Internal.Data.Semigroup.Internal" [], + entry "GHC.Internal.Data.String" [], + entry "GHC.Internal.Data.Traversable" [], + entry "GHC.Internal.Data.Tuple" [], + entry + "GHC.Internal.Data.Type.Bool" + [("&&", [InTypes], RightAssoc, 3), ("||", [InTypes], RightAssoc, 2)], + entry "GHC.Internal.Data.Type.Coercion" [], + entry + "GHC.Internal.Data.Type.Equality" + [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4), ("==", [InTypes], NoAssoc, 4), ("~~", [InTypes], NoAssoc, 4)], + entry + "GHC.Internal.Data.Type.Ord" + [("<", [InTypes], NoAssoc, 4), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("", [InTypes], NoAssoc, 4), (">=", [InTypes], NoAssoc, 4), (">=?", [InTypes], NoAssoc, 4), (">?", [InTypes], NoAssoc, 4)], + entry + "GHC.Internal.Data.Typeable" + [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4)], + entry "GHC.Internal.Data.Unique" [], + entry "GHC.Internal.Data.Version" [], + entry "GHC.Internal.Data.Void" [], + entry "GHC.Internal.Debug" [], + entry "GHC.Internal.Debug.Trace" [], + entry + "GHC.Internal.Desugar" + [(">>>", [InTerms], LeftAssoc, 9)], + entry "GHC.Internal.Encoding.UTF8" [], + entry "GHC.Internal.Enum" [], + entry "GHC.Internal.Environment" [], + entry "GHC.Internal.Err" [], + entry "GHC.Internal.Event" [], + entry "GHC.Internal.Event.TimeOut" [], + entry "GHC.Internal.Exception" [], + entry "GHC.Internal.Exception.Backtrace" [], + entry "GHC.Internal.Exception.Context" [], + entry "GHC.Internal.Exception.Type" [], + entry "GHC.Internal.ExecutionStack" [], + entry "GHC.Internal.ExecutionStack.Internal" [], + entry + "GHC.Internal.Exts" + [("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), ("/##", [InTerms], LeftAssoc, 7), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), ("seq", [InTerms], RightAssoc, 0), ("~~", [InTypes], NoAssoc, 4)], + entry "GHC.Internal.Fingerprint" [], + entry "GHC.Internal.Fingerprint.Type" [], + entry + "GHC.Internal.Float" + [("**", [InTerms], RightAssoc, 8)], + entry "GHC.Internal.Float.ConversionUtils" [], + entry "GHC.Internal.Float.RealFracMethods" [], + entry "GHC.Internal.Foreign.C.ConstPtr" [], + entry "GHC.Internal.Foreign.C.Error" [], + entry "GHC.Internal.Foreign.C.String" [], + entry "GHC.Internal.Foreign.C.String.Encoding" [], + entry "GHC.Internal.Foreign.C.Types" [], + entry "GHC.Internal.Foreign.Concurrent" [], + entry "GHC.Internal.Foreign.ForeignPtr" [], + entry "GHC.Internal.Foreign.ForeignPtr.Imp" [], + entry "GHC.Internal.Foreign.ForeignPtr.Unsafe" [], + entry "GHC.Internal.Foreign.Marshal.Alloc" [], + entry "GHC.Internal.Foreign.Marshal.Array" [], + entry "GHC.Internal.Foreign.Marshal.Error" [], + entry "GHC.Internal.Foreign.Marshal.Pool" [], + entry "GHC.Internal.Foreign.Marshal.Safe" [], + entry "GHC.Internal.Foreign.Marshal.Unsafe" [], + entry "GHC.Internal.Foreign.Marshal.Utils" [], + entry "GHC.Internal.Foreign.Ptr" [], + entry "GHC.Internal.Foreign.StablePtr" [], + entry "GHC.Internal.Foreign.Storable" [], + entry "GHC.Internal.ForeignPtr" [], + entry "GHC.Internal.ForeignSrcLang" [], + entry "GHC.Internal.Functor.ZipList" [], + entry "GHC.Internal.GHCi" [], + entry "GHC.Internal.GHCi.Helpers" [], + entry + "GHC.Internal.Generics" + [(":*:", [InTypes, InTerms], RightAssoc, 6), (":+:", [InTypes], RightAssoc, 5), (":.:", [InTypes], RightAssoc, 7)], + entry "GHC.Internal.Heap.Closures" [], + entry "GHC.Internal.Heap.Constants" [], + entry "GHC.Internal.Heap.InfoTable" [], + entry "GHC.Internal.Heap.InfoTable.Types" [], + entry "GHC.Internal.Heap.InfoTableProf" [], + entry "GHC.Internal.Heap.ProfInfo.Types" [], + entry "GHC.Internal.IO" [], + entry "GHC.Internal.IO.Buffer" [], + entry "GHC.Internal.IO.BufferedIO" [], + entry "GHC.Internal.IO.Device" [], + entry "GHC.Internal.IO.Encoding" [], + entry "GHC.Internal.IO.Encoding.CodePage" [], + entry "GHC.Internal.IO.Encoding.Failure" [], + entry "GHC.Internal.IO.Encoding.Iconv" [], + entry "GHC.Internal.IO.Encoding.Latin1" [], + entry "GHC.Internal.IO.Encoding.Types" [], + entry "GHC.Internal.IO.Encoding.UTF16" [], + entry "GHC.Internal.IO.Encoding.UTF32" [], + entry "GHC.Internal.IO.Encoding.UTF8" [], + entry "GHC.Internal.IO.Exception" [], + entry "GHC.Internal.IO.FD" [], + entry "GHC.Internal.IO.Handle" [], + entry "GHC.Internal.IO.Handle.FD" [], + entry "GHC.Internal.IO.Handle.Internals" [], + entry "GHC.Internal.IO.Handle.Lock" [], + entry "GHC.Internal.IO.Handle.Text" [], + entry "GHC.Internal.IO.Handle.Types" [], + entry "GHC.Internal.IO.IOMode" [], + entry "GHC.Internal.IO.StdHandles" [], + entry + "GHC.Internal.IO.SubSystem" + [("", [InTerms], LeftAssoc, 7)], + entry "GHC.Internal.IO.Unsafe" [], + entry "GHC.Internal.IOArray" [], + entry "GHC.Internal.IORef" [], + entry "GHC.Internal.InfoProv" [], + entry "GHC.Internal.InfoProv.Types" [], + entry "GHC.Internal.Int" [], + entry "GHC.Internal.Integer" [], + entry "GHC.Internal.Integer.Logarithms" [], + entry "GHC.Internal.IsList" [], + entry "GHC.Internal.Ix" [], + entry "GHC.Internal.LanguageExtensions" [], + entry "GHC.Internal.Lexeme" [], + entry + "GHC.Internal.List" + [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)], + entry "GHC.Internal.MVar" [], + entry "GHC.Internal.Magic" [], + entry "GHC.Internal.Magic.Dict" [], + entry "GHC.Internal.Maybe" [], + entry "GHC.Internal.Natural" [], + entry + "GHC.Internal.Num" + [("*", [InTerms], LeftAssoc, 7), ("+", [InTerms], LeftAssoc, 6), ("-", [InTerms], LeftAssoc, 6)], + entry + "GHC.Internal.Numeric" + [("**", [InTerms], RightAssoc, 8)], + entry "GHC.Internal.Numeric.Natural" [], + entry "GHC.Internal.OverloadedLabels" [], + entry "GHC.Internal.Pack" [], + entry + "GHC.Internal.Prim" + [("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), ("/##", [InTerms], LeftAssoc, 7), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), ("seq", [InTerms], RightAssoc, 0)], + entry "GHC.Internal.Prim.Exception" [], + entry "GHC.Internal.Prim.Ext" [], + entry "GHC.Internal.Prim.Panic" [], + entry "GHC.Internal.Prim.PtrEq" [], + entry + "GHC.Internal.PrimopWrappers" + [("*#", [InTerms], LeftAssoc, 9), ("*##", [InTerms], LeftAssoc, 9), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 9), ("+##", [InTerms], LeftAssoc, 9), ("-#", [InTerms], LeftAssoc, 9), ("-##", [InTerms], LeftAssoc, 9), ("/##", [InTerms], LeftAssoc, 9), ("/=#", [InTerms], LeftAssoc, 9), ("/=##", [InTerms], LeftAssoc, 9), ("<#", [InTerms], LeftAssoc, 9), ("<##", [InTerms], LeftAssoc, 9), ("<=#", [InTerms], LeftAssoc, 9), ("<=##", [InTerms], LeftAssoc, 9), ("==#", [InTerms], LeftAssoc, 9), ("==##", [InTerms], LeftAssoc, 9), (">#", [InTerms], LeftAssoc, 9), (">##", [InTerms], LeftAssoc, 9), (">=#", [InTerms], LeftAssoc, 9), (">=##", [InTerms], LeftAssoc, 9)], + entry "GHC.Internal.Profiling" [], + entry "GHC.Internal.Ptr" [], + entry "GHC.Internal.RTS.Flags" [], + entry "GHC.Internal.RTS.Flags.Test" [], + entry "GHC.Internal.Read" [], + entry + "GHC.Internal.Real" + [("%", [InTerms], LeftAssoc, 7), ("/", [InTerms], LeftAssoc, 7), (":%", [InTerms], LeftAssoc, 9), ("^", [InTerms], RightAssoc, 8), ("^%^", [InTerms], LeftAssoc, 9), ("^^", [InTerms], RightAssoc, 8), ("^^%^^", [InTerms], LeftAssoc, 9), ("div", [InTerms], LeftAssoc, 7), ("mod", [InTerms], LeftAssoc, 7), ("quot", [InTerms], LeftAssoc, 7), ("rem", [InTerms], LeftAssoc, 7)], + entry "GHC.Internal.Records" [], + entry "GHC.Internal.ResponseFile" [], + entry "GHC.Internal.ST" [], + entry "GHC.Internal.STRef" [], + entry "GHC.Internal.Show" [], + entry "GHC.Internal.Stable" [], + entry "GHC.Internal.StableName" [], + entry "GHC.Internal.Stack" [], + entry "GHC.Internal.Stack.Annotation" [], + entry "GHC.Internal.Stack.CCS" [], + entry "GHC.Internal.Stack.CloneStack" [], + entry "GHC.Internal.Stack.Constants" [], + entry "GHC.Internal.Stack.ConstantsProf" [], + entry "GHC.Internal.Stack.Decode" [], + entry "GHC.Internal.Stack.Types" [], + entry "GHC.Internal.StaticPtr" [], + entry "GHC.Internal.Stats" [], + entry "GHC.Internal.Storable" [], + entry "GHC.Internal.System.Environment" [], + entry "GHC.Internal.System.Environment.Blank" [], + entry "GHC.Internal.System.Exit" [], + entry "GHC.Internal.System.IO" [], + entry "GHC.Internal.System.IO.Error" [], + entry "GHC.Internal.System.Mem" [], + entry "GHC.Internal.System.Mem.StableName" [], + entry "GHC.Internal.System.Posix.Internals" [], + entry "GHC.Internal.System.Posix.Types" [], + entry "GHC.Internal.TH.Lib" [], + entry "GHC.Internal.TH.Lift" [], + entry "GHC.Internal.TH.Quote" [], + entry "GHC.Internal.TH.Syntax" [], + entry + "GHC.Internal.Text.ParserCombinators.ReadP" + [("+++", [InTerms], RightAssoc, 5), ("<++", [InTerms], RightAssoc, 5)], + entry + "GHC.Internal.Text.ParserCombinators.ReadPrec" + [("+++", [InTerms], LeftAssoc, 9), ("<++", [InTerms], LeftAssoc, 9)], + entry + "GHC.Internal.Text.Read" + [("+++", [InTerms], LeftAssoc, 9), ("<++", [InTerms], LeftAssoc, 9)], + entry "GHC.Internal.Text.Read.Lex" [], + entry "GHC.Internal.Text.Show" [], + entry "GHC.Internal.TopHandler" [], + entry + "GHC.Internal.Tuple" + [("()", [InTypes, InTerms], LeftAssoc, 9), ("(,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9)], + entry + "GHC.Internal.Type.Reflection" + [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4)], + entry "GHC.Internal.Type.Reflection.Unsafe" [], + entry + "GHC.Internal.TypeError" + [(":$$:", [InTerms], LeftAssoc, 5), (":<>:", [InTerms], LeftAssoc, 6)], + entry + "GHC.Internal.TypeLits" + [("*", [InTypes], LeftAssoc, 7), ("+", [InTypes], LeftAssoc, 6), ("-", [InTypes], LeftAssoc, 6), (":$$:", [InTerms], LeftAssoc, 5), (":<>:", [InTerms], LeftAssoc, 6), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("Div", [InTypes], LeftAssoc, 7), ("Mod", [InTypes], LeftAssoc, 7), ("^", [InTypes], RightAssoc, 8)], + entry "GHC.Internal.TypeLits.Internal" [], + entry + "GHC.Internal.TypeNats" + [("*", [InTypes], LeftAssoc, 7), ("+", [InTypes], LeftAssoc, 6), ("-", [InTypes], LeftAssoc, 6), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("Div", [InTypes], LeftAssoc, 7), ("Mod", [InTypes], LeftAssoc, 7), ("^", [InTypes], RightAssoc, 8)], + entry "GHC.Internal.TypeNats.Internal" [], + entry + "GHC.Internal.Types" + [("~~", [InTypes], NoAssoc, 4)], + entry "GHC.Internal.Unicode" [], + entry "GHC.Internal.Unsafe.Coerce" [], + entry "GHC.Internal.Weak" [], + entry "GHC.Internal.Weak.Finalize" [], + entry "GHC.Internal.Word" [], + entry "GHC.IsList" [], + entry "GHC.Ix" [], + entry "GHC.LanguageExtensions.Type" [], + entry "GHC.Lexeme" [], + entry + "GHC.List" + [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)], + entry "GHC.MVar" [], + entry "GHC.Magic" [], + entry "GHC.Magic.Dict" [], + entry "GHC.Maybe" [], + entry "GHC.Natural" [], + entry + "GHC.Num" + [("*", [InTerms], LeftAssoc, 7), ("+", [InTerms], LeftAssoc, 6), ("-", [InTerms], LeftAssoc, 6)], + entry "GHC.Num.Backend" [], + entry "GHC.Num.Backend.Native" [], + entry "GHC.Num.Backend.Selected" [], + entry "GHC.Num.BigNat" [], + entry "GHC.Num.Integer" [], + entry "GHC.Num.Natural" [], + entry + "GHC.Num.Primitives" + [("&&#", [InTerms], RightAssoc, 3), ("||#", [InTerms], RightAssoc, 2)], + entry "GHC.Num.WordArray" [], + entry + "GHC.OldList" + [("!!", [InTerms], LeftAssoc, 9), ("!?", [InTerms], LeftAssoc, 9), ("++", [InTerms], RightAssoc, 5), ("\\\\", [InTerms], NoAssoc, 5), ("elem", [InTerms], NoAssoc, 4), ("notElem", [InTerms], NoAssoc, 4)], + entry "GHC.OverloadedLabels" [], + entry + "GHC.Prim" + [("*#", [InTerms], LeftAssoc, 7), ("*##", [InTerms], LeftAssoc, 7), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 6), ("+##", [InTerms], LeftAssoc, 6), ("-#", [InTerms], LeftAssoc, 6), ("-##", [InTerms], LeftAssoc, 6), ("/##", [InTerms], LeftAssoc, 7), ("/=#", [InTerms], NoAssoc, 4), ("/=##", [InTerms], NoAssoc, 4), ("<#", [InTerms], NoAssoc, 4), ("<##", [InTerms], NoAssoc, 4), ("<=#", [InTerms], NoAssoc, 4), ("<=##", [InTerms], NoAssoc, 4), ("==#", [InTerms], NoAssoc, 4), ("==##", [InTerms], NoAssoc, 4), (">#", [InTerms], NoAssoc, 4), (">##", [InTerms], NoAssoc, 4), (">=#", [InTerms], NoAssoc, 4), (">=##", [InTerms], NoAssoc, 4), ("seq", [InTerms], RightAssoc, 0)], + entry "GHC.Prim.Exception" [], + entry "GHC.Prim.Ext" [], + entry "GHC.Prim.Panic" [], + entry "GHC.Prim.PtrEq" [], + entry + "GHC.PrimopWrappers" + [("*#", [InTerms], LeftAssoc, 9), ("*##", [InTerms], LeftAssoc, 9), ("**##", [InTerms], LeftAssoc, 9), ("+#", [InTerms], LeftAssoc, 9), ("+##", [InTerms], LeftAssoc, 9), ("-#", [InTerms], LeftAssoc, 9), ("-##", [InTerms], LeftAssoc, 9), ("/##", [InTerms], LeftAssoc, 9), ("/=#", [InTerms], LeftAssoc, 9), ("/=##", [InTerms], LeftAssoc, 9), ("<#", [InTerms], LeftAssoc, 9), ("<##", [InTerms], LeftAssoc, 9), ("<=#", [InTerms], LeftAssoc, 9), ("<=##", [InTerms], LeftAssoc, 9), ("==#", [InTerms], LeftAssoc, 9), ("==##", [InTerms], LeftAssoc, 9), (">#", [InTerms], LeftAssoc, 9), (">##", [InTerms], LeftAssoc, 9), (">=#", [InTerms], LeftAssoc, 9), (">=##", [InTerms], LeftAssoc, 9)], + entry "GHC.Profiling" [], + entry "GHC.Ptr" [], + entry "GHC.RTS.Flags" [], + entry "GHC.Read" [], + entry + "GHC.Real" + [("%", [InTerms], LeftAssoc, 7), ("/", [InTerms], LeftAssoc, 7), (":%", [InTerms], LeftAssoc, 9), ("^", [InTerms], RightAssoc, 8), ("^%^", [InTerms], LeftAssoc, 9), ("^^", [InTerms], RightAssoc, 8), ("^^%^^", [InTerms], LeftAssoc, 9), ("div", [InTerms], LeftAssoc, 7), ("mod", [InTerms], LeftAssoc, 7), ("quot", [InTerms], LeftAssoc, 7), ("rem", [InTerms], LeftAssoc, 7)], + entry "GHC.Records" [], + entry "GHC.ResponseFile" [], + entry "GHC.ST" [], + entry "GHC.STRef" [], + entry "GHC.Show" [], + entry "GHC.Stable" [], + entry "GHC.StableName" [], + entry "GHC.Stack" [], + entry "GHC.Stack.CCS" [], + entry "GHC.Stack.CloneStack" [], + entry "GHC.Stack.Types" [], + entry "GHC.StaticPtr" [], + entry "GHC.Stats" [], + entry "GHC.Storable" [], + entry "GHC.TopHandler" [], + entry + "GHC.Tuple" + [("()", [InTypes, InTerms], LeftAssoc, 9), ("(,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9), ("(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)", [InTypes, InTerms], LeftAssoc, 9)], + entry + "GHC.TypeError" + [(":$$:", [InTerms], LeftAssoc, 5), (":<>:", [InTerms], LeftAssoc, 6)], + entry + "GHC.TypeLits" + [("*", [InTypes], LeftAssoc, 7), ("+", [InTypes], LeftAssoc, 6), ("-", [InTypes], LeftAssoc, 6), (":$$:", [InTerms], LeftAssoc, 5), (":<>:", [InTerms], LeftAssoc, 6), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("Div", [InTypes], LeftAssoc, 7), ("Mod", [InTypes], LeftAssoc, 7), ("^", [InTypes], RightAssoc, 8)], + entry + "GHC.TypeNats" + [("*", [InTypes], LeftAssoc, 7), ("+", [InTypes], LeftAssoc, 6), ("-", [InTypes], LeftAssoc, 6), ("<=", [InTypes], NoAssoc, 4), ("<=?", [InTypes], NoAssoc, 4), ("Div", [InTypes], LeftAssoc, 7), ("Mod", [InTypes], LeftAssoc, 7), ("^", [InTypes], RightAssoc, 8)], + entry + "GHC.Types" + [("~~", [InTypes], NoAssoc, 4)], + entry "GHC.Unicode" [], + entry "GHC.Weak" [], + entry "GHC.Weak.Finalize" [], + entry "GHC.Word" [], + entry "Language.Haskell.TH" [], + entry + "Language.Haskell.TH.CodeDo" + [(">>", [InTerms], LeftAssoc, 9), (">>=", [InTerms], LeftAssoc, 9)], + entry "Language.Haskell.TH.LanguageExtensions" [], + entry "Language.Haskell.TH.Lib" [], + entry "Language.Haskell.TH.Ppr" [], + entry + "Language.Haskell.TH.PprLib" + [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)], + entry "Language.Haskell.TH.Quote" [], + entry "Language.Haskell.TH.Syntax" [], + entry + "Numeric" + [("**", [InTerms], RightAssoc, 8)], + entry "Numeric.Natural" [], + entry + "Prelude" + [("!!", [InTerms], LeftAssoc, 9), ("$", [InTerms], RightAssoc, 0), ("$!", [InTerms], RightAssoc, 0), ("&&", [InTerms], RightAssoc, 3), ("*", [InTerms], LeftAssoc, 7), ("**", [InTerms], RightAssoc, 8), ("*>", [InTerms], LeftAssoc, 4), ("+", [InTerms], LeftAssoc, 6), ("++", [InTerms], RightAssoc, 5), ("-", [InTerms], LeftAssoc, 6), (".", [InTerms], RightAssoc, 9), ("/", [InTerms], LeftAssoc, 7), ("/=", [InTerms], NoAssoc, 4), (":", [InTerms], RightAssoc, 5), ("<", [InTerms], NoAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<$>", [InTerms], LeftAssoc, 4), ("<*", [InTerms], LeftAssoc, 4), ("<*>", [InTerms], LeftAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("<>", [InTerms], RightAssoc, 6), ("=<<", [InTerms], RightAssoc, 1), ("==", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1), ("^", [InTerms], RightAssoc, 8), ("^^", [InTerms], RightAssoc, 8), ("div", [InTerms], LeftAssoc, 7), ("elem", [InTerms], NoAssoc, 4), ("mod", [InTerms], LeftAssoc, 7), ("notElem", [InTerms], NoAssoc, 4), ("quot", [InTerms], LeftAssoc, 7), ("rem", [InTerms], LeftAssoc, 7), ("seq", [InTerms], RightAssoc, 0), ("||", [InTerms], RightAssoc, 2)], + entry "System.CPUTime" [], + entry "System.Cmd" [], + entry "System.Console.GetOpt" [], + entry "System.Directory" [], + entry "System.Directory.Internal" [], + entry + "System.Directory.Internal.Prelude" + [("!!", [InTerms], LeftAssoc, 9), ("$", [InTerms], RightAssoc, 0), ("$!", [InTerms], RightAssoc, 0), ("&&", [InTerms], RightAssoc, 3), ("*", [InTerms], LeftAssoc, 7), ("**", [InTerms], RightAssoc, 8), ("*>", [InTerms], LeftAssoc, 4), ("+", [InTerms], LeftAssoc, 6), ("++", [InTerms], RightAssoc, 5), ("-", [InTerms], LeftAssoc, 6), (".", [InTerms], RightAssoc, 9), (".&.", [InTerms], LeftAssoc, 7), (".|.", [InTerms], LeftAssoc, 5), ("/", [InTerms], LeftAssoc, 7), ("/=", [InTerms], NoAssoc, 4), ("<", [InTerms], NoAssoc, 4), ("<$", [InTerms], LeftAssoc, 4), ("<$>", [InTerms], LeftAssoc, 4), ("<*", [InTerms], LeftAssoc, 4), ("<*>", [InTerms], LeftAssoc, 4), ("<=", [InTerms], NoAssoc, 4), ("<=<", [InTerms], RightAssoc, 1), ("<>", [InTerms], RightAssoc, 6), ("=<<", [InTerms], RightAssoc, 1), ("==", [InTerms], NoAssoc, 4), (">", [InTerms], NoAssoc, 4), (">=", [InTerms], NoAssoc, 4), (">=>", [InTerms], RightAssoc, 1), (">>", [InTerms], LeftAssoc, 1), (">>=", [InTerms], LeftAssoc, 1), ("^", [InTerms], RightAssoc, 8), ("^^", [InTerms], RightAssoc, 8), ("div", [InTerms], LeftAssoc, 7), ("elem", [InTerms], NoAssoc, 4), ("mod", [InTerms], LeftAssoc, 7), ("notElem", [InTerms], NoAssoc, 4), ("on", [InTerms], LeftAssoc, 0), ("quot", [InTerms], LeftAssoc, 7), ("rem", [InTerms], LeftAssoc, 7), ("seq", [InTerms], RightAssoc, 0), ("||", [InTerms], RightAssoc, 2)], + entry "System.Directory.OsPath" [], + entry "System.Environment" [], + entry "System.Environment.Blank" [], + entry "System.Exit" [], + entry + "System.FilePath" + [("-<.>", [InTerms], RightAssoc, 7), ("<.>", [InTerms], RightAssoc, 7), ("", [InTerms], RightAssoc, 5)], + entry + "System.FilePath.Posix" + [("-<.>", [InTerms], RightAssoc, 7), ("<.>", [InTerms], RightAssoc, 7), ("", [InTerms], RightAssoc, 5)], + entry + "System.FilePath.Windows" + [("-<.>", [InTerms], RightAssoc, 7), ("<.>", [InTerms], RightAssoc, 7), ("", [InTerms], RightAssoc, 5)], + entry "System.IO" [], + entry "System.IO.Error" [], + entry "System.IO.Unsafe" [], + entry "System.Info" [], + entry "System.Mem" [], + entry "System.Mem.StableName" [], + entry "System.Mem.Weak" [], + entry + "System.OsPath" + [("-<.>", [InTerms], LeftAssoc, 9), ("<.>", [InTerms], LeftAssoc, 9), ("", [InTerms], LeftAssoc, 9)], + entry "System.OsPath.Encoding" [], + entry "System.OsPath.Internal" [], + entry + "System.OsPath.Posix" + [("-<.>", [InTerms], LeftAssoc, 9), ("<.>", [InTerms], LeftAssoc, 9), ("", [InTerms], LeftAssoc, 9)], + entry + "System.OsPath.Posix.Internal" + [("-<.>", [InTerms], RightAssoc, 7), ("<.>", [InTerms], RightAssoc, 7), ("", [InTerms], RightAssoc, 5)], + entry "System.OsPath.Types" [], + entry + "System.OsPath.Windows" + [("-<.>", [InTerms], LeftAssoc, 9), ("<.>", [InTerms], LeftAssoc, 9), ("", [InTerms], LeftAssoc, 9)], + entry + "System.OsPath.Windows.Internal" + [("-<.>", [InTerms], RightAssoc, 7), ("<.>", [InTerms], RightAssoc, 7), ("", [InTerms], RightAssoc, 5)], + entry + "System.OsString" + [("!?", [InTerms], LeftAssoc, 9)], + entry + "System.OsString.Data.ByteString.Short" + [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)], + entry "System.OsString.Data.ByteString.Short.Internal" [], + entry + "System.OsString.Data.ByteString.Short.Word16" + [("!?", [InTerms], LeftAssoc, 9), ("cons", [InTerms], RightAssoc, 5), ("snoc", [InTerms], LeftAssoc, 5)], + entry "System.OsString.Encoding" [], + entry "System.OsString.Encoding.Internal" [], + entry + "System.OsString.Internal" + [("!?", [InTerms], LeftAssoc, 9)], + entry "System.OsString.Internal.Exception" [], + entry "System.OsString.Internal.Types" [], + entry + "System.OsString.Posix" + [("!?", [InTerms], LeftAssoc, 9)], + entry + "System.OsString.Windows" + [("!?", [InTerms], LeftAssoc, 9)], + entry + "System.Posix" + [("addSignal", [InTerms], RightAssoc, 9), ("deleteSignal", [InTerms], RightAssoc, 9)], + entry + "System.Posix.ByteString" + [("addSignal", [InTerms], RightAssoc, 9), ("deleteSignal", [InTerms], RightAssoc, 9)], + entry "System.Posix.ByteString.FilePath" [], + entry "System.Posix.Directory" [], + entry "System.Posix.Directory.ByteString" [], + entry "System.Posix.Directory.Fd" [], + entry "System.Posix.Directory.Internals" [], + entry "System.Posix.Directory.PosixPath" [], + entry "System.Posix.DynamicLinker" [], + entry "System.Posix.DynamicLinker.ByteString" [], + entry "System.Posix.DynamicLinker.Module" [], + entry "System.Posix.DynamicLinker.Module.ByteString" [], + entry "System.Posix.DynamicLinker.Prim" [], + entry "System.Posix.Env" [], + entry "System.Posix.Env.ByteString" [], + entry "System.Posix.Env.PosixString" [], + entry "System.Posix.Error" [], + entry "System.Posix.Fcntl" [], + entry "System.Posix.Files" [], + entry "System.Posix.Files.ByteString" [], + entry "System.Posix.Files.PosixString" [], + entry "System.Posix.IO" [], + entry "System.Posix.IO.ByteString" [], + entry "System.Posix.IO.PosixString" [], + entry "System.Posix.Internals" [], + entry "System.Posix.PosixPath.FilePath" [], + entry + "System.Posix.PosixString" + [("addSignal", [InTerms], RightAssoc, 9), ("deleteSignal", [InTerms], RightAssoc, 9)], + entry "System.Posix.Process" [], + entry "System.Posix.Process.ByteString" [], + entry "System.Posix.Process.Internals" [], + entry "System.Posix.Process.PosixString" [], + entry "System.Posix.Resource" [], + entry "System.Posix.Semaphore" [], + entry "System.Posix.SharedMem" [], + entry + "System.Posix.Signals" + [("addSignal", [InTerms], RightAssoc, 9), ("deleteSignal", [InTerms], RightAssoc, 9)], + entry + "System.Posix.Signals.Exts" + [("addSignal", [InTerms], RightAssoc, 9), ("deleteSignal", [InTerms], RightAssoc, 9)], + entry "System.Posix.Temp" [], + entry "System.Posix.Temp.ByteString" [], + entry "System.Posix.Temp.PosixString" [], + entry "System.Posix.Terminal" [], + entry "System.Posix.Terminal.ByteString" [], + entry "System.Posix.Terminal.PosixString" [], + entry "System.Posix.Time" [], + entry "System.Posix.Types" [], + entry "System.Posix.Unistd" [], + entry "System.Posix.User" [], + entry "System.Posix.User.ByteString" [], + entry "System.Process" [], + entry "System.Process.CommunicationHandle" [], + entry "System.Process.CommunicationHandle.Internal" [], + entry "System.Process.Environment.OsString" [], + entry "System.Process.Internals" [], + entry "System.Timeout" [], + entry + "Text.Parsec" + [("", [InTerms], NoAssoc, 0), ("<|>", [InTerms], RightAssoc, 1)], + entry "Text.Parsec.ByteString" [], + entry "Text.Parsec.ByteString.Lazy" [], + entry "Text.Parsec.Char" [], + entry "Text.Parsec.Combinator" [], + entry "Text.Parsec.Error" [], + entry "Text.Parsec.Expr" [], + entry "Text.Parsec.Language" [], + entry + "Text.Parsec.Perm" + [("<$$>", [InTerms], LeftAssoc, 2), ("<$?>", [InTerms], LeftAssoc, 2), ("<|?>", [InTerms], LeftAssoc, 1), ("<||>", [InTerms], LeftAssoc, 1)], + entry "Text.Parsec.Pos" [], + entry + "Text.Parsec.Prim" + [("", [InTerms], NoAssoc, 0), ("<|>", [InTerms], RightAssoc, 1)], + entry "Text.Parsec.String" [], + entry "Text.Parsec.Text" [], + entry "Text.Parsec.Text.Lazy" [], + entry "Text.Parsec.Token" [], + entry + "Text.ParserCombinators.Parsec" + [("", [InTerms], NoAssoc, 0), ("<|>", [InTerms], RightAssoc, 1)], + entry "Text.ParserCombinators.Parsec.Char" [], + entry "Text.ParserCombinators.Parsec.Combinator" [], + entry "Text.ParserCombinators.Parsec.Error" [], + entry "Text.ParserCombinators.Parsec.Expr" [], + entry "Text.ParserCombinators.Parsec.Language" [], + entry + "Text.ParserCombinators.Parsec.Perm" + [("<$$>", [InTerms], LeftAssoc, 2), ("<$?>", [InTerms], LeftAssoc, 2), ("<|?>", [InTerms], LeftAssoc, 1), ("<||>", [InTerms], LeftAssoc, 1)], + entry "Text.ParserCombinators.Parsec.Pos" [], + entry + "Text.ParserCombinators.Parsec.Prim" + [("", [InTerms], NoAssoc, 0), ("<|>", [InTerms], RightAssoc, 1)], + entry "Text.ParserCombinators.Parsec.Token" [], + entry + "Text.ParserCombinators.ReadP" + [("+++", [InTerms], RightAssoc, 5), ("<++", [InTerms], RightAssoc, 5)], + entry + "Text.ParserCombinators.ReadPrec" + [("+++", [InTerms], LeftAssoc, 9), ("<++", [InTerms], LeftAssoc, 9)], + entry + "Text.PrettyPrint" + [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)], + entry + "Text.PrettyPrint.Annotated" + [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)], + entry + "Text.PrettyPrint.Annotated.HughesPJ" + [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)], + entry + "Text.PrettyPrint.Annotated.HughesPJClass" + [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)], + entry + "Text.PrettyPrint.HughesPJ" + [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)], + entry + "Text.PrettyPrint.HughesPJClass" + [("$$", [InTerms], LeftAssoc, 5), ("$+$", [InTerms], LeftAssoc, 5), ("<+>", [InTerms], LeftAssoc, 6), ("<>", [InTerms], LeftAssoc, 6)], + entry "Text.Printf" [], + entry + "Text.Read" + [("+++", [InTerms], LeftAssoc, 9), ("<++", [InTerms], LeftAssoc, 9)], + entry "Text.Read.Lex" [], + entry "Text.Show" [], + entry "Text.Show.Functions" [], + entry "Trace.Hpc.Mix" [], + entry "Trace.Hpc.Reflect" [], + entry "Trace.Hpc.Tix" [], + entry "Trace.Hpc.Util" [], + entry + "Type.Reflection" + [(":~:", [InTypes], NoAssoc, 4), (":~~:", [InTypes], NoAssoc, 4)], + entry "Type.Reflection.Unsafe" [], + entry "Unsafe.Coerce" [] + ] + where + entry name ops = + ( name, + Map.fromList + [ ((namespace, OpName o), Fixity d p) + | (o, governs, d, p) <- ops, + namespace <- governs + ] + ) diff --git a/src/Tilia/Fixity/ByHand.hs b/src/Tilia/Fixity/ByHand.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Fixity/ByHand.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Fixities for the few modules whose source defeats us. +module Tilia.Fixity.ByHand + ( byHandFixities, + hscFixities, + ) +where + +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Text (Text) +import Tilia.Fixity + +-- | The modules, and the operators they declare. +byHandFixities :: Map Text (Map OpName Fixity) +byHandFixities = + Map.fromList + [ -- @Test.QuickCheck.Property@ invokes a macro it defines: + -- @WITNESSES(:: [Witness])@ stands in the middle of a record, and + -- only @cpp@ can expand it. No configuration of the module is + -- Haskell, so there is nothing to parse in any of them. + entry + "Test.QuickCheck.Property" + [ ("==>", RightAssoc, 0), + (".&.", RightAssoc, 1), + (".&&.", RightAssoc, 1), + (".||.", RightAssoc, 1), + ("===", NoAssoc, 4), + ("=/=", NoAssoc, 4) + ], + -- @network@ writes its system calls as @foreign import CALLCONV@, + -- and @CALLCONV@ is a macro out of @HsNetDef.h@ standing where the + -- calling convention goes. It has to be expanded for the line to be + -- Haskell at all, so no configuration of these five parses. + -- + -- Not one of them declares a fixity, defines an operator, or gives a + -- constructor an operator name, in any version; every entry below is + -- therefore empty. What that buys is not their own operators but + -- everything downstream: @Network.Socket@ is perfectly readable and + -- was only ever refused because these are what it passes on, and + -- refusing it refused @wai@, @http-client@, @warp@ and in the end + -- every @servant@ module that reaches one of them. + entry "Network.Socket.If" [], + entry "Network.Socket.Internal" [], + entry "Network.Socket.Name" [], + entry "Network.Socket.Shutdown" [], + entry "Network.Socket.Syscall" [], + -- @Data.HashMap.Internal.Array@ defines @CHECK_BOUNDS@ and calls it + -- where an expression goes, with the guarded @case@ on the line + -- below. Unexpanded it reads as a function applied to that @case@, + -- and both branches of the @#if@ that defines it leave the call + -- standing, so there is no configuration to fall back on. + -- + -- It exports no operator and declares no fixity. What it costs to + -- refuse is @Data.HashMap.Strict@, and after that @Data.Aeson.KeyMap@ + -- and everything that reads a JSON object. + entry "Data.HashMap.Internal.Array" [], + -- @monad-logger@ writes one method body once and hands it to sixteen + -- instances: @#define DEF monadLoggerLog a b c d = …@, and then + -- @instance … where DEF@ for each of them. A @where@ with a bare name + -- after it is not Haskell, and the @#define@ sits outside every + -- conditional, so there is no configuration in which it is. + -- + -- It declares no fixity, and its export list is explicit throughout: + -- no module is handed on whole, and none of the types it exports with + -- @(..)@ keeps an operator. What refusing it costs is @Yesod.Core@, + -- and after that every module of @yesod@ that reaches one. + entry "Control.Monad.Logger" [], + -- @cereal@ writes its generic sum instances through three macros, and + -- the one that matters expands into a guard and its right-hand side + -- at once: @gPut | PUTSUM(Word8) | …@. Unexpanded that is a guard + -- with nothing after it. + -- + -- It declares no fixity. It does hand @Data.Serialize.Get@, @.Put@ + -- and @.IEEE754@ on whole, so this claim is about those as well, and + -- not one of the three declares a fixity or exports an operator + -- either: what they supply has the Report's @infixl 9@, which is what + -- an absence here already says. + entry "Data.Serialize" [], + -- @th-lift-instances@ has @LIFT_TYPED_DEFAULT@, defined three ways + -- against the @template-haskell@ version and to nothing at all in the + -- oldest of them, and written bare in five instance bodies. + -- + -- Its export list is empty—the module exists for its orphan + -- instances—so it supplies no operator whatever it declares. It is + -- reached through eight modules of @persistent@, which is a long way + -- to be refused from. + entry "Instances.TH.Lift" [] + ] + where + entry name ops = + (name, Map.fromList [(OpName o, Fixity d p) | (o, d, p) <- ops]) + +-- | What the modules written for @hsc2hs@ declare. +-- +-- A different question from 'byHandFixities', and asked at a different +-- moment. That table is a last resort for a module nothing could be made +-- of; this one is the whole answer for an @.hsc@, given instead of reading +-- it, and a module absent from here declares nothing rather than being +-- unreadable. +-- +-- The claim behind the absence is that @hsc2hs@ modules hardly ever declare +-- a fixity. Of three hundred @.hsc@ files across the packages this project +-- builds against, exactly one module declares one, and it is below. One +-- other defines operators at all — @regex-posix@'s @Text.Regex.Posix.Wrap@, +-- which gives @=~@ and @=~~@ and no fixity for either, so the Report's +-- @infixl 9@ is what they have and is what an absence here already says. +-- Neither module can be parsed even with the @hsc2hs@ constructs blanked +-- out, so there was never a reading that would have found them. +-- +-- Being wrong here costs indentation and nothing else: a fixity decides +-- how a chain of operators is grouped when it is broken across lines, and +-- nothing in the renderer adds or removes a parenthesis. A module missing +-- from this table is laid out as though its operators were @infixl 9@. +hscFixities :: Map Text (Map OpName Fixity) +hscFixities = + Map.fromList + [ -- @addSignal@ and @deleteSignal@ take a signal on the left and a set + -- on the right, so a chain of them only typechecks to the right, and + -- the module says so with a bare @infixr@—precedence 9, as the + -- Report has it when none is written. + entry + "System.Posix.Signals" + [ ("addSignal", RightAssoc, 9), + ("deleteSignal", RightAssoc, 9) + ] + ] + where + entry name ops = + (name, Map.fromList [(OpName o, Fixity d p) | (o, d, p) <- ops]) diff --git a/src/Tilia/Fixity/Cabal.hs b/src/Tilia/Fixity/Cabal.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Fixity/Cabal.hs @@ -0,0 +1,154 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Reading a package's exposed modules out of its @.cabal@ file. +module Tilia.Fixity.Cabal + ( packageModules, + cabalFileInArchive, + cabalFileAtTop, + entryPosixPath, + containedModules, + sourceDirs, + declaredExtensions, + ) +where + +import Codec.Archive.Tar qualified as Tar +import Codec.Archive.Tar.Entry qualified as Tar +import Codec.Compression.GZip qualified as GZip +import Data.ByteString.Lazy qualified as BL +import Data.Char (isSpace) +import Data.List (isSuffixOf) +import Data.List qualified +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import GHC.Driver.Session qualified as GHC +import GHC.LanguageExtensions.Type (Extension) +import Tilia.Pragma (lookupExtension) +import Tilia.Utils (quietly) + +-- | The modules a package exposes, read from the @.cabal@ file in its +-- source tarball. +-- +-- Nothing if the tarball cannot be read or holds no @.cabal@ file. +packageModules :: FilePath -> IO (Maybe [Text]) +packageModules tarball = quietly Nothing $ do + bytes <- BL.readFile tarball + pure (containedModules <$> cabalFileInArchive (Tar.read (GZip.decompress bytes))) + +-- | The first @.cabal@ file at the top level of an archive. +-- +-- Stops as soon as it finds one. The archive is decompressed lazily, so a +-- @.cabal@ near the front costs a fraction of the whole file. +cabalFileInArchive :: Tar.Entries e -> Maybe Text +cabalFileInArchive = \case + Tar.Next entry rest + | cabalFileAtTop (entryPosixPath entry), + Tar.NormalFile content _ <- Tar.entryContent entry -> + Just (T.decodeUtf8Lenient (BL.toStrict content)) + | otherwise -> cabalFileInArchive rest + Tar.Done -> Nothing + Tar.Fail _ -> Nothing + +-- | Where an entry sits in its archive, written the way a tar file writes +-- it. +entryPosixPath :: Tar.Entry -> FilePath +entryPosixPath = Tar.fromTarPathToPosixPath . Tar.entryTarPath + +-- | Is this the path of a package's own @.cabal@ file? +cabalFileAtTop :: FilePath -> Bool +cabalFileAtTop path = ".cabal" `isSuffixOf` path && depth path == 2 + where + depth = (1 +) . length . filter (== '/') + +-- | Every module a package holds, whether it exposes it or not. +-- +-- A package's internals are worth knowing about because its exposed modules +-- pass names on from them: @base@ re-exports from @GHC.Internal.*@, none of +-- which it exposes. Reading only the exposed list leaves those unreachable, +-- and a re-export that cannot be followed is an answer thrown away. +containedModules :: Text -> [Text] +containedModules t = + modulesUnder "exposed-modules" t <> modulesUnder "other-modules" t + +modulesUnder :: Text -> Text -> [Text] +modulesUnder field = + concatMap moduleNames . fieldsNamed field . T.lines + where + moduleNames = + filter looksLikeModule + . concatMap (T.split (== ',')) + . T.words + + looksLikeModule m = case T.uncons m of + Just (c, _) -> c `elem` ['A' .. 'Z'] + Nothing -> False + +-- | Every directory a @.cabal@ file's modules could be under. +-- +-- The current directory is always among them, whatever @hs-source-dirs@ +-- says. This is deliberately more than cabal would look at: a package can +-- keep modules beside its @.cabal@ file and name other directories as well, +-- and a directory too many costs one @stat@ where a directory too few costs +-- a module we cannot resolve. +sourceDirs :: Text -> [Text] +sourceDirs contents = Data.List.nub (named <> ["."]) + where + named = + filter (not . T.null) + . map T.strip + . concatMap (T.split (== ',')) + . concatMap T.words + . fieldsNamed "hs-source-dirs" + $ T.lines contents + +-- | The extensions a package puts in force, read from its @.cabal@ file. +declaredExtensions :: Text -> [Extension] +declaredExtensions contents = + foldl apply baseline named + where + ls = T.lines contents + baseline = case mapMaybe languageNamed (fieldsNamed "default-language" ls) of + [] -> GHC.languageExtensions Nothing + editions -> + Data.List.nub (concatMap (GHC.languageExtensions . Just) editions) + named = + concatMap (T.split (== ',')) . concatMap T.words $ + fieldsNamed "default-extensions" ls + apply acc written = case T.strip written of + name + | Just off <- T.stripPrefix "No" name, + Just extension <- lookupExtension off -> + filter (/= extension) acc + | Just extension <- lookupExtension name, + extension `notElem` acc -> + acc <> [extension] + | otherwise -> acc + languageNamed written = + lookup (T.unpack (T.strip written)) [(show e, e) | e <- [minBound .. maxBound]] + +-- | The values of every field with the given name, wherever it appears and +-- however deeply it is nested. +fieldsNamed :: Text -> [Text] -> [Text] +fieldsNamed name = go . filter (not . commented) + where + commented = T.isPrefixOf "--" . T.stripStart + + go = \case + [] -> [] + (l : ls) + | Just value <- fieldValue l -> + let (continued, rest) = span (deeperThan (indentOf l)) ls + in T.unwords (value : map T.strip continued) : go rest + | otherwise -> go ls + + fieldValue l = + let (key, rest) = T.break (== ':') l + in if T.toLower (T.strip key) == name && not (T.null rest) + then Just (T.strip (T.drop 1 rest)) + else Nothing + + deeperThan n l = T.null (T.strip l) || indentOf l > n + indentOf = T.length . T.takeWhile isSpace diff --git a/src/Tilia/Fixity/Cache.hs b/src/Tilia/Fixity/Cache.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Fixity/Cache.hs @@ -0,0 +1,432 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Remembering what was read out of a package, between runs. +-- +-- Reading a dependency means decompressing an archive and parsing a module, +-- which costs tens of milliseconds. Doing it once is fine. Doing it again +-- for every file of a project, on every save, is not—and that is the shape +-- of the work when a formatter is driven from an editor. +module Tilia.Fixity.Cache + ( Cache, + PlanToken (..), + openCache, + cachedModules, + storeModules, + cachedFixities, + storeFixities, + cachedExportNames, + storeExportNames, + cachedChildren, + storeChildren, + cachedInstalled, + storeInstalled, + cachedFutileSolve, + storeFutileSolve, + cachedFutileFetch, + storeFutileFetch, + ) +where + +import Control.Monad (join) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Set (Set) +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.IO qualified as T +import Data.Text.Read qualified as T +import System.Directory + ( XdgDirectory (XdgCache), + createDirectoryIfMissing, + doesFileExist, + getModificationTime, + getXdgDirectory, + renameFile, + ) +import System.FilePath (takeDirectory, ()) +import Tilia.Fixity +import Tilia.Fixity.PackageDb (Installed (..), InstalledPackage (..)) +import Tilia.Utils (quietly) + +-- | Where cached answers are kept together with a token unique to this +-- build plan, read in this environment. +data Cache = Cache FilePath PlanToken + +-- | A token that is unique to this plan, read in this environment. It is +-- needed in order to be able to cache the expensive class of lookup +-- failures that are related to chasing module re-export chains. Rather than +-- track what each failure leaned on, all of them are tied to the pair as a +-- whole: anything that could turn a failure into an answer changes one or +-- the other, and failures are few enough that re-deriving them when it does +-- costs little. +-- +-- The environment belongs in it because a module the plan names is +-- unreadable where the compiler cannot be asked about its package and +-- readable where it can, and that is settled outside the project. See +-- 'Tilia.Fixity.PackageDb.compilerIdentity'. +newtype PlanToken = PlanToken Text + deriving (Eq, Show) + +-- | Bumped whenever what is written changes shape, so that entries from an +-- older Tilia are ignored rather than misread. +formatVersion :: FilePath +formatVersion = "v1" + +-- | Open, creating the directory if need be. +-- +-- 'Nothing' if there is nowhere to write, in which case everything still +-- works and is merely slower. +-- +-- The token is what a failure written through this cache is tied to, and +-- what one read back out of it has to match. See 'PlanToken'. +openCache :: PlanToken -> IO (Maybe Cache) +openCache token = quietly Nothing $ do + root <- ( formatVersion) <$> getXdgDirectory XdgCache "tilia" + createDirectoryIfMissing True (root "modules") + createDirectoryIfMissing True (root "fixities") + createDirectoryIfMissing True (root "installed") + pure (Just (Cache root token)) + +-- | The modules a package exposes, if that was worked out before. +cachedModules :: Cache -> Text -> IO (Maybe [Text]) +cachedModules cache package = + readIfPresent (modulesPath cache package) $ + filter (not . T.null) . T.lines + +-- | Remember what a package exposes. +storeModules :: Cache -> Text -> [Text] -> IO () +storeModules cache package = + writeAtomically (modulesPath cache package) . T.unlines + +-- | What was established about a module before, if anything was. +-- +-- An 'Unreadable' answer is offered back only under the 'PlanToken' it was +-- written under. +cachedFixities :: + -- | Where to look + Cache -> + -- | The package the module belongs to. Opaque here: whatever the caller + -- uses to tell one package from another is what an answer is filed under, + -- and answers filed under different keys never meet. + Text -> + -- | The module, by its full dotted name + Text -> + -- | What was established, or 'Nothing' if nothing was + IO (Maybe Established) +cachedFixities cache@(Cache _ (PlanToken token)) package modName = + fmap join . readIfPresent (fixitiesPath cache package modName) $ \contents -> + case T.lines contents of + ("read" : entries) -> Declares . Map.fromList <$> traverse parseEntry entries + [unread] | Just rest <- T.stripPrefix ("unread\t" <> token) unread -> + case T.uncons rest of + Nothing -> Just (Unreadable Nothing) + Just ('\t', below) | not (T.null below) -> Just (Unreadable (Just below)) + _ -> Nothing + _ -> Nothing + +-- | Remember what reading a module established. +storeFixities :: + -- | Where to write + Cache -> + -- | The package the module belongs to, as 'cachedFixities' takes it + Text -> + -- | The module, by its full dotted name + Text -> + -- | What was established about it + Established -> + IO () +storeFixities cache package modName answer = do + quietly () (createDirectoryIfMissing True (packageDir cache package)) + writeAtomically (fixitiesPath cache package modName) $ + case answer of + Unreadable below -> + T.unlines ["unread\t" <> token <> foldMap ("\t" <>) below] + Declares fixities -> + T.unlines ("read" : map renderEntry (Map.toList fixities)) + where + Cache _ (PlanToken token) = cache + +---------------------------------------------------------------------------- +-- Export names + +-- | What a module's export list was found to say, if it was ever read. +-- +-- Wanted for the modules whose fixities could not be established, and asked +-- exactly then: a warm cache answers those from 'cachedFixities' without +-- opening the archive at all, and without this the archive would be opened +-- anyway to ask this instead. +cachedExportNames :: + -- | Where to look + Cache -> + -- | The package the module belongs to, as 'cachedFixities' takes it + Text -> + -- | The module, by its full dotted name + Text -> + -- | What its export list said, or 'Nothing' if it was never read + IO (Maybe Exported) +cachedExportNames cache package modName = + fmap join . readIfPresent (exportsPath cache package modName) $ \contents -> + case T.lines contents of + ("names" : entries) -> Just (Exports (Set.fromList (map OpName entries))) + ["untellable"] -> Just Untellable + _ -> Nothing + +-- | Remember what a module's export list said. +storeExportNames :: + -- | Where to write + Cache -> + -- | The package the module belongs to, as 'cachedFixities' takes it + Text -> + -- | The module, by its full dotted name + Text -> + -- | What its export list said + Exported -> + IO () +storeExportNames cache package modName answer = do + quietly () (createDirectoryIfMissing True (exportsDir cache package)) + writeAtomically (exportsPath cache package modName) $ + case answer of + Untellable -> T.unlines ["untellable"] + Exports names -> T.unlines ("names" : [op | OpName op <- Set.toAscList names]) + +---------------------------------------------------------------------------- +-- What a name carries with it + +-- | What a module keeps under each of its names, if it was ever read for +-- it. +-- +-- Wanted wherever an import list writes @T(..)@, and got at by reading the +-- module's interface or its source—which on a warm cache is work that +-- would otherwise not be done at all. +cachedChildren :: + -- | Where to look + Cache -> + -- | The package the module belongs to, as 'cachedFixities' takes it + Text -> + -- | The module, by its full dotted name + Text -> + -- | What it keeps under each name, or 'Nothing' if it was never read + IO (Maybe (Map OpName (Set OpName))) +cachedChildren cache package modName = + fmap join . readIfPresent (childrenPath cache package modName) $ \contents -> + case T.lines contents of + ("children" : entries) -> Just (Map.fromList (mapMaybe childEntry entries)) + _ -> Nothing + where + childEntry line = case T.splitOn "\t" line of + (parent : kids) -> Just (OpName parent, Set.fromList (map OpName kids)) + [] -> Nothing + +-- | Remember what a module keeps under each of its names. +storeChildren :: + -- | Where to write + Cache -> + -- | The package the module belongs to, as 'cachedFixities' takes it + Text -> + -- | The module, by its full dotted name + Text -> + -- | What it keeps under each name + Map OpName (Set OpName) -> + IO () +storeChildren cache package modName children = do + quietly () (createDirectoryIfMissing True (childrenDir cache package)) + writeAtomically (childrenPath cache package modName) $ + T.unlines ("children" : map entry (Map.toList children)) + where + entry (OpName parent, kids) = + T.intercalate "\t" (parent : [kid | OpName kid <- Set.toAscList kids]) + +---------------------------------------------------------------------------- +-- The package database + +-- | What the compiler could see when last asked, if it can still see it. +-- +-- Whose answer this is, is settled by the path it was found at rather than +-- by anything written inside it. See 'installedPath'. +cachedInstalled :: Cache -> IO (Maybe [InstalledPackage]) +cachedInstalled cache = quietly Nothing $ do + readIfPresent (installedPath cache) T.lines >>= \case + Nothing -> pure Nothing + Just ls -> do + let written = + [(T.unpack path, stamp) | ["db", path, stamp] <- map fields ls] + still <- traverse unchanged written + pure $ + if not (null written) && and still + then Just (mapMaybe installedFrom ls) + else Nothing + where + unchanged (path, stamp) = + quietly False ((== stamp) . T.pack . show <$> getModificationTime path) + installedFrom l = case fields l of + ("pkg" : name : version : modules : dirs) -> + Just + InstalledPackage + { ipName = name, + ipVersion = version, + ipModules = T.words modules, + ipImportDirs = map T.unpack dirs + } + _ -> Nothing + fields = T.splitOn "\t" + +-- | Remember what the compiler can see, stamped so that a later run can +-- tell whether it still does. +-- +-- Nothing is written when there is no database to stamp: an answer nothing +-- can invalidate is worse than no answer, because it never stops being +-- given. +storeInstalled :: Cache -> Installed -> IO () +storeInstalled cache found + | null (installedDatabases found) = pure () + | otherwise = quietly () $ do + stamps <- traverse stamped (installedDatabases found) + writeAtomically (installedPath cache) . T.unlines $ + [T.intercalate "\t" ["db", T.pack path, stamp] | (path, stamp) <- stamps] + <> [ T.intercalate "\t" $ + ["pkg", ipName p, ipVersion p, T.unwords (ipModules p)] + <> map T.pack (ipImportDirs p) + | p <- installedPackages found + ] + where + stamped path = do + stamp <- T.pack . show <$> getModificationTime path + pure (path, stamp) + +---------------------------------------------------------------------------- +-- Solves that came to nothing + +-- | Whether asking @cabal@ to solve this plan again has already been tried +-- and left the plan saying exactly what it said before. +cachedFutileSolve :: Cache -> IO Bool +cachedFutileSolve cache = + quietly False (doesFileExist (futileSolvePath cache)) + +-- | Remember that solving again did not widen the plan. +storeFutileSolve :: Cache -> IO () +storeFutileSolve cache = quietly () $ do + createDirectoryIfMissing True (takeDirectory (futileSolvePath cache)) + writeAtomically (futileSolvePath cache) "" + +-- | The packages an earlier run was still short of after asking @cabal@ to +-- fetch them, and which asking again will therefore not bring in. +cachedFutileFetch :: Cache -> IO [Text] +cachedFutileFetch cache = + fromMaybe [] + <$> readIfPresent + (futileFetchPath cache) + (filter (not . T.null) . T.lines) + +-- | Remember what fetching left missing. +storeFutileFetch :: Cache -> [Text] -> IO () +storeFutileFetch cache packages = quietly () $ do + createDirectoryIfMissing True (takeDirectory (futileFetchPath cache)) + writeAtomically (futileFetchPath cache) (T.unlines packages) + +---------------------------------------------------------------------------- +-- Entries + +renderEntry :: ((Namespace, OpName), Fixity) -> Text +renderEntry ((namespace, OpName op), Fixity direction precedence) = + T.intercalate + "\t" + [op, renderNamespace namespace, renderDirection direction, T.pack (show precedence)] + where + renderNamespace = \case + InTypes -> "t" + InTerms -> "v" + renderDirection = \case + LeftAssoc -> "l" + RightAssoc -> "r" + NoAssoc -> "n" + +parseEntry :: Text -> Maybe ((Namespace, OpName), Fixity) +parseEntry line = case T.splitOn "\t" line of + [op, namespace, direction, precedence] -> do + n <- parseNamespace namespace + d <- parseDirection direction + p <- readPrecedence precedence + pure ((n, OpName op), Fixity d p) + _ -> Nothing + where + parseNamespace = \case + "t" -> Just InTypes + "v" -> Just InTerms + _ -> Nothing + parseDirection = \case + "l" -> Just LeftAssoc + "r" -> Just RightAssoc + "n" -> Just NoAssoc + _ -> Nothing + readPrecedence t = case T.signed T.decimal t of + Right (p, rest) | T.null rest -> Just p + _ -> Nothing + +---------------------------------------------------------------------------- +-- Paths and files + +packageDir :: Cache -> Text -> FilePath +packageDir (Cache root _) package = root "fixities" T.unpack package + +-- | Under the token, as everything else here is filed under the key that +-- decides it. +-- +-- One file shared by every token could only ever carry a check saying whose +-- it was, which answers \"is this mine?\" and never \"where is mine?\": two +-- environments formatting the same project would take turns discarding each +-- other's answer and asking @ghc-pkg@ again. +installedPath :: Cache -> FilePath +installedPath (Cache root (PlanToken token)) = + root "installed" T.unpack token + +futileSolvePath :: Cache -> FilePath +futileSolvePath (Cache root (PlanToken token)) = + root "solves" T.unpack token + +futileFetchPath :: Cache -> FilePath +futileFetchPath (Cache root (PlanToken token)) = + root "fetches" T.unpack token + +modulesPath :: Cache -> Text -> FilePath +modulesPath (Cache root _) package = root "modules" T.unpack package + +fixitiesPath :: Cache -> Text -> Text -> FilePath +fixitiesPath cache package modName = + packageDir cache package T.unpack modName + +exportsDir :: Cache -> Text -> FilePath +exportsDir (Cache root _) package = root "exports" T.unpack package + +exportsPath :: Cache -> Text -> Text -> FilePath +exportsPath cache package modName = + exportsDir cache package T.unpack modName + +childrenDir :: Cache -> Text -> FilePath +childrenDir (Cache root _) package = root "children" T.unpack package + +childrenPath :: Cache -> Text -> Text -> FilePath +childrenPath cache package modName = + childrenDir cache package T.unpack modName + +readIfPresent :: FilePath -> (Text -> a) -> IO (Maybe a) +readIfPresent path parse = quietly Nothing $ do + there <- doesFileExist path + if there then Just . parse <$> T.readFile path else pure Nothing + +-- | Write via a temporary file and a rename. +-- +-- Two formatters may run at once—an editor saving while a pre-commit hook +-- runs—and a half-written entry read by the other would be worse than no +-- entry at all. A rename is atomic, so a reader sees the old file or the +-- new one and never a partial one. +-- +-- If anything fails the write is abandoned. A stray temporary left in a +-- cache directory costs nothing; a wrong answer would cost a great deal. +writeAtomically :: FilePath -> Text -> IO () +writeAtomically path contents = quietly () $ do + let temporary = path <> ".tmp" + T.writeFile temporary contents + renameFile temporary path diff --git a/src/Tilia/Fixity/Debug.hs b/src/Tilia/Fixity/Debug.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Fixity/Debug.hs @@ -0,0 +1,231 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | An account of how a module's fixities were determined. +module Tilia.Fixity.Debug + ( FixityNotes (..), + ImportNote (..), + OperatorNote (..), + fixityNotes, + renderFixityNotes, + ) +where + +import Data.Choice (Choice) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Hs (HsModule) +import GHC.Hs.Extension (GhcPs) +import Tilia.Fixity + ( Direction (..), + Fixities, + Fixity (..), + Import (..), + OpName (..), + Provenance (..), + Resolution (..), + Scope (..), + lookupFixity, + moduleImports, + operatorSpelling, + operatorsUsed, + reachAmbiguous, + reachIn, + reachUnqualified, + spellUnreadIn, + ) +import Tilia.Palette (Color (Operator, Place), Palette, paint) +import Tilia.Utils (indent, lineWidth, wrapTo) + +-- | Everything that decided one module's fixities. +data FixityNotes = FixityNotes + { -- | What each import brought, in the order the module writes them. + notedImports :: [ImportNote], + -- | What became of every operator the module uses, one entry per + -- operator. + notedOperators :: [OperatorNote], + -- | What the module declares for itself. + notedDeclarations :: [(Text, Fixity)] + } + deriving (Eq, Show) + +-- | One import. +data ImportNote = ImportNote + { -- | The module imported. + noteModule :: Text, + -- | The name it goes under here, when that differs from its own. + noteAlias :: Maybe Text, + -- | Whether it was imported qualified. + noteQualified :: Bool, + -- | How many operators it was read for, or 'Nothing' when it could not + -- be read at all. + noteBrought :: Maybe Int, + -- | Where reading it went before giving up, ending at the module that + -- actually stopped it. Empty for an import that was read, and for one + -- unread on its own account. + noteChain :: [Text] + } + deriving (Eq, Show) + +-- | One operator the module uses. +data OperatorNote = OperatorNote + { -- | The operator as the module writes it, qualifier and all. + noteSpelling :: Text, + -- | What the scope answered for it. + noteResolution :: Resolution, + -- | Whether two modules in scope disagree about it. + noteAmbiguous :: Bool + } + deriving (Eq, Show) + +-- | Record everything that decided one module's fixities. +fixityNotes :: + -- | Whether @ImplicitPrelude@ is on, so that the Prelude is listed + -- among the imports exactly when the module actually has it + Choice "implicitPrelude" -> + -- | What each module in scope exports, as the resolver answers it + (Text -> IO (Maybe (Fixities))) -> + -- | Where reading a module went before giving up, asked only of the ones + -- the line above gave up on + (Text -> IO [Text]) -> + -- | The scope the module was formatted under + Scope -> + -- | The module + HsModule GhcPs -> + IO FixityNotes +fixityNotes implicitPrelude resolve chainOf scope hsModule = do + brought <- traverse alongside (moduleImports implicitPrelude hsModule) + pure + FixityNotes + { notedImports = brought, + notedOperators = map aboutOperator used, + notedDeclarations = here + } + where + alongside i = do + answer <- resolve (importModule i) + below <- case answer of + Just _ -> pure [] + Nothing -> chainOf (importModule i) + pure + ImportNote + { noteModule = importModule i, + noteAlias = + if importAlias i == importModule i + then Nothing + else Just (importAlias i), + noteQualified = importQualified i, + noteBrought = Set.size . Set.fromList . map snd . Map.keys <$> answer, + noteChain = below + } + + used = + Map.elems + ( Map.fromList + [ ((namespace, uncurry operatorSpelling u), (namespace, u)) + | (namespace, u) <- operatorsUsed hsModule + ] + ) + + here = + [ (op, fixity) + | (OpName op, (fixity, DeclaredHere)) <- Map.toList declaredHere + ] + declaredHere = + Map.union + (reachUnqualified (scopeInTerms scope)) + (reachUnqualified (scopeInTypes scope)) + + aboutOperator (namespace, (qualifier, op)) = + OperatorNote + { noteSpelling = operatorSpelling qualifier op, + noteResolution = lookupFixity scope namespace qualifier op, + noteAmbiguous = + (qualifier, op) `elem` reachAmbiguous (reachIn namespace scope) + } + +-- | Set out all the 'FixityNotes' per file. +renderFixityNotes :: Palette -> Map FilePath FixityNotes -> [Text] +renderFixityNotes palette notes = + concat + [ (indent 1 <> "fixities for " <> paint palette Place (T.pack path)) + : aboutFile palette told + | (path, told) <- Map.toList notes + ] + +-- | One file's account, in reading order. +aboutFile :: Palette -> FixityNotes -> [Text] +aboutFile palette notes = + concat + [ section "imports" fromImport (notedImports notes), + section "operators" fromOperator (notedOperators notes), + section "declared here" fromOwn (notedDeclarations notes) + ] + where + section what render items + | null items = [] + | otherwise = heading what : concatMap (entry . render) items + heading what = indent 2 <> "· " <> what + + entry line = case wrapTo (lineWidth - 8) line of + [] -> [] + (opening : rest) -> (indent 3 <> "· " <> opening) : map (indent 4 <>) rest + + fromImport i = + named (noteModule i) + <> qualification i + <> ": " + <> case noteBrought i of + Nothing -> "could not be read" <> through (noteChain i) + Just n -> operators n + + through = \case + [] -> "" + below -> ", through " <> T.intercalate " → " (map named below) + + qualification i = case (noteQualified i, noteAlias i) of + (True, Just alias) -> " qualified as " <> named alias + (True, Nothing) -> " qualified" + (False, Just alias) -> " as " <> named alias + (False, Nothing) -> "" + + fromOwn (op, fixity) = operator op <> " " <> spelled fixity + + fromOperator o = + operator (noteSpelling o) + <> " " + <> case noteResolution o of + Resolved fixity provenance -> + spelled fixity <> ", " <> from provenance <> ambiguously o + Unresolved missing -> + "unknown: may be declared in " <> spellUnreadIn palette missing + + from = \case + DeclaredHere -> "declared in this module" + DeclaredIn m -> "declared in " <> named m + ReportDefault -> "the Report's default, nothing in scope declaring it" + + ambiguously o + | noteAmbiguous o = ", and two modules in scope disagree about it" + | otherwise = "" + + named = paint palette Place + operator = paint palette Operator + + operators = \case + 1 -> "1 operator" + n -> T.pack (show n) <> " operators" + +-- | A fixity, written the way it would be declared. +spelled :: Fixity -> Text +spelled (Fixity direction precedence) = + which direction <> " " <> T.pack (show precedence) + where + which = \case + LeftAssoc -> "infixl" + RightAssoc -> "infixr" + NoAssoc -> "infix" diff --git a/src/Tilia/Fixity/Interface.hs b/src/Tilia/Fixity/Interface.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Fixity/Interface.hs @@ -0,0 +1,211 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Reading a module's operators out of interface files. +module Tilia.Fixity.Interface + ( Interface (..), + readInterface, + parseInterface, + ) +where + +import Data.Char (isUpper) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Maybe (mapMaybe) +import Data.Set (Set) +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Read qualified as T +import Tilia.Fixity +import Tilia.Process (readProgramOutput) +import Tilia.Utils (quietly) + +-- | What an interface says about the operators a module offers. +data Interface = Interface + { -- | The fixities the module declares itself, by the namespace each + -- governs. + interfaceDeclares :: Fixities, + -- | The names it exports that some other module declared, each with the + -- module that did. Not only the operators: a plain function can be + -- given a fixity and used in backticks, and one of these is where the + -- declaration would be. + interfacePassedOn :: [(Text, OpName)], + -- | What it exports under each name, for the names that carry others + -- with them. This is what @T(..)@ in an import list stands for, and the + -- compiler has already worked it out: an export entry wears its members + -- in braces. + interfaceChildren :: Map OpName (Set OpName) + } + deriving (Eq, Show) + +-- | Read a module's interface file, if the compiler will show it to us. +-- +-- 'Nothing' where it will not, which covers a file that is not there, one +-- built by another compiler, and @ghc@ not being on the path at all. None +-- of those is fatal; they only mean this module has nothing to add. +readInterface :: + -- | The module the file is supposed to hold + Text -> + -- | The file + FilePath -> + IO (Maybe Interface) +readInterface modName path = + quietly Nothing $ + readProgramOutput "ghc" ["--show-iface", path] >>= \case + Nothing -> pure Nothing + Just out -> pure (parseInterface modName out) + +-- | Read what @ghc --show-iface@ printed, if it is this module's interface. +parseInterface :: Text -> Text -> Maybe Interface +parseInterface modName out + | not (any holdsModule (T.lines out)) = Nothing + | otherwise = + Just + Interface + { interfaceDeclares = + namespaced + (typeNamesIn out) + (Map.fromList (concatMap declared (sectionsNamed "fixities"))), + interfacePassedOn = concatMap passedOn (sectionsNamed "exports:"), + interfaceChildren = + Map.unionsWith Set.union (map childrenIn (sectionsNamed "exports:")) + } + where + holdsModule l = case T.words l of + ("interface" : m : _) -> m == modName + _ -> False + sectionsNamed name = [body | (heading, body) <- sections out, heading == name] + declared = mapMaybe fixityEntry . T.splitOn "," + passedOn = concatMap fromExport . T.words + childrenIn section = + Map.fromListWith + Set.union + [ (nameOnly parent, Set.fromList (map nameOnly kids)) + | (parent, kids@(_ : _)) <- exportEntries section + ] + +-- | The names an interface declares as types. +-- +-- The compiler writes each declaration out, and a type is written as one: +-- @data (:~:) a b where@, @type (==) :: …@, @class Eq a where@. A name +-- that turns up in none of those is a value, which is the other namespace. +typeNamesIn :: Text -> Set OpName +typeNamesIn out = + Set.fromList + [ nameOnly (T.dropWhileEnd (== ')') (T.dropWhile (== '(') name)) + | l <- T.lines out, + indented l, + (keyword : rest) <- [T.words l], + keyword `elem` (["data", "type", "newtype", "class"] :: [Text]), + name <- take 1 (dropWhile (`elem` (["family", "role", "instance"] :: [Text])) rest) + ] + where + indented l = maybe False (== ' ') (fst <$> T.uncons l) + +-- | Sort declared fixities into the namespaces they govern. +-- +-- A fixity for a name the interface declares as a type governs types; one +-- for any other name governs terms. A name that is both—rare, and legal— +-- gets the fixity in both, which is what the interface says: it records +-- one fixity for the name and no namespace of its own. +namespaced :: Set OpName -> Map OpName Fixity -> Fixities +namespaced types declared = + Map.fromList + [ ((namespace, op), fixity) + | (op, fixity) <- Map.toList declared, + namespace <- if Set.member op types then [InTypes] else [InTerms] + ] + +-- | Split the output into sections. +sections :: Text -> [(Text, Text)] +sections = go . T.lines + where + go = \case + [] -> [] + (l : ls) + | indented l -> go ls + | otherwise -> + let (body, rest) = span indented ls + (heading, opening) = T.breakOn " " l + in (heading, T.unwords (opening : body)) : go rest + indented l = maybe False (== ' ') (fst <$> T.uncons l) + +-- | One entry of a @fixities@ line: @infixl 9 !@ and the like. +fixityEntry :: Text -> Maybe (OpName, Fixity) +fixityEntry entry = case T.words entry of + [direction, precedence, op] -> do + d <- case direction of + "infixl" -> Just LeftAssoc + "infixr" -> Just RightAssoc + "infix" -> Just NoAssoc + _ -> Nothing + p <- readPrecedence precedence + pure (OpName op, Fixity d p) + _ -> Nothing + where + -- Not one digit: GHC gives @->@ a precedence of -1, below anything the + -- report allows anyone to write, and drops it into a fixities line like + -- any other. + readPrecedence t = case T.signed T.decimal t of + Right (p, rest) | T.null rest -> Just p + _ -> Nothing + +-- | Split an exports section into its entries, keeping the members an entry +-- wears in braces with the name they belong to. +-- +-- An entry is @Some.Module.T@, or @Some.Module.T{Some.Module.A +-- Some.Module.B}@ where @T@ carries names with it. A partial export writes +-- the name as @T|@, which says that not all of them are there; the ones in +-- the braces are still exactly what @T(..)@ would bring in. +exportEntries :: Text -> [(Text, [Text])] +exportEntries = go + where + go text = case T.uncons (T.dropWhile (== ' ') text) of + Nothing -> [] + Just _ -> + let trimmed = T.dropWhile (== ' ') text + (name, rest) = T.break (\c -> c == ' ' || c == '{') trimmed + in case T.uncons rest of + Just ('{', inside) -> + let (kids, after) = T.break (== '}') inside + in (bare name, T.words kids) : go (T.drop 1 after) + _ -> (bare name, []) : go rest + bare = T.dropWhileEnd (`elem` ("|," :: String)) + +-- | An exported name without the module that declared it. +nameOnly :: Text -> OpName +nameOnly t = OpName (maybe t snd (moduleOf t)) + +-- | The names an export entry passes on, with the module that declared each. +-- +-- An entry is a name, and a type or class is followed by its members in +-- braces. A name written bare was declared by the module whose interface +-- this is, and is left out: its fixity is in the @fixities@ line already. +fromExport :: Text -> [(Text, OpName)] +fromExport = mapMaybe qualified . T.split (`elem` ("{}|," :: String)) + where + qualified name = case moduleOf name of + Just (m, n) | not (T.null n) -> Just (m, OpName n) + _ -> Nothing + +-- | Split a name into the module that declared it and the name itself. +moduleOf :: Text -> Maybe (Text, Text) +moduleOf = go [] + where + go seen t = case component t of + Just (c, rest) -> go (c : seen) rest + Nothing + | null seen -> Nothing + | otherwise -> Just (T.intercalate "." (reverse seen), t) + component t = do + (c, _) <- T.uncons t + if isUpper c + then case T.break (== '.') t of + (before, rest) + | Just after <- T.stripPrefix "." rest, + not (T.null before) -> + Just (before, after) + _ -> Nothing + else Nothing diff --git a/src/Tilia/Fixity/PackageDb.hs b/src/Tilia/Fixity/PackageDb.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Fixity/PackageDb.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Which package exposes a module, according to the compiler. +-- +-- The other way of answering this — reading @exposed-modules@ from a +-- @.cabal@ file inside a source tarball — only works where tarballs are. +-- Under Nix they are not: dependencies arrive already built, and a plan +-- solved there calls almost all of them @pre-existing@, so nothing is ever +-- looked for. +-- +-- The compiler always knows, though, because it is what compiles against +-- them. Asking @ghc-pkg@ works in both worlds and is the faster of the two. +-- +-- What this does /not/ give is fixities. A package database records what +-- was built, not what it was built from, so the source is still read from a +-- tarball; this only decides which tarball to look for. +module Tilia.Fixity.PackageDb + ( InstalledPackage (..), + Installed (..), + readInstalledPackages, + compilerIdentity, + fromFields, + ) +where + +import Control.Monad (filterM) +import Data.Char (isSpace) +import Data.List (nub) +import Data.Map.Strict qualified as Map +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import Data.Text qualified as T +import System.Directory (doesDirectoryExist, findExecutable) +import System.FilePath (()) +import Tilia.Process (readProgramOutput) +import Tilia.Utils (quietly) + +-- | A package the compiler can see. +data InstalledPackage = InstalledPackage + { -- | Package name + ipName :: Text, + -- | Package version + ipVersion :: Text, + -- | Every module it holds, hidden ones included, with re-export clauses + -- dropped: those name modules belonging to another package, and looking + -- there is that package's business. + ipModules :: [Text], + -- | Where its compiled interfaces are. + ipImportDirs :: [FilePath] + } + deriving (Eq, Show) + +-- | What the compiler can see, and where it is. +data Installed = Installed + { -- | Every package it can see. + installedPackages :: [InstalledPackage], + installedDatabases :: [FilePath] + } + deriving (Eq, Show) + +-- | Everything the compiler can see, and where it read it from. +-- +-- Empty if @ghc-pkg@ cannot be run, which is not fatal. +-- +-- @ghc-pkg@ is invoked rather than a database read off disk because where +-- the databases are is not knowable from outside: under Nix the wrapper +-- carries the paths, and @GHC_PACKAGE_PATH@ is not set. The records name +-- them, though, so having asked once we need not ask again to find out +-- whether the answer still holds. +readInstalledPackages :: IO Installed +readInstalledPackages = + quietly (Installed [] []) $ + readProgramOutput "ghc-pkg" ["dump", "--global", "--user"] >>= \case + Nothing -> pure (Installed [] []) + Just out -> do + let fields = map parseFields (records out) + databases <- filterM doesDirectoryExist (databasesIn fields) + pure + Installed + { installedPackages = mapMaybe fromFields fields, + installedDatabases = databases + } + +-- | What tells one compiler environment from another. +-- +-- The resolved path of the @ghc-pkg@ that 'readInstalledPackages' will run. +-- Which packages a run can see is settled by that program and by nothing in +-- the project, so it is what an answer about them has to be filed under. +-- Under Nix the path is a store path, and it changes exactly when the +-- environment does; elsewhere it is stable, which is the same thing said of +-- an environment that does not change. +-- +-- Hashing the databases themselves would be more exact, but they cannot be +-- named without running @ghc-pkg dump@—the very thing being remembered. +-- +-- Empty where there is no @ghc-pkg@ to find, which is a state a run can be +-- in and has to be told apart from the others. +compilerIdentity :: IO Text +compilerIdentity = + quietly "" (maybe "" T.pack <$> findExecutable "ghc-pkg") + +-- | The databases a set of records came out of. +databasesIn :: [Map.Map Text Text] -> [FilePath] +databasesIn fields = + nub + [ T.unpack (unquote root) "package.conf.d" + | f <- fields, + Just root <- [Map.lookup "pkgroot" f] + ] + +-- | Strip the quotes a path is written in when it has none needing them. +unquote :: Text -> Text +unquote = T.dropAround (== '"') . T.strip + +-- | Split @ghc-pkg dump@ output into its records. +records :: Text -> [Text] +records = map T.unlines . go . T.lines + where + go ls = case break (== "---") ls of + (record, []) -> [record | not (null record)] + (record, _ : rest) -> record : go rest + +-- | Read one record's fields, if they name a package. +fromFields :: Map.Map Text Text -> Maybe InstalledPackage +fromFields fields = do + name <- Map.lookup "name" fields + version <- Map.lookup "version" fields + pure + InstalledPackage + { ipName = T.strip name, + ipVersion = T.strip version, + ipModules = + concatMap + (maybe [] moduleNames . (`Map.lookup` fields)) + ["exposed-modules", "hidden-modules"], + ipImportDirs = + maybe + [] + (map (T.unpack . rooted fields . unquote) . T.words) + (Map.lookup "import-dirs" fields) + } + +-- | Put the package's root where its registration only left a variable. +rooted :: Map.Map Text Text -> Text -> Text +rooted fields path = case Map.lookup "pkgroot" fields of + Nothing -> path + Just root -> T.replace "${pkgroot}" (unquote root) path + +-- | The module names in an @exposed-modules@ field. +moduleNames :: Text -> [Text] +moduleNames = go . filter (not . T.null) . concatMap (T.split (== ',')) . T.words + where + go = \case + (_ : "from" : _ : rest) -> go rest + (m : rest) | looksLikeModule m -> m : go rest + (_ : rest) -> go rest + [] -> [] + looksLikeModule m = case T.uncons m of + Just (c, _) -> c `elem` ['A' .. 'Z'] && not (T.any (== ':') m) + Nothing -> False + +-- | Split a record into its fields. +-- +-- A field is @name: value@, and its value continues onto any following +-- indented lines. +parseFields :: Text -> Map.Map Text Text +parseFields = Map.fromList . mapMaybe field . groups . T.lines + where + groups = \case + [] -> [] + (l : ls) + | isContinuation l -> groups ls + | otherwise -> + let (continued, rest) = span isContinuation ls + in (l : continued) : groups rest + isContinuation l = not (T.null l) && isSpace (T.head l) + + field [] = Nothing + field (l : rest) = case T.breakOn ":" l of + (key, value) + | not (T.null value) -> + Just (T.strip key, T.unwords (T.drop 1 value : map T.strip rest)) + _ -> Nothing diff --git a/src/Tilia/Fixity/Plan.hs b/src/Tilia/Fixity/Plan.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Fixity/Plan.hs @@ -0,0 +1,1937 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | "Tilia.Fixity" resolves a module's operators exactly, given a function +-- that says what each imported module exports. This is that function, built +-- from what the project itself is compiled against. +module Tilia.Fixity.Plan + ( -- * Build plans + PlanPackage (..), + PackageSource (..), + isFetchable, + sourceHashOf, + BuildPlan (..), + readBuildPlan, + planToken, + tokenFor, + macrosOf, + + -- * Readiness + Readiness (..), + PlanComponent (..), + spellComponent, + plannedComponents, + planPathFor, + checkReadiness, + plannedTarballs, + packageCacheRoot, + guessedPackageCacheRoot, + Solves (..), + forgetfulSolves, + prepareWith, + loadPlan, + + -- * Resolving + Route (..), + Resolver (..), + newResolver, + newResolverVia, + withReexports, + scopeFor, + ) +where + +import Codec.Archive.Tar qualified as Tar +import Codec.Compression.GZip qualified as GZip +import Control.Applicative ((<|>)) +import Control.Monad (filterM, foldM, join) +import Crypto.Hash.SHA256 qualified as SHA256 +import Data.Aeson + ( FromJSON (..), + Value, + decodeStrict, + eitherDecodeFileStrict, + withObject, + (.:), + (.:?), + ) +import Data.Aeson.Types (parseMaybe) +import Data.ByteString qualified as BS +import Data.ByteString.Base16 qualified as B16 +import Data.ByteString.Lazy qualified as BL +import Data.Choice (Choice, fromBool) +import Data.Foldable (toList, traverse_) +import Data.IORef +import Data.List (isSuffixOf) +import Data.List qualified +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.List.NonEmpty qualified as NE +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Maybe (catMaybes, fromMaybe, listToMaybe, mapMaybe) +import Data.Set (Set) +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import Data.Text.Read qualified as T +import GHC.Hs (HsModule) +import GHC.Hs.Extension (GhcPs) +import GHC.IO.Handle (hDuplicate) +import GHC.LanguageExtensions.Type (Extension (ImplicitPrelude)) +import System.Directory + ( XdgDirectory (XdgCache), + doesFileExist, + getAppUserDataDirectory, + getModificationTime, + getXdgDirectory, + listDirectory, + ) +import System.Environment (lookupEnv) +import System.Exit (ExitCode (..)) +import System.FilePath (takeDirectory, ()) +import System.IO (hFlush, stderr) +import System.Info qualified +import System.Process + ( StdStream (Inherit, UseHandle), + createProcess, + cwd, + proc, + std_err, + std_out, + waitForProcess, + ) +import Tilia.Cpp (branchLeaves, withoutRuledOut) +import Tilia.Cpp.Macros (Macros (..)) +import Tilia.Fixity +import Tilia.Fixity.Builtin (builtinFixities) +import Tilia.Fixity.ByHand (byHandFixities, hscFixities) +import Tilia.Fixity.Cabal + ( cabalFileAtTop, + cabalFileInArchive, + containedModules, + declaredExtensions, + entryPosixPath, + packageModules, + sourceDirs, + ) +import Tilia.Fixity.Cache +import Tilia.Fixity.Interface +import Tilia.Fixity.PackageDb +import Tilia.Package (newPackageReader) +import Tilia.Parser +import Tilia.Pragma (effectiveExtensions) +import Tilia.Process (readProgramOutput) +import Tilia.Utils (quietly) + +---------------------------------------------------------------------------- +-- The plan + +-- | One package of a build plan. +data PlanPackage = PlanPackage + { -- | Package name + ppName :: Text, + -- | Package version + ppVersion :: Text, + -- | Package source + ppSource :: PackageSource, + -- | Which components of the package the entry is about. + -- + -- Usually one, because @cabal@ configures a package one component at a + -- time and gives each its own entry. A package it cannot take apart—one + -- with a @Custom@ build type, whose @Setup.hs@ is entitled to do as it + -- pleases—is planned whole instead, and its entry is about every + -- component at once. Empty where the entry is about none of them. + ppComponents :: [Text] + } + deriving (Eq, Show) + +-- | Where a package's source is, if anywhere. +-- +-- A plan contains exactly three kinds of entry and they are mutually +-- exclusive, which two independent flags could not say: a package cannot be +-- both shipped with the compiler and fetched from Hackage. Each carries +-- what is peculiar to it and nothing else, so there is no hash to consult +-- on a package that has no tarball, and no tarball to look for on one that +-- is a directory. +data PackageSource + = -- | Already installed, so @cabal@ will not build it. + -- + -- Not the same as "ships with the compiler", though it includes those. + PreExisting + | -- | A directory on this machine—the project being formatted, or a + -- sibling of it in the same repository. + LocalPackage FilePath + | -- | Fetched from a repository as a tarball, with the SHA-256 the plan + -- expects it to have and where it was fetched from. + -- + -- Hackage is one such repository and not a special one. A company that + -- runs its own has packages here exactly as Hackage does, and the only + -- difference that reaches us is where the tarball landed. + RepoPackage (Maybe Text) Repository + | -- | A @source-repository-package@ we have not found the sources of. + -- + -- The plan says where the repository is, which is of no use: what is + -- wanted is where @cabal@ put the clone, and the plan does not say. A + -- package that stays this way is one nothing can be read from, which is + -- what every one of them was before 'checkedOutIn' went looking. + SourceRepo + | -- | The same, found unpacked under the project's own @dist-newstyle@. + -- + -- A directory of sources like 'LocalPackage', and read the same way. + -- Kept apart from it because a dependency is not one of the project's + -- own packages: its components are not components a run formats, and + -- its @.cabal@ file being newer than the plan says nothing about + -- whether the plan is stale. + CheckedOut FilePath + deriving (Eq, Show) + +-- | Which repository a package was fetched from, as far as it bears on +-- finding the tarball afterwards. +data Repository + = -- | One @cabal@ downloads from, named by its URI. The tarball goes into + -- the package cache, in a directory named after the repository as the + -- configuration spells it. + Downloaded Text + | -- | A directory of tarballs, named by @file+noindex@. Nothing is + -- downloaded and nothing is cached: the tarball is already sitting + -- there, beside the index @cabal@ wrote for it. + ADirectory FilePath + | -- | A plan that does not say. Older @cabal@ wrote nothing here, and + -- Hackage is the only guess worth making. + Unsaid + deriving (Eq, Show) + +-- | Is there a tarball to go and read? +isFetchable :: PlanPackage -> Bool +isFetchable p = case ppSource p of + RepoPackage _ _ -> True + _ -> False + +-- | Every package the compiler can see. +whatTheCompilerSees :: Maybe Cache -> IO [InstalledPackage] +whatTheCompilerSees cache = + remembered >>= \case + Just packages -> pure packages + Nothing -> do + found <- readInstalledPackages + traverse_ (`storeInstalled` found) cache + pure (installedPackages found) + where + remembered = maybe (pure Nothing) cachedInstalled cache + +-- | Summarize a 'BuildPlan', and the environment it will be read in, by +-- hashing over both. +-- +-- The plan alone would not do. What a failure to read a module leans on is +-- partly the plan and partly the compiler this run can ask: a package the +-- plan names is unreadable where @ghc-pkg@ does not expose it and readable +-- where it does, and one shell can differ from another in that while +-- solving the very same plan. Tying failures to the plan alone would let +-- one shell's \"could not be read\" be handed to a shell that can. +tokenFor :: BuildPlan -> IO PlanToken +tokenFor plan = flip planToken plan <$> compilerIdentity + +-- | 'tokenFor' without the asking, so that what goes into the token is +-- visible in one place. +planToken :: Text -> BuildPlan -> PlanToken +planToken environment plan = + PlanToken + . T.take 16 + . T.decodeUtf8Lenient + . B16.encode + . SHA256.hash + . T.encodeUtf8 + $ T.intercalate + "\n" + (environment : bpCompiler plan : Data.List.sort (map cacheKey (bpPackages plan))) + +-- | The SHA-256 the plan expects this package's tarball to have. +sourceHashOf :: PlanPackage -> Maybe Text +sourceHashOf p = case ppSource p of + RepoPackage hash _ -> hash + _ -> Nothing + +-- | A resolved build plan. +data BuildPlan = BuildPlan + { bpCompiler :: Text, + bpPackages :: [PlanPackage] + } + deriving (Eq, Show) + +instance FromJSON BuildPlan where + parseJSON = withObject "BuildPlan" $ \o -> + BuildPlan + <$> o .: "compiler-id" + <*> o .: "install-plan" + +instance FromJSON PlanPackage where + parseJSON = withObject "PlanPackage" $ \o -> do + name <- o .: "pkg-name" + version <- o .: "pkg-version" + kind <- o .:? "type" + sourceKind <- o .:? "pkg-src" >>= traverse (.: "type") + sourcePath <- o .:? "pkg-src" >>= traverse (.:? "path") + sourceHash <- o .:? "pkg-src-sha256" + repo <- o .:? "pkg-src" >>= traverse (.:? "repo") + repoKind <- traverse (traverse (.:? "type")) repo + repoUri <- traverse (traverse (.:? "uri")) repo + repoPath <- traverse (traverse (.:? "path")) repo + named <- o .:? "component-name" + whole <- o .:? "components" + pure + PlanPackage + { ppName = name, + ppVersion = version, + ppComponents = componentsOf named whole, + ppSource = case (kind :: Maybe Text, sourceKind :: Maybe Text) of + (Just "pre-existing", _) -> PreExisting + (_, Just "repo-tar") -> + RepoPackage + sourceHash + ( case (join (join repoKind) :: Maybe Text, join (join repoPath), join (join repoUri)) of + (Just "local-repo-no-index", Just dir, _) -> ADirectory (T.unpack dir) + (_, _, Just uri) -> Downloaded uri + _ -> Unsaid + ) + (_, Just "local") -> LocalPackage (maybe "" T.unpack (join sourcePath)) + (_, Just "source-repo") -> SourceRepo + -- Anything else is treated as already present. + _ -> PreExisting + } + +-- | The components one plan entry is about. +-- +-- @cabal@ writes this two ways. An entry for a single component names it in +-- @component-name@; an entry for a package planned whole carries a +-- @components@ object instead, keyed by the very same spellings. Reading +-- only the first would leave every @Custom@ package looking like one the +-- plan says nothing about, and a run would keep asking @cabal@ to solve +-- again for components a fresh solve would file exactly where this one did. +-- +-- @setup@ is dropped. It is the @Setup.hs@ program @cabal@ builds in order +-- to build the package, not a component of the package, and nothing in the +-- project will ever be formatted as part of it. +componentsOf :: Maybe Text -> Maybe (Map Text Value) -> [Text] +componentsOf named whole = case named of + Just component -> [component] + Nothing -> filter (/= "setup") (Map.keys (fromMaybe Map.empty whole)) + +-- | Read @plan.json@. +readBuildPlan :: FilePath -> IO (Either Text BuildPlan) +readBuildPlan path = + doesFileExist path >>= \case + False -> pure (Left ("no build plan at " <> T.pack path)) + True -> + eitherDecodeFileStrict path >>= \case + Left why -> pure (Left (T.pack why)) + Right plan -> Right <$> checkedOutIn (takeDirectory (takeDirectory path)) plan + +-- | Find where @cabal@ unpacked each @source-repository-package@. +checkedOutIn :: FilePath -> BuildPlan -> IO BuildPlan +checkedOutIn distDir plan = do + packages <- traverse locate (bpPackages plan) + pure plan {bpPackages = packages} + where + locate p = case ppSource p of + SourceRepo -> + clonesOf p >>= \case + (dir : _) -> pure p {ppSource = CheckedOut dir} + [] -> pure p + _ -> pure p + clonesOf p = quietly [] $ do + entries <- listDirectory (distDir "src") + filterM + (isThePackage p) + [ distDir "src" e + | e <- Data.List.sort entries, + (ppName p <> "-") `T.isPrefixOf` T.pack e + ] + isThePackage p dir = quietly False $ do + contents <- readFileText (dir T.unpack (ppName p) <> ".cabal") + pure (maybe False (describes p) contents) + describes p text = + any (names "name:" (ppName p)) (T.lines text) + && any (names "version:" (ppVersion p)) (T.lines text) + names field value line = case T.stripPrefix field (T.toLower (T.strip line)) of + Just rest -> T.strip rest == T.toLower value + Nothing -> False + +-- | The version macros a plan settles. +macrosOf :: BuildPlan -> Macros +macrosOf plan = + Macros + { macroVersions = + Map.fromList + ( [ ("MIN_VERSION_" <> underscored name, version) + | (name, [version]) <- Map.toList (Map.map Set.toList versions) + ] + <> [("MIN_VERSION_GLASGOW_HASKELL", v) | v <- toList compiler] + ), + macroNumbers = + Map.fromList + [ entry + | (major : minor : patches) <- toList compiler, + entry <- + [ ("__GLASGOW_HASKELL__", major * 100 + minor), + ("__GLASGOW_HASKELL_PATCHLEVEL1__", nth 0 patches), + ("__GLASGOW_HASKELL_PATCHLEVEL2__", nth 1 patches) + ] + ] + } + where + versions = + Map.fromListWith + Set.union + [ (ppName p, Set.singleton v) + | p <- bpPackages plan, + Just v <- [numberedVersion (ppVersion p)] + ] + compiler = do + version <- T.stripPrefix "ghc-" (bpCompiler plan) + parts <- numberedVersion version + case parts of + _ : _ : _ -> Just (take 4 (parts <> repeat 0)) + _ -> Nothing + nth i xs = if i < length xs then xs !! i else 0 + +-- | The modules @cabal@ writes itself for a plan's packages, and which are +-- therefore in nobody's sources. +generatedModules :: BuildPlan -> Set Text +generatedModules plan = + Set.fromList + [ prefix <> underscored (ppName p) + | p <- bpPackages plan, + prefix <- ["Paths_", "PackageInfo_"] + ] + +-- | A package's name as a module name spells it, which is with the hyphens +-- turned into underscores. @cabal@ does this for the version macros and for +-- the modules it generates alike. +underscored :: Text -> Text +underscored = T.map (\c -> if c == '-' then '_' else c) + +-- | A version as its numbers, or 'Nothing' where any of them is not one. +numberedVersion :: Text -> Maybe [Integer] +numberedVersion = traverse number . T.splitOn "." + where + number part = case T.decimal part of + Right (n, rest) | T.null rest -> Just n + _ -> Nothing + +---------------------------------------------------------------------------- +-- Readiness + +-- | A component of the project, named the way a build plan names one. +data PlanComponent = PlanComponent + { -- | The package it belongs to. + pcPackage :: Text, + -- | @lib@, @exe:name@, @test:name@, @bench:name@. + pcName :: Text + } + deriving (Eq, Ord, Show) + +-- | A component as it would be written on the command line. +spellComponent :: PlanComponent -> Text +spellComponent c = pcPackage c <> ":" <> pcName c + +-- | The components of the project's own packages that a plan covers. +plannedComponents :: BuildPlan -> [PlanComponent] +plannedComponents plan = + [ PlanComponent (ppName p) component + | p <- bpPackages plan, + LocalPackage _ <- [ppSource p], + component <- ppComponents p + ] + +-- | Whether everything the resolver needs is on disk. +data Readiness + = -- | Nothing to do. + Ready + | -- | No build plan; @cabal@ has not solved this project yet. + PlanMissing + | -- | The plan is older than the files that determine it. + PlanStale [FilePath] + | -- | The plan says nothing about components the run is about to format. + PlanNarrow [Text] + | -- | The plan is there, and some packages have neither been downloaded + -- nor built. The names are listed so that a caller can say what it is + -- waiting for. + -- + -- Built counts as having them: their interfaces answer everything the + -- source would have been read for, so a package the compiler already + -- holds is not missing however absent its tarball is. + SourcesMissing [Text] + deriving (Eq, Show) + +-- | Where @cabal@ writes the plan for a project. +planPathFor :: FilePath -> FilePath +planPathFor projectDir = projectDir "dist-newstyle" "cache" "plan.json" + +-- | Check what is missing, cheaply. +-- +-- One read of the plan and one @stat@ per package, so this is fast enough +-- to run before every format without anyone noticing. +checkReadiness :: [PlanComponent] -> FilePath -> IO Readiness +checkReadiness wanted projectDir = + readBuildPlan (planPathFor projectDir) >>= \case + Left _ -> pure PlanMissing + Right plan -> do + newer <- filesNewerThanPlan plan projectDir + let covered = plannedComponents plan + missing = [spellComponent c | c <- wanted, c `notElem` covered] + case (newer, missing) of + (_ : _, _) -> pure (PlanStale newer) + ([], _ : _) -> pure (PlanNarrow missing) + ([], []) -> + sourcesShortOf plan >>= \case + [] -> pure Ready + ns -> pure (SourcesMissing ns) + +-- | The packages the plan expects to fetch whose sources are not here. +-- +-- Asked apart from the rest of 'checkReadiness' because it is a different +-- question with a different answer. Whether the plan covers the components +-- a run is about to format is about the plan; whether the sources it names +-- are on this machine is about the machine, and a plan that will never +-- cover everything—one component of the project does not build, and the +-- solver leaves it out—must not stop the sources for the rest being +-- fetched. +sourcesShortOf :: BuildPlan -> IO [Text] +sourcesShortOf plan = do + tarballs <- filter (isFetchable . fst) <$> plannedTarballs plan + absent <- map fst <$> filterM (fmap not . doesFileExist . snd) tarballs + short <- + if null absent + then pure [] + else do + cache <- openCache =<< tokenFor plan + installed <- whatTheCompilerSees cache + pure (filter (not . builtAlready installed) absent) + pure (map ppName short) + +-- | Has the compiler got this package already? +builtAlready :: [InstalledPackage] -> PlanPackage -> Bool +builtAlready installed p = any matches installed + where + matches i = ipName i == ppName p && ipVersion i == ppVersion p + +-- | The project files that have changed since the plan was written. +-- +-- A plan describes the dependencies as they were when @cabal@ last solved. +-- Edit a @build-depends@ and the plan on disk is about a different project, +-- and resolving fixities against it would answer for packages that are no +-- longer in play. Comparing modification times is one @stat@ each, so this +-- costs nothing to check every time. +filesNewerThanPlan :: BuildPlan -> FilePath -> IO [FilePath] +filesNewerThanPlan plan projectDir = quietly [] $ do + planTime <- getModificationTime (planPathFor projectDir) + atRoot <- quietly [] (listDirectory projectDir) + inPackages <- concat <$> traverse cabalFilesIn (localDirs plan) + let candidates = + [projectDir f | f <- atRoot, f `elem` projectFiles] + <> [projectDir f | f <- atRoot, ".cabal" `isSuffixOf` f] + <> inPackages + newer <- traverse (isNewerThan planTime) candidates + pure [f | Just f <- newer] + where + projectFiles = + ["cabal.project", "cabal.project.local", "cabal.project.freeze"] + localDirs p = + Data.List.nub [dir | LocalPackage dir <- map ppSource (bpPackages p)] + cabalFilesIn dir = quietly [] $ do + entries <- listDirectory dir + pure [dir f | f <- entries, ".cabal" `isSuffixOf` f] + isNewerThan planTime path = quietly Nothing $ do + t <- getModificationTime path + pure (if t > planTime then Just path else Nothing) + +-- | Do whatever is missing, by asking @cabal@. +-- +-- Neither of these builds anything: a dry run only solves, and +-- @--only-download@ only fetches. Both are one-time costs, and @cabal@'s +-- package cache is shared between projects, so a machine that has seen a +-- dependency once never fetches it again. +-- +-- This runs a subprocess and may reach the network, so it is a separate +-- call rather than something 'newResolver' does behind the caller's back. +-- An editor formatting on save must not block on it. +prepare :: [PlanComponent] -> FilePath -> Readiness -> IO (Either Text ()) +prepare wanted projectDir readiness = + prepareWith (runCabal projectDir) (solvesFor projectDir) wanted projectDir readiness + +-- | What a run knows about the asking earlier runs did, and how to add to +-- it. +-- +-- Both halves are the same idea: @cabal@ was asked for something, it did +-- not help, and asking again will not help either. A run that formats on +-- save would otherwise ask on every save. +data Solves = Solves + { -- | Has solving this plan already been tried and left it as narrow? + solveWasFutile :: IO Bool, + -- | Remember that it has. + rememberFutileSolve :: IO (), + -- | The packages an earlier fetch was still short of afterwards. + fetchWasFutileFor :: IO [Text], + -- | Remember what a fetch left missing. + rememberFutileFetch :: [Text] -> IO () + } + +-- | Solves remembered nowhere, for a caller with nothing to remember them +-- in. +forgetfulSolves :: Solves +forgetfulSolves = + Solves + { solveWasFutile = pure False, + rememberFutileSolve = pure (), + fetchWasFutileFor = pure [], + rememberFutileFetch = const (pure ()) + } + +-- | Solves remembered in the cache, under the plan the project has now. +-- +-- A project with no readable plan has no token to file anything under, and +-- nothing to remember either: a solve is exactly what it needs. +solvesFor :: FilePath -> Solves +solvesFor projectDir = + Solves + { solveWasFutile = withCache False cachedFutileSolve, + rememberFutileSolve = withCache () storeFutileSolve, + fetchWasFutileFor = withCache [] cachedFutileFetch, + rememberFutileFetch = \packages -> withCache () (`storeFutileFetch` packages) + } + where + withCache fallback use = + readBuildPlan (planPathFor projectDir) >>= \case + Left _ -> pure fallback + Right plan -> do + opened <- openCache =<< tokenFor plan + maybe (pure fallback) use opened + +-- | 'prepare', given a way to run @cabal@ and a memory of earlier solves. +prepareWith :: + -- | Run @cabal@ with these arguments + ([String] -> IO (Either Text ())) -> + -- | What is known about solves already asked for + Solves -> + -- | The components the run is about to format + [PlanComponent] -> + -- | The project being prepared + FilePath -> + -- | What it was found to be short of + Readiness -> + IO (Either Text ()) +prepareWith cabal solves wanted projectDir = \case + Ready -> pure (Right ()) + SourcesMissing _ -> fetch + PlanMissing -> solveThenFetch + PlanStale _ -> solveThenFetch + PlanNarrow _ -> + solveWasFutile solves >>= \case + True -> fetchWhatIsShort + False -> solveThenFetch + where + wholeProject = ["--enable-tests", "--enable-benchmarks"] + tryWholeProject args = + cabal (args <> wholeProject) >>= \case + Right () -> pure (Right ()) + Left _ -> cabal args + fetch = tryWholeProject ["build", "all", "--only-download"] + fetchWhatIsShort = + readBuildPlan (planPathFor projectDir) >>= \case + Left _ -> pure (Right ()) + Right plan -> do + short <- sourcesShortOf plan + refused <- fetchWasFutileFor solves + if null short || all (`elem` refused) short + then pure (Right ()) + else + fetch >>= \case + Left err -> pure (Left err) + Right () -> do + left <- sourcesShortOf plan + rememberFutileFetch solves left + pure (Right ()) + solveThenFetch = + tryWholeProject ["build", "all", "--dry-run"] >>= \case + Left err -> pure (Left err) + Right () -> + checkReadiness wanted projectDir >>= \case + SourcesMissing _ -> fetch + PlanNarrow _ -> rememberFutileSolve solves >> fetchWhatIsShort + _ -> pure (Right ()) + +-- | Run @cabal@ in a project directory, letting it speak for itself. +runCabal :: FilePath -> [String] -> IO (Either Text ()) +runCabal projectDir args = quietly (Left "could not run cabal") $ do + hFlush stderr + -- A duplicate because 'createProcess' closes the handle it is given once + -- the child has it, and closing the real standard error would leave + -- nothing to report the failure on. + passed <- hDuplicate stderr + (_, _, _, running) <- + createProcess + (proc "cabal" args) + { cwd = Just projectDir, + std_out = UseHandle passed, + std_err = Inherit + } + code <- waitForProcess running + pure $ case code of + ExitSuccess -> Right () + _ -> Left ("cabal " <> T.unwords (map T.pack args) <> " failed; see above") + +-- | Get a plan that is safe to use, doing whatever @cabal@ work is needed. +-- +-- This is the call most users want. It checks, asks @cabal@ if anything is +-- missing or possibly out of date, and then reads the plan. 'prepare' does +-- at most one solve and one fetch however much is missing, so a project +-- whose files are merely newer than its plan cannot send this into a loop, +-- and the plan is read once at the end rather than judged again. +loadPlan :: [PlanComponent] -> FilePath -> IO (Either Text BuildPlan) +loadPlan wanted projectDir = do + readiness <- checkReadiness wanted projectDir + prepare wanted projectDir readiness >>= \case + Left err -> pure (Left err) + _ -> readBuildPlan (planPathFor projectDir) + +-- | Every planned package whose source could be in the package cache, with +-- where that would be. +-- +-- Not only the ones the plan will fetch. A package already installed still +-- has a tarball in the cache if anything ever downloaded it, and under Nix +-- that is the normal case for every dependency. A package with no tarball +-- costs one @stat@ and falls through. +-- +-- Local packages are excluded: they are directories, not archives. +plannedTarballs :: BuildPlan -> IO [(PlanPackage, FilePath)] +plannedTarballs plan = do + cacheRoot <- packageCacheRoot + -- Listed once rather than once per package: a plan holds hundreds of + -- these and the answer is the same for every one of them. + repos <- quietly [] (Data.List.sort <$> listDirectory cacheRoot) + traverse + (\p -> (,) p <$> tarballFor cacheRoot repos p) + [p | p <- bpPackages plan, not (isLocal p)] + where + isLocal p = case ppSource p of + LocalPackage _ -> True + CheckedOut _ -> True + _ -> False + +-- | Where @cabal@ keeps downloaded package sources, one directory per +-- repository it downloads from. +packageCacheRoot :: IO FilePath +packageCacheRoot = + readProgramOutput "cabal" ["path", "--remote-repo-cache", "--output-format=json"] >>= \case + Just said | Just dir <- remoteRepoCacheIn said -> pure dir + _ -> guessedPackageCacheRoot + +-- | The package cache directory, out of what @cabal path@ printed. +remoteRepoCacheIn :: Text -> Maybe FilePath +remoteRepoCacheIn said = do + spoken <- listToMaybe (reverse (filter (not . T.null) (map T.strip (T.lines said)))) + value <- decodeStrict (T.encodeUtf8 spoken) + parseMaybe (withObject "cabal path" (.: "remote-repo-cache")) value + +-- | Where @cabal@ probably keeps them, for a @cabal@ that will not say. +guessedPackageCacheRoot :: IO FilePath +guessedPackageCacheRoot = + lookupEnv "CABAL_DIR" >>= \case + Just dir -> pure (dir "packages") + Nothing -> do + places <- cabalDirs + found <- filterM holdsAnIndex (toList places) + pure (fromMaybe (NE.head places) (listToMaybe found)) + where + holdsAnIndex dir = + quietly False (doesFileExist (dir hackage "01-index.tar")) + hackage = "hackage.haskell.org" + +-- | Every directory @cabal@ could be keeping a package cache in, the +-- platform's own default first. +cabalDirs :: IO (NonEmpty FilePath) +cabalDirs = do + appData <- getAppUserDataDirectory "cabal" + xdg <- quietly Nothing (Just <$> getXdgDirectory XdgCache "cabal") + pure . fmap ( "packages") $ case xdg of + Just dir | not onWindows -> dir :| [appData] + Just dir -> appData :| [dir] + Nothing -> appData :| [] + +-- | Whether this is a Windows build, for the places that differ there. +onWindows :: Bool +onWindows = System.Info.os == "mingw32" + +-- | The repository @cabal@ would have kept a package's sources under. +hackageByDefault :: FilePath +hackageByDefault = "hackage.haskell.org" + +-- | Where a package's source tarball is, or where fetching would put it. +tarballFor :: FilePath -> [FilePath] -> PlanPackage -> IO FilePath +tarballFor cacheRoot repos p = case repositoryOf p of + ADirectory dir -> pure (dir flat) + Downloaded uri -> searched (hostOf uri) + Unsaid -> searched Nothing + where + flat = T.unpack (ppName p <> "-" <> ppVersion p <> ".tar.gz") + under repo = + cacheRoot repo T.unpack (ppName p) T.unpack (ppVersion p) flat + searched preferred = do + let first' = fromMaybe hackageByDefault preferred + rest = filter (/= first') repos + found <- filterM doesFileExist (map under (first' : rest)) + pure (fromMaybe (under first') (listToMaybe found)) + +-- | Which repository a package came from, where it came from one. +repositoryOf :: PlanPackage -> Repository +repositoryOf p = case ppSource p of + RepoPackage _ repo -> repo + _ -> Unsaid + +-- | The host a URI names, which is what @cabal@ conventionally calls the +-- repository that lives there. +hostOf :: Text -> Maybe FilePath +hostOf uri = case T.breakOn "//" uri of + (_, rest) + | not (T.null rest), + host <- T.takeWhile (/= '/') (T.drop 2 rest), + not (T.null host) -> + Just (T.unpack host) + _ -> Nothing + +---------------------------------------------------------------------------- +-- Resolving + +-- | Where a module's fixities can be read from. +data Route + = -- | The compiled interface the package database points at. Cheap, and + -- authoritative where it exists, since it is the compiler's own account + -- of what it settled on. + FromInterface + | -- | The module's source, out of the package's tarball in Cabal's + -- package cache. Slower, and the only route for a package that is + -- planned but not built. + FromSource + deriving (Eq, Show) + +-- | What can be asked about a module, once a plan says where to look. +-- +-- The three questions "Tilia.Fixity" has, answered against the outside +-- world. They come back together because they share everything—the module +-- index, the cache, the packages the compiler holds, the memo of what has +-- been read—and answering them apart would settle all of it three times. +data Resolver = Resolver + { -- | What a module exports, with 'Nothing' for one that could not be + -- read, which is not the same as its having no operators; see + -- 'Tilia.Fixity.resolveScope' for why the difference has to survive. + askFixities :: Text -> IO (Maybe (Fixities)), + -- | What a module keeps under each of its names, for the sake of a + -- @T(..)@ in an import list. + askChildren :: Text -> IO (Map OpName (Set OpName)), + -- | The operators an unread module's export list names, asked only of + -- the modules 'askFixities' gave up on, and what keeps a module that + -- plainly has no such operator from being blamed for one. + askExportNames :: Text -> IO (Maybe (Set OpName)), + -- | The modules reading a module went through before giving up, the one + -- it gave up on last. Asked only of the modules 'askFixities' gave up + -- on, and only so that a message can name the module really in the way + -- rather than the import that happens to sit above it. + askChain :: Text -> IO [Text] + } + +-- | Build the answers to what "Tilia.Fixity" asks. +-- +-- Answers are remembered on disk between runs by "Tilia.Fixity.Cache", so a +-- package is decompressed and parsed once per machine rather than once per +-- file. +newResolver :: + -- | The build plan to use + BuildPlan -> + IO Resolver +newResolver = newResolverVia [FromInterface, FromSource] + +-- | 'newResolver', restricted to the routes given. +newResolverVia :: + -- | Which readings to try, in order + [Route] -> + -- | The build plan to use + BuildPlan -> + IO Resolver +newResolverVia routes plan = do + tarballs <- plannedTarballs plan + cache <- openCache =<< tokenFor plan + installed <- whatTheCompilerSees cache + index <- buildModuleIndex cache installed tarballs + let interfaces = interfaceIndex installed + local <- localModules plan + memo <- newIORef Map.empty + childrenRead <- newIORef Map.empty + askPackage <- newPackageReader + extensionsRead <- newIORef Map.empty + exportsRead <- newIORef Map.empty + interfacesRead <- newIORef Map.empty + let interfaceOf modName = do + seen <- readIORef interfacesRead + case Map.lookup modName seen of + Just interface -> pure interface + Nothing -> do + found <- case Map.lookup modName interfaces of + Nothing -> pure Nothing + Just (_, path) -> readInterface modName path + -- Being listed is not the same as being readable: @ghc-pkg@ + -- names @GHC.Prim@ among @ghc-prim@'s modules and there is no + -- file at the path that implies. So the table answers for a + -- module with nothing to read, however it came to have nothing. + let interface = case found of + Just _ -> found + Nothing -> asInterface <$> Map.lookup modName builtinFixities + atomicModifyIORef' interfacesRead (\m -> (Map.insert modName interface m, ())) + pure interface + let workings = + Workings + { wkRoutes = routes, + wkCache = cache, + wkLocal = local, + wkIndex = index, + wkInterfaces = interfaces, + wkInterfaceOf = interfaceOf, + wkReach = reach, + wkReachChildren = children, + wkReachExports = exports, + wkExtensionsOf = extensionsOf, + wkMacros = macrosOf plan, + wkGenerated = generatedModules plan + } + resolved visiting modName = do + known <- readIORef memo + case Map.lookup modName known of + Just answer -> pure answer + Nothing -> do + answer <- resolveModule workings visiting modName + atomicModifyIORef' memo (\m -> (Map.insert modName answer m, ())) + pure answer + reach visiting modName + | modName `Set.member` visiting = pure Nothing + | otherwise = fixitiesEstablished <$> resolved visiting modName + chain visiting = go Set.empty + where + go seen modName + | modName `Set.member` seen = pure [] + | otherwise = + resolved visiting modName >>= \case + Unreadable (Just below) -> + (below :) <$> go (Set.insert modName seen) below + _ -> pure [] + exports visiting modName + | modName `Set.member` visiting = pure Nothing + | otherwise = do + seen <- readIORef exportsRead + case Map.lookup modName seen of + Just names -> pure names + Nothing -> do + names <- exportNamesOfModule workings visiting modName + atomicModifyIORef' exportsRead (\m -> (Map.insert modName names m, ())) + pure names + extensionsOf modName + | Just path <- Map.lookup modName local = + either (const []) id <$> askPackage path + | Just (package, tarball) <- Map.lookup modName index = do + seen <- readIORef extensionsRead + case Map.lookup package seen of + Just extensions -> pure extensions + Nothing -> do + extensions <- fromTarball tarball + atomicModifyIORef' extensionsRead (\m -> (Map.insert package extensions m, ())) + pure extensions + | otherwise = pure [] + fromTarball tarball = + quietly [] $ do + bytes <- BL.readFile tarball + pure (foldMap declaredExtensions (cabalFileInArchive (Tar.read (GZip.decompress bytes)))) + children visiting modName + | modName `Set.member` visiting = pure Map.empty + | otherwise = do + seen <- readIORef childrenRead + case Map.lookup modName seen of + Just kept -> pure kept + Nothing -> do + kept <- childrenOfModule workings visiting modName + atomicModifyIORef' childrenRead (\m -> (Map.insert modName kept m, ())) + pure kept + pure + Resolver + { askFixities = reach Set.empty, + askChildren = children Set.empty, + askExportNames = exports Set.empty, + askChain = chain Set.empty + } + +-- | The operators a module's export list names, where that list can be +-- enumerated without reading what it passes on. +-- +-- Asked only about modules whose fixities could not be established, and +-- only to decide which of them an unsettled operator can be blamed on. A +-- module that exports whole modules keeps its own counsel and answers +-- 'Nothing'; one with no export list exports what it declares, which is +-- every fixity it could supply. +exportNamesOfModule :: Workings -> Set Text -> Text -> IO (Maybe (Set OpName)) +exportNamesOfModule + Workings {wkCache, wkLocal, wkIndex, wkReachChildren, wkReachExports, wkMacros} + visiting + modName + | Just path <- Map.lookup modName wkLocal, + writtenForHsc path = + pure (Just (hscSupplies modName)) + | Just path <- Map.lookup modName wkLocal = namesIn =<< readFileText path + | Just (package, tarball) <- Map.lookup modName wkIndex = + remembered package >>= \case + Just answer -> pure (exportedNames answer) + Nothing -> + readModule tarball modName >>= \case + Nothing -> pure Nothing + Just ForHsc -> do + let names = Just (hscSupplies modName) + store package (asExported names) + pure names + Just (Haskell text) -> do + names <- namesIn (Just text) + store package (asExported names) + pure names + | otherwise = pure Nothing + where + remembered package = case wkCache of + Nothing -> pure Nothing + Just c -> cachedExportNames c package modName + store package answer = case wkCache of + Nothing -> pure () + Just c -> storeExportNames c package modName answer + namesIn text = case parsedLeaves =<< text of + Nothing -> pure Nothing + Just modules -> + fmap Set.unions . sequence <$> traverse readOne modules + readOne (implicitPrelude, hsModule) = + exportNamesWithReexports + implicitPrelude + (wkReachExports visiting') + (wkReachChildren visiting') + modName + hsModule + visiting' = Set.insert modName visiting + parsedLeaves = configurationsOf wkMacros Nothing modName + +-- | What a module keeps under each of its names, so that a @T(..)@ in an +-- import list can be told what it brings in. +childrenOfModule :: Workings -> Set Text -> Text -> IO (Map OpName (Set OpName)) +childrenOfModule + Workings + { wkRoutes, + wkCache, + wkLocal, + wkIndex, + wkInterfaces, + wkInterfaceOf, + wkReachChildren, + wkExtensionsOf, + wkMacros + } + visiting + modName + | Just path <- Map.lookup modName wkLocal, + writtenForHsc path = + pure Map.empty + | Just path <- Map.lookup modName wkLocal = + readFileText path >>= \case + Nothing -> pure Map.empty + Just text -> inSource text + | otherwise = firstAnswer (map taking wkRoutes) + where + taking = \case + FromInterface -> case Map.lookup modName wkInterfaces of + Nothing -> pure Nothing + Just (key, _) -> keptUnder key outOfInterface + FromSource -> case Map.lookup modName wkIndex of + Nothing -> pure Nothing + Just (package, tarball) -> + keptUnder package $ + readModule tarball modName >>= \case + Nothing -> pure Nothing + Just ForHsc -> pure (Just Map.empty) + Just (Haskell text) -> Just <$> inSource text + firstAnswer [] = pure Map.empty + firstAnswer (route : rest) = + route >>= \case + Just kept -> pure kept + Nothing -> firstAnswer rest + keptUnder package readIt = + remembered package >>= \case + Just kept -> pure (Just kept) + Nothing -> do + kept <- readIt + traverse_ (store package) kept + pure kept + remembered package = case wkCache of + Nothing -> pure Nothing + Just c -> cachedChildren c package modName + store package kept = case wkCache of + Nothing -> pure () + Just c -> storeChildren c package modName kept + outOfInterface = fmap interfaceChildren <$> wkInterfaceOf modName + inSource text = do + extensions <- wkExtensionsOf modName + case parsedLeaves extensions text of + Nothing -> pure Map.empty + Just modules -> + Map.unionsWith Set.union + <$> traverse readOne modules + readOne (implicitPrelude, hsModule) = + childrenWithReexports + implicitPrelude + (wkReachChildren visiting') + modName + hsModule + visiting' = Set.insert modName visiting + parsedLeaves extensions = configurationsOf wkMacros (Just extensions) modName + +-- | Work out what a module can see, using a resolver to reach its imports. +-- +-- This is the join between the pure half of "Tilia.Fixity" and the half +-- that touches the disk: the imports are resolved first, and the scope is +-- then computed from the answers. Note that an import the resolver could +-- not read arrives as 'Nothing' and stays 'Nothing', which is what lets +-- 'Tilia.Fixity.lookupFixity' distinguish a conclusion from a guess. +scopeFor :: + -- | What can be asked about the modules it imports + Resolver -> + -- | Whether @ImplicitPrelude@ is on, which the module's own pragmas + -- and its package's @default-extensions@ decide between them + Choice "implicitPrelude" -> + -- | The module whose scope is wanted, already parsed + HsModule GhcPs -> + -- | Everything that module can see, and what it could not find out + IO Scope +scopeFor resolver implicitPrelude hsModule = do + let imports = moduleImports implicitPrelude hsModule + answers <- traverse (\m -> (m,) <$> askFixities resolver m) (map importModule imports) + let table = Map.fromList answers + unread = [m | (m, Nothing) <- answers] + names <- Map.fromList <$> traverse (\m -> (m,) <$> askExportNames resolver m) unread + chains <- Map.fromList <$> traverse (\m -> (m,) <$> askChain resolver m) unread + kept <- + Map.fromList + <$> traverse + (\m -> (m,) <$> askChildren resolver m) + (Set.toList (Set.fromList (map importModule (filter expands imports)))) + pure $ + resolveScope + implicitPrelude + Known + { knownFixities = \m -> Map.findWithDefault Nothing m table, + knownChildren = \m -> Map.findWithDefault Map.empty m kept, + knownExportNames = \m -> Map.findWithDefault Nothing m names, + knownChain = \m -> Map.findWithDefault [] m chains + } + hsModule + where + expands i = case importNames i of + Nothing -> False + Just (_, items) -> any isAll items + isAll = \case + ImportedAll _ -> True + _ -> False + +-- | Everything a resolver consults, and the way back into it. +-- +-- None of it changes from one module to the next, which is why +-- 'newResolverVia' builds it once and hands it over whole. What comes back +-- out of that is the 'Resolver'; this is what is behind it. +data Workings = Workings + { -- | Which readings to try, in the order given. + wkRoutes :: [Route], + -- | Where to remember answers between runs. + wkCache :: Maybe Cache, + -- | The modules of the project's own packages, which are read straight + -- from disk rather than out of an archive. + wkLocal :: Map Text FilePath, + -- | Which package holds each module, and the tarball to find it in; the + -- package is the cache key, which carries the hash the tarball was + -- verified against. + wkIndex :: Map Text (Text, FilePath), + -- | What to file an answer read out of each module's interface under. + wkInterfaces :: Map Text (Text, FilePath), + -- | A module's interface, read at most once a run. + wkInterfaceOf :: Text -> IO (Maybe Interface), + -- | How to reach another module. Tied back on itself by + -- 'newResolverVia', so that the memo it keeps covers the recursive + -- calls too. + wkReach :: Set Text -> Text -> IO (Maybe (Fixities)), + -- | How to reach another module for what its names carry with them, + -- tied back the same way and against a visiting set of its own. + wkReachChildren :: Set Text -> Text -> IO (Map OpName (Set OpName)), + -- | How to reach another module for what its export list names, tied + -- back the same way again. + wkReachExports :: Set Text -> Text -> IO (Maybe (Set OpName)), + -- | What the package a module belongs to puts in force. A module that + -- leans on its package's @default-extensions@ does not parse without + -- them, and one that does not parse cannot be read for anything. + wkExtensionsOf :: Text -> IO [Extension], + -- | What the plan settles about the questions a module's conditionals + -- ask, so that a branch written for another version of a dependency is + -- not read as part of it. + wkMacros :: Macros, + -- | The modules @cabal@ writes itself, which are therefore in no + -- package's sources. See 'generatedModules'. + wkGenerated :: Set Text + } + +-- | Where a module's fixities come from, in order of cost. +resolveModule :: + -- | Where to look, and how to get back to the resolver. + Workings -> + -- | Modules currently being resolved further up the call chain. + -- + -- Only passed through, so that a chase started here carries where it came + -- from. What is done about a module already in it belongs to + -- 'newResolverVia', which decides it before anything is remembered. + Set Text -> + -- | The module to resolve. + Text -> + -- | Its operator fixities, or, where they could not be established, the + -- module below it that stopped us if there was one. + IO Established +resolveModule + Workings + { wkRoutes, + wkCache, + wkLocal, + wkIndex, + wkInterfaces, + wkInterfaceOf, + wkReach, + wkReachChildren, + wkExtensionsOf, + wkMacros, + wkGenerated + } + visiting + modName + | Just builtin <- Map.lookup modName builtinFixities = pure (Declares builtin) + | Just path <- Map.lookup modName wkLocal, + writtenForHsc path = + pure (hscDeclares modName) + | Just path <- Map.lookup modName wkLocal = + readFileText path >>= \case + Nothing -> pure (Unreadable Nothing) + Just source -> do + extensions <- wkExtensionsOf modName + fromText + wkMacros + extensions + (wkReach visiting') + (wkReachChildren visiting') + visiting' + source + modName + | otherwise = answered <$> firstAnswer (map taking wkRoutes) + where + visiting' = Set.insert modName visiting + + taking = \case + FromInterface -> viaInterface + FromSource -> viaArchive + + firstAnswer = go Nothing + where + go blamed [] = pure (Unreadable blamed) + go blamed (route : rest) = + route >>= \case + Just (Declares fixities) -> pure (Declares fixities) + Just (Unreadable below) -> go (blamed <|> below) rest + Nothing -> go blamed rest + + viaInterface = case Map.lookup modName wkInterfaces of + Nothing -> pure Nothing + Just (key, _) -> + cachedFor key >>= \case + Just remembered -> pure (Just remembered) + Nothing -> do + established <- fromInterface wkInterfaceOf modName + storeFor key established + pure (Just established) + + viaArchive = case Map.lookup modName wkIndex of + Nothing -> pure Nothing + Just (package, tarball) -> + cachedFor package >>= \case + Just remembered -> pure (Just remembered) + Nothing -> do + extensions <- wkExtensionsOf modName + fromSource + wkMacros + extensions + (wkReach visiting') + (wkReachChildren visiting') + visiting' + tarball + modName + >>= \case + NoArchive -> pure Nothing + FromArchive established -> do + storeFor package established + pure (Just established) + + answered = \case + Declares fixities -> Declares fixities + Unreadable below + | Set.member modName wkGenerated -> Declares Map.empty + | otherwise -> maybe (Unreadable below) Declares (byHand modName) + byHand = fmap inBothNamespaces . (`Map.lookup` byHandFixities) + cachedFor package = case wkCache of + Nothing -> pure Nothing + Just c -> cachedFixities c package modName + storeFor package fixities = case wkCache of + Nothing -> pure () + Just c -> storeFixities c package modName fixities + +-- | Which package and tarball holds each module. +-- +-- The module list of a package is itself cached: it comes from a @.cabal@ +-- file inside an archive, and reading seventy of those is the bulk of what +-- starting up costs. +-- +-- Where two packages expose the same module the first is kept. A plan that +-- builds cannot contain such a pair for any module the project imports, so +-- the choice only ever falls on a module nothing will ask about. +buildModuleIndex :: + -- | Where to remember each package's module list, if anywhere. + Maybe Cache -> + -- | What the compiler says is installed. Empty if @ghc-pkg@ could not be + -- run, in which case every package falls back to its @.cabal@ file. + [InstalledPackage] -> + -- | Every package that might have a tarball, and where it would be. + [(PlanPackage, FilePath)] -> + -- | For each module, the package that exposes it (as a cache key) and + -- the tarball holding its source. + IO (Map Text (Text, FilePath)) +buildModuleIndex cache installed tarballs = + Map.fromListWith (\_ first' -> first') . concat <$> traverse one tarballs + where + byNameVersion = + Map.fromList [((ipName i, ipVersion i), ipModules i) | i <- installed] + one (p, tarball) = do + let key = cacheKey p + let exposed = Map.lookup (ppName p, ppVersion p) byNameVersion + held <- fromCabalFile cache key tarball p + let modules = case (exposed, held) of + (Nothing, Nothing) -> [] + (a, b) -> concat (catMaybes [a, b]) + pure [(m, (key, tarball)) | m <- modules] + +-- | Where each installed module's compiled interface is. +-- +-- Filed under the directory it was found in rather than under the package's +-- name and version, because those do not say which build: the same version +-- compiled with different flags can declare different fixities, and under +-- Nix a different build is a different directory. +interfaceIndex :: [InstalledPackage] -> Map Text (Text, FilePath) +interfaceIndex installed = + Map.fromListWith + (\_ first' -> first') + [ (m, (key, dir T.unpack (T.replace "." "/" m) <> ".hi")) + | i <- installed, + dir <- ipImportDirs i, + -- Bound out here so that the directory is hashed once rather than + -- once for each of the modules found in it. + let key = keyFor dir, + m <- ipModules i + ] + where + keyFor dir = + "interface-" + <> T.take 24 (T.decodeUtf8Lenient (B16.encode (SHA256.hash (T.encodeUtf8 (T.pack dir))))) + +-- | Present a fixity map as an 'Interface'. +asInterface :: Fixities -> Interface +asInterface fixities = + Interface + { interfaceDeclares = fixities, + interfacePassedOn = [], + interfaceChildren = Map.empty + } + +-- | The fixities a compiled interface reports, and those it passes on. +fromInterface :: + -- | A module's interface, if it has one + (Text -> IO (Maybe Interface)) -> + -- | The module to read + Text -> + IO Established +fromInterface interfaceOf modName = + interfaceOf modName >>= \case + Nothing -> pure (Unreadable Nothing) + Just iface -> do + declarers <- traverse asked (distinct (map fst (interfacePassedOn iface))) + pure $ case [m | (m, Nothing) <- declarers] of + (m : _) -> Unreadable (Just m) + [] -> + Declares . Map.union (interfaceDeclares iface) . Map.unions $ + [ Map.filterWithKey (\(_, o) _ -> o == op) (interfaceDeclares declarer) + | (m, op) <- interfacePassedOn iface, + Just (Just declarer) <- [lookup m declarers] + ] + where + asked m = do + interface <- interfaceOf m + pure (m, interface) + distinct = Map.keys . Map.fromList . map (,()) + +-- | A package's module list from the @.cabal@ file in its tarball. +fromCabalFile :: + -- | Where to remember the answer, if anywhere. + Maybe Cache -> + -- | What to file it under. Carries the hash the tarball was verified + -- against, so a changed tarball misses rather than matching stale data. + Text -> + -- | The tarball to read the @.cabal@ file out of. + FilePath -> + -- | The package it belongs to, consulted for the hash to verify against. + PlanPackage -> + -- | The modules it exposes, or 'Nothing' if the tarball is absent, fails + -- verification, or holds no @.cabal@ file. + IO (Maybe [Text]) +fromCabalFile cache key tarball p = do + remembered <- case cache of + Nothing -> pure Nothing + Just c -> cachedModules c key + case remembered of + -- A cached entry was written after the tarball was verified, and the + -- key it is filed under contains the hash it was verified against, so a + -- changed tarball simply misses rather than matching the wrong data. + Just ms -> pure (Just ms) + Nothing -> + verified p tarball >>= \case + False -> pure Nothing + True -> + packageModules tarball >>= \case + Nothing -> pure Nothing + Just ms -> do + case cache of + Nothing -> pure () + Just c -> storeModules c key ms + pure (Just ms) + +-- | How a package's cached answers are filed. +-- +-- The expected hash is part of the key, so everything derived from a +-- tarball is bound to the exact bytes it was derived from. A package with +-- no hash in the plan is keyed by name and version alone. +cacheKey :: PlanPackage -> Text +cacheKey p = + ppName p <> "-" <> ppVersion p <> maybe "" (("-" <>) . T.take 16) (sourceHashOf p) + +-- | Does the tarball hash to what the plan says it should? +-- +-- Hashing a few megabytes is not free, which is why it happens only on a +-- cache miss: once per package version per machine. +verified :: PlanPackage -> FilePath -> IO Bool +verified p tarball = case sourceHashOf p of + Nothing -> pure True + Just expected -> + quietly False $ do + actual <- sha256OfFile tarball + pure (actual == T.toLower expected) + +-- | The SHA-256 of a file, as lower-case hex. +sha256OfFile :: FilePath -> IO Text +sha256OfFile path = do + bytes <- BL.readFile path + pure (T.decodeUtf8Lenient (B16.encode (SHA256.hashlazy bytes))) + +-- | Read a module's fixities out of a tarball, following re-exports. +fromSource :: + -- | What the plan settles about its conditionals. + Macros -> + -- | What the module's package puts in force, before its own pragmas. + [Extension] -> + -- | How to reach another module, for chasing re-exports. This is + -- 'resolveModule' tied back on itself, with the visiting set already + -- extended. + (Text -> IO (Maybe (Fixities))) -> + -- | How to reach another module for what its names carry with them. + (Text -> IO (Map OpName (Set OpName))) -> + -- | Modules currently being resolved, passed through so that a + -- re-export chain cannot loop. + Set Text -> + -- | The tarball holding this module's source. + FilePath -> + -- | The module to read. + Text -> + -- | What it declares, including what it only passes on, and whether that + -- is worth remembering. + IO Reading +fromSource macros extensions reach reachChildren visiting tarball modName = + doesFileExist tarball >>= \case + False -> pure NoArchive + True -> + readModule tarball modName >>= \case + Nothing -> pure (FromArchive (Unreadable Nothing)) + Just ForHsc -> pure (FromArchive (hscDeclares modName)) + Just (Haskell source) -> + FromArchive + <$> fromText macros extensions reach reachChildren visiting source modName + +-- | What came of looking for a module in an archive. +data Reading + = -- | The archive was there, and this is what reading it established. + FromArchive Established + | -- | There was no archive to open. That is a fact about this machine and + -- not about the module—the plan can stay exactly as it is while + -- somebody downloads the sources—so it is never remembered. + NoArchive + +-- | The fixities a module's text declares and passes on. +fromText :: + -- | What the plan settles about its conditionals. + Macros -> + -- | What the module's package puts in force, before its own pragmas. + [Extension] -> + -- | How to reach another module, for chasing re-exports. This is + -- 'resolveModule' tied back on itself, with the visiting set already + -- extended. + (Text -> IO (Maybe (Fixities))) -> + -- | How to reach another module for what its names carry with them. + (Text -> IO (Map OpName (Set OpName))) -> + -- | Modules currently being resolved, passed through so that a + -- re-export chain cannot loop. + Set Text -> + -- | The module's source. + Text -> + -- | Its name. + Text -> + IO Established +fromText macros extensions reach reachChildren visiting source modName = + case configurationsOf macros (Just extensions) modName source of + Nothing -> pure (Unreadable Nothing) + Just modules -> + agreeing <$> traverse readOne modules + where + readOne (implicitPrelude, hsModule) = + withReexports + implicitPrelude + reach + reachChildren + visiting + modName + hsModule + +-- | One answer from every configuration that could be read, if they agree. +-- +-- A module may declare a fixity in one configuration and a different one in +-- another. Which of them holds depends on how the module is compiled, which +-- is not ours to decide, so disagreement is not an answer. Agreement across +-- the ones we could read is one, and a stronger one than the blanked text +-- could give: it is a fact about the module rather than about a reading. +-- +-- A configuration whose imports could not be resolved is passed over rather +-- than counted against the rest, because almost every one of those is a +-- branch meant for somewhere else. @System.IO.CodePage@ imports +-- @System.Win32.CodePage@ under @#ifdef WINDOWS@, and no plan solved on +-- Linux has Win32 anywhere in it. Refusing the whole module over a branch +-- that will never be compiled here would be letting a fact about this +-- machine stand as a fact about the module. +-- +-- Every configuration unresolvable is still no answer. There is nothing +-- left to agree, and saying the module declares nothing would be a guess +-- rather than the silence it deserves. What is passed on then is the first +-- reason any configuration gave, which is as good as any: they are branches +-- of one module, and whichever of them is reported the reader is being sent +-- to a real module that really could not be read. +agreeing :: NonEmpty Established -> Established +agreeing answers = case [fixities | Declares fixities <- toList answers] of + [] -> Unreadable (listToMaybe (catMaybes [below | Unreadable below <- toList answers])) + readable -> + maybe (Unreadable Nothing) Declares (foldM together Map.empty readable) + where + together settled found + | and (Map.intersectionWith (==) settled found) = Just (Map.union settled found) + | otherwise = Nothing + +-- | Where each module that lives in a directory rather than an archive is. +localModules :: BuildPlan -> IO (Map Text FilePath) +localModules plan = + Map.unions <$> traverse forPackage (concatMap directoryOf (bpPackages plan)) + where + directoryOf p = case ppSource p of + LocalPackage dir -> [dir] + CheckedOut dir -> [dir] + _ -> [] + forPackage dir = quietly Map.empty $ do + entries <- listDirectory dir + case filter (".cabal" `isSuffixOf`) entries of + [] -> pure Map.empty + (cabalFile : _) -> do + contents <- readFileText (dir cabalFile) + case contents of + Nothing -> pure Map.empty + Just text -> + Map.fromList . concat + <$> traverse (locate dir (sourceDirs text)) (containedModules text) + + -- A package may list several source directories and the @.cabal@ file + -- does not say which one holds which module, so they are tried in turn + -- and the first that has the file wins. + locate dir dirs m = do + found <- + filterM + doesFileExist + [ dir T.unpack d modulePath m ending + | d <- dirs, + ending <- moduleEndings + ] + pure [(m, path) | path <- take 1 found] + + modulePath m ending = T.unpack (T.replace "." "/" m) <> ending + +-- | Read a file, if it is there and is text. +readFileText :: FilePath -> IO (Maybe Text) +readFileText path = quietly Nothing $ do + there <- doesFileExist path + if there + then Just . T.decodeUtf8Lenient <$> BS.readFile path + else pure Nothing + +-- | What a module passes on, as well as what it declares. +-- +-- A module that exports an operator it did not declare carries no fixity of +-- its own for it, so the declaration is chased through the export list into +-- whichever module the name came from. +withReexports :: + -- | Whether @ImplicitPrelude@ is on in the module being read. + Choice "implicitPrelude" -> + -- | How to reach another module, for names this one only passes on. + (Text -> IO (Maybe (Fixities))) -> + -- | How to reach another module for what its names carry with them, + -- which is what a @T(..)@ this module hands on amounts to. + (Text -> IO (Map OpName (Set OpName))) -> + -- | Modules currently being resolved. A candidate already in here is + -- skipped rather than followed. + Set Text -> + -- | The name this module was looked up under, used to recognise a + -- @module M@ export that refers to the module itself. + Text -> + -- | The module, already parsed. + HsModule GhcPs -> + -- | What it declares together with what it re-exports, or the module it + -- passes names on from that could not be read. + IO Established +withReexports implicitPrelude reach reachChildren visiting modName hsModule = + case moduleExports hsModule of + Nothing -> pure (Declares own) + Just items -> do + carried <- carriedNames implicitPrelude reachChildren hsModule items + let wanted = wantedNames items <> fromCarried carried + visible <- + if null wanted + then pure [] + else + traverse + (\i -> (,) i <$> fromModule (importModule i)) + (moduleImports implicitPrelude hsModule) + let handedOnWhole = + wantedModules implicitPrelude modName hsModule items + wholeModules <- traverse (\m -> (,) m <$> fromModule m) handedOnWhole + pure $ case stoppedAt visible wholeModules of + Just below -> Unreadable (Just below) + Nothing -> + let seen = [(i, exported) | (i, Just exported) <- visible] + whole = [exported | (_, Just exported) <- wholeModules] + passedOn = + Map.unions + [ found + | (qualifier, op) <- wanted, + found <- take 1 (from qualifier op seen) + ] + in Declares (Map.unions (own : passedOn : whole)) + where + stoppedAt visible wholeModules = + listToMaybe $ + [importModule i | (i, Nothing) <- visible] + <> [m | (m, Nothing) <- wholeModules] + own = declaredFixities hsModule + defined = declaredNames hsModule + wantedNames items = + [(qualifier, op) | ExportName qualifier op <- items, not (Set.member op defined)] + <> [(qualifier, op) | ExportAll qualifier op <- items, not (Set.member op defined)] + fromCarried carried = + [ (qualifier, op) + | ((qualifier, _), Just ops) <- carried, + op <- Set.toList ops, + not (Set.member op defined) + ] + from qualifier op seen = + [ found + | (i, exported) <- seen, + canSupply qualifier op i, + let found = Map.filterWithKey (\(_, o) _ -> o == op) exported, + not (Map.null found) + ] + fromModule m + | m `Set.member` visiting = pure (Just Map.empty) + | otherwise = reach m + +-- | What each name a module's export list hands on carries with it. +childrenWithReexports :: + -- | Whether @ImplicitPrelude@ is on in the module being read. + Choice "implicitPrelude" -> + -- | How to reach another module for what its names carry + (Text -> IO (Map OpName (Set OpName))) -> + -- | The name this module was looked up under + Text -> + -- | The module, already parsed + HsModule GhcPs -> + IO (Map OpName (Set OpName)) +childrenWithReexports implicitPrelude reachChildren modName hsModule = + case moduleExports hsModule of + Nothing -> pure (moduleChildren hsModule) + Just items -> do + carried <- carriedNames implicitPrelude reachChildren hsModule items + let handedOnWhole = + wantedModules implicitPrelude modName hsModule items + wholes <- traverse reachChildren handedOnWhole + pure . Map.unionsWith Set.union $ + moduleChildren hsModule + : Map.fromListWith Set.union [(parent, ops) | ((_, parent), Just ops) <- carried] + : wholes + +-- | The operators a module's export list names, following what it hands on. +-- +-- 'exportedOperators' answers for a list that names everything outright. +-- Where the list hands a whole module on, or a @T(..)@ for a type declared +-- elsewhere, the answer is in another module and this goes and gets it. +-- +-- 'Nothing' where any part of the list stays beyond us, since a set that +-- leaves names out would clear a module of carrying an operator it may +-- well carry. Everything or nothing: this answer is only ever used to rule +-- a module out. +exportNamesWithReexports :: + -- | Whether @ImplicitPrelude@ is on in the module being read. + Choice "implicitPrelude" -> + -- | How to reach another module for what its export list names + (Text -> IO (Maybe (Set OpName))) -> + -- | How to reach another module for what its names carry + (Text -> IO (Map OpName (Set OpName))) -> + -- | The name this module was looked up under + Text -> + -- | The module, already parsed + HsModule GhcPs -> + IO (Maybe (Set OpName)) +exportNamesWithReexports + implicitPrelude + reachNames + reachChildren + modName + hsModule = + case moduleExports hsModule of + Nothing -> pure (Just (Set.fromList [op | (_, op) <- Map.keys (declaredFixities hsModule)])) + Just items -> do + carried <- carriedNames implicitPrelude reachChildren hsModule items + let handedOnWhole = + wantedModules implicitPrelude modName hsModule items + wholes <- traverse reachNames handedOnWhole + pure $ do + fromWholes <- sequence wholes + fromCarried <- + traverse (\((_, parent), kids) -> Set.insert parent <$> kids) carried + pure (Set.unions (named items : declaredHere items : fromCarried <> fromWholes)) + where + declared = declaredChildren hsModule + named items = Set.fromList [op | ExportName _ op <- items] + declaredHere items = + Set.unions + [ Set.insert parent kids + | ExportAll _ parent <- items, + Just kids <- [Map.lookup parent declared] + ] + +-- | What the types a module hands on but does not declare carry with them, +-- asked of the modules they could have come from. +carriedNames :: + -- | Whether @ImplicitPrelude@ is on in the module being read. + Choice "implicitPrelude" -> + -- | How to reach another module for what its export list names + (Text -> IO (Map OpName (Set OpName))) -> + -- | The module, already parsed + HsModule GhcPs -> + -- | Export items + [ExportItem] -> + -- | For each handed-on name, what it carries, or 'Nothing' where no + -- module that could have supplied it had anything to say about it. + IO [((Maybe Text, OpName), Maybe (Set OpName))] +carriedNames implicitPrelude reachChildren hsModule items = + traverse (\(qualifier, parent) -> ((qualifier, parent),) <$> carriedBy qualifier parent) handedOn + where + declared = declaredChildren hsModule + imports = moduleImports implicitPrelude hsModule + handedOn = + [ (qualifier, parent) + | ExportAll qualifier parent <- items, + not (Map.member parent declared) + ] + carriedBy qualifier parent = do + answers <- traverse (reachChildren . importModule) (filter (canSupply qualifier parent) imports) + pure $ case mapMaybe (Map.lookup parent) answers of + [] -> Nothing + kids -> Just (Set.unions kids) + +-- | Could this import have supplied a name an export list hands on? +canSupply :: Maybe Text -> OpName -> Import -> Bool +canSupply qualifier op i = + reaches && case importNames i of + Nothing -> True + Just (True, hidden) -> not (surelyNames Map.empty op hidden) + Just (False, shown) -> mightBring Map.empty op shown + where + reaches = case qualifier of + Nothing -> not (importQualified i) + Just q -> importAlias i == q + +-- | The modules a @module M@ export hands on whole, by their own names. +wantedModules :: + Choice "implicitPrelude" -> + Text -> + HsModule GhcPs -> + [ExportItem] -> + [Text] +wantedModules implicitPrelude modName hsModule items = + Set.toList . Set.fromList $ + concat [under m | ExportModule m <- items, not (isSelf m)] + where + under m = case [importModule i | i <- imports, importAlias i == m] of + [] -> [m] + aliased -> aliased + imports = moduleImports implicitPrelude hsModule + isSelf m = Just m == moduleName hsModule || m == modName + +-- | What to parse a module with: what its package puts in force, and then +-- whatever its own pragmas say about that. +configFor :: [Extension] -> Text -> ParserConfig +configFor extensions source = parserConfigFor (effectiveExtensions extensions source) + +-- | What a parse produced, where only having it or not matters. +whatParsed :: Either e a -> Maybe a +whatParsed = either (const Nothing) Just + +-- | Every configuration the preprocessor allows of a module's text that is +-- Haskell, parsed, each with whether it has the Prelude without importing +-- it. +configurationsOf :: + -- | What the plan settles about the questions its conditionals ask. + Macros -> + -- | What the module's package puts in force, or 'Nothing' where nothing + -- is known about it. Then it is parsed under the most generous edition + -- rather than the narrowest, and taken to have the Prelude unless it + -- says otherwise—both being the way to be wrong that costs least. + Maybe [Extension] -> + -- | The module's name, for the parser to put in its errors + Text -> + -- | Its text + Text -> + Maybe (NonEmpty (Choice "implicitPrelude", HsModule GhcPs)) +configurationsOf macros extensions modName text = + NE.nonEmpty . mapMaybe parsed + =<< whatParsed (branchLeaves (withoutRuledOut macros text)) + where + parsed leaf = + (,) (hasImplicitPrelude (fromMaybe [] extensions) leaf) . pmModule + <$> whatParsed (parseModule (configOf leaf) named leaf) + configOf leaf = maybe defaultParserConfig (`configFor` leaf) extensions + named = T.unpack modName + +-- | Does this module see the Prelude without importing it? +hasImplicitPrelude :: [Extension] -> Text -> Choice "implicitPrelude" +hasImplicitPrelude extensions source = + fromBool (ImplicitPrelude `elem` effectiveExtensions extensions source) + +-- | Find a module inside a tarball and say what was found. +-- +-- Looked for under each of the endings a package may write a module with, +-- Haskell first. An @.hsc@ is reported rather than read: it is not Haskell +-- until @hsc2hs@ has been over it, and what it declares is answered out of +-- 'hscFixities' instead. +readModule :: FilePath -> Text -> IO (Maybe InArchive) +readModule tarball modName = quietly Nothing $ do + bytes <- BL.readFile tarball + let (cabal, candidates) = sweep Nothing [] (Tar.read (GZip.decompress bytes)) + dirs = maybe [] sourceDirs cabal + pure (listToMaybe (mapMaybe (pick dirs candidates) moduleEndings)) + where + suffix ending = "/" <> T.unpack (T.replace "." "/" modName) <> ending + suffixes = map suffix moduleEndings + sweep cabal found = \case + Tar.Next entry rest + | Tar.NormalFile content _ <- Tar.entryContent entry, + cabalFileAtTop (entryPosixPath entry), + Nothing <- cabal -> + sweep (Just (decode content)) found rest + | Tar.NormalFile content _ <- Tar.entryContent entry, + any (`isSuffixOf` entryPosixPath entry) suffixes -> + sweep cabal ((entryPosixPath entry, decode content) : found) rest + | otherwise -> sweep cabal found rest + _ -> (cabal, reverse found) + pick dirs candidates ending = + inArchive ending . snd + <$> listToMaybe (under sfx dirs matching <> matching) + where + sfx = suffix ending + matching = [c | c <- candidates, sfx `isSuffixOf` fst c] + under sfx dirs matching = [e | d <- dirs, e <- matching, inDir sfx d (fst e)] + inDir sfx d path + | d == "." = takeWhile (/= '/') path <> sfx == path + | otherwise = ("/" <> T.unpack d <> sfx) `isSuffixOf` path + decode = T.decodeUtf8Lenient . BL.toStrict + +-- | The endings a package may write a module under, in the order they are +-- tried. +-- +-- Plain Haskell first: a package that ships both has generated the one from +-- the other, and the generated one is the module as it will be compiled. +moduleEndings :: [String] +moduleEndings = [".hs", ".hsc"] + +-- | What an archive holds for a module. +data InArchive + = -- | Haskell, as the package wrote it. + Haskell Text + | -- | A module written for @hsc2hs@. Its text is not kept: there is + -- nothing to be done with it, and 'hscFixities' answers for it. + ForHsc + +-- | What was found under one ending amounts to. +inArchive :: String -> Text -> InArchive +inArchive ending text + | writtenForHsc ending = ForHsc + | otherwise = Haskell text + +-- | Is this a module @hsc2hs@ writes rather than one anybody compiles? +writtenForHsc :: FilePath -> Bool +writtenForHsc = isSuffixOf ".hsc" + +-- | What an @.hsc@ module declares, which is nothing unless it is named. +-- +-- See 'hscFixities' for why an absence is an answer here and not a refusal +-- to give one. +hscDeclares :: Text -> Established +hscDeclares modName = + Declares (maybe Map.empty inBothNamespaces (Map.lookup modName hscFixities)) + +-- | The fixities an 'Established' holds, where it holds any. +fixitiesEstablished :: Established -> Maybe (Fixities) +fixitiesEstablished = \case + Declares fixities -> Just fixities + Unreadable _ -> Nothing + +-- | The operators an @.hsc@ module can supply, on the same reasoning. +hscSupplies :: Text -> Set OpName +hscSupplies modName = + maybe Set.empty Map.keysSet (Map.lookup modName hscFixities) diff --git a/src/Tilia/Format.hs b/src/Tilia/Format.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Format.hs @@ -0,0 +1,425 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Formatting a file, with everything the project can tell us about it. +module Tilia.Format + ( FormatError (..), + describeFormatError, + formatErrorExitCode, + refused, + Session, + newSession, + fixityNotesOf, + formatSource, + ) +where + +import Control.Applicative ((<|>)) +import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) +import Data.Choice (Choice, fromBool, isTrue) +import Data.Foldable (traverse_) +import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import GHC.LanguageExtensions.Type (Extension (ImplicitPrelude)) +import Tilia.Cpp + ( CppError (..), + blankCpp, + branchLeaves, + describeCppError, + formatWithCpp, + usesCpp, + withoutRuledOut, + ) +import Tilia.Cpp.Macros (Macros) +import Tilia.Doc (defaultRenderOptions, printDoc) +import Tilia.Equivalence (commentDifference, syntaxDifference) +import Tilia.Fixity (OpName, Unknown (..), operatorSpelling, spellUnreadIn, unknownOperators) +import Tilia.Fixity.Debug (FixityNotes, fixityNotes) +import Tilia.Fixity.Plan + ( PlanComponent, + Resolver (..), + loadPlan, + macrosOf, + newResolver, + scopeFor, + ) +import Tilia.Package + ( PackageProblem (..), + PackageReader, + describePackageProblem, + newPackageReader, + ) +import Tilia.Palette (Color (Operator, Place), Palette, paint) +import Tilia.Parser + ( ParseError, + ParsedModule, + ParserConfig, + describeParseError, + parseModule, + parserConfigFor, + pmModule, + pmSource, + ) +import Tilia.Pragma (effectiveExtensions, movesPositions) +import Tilia.Project (ProjectRoot (..), findProjectRoot) +import Tilia.Render (RenderConfig (..), defaultRenderConfig, renderModule) +import Tilia.Source (comments) + +-- | Why a file could not be formatted. +data FormatError + = -- | No @cabal.project@ or @.cabal@ file above it. + NoProject FilePath + | -- | A project, but no build plan we could read or produce. The text is + -- whatever @cabal@ had to say about it. + NoBuildPlan FilePath Text + | -- | We failed to read .cabal file. + NoPackage FilePath PackageProblem + | -- | The file is not Haskell we can parse. + NotParsed ParseError + | -- | The file carries @{-# LINE #-}@ or @{-# COLUMN #-}@ pragmas. + PositionPragmas FilePath + | -- | The file uses the preprocessor in a way we cannot handle. + CppUnsupported FilePath CppError + | -- | An operator the file uses has a fixity we could not establish, as + -- the file writes it. + UnknownFixity FilePath [((Maybe Text, OpName), Unknown)] + | -- | The file could not be read at all. + Unreadable FilePath Text + | -- | Formatting the file changed its AST. + NotEquivalent FilePath Text + | -- | Formatting is not idempotent. + NotIdempotent FilePath Text + +-- | Say what went wrong, in one line. +describeFormatError :: Palette -> FormatError -> Text +describeFormatError palette = \case + NoProject path -> + "no project above " <> file path <> ": expected a cabal.project or a .cabal file" + NoBuildPlan root reason -> + "no build plan for " <> file root <> ": " <> reason + NoPackage path problem -> + "cannot tell what " + <> file path + <> " is written in: " + <> describePackageProblem problem + NotParsed e -> "cannot parse " <> located (describeParseError e) + PositionPragmas path -> + "will not format " <> file path <> ": it uses {-# LINE #-} pragmas, and no reformatting can leave those true" + CppUnsupported path why -> + "will not format " <> file path <> ": " <> describeCppError why + Unreadable path why -> "cannot read " <> file path <> ": " <> why + NotEquivalent path why -> + "formatting " <> file path <> " changed the program: " <> why + NotIdempotent path why -> + "formatting " <> file path <> " is not idempotent: " <> why + UnknownFixity path unknown -> + "will not format " + <> file path + <> ": " + <> T.intercalate ", and " (map saying (together unknown)) + where + saying (why, ops) = + (if length ops == 1 then "the fixity of " else "the fixities of ") + <> listing ops + <> " " + <> because why + because = \case + NotRead missing -> "may be declared in " <> spellUnreadIn palette missing + Ambiguous -> "is declared differently by two modules in scope" + together = foldl put [] + where + put seen ((qualifier, op), why) = + let named = paint palette Operator (operatorSpelling qualifier op) + in case break ((== why) . fst) seen of + (before, (_, ops) : after) -> + before <> [(why, ops <> [named])] <> after + _ -> seen <> [(why, [named])] + listing ops = case reverse ops of + [] -> "" + [one] -> one + [second, first'] -> first' <> " and " <> second + (final : rest) -> T.intercalate ", " (reverse rest) <> ", and " <> final + where + file = paint palette Place . T.pack + located t = case T.breakOn ":" t of + (where', rest) -> paint palette Place where' <> rest + +-- | The exit status a failure should leave behind. +formatErrorExitCode :: FormatError -> Int +formatErrorExitCode = \case + NoProject {} -> 2 + NoBuildPlan {} -> 3 + NotParsed {} -> 4 + PositionPragmas {} -> 5 + NoPackage _ problem -> case problem of + NoPackageFile -> 6 + PackageUnreadable {} -> 6 + PackageMalformed {} -> 7 + FileUnclaimed {} -> 8 + UnknownFixity {} -> 15 + Unreadable {} -> 16 + NotEquivalent {} -> 17 + NotIdempotent {} -> 18 + CppUnsupported _ why -> case why of + UnhandledDirective {} -> 9 + UnsplittableConditional -> 10 + TooManyConfigurations -> 11 + ConfigurationNotParsed {} -> 12 + DirectiveUnplaceable {} -> 13 + DirectiveInQuotedText {} -> 14 + +-- | Did we decline to format the file, rather than fail to? +refused :: FormatError -> Bool +refused = \case + PositionPragmas {} -> True + CppUnsupported {} -> True + UnknownFixity {} -> True + NotParsed {} -> False + NoPackage {} -> False + Unreadable {} -> False + NotEquivalent {} -> False + NotIdempotent {} -> False + NoProject {} -> False + NoBuildPlan {} -> False + +-- | What a run works out once and then uses for every file. +-- +-- Finding the project, solving its build plan and building a resolver cost +-- about as much as formatting a small file, and none of it depends on which +-- file is being formatted. +data Session = Session + { -- | What can be asked about the modules a file imports. + sessionResolver :: Resolver, + -- | What the plan settles about the questions a file's conditionals + -- ask, so that a branch it rules out is not read as part of the file. + sessionMacros :: Macros, + -- | What each file's package puts in force. + sessionPackage :: PackageReader, + -- | Whether to check AST equivalence. + sessionCheckAst :: Choice "checkAst", + -- | Whether to check idempotence. + sessionCheckIdempotence :: Choice "checkIdempotence", + -- | An account of how each file's fixities were determined. 'Nothing' + -- when this information was not requested, which is what keeps an + -- ordinary run from doing any of the work. + sessionFixityNotes :: Maybe (IORef (Map FilePath FixityNotes)) + } + +-- | Settle everything that does not depend on the file being formatted. +newSession :: + -- | Where to start looking for the project + FilePath -> + -- | The components about to be formatted, so that a plan which says + -- nothing about them can be solved again rather than trusted + [PlanComponent] -> + -- | Check AST equivalence. + Choice "checkAst" -> + -- | Check idempotence. + Choice "checkIdempotence" -> + -- | Record how every file's fixities were settled, to be read afterwards + -- with 'fixityNotesOf'. + Choice "debugFixity" -> + IO (Either FormatError Session) +newSession start components checkAst checkIdempotence debugFixity = runExceptT $ do + root <- prPath <$> (need (NoProject start) =<< liftIO (findProjectRoot start)) + plan <- orElse (NoBuildPlan root) =<< liftIO (loadPlan components root) + resolver <- liftIO (newResolver plan) + askPackage <- liftIO newPackageReader + notes <- + if isTrue debugFixity + then Just <$> liftIO (newIORef Map.empty) + else pure Nothing + pure + Session + { sessionResolver = resolver, + sessionMacros = macrosOf plan, + sessionPackage = askPackage, + sessionCheckAst = checkAst, + sessionCheckIdempotence = checkIdempotence, + sessionFixityNotes = notes + } + where + need :: FormatError -> Maybe a -> ExceptT FormatError IO a + need e = maybe (throwE e) pure + +-- | What the run made of every file's operators, by file. +-- +-- Empty unless the session was asked to keep an account of it. Nothing here +-- is rendered; 'Tilia.Fixity.Debug.renderFixityNotes' does that. +fixityNotesOf :: Session -> IO (Map FilePath FixityNotes) +fixityNotesOf session = case sessionFixityNotes session of + Nothing -> pure Map.empty + Just ref -> readIORef ref + +-- | Format source that has already been read. +-- +-- The text is passed in rather than read here because a caller that means +-- to compare the two needs the original anyway, and reading a file twice to +-- format it once is the sort of thing this is trying to stop doing. +formatSource :: + -- | What the run has worked out already + Session -> + -- | The file the source came from, for reporting and for its package + FilePath -> + -- | The source + Text -> + -- | Result + IO (Either FormatError Text) +formatSource session path source = runExceptT $ do + when (movesPositions source) $ + throwE (PositionPragmas path) + package <- orElse (NoPackage path) =<< liftIO (sessionPackage session path) + let resolver = sessionResolver session + config = parserConfigFor package + reading = blankCpp . withoutRuledOut (sessionMacros session) + extensionsAndCpp text = + let declared = effectiveExtensions package text + in (Set.fromList declared, usesCpp declared text) + renderConfigFor extensions hsModule = do + let implicitPrelude = + fromBool (Set.member ImplicitPrelude extensions) + scope <- liftIO (scopeFor resolver implicitPrelude hsModule) + liftIO $ case sessionFixityNotes session of + Nothing -> pure () + Just ref -> do + told <- + fixityNotes + implicitPrelude + (askFixities resolver) + (askChain resolver) + scope + hsModule + atomicModifyIORef' ref (\m -> (Map.insertWith (\_ old -> old) path told m, ())) + case unknownOperators scope hsModule of + [] -> + pure + defaultRenderConfig + { rcExtensions = extensions, + rcScope = Just scope + } + unknown -> throwE (UnknownFixity path unknown) + formatting (extensions, cpp) already text + | cpp = do + render <- case parseModule config path (reading text) of + Left _ -> pure defaultRenderConfig {rcExtensions = extensions} + Right whole -> renderConfigFor extensions (pmModule whole) + printed <- + orElse + (CppUnsupported path) + (formatWithCpp config render path text) + pure (printed, Nothing) + | otherwise = do + parsed <- + maybe (orElse NotParsed (parseModule config path text)) pure already + render <- renderConfigFor extensions (pmModule parsed) + pure + ( printDoc defaultRenderOptions (renderModule render parsed), + Just parsed + ) + let inForce@(_, cpp) = extensionsAndCpp source + (formatted, tree) <- formatting inForce Nothing source + printedTree <- + if isTrue (sessionCheckAst session) + then do + let (changed, parsed) = rewritten config cpp path (source, tree) formatted + traverse_ (throwE . NotEquivalent path) changed + pure parsed + else pure Nothing + when (isTrue (sessionCheckIdempotence session)) $ do + (settled, _) <- formatting (extensionsAndCpp formatted) printedTree formatted + when (settled /= formatted) $ + throwE (NotIdempotent path (whereTheyDiffer formatted settled)) + pure formatted + +-- | Where two spellings of the same file first disagree. +whereTheyDiffer :: Text -> Text -> Text +whereTheyDiffer before after = + case [n | (n, one, two) <- zip3 [1 :: Int ..] first second, one /= two] of + (n : _) -> "line " <> tshow n <> " differs" + [] -> + "the second pass came out " + <> tshow (length second) + <> " lines long where the first came out " + <> tshow (length first) + where + first = T.lines before + second = T.lines after + tshow :: Int -> Text + tshow = T.pack . show + +-- | What formatting changed about the program. +-- +-- A file with conditionals is compared one configuration at a time, because +-- the text as it stands is not a program: the branches only make one once +-- the preprocessor has chosen between them. +rewritten :: + -- | How to parse both sides + ParserConfig -> + -- | Whether the file uses the preprocessor + Bool -> + -- | The file, for the parser's messages + FilePath -> + -- | What was read, and the tree it was printed from where it has one + (Text, Maybe ParsedModule) -> + -- | What was printed + Text -> + -- | What formatting changed, and the tree of what was printed + (Maybe Text, Maybe ParsedModule) +rewritten config cpp path (before, printedFrom') after + | not cpp = case parseModule config path after of + Left e -> + ( Just ("the formatted output does not parse: " <> describeParseError e), + Nothing + ) + Right a' -> case printedFrom' <|> whatParsed (parseModule config path before) of + -- The input parsed once already, or there would be nothing to + -- compare. + Nothing -> (Nothing, Just a') + Just b' -> (comparing b' a', Just a') + | otherwise = (underCpp, Nothing) + where + comparing b' a' = + syntaxDifference (pmModule b') (pmModule a') + <|> commentDifference + (pmModule b', pmModule a') + (comments (pmSource b')) + (comments (pmSource a')) + whatParsed = either (const Nothing) Just + underCpp = case (branchLeaves before, branchLeaves after) of + -- Neither can really happen: a source that would not split never got + -- as far as being formatted. Saying so beats saying nothing. + (Left _, _) -> Just "the input could not be split into configurations" + (_, Left _) -> Just "the output could not be split into configurations" + (Right went, Right came) + | length went /= length came -> + Just + ( "the output has " + <> tshow (length came) + <> " configurations where the input had " + <> tshow (length went) + ) + | otherwise -> + firstJust + [ ("in one configuration, " <>) <$> difference b a + | (b, a) <- zip went came + ] + difference b a = case (parseModule config path b, parseModule config path a) of + -- The input parsed once already, or there would be nothing to compare. + (Left _, _) -> Nothing + (_, Left e) -> + Just ("the formatted output does not parse: " <> describeParseError e) + (Right b', Right a') -> comparing b' a' + firstJust = foldr (<|>) Nothing + tshow :: Int -> Text + tshow = T.pack . show + +-- | Give up with the given error where there is one to give up over. +orElse :: (e -> FormatError) -> Either e a -> ExceptT FormatError IO a +orElse f = either (throwE . f) pure diff --git a/src/Tilia/Imports.hs b/src/Tilia/Imports.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Imports.hs @@ -0,0 +1,306 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} + +-- | Putting a module's imports in order. +module Tilia.Imports + ( normalizeImports, + ) +where + +import Data.Char (isAlphaNum) +import Data.Choice (Choice, isTrue) +import Data.Function (on, (&)) +import Data.List (groupBy, sortOn) +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Data.FastString (unpackFS) +import GHC.Hs +import GHC.Types.Name.Occurrence (occNameString) +import GHC.Types.Name.Reader (RdrName, rdrNameOcc) +import GHC.Types.PkgQual (RawPkgQual (..)) +import GHC.Types.SourceText (StringLiteral (..)) +import GHC.Types.SrcLoc +import Tilia.Comments (Comment (..), commentTrailing, commentsWithin) +import Tilia.Span (endPoint, startPoint) +import Tilia.Span.Ghc (spanOf, spanOfSrcSpan) + +-- | Whether an explicit @import Prelude@ is telling the reader anything. +data PreludeImport + = -- | @ImplicitPrelude@ is on, so the module has the Prelude whatever it + -- says, and the line only trims what it already takes. + Refines + | -- | @ImplicitPrelude@ is off, so the line is the only reason the module + -- has a Prelude at all, and it is an import like any other. + Provides + deriving (Eq, Show) + +-- | Sort a module's imports and fold together the ones that say the same +-- thing. +normalizeImports :: + -- | Whether @ImplicitPrelude@ is on + Choice "implicitPrelude" -> + -- | Source lines the block must not be sorted across + [Int] -> + -- | The module's comments + [Comment] -> + -- | Original imports + [LImportDecl GhcPs] -> + -- | Normalized imports + [LImportDecl GhcPs] +normalizeImports implicitPrelude barriers written imports = + concatMap stretch (segmented (dividing imports barriers) tidied) + where + prelude = if isTrue implicitPrelude then Refines else Provides + tidied = map (fmap (tidyList written)) imports + stretch is = foldRuns (fuse written) [((identity prelude i, alone i), i) | i <- is] + alone i + | any strands (spanOf i) = startLineOf i + | otherwise = 0 + where + strands s = + any (unanchored (itemStarts i)) (filter loose (commentsWithin s written)) + loose = not . commentTrailing + unanchored starts c = not (any (> endPoint (commentSpan c)) starts) + startLineOf i = case srcSpanStart (getLocA i) of + RealSrcLoc l _ -> srcLocLine l + _ -> 0 + +-- | Where every name an import lists begins, the names inside a thing's own +-- brackets among them. +itemStarts :: LImportDecl GhcPs -> [(Int, Int)] +itemStarts (L _ decl) = case ideclImportList decl of + Nothing -> [] + Just (_, L _ items) -> concatMap starts items + where + starts item = foldMap ((: []) . startPoint) (spanOf item) <> inside (unLoc item) + inside = \case + IEThingWith _ _ _ members _ -> + concatMap (foldMap ((: []) . startPoint) . spanOf) members + _ -> [] + +-- | The lines that fall between imports, out of the lines that must not be +-- sorted across. +dividing :: [LImportDecl GhcPs] -> [Int] -> [Int] +dividing imports = filter (not . within) + where + within l = any (\(from, to) -> from <= l && l <= to) spans' + spans' = [(srcLocLine from, srcLocLine to) | i <- imports, Just (from, to) <- [endsOf i]] + endsOf i = case (srcSpanStart (getLocA i), srcSpanEnd (getLocA i)) of + (RealSrcLoc from _, RealSrcLoc to _) -> Just (from, to) + _ -> Nothing + +-- | Cut a list of imports into the stretches the barriers leave between +-- them, in order. +segmented :: [Int] -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]] +segmented [] imports = [imports] +segmented barriers imports = + groupBy ((==) `on` fst) [(between i, i) | i <- imports] & map (map snd) + where + between i = length (takeWhile (< lineOf i) barriers) + lineOf i = case srcSpanStart (getLocA i) of + RealSrcLoc l _ -> srcLocLine l + _ -> 0 + +---------------------------------------------------------------------------- +-- Runs + +-- | Sort by the keys, then replace each run of equal keys by one value +-- folded out of it. +-- +-- The sort is stable, so a run holds its values in the order they were +-- written and the fold sees them that way round. That is worth having: +-- folding keeps the first one's identity, and \"first\" should mean first +-- in the file. +foldRuns :: (Ord k) => (a -> a -> a) -> [(k, a)] -> [a] +foldRuns fold' = + map (foldl1 fold' . map snd) . groupBy ((==) `on` fst) . sortOn fst + +---------------------------------------------------------------------------- +-- Which imports are the same import + +-- | What has to agree before two imports may be folded together, in the +-- order imports should be printed in. +-- +-- The two leading keys are about reading rather than about identity. A +-- @Prelude@ that only refines what the module already has goes at the end, +-- since looking for it among the @D@s would be looking for the least +-- interesting line in the block. The package goes before the module name so +-- that the imports from one package stay in one run; sorting by module +-- first would interleave them and hide who provides what. +identity :: + PreludeImport -> + LImportDecl GhcPs -> + (Bool, (Int, Text), Text, Bool, Bool, Bool, Maybe Text, Maybe Bool, Maybe Bool) +identity prelude (L _ decl) = + ( prelude == Refines && named (ideclName decl) == T.pack "Prelude", + package (ideclPkgQual decl), + named (ideclName decl), + ideclSource decl == IsBoot, + ideclSafe decl, + isImportDeclQualified (ideclQualified decl), + named <$> ideclAs decl, + hides . fst <$> ideclImportList decl, + lifted (ideclLevelSpec decl) + ) + where + named = T.pack . moduleNameString . unLoc + package = \case + NoRawPkgQual -> (0, T.empty) + RawPkgQual (sl_fs -> fs) + | name == T.pack "this" -> (2, T.empty) + | otherwise -> (1, name) + where + name = T.pack (unpackFS fs) + hides = \case + Exactly -> False + EverythingBut -> True + lifted = \case + NotLevelled -> Nothing + LevelStylePre l -> Just (quoted l) + LevelStylePost l -> Just (quoted l) + quoted = \case + ImportDeclSplice -> False + ImportDeclQuote -> True + +---------------------------------------------------------------------------- +-- Folding two imports into one + +-- | Keep the first import and give it everything the second named. +-- +-- The result covers both of their spans. That matters for comments: one +-- written between the two has to land inside the declaration that replaces +-- them, and a folded import claiming only the first one's span would leave +-- it nowhere to go. +fuse :: [Comment] -> LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs +fuse written (L ann kept) (L other folded) = + L + ann {entry = EpaSpan (combineSrcSpans (locA ann) (locA other))} + kept {ideclImportList = both (ideclImportList kept) (ideclImportList folded)} + where + both (Just (interpretation, L l xs)) (Just (_, L l' ys)) = + Just (interpretation, L (widened written l l') (tidyItems written (xs <> ys))) + both _ _ = Nothing + +---------------------------------------------------------------------------- +-- The names inside an import list + +tidyList :: [Comment] -> ImportDecl GhcPs -> ImportDecl GhcPs +tidyList written decl = + decl {ideclImportList = fmap (fmap (tidyItems written)) <$> ideclImportList decl} + +-- | Sort an import list and fold together the entries naming one thing. +-- +-- @import M (T (A), T (B))@ names one type twice and comes out as @import M +-- (T (A, B))@. +tidyItems :: [Comment] -> [LIE GhcPs] -> [LIE GhcPs] +tidyItems written items + -- An import list should hold nothing but names, and the parser will accept + -- things there that the compiler goes on to reject—@import M (module N)@ + -- among them. Sorting a list we cannot read would be guessing. + | any (unnameable . unLoc) items = items + | otherwise = foldRuns (wider written) [(nameOf (unLoc i), fmap sortSubnames i) | i <- items] + where + unnameable = \case + IEVar {} -> False + IEThingAbs {} -> False + IEThingAll {} -> False + IEThingWith {} -> False + _ -> True + +-- | Cover both of these regions, if anything was written between them. +-- +-- A region says two things at once: where a comment written inside it +-- belongs, and how the construct was laid out. What comes out of folding was +-- never written, so it has no layout of its own, and taking the region that +-- covers everything folded in would have it laid out across all the lines +-- those names were spread over—several lines for a name or two. +-- +-- So the region grows only where growing it is the point: when a comment +-- falls between the two, and would otherwise be left outside the entry that +-- now holds the names it was written among. +widened :: [Comment] -> EpAnn ann -> EpAnn ann -> EpAnn ann +widened written a b + | any holdsComment (spanOfSrcSpan combined) = a {entry = EpaSpan combined} + | otherwise = a + where + combined = combineSrcSpans (locA a) (locA b) + holdsComment s = not (null (commentsWithin s written)) + +-- | Of two entries naming one thing, the one that brings in more of it. +-- +-- Naming all of a type beats naming some of its pieces, which beats naming +-- the type alone. Where both name some, the two lists go together. The +-- documentation is dropped whenever two entries are folded: it was written +-- against one of them and would become a claim about both. +wider :: [Comment] -> LIE GhcPs -> LIE GhcPs -> LIE GhcPs +wider written (L ann kept) (L other folded) = + L (widened written ann other) (combine kept folded) + where + combine a b = case (a, b) of + (IEThingAll x n _, _) -> IEThingAll x n Nothing + (_, IEThingAll x n _) -> IEThingAll x n Nothing + (IEThingWith x n wildcard subs _, IEThingWith _ _ wildcard' subs' _) -> + IEThingWith + x + n + (eitherWildcard wildcard wildcard') + (dedupeSubnames (subs <> subs')) + Nothing + (IEThingWith x n wildcard subs _, _) -> + IEThingWith x n wildcard subs Nothing + (_, IEThingWith x n wildcard subs _) -> + IEThingWith x n wildcard subs Nothing + (IEVar _ n _, _) -> IEVar Nothing n Nothing + _ -> a + + eitherWildcard a b = case (a, b) of + (NoIEWildcard, NoIEWildcard) -> NoIEWildcard + _ -> IEWildcard 0 + +sortSubnames :: IE GhcPs -> IE GhcPs +sortSubnames = \case + IEThingWith x n wildcard subs doc -> + IEThingWith x n wildcard (dedupeSubnames subs) doc + other -> other + +-- | The same name written twice in a sub-list is written once here. Which +-- of the two survives cannot matter: they name the same thing. +dedupeSubnames :: [LIEWrappedName GhcPs] -> [LIEWrappedName GhcPs] +dedupeSubnames subs = foldRuns const [(nameKey (unLoc s), s) | s <- subs] + +---------------------------------------------------------------------------- +-- Ordering names + +nameOf :: IE GhcPs -> (Int, Bool, String) +nameOf = \case + IEVar _ x _ -> nameKey (unLoc x) + IEThingAbs _ x _ -> nameKey (unLoc x) + IEThingAll _ x _ -> nameKey (unLoc x) + IEThingWith _ x _ _ _ -> nameKey (unLoc x) + -- 'tidyItems' has already refused to touch a list holding anything else. + _ -> (maxBound, True, "") + +-- | Where a name sorts. +-- +-- Grouped first by what kind of thing is named, so that the @pattern@s and +-- the @type@s of an import list stay together. Then the names spelled with +-- letters before the ones spelled with punctuation, which gathers the +-- operators at the end where they are easy to find; ordering by character +-- code would scatter them, some before the letters and some after. +nameKey :: IEWrappedName GhcPs -> (Int, Bool, String) +nameKey = \case + IEName _ x -> spelled 0 x + IEDefault _ x -> spelled 1 x + IEPattern _ x -> spelled 2 x + IEType _ x -> spelled 3 x + IEData _ x -> spelled 4 x + where + spelled :: Int -> LocatedN RdrName -> (Int, Bool, String) + spelled kind (unLoc -> name) = (kind, punctuation text, text) + where + text = occNameString (rdrNameOcc name) + punctuation = \case + (c : _) -> not (isAlphaNum c) + [] -> False diff --git a/src/Tilia/Newline.hs b/src/Tilia/Newline.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Newline.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Handling of newlines. +module Tilia.Newline + ( NewlineStyle (..), + getNewlineStyle, + setNewlineStyle, + ) +where + +import Data.Text (Text) +import Data.Text qualified as T + +-- | The two ways a line can end. +data NewlineStyle + = -- | @\\n@, as everything but Windows writes them. + Lf + | -- | @\\r\\n@, as Windows writes them. + CrLf + deriving (Eq, Show) + +-- | Which of the two a text is written with, by the first ending in it. +getNewlineStyle :: Text -> NewlineStyle +getNewlineStyle t = case T.breakOn "\n" t of + (before, rest) + | not (T.null rest), + "\r" `T.isSuffixOf` before -> + CrLf + _ -> Lf + +-- | Set every line ending in a text the given way. +setNewlineStyle :: NewlineStyle -> Text -> Text +setNewlineStyle style = case style of + Lf -> toNewlines + CrLf -> T.replace "\n" "\r\n" . toNewlines + where + toNewlines = T.replace "\r\n" "\n" diff --git a/src/Tilia/Package.hs b/src/Tilia/Package.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Package.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Information coming from .cabal files. +module Tilia.Package + ( PackageProblem (..), + describePackageProblem, + PackageReader, + newPackageReader, + ) +where + +import Data.ByteString qualified as BS +import Data.IORef +import Data.List (isSuffixOf, sortOn) +import Data.List.NonEmpty qualified as NE +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Ord (Down (..)) +import Data.Text (Text) +import Data.Text qualified as T +import Distribution.Fields.ParseResult (runParseResult) +import Distribution.PackageDescription + ( Benchmark (..), + BuildInfo (..), + CondTree (..), + Executable (..), + GenericPackageDescription (..), + Library (..), + TestSuite (..), + ) +import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) +import Distribution.Parsec (showPError) +import Distribution.Utils.Path (getSymbolicPath) +import GHC.Driver.Session qualified as GHC +import GHC.LanguageExtensions.Type (Extension) +import Language.Haskell.Extension qualified as Cabal +import System.Directory (canonicalizePath, doesDirectoryExist, listDirectory) +import System.FilePath (equalFilePath, splitDirectories, takeDirectory, ()) +import Tilia.Pragma (lookupExtension) +import Tilia.Utils (attempted, quietly) + +-- | Why a file's extensions could not be settled. +data PackageProblem + = -- | No @.cabal@ file at or above the module. + NoPackageFile + | -- | A @.cabal@ file that could not be read at all, and what went wrong. + PackageUnreadable FilePath Text + | -- | A @.cabal@ file that was read but did not parse, and everything the + -- parser had to say about it. One message per line, each already + -- carrying the position it refers to. + PackageMalformed FilePath [Text] + | -- | A @.cabal@ file naming no component whose @hs-source-dirs@ holds + -- the module. + FileUnclaimed FilePath + deriving (Eq, Show) + +-- | Say what went wrong, in one line. +describePackageProblem :: PackageProblem -> Text +describePackageProblem = \case + NoPackageFile -> "no .cabal file above it" + PackageUnreadable file why -> T.pack file <> " could not be read: " <> why + PackageMalformed file complaints -> + T.pack file <> " does not parse:" <> foldMap ("\n " <>) complaints + FileUnclaimed file -> + T.pack file <> " names no component whose hs-source-dirs holds it" + +-- | What we retain from reading a .cabal file. +type PackageReader = FilePath -> IO (Either PackageProblem [Extension]) + +-- | A 'PackageReader' that remembers what it has already worked out. +newPackageReader :: IO PackageReader +newPackageReader = do + covering <- newIORef Map.empty + described <- newIORef Map.empty + pure $ \path -> quietly (Left NoPackageFile) $ do + file <- canonicalizePath path + from <- startingDirectory file + findCabalFile covering from >>= \case + Nothing -> pure (Left NoPackageFile) + Just cabalFile -> + componentsOf described cabalFile >>= \case + Left problem -> pure (Left problem) + Right components -> pure $ case claiming file components of + Just c -> Right (componentExtensions c) + Nothing -> Left (FileUnclaimed cabalFile) + +-- | Where to start looking for a @.cabal@ file. +startingDirectory :: FilePath -> IO FilePath +startingDirectory path = do + isDirectory <- quietly False (doesDirectoryExist path) + pure (if isDirectory then path else takeDirectory path) + +-- | A component of a package, with everything about it already worked out. +data Component = Component + { -- | Its source directories, absolute and canonical. + componentDirs :: [FilePath], + -- | The extensions it puts in force. + componentExtensions :: [Extension] + } + +-- | Which component holds the file, of those whose directories cover it. +claiming :: FilePath -> [Component] -> Maybe Component +claiming file components = + case sortOn (Down . fst) [(nearness c, c) | c <- components, covered c] of + ((_, c) : _) -> Just c + [] -> Nothing + where + covered = not . null . covering + nearness = maximum . map length . covering + covering c = [d | d <- componentDirs c, d `covers` file] + +-- | Whether a file is somewhere under a directory. +covers :: FilePath -> FilePath -> Bool +covers directory file = go (splitDirectories directory) (splitDirectories file) + where + go [] (_ : _) = True + go (d : ds) (f : fs) = equalFilePath d f && go ds fs + go _ _ = False + +-- | The nearest @.cabal@ file at or above a directory. +findCabalFile :: + -- | What is known already, by directory: the file covering it, or + -- 'Nothing' for one with no @.cabal@ anywhere above it. Read before the + -- walk and added to after it, for every directory the walk passed through + -- rather than only the one asked about—none of the others held a @.cabal@ + -- either, which is why the walk went through them, so the answer is + -- theirs as well. + IORef (Map FilePath (Maybe FilePath)) -> + -- | Where to start, which is walked upwards until a @.cabal@ file turns + -- up or the filesystem root is reached. + FilePath -> + IO (Maybe FilePath) +findCabalFile ref = climb [] + where + climb passed directory = do + known <- readIORef ref + case Map.lookup directory known of + Just answer -> settle passed answer + Nothing -> do + entries <- quietly [] (listDirectory directory) + case filter (".cabal" `isSuffixOf`) entries of + (named : _) -> settle (directory : passed) (Just (directory named)) + [] -> + let parent = takeDirectory directory + in if parent == directory + then settle (directory : passed) Nothing + else climb (directory : passed) parent + settle passed answer = do + modifyIORef' ref (\m -> foldl' (\acc d -> Map.insert d answer acc) m passed) + pure answer + +-- | What a @.cabal@ file amounts to. +componentsOf :: + IORef (Map FilePath (Either PackageProblem [Component])) -> + FilePath -> + IO (Either PackageProblem [Component]) +componentsOf ref cabalFile = do + known <- readIORef ref + case Map.lookup cabalFile known of + Just answer -> pure answer + Nothing -> do + answer <- settle + modifyIORef' ref (Map.insert cabalFile answer) + pure answer + where + settle = + attempted (BS.readFile cabalFile) >>= \case + Left why -> pure (Left (PackageUnreadable cabalFile why)) + Right bytes -> + case snd (runParseResult (parseGenericPackageDescription bytes)) of + Left (_, complaints) -> + pure (Left (PackageMalformed cabalFile (map said (NE.toList complaints)))) + Right description -> + Right + <$> traverse + (component (takeDirectory cabalFile)) + (buildInfos description) + said = T.pack . showPError cabalFile + +-- | One component, with its directories resolved and its extensions settled. +component :: FilePath -> BuildInfo -> IO Component +component root bi = do + dirs <- traverse (quietlyCanonical . (root )) (sourceDirsOf bi) + pure + Component + { componentDirs = concat dirs, + componentExtensions = extensionsInForce bi + } + where + sourceDirsOf b = case map getSymbolicPath (hsSourceDirs b) of + [] -> ["."] + ds -> ds + quietlyCanonical d = + quietly [] $ + doesDirectoryExist d >>= \case + True -> pure <$> canonicalizePath d + False -> pure [] + +-- | Every component's build settings, in the order they are declared. +buildInfos :: GenericPackageDescription -> [BuildInfo] +buildInfos described = + concat + [ foldMap (pure . libBuildInfo . condTreeData) (condLibrary described), + named (libBuildInfo . condTreeData) (condSubLibraries described), + named (buildInfo . condTreeData) (condExecutables described), + named (testBuildInfo . condTreeData) (condTestSuites described), + named (benchmarkBuildInfo . condTreeData) (condBenchmarks described) + ] + where + named f = map (f . snd) + +-- | The extensions a component puts in force, before any module's pragmas. +extensionsInForce :: BuildInfo -> [Extension] +extensionsInForce bi = + foldl apply (GHC.languageExtensions edition) (defaultExtensions bi) + where + edition = ghcLanguage =<< defaultLanguage bi + apply acc = \case + Cabal.EnableExtension e + | Just on <- named e, on `notElem` acc -> acc <> [on] + Cabal.DisableExtension e + | Just off <- named e -> filter (/= off) acc + _ -> acc + named = lookupExtension . T.pack . show + +-- | GHC's name for a language edition, when it has one. +ghcLanguage :: Cabal.Language -> Maybe GHC.Language +ghcLanguage l = lookup (show l) [(show e, e) | e <- [minBound .. maxBound]] diff --git a/src/Tilia/Palette.hs b/src/Tilia/Palette.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Palette.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | The color palette abstraction for printing to color-capable terminals. +module Tilia.Palette + ( Palette (..), + paletteFor, + Color (..), + paint, + marker, + ) +where + +import Data.Maybe (isJust) +import Data.Text (Text) +import System.Environment (lookupEnv) +import System.IO (hIsTerminalDevice, stdout) + +-- | Whether to color the output. +data Palette = Colors | Plain + deriving (Eq, Show) + +-- | Color output when there is somebody there to see it. +paletteFor :: IO Palette +paletteFor = do + refused <- lookupEnv "NO_COLOR" + terminal <- hIsTerminalDevice stdout + pure $ + if terminal && not (isJust refused) + then Colors + else Plain + +-- | Different kinds of colors, classified semantically. +data Color + = -- | A diff's hunk headings and its asides. + Meta + | -- | A line a change removes. + Gone + | -- | A line a change adds. + New + | -- | A line a change leaves alone. + Unchanged + | -- | Something that went well. + Good + | -- | Something that did not, without being wrong. + Middling + | -- | Something wrong. + Bad + | -- | An operator. + Operator + | -- | Somewhere a message points at—a file, a module, the heading over a + -- file's diff. + Place + | -- | A heading over what follows it. + Header Color + deriving (Eq, Show) + +-- | Color one piece of text, and only that piece. +paint :: Palette -> Color -> Text -> Text +paint Plain _ t = t +paint Colors color t = code color <> t <> "\ESC[0m" + where + code = \case + Meta -> "\ESC[36m" + Gone -> "\ESC[31m" + New -> "\ESC[32m" + Unchanged -> "\ESC[39m" + Good -> "\ESC[32m" + Middling -> "\ESC[33m" + Bad -> "\ESC[31m" + Operator -> "\ESC[36m" + Place -> "\ESC[1m" + Header i -> "\ESC[1m" <> code i + +-- | A marker in brackets, as the summary lines wear one. +marker :: Palette -> Color -> Text -> Text +marker palette color mark = "[" <> paint palette color mark <> "]" diff --git a/src/Tilia/Parser.hs b/src/Tilia/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Parser.hs @@ -0,0 +1,263 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Turning source text into a syntax tree and a comment stream. +module Tilia.Parser + ( ParsedModule (..), + parseModule, + parseConfiguration, + ParseError (..), + describeParseError, + ParserConfig (..), + defaultParserConfig, + parserConfigFor, + ghcLibParserVersion, + ) +where + +import Data.Foldable (toList) +import Data.List (isSuffixOf, nub, sortOn) +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Data.EnumSet qualified as EnumSet +import GHC.Data.FastString (mkFastString) +import GHC.Data.StringBuffer qualified as GHC +import GHC.Driver.Session qualified as GHC +import GHC.Hs (HsModule (..)) +import GHC.Hs.Extension (GhcPs) +import GHC.LanguageExtensions.Type (Extension) +import GHC.Parser qualified as GHC +import GHC.Parser.Annotation (getLocA) +import GHC.Parser.Lexer qualified as GHC +import GHC.Types.Error qualified as GHC +import GHC.Types.SrcLoc qualified as GHC +import GHC.Unit.Module.Warnings (emptyWarningCategorySet) +import GHC.Utils.Error qualified as GHC +import GHC.Utils.Outputable qualified as GHC +import Tilia.Pragma (effectiveExtensions) +import Tilia.Source (Lines, Source, SourceType (..), Written (..), lineTexts, linesOf, sourceOf) +import Tilia.Span (Span (..)) +import Tilia.Span.Ghc (spanOfReal) + +-- | A module that parsed, together with the comments found in it. +data ParsedModule = ParsedModule + { -- | The syntax tree, exactly as GHC produced it. + pmModule :: HsModule GhcPs, + -- | The module as its author wrote it. + pmSource :: Source, + -- | Whether GHC read this as a module or as a Backpack signature. + pmSourceType :: SourceType, + -- | The lines above the module that the parser never sees. + -- + -- The lexer skips a @#!@ line, which puts it in no annotation and no + -- node, so nothing downstream could put it back. Whatever empty line + -- follows the last of them is kept too: it is what holds the module off + -- the interpreter line, and it is the author's to decide. + pmPrologue :: [Text], + -- | Where the file header stops and the module proper begins, if the + -- module has anything after its header. + -- + -- GHC reads pragmas from the header and nowhere else, so this is the + -- line that decides whether a @{-# … #-}@ is a pragma at all. One + -- written below it has no effect on compilation, and hoisting it to the + -- top of the module would change its meaning. + pmHeaderEnd :: Maybe Span + } + +-- | Parse a module. +parseModule :: + ParserConfig -> + -- | Path, used only in positions reported back + FilePath -> + -- | The source + Text -> + Either ParseError ParsedModule +parseModule config path source = + parseConfiguration config path (linesOf (Written source)) source + +-- | Parse one configuration of a module. +-- +-- The text to parse is one configuration of the module; the 'Written' text +-- is the module the author wrote, which is what every question about the +-- source is answered against. Without the preprocessor the two are the same +-- text and this is 'parseModule'. +parseConfiguration :: + ParserConfig -> + -- | Path, used only in positions reported back + FilePath -> + -- | The lines of the module as written, except for the lines that do not + -- belong to this configuration + Lines -> + -- | The configuration of it to parse + Text -> + Either ParseError ParsedModule +parseConfiguration config path written source = + case GHC.unP entryPoint initialState of + GHC.PFailed pstate -> Left (whyNot pstate) + GHC.POk pstate (GHC.L _ hsModule) + | not (GHC.isEmptyMessages (GHC.getPsErrorMessages pstate)) -> + Left (whyNot pstate) + | otherwise -> + Right + ParsedModule + { pmModule = hsModule, + pmSource = sourceOf written (headerComments pstate) hsModule, + pmSourceType = sourceType, + pmPrologue = prologueOf (lineTexts written), + pmHeaderEnd = headerEndOf hsModule + } + where + -- Everything above the @signature@ keyword: the parser leaves those + -- here rather than in the tree. A module's are in both. + headerComments = concat . GHC.header_comments + + sourceType = sourceTypeOf path + + entryPoint = case sourceType of + ModuleSource -> GHC.parseModule + SignatureSource -> GHC.parseSignature + + whyNot pstate = + case sortOn at (toList (GHC.getMessages (GHC.getPsErrorMessages pstate))) of + m : _ -> ParseError {peSpan = GHC.errMsgSpan m, peProblem = saying m} + [] -> + ParseError + { peSpan = GHC.mkSrcSpanPs (GHC.last_loc pstate), + peProblem = "parse error" + } + + at m = case GHC.srcSpanToRealSrcSpan (GHC.errMsgSpan m) of + Just s -> (GHC.srcSpanStartLine s, GHC.srcSpanStartCol s) + Nothing -> (maxBound, maxBound) + + saying = + T.pack + . GHC.showSDocUnsafe + . GHC.vcat + . GHC.unDecorated + . GHC.diagnosticMessage GHC.NoDiagnosticOpts + . GHC.errMsgDiagnostic + + config' = + config + { pcExtensions = withImplied (effectiveExtensions (pcExtensions config) source) + } + + initialState = + GHC.initParserState + (parserOpts config') + (GHC.stringToStringBuffer (T.unpack source)) + (GHC.mkRealSrcLoc (mkFastString path) 1 1) + +-- | Close a set of extensions under what they imply. +withImplied :: [Extension] -> [Extension] +withImplied = settle . nub + where + settle es = + let es' = nub (es <> concatMap implied es) + in if length es' == length es then es else settle es' + implied e = [to | (from, GHC.On to) <- GHC.impliedXFlags, from == e] + +-- | Options to parse with. +parserOpts :: ParserConfig -> GHC.ParserOpts +parserOpts ParserConfig {pcExtensions} = + GHC.mkParserOpts + (EnumSet.fromList pcExtensions) + quietDiagnostics + False -- safe imports + True -- keep Haddock tokens + True -- keep ordinary comment tokens + True -- let @LINE@ and @COLUMN@ pragmas move the source position + +-- | Diagnostics are not reported, so the settings only have to be +-- well-formed. +quietDiagnostics :: GHC.DiagOpts +quietDiagnostics = + GHC.DiagOpts + { GHC.diag_warning_flags = EnumSet.empty, + GHC.diag_fatal_warning_flags = EnumSet.empty, + GHC.diag_custom_warning_categories = emptyWarningCategorySet, + GHC.diag_fatal_custom_warning_categories = emptyWarningCategorySet, + GHC.diag_warn_is_error = False, + GHC.diag_reverse_errors = False, + GHC.diag_max_errors = Nothing, + GHC.diag_ppr_ctx = GHC.defaultSDocContext + } + +-- | The @#!@ lines a file begins with, and the empty line after them. +-- +-- At most one empty line is taken: the rest would only be collapsed +-- wherever they were reproduced, so keeping them would be keeping a +-- distinction that cannot survive. +prologueOf :: [Text] -> [Text] +prologueOf ls = case span isShebang ls of + ([], _) -> [] + (shebangs, rest) -> shebangs <> filter T.null (take 1 rest) + where + isShebang = T.isPrefixOf "#!" + +-- | The start of the first thing that is not part of the header. +-- +-- Imports and declarations are the only things that can end a header, and +-- either may come first, so both are consulted. +headerEndOf :: HsModule GhcPs -> Maybe Span +headerEndOf hsModule = + foldl' earliest Nothing $ + map getLocA (hsmodImports hsModule) + <> map getLocA (hsmodDecls hsModule) + where + earliest acc l = case GHC.srcSpanToRealSrcSpan l of + Nothing -> acc + Just s -> + let this = spanOfReal s + in Just (maybe this (keepEarlier this) acc) + keepEarlier a b + | (spanStartLine a, spanStartColumn a) <= (spanStartLine b, spanStartColumn b) = a + | otherwise = b + +-- | Why a module did not parse. +data ParseError = ParseError + { -- | Where the parser gave up. + peSpan :: GHC.SrcSpan, + -- | GHC's rendered error message. + peProblem :: Text + } + +-- | Present 'ParseError' in a human-friendly form. +describeParseError :: ParseError -> Text +describeParseError e = + T.pack (GHC.showSDocUnsafe (GHC.ppr (peSpan e))) <> ": " <> peProblem e + +-- | What the parser is allowed to accept. +newtype ParserConfig = ParserConfig + { -- | Extensions to enable before parsing. + pcExtensions :: [Extension] + } + +-- | What to parse with when there is no package to ask. +defaultParserConfig :: ParserConfig +defaultParserConfig = parserConfigFor [] + +-- | What to parse with, given whatever the package had to say. +parserConfigFor :: + -- | What the package puts in force, or nothing if there is no package + [Extension] -> + -- | The resulting parser config + ParserConfig +parserConfigFor package = + ParserConfig + { pcExtensions = + if null package + then GHC.languageExtensions (Just GHC.GHC2021) + else package + } + +-- | What a file's name says it holds. +sourceTypeOf :: FilePath -> SourceType +sourceTypeOf path + | ".hsig" `isSuffixOf` path = SignatureSource + | otherwise = ModuleSource + +-- | The version of @ghc-lib-parser@ this was built against. +ghcLibParserVersion :: String +ghcLibParserVersion = VERSION_ghc_lib_parser diff --git a/src/Tilia/Pragma.hs b/src/Tilia/Pragma.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Pragma.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Pragma-related helpers. +module Tilia.Pragma + ( movesPositions, + effectiveExtensions, + lookupExtension, + ) +where + +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Driver.Session qualified as GHC +import GHC.LanguageExtensions.Type (Extension (..)) + +-- | Recognize @{-# LINE #-}@ and @{-# COLUMN #-}@ pragmas. +movesPositions :: Text -> Bool +movesPositions = any positional . pragmaBodies + where + positional body = + T.toUpper (T.takeWhile (/= ' ') body) `elem` ["LINE", "COLUMN"] + +-- | The extensions actually in force in a module. +effectiveExtensions :: + -- | What the package the module belongs to puts in force, which is its + -- @default-language@ and @default-extensions@ already resolved into a + -- set. + [Extension] -> + -- | The module's source, read here for its @LANGUAGE@ pragmas alone. + Text -> + [Extension] +effectiveExtensions package + | null package = pragmasOver onUnlessRefused + | otherwise = pragmasOver package + +-- | The extensions that are on until something says otherwise. +onUnlessRefused :: [Extension] +onUnlessRefused = [ImplicitPrelude] + +-- | Apply a module's @LANGUAGE@ pragmas to a starting set. +pragmasOver :: [Extension] -> Text -> [Extension] +pragmasOver initial = foldl' apply initial . concatMap pragmaNames . pragmaBodies + where + apply acc name = case T.stripPrefix "No" name >>= lookupExtension of + Just off -> filter (/= off) acc + Nothing -> case lookupExtension name of + Just on | on `notElem` acc -> acc <> [on] + _ -> acc + pragmaNames body = + let (keyword, names) = T.break (== ' ') body + in if T.toUpper keyword == "LANGUAGE" + then filter (not . T.null) (map T.strip (T.splitOn "," names)) + else [] + +-- | The extension one writes this name for, if any compiler knows it. +lookupExtension :: Text -> Maybe Extension +lookupExtension name = Map.lookup name extensionsByName + +-- | Every extension this compiler knows, by the name one writes in a +-- pragma. +extensionsByName :: Map Text Extension +extensionsByName = + Map.fromList + [(T.pack (GHC.flagSpecName f), GHC.flagSpecFlag f) | f <- GHC.xFlags] + +-- | What every @{-# … #-}@ in a module has between its braces, each on one +-- line. +pragmaBodies :: Text -> [Text] +pragmaBodies = go + where + go = step . T.dropWhile (\c -> c /= '{' && c /= '-' && c /= '"') + + step t + | T.null t = [] + | Just body <- T.stripPrefix "{-#" t = case T.breakOn "#-}" body of + (_, after) | T.null after -> [] + (inner, after) -> T.unwords (T.words inner) : go (T.drop 3 after) + | Just after <- T.stripPrefix "{-" t = go (skipBlock (1 :: Int) after) + | opensLineComment t = go (T.dropWhile (/= '\n') t) + | Just after <- T.stripPrefix "\"" t = go (skipString after) + | otherwise = go (T.drop 1 t) + + opensLineComment t = case T.stripPrefix "--" t of + Nothing -> False + Just rest -> maybe True (not . symbolic . fst) (T.uncons rest) + + symbolic c = c `elem` ("!#$%&*+./<=>?@\\^|-~:" :: String) + + skipBlock 0 t = t + skipBlock n t0 = inBlock n (T.dropWhile (\c -> c /= '{' && c /= '-') t0) + + inBlock n t + | T.null t = t + | Just after <- T.stripPrefix "{-" t = skipBlock (n + 1) after + | Just after <- T.stripPrefix "-}" t = skipBlock (n - 1) after + | otherwise = skipBlock n (T.drop 1 t) + + skipString = inString . T.dropWhile (\c -> c /= '"' && c /= '\\') + + inString t + | T.null t = t + | Just after <- T.stripPrefix "\\" t = skipString (T.drop 1 after) + | Just after <- T.stripPrefix "\"" t = after + | otherwise = skipString (T.drop 1 t) diff --git a/src/Tilia/Process.hs b/src/Tilia/Process.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Process.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE LambdaCase #-} + +-- | Running a program and reading its output. +module Tilia.Process (readProgramOutput) where + +import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar) +import Data.ByteString qualified as BS +import Data.Foldable (traverse_) +import Data.Text (Text) +import Data.Text.Encoding qualified as T +import System.Exit (ExitCode (..)) +import System.IO (Handle, hClose, hSetBinaryMode) +import System.Process + ( StdStream (CreatePipe), + proc, + std_err, + std_in, + std_out, + waitForProcess, + withCreateProcess, + ) +import Tilia.Newline (NewlineStyle (Lf), setNewlineStyle) +import Tilia.Utils (quietly) + +-- | Run a program and read what it printed on standard output. +-- +-- 'Nothing' where it could not be run at all or did not succeed, which the +-- callers treat alike: both mean this program has nothing to tell them. +-- Whatever it printed on its error stream is read but not kept—see 'drain' +-- for why it has to be read—because the one thing worse than a tool that +-- cannot answer is a tool that says so over the formatter's own output. +-- +-- Line endings come back as newlines however the program wrote them. A +-- child writing to a pipe on Windows ends its lines the Windows way, and +-- every caller here goes on to split what it gets into lines and compare +-- them against something. +readProgramOutput :: FilePath -> [String] -> IO (Maybe Text) +readProgramOutput program args = quietly Nothing $ + withCreateProcess spec $ \toChild fromChild childErrors running -> do + traverse_ hClose toChild + waitForErrors <- forked (drain childErrors) + out <- drain fromChild + _ <- waitForErrors + waitForProcess running >>= \case + ExitSuccess -> pure (Just (setNewlineStyle Lf (T.decodeUtf8Lenient out))) + _ -> pure Nothing + where + spec = + (proc program args) + { std_in = CreatePipe, + std_out = CreatePipe, + std_err = CreatePipe + } + +-- | Read a pipe to its end. +drain :: Maybe Handle -> IO BS.ByteString +drain = \case + Nothing -> pure BS.empty + Just h -> quietly BS.empty (hSetBinaryMode h True >> BS.hGetContents h) + +-- | Start an action now and hand back the waiting callback for it. +forked :: IO a -> IO (IO a) +forked action = do + done <- newEmptyMVar + _ <- forkIO (action >>= putMVar done) + pure (takeMVar done) diff --git a/src/Tilia/Project.hs b/src/Tilia/Project.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Project.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Finding the project a file belongs to. +-- +-- A formatter is usually handed a file, not a project. An editor may run it +-- with the working directory set to the file's own directory, or to the +-- editor's, or to wherever the user happened to start it. None of those is +-- reliably the root, and the root is what the build plan and the package +-- cache are found relative to. +module Tilia.Project + ( ProjectRoot (..), + Marker (..), + markerFile, + findProjectRoot, + ) +where + +import Data.List (isSuffixOf) +import Data.Maybe (listToMaybe) +import System.Directory + ( canonicalizePath, + doesDirectoryExist, + listDirectory, + ) +import System.FilePath (takeDirectory) +import Tilia.Utils (quietly) + +-- | A project, and what marked it out. +data ProjectRoot = ProjectRoot + { -- | The directory. + prPath :: FilePath, + -- | What identified it. + prMarker :: Marker + } + deriving (Eq, Show) + +-- | What a project was recognised by. +-- +-- The two are read differently—one names the packages of a build, the +-- other is a package—so which it was has to survive being found. +data Marker + = -- | A @cabal.project@, which names the packages. + ProjectFile + | -- | A @.cabal@ file, by its name: a package with no project around it. + PackageFile FilePath + deriving (Eq, Show) + +-- | The file a marker stands for, for reporting. +markerFile :: Marker -> FilePath +markerFile = \case + ProjectFile -> "cabal.project" + PackageFile named -> named + +-- | Walk upwards from a file or directory looking for a project. +-- +-- A @cabal.project@ anywhere above wins over a @.cabal@ file nearer to +-- hand, so that a package inside a multi-package repository resolves to the +-- repository rather than to itself. That is where @cabal@ solves the build +-- and writes the plan, and a run rooted at the package would go looking for +-- a plan that is one directory up. +-- +-- Only what @cabal@ reads counts. A @stack.yaml@ is not a project here: it +-- would stop the climb at a directory @cabal@ cannot solve in, whereas +-- passing over it settles on a @.cabal@ that @cabal@ can, which is the +-- difference between formatting a stack project and refusing it. +-- +-- Stops at the filesystem root and returns 'Nothing' rather than guessing. +-- Formatting a file that belongs to no project is a perfectly ordinary +-- thing to do; it simply cannot have its fixities resolved. +findProjectRoot :: FilePath -> IO (Maybe ProjectRoot) +findProjectRoot start = quietly Nothing $ do + from <- startingDirectory + found <- traverse markersIn (from : ancestorsOf from) + pure (listToMaybe (concatMap fst found <> concatMap snd found)) + where + startingDirectory = do + absolute <- canonicalizePath start + isDirectory <- doesDirectoryExist absolute + pure (if isDirectory then absolute else takeDirectory absolute) + + ancestorsOf directory = + let parent = takeDirectory directory + in if parent == directory then [] else parent : ancestorsOf parent + + markersIn directory = quietly ([], []) $ do + entries <- listDirectory directory + pure + ( [ProjectRoot directory ProjectFile | "cabal.project" `elem` entries], + [ ProjectRoot directory (PackageFile named) + | named <- take 1 (filter (".cabal" `isSuffixOf`) entries) + ] + ) diff --git a/src/Tilia/Render.hs b/src/Tilia/Render.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render.hs @@ -0,0 +1,188 @@ +-- | Turning a parsed module into a document. +module Tilia.Render + ( RenderConfig (..), + defaultRenderConfig, + renderModule, + ) +where + +import Data.Choice (fromBool) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Set (Set) +import Data.Set qualified as Set +import Data.Text (Text) +import GHC.Hs (HsModule (..), XModulePs (..)) +import GHC.Hs.Extension (GhcPs) +import GHC.LanguageExtensions.Type (Extension (..)) +import GHC.Types.SrcLoc (getLoc) +import Tilia.Comments + ( Comment (..), + bracketed, + closesItself, + commentTrailing, + escapeTrigger, + widenTrigger, + ) +import Tilia.Comments.Attach (attachComments) +import Tilia.Doc.Combinators +import Tilia.Fixity (Scope) +import Tilia.Imports (normalizeImports) +import Tilia.Parser (ParsedModule (..)) +import Tilia.Render.Context +import Tilia.Render.Declaration (decls, declsKeepingGroups) +import Tilia.Render.Expression (hsCmd, hsExprIn, untypedSplice) +import Tilia.Render.Haddock (haddockSpans) +import Tilia.Render.Header (HeaderPragma (..), hsModule, takeHeaderPragmas, takeStackHeader) +import Tilia.Render.Signature (sigDecl) +import Tilia.Source (comments) +import Tilia.Span +import Tilia.Span.Ghc (spanOf, spanOfSrcSpan) + +-- | What the printer needs to know about the module beyond its text. +data RenderConfig = RenderConfig + { -- | Extensions in force, from the module's own pragmas and from the + -- package it belongs to. + rcExtensions :: Set Extension, + -- | What the module can see, if it could be worked out. + rcScope :: Maybe Scope, + -- | Source lines the import block must not be sorted across. + rcImportBarriers :: [Int] + } + +-- | A configuration that asserts nothing. +defaultRenderConfig :: RenderConfig +defaultRenderConfig = + RenderConfig + { rcExtensions = Set.empty, + rcScope = Nothing, + rcImportBarriers = [] + } + +-- | Render a parsed module, comments and all. +renderModule :: RenderConfig -> ParsedModule -> Doc +renderModule settings parsed = + prologue (pmPrologue parsed) + <> stackHeader + <> attachComments loose (hsModule ctx pragmas (sorted hsMod)) + where + hsMod = pmModule parsed + (haddocks, loose') = splitHaddocks hsMod (comments (pmSource parsed)) + plain = heldOff haddocks loose' + (stackHeader, rest) = takeStackHeader (pmHeaderEnd parsed) plain + (pragmas, uncovered) = takeHeaderPragmas (pmSource parsed) (pmHeaderEnd parsed) rest + loose = heldOffModuleDoc hsMod haddocks pragmas uncovered + + implicitPrelude = + fromBool (Set.member ImplicitPrelude (rcExtensions settings)) + + sorted m = + m + { hsmodImports = + normalizeImports + implicitPrelude + (rcImportBarriers settings) + (comments (pmSource parsed)) + (hsmodImports m) + } + ctx = + Ctx + { ctxExtensions = rcExtensions settings, + ctxSourceType = pmSourceType parsed, + ctxScope = rcScope settings, + ctxSource = pmSource parsed, + ctxLineComments = indexOn (filter (not . closesItself) loose), + ctxHaddocks = indexOn haddocks, + ctxKnot = knot + } + +-- | Keep a comment from running into a Haddock. +heldOff :: [Comment] -> [Comment] -> [Comment] +heldOff haddocks = map holdOff + where + written = filter (not . bracketed) haddocks + ends = Set.fromList (map (spanEndLine . commentSpan) written) + starts = + Set.fromList + [ spanStartLine (commentSpan h) + | h <- written, + not (commentTrailing h) + ] + holdOff c + | bracketed c = c + | otherwise = + c + { commentGapAbove = + commentGapAbove c || Set.member (spanStartLine s - 1) ends, + commentGapBelow = + commentGapBelow c || Set.member (spanEndLine s + 1) starts + } + where + s = commentSpan c + +-- | Hold the first comment of the header off the module's own Haddock. +heldOffModuleDoc :: + HsModule GhcPs -> + -- | The Haddocks of the module, the module's own among them + [Comment] -> + -- | The pragmas the header is about to hoist + [HeaderPragma] -> + [Comment] -> + [Comment] +heldOffModuleDoc hsMod haddocks pragmas cs + | Just ended <- endOfModuleDoc, + Just began <- startOfModuleLine, + (before', c : after') <- break (uncoveredBetween ended began) cs = + before' <> (c {commentGapAbove = True} : after') + | otherwise = cs + where + uncoveredBetween ended began c = + ended < spanStartLine here + && spanStartLine here < began + && not (Set.member (spanEndLine here + 1) travellers) + where + here = commentSpan c + travellers = Set.fromList (map (spanStartLine . hpSpan) pragmas) + endOfModuleDoc = do + s <- moduleDoc + c <- lookup (startPoint s) [(startPoint (commentSpan h), h) | h <- haddocks] + if bracketed c then Nothing else Just (spanEndLine s) + moduleDoc = case hsmodExt hsMod of + XModulePs {hsmodHaddockModHeader = Just d} -> spanOfSrcSpan (getLoc d) + _ -> Nothing + startOfModuleLine = spanStartLine <$> (spanOf =<< hsmodName hsMod) + +-- | The lines above the module, put back exactly as they were written. +prologue :: [Text] -> Doc +prologue = foldMap (\l -> txt l <> hardBreak) + +-- | The knot: the printers that a module below their definition needs. +knot :: Knot +knot = + Knot + { knotExpr = hsExprIn, + knotCmd = hsCmd, + knotSplice = untypedSplice, + knotSig = sigDecl, + knotDecls = decls, + knotDeclsGrouped = declsKeepingGroups + } + +-- | Separate the comments the syntax tree also knows about from the rest. +splitHaddocks :: + HsModule GhcPs -> + -- | Every comment in the module + [Comment] -> + -- | The ones the tree carries, and the ones it does not + ([Comment], [Comment]) +splitHaddocks hsMod = foldr sort' ([], []) + where + inTree = Set.fromList (map startPoint (haddockSpans hsMod)) + sort' c (docs, rest) + | startPoint (commentSpan c) `Set.member` inTree = + (widenTrigger c : docs, rest) + | otherwise = (docs, escapeTrigger c : rest) + +-- | Index comments by where they begin. +indexOn :: [Comment] -> Map (Int, Int) Comment +indexOn cs = Map.fromList [(startPoint (commentSpan c), c) | c <- cs] diff --git a/src/Tilia/Render/Body.hs b/src/Tilia/Render/Body.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Body.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE LambdaCase #-} + +-- | Which constructs absorb the line break that introduces them. +-- +-- A body is a node together with the site it stands at, and the one question +-- an enclosing construct has to ask of it is where to put it: on the line it +-- has already started, or on the next one indented. "Tilia.Doc.Body" +-- states that question as a class; this module answers it, for the two kinds +-- of node that can stand as a body. +-- +-- The answers are a table, not an argument. Threading a @body -> Placement@ +-- callback through every construct that has a body—equations, guards, @if@, +-- @let@, @case@, lambdas, statements—spreads one small piece of knowledge +-- across a dozen signatures and makes each of them carry a second parameter +-- that only ever has two possible values. Here it is written down once, and +-- what the constructs pass around is the body itself. +module Tilia.Render.Body + ( -- * Bodies + ExprBody (..), + CmdBody (..), + CmdTopBody (..), + + -- * The table + exprHangs, + operatorName, + cmdTopHangs, + ) +where + +import GHC.Hs +import GHC.Types.Name.Occurrence (occNameString) +import GHC.Types.Name.Reader (RdrName, rdrNameOcc) +import GHC.Types.SrcLoc (GenLocated (..), unLoc) +import Tilia.Doc.Body +import Tilia.Doc.Combinators +import Tilia.Render.Context +import Tilia.Span +import Tilia.Span.Ghc + +---------------------------------------------------------------------------- +-- Bodies + +-- | An expression standing as the body of an enclosing construct. +data ExprBody = ExprBody Ctx Site (LHsExpr GhcPs) + +instance Body ExprBody where + printBody (ExprBody ctx site e) = knotExpr (ctxKnot ctx) ctx site e + bodyPlacement (ExprBody _ _ e) = exprHangs (unLoc e) + +-- | A command standing as the body of an enclosing construct. +data CmdBody = CmdBody Ctx Site (LHsCmd GhcPs) + +instance Body CmdBody where + printBody (CmdBody ctx site c) = knotCmd (ctxKnot ctx) ctx site c + bodyPlacement (CmdBody _ _ c) = cmdHangs (unLoc c) + +-- | A command at the top of an arrow form. +data CmdTopBody = CmdTopBody Ctx Site (LHsCmdTop GhcPs) + +instance Body CmdTopBody where + printBody (CmdTopBody ctx site l) = + at ctx l (\(HsCmdTop _ cmd) -> knotCmd (ctxKnot ctx) ctx site cmd) + bodyPlacement (CmdTopBody _ _ l) = cmdTopHangs (unLoc l) + +---------------------------------------------------------------------------- +-- The table + +-- | Does this expression absorb the line break that introduces it? +-- +-- A @do@ block, a @case@ and a lambda all begin with a keyword and continue +-- on the lines below, so @f = do@ costs nothing and saves a line. Everything +-- not named here has to start on a line of its own. +exprHangs :: HsExpr GhcPs -> Placement +exprHangs = \case + HsDo _ (DoExpr _) _ -> Hanging + HsDo _ (MDoExpr _) _ -> Hanging + HsCase {} -> Hanging + HsLam _ lamVariant mg -> case lamVariant of + LamCase -> Hanging + LamCases -> Hanging + -- A lambda whose parameters ran over several lines leaves its body + -- indented under nothing legible, so only a compact one hangs. + LamSingle -> case mg of + MG _ (L _ [L _ (Match _ _ (L _ ps@(_ : _)) _)]) + | maybe False isSingleLine (spansOf ps) -> Hanging + _ -> Normal + HsProc _ p _ + -- The indentation breaks when the pattern runs over more than one line, + -- so hanging is only safe when it does not. + | maybe False isSingleLine (spanOf p) -> Hanging + | otherwise -> Normal + -- An application hangs on its last argument, and a chain through @$@ on + -- its right operand: both of those are the thing that would be introduced. + -- No other operator qualifies, @$@ being the one whose whole purpose is to + -- hand a block to what precedes it. + HsApp _ _ y -> exprHangs (unLoc y) + OpApp _ _ op y + | Just n <- operatorName op, + occNameString (rdrNameOcc n) == "$" -> + exprHangs (unLoc y) + _ -> Normal + +-- | Does this command absorb the line break that introduces it? +cmdHangs :: HsCmd GhcPs -> Placement +cmdHangs = \case + HsCmdDo {} -> Hanging + HsCmdCase {} -> Hanging + HsCmdLam {} -> Hanging + _ -> Normal + +cmdTopHangs :: HsCmdTop GhcPs -> Placement +cmdTopHangs (HsCmdTop _ c) = cmdHangs (unLoc c) + +-- | The name of an operator, when the expression standing as one is a name. +operatorName :: LHsExpr GhcPs -> Maybe RdrName +operatorName e = case unLoc e of + HsVar _ (L _ n) -> Just n + _ -> Nothing diff --git a/src/Tilia/Render/Class.hs b/src/Tilia/Render/Class.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Class.hs @@ -0,0 +1,353 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | Classes, instances and families. +-- +-- What these have in common is a head followed by a body of declarations, +-- and a recurring difficulty: the syntax tree keeps the body's declarations +-- in several lists—signatures here, bindings there, associated families +-- somewhere else—so the order the author wrote them in survives only in +-- their spans. Every body in this module has to be put back in order before +-- it can be printed. +module Tilia.Render.Class + ( classDecl, + clsInstDecl, + tyFamInstDecl, + dataFamInstDecl, + standaloneDerivDecl, + famDecl, + roleAnnot, + ) +where + +import Data.Function (on) +import Data.List (sortBy) +import Data.Maybe (isNothing) +import GHC.Builtin.Types (cTupleTyConName, isCTupleTyConName) +import GHC.Core.Coercion.Axiom (Role (..)) +import GHC.Hs +import GHC.Types.Fixity (LexicalFixity (..)) +import GHC.Types.Name.Reader (RdrName (..)) +import GHC.Types.SrcLoc (GenLocated (..), leftmost_smallest, unLoc) +import Tilia.Doc.Combinators +import Tilia.Render.Context +import Tilia.Render.Data (dataDecl) +import Tilia.Render.Name +import Tilia.Render.Pragma +import Tilia.Render.Type +import Tilia.Span.Ghc + +---------------------------------------------------------------------------- +-- Classes + +-- | A type class declaration. +classDecl :: + Ctx -> + AnnClassDecl -> + Maybe (LHsContext GhcPs) -> + LocatedN RdrName -> + LHsQTyVars GhcPs -> + LexicalFixity -> + [LHsFunDep GhcPs] -> + [LSig GhcPs] -> + LHsBinds GhcPs -> + [LFamilyDecl GhcPs] -> + [LTyFamDefltDecl GhcPs] -> + [LDocDecl GhcPs] -> + Doc +classDecl ctx anns ctxt tyCon HsQTvs {..} fixity fdeps sigs binds families defaults docs = + txt "class" <> layoutFrom ctx wholeHeadSpan head' <> body + where + headSpan = spanOf tyCon <> spansOf hsq_explicit + whereSpan = tokenSpan (acd_where anns) + wholeHeadSpan = foldMap spanOf ctxt <> headSpan <> spansOf fdeps + + head' = + breakOrSpace + <> indent + ( foldMap (classContext ctx) ctxt + <> layoutFrom ctx headSpan classHead + <> indent (funDeps ctx fdeps) + <> includeUnless + (null members) + (breakOrSpace <> keywordAt ctx whereSpan "where") + ) + + classHead + | isCTuple (unLoc tyCon) (length hsq_explicit) = + layoutWithin ctx (spanOf tyCon) (spansOf hsq_explicit) $ + parens + ( insideBrackets + (spanOf tyCon) + (commaSep (map (align . at_ ctx (tyVarBndr ctx)) hsq_explicit)) + ) + | otherwise = + defHead + (fixity == Infix) + True + (name ctx tyCon) + (map (at_ ctx (tyVarBndr ctx)) hsq_explicit) + + body = + includeUnless + (null members) + (breakOrSpace <> indent (knotDeclsGrouped (ctxKnot ctx) ctx Associated members)) + + members = + inSourceOrder + [ map (fmap (SigD NoExtField)) sigs, + map (fmap (ValD NoExtField)) binds, + map (fmap (TyClD NoExtField . FamDecl NoExtField)) families, + map (fmap (InstD NoExtField . TyFamInstD NoExtField)) defaults, + map (fmap (DocD NoExtField)) docs + ] + +-- | Is this the constraint tuple of the given arity? +isCTuple :: RdrName -> Int -> Bool +isCTuple (Exact n) arity = isCTupleTyConName n && n == cTupleTyConName arity +isCTuple _ _ = False + +-- | A context on a class head, with the @=>@ that follows it. +classContext :: Ctx -> LHsContext GhcPs -> Doc +classContext ctx ctxt + | null (unLoc ctxt) = mempty + | otherwise = context ctx ctxt <> joinedBy "=>" + +-- | The functional dependencies of a class. +funDeps :: Ctx -> [LHsFunDep GhcPs] -> Doc +funDeps _ [] = mempty +funDeps ctx fdeps = + breakOrSpace + <> txt "|" + <> space + <> indent (commaSep (map (align . at_ ctx (funDep ctx)) fdeps)) + +funDep :: Ctx -> FunDep GhcPs -> Doc +funDep ctx (FunDep _ before after) = + hsep (map (name ctx) before) + <> space + <> txt "->" + <> space + <> hsep (map (name ctx) after) + +---------------------------------------------------------------------------- +-- Instances + +-- | A class instance. +clsInstDecl :: Ctx -> ClsInstDecl GhcPs -> Doc +clsInstDecl ctx ClsInstDecl {cid_ext = (warning, anns, _), ..} = + txt "instance" <> layoutFrom ctx headSpan head' <> body + where + headSpan = foldMap spanOf warning <> spanOf cid_poly_ty + whereSpan = tokenSpan (acid_where anns) + + head' = + foldMap (\w -> breakOrSpace <> at ctx w warningTxt) warning + <> breakOrSpace + <> at + ctx + cid_poly_ty + ( \sigTy -> + indent $ + foldMap (<> breakOrSpace) (overlapMode cid_overlap_mode) + <> hsSigTypeBody ctx sigTy + <> includeUnless + (null members) + (breakOrSpace <> keywordAt ctx whereSpan "where") + ) + + body = + includeUnless (null members) . indent $ + breakOrSpace <> knotDeclsGrouped (ctxKnot ctx) ctx Associated members + + members = + inSourceOrder + [ map (fmap (SigD NoExtField)) cid_sigs, + map (fmap (ValD NoExtField)) cid_binds, + map (fmap (InstD NoExtField . TyFamInstD NoExtField)) cid_tyfam_insts, + map (fmap (InstD NoExtField . DataFamInstD NoExtField)) cid_datafam_insts + ] + +-- | A standalone @deriving@ declaration. +standaloneDerivDecl :: Ctx -> DerivDecl GhcPs -> Doc +standaloneDerivDecl ctx DerivDecl {deriv_ext = (warning, _), ..} = + txt "deriving" <> space <> strategy + where + instanceHead indented = + indent $ + txt "instance" + <> foldMap (\w -> breakOrSpace <> at ctx w warningTxt) warning + <> breakOrSpace + <> foldMap (<> breakOrSpace) (overlapMode deriv_overlap_mode) + <> nest (if indented then 1 else 0) (hsSigType ctx (hswc_body deriv_type)) + + strategy = case deriv_strategy of + Nothing -> instanceHead False + Just (L _ s) -> case s of + StockStrategy _ -> txt "stock " <> instanceHead False + AnyclassStrategy _ -> txt "anyclass " <> instanceHead False + NewtypeStrategy _ -> txt "newtype " <> instanceHead False + ViaStrategy (XViaStrategyPs _ sigTy) -> + txt "via" + <> breakOrSpace + <> indent (hsSigType ctx sigTy) + <> breakOrSpace + <> instanceHead True + +-- | A type family instance. +tyFamInstDecl :: Ctx -> FamilyStyle -> TyFamInstDecl GhcPs -> Doc +tyFamInstDecl ctx style TyFamInstDecl {..} = + txt keyword <> breakOrSpace <> indent (tyFamInstEqn ctx tfid_eqn) + where + keyword = case style of + Associated -> "type" + Free -> "type instance" + +-- | A data family instance. +dataFamInstDecl :: Ctx -> FamilyStyle -> DataFamInstDecl GhcPs -> Doc +dataFamInstDecl ctx style (DataFamInstDecl FamEqn {..}) = + dataDecl + ctx + style + feqn_tycon + feqn_pats + typeArgSpan + (typeArgument ctx) + feqn_fixity + outerBinders + feqn_rhs + where + -- @data instance forall k (a :: k). D a = …@ binds its variables ahead + -- of the head, exactly as a type family instance does. + outerBinders = case feqn_bndrs of + HsOuterImplicit NoExtField -> mempty + HsOuterExplicit _ bndrs -> + forallBndrs ctx Invisible (tyVarBndr ctx) bndrs <> breakOrSpace + +---------------------------------------------------------------------------- +-- Families + +-- | A @data family@ or @type family@ declaration. +famDecl :: Ctx -> FamilyStyle -> FamilyDecl GhcPs -> Doc +famDecl ctx style FamilyDecl {fdTyVars = HsQTvs {..}, ..} = + txt keyword <> txt familyWord <> head' <> equations + where + (keyword, closedEqns) = case fdInfo of + DataFamily -> ("data", Nothing) + OpenTypeFamily -> ("type", Nothing) + ClosedTypeFamily eqs -> ("type", Just eqs) + familyWord = case style of + Associated -> "" + Free -> " family" + + headSpan = spanOf fdLName <> spansOf hsq_explicit + headAndSigSpan = spanOf fdResultSig <> headSpan + + head' = + indent . layoutFrom ctx headAndSigSpan $ + breakOrSpace + <> layoutFrom + ctx + headSpan + ( defHead + (fdFixity == Infix) + True + (name ctx fdLName) + (map (at_ ctx (tyVarBndr ctx)) hsq_explicit) + ) + <> includeUnless + (isNothing resultSig && isNothing fdInjectivityAnn) + space + <> indent + ( sequence_' resultSig + <> space + <> foldMap (at_ ctx (injectivityAnn ctx)) fdInjectivityAnn + ) + + sequence_' = maybe mempty id + resultSig = familyResultSig ctx fdResultSig + + equations = case closedEqns of + Nothing -> mempty + Just eqs -> + indent (layoutFrom ctx headAndSigSpan (breakOrSpace <> txt "where")) + <> case eqs of + -- @where ..@ is how a closed family says that its equations are + -- not being given here. + Nothing -> space <> txt ".." + -- A closed family may be given no equations at all, and then + -- the @where@ is the whole of it. Breaking the line anyway + -- leaves the next thing along hanging under a @where@ that + -- opened a block nothing was put in. + Just given -> + includeUnless (null given) $ + hardBreak <> indent (vsep (map (at_ ctx (tyFamInstEqn ctx)) given)) + +familyResultSig :: Ctx -> LFamilyResultSig GhcPs -> Maybe Doc +familyResultSig ctx (L _ sig) = case sig of + NoSig NoExtField -> Nothing + KindSig NoExtField k -> + Just (txt "::" <> breakOrSpace <> hsType ctx k) + TyVarSig NoExtField bndr -> + Just (txt "=" <> breakOrSpace <> at ctx bndr (tyVarBndr ctx)) + +injectivityAnn :: Ctx -> InjectivityAnn GhcPs -> Doc +injectivityAnn ctx (InjectivityAnn _ from to) = + txt "|" + <> space + <> name ctx from + <> space + <> txt "->" + <> space + <> hsep (map (name ctx) to) + +-- | One equation of a type family. +tyFamInstEqn :: Ctx -> TyFamInstEqn GhcPs -> Doc +tyFamInstEqn ctx FamEqn {..} = + binders <> nest (if hasBinders then 1 else 0) (lhs <> rhs) + where + (binders, hasBinders) = case feqn_bndrs of + HsOuterImplicit NoExtField -> (mempty, False) + HsOuterExplicit _ bndrs -> + ( forallBndrs ctx Invisible (tyVarBndr ctx) bndrs <> breakOrSpace, + not (null bndrs) + ) + + lhs = + layoutFrom ctx (spanOf feqn_tycon <> foldMap typeArgSpan feqn_pats) $ + defHead + (feqn_fixity == Infix) + True + (name ctx feqn_tycon) + (map (typeArgument ctx) feqn_pats) + + rhs = + indent (joinedBy "=" <> hsType ctx feqn_rhs) + +---------------------------------------------------------------------------- +-- Role annotations + +-- | A @type role@ declaration. +roleAnnot :: Ctx -> RoleAnnotDecl GhcPs -> Doc +roleAnnot ctx (RoleAnnotDecl _ tyCon roles) = + txt "type role" + <> breakOrSpace + <> indent + ( name ctx tyCon + <> breakOrSpace + <> indent (align (sepBy breakOrSpace (map (align . at_ ctx role) roles))) + ) + where + role = maybe (txt "_") $ \case + Nominal -> txt "nominal" + Representational -> txt "representational" + Phantom -> txt "phantom" + +---------------------------------------------------------------------------- +-- Helpers + +-- | Merge several lists of declarations back into the order they were +-- written in. +inSourceOrder :: [[LHsDecl GhcPs]] -> [LHsDecl GhcPs] +inSourceOrder = sortBy (leftmost_smallest `on` getLocA) . concat diff --git a/src/Tilia/Render/Context.hs b/src/Tilia/Render/Context.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Context.hs @@ -0,0 +1,398 @@ +-- | What the syntax walk needs to know that the syntax tree does not say. +-- +-- Printing a Haskell module is very nearly a fold over its syntax tree, but +-- not quite: a handful of decisions need facts from outside the node being +-- printed. Which extensions are on decides whether @(#foo)@ needs spaces +-- inside its parentheses; which operators are in scope decides how a chain +-- of them may be regrouped; where the comments are decides which constructs +-- may be put on one line. +-- +-- The record also carries the knot ('Knot'). Rendering is mutually +-- recursive—a type may contain a splice, which contains an expression, +-- which contains declarations, which contain types—and rather than break +-- the cycle with @hs-boot@ files the few backward edges are held in this +-- record and tied once, in "Tilia.Render". That is what lets the modules +-- below be ordered by syntactic category instead of by what happens to +-- import what. +module Tilia.Render.Context + ( -- * The context + Ctx (..), + SourceType (..), + Knot (..), + FamilyStyle (..), + + -- * Where a node stands + Site (..), + plainSite, + withBracing, + underSite, + closingFor, + + -- * Extensions + extensionOn, + + -- * Fixities + operatorFixity, + + -- * What lies between two spans + commentBetween, + separatedByBlank, + + -- * Entering the tree + at, + at_, + atSpan, + keywordAt, + fenceWithin, + layoutFrom, + layoutWithin, + layoutAcross, + insideBrackets, + + -- * Haddocks + writtenHaddock, + ) +where + +import Data.List.NonEmpty (NonEmpty) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Set (Set) +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Hs hiding (Fixity) +import GHC.LanguageExtensions.Type (Extension) +import GHC.Types.Name.Occurrence (occNameString) +import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc) +import GHC.Types.SrcLoc (GenLocated (..)) +import GHC.Types.SrcLoc qualified as GHC +import Tilia.Comments (Comment (..), CommentStyle (..), commentTrailing) +import Tilia.Doc.Combinators +import Tilia.Fixity + ( Fixity, + Namespace (..), + OpName (..), + Resolution (..), + Scope, + lookupFixity, + ) +import Tilia.Render.Layout (Bracing (..)) +import Tilia.Source (Source, SourceType (..), blankAt, sourceLines) +import Tilia.Span +import Tilia.Span.Ghc + +---------------------------------------------------------------------------- +-- The context + +-- | Whether a family or data declaration stands on its own or inside a +-- class. +-- +-- An associated declaration drops the @family@ and @instance@ keywords its +-- free-standing counterpart needs, which is the only thing the printer has +-- to know about the difference. +data FamilyStyle + = Associated + | Free + deriving (Eq, Show) + +-- | The backward edges of the rendering knot. +-- +-- Each field is a printer defined in a module that the module needing it +-- comes before. Nothing else belongs here: a forward edge is an ordinary +-- import and should stay one. +data Knot = Knot + { -- | Expressions, needed by types, patterns and bodies. + knotExpr :: Ctx -> Site -> LHsExpr GhcPs -> Doc, + -- | Commands, needed by bodies. + knotCmd :: Ctx -> Site -> LHsCmd GhcPs -> Doc, + -- | Splices, needed by types and patterns, defined with expressions. + knotSplice :: Ctx -> SpliceDecoration -> HsUntypedSplice GhcPs -> Doc, + -- | Signature declarations, needed by @let@ and @where@ bodies. + knotSig :: Ctx -> Sig GhcPs -> Doc, + -- | A run of declarations, needed by Template Haskell brackets. + knotDecls :: Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc, + -- | A run of declarations that keeps the author's blank lines, needed by + -- class and instance bodies. + knotDeclsGrouped :: Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc + } + +-- | Everything a printer may need beyond the node it is given. +data Ctx = Ctx + { -- | Extensions in force. + ctxExtensions :: Set Extension, + -- | Module or signature. + ctxSourceType :: SourceType, + -- | What the module can see, if that could be worked out. + -- + -- 'Nothing' is not the same as an empty scope: it means no answer was + -- established, and an operator chain whose fixities are unknown is left + -- exactly as the author arranged it. See "Tilia.Fixity". + ctxScope :: Maybe Scope, + -- | The comments that take whole lines, by starting position. + -- + -- Only these are here, because only these bear on layout: a construct + -- with one written inside it cannot be put on one line, since the + -- comment would swallow whatever followed it. + ctxLineComments :: Map (Int, Int) Comment, + -- | The module as its author wrote it. + ctxSource :: Source, + -- | The author's own text for each Haddock, by starting position. + ctxHaddocks :: Map (Int, Int) Comment, + -- | The knot. + ctxKnot :: Knot + } + +---------------------------------------------------------------------------- +-- Extensions + +-- | Is the extension on? +extensionOn :: Ctx -> Extension -> Bool +extensionOn ctx e = Set.member e (ctxExtensions ctx) + +---------------------------------------------------------------------------- +-- Fixities + +-- | The fixity of an operator, if one was established. +-- +-- 'Nothing' means the question was not answered, and the caller must not +-- rearrange anything on the strength of it. +-- +-- The namespace is the caller's to say, and it matters: @:>@ written among +-- types is servant's, written among terms it is text's, and they do not +-- agree about how it binds. +operatorFixity :: Ctx -> Namespace -> RdrName -> Maybe Fixity +operatorFixity ctx namespace name = do + scope <- ctxScope ctx + case lookupFixity scope namespace qualifier op of + Resolved fixity _ -> Just fixity + Unresolved _ -> Nothing + where + op = OpName (T.pack (occNameString (rdrNameOcc name))) + qualifier = case name of + Qual m _ -> Just (T.pack (moduleNameString m)) + _ -> Nothing + +---------------------------------------------------------------------------- +-- Where a node stands + +-- | What the surroundings of a node oblige it to do. +-- +-- None of this can be read off the node itself, and all of it changes how +-- the node is laid out, which is why it travels alongside. It lives here +-- rather than with the expression printer because the knot has to mention +-- it: a body is a node together with the site it stands at, and the printers +-- that turn one into a document are reached through the knot. +data Site = Site + { -- | Is this the function of an application, as @f@ is in @f a@? + siteApplicand :: Bool, + -- | Is this an item of a layout block? + -- + -- Such an item may not leave a bracket open for the block's own layout + -- to close, so a list comprehension standing as a statement is arranged + -- differently from one standing anywhere else. + siteInBlock :: Bool, + -- | May a block inside this node put braces round itself? + siteBracing :: Bracing + } + deriving (Eq, Show) + +-- | A node standing on its own. +plainSite :: Site +plainSite = + Site + { siteApplicand = False, + siteInBlock = False, + siteBracing = NoBrace + } + +-- | The same site, with a different answer about braces. +withBracing :: Bracing -> Site -> Site +withBracing bracing site = site {siteBracing = bracing} + +-- | Indent a hanging body, one step further when it hangs off an applicand. +underSite :: Site -> Doc -> Doc +underSite site = nest (if siteApplicand site then 2 else 1) + +-- | Where a bracket opened here has to close. +closingFor :: Site -> ClosingIndent +closingFor site = if siteInBlock site then Indented else Outdented + +---------------------------------------------------------------------------- +-- What lies between two spans + +-- | Where the next thing to be printed begins. It is either the third +-- argument or a comment, if there is any between the two spans. +nextPrinted :: + Ctx -> + -- | What has just been printed + Maybe Span -> + -- | What follows it, if nothing comes between + Maybe Span -> + Maybe Span +nextPrinted ctx (Just a) mb@(Just b) = + case filter (not . commentTrailing) (Map.elems inTheGap) of + (c : _) -> Just (commentSpan c) + [] -> mb + where + inTheGap = + Map.takeWhileAntitone (< startPoint b) $ + Map.dropWhileAntitone (< endPoint a) (ctxLineComments ctx) +nextPrinted _ _ mb = mb + +-- | Is a comment going to be printed between the two spans? +commentBetween :: Ctx -> Maybe Span -> Maybe Span -> Bool +commentBetween ctx a b = nextPrinted ctx a b /= b + +-- | Did the author leave an empty line directly after the first of these? +separatedByBlank :: Ctx -> Maybe Span -> Maybe Span -> Bool +separatedByBlank ctx ma@(Just a) mb = case nextPrinted ctx ma mb of + Just s -> any (writtenBlank ctx) [spanEndLine a + 1 .. spanStartLine s - 1] + Nothing -> False +separatedByBlank _ _ _ = False + +-- | Did the author leave this line empty? +-- +-- Asked of the module as written, so that a line the preprocessor support +-- emptied to make one configuration does not read as one the author left +-- blank. +writtenBlank :: Ctx -> Int -> Bool +writtenBlank ctx n = blankAt n (sourceLines (ctxSource ctx)) + +---------------------------------------------------------------------------- +-- Entering the tree + +-- | Enter a located node. +-- +-- This is the counterpart of every @L@ in the syntax tree: it records where +-- the output came from, so that comments can be attached to it later, and +-- it settles the node's layout from the region it occupied. A printer that +-- pattern-matches through a located wrapper without going through here has +-- dropped a comment's only anchor. +at :: (HasLoc l) => Ctx -> GenLocated l a -> (a -> Doc) -> Doc +at ctx l f = atSpan ctx (spanOf l) (f (GHC.unLoc l)) + +-- | 'at' with the arguments the other way round, for use in sections. +at_ :: (HasLoc l) => Ctx -> (a -> Doc) -> GenLocated l a -> Doc +at_ ctx f l = at ctx l f + +-- | Lay a region out as it was written, and claim it. +-- +-- Claiming is the difference between this and 'layoutFrom': a comment +-- written anywhere inside the region attaches to this document. So it is +-- for the handful of things a comment can be written against that the +-- syntax tree gives no node for—the @where@ that opens a body, the @then@ +-- of an @if@—and for nothing else. Claiming a region merely because its +-- layout is being decided would hand every comment inside it to whatever +-- happens to be printed first. +atSpan :: Ctx -> Maybe Span -> Doc -> Doc +atSpan _ Nothing d = d +atSpan ctx (Just s) d = located s (grouped ctx s d) + +-- | A keyword, claiming the span it was written on. +-- +-- A keyword is one of the things an author writes a comment against that +-- the syntax tree gives no node for. Unless it claims its own span there is +-- no region on that line for such a comment to trail, and it falls through +-- to whatever construct begins next, to be printed above that on a line its +-- author did not choose. +keywordAt :: Ctx -> Maybe Span -> Text -> Doc +keywordAt ctx s = atSpan ctx s . txt + +-- | Prevent comments inside the given region to float out of it and attach +-- to elements outside. +fenceWithin :: Ctx -> Maybe Span -> Doc -> Doc +fenceWithin _ Nothing d = d +fenceWithin _ (Just s) d = fence s d + +-- | Lay a region out as it was written, and claim nothing. +-- +-- The region decides one thing—whether what is printed here goes on one +-- line or several—and says nothing about where the output came from. That +-- is the whole difference from 'atSpan', and it is why this is the one to +-- reach for by default. +-- +-- Given no span at all it lays the document out flat, which is what a +-- construct the printer synthesised rather than read deserves. +layoutFrom :: Ctx -> Maybe Span -> Doc -> Doc +layoutFrom _ Nothing d = flat d +layoutFrom ctx (Just s) d = grouped ctx s d + +-- | Lay a construct out from the region its contents occupy rather than the +-- region it occupies. +-- +-- Delimiters are not contents. @[\n Int\n]@ is a list of one thing written +-- on one line, held apart by brackets that happen to sit on lines of their +-- own, and breaking it because the brackets are spread out would be +-- following the punctuation rather than the code. What the author spread +-- out is what decides, and that is the elements. +-- +-- Comments are still looked for across the whole construct, brackets and +-- all: one written between a bracket and what it holds still owns the rest +-- of its line, so the construct still cannot be put on one. +layoutWithin :: + Ctx -> + -- | The whole construct, delimiters included + Maybe Span -> + -- | What it holds + Maybe Span -> + Doc -> + Doc +layoutWithin ctx whole contents d + | any (holdsLineComment ctx) whole = broken d + | otherwise = maybe (flat d) (`group` d) contents + +-- | 'layoutFrom' over the region several located things cover. +layoutAcross :: (HasLoc l) => Ctx -> [GenLocated l a] -> Doc -> Doc +layoutAcross ctx xs = layoutFrom ctx (spansOf xs) + +-- | Give the inside of a bracketed construct an anchor at its far end. +-- +-- The last element of a list is not the last thing inside its brackets: a +-- comment may be written after it and before the closing bracket, and it +-- belongs inside. Nothing in the syntax tree stands there, so a zero-width +-- anchor at the construct's own end is put there for such a comment to +-- attach to—and it is the only thing a comment written between the brackets +-- of an /empty/ construct has to attach to at all. +-- +-- Without it those comments have nothing to hold them and are emitted after +-- the closing bracket, which moves them out of the construct they were +-- written in. +insideBrackets :: Maybe Span -> Doc -> Doc +insideBrackets here d = d <> foldMap (emptyAnchor . endOf) here + +-- | Lay a document out according to a span, and to the comments inside it. +-- +-- Layout follows the input, except that a comment taking a whole line +-- overrules it. Such a comment owns the rest of its line, so a construct +-- holding one cannot be put on one line however the author wrote it; the +-- closing bracket would end up commented out. +grouped :: Ctx -> Span -> Doc -> Doc +grouped ctx s d + | holdsLineComment ctx s = broken d + | otherwise = group s d + +-- | Does a comment that takes whole lines begin inside this span? +holdsLineComment :: Ctx -> Span -> Bool +holdsLineComment ctx s = + case Map.lookupGE (startPoint s) (ctxLineComments ctx) of + Just (start, _) -> start < endPoint s + Nothing -> False + +---------------------------------------------------------------------------- +-- Haddocks + +-- | The author's own text for the Haddock at this position, if we kept it. +-- +-- Rebuilding a Haddock from the doc string the syntax tree carries cannot +-- reproduce a @{- | … -}@ or an empty @-- |@, so the text is taken from the +-- comment stream whenever the Haddock is going to come back out in the style +-- it went in as. Deciding that is the caller's business; all this does is +-- find the text. +writtenHaddock :: Ctx -> Maybe Span -> Maybe (NonEmpty Text) +writtenHaddock ctx ms = do + s <- ms + c <- Map.lookup (spanStartLine s, spanStartColumn s) (ctxHaddocks ctx) + case commentStyle c of + DocComment -> Just (commentBody c) + _ -> Nothing diff --git a/src/Tilia/Render/Data.hs b/src/Tilia/Render/Data.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Data.hs @@ -0,0 +1,397 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | Data types and type synonyms. +-- +-- One declaration form covers a great deal of ground here—@data@, +-- @newtype@, @type data@, ordinary constructors, record constructors, GADT +-- constructors, and instances of all of them—which is why this reads as a +-- series of decisions rather than as a single shape. The decisions are: +-- whether the constructors are written in GADT style, whether there is +-- exactly one and it is a record, and whether anything is documented with a +-- Haddock that takes whole lines. +module Tilia.Render.Data + ( dataDecl, + synDecl, + ) +where + +import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NE +import Data.Maybe (isJust, isNothing, mapMaybe, maybeToList) +import GHC.Hs +import GHC.Types.Fixity (LexicalFixity (..)) +import GHC.Types.ForeignCall (CType (..), Header (..)) +import GHC.Types.Name.Reader (RdrName) +import GHC.Types.SrcLoc (GenLocated (..), unLoc) +import Tilia.Doc.Combinators +import Tilia.Render.Context +import Tilia.Render.Haddock +import Tilia.Render.Layout +import Tilia.Render.Name +import Tilia.Render.Type +import Tilia.Span +import Tilia.Span.Ghc + +-- | A @data@, @newtype@ or @type data@ declaration, or an instance of one. +-- +-- The type variables are left abstract because a data instance is applied to +-- types rather than to variables, and the two are otherwise printed +-- identically. +dataDecl :: + Ctx -> + FamilyStyle -> + -- | The type constructor + LocatedN RdrName -> + -- | What it is applied to + [tyVar] -> + -- | Where each of those was + (tyVar -> Maybe Span) -> + -- | How to print one + (tyVar -> Doc) -> + -- | Was the head written infix? + LexicalFixity -> + -- | The @forall@ a family instance may bind its variables with, which an + -- ordinary declaration does not have and passes as 'mempty'. + Doc -> + HsDataDefn GhcPs -> + Doc +dataDecl ctx style tyCon tyVars tyVarSpan renderTyVar fixity outerBinders HsDataDefn {..} = + txt keyword <> txt instanceWord <> header <> constructors <> derivings + where + keyword = case dd_cons of + NewTypeCon _ -> "newtype" + DataTypeCons False _ -> "data" + DataTypeCons True _ -> "type data" + instanceWord = case style of + Associated -> "" + Free -> " instance" + + headSpan = spanOf tyCon <> foldMap tyVarSpan tyVars + wholeHeadSpan = + headSpan + <> foldMap spanOf dd_kindSig + <> foldMap spanOf dd_ctxt + <> foldMap spanOf dd_cType + + header = + layoutFrom ctx wholeHeadSpan . indent $ + foreignType + <> breakOrSpace + <> outerBinders + <> foldMap (leftContext ctx) dd_ctxt + <> layoutFrom + ctx + headSpan + (defHead (fixity == Infix) True (name ctx tyCon) (map renderTyVar tyVars)) + <> foldMap kindSignature dd_kindSig + + kindSignature k = + joinedBy "::" <> indent (hsType ctx k) + + -- The @{-# CTYPE … #-}@ pragma of a foreign data type. + foreignType = case unLoc <$> dd_cType of + Nothing -> mempty + Just (CType prag header' (type_, _)) -> + breakOrSpace + <> sourceText prag + <> foldMap (\(Header h _) -> space <> sourceText h) header' + <> space + <> sourceText type_ + <> txt " #-}" + + cons = case dd_cons of + NewTypeCon c -> [c] + DataTypeCons _ cs -> cs + + -- A kind signature on the head, or any constructor written with a + -- signature of its own, means the whole declaration is in GADT style. + isGadt = isJust dd_kindSig || any (isGadtCon . unLoc) cons + + constructors = case cons of + [] -> mempty + (firstCon : _) + | isGadt -> + indent $ + layoutFrom ctx wholeHeadSpan (breakOrSpace <> txt "where") + <> breakOrSpace + -- Braces once there is a semicolon to protect: written flat + -- the @where@ block has no column to end at, so anything + -- after the declaration would be read as another + -- constructor. One constructor needs no separator and so no + -- braces. + <> items + (if null (drop 1 cons) then NoBrace else MayBrace) + (map (at_ ctx (conDecl ctx False)) cons) + | otherwise -> + layoutFrom ctx (spanOf tyCon <> spansOf cons) . indent $ + beforeEquals <> txt "=" <> space <> alternatives + where + -- A single record constructor is laid out as one thing with the + -- @=@, since there is no choice of constructor to present. + singleRecCon = case cons of + [L _ ConDeclH98 {con_args = RecCon {}}] -> True + _ -> False + compactAroundEquals = + sameLine (spanOf tyCon) (conNamesSpan (unLoc firstCon)) + conNamesSpan = \case + ConDeclGADT {..} -> spansOf (NE.toList con_names) + ConDeclH98 {..} -> spanOf con_name + + -- Documentation written as @--@ lines owns the rest of the line + -- it starts, so nothing can follow it and the constructors go one + -- to a line. Written as @{- | … -}@ it closes itself and asks + -- nothing of the layout. + lineHaddocks = any (printsWholeLineDocs ctx . visibleDocs . unLoc) cons + + beforeEquals + | lineHaddocks = hardBreak + | singleRecCon && compactAroundEquals = space + | otherwise = breakOrSpace + + separator + | lineHaddocks = hardBreak <> txt "|" <> space + | otherwise = breakOrSpace <> txt "|" <> space + + keepTogether + | lineHaddocks || not singleRecCon = align + | otherwise = id + + alternatives = + sepBy separator (map (keepTogether . at_ ctx (conDecl ctx singleRecCon)) cons) + + derivings = + includeUnless (null dd_derivs) beforeDerivings + <> indent (vsep (map (at_ ctx (derivingClause ctx)) dd_derivs)) + beforeDerivings + | length dd_derivs > 1 = hardBreak + | otherwise = breakOrSpace + +-- | The documentation a constructor's own layout has to make room for. +-- +-- Which is its Haddock and the ones on its prefix arguments, and nothing +-- deeper. A field of a record gets a line of its own wherever the @=@ ends +-- up, so a Haddock on one of those settles nothing about the constructor +-- around it and is left out of the question. +visibleDocs :: ConDecl GhcPs -> [LHsDoc GhcPs] +visibleDocs = \case + ConDeclH98 {..} -> + maybeToList con_doc <> case con_args of + PrefixCon xs -> mapMaybe cdf_doc xs + _ -> [] + ConDeclGADT {} -> [] + +isGadtCon :: ConDecl GhcPs -> Bool +isGadtCon = \case + ConDeclGADT {} -> True + ConDeclH98 {} -> False + +---------------------------------------------------------------------------- +-- Constructors + +-- | One constructor. +conDecl :: Ctx -> Bool -> ConDecl GhcPs -> Doc +conDecl ctx _ ConDeclGADT {..} = + foldMap (haddock ctx Pipe Closed) con_doc + <> layoutFrom ctx declSpan (brokenIfDocumented ctx documented body) + where + -- Every part of the signature shares one layout decision, so a Haddock + -- anywhere in it puts the whole of it on several lines. + documented = (con_g_args, con_res_ty) + + c :| cs = con_names + body = + name ctx c + <> includeUnless + (null cs) + (indent (comma <> breakOrSpace <> commaSep (map (name ctx) cs))) + <> joinedBy "::" + <> indent (layoutFrom ctx sigSpan (brokenIfDocumented ctx documented signature)) + + signature = + outerBndrs ctx (unLoc con_outer_bndrs) + <> ( case unLoc con_outer_bndrs of + HsOuterImplicit {} -> mempty + HsOuterExplicit {} -> breakOrSpace + ) + <> foldMap (\tele -> forallTelescope ctx tele <> breakOrSpace) con_inner_bndrs + <> foldMap + (\qs -> context ctx qs <> joinedBy "=>") + con_mb_cxt + <> layoutFrom ctx argResSpan (brokenIfDocumented ctx documented argsAndResult) + + argsAndResult = arguments <> resultType + + -- GHC keeps a GADT's result type without the brackets it was written + -- with, and there is one shape that does not survive losing them. A + -- kind signature needs them back: @MkT :: Int -> T :: Star@ reads as a + -- second signature on the constructor rather than as a kind on its + -- result, and does not parse at all. + resultType = case unLoc con_res_ty of + HsKindSig {} -> parens (hsType ctx con_res_ty) + HsForAllTy {} | standsAlone -> parens (hsType ctx con_res_ty) + HsQualTy {} | standsAlone -> parens (hsType ctx con_res_ty) + _ -> hsType ctx con_res_ty + standsAlone = case (unLoc con_outer_bndrs, con_g_args) of + (HsOuterImplicit {}, PrefixConGADT _ []) -> + null con_inner_bndrs && null con_mb_cxt + _ -> False + arguments = case con_g_args of + PrefixConGADT NoExtField xs -> foldMap argument xs + RecConGADT _ x -> + recordFieldsAt ctx x <> joinedBy "->" + argument x = + documentedConDeclField ctx x + <> space + <> multiplicity (hsType ctx) (cdf_multiplicity x) + <> joinedBy "->" + + declSpan = spansOf (NE.toList con_names) <> sigSpan + sigSpan = spanOf con_outer_bndrs <> foldMap spanOf con_mb_cxt <> argResSpan + argResSpan = + spanOf con_res_ty <> case con_g_args of + PrefixConGADT NoExtField xs -> spansOf (map cdf_type xs) + RecConGADT _ x -> spanOf x +conDecl ctx singleRecCon ConDeclH98 {..} = case con_args of + PrefixCon xs -> + ownDoc + <> existentials + <> layoutFrom + ctx + declSpan + ( brokenIfDocumented ctx xs $ + name ctx con_name + <> includeUnless (null xs) breakOrSpace + <> indent (align (sepBy breakOrSpace (map (align . documentedConDeclField ctx) xs))) + ) + RecCon l -> + ownDoc + <> existentials + <> layoutFrom + ctx + declSpan + ( name ctx con_name + <> breakOrSpace + <> nest (if singleRecCon then 0 else 1) (recordFieldsAt ctx l) + ) + InfixCon l r -> + -- The constructor's own Haddock can only go above the whole constructor + -- when neither argument has one of its own; otherwise it goes between + -- them, next to the name. + includeWhen docOnTop ownDoc + <> existentials + <> layoutFrom + ctx + declSpan + ( leftArgument l + <> indent + ( includeUnless docOnTop ownDoc + <> name ctx con_name + <> rightDoc r + <> conDeclField ctx r + ) + ) + where + docOnTop = isNothing (cdf_doc l) && isNothing (cdf_doc r) + -- The left argument's Haddock may use pipe style only when the + -- constructor itself is documented, since otherwise there is nothing + -- above it for the pipe to point at. + leftArgument x + | isJust con_doc = + foldMap (haddock ctx Pipe Closed) (cdf_doc x) + <> conDeclField ctx x + <> breakOrSpace + | otherwise = + conDeclField ctx x + <> case cdf_doc x of + Just d -> space <> haddock ctx Caret Closed d + Nothing -> breakOrSpace + rightDoc x = case cdf_doc x of + Just d -> hardBreak <> haddock ctx Pipe Closed d + Nothing -> breakOrSpace + where + ownDoc = foldMap (haddock ctx Pipe Closed) con_doc + + existentials = + layoutFrom ctx contextSpan $ + includeWhen + con_forall + (forallBndrs ctx Invisible (tyVarBndr ctx) con_ex_tvs <> breakOrSpace) + <> foldMap (leftContext ctx) con_mb_cxt + + contextSpan = + spanOfSrcSpan (getHasLoc (acdh_forall con_ext)) + <> spansOf con_ex_tvs + <> foldMap spanOf con_mb_cxt + <> spanOf con_name + + declSpan = spanOf con_name <> argSpans + argSpans = case con_args of + PrefixCon xs -> spansOf (map cdf_type xs) + RecCon l -> spanOf l + InfixCon x y -> spansOf (map cdf_type [x, y]) + +-- | A context standing to the left of a @=>@, with the arrow and the break +-- after it. +leftContext :: Ctx -> LHsContext GhcPs -> Doc +leftContext ctx = \case + L _ [] -> mempty + ctxt -> context ctx ctxt <> joinedBy "=>" + +---------------------------------------------------------------------------- +-- Deriving clauses + +derivingClause :: Ctx -> HsDerivingClause GhcPs -> Doc +derivingClause ctx HsDerivingClause {..} = + brokenIfDocumented ctx deriv_clause_tys $ + txt "deriving" <> space <> strategy + where + what = + at ctx deriv_clause_tys $ \tys -> + brokenIfDocumented ctx tys $ case tys of + DctSingle NoExtField sigTy -> parens (hsSigType ctx sigTy) + DctMulti NoExtField sigTys -> + parens (commaSep (map (align . hsSigType ctx) sigTys)) + + strategy = case deriv_clause_strategy of + Nothing -> breakOrSpace <> indent what + Just (L _ s) -> case s of + StockStrategy _ -> named "stock" + AnyclassStrategy _ -> named "anyclass" + NewtypeStrategy _ -> named "newtype" + ViaStrategy (XViaStrategyPs _ sigTy) -> + breakOrSpace + <> indent + ( what + <> breakOrSpace + <> txt "via" + <> space + <> hsSigType ctx sigTy + ) + where + named kw = txt kw <> breakOrSpace <> indent what + +---------------------------------------------------------------------------- +-- Type synonyms + +-- | @type T a = …@. +synDecl :: + Ctx -> + LocatedN RdrName -> + LexicalFixity -> + LHsQTyVars GhcPs -> + LHsType GhcPs -> + Doc +synDecl ctx tyCon fixity HsQTvs {..} rhs = + txt "type" + <> space + <> layoutFrom + ctx + (spanOf tyCon <> spansOf hsq_explicit) + (defHead (fixity == Infix) True (name ctx tyCon) (map (at_ ctx (tyVarBndr ctx)) hsq_explicit)) + <> indent (space <> txt "=" <> separator <> hsType ctx rhs) + where + separator + | typeIsDocumented (unLoc rhs) = hardBreak + | otherwise = breakOrSpace diff --git a/src/Tilia/Render/Declaration.hs b/src/Tilia/Render/Declaration.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Declaration.hs @@ -0,0 +1,394 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | Declarations: dispatching to the right printer, and grouping. +-- +-- Two jobs live here. The first is a case over every kind of declaration, +-- which is mostly a matter of handing the work on; the few forms with no +-- module of their own—foreign imports, annotations, @default@ declarations, +-- top-level splices—are printed here rather than in four files of a dozen +-- lines each. +-- +-- The second is grouping, which is the interesting one. A blank line between +-- declarations is meaningful to a reader, so a signature and the function it +-- describes should stay together while unrelated declarations are kept +-- apart. Nothing in the syntax tree says which declarations belong together, +-- so it is worked out from what they are and what they name. +module Tilia.Render.Declaration + ( decls, + declsKeepingGroups, + ) +where + +import Data.List (sort) +import Data.List.NonEmpty (NonEmpty (..), (<|)) +import Data.List.NonEmpty qualified as NE +import GHC.Data.FastString (unpackFS) +import GHC.Hs +import GHC.Types.ForeignCall (CExportSpec (..)) +import GHC.Types.Name.Occurrence (occNameFS) +import GHC.Types.Name.Reader (RdrName, rdrNameOcc) +import GHC.Types.SourceText +import GHC.Types.SrcLoc (GenLocated (..), isGoodSrcSpan, unLoc) +import Tilia.Doc.Combinators +import Tilia.Render.Class +import Tilia.Render.Context +import Tilia.Render.Data +import Tilia.Render.Expression +import Tilia.Render.Haddock +import Tilia.Render.Layout +import Tilia.Render.Literal (stringLiteral) +import Tilia.Render.Name +import Tilia.Render.Pragma +import Tilia.Render.Signature +import Tilia.Render.Type +import Tilia.Span +import Tilia.Span.Ghc + +---------------------------------------------------------------------------- +-- Runs of declarations + +-- | A run of declarations, with blank lines wherever we think they belong. +decls :: Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc +decls = declRun Disregard + +-- | A run of declarations that keeps the author's grouping. +-- +-- Where the author ran declarations together we run them together too, and +-- where they left a blank line we leave one. The exception is documentation: +-- a documented declaration always gets air around it, since a Haddock that +-- butts up against the declaration above reads as belonging to that one. +declsKeepingGroups :: Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc +declsKeepingGroups = declRun Respect + +-- | Whether the author's own blank lines are consulted. +data Grouping + = Disregard + | Respect + deriving (Eq, Show) + +declRun :: Grouping -> Ctx -> FamilyStyle -> [LHsDecl GhcPs] -> Doc +declRun grouping ctx style ds = + items NoBrace $ case groups of + [] -> [] + (firstGroup : rest) -> + render firstGroup <> concat (zipWith withGap groups rest) + where + isSignatureFile = ctxSourceType ctx == SignatureSource + groups = groupDecls ctx isSignatureFile ds + render = NE.toList . fmap (at_ ctx (hsDecl ctx style)) + + withGap previous current + | separate previous current = breakOrSpace : render current + | otherwise = render current + + separate previous current = case grouping of + Disregard -> True + Respect -> + separatedByBlank ctx ended began + || commentBetween ctx ended began + || isDocumented previous + || isDocumented current + where + ended = spanOf (NE.last previous) + began = spanOf (NE.head current) + + isDocumented = any (isDocNext . unLoc) + isDocNext = \case + DocD _ (DocCommentNext _) -> True + DocD _ (DocCommentPrev _) -> True + _ -> False + +-- | Gather declarations that belong together. +groupDecls :: Ctx -> Bool -> [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)] +groupDecls _ _ [] = [] +groupDecls ctx isSignatureFile (d : ds) + -- A Haddock documenting what follows belongs to the group that follows, + -- not to a group of its own—unless what follows is another Haddock, which + -- documents nothing either. Those two have to be kept apart: run + -- together they are not two doc comments but one. + | isDocNext (unLoc d) = case groupDecls ctx isSignatureFile ds of + [] -> [d :| []] + (g : gs) + | isDoc (unLoc (NE.head g)) -> (d :| []) : g : gs + | otherwise -> (d <| g) : gs + | otherwise = + let (together, rest) = span belongs (zip (d : ds) ds) + in (d :| map snd together) : groupDecls ctx isSignatureFile (map snd rest) + where + isDocNext = \case + DocD _ (DocCommentNext _) -> True + _ -> False + isDoc = \case + DocD _ _ -> True + _ -> False + belongs (previous, current) = + (not isSignatureFile && isSignatureSeries ctx previous current) + || isDerivingSeries ctx previous current + || relatedDecls d current + || relatedDecls previous current + +-- | A run of type signatures with nothing between them is a list, and a +-- list reads better without gaps in it. +isSignatureSeries :: Ctx -> LHsDecl GhcPs -> LHsDecl GhcPs -> Bool +isSignatureSeries ctx x@(L _ a) y@(L _ b) = case (a, b) of + (SigD _ TypeSig {}, SigD _ TypeSig {}) -> + not (commentBetween ctx (spanOf x) (spanOf y)) + _ -> False + +-- | Two standalone @deriving@ declarations the author ran together. +isDerivingSeries :: Ctx -> LHsDecl GhcPs -> LHsDecl GhcPs -> Bool +isDerivingSeries ctx x@(L _ a) y@(L _ b) = case (a, b) of + (DerivD {}, DerivD {}) -> + not (separatedByBlank ctx (spanOf x) (spanOf y)) + _ -> False + +---------------------------------------------------------------------------- +-- What a declaration is about + +-- | The kinds of declaration that grouping distinguishes. +-- +-- Anything not named here groups with nothing, which is the right default: +-- an unrecognised declaration standing on its own is merely a missed +-- opportunity, whereas one wrongly attached to its neighbour is a mistake. +data Kind + = TypeSignature + | DefaultSignature + | FunctionBody + | PatternSignature + | PatternDefinition + | DataDeclaration + | ClassDeclaration + | KindSignature + | FamilyDeclaration + | TypeSynonym + | PragmaDeclaration + | TopLevelSplice + | DocumentsNext + | DocumentsPrevious + | Unremarkable + deriving (Eq, Show) + +-- | What a declaration is, and what it names. +declKind :: HsDecl GhcPs -> (Kind, [RdrName]) +declKind = \case + SigD _ (TypeSig _ ns _) -> (TypeSignature, map unLoc ns) + SigD _ (ClassOpSig _ True ns _) -> (DefaultSignature, map unLoc ns) + SigD _ (ClassOpSig _ False ns _) -> (TypeSignature, map unLoc ns) + SigD _ (PatSynSig _ ns _) -> (PatternSignature, map unLoc ns) + SigD _ (InlineSig _ (L _ n) _) -> (PragmaDeclaration, [n]) + SigD _ (SCCFunSig _ (L _ n) _) -> (PragmaDeclaration, [n]) + SigD _ sig + | Just n <- specialisedName sig -> (PragmaDeclaration, [n]) + ValD _ (FunBind _ (L _ n) _) -> (FunctionBody, [n]) + ValD _ (PatBind _ p _ _) -> (FunctionBody, boundNames p) + ValD _ (PatSynBind _ (PSB _ (L _ n) _ _ _)) -> (PatternDefinition, [n]) + AnnD _ (HsAnnotation _ (ValueAnnProvenance (L _ n)) _) -> (PragmaDeclaration, [n]) + AnnD _ (HsAnnotation _ (TypeAnnProvenance (L _ n)) _) -> (PragmaDeclaration, [n]) + WarningD _ (Warnings _ ws) -> + (PragmaDeclaration, [unLoc n | L _ (Warning _ ns _) <- ws, n <- ns]) + TyClD _ (DataDecl _ (L _ n) _ _ _) -> (DataDeclaration, [n]) + TyClD _ (ClassDecl {tcdLName = L _ n}) -> (ClassDeclaration, [n]) + TyClD _ (SynDecl _ (L _ n) _ _ _) -> (TypeSynonym, [n]) + TyClD _ (FamDecl _ (FamilyDecl _ _ _ (L _ n) _ _ _ _)) -> (FamilyDeclaration, [n]) + KindSigD _ (StandaloneKindSig _ (L _ n) _) -> (KindSignature, [n]) + SpliceD _ (SpliceDecl _ _ _) -> (TopLevelSplice, []) + DocD _ (DocCommentNext _) -> (DocumentsNext, []) + DocD _ (DocCommentPrev _) -> (DocumentsPrevious, []) + _ -> (Unremarkable, []) + +-- | The names a pattern binding brings into scope. +boundNames :: LPat GhcPs -> [RdrName] +boundNames (L _ p) = case p of + VarPat _ (L _ n) -> [n] + AsPat _ (L _ n) inner -> n : boundNames inner + NPlusKPat _ (L _ n) _ _ _ _ -> [n] + LazyPat _ inner -> boundNames inner + BangPat _ inner -> boundNames inner + ParPat _ inner -> boundNames inner + SigPat _ inner _ -> boundNames inner + ViewPat _ _ inner -> boundNames inner + SumPat _ inner _ _ -> boundNames inner + TuplePat _ ps _ -> concatMap boundNames ps + ListPat _ ps -> concatMap boundNames ps + OrPat _ ps -> concatMap boundNames (NE.toList ps) + ConPat _ _ details -> concatMap boundNames (hsConPatArgs details) + _ -> [] + +-- | Should these two declarations be printed with no blank line between +-- them? +relatedDecls :: LHsDecl GhcPs -> LHsDecl GhcPs -> Bool +relatedDecls a b = case (kindA, kindB) of + (DocumentsNext, _) -> True + (_, DocumentsPrevious) -> True + -- Splices name nothing, so the only evidence they belong together is that + -- the author wrote them together. + (TopLevelSplice, TopLevelSplice) -> not (blankBetween (spanOf a) (spanOf b)) + pair | pair `elem` relatedKinds -> shareAName namesA namesB + _ -> False + where + (kindA, namesA) = declKind (unLoc a) + (kindB, namesB) = declKind (unLoc b) + +-- | The pairs of declaration kinds that group when they name something in +-- common. +-- +-- Reading this as a list rather than as nested cases is the point: what +-- belongs with what is a policy, and a policy is easier to check when it is +-- written out. +relatedKinds :: [(Kind, Kind)] +relatedKinds = + [ (TypeSignature, FunctionBody), + (TypeSignature, DefaultSignature), + (DefaultSignature, TypeSignature), + (DefaultSignature, FunctionBody), + (TypeSignature, PragmaDeclaration), + (PragmaDeclaration, TypeSignature), + (PragmaDeclaration, FunctionBody), + (FunctionBody, PragmaDeclaration), + (PragmaDeclaration, DataDeclaration), + (DataDeclaration, PragmaDeclaration), + (PragmaDeclaration, PragmaDeclaration), + (PatternSignature, PatternDefinition), + (KindSignature, DataDeclaration), + (KindSignature, ClassDeclaration), + (KindSignature, FamilyDeclaration), + (KindSignature, TypeSynonym) + ] + +-- | Do the two declarations name anything in common? +-- +-- Names are compared as text rather than as parsed names, since a pragma +-- may name a constructor where the declaration names the type, and the two +-- are different parsed names for the same spelling. +shareAName :: [RdrName] -> [RdrName] -> Bool +shareAName xs ys = overlaps (sort (map spelling xs)) (sort (map spelling ys)) + where + spelling :: RdrName -> String + spelling = unpackFS . occNameFS . rdrNameOcc + overlaps (a : as) (b : bs) + | a < b = overlaps as (b : bs) + | a > b = overlaps (a : as) bs + | otherwise = True + overlaps _ _ = False + +---------------------------------------------------------------------------- +-- One declaration + +-- | Print one declaration. +hsDecl :: Ctx -> FamilyStyle -> HsDecl GhcPs -> Doc +hsDecl ctx style = \case + TyClD _ x -> tyClDecl ctx style x + ValD _ x -> valDecl ctx NoBrace x + SigD _ x -> sigDecl ctx x + InstD _ x -> instDecl ctx style x + DerivD _ x -> standaloneDerivDecl ctx x + DefD _ x -> defaultDecl ctx x + ForD _ x -> foreignDecl ctx x + WarningD _ x -> warnDecls ctx x + AnnD _ x -> annDecl ctx x + RuleD _ x -> ruleDecls ctx x + SpliceD _ (SpliceDecl NoExtField splice deco) -> + at ctx splice (untypedSplice ctx deco) + RoleAnnotD _ x -> roleAnnot ctx x + KindSigD _ x -> standaloneKindSig ctx x + DocD _ x -> case x of + DocCommentNext str -> haddock ctx Pipe Open str + DocCommentPrev str -> haddock ctx Caret Open str + DocCommentNamed n str -> haddock ctx (Chunk n) Open str + DocGroup n str -> haddock ctx (Section n) Open str + +tyClDecl :: Ctx -> FamilyStyle -> TyClDecl GhcPs -> Doc +tyClDecl ctx style = \case + FamDecl _ x -> famDecl ctx style x + SynDecl {..} -> synDecl ctx tcdLName tcdFixity tcdTyVars tcdRhs + DataDecl {..} -> + dataDecl + ctx + Associated + tcdLName + (hsq_explicit tcdTyVars) + spanOf + (at_ ctx (tyVarBndr ctx)) + tcdFixity + mempty + tcdDataDefn + ClassDecl {tcdCExt = (anns, _, _), ..} -> + classDecl + ctx + anns + tcdCtxt + tcdLName + tcdTyVars + tcdFixity + tcdFDs + tcdSigs + tcdMeths + tcdATs + tcdATDefs + tcdDocs + +instDecl :: Ctx -> FamilyStyle -> InstDecl GhcPs -> Doc +instDecl ctx style = \case + ClsInstD _ x -> clsInstDecl ctx x + TyFamInstD _ x -> tyFamInstDecl ctx style x + DataFamInstD _ x -> dataFamInstDecl ctx style x + +---------------------------------------------------------------------------- +-- The declarations with nowhere else to live + +-- | A @default@ declaration. +defaultDecl :: Ctx -> DefaultDecl GhcPs -> Doc +defaultDecl ctx (DefaultDecl _ className types) = + txt "default" + <> foldMap (\c -> breakOrSpace <> name ctx c) className + <> breakOrSpace + <> indent (parens (commaSep (map (align . hsType ctx) types))) + +-- | An @ANN@ pragma. +annDecl :: Ctx -> AnnDecl GhcPs -> Doc +annDecl ctx (HsAnnotation _ provenance e) = + pragma "ANN" . indent $ + subject <> breakOrSpace <> hsExpr ctx e + where + subject = case provenance of + ValueAnnProvenance n -> name ctx n + TypeAnnProvenance n -> txt "type" <> space <> name ctx n + ModuleAnnProvenance -> txt "module" + +-- | A foreign import or export. +foreignDecl :: Ctx -> ForeignDecl GhcPs -> Doc +foreignDecl ctx = \case + fd@ForeignImport {fd_fi} -> foreignImport ctx fd_fi <> foreignSig ctx fd + fd@ForeignExport {fd_fe} -> foreignExport ctx fd_fe <> foreignSig ctx fd + +-- | The name and type that end a foreign declaration. +foreignSig :: Ctx -> ForeignDecl GhcPs -> Doc +foreignSig ctx fd = + breakOrSpace + <> indent + ( layoutFrom ctx (spanOf (fd_name fd) <> spanOf (fd_sig_ty fd)) $ + name ctx (fd_name fd) <> typeAscription ctx (fd_sig_ty fd) + ) + +-- | The head of a foreign import. +foreignImport :: Ctx -> ForeignImport GhcPs -> Doc +foreignImport ctx (CImport src callConv safety _ _) = + txt "foreign import" + <> space + <> at ctx callConv outputable + <> includeWhen (isGoodSrcSpan (getLocA safety)) (space <> outputable safety) + <> indent + ( at ctx src $ \case + NoSourceText -> mempty + SourceText lit -> breakOrSpace <> stringLiteral lit + ) + +foreignExport :: Ctx -> ForeignExport GhcPs -> Doc +foreignExport ctx (CExport src (L loc (CExportStatic _ _ callConv))) = + txt "foreign export" + <> space + <> at ctx (L loc callConv) outputable + <> space + <> at ctx src sourceText diff --git a/src/Tilia/Render/Expression.hs b/src/Tilia/Render/Expression.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Expression.hs @@ -0,0 +1,1328 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +-- | Expressions, and the equations and blocks built out of them. +-- +-- These are together because they are genuinely one thing: an equation is a +-- pattern and an expression, a @do@ block is a run of expressions, and a +-- @where@ clause is a run of equations. Splitting them would only move the +-- recursion into a knot without making either half easier to read. +-- +-- The recurring question here is /placement/: whether a body begins on the +-- line that introduces it or on the next one, indented. Some expressions +-- have a hanging form—a @do@ block, a @case@, a lambda—and can absorb the +-- line break themselves, which is why @f = do@ reads better than @f =@ with +-- @do@ alone on the line below. Everything else has to be pushed down. +-- 'Placement' is the answer, and most of what looks like special-casing +-- below is working out which one applies. +module Tilia.Render.Expression + ( -- * Expressions + hsExpr, + hsExprIn, + hsCmd, + + -- * Bindings + valDecl, + MatchStyle (..), + GuardStyle (..), + + -- * Splices + untypedSplice, + ) +where + +import Data.Function (on) +import Data.Generics.Schemes (listify) +import Data.List (sortBy, unsnoc) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NE +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Data.FastString (unpackFS) +import GHC.Hs hiding (Fixity) +import GHC.LanguageExtensions.Type (Extension (..)) +import GHC.Types.Basic (Boxity (..)) +import GHC.Types.Fixity (LexicalFixity (..)) +import GHC.Types.Name.Occurrence (isVarOcc) +import GHC.Types.Name.Reader (RdrName, mkVarUnqual, rdrNameOcc) +import GHC.Types.SourceText +import GHC.Types.SrcLoc + ( GenLocated (..), + isZeroWidthSpan, + leftmost_smallest, + noSrcSpan, + unLoc, + ) +import Language.Haskell.Syntax.Basic (field_label) +import Tilia.Doc.Body +import Tilia.Doc.Combinators +import Tilia.Fixity + ( Fixity, + Namespace (..), + ) +import Tilia.Render.Body +import Tilia.Render.Context +import Tilia.Render.Layout +import Tilia.Render.Literal (stringLiteral) +import Tilia.Render.Name +import Tilia.Render.Operator +import Tilia.Render.Pattern +import Tilia.Render.Type +import Tilia.Span +import Tilia.Span.Ghc + +---------------------------------------------------------------------------- +-- Bracing + +-- | Let a block brace itself when the surrounding layout is flat. +-- +-- Whether braces are wanted is a question about the layout, and the layout +-- is not known while the document is being built. Both answers are prepared +-- and the engine picks; the one it does not pick is never forced. +whenFlat :: Bracing -> (Bracing -> Doc) -> Doc +whenFlat whenBroken render = variant (render MayBrace) (render whenBroken) + +-- | A @case@ or lambda standing as a block item has to delimit itself when +-- the block is flat, unless it is the function of an application, where the +-- argument that follows already does so. +bracedForSite :: Site -> (Bracing -> Doc) -> Doc +bracedForSite site render + | siteInBlock site && not (siteApplicand site) = whenFlat (siteBracing site) render + | otherwise = render (siteBracing site) + +---------------------------------------------------------------------------- +-- Expressions + +-- | An expression. +hsExpr :: Ctx -> LHsExpr GhcPs -> Doc +hsExpr ctx = hsExprIn ctx plainSite + +-- | An expression that knows where it stands. +hsExprIn :: Ctx -> Site -> LHsExpr GhcPs -> Doc +hsExprIn ctx site l = at ctx l (exprBody ctx site (spanOf l)) + +-- | The body of an equation, as the enclosing construct will hand it on. +-- +-- Neither the site nor the placement is known when the body is passed in: +-- the site depends on the layout the group of equations settles on, and the +-- placement is the body's own business. So what travels is a way of making +-- a body from a site, and 'Tilia.Doc.Body.Body' answers the rest. +type BodyOf body b = Site -> LocatedA body -> b + +-- | A body standing on its own, with the given bracing. +bodyIn :: BodyOf body b -> Bracing -> LocatedA body -> b +bodyIn mkBody bracing = mkBody (withBracing bracing plainSite) + +exprBody :: Ctx -> Site -> Maybe Span -> HsExpr GhcPs -> Doc +exprBody ctx site here = \case + HsVar _ n -> name ctx n + HsOverLabel src _ -> txt "#" <> sourceText src + HsIPVar _ (HsIPName n) -> txt "?" <> outputable n + HsOverLit _ v -> outputable (ol_val v) + HsLit _ lit -> case lit of + HsString (SourceText s) _ -> stringLiteral s + HsStringPrim (SourceText s) _ -> stringLiteral s + HsMultilineString (SourceText s) _ -> stringLiteral s + other -> outputable other + HsLam _ variant' mg -> lambda ctx site variant' (ExprBody ctx) mg + HsApp _ f x -> application ctx site f x + HsAppType at' e a -> + hsExpr ctx e + <> breakOrSpace + <> indent + ( atSpan + ctx + (tokenSpan at' <> spanOf (hswc_body a)) + (txt "@" <> hsTypeBody ctx (spanOf (hswc_body a)) (unLoc (hswc_body a))) + ) + OpApp _ x op y -> exprChain ctx site x op y + NegApp _ e _ -> txt "-" <> negationGap ctx e <> hsExpr ctx e + HsPar _ e -> + layoutWithin ctx here (spanOf e) $ + parensWith (closingFor site) (insideBrackets here (hsExpr ctx e)) + SectionL _ x op -> hsExpr ctx x <> breakOrSpace <> indent (hsExpr ctx op) + SectionR _ op x -> hsExpr ctx op <> breakOrSpace <> indent (hsExpr ctx x) + ExplicitTuple _ args boxity -> tuple ctx here (closingFor site) boxity args + ExplicitSum _ tag arity e -> unboxedSum (closingFor site) tag arity (hsExpr ctx e) + HsCase _ e mg -> caseOf ctx site (ExprBody ctx) e mg + HsIf anns c t e -> ifThenElse ctx (bodyIn (ExprBody ctx) (siteBracing site)) anns c t e + HsMultiIf _ guards -> + txt "if" + <> breakOrSpace + <> underSite site (sepBy breakOrSpace (map alternative (NE.toList guards))) + where + alternative g = + atSpan + ctx + (grhsSpan (unLoc g)) + (guardedRhs ctx Normal (siteBracing site) (ExprBody ctx) RightArrow (unLoc g)) + HsLet _ binds e -> letIn ctx (bodyIn (ExprBody ctx) (siteBracing site)) binds e + HsDo anns flavour es -> case flavour of + DoExpr moduleName -> doBlock moduleName "do" + MDoExpr moduleName -> doBlock moduleName "mdo" + ListComp -> comprehension ctx site es + MonadComp -> comprehension ctx site es + GhciStmtCtxt -> error "Tilia: GhciStmtCtxt cannot occur in a source file" + where + doBlock moduleName word = + foldMap (\m -> outputable m <> txt ".") moduleName + <> keywordAt ctx (doKeywordSpan anns) word + <> statements ctx site (ExprBody ctx) es + ExplicitList _ xs -> + bracketsWith + (closingFor site) + (insideBrackets here (commaSep (map (align . hsExpr ctx) xs))) + RecordCon {..} -> + name ctx rcon_con + <> breakOrSpace + <> indent (braces (insideBrackets here (commaSep (map align (fields <> wildcard))))) + where + HsRecFields {..} = rcon_flds + fields = map (at_ ctx (fieldBind ctx (at_ ctx (name ctx . foLabel)))) rec_flds + -- The @..@ has a location of its own, and needs it: a comment written + -- against it has nothing else to attach to. + wildcard = case rec_dotdot of + Just l -> [at ctx l (const (txt ".."))] + Nothing -> [] + RecordUpd {..} -> + hsExpr ctx rupd_expr <> breakOrSpace <> indent (braces (insideBrackets here updates)) + where + updates = case rupd_flds of + RegularRecUpdFields {..} -> + commaSep (map (align . at_ ctx (fieldBind ctx (at_ ctx (fieldOcc ctx)))) recUpdFields) + OverloadedRecUpdFields {..} -> + commaSep (map (align . at_ ctx (fieldBind ctx (at_ ctx labelChain))) olRecUpdFields) + labelChain (FieldLabelStrings flss) = dotFields ctx (unLoc <$> flss) + HsGetField {..} -> + hsExpr ctx gf_expr <> txt "." <> at ctx gf_field (dotField ctx) + HsProjection {..} -> parens (txt "." <> dotFields ctx proj_flds) + ExprWithTySig _ x HsWC {hswc_body} -> + align $ + hsExpr ctx x + <> joinedBy "::" + <> indent (hsSigType ctx hswc_body) + ArithSeq _ _ range -> arithSeq ctx (closingFor site) range + HsTypedBracket (bracketAnn, _) e -> + txt opener <> breakOrNothing <> hsExpr ctx e <> breakOrNothing <> txt "||]" + where + -- @[e|| … ||]@ and @[|| … ||]@ are the same bracket written two ways, + -- and which one the author reached for is theirs to keep. + opener = case bracketAnn of + BracketNoE {} -> "[||" + BracketHasE {} -> "[e||" + HsUntypedBracket _ q -> quotation ctx q + HsTypedSplice _ (HsTypedSpliceExpr _ e) -> spliceTH ctx True e DollarSplice + HsUntypedSplice _ splice -> untypedSplice ctx DollarSplice splice + HsProc _ p e -> + txt "proc" + <> layoutFrom ctx (spanOf p) (breakOrSpace <> indent (hsPat ctx p) <> breakOrSpace) + <> txt "->" + <> attachBody (CmdTopBody ctx plainSite e) + HsStatic _ e -> txt "static" <> breakOrSpace <> indent (hsExpr ctx e) + HsPragE _ prag x -> case prag of + HsPragSCC _ n -> + txt "{-# SCC " + <> outputable n + <> txt " #-}" + <> breakOrSpace + <> nest (if siteInBlock site then 1 else 0) (hsExpr ctx x) + HsEmbTy _ HsWC {hswc_body} -> txt "type" <> space <> hsType ctx hswc_body + HsHole holeKind -> case holeKind of + HoleVar n -> name ctx n + HoleError -> error "Tilia: a nameless hole cannot come from a successful parse" + -- The three that follow mirror their counterparts in types: a quoted + -- signature is an expression until it is elaborated. + HsForAll _ tele e -> forallTelescope ctx tele <> breakOrSpace <> hsExpr ctx e + HsQual _ qs e -> + at ctx qs (contextOf loneVariableExpr (hsExpr ctx) . map unbracketed) + <> joinedBy "=>" + <> hsExpr ctx e + HsFunArr _ multAnn x y -> + hsExpr ctx x + <> space + <> multiplicity (hsExpr ctx) multAnn + <> joinedBy "->" + <> case unLoc y of + HsFunArr {} -> exprBody ctx plainSite (spanOf y) (unLoc y) + _ -> hsExpr ctx y + +-- | @-@ in front of a literal needs a space when @NegativeLiterals@ is on, +-- since @- 1@ and @-1@ then parse differently. +negationGap :: Ctx -> LHsExpr GhcPs -> Doc +negationGap ctx e = includeWhen (extensionOn ctx NegativeLiterals && isLiteral) space + where + isLiteral = case unLoc e of + HsLit {} -> True + HsOverLit {} -> True + _ -> False + +-- | A function applied to arguments. +-- +-- The last argument is held apart from the rest because it is the only one +-- that may hang: @f x $ do …@ puts the block after the arguments rather than +-- indenting everything under @f@. It may only hang when the function and the +-- earlier arguments fit on one line, since otherwise there is nothing left +-- of that line for it to hang from. +application :: Ctx -> Site -> LHsExpr GhcPs -> LHsExpr GhcPs -> Doc +application ctx site f x = + case placement of + Normal -> + whenFlat (siteBracing site) headAndInit + <> indent (includeUnless (null initArgs) breakOrSpace <> hsExpr ctx lastArg) + Hanging -> + layoutFrom ctx initSpan (headAndInit MayBrace) + <> attach Hanging (hsExpr ctx lastArg) + where + (func, args) = gatherArgs f (x :| []) + initArgs = NE.init args + lastArg = NE.last args + initSpan = spanOf f <> (startOf <$> spanOf lastArg) + placement + | maybe False isSingleLine initSpan = exprHangs (unLoc lastArg) + | otherwise = Normal + headAndInit bracing = + hsExprIn ctx site {siteApplicand = True, siteBracing = bracing} func + <> breakOrSpace + <> nest + (if placement == Hanging then 0 else 1) + (sepBy breakOrSpace (map (hsExprIn ctx (withBracing bracing plainSite)) initArgs)) + +gatherArgs :: + LHsExpr GhcPs -> + NonEmpty (LHsExpr GhcPs) -> + (LHsExpr GhcPs, NonEmpty (LHsExpr GhcPs)) +gatherArgs f known = case unLoc f of + HsApp _ l r -> gatherArgs l (NE.cons r known) + _ -> (f, known) + +-- | A tuple, or a tuple section. +-- +-- A section has holes in it, and a hole cannot carry a line break, so a +-- section is laid out flat however it was written. +tuple :: Ctx -> Maybe Span -> ClosingIndent -> Boxity -> [HsTupArg GhcPs] -> Doc +tuple ctx here closing boxity args + | any isMissing args = flat (brackets' (sepBy comma (map arg args))) + | otherwise = brackets' (insideBrackets here (commaSep (map arg args))) + where + brackets' = case boxity of + Boxed -> parensWith closing + Unboxed -> unboxedWith closing + isMissing = \case + Missing _ -> True + _ -> False + arg = + align . \case + Present _ e -> hsExpr ctx e + Missing _ -> mempty + +-- | An arithmetic sequence, in whichever of its four forms. +arithSeq :: Ctx -> ClosingIndent -> ArithSeqInfo GhcPs -> Doc +arithSeq ctx closing = \case + From from -> wrap (hsExpr ctx from <> breakOrSpace <> txt "..") + FromThen from next -> + wrap (commaSep (map (hsExpr ctx) [from, next]) <> breakOrSpace <> txt "..") + FromTo from to -> + wrap (hsExpr ctx from <> breakOrSpace <> txt ".." <> space <> hsExpr ctx to) + FromThenTo from next to -> + wrap $ + commaSep (map (hsExpr ctx) [from, next]) + <> breakOrSpace + <> txt ".." + <> space + <> hsExpr ctx to + where + wrap = bracketsWith closing + +-- | One field of a record construction or update. +fieldBind :: + (HasLoc l) => + Ctx -> + (GenLocated l a -> Doc) -> + HsFieldBind (GenLocated l a) (LHsExpr GhcPs) -> + Doc +fieldBind ctx label HsFieldBind {..} = + label hfbLHS + <> includeUnless hfbPun (space <> txt "=" <> attach placement (hsExpr ctx hfbRHS)) + where + placement + | sameLine (spanOf hfbLHS) (spanOf hfbRHS) = exprHangs (unLoc hfbRHS) + | otherwise = Normal + +dotField :: Ctx -> DotFieldOcc GhcPs -> Doc +dotField ctx = name ctx . fmap (mkVarUnqual . field_label) . dfoLabel + +dotFields :: Ctx -> NonEmpty (DotFieldOcc GhcPs) -> Doc +dotFields ctx = sepBy (txt ".") . map (dotField ctx) . NE.toList + +---------------------------------------------------------------------------- +-- Operator chains + +-- | A chain of operators applied to expressions. +-- +-- Two layouts are possible once such a chain has to break. The leading one +-- puts each operator at the start of a line with its operand: +-- +-- > foo +-- > <> bar +-- > <> baz +-- +-- The trailing one leaves the operator at the end of the line above: +-- +-- > foo $ do +-- > … +-- +-- Trailing is only right when every operator is a separator +-- ('isSeparator') and the chain ends in something with a hanging form, or +-- when there is a single operator. Otherwise it builds a staircase of +-- ever-deeper indentation and gains nothing by it. +exprChain :: Ctx -> Site -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> Doc +exprChain ctx site x op y = + renderExprChain ctx site (uncurry (associate (fixityOf ctx)) chain) + where + chain = flattenAround splitOpApp x op y + +splitOpApp :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, LHsExpr GhcPs, LHsExpr GhcPs) +splitOpApp e = case unLoc e of + OpApp _ l o r -> Just (l, o, r) + _ -> Nothing + +fixityOf :: Ctx -> LHsExpr GhcPs -> Maybe Fixity +fixityOf ctx o = operatorName o >>= operatorFixity ctx InTerms + +renderExprChain :: Ctx -> Site -> OpChain (LHsExpr GhcPs) (LHsExpr GhcPs) -> Doc +renderExprChain ctx site = \case + Operand e -> hsExprIn ctx site e + chain@(Chain operands@(firstOne :| rest) operators) -> + layoutFrom ctx (chainSpan spanOf chain) $ + if trailing + then laidOut MayBrace + else whenFlat (if placement == Hanging then MayBrace else NoBrace) laidOut + where + placement = chainPlacement exprHangs firstOne (NE.last operands) + + laidOut bracing = + renderExprChain ctx (withBracing bracing site) firstOne + <> pieces bracing firstOne operators rest + + pieces bracing previous (o : os) (operand : more) = + let isLast = null more + operandSite = + withBracing (if isLast then siteBracing site else bracing) plainSite + rendered = renderExprChain ctx operandSite operand + rest' = pieces bracing operand os more + in if trailing + then space <> hsExpr ctx o <> attach (tailPlacement isLast previous operand) (rendered <> rest') + else attach placement (hsExpr ctx o <> space <> rendered) <> rest' + pieces _ _ _ _ = mempty + + -- In a staircase of trailing operators the operand at the very end is + -- the one that may hang, since it is the block the whole chain exists + -- to introduce. + tailPlacement isLast previous operand + | isLast, + not (maybe True isSingleLine (chainSpan spanOf operand)) = + chainPlacement exprHangs previous operand + | otherwise = Normal + + -- A comment written on its own line in front of an operator would be + -- carried to the end of the line above along with it, and a @$@ at the + -- start of a line inside a @do@ block reads as a new statement rather + -- than as a continuation. The leading layout indents instead, so it + -- keeps the meaning. + commentedOperators = + or (zipWith commentedBefore (NE.toList operands) operators) + commentedBefore operand o = + commentBetween ctx (chainSpan spanOf operand) (spanOf o) + + trailing = + (length operators == 1 || endsHanging) + && not commentedOperators + && and (zipWith couldTrail (NE.toList operands) operators) + + endsHanging = exprHangs (unLoc (lastOperand chain)) == Hanging + + couldTrail previous o = + isSeparator (fixityOf ctx o) + && maybe False isSingleLine (chainSpan spanOf previous) + && placement == Normal + -- An operator cannot trail a @do@ block: the block would swallow + -- it and read it as part of its last statement. + && not (isDoBlock (lastOperand previous)) + +isDoBlock :: LHsExpr GhcPs -> Bool +isDoBlock e = case unLoc e of + HsDo _ (DoExpr _) _ -> True + HsDo _ (MDoExpr _) _ -> True + _ -> False + +-- | Whether the operands of a chain hang. +-- +-- They may when the first and the last operand begin on the same line—so +-- that there is a line for the last one to hang from—and the last operand is +-- itself something with a hanging form. +chainPlacement :: + (HasLoc l) => + (a -> Placement) -> + OpChain (GenLocated l a) op -> + OpChain (GenLocated l a) op -> + Placement +chainPlacement placer firstOne lastOne = case lastOne of + Operand (L _ n) | startsTogether -> placer n + _ -> Normal + where + startsTogether = + case (chainSpan spanOf firstOne, chainSpan spanOf lastOne) of + (Just a, Just b) -> spanStartLine a == spanStartLine b + _ -> False + +-- | Is this quoted constraint nothing but a variable? +loneVariableExpr :: LHsExpr GhcPs -> Bool +loneVariableExpr e = case unLoc e of + HsVar _ (L _ n) -> isVarOcc (rdrNameOcc n) + _ -> False + +unbracketed :: LHsExpr GhcPs -> LHsExpr GhcPs +unbracketed e = case unLoc e of + HsPar _ inner -> unbracketed inner + _ -> e + +---------------------------------------------------------------------------- +-- Commands + +-- | An arrow-notation command. +hsCmd :: Ctx -> Site -> LHsCmd GhcPs -> Doc +hsCmd ctx site l = at ctx l (cmdBody ctx site) + +cmdBody :: Ctx -> Site -> HsCmd GhcPs -> Doc +cmdBody ctx site = \case + -- Which of the two operands is written first is what the arrow's + -- direction says: @a -< b@ feeds the input on the right to the command on + -- the left, and @b >- a@ says the same thing the other way round. + HsCmdArrApp _ body input arrow rightToLeft -> + let writtenFirst = if rightToLeft then body else input + writtenSecond = if rightToLeft then input else body + in hsExprIn ctx site {siteApplicand = False} writtenFirst + <> breakOrSpace + <> indent + ( txt (arrowText arrow rightToLeft) + <> attach (exprHangs (unLoc input)) (hsExpr ctx writtenSecond) + ) + HsCmdArrForm _ form Prefix cmds -> + bananaWith (closingFor site) $ + hsExpr ctx form + <> includeUnless + (null cmds) + (breakOrSpace <> indent (sepBy breakOrSpace (map (printBody . CmdTopBody ctx plainSite) cmds))) + HsCmdArrForm _ form Infix [l, r] -> cmdChain ctx site l form r + HsCmdArrForm _ _ Infix _ -> + error "Tilia: an infix command form always has exactly two operands" + HsCmdApp _ cmd e -> + hsCmd ctx site {siteApplicand = True} cmd + <> breakOrSpace + <> indent (hsExpr ctx e) + HsCmdLam _ variant' mg -> lambda ctx site variant' (CmdBody ctx) mg + HsCmdPar _ c -> parens (hsCmd ctx plainSite c) + HsCmdCase _ e mg -> caseOf ctx site (CmdBody ctx) e mg + HsCmdIf anns _ c t e -> + ifThenElse ctx (bodyIn (CmdBody ctx) (siteBracing site)) anns c t e + HsCmdLet _ binds c -> letIn ctx (bodyIn (CmdBody ctx) (siteBracing site)) binds c + HsCmdDo anns es -> + keywordAt ctx (doKeywordSpan anns) "do" + <> statements ctx site (CmdBody ctx) es + +arrowText :: HsArrAppType -> Bool -> Text +arrowText arrow rightToLeft = case (arrow, rightToLeft) of + (HsFirstOrderApp, True) -> "-<" + (HsHigherOrderApp, True) -> "-<<" + (HsFirstOrderApp, False) -> ">-" + (HsHigherOrderApp, False) -> ">>-" + +-- | A command at the top of an arrow form. +cmdTop :: Ctx -> Site -> HsCmdTop GhcPs -> Doc +cmdTop ctx site (HsCmdTop _ cmd) = hsCmd ctx site cmd + +-- | A chain of operators applied to commands. +-- +-- Commands have no trailing layout: an arrow form is already delimited, so +-- there is nothing for a trailing operator to introduce. +cmdChain :: + Ctx -> + Site -> + LHsCmdTop GhcPs -> + LHsExpr GhcPs -> + LHsCmdTop GhcPs -> + Doc +cmdChain ctx site l op r = + render (uncurry (associate (fixityOf ctx)) (flattenAround splitCmd l op r)) + where + splitCmd c = case unLoc c of + HsCmdTop _ (L _ (HsCmdArrForm _ o Infix [a, b])) -> Just (a, o, b) + _ -> Nothing + + render = \case + Operand c -> at ctx c (cmdTop ctx site) + chain@(Chain operands@(firstOne :| rest) operators) -> + layoutFrom ctx (chainSpan spanOf chain) $ + whenFlat (if placement == Hanging then MayBrace else NoBrace) laidOut + where + placement = chainPlacement cmdTopHangs firstOne (NE.last operands) + laidOut bracing = + renderIn bracing firstOne <> pieces bracing operators rest + -- Every operand but the last has to delimit itself when the chain + -- is flat, or a block inside it would swallow the operator. + pieces bracing (o : os) (operand : more) = + attach + placement + (hsExpr ctx o <> space <> renderIn (if null more then siteBracing site else bracing) operand) + <> pieces bracing os more + pieces _ _ _ = mempty + renderIn bracing = \case + Operand c -> at ctx c (cmdTop ctx (withBracing bracing site)) + inner -> render inner + +---------------------------------------------------------------------------- +-- Statements + +-- | A statement of a comprehension or a guard. +hsStmt :: Ctx -> ExprLStmt GhcPs -> Doc +hsStmt ctx = at_ ctx (stmtBody ctx plainSite (ExprBody ctx)) + +stmtBody :: + ( Body b, + Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW, + Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA, + Anno body ~ SrcSpanAnnA + ) => + Ctx -> + Site -> + BodyOf body b -> + Stmt GhcPs (XRec GhcPs body) -> + Doc +stmtBody ctx site mkBody = \case + LastStmt _ body _ _ -> printBody (mkBody site body) + BodyStmt _ body _ _ -> printBody (mkBody site body) + BindStmt _ p f -> + hsPat ctx p + -- Indented in case it does not stay on the line the pattern is on. A + -- comment that owns its line ends it, and an arrow starting a line at + -- the statement's own column would begin a new statement instead of + -- continuing this one. + <> nest 1 (space <> txt "<-") + <> layoutFrom ctx (spanOf p <> spanOf f) (attach placement (printBody bound)) + where + bound = mkBody plainSite f + placement + | sameLine (spanOf p) (spanOf f) = bodyPlacement bound + | otherwise = Normal + -- A @let@ opens a layout block of its own, so when something follows it + -- in a flat block the semicolon meant to end the statement is taken for + -- one separating two bindings, and the rest of the @do@ disappears into + -- the @let@. The site already knows whether anything follows: it carries + -- 'MayBrace' for every statement but the last. + LetStmt _ binds -> txt "let" <> space <> align (bound binds) + where + -- @let@ with nothing after it is not a statement whatever the layout, + -- so an empty group is written out rather than left to the bracing. + bound = \case + EmptyLocalBinds _ -> txt "{}" + bs -> localBinds ctx (siteBracing site) bs + ParStmt {} -> + -- Parallel blocks are unpacked before any statement is printed; see + -- 'comprehensionSections'. + error "Tilia: ParStmt should have been unpacked" + TransStmt {..} -> case (trS_form, trS_by) of + (ThenForm, Nothing) -> + txt "then" <> breakOrSpace <> indent (hsExpr ctx trS_using) + (ThenForm, Just e) -> + txt "then" + <> breakOrSpace + <> indent (hsExpr ctx trS_using) + <> breakOrSpace + <> txt "by" + <> breakOrSpace + <> indent (hsExpr ctx e) + (GroupForm, Nothing) -> + txt "then group using" <> breakOrSpace <> indent (hsExpr ctx trS_using) + (GroupForm, Just e) -> + txt "then group by" + <> breakOrSpace + <> indent (hsExpr ctx e) + <> breakOrSpace + <> txt "using" + <> breakOrSpace + <> indent (hsExpr ctx trS_using) + RecStmt {..} -> + txt "rec" + <> space + <> align + ( at ctx recS_stmts $ \xs -> + items (siteBracing site) $ + keepBlanks + (separatedByBlank ctx) + [ (spanOf s, at_ ctx (stmtBody ctx site mkBody) s) + | s <- xs + ] + ) + +-- | The statements of a block, with the break that introduces them. +statements :: + ( Body b, + Anno [LStmt GhcPs (XRec GhcPs body)] ~ SrcSpanAnnLW, + Anno (Stmt GhcPs (XRec GhcPs body)) ~ SrcSpanAnnA, + Anno body ~ SrcSpanAnnA + ) => + Ctx -> + Site -> + BodyOf body b -> + XRec GhcPs [LStmt GhcPs (XRec GhcPs body)] -> + Doc +statements ctx site mkBody es = + breakOrSpace <> underSite site (at ctx es block) + where + block xs = + items (siteBracing site) $ + keepBlanks (separatedByBlank ctx) [(spanOf stmt, item place stmt) | (place, stmt) <- places xs] + + -- Every statement but the last has to delimit itself when the block is + -- flat, or a block nested inside it would run on into the next one. + item place stmt = case place of + Last -> rendered (siteBracing site) + Only -> rendered (siteBracing site) + _ -> whenFlat (siteBracing site) rendered + where + rendered bracing = + at_ ctx (stmtBody ctx (blockSite bracing) mkBody) stmt + + blockSite bracing = + plainSite {siteInBlock = True, siteBracing = bracing} + +---------------------------------------------------------------------------- +-- List comprehensions + +-- | A list comprehension. +-- +-- Standing as a statement of a @do@ block, the closing bracket has to line +-- up under the opening one: the block's own layout would otherwise end the +-- statement before the bracket was closed. +comprehension :: Ctx -> Site -> XRec GhcPs [ExprLStmt GhcPs] -> Doc +comprehension ctx site es = align (variant onOneLine acrossLines) + where + onOneLine = txt "[" <> body <> txt "]" + acrossLines = txt "[" <> space <> keepInside (body <> hardBreak <> txt "]") + keepInside = if siteInBlock site then align else id + body = at ctx es sections + sections xs = case unsnoc xs of + Nothing -> error "Tilia: a comprehension always yields something" + Just (stmts, yield) -> + align (hsStmt ctx yield) + <> breakOrSpace + <> sepBy breakOrSpace (map section (comprehensionSections stmts)) + section stmts = + located' + (spansOf stmts) + (txt "|" <> space <> align (commaSep (map (align . hsStmt ctx) stmts))) + located' = maybe id located + +-- | Split the statements of a comprehension into its parallel sections. +-- +-- With @ParallelListComp@ a comprehension may have several runs of +-- statements separated by bars, and the parser wraps those in a single +-- statement holding blocks. Everywhere else there is exactly one run. Both +-- come back from here as a list of runs, so nothing downstream has to know +-- which it was given. +comprehensionSections :: [ExprLStmt GhcPs] -> [[ExprLStmt GhcPs]] +comprehensionSections = map unnest . branches + where + -- One run of statements, unless the comprehension was written with @|@ + -- between several, in which case each run is a section of its own. + branches = \case + [L _ (ParStmt _ blocks _ _)] -> + [run | ParStmtBlock _ run _ _ <- NE.toList blocks] + run -> [run] + + -- A @then@ carries the statements it transforms. They are printed, and + -- then it is, in that order. + unnest = concatMap $ \case + L _ ParStmt {} -> error "Tilia: parallel blocks do not nest" + stmt@(L _ TransStmt {trS_stmts}) -> unnest trS_stmts <> [stmt] + stmt -> [stmt] + +---------------------------------------------------------------------------- +-- Case, lambda, if and let + +-- | A @case@ expression or command. +caseOf :: + ( Body b, + Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO, + Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA + ) => + Ctx -> + Site -> + BodyOf body b -> + LHsExpr GhcPs -> + MatchGroup GhcPs (LocatedA body) -> + Doc +caseOf ctx site mkBody scrutinee mg = + txt "case" + <> space + <> hsExpr ctx scrutinee + <> joinedBy "of" + <> bracedForSite site alternatives + where + alternatives b = underSite site (matchGroup ctx b mkBody CaseStyle mg) + +-- | A lambda, in any of its three spellings. +lambda :: + ( Body b, + Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO, + Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA + ) => + Ctx -> + Site -> + HsLamVariant -> + BodyOf body b -> + MatchGroup GhcPs (LocatedA body) -> + Doc +lambda ctx site variant' mkBody mg = case keyword of + Nothing -> matchGroup ctx (siteBracing site) mkBody LambdaStyle mg + Just kw -> txt kw <> breakOrSpace <> bracedForSite site alternatives + where + alternatives b = underSite site (matchGroup ctx b mkBody LambdaCaseStyle mg) + keyword = case variant' of + LamSingle -> Nothing + LamCase -> Just "\\case" + LamCases -> Just "\\cases" + +-- | An @if@ expression or command. +ifThenElse :: + (Body b) => + Ctx -> + (LocatedA body -> b) -> + AnnsIf -> + LHsExpr GhcPs -> + LocatedA body -> + LocatedA body -> + Doc +ifThenElse ctx bodyOf AnnsIf {aiThen, aiElse} condition thenBody elseBody = + txt "if" + <> space + <> hsExpr ctx condition + <> breakOrSpace + <> indent + ( branch (locA aiThen) "then" thenBody + <> breakOrSpace + <> branch (locA aiElse) "else" elseBody + ) + where + branch written word body = + keywordAt ctx keywordSpan word + <> space + <> layoutFrom + ctx + (keywordSpan <> spanOf body) + (attach placement (printBody (bodyOf body))) + where + keywordSpan = spanOfSrcSpan written + placement + | commentBetween ctx keywordSpan (spanOf body) = Normal + | otherwise = bodyPlacement (bodyOf body) + +-- | A @let@ expression or command. +-- +-- The @in@ is indented by one column rather than by one step, which keeps it +-- clear of the bindings above without making it look like one of them. +letIn :: + (Body b) => + Ctx -> + (LocatedA body -> b) -> + HsLocalBinds GhcPs -> + LocatedA body -> + Doc +letIn ctx bodyOf binds body = + align $ + -- Neither keyword claims its span, unlike the @do@ of a block. Both have + -- something printed after them on their own line—the first binding, the + -- body—so a comment either of them claimed would be held back over that + -- and come out against it, which is further from where it was written + -- than where it lands by falling through. + txt "let" + <> space + <> align (localBinds ctx NoBrace binds) + <> variant space (hardBreak <> txt " ") + <> txt "in" + <> space + <> align (printBody (bodyOf body)) + +---------------------------------------------------------------------------- +-- Bindings + +-- | A value binding. +valDecl :: Ctx -> Bracing -> HsBind GhcPs -> Doc +valDecl ctx bracing = \case + FunBind _ funId funMatches -> + matchGroup ctx bracing (ExprBody ctx) (FunctionStyle funId) funMatches + PatBind _ p multAnn grhss -> + match ctx bracing (ExprBody ctx) PatternBindStyle False multAnn NoSrcStrict [p] grhss + PatSynBind _ psb -> patSynBind ctx psb + VarBind {} -> error "Tilia: VarBind is introduced by the type checker" + +-- | Which shape a group of equations takes. +data MatchStyle + = -- | @f x = …@ + FunctionStyle (LocatedN RdrName) + | -- | @(x, y) = …@ + PatternBindStyle + | -- | An alternative of a @case@ + CaseStyle + | -- | The body of a @\\@ + LambdaStyle + | -- | An alternative of a @\\case@ or @\\cases@ + LambdaCaseStyle + +-- | What separates a guard from what it guards. +data GuardStyle + = EqualsSign + | RightArrow + deriving (Eq, Show) + +-- | A group of equations. +matchGroup :: + ( Body b, + Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO, + Anno (Match GhcPs (LocatedA body)) ~ SrcSpanAnnA + ) => + Ctx -> + Bracing -> + BodyOf body b -> + MatchStyle -> + MatchGroup GhcPs (LocatedA body) -> + Doc +matchGroup ctx bracing mkBody style MG {..} = + items blockBracing (map rendered (places (unLoc mg_alts))) + where + blockBracing = case style of + CaseStyle -> ifEmpty + LambdaCaseStyle -> ifEmpty + _ -> NoBrace + ifEmpty = if null (unLoc mg_alts) then MayBrace else bracing + rendered (place, m) = case place of + Last -> written bracing + Only -> written bracing + _ -> whenFlat bracing written + where + written b = at_ ctx (renderMatch b) m + + renderMatch b m@Match {..} = + match + ctx + b + mkBody + (adjustStyle m style) + (isInfixMatch m) + (HsUnannotated EpPatBind) + (bangBeforeName m) + (unLoc m_pats) + m_grhss + +-- | The name to print an equation with. +-- +-- The name on the binding as a whole is not usable: the equations may spell +-- it differently, one writing @x \`f\` y@ and the next @f x y@, and each +-- carries its own decorations. So the name comes from the equation. +adjustStyle :: Match GhcPs body -> MatchStyle -> MatchStyle +adjustStyle m = \case + FunctionStyle _ | FunRhs {mc_fun = f} <- m_ctxt m -> FunctionStyle f + style -> style + +-- | Was a @!@ written in front of the name this equation defines? +bangBeforeName :: Match id body -> SrcStrictness +bangBeforeName = \case + Match {m_ctxt = FunRhs {mc_strictness}} -> mc_strictness + _ -> NoSrcStrict + +-- | One equation: a head, a body, and possibly a @where@. +match :: + (Body b, Anno (GRHS GhcPs (LocatedA body)) ~ EpAnnCO) => + Ctx -> + Bracing -> + BodyOf body b -> + MatchStyle -> + -- | Written infix? + Bool -> + HsMultAnn GhcPs -> + SrcStrictness -> + [LPat GhcPs] -> + GRHSs GhcPs (LocatedA body) -> + Doc +match ctx bracing mkBody style isInfix multAnn strict pats GRHSs {..} = + multiplicity (hsType ctx) multAnn + <> multAnnGap + <> strictness strict + <> head' + <> nest + (if indentBody then 1 else 0) + ( separator + <> layoutFrom ctx bodySpan (attach placement body) + <> indent whereClause + ) + where + multAnnGap = case multAnn of + HsUnannotated {} -> mempty + _ -> space + + -- Patterns may be spread over several lines, in which case they have to + -- be indented past the name, and then the body has to be indented too or + -- it would line up with them. When they fit on one line neither + -- indentation is wanted: the body would sit two steps in for no reason. + indentBody = case pats of + [] -> False + _ -> + not (maybe True isSingleLine headSpan) + && not (isCaseStyle style && any containsOrPat pats) + + headSpan = case style of + FunctionStyle n -> spanOf n <> patSpans + _ -> patSpans + patSpans = spansOf pats + + head' = case pats of + [] -> case style of + FunctionStyle n -> name ctx n + _ -> mempty + (headPat : tailPats) -> layoutFrom ctx headSpan $ case style of + FunctionStyle n -> defHead isInfix indentBody (name ctx n) rendered + PatternBindStyle -> sepBy breakOrSpace rendered + CaseStyle -> sepBy breakOrSpace rendered + LambdaStyle -> txt "\\" <> lambdaGap headPat <> align (sepBy breakOrSpace rendered) + LambdaCaseStyle -> + hsPat ctx headPat + <> includeUnless + (null tailPats) + (breakOrSpace <> indent (sepBy breakOrSpace (map (hsPat ctx) tailPats))) + where + rendered = map (hsPat ctx) pats + + -- A @~@, @!@ or splice immediately after the backslash would be taken + -- for an operator section. + lambdaGap p = includeWhen (needsGap (unLoc p)) space + needsGap = \case + LazyPat {} -> True + BangPat {} -> True + SplicePat {} -> True + InvisPat {} -> True + _ -> False + + endOfPats = case pats of + [] -> case style of + FunctionStyle n -> spanOf n + _ -> Nothing + _ -> spanOf (last pats) + + hasGuards = any (not . null . guardsOf . unLoc) grhssGRHSs + + rhsSpan = foldr1 (<>) (fmap (grhsSpan . unLoc) grhssGRHSs) + bodySpan = fmap endOf endOfPats <> rhsSpan + + placement = case endOfPats of + Just spn + | any (longGuard . unLoc) grhssGRHSs || not (sameLine (Just spn) rhsSpan) -> + Normal + _ -> blockPlacement (bodyIn mkBody bracing) grhssGRHSs + -- A guard that does not fit on one line, or a run of them, has to be + -- followed by a break: the body would otherwise trail off the end of a + -- guard rather than following the whole condition. + longGuard grhs = case guardsOf grhs of + [] -> False + [g] -> not (maybe True isSingleLine (spanOf g)) + _ -> True + + -- With more than one guarded alternative there is nothing to put the @=@ + -- after: each alternative carries its own. + separator + | length grhssGRHSs > 1 = mempty + | otherwise = case style of + FunctionStyle _ | hasGuards -> mempty + FunctionStyle _ -> space <> indent (txt "=") + PatternBindStyle | hasGuards -> mempty + PatternBindStyle -> space <> indent (txt "=") + s | isCaseStyle s && hasGuards -> mempty + _ -> space <> txt "->" + + body = sepBy breakOrSpace (map alternative (NE.toList grhssGRHSs)) + -- The region an alternative owns runs from its guards to its body. The + -- annotation would have it start at the @->@, which puts a comment + -- written after the pattern inside the alternative rather than at the + -- end of the pattern's line, where the author wrote it. + alternative g = + fenceWithin ctx (spanOf g) $ + atSpan + ctx + (grhsSpan (unLoc g)) + (guardedRhs ctx placement bracing mkBody groupStyle (unLoc g)) + groupStyle + | isCaseStyle style && hasGuards = RightArrow + | otherwise = EqualsSign + + -- A @where@ the author wrote and put nothing under is kept. Only the + -- absence of the keyword altogether prints nothing: the two are + -- different trees, and an empty @where@ is usually somewhere its author + -- was about to write something. + whereClause = case grhssLocalBinds of + EmptyLocalBinds _ -> mempty + binds -> + breakOrSpace + <> keywordAt ctx (whereKeywordSpan binds) "where" + <> includeUnless + (isEmptyLocalBinds binds) + (breakOrSpace <> indent (localBinds ctx bracing binds)) + +isCaseStyle :: MatchStyle -> Bool +isCaseStyle = \case + CaseStyle -> True + LambdaCaseStyle -> True + _ -> False + +containsOrPat :: LPat GhcPs -> Bool +containsOrPat = any isOrPat . listify (const True :: Pat GhcPs -> Bool) + where + isOrPat = \case + OrPat {} -> True + _ -> False + +grhsSpan :: GRHS GhcPs (LocatedA body) -> Maybe Span +grhsSpan (GRHS _ guards body) = spanOf body <> spansOf guards + +-- | The guards of an alternative. +guardsOf :: GRHS GhcPs body -> [GuardLStmt GhcPs] +guardsOf (GRHS _ guards _) = guards + +-- | The placement of a body that is the whole of an equation. +-- +-- Only an unguarded equation with a single alternative can hang: with +-- guards, what follows the @=@ is a guard rather than the body. +blockPlacement :: + (Body b) => + (LocatedA body -> b) -> + NonEmpty (LGRHS GhcPs (LocatedA body)) -> + Placement +blockPlacement bodyOf = \case + L _ (GRHS _ _ body) :| [] -> bodyPlacement (bodyOf body) + _ -> Normal + +-- | One alternative of an equation: its guards, and what they guard. +guardedRhs :: + (Body b) => + Ctx -> + -- | How the equation as a whole is placed + Placement -> + -- | Bracing the body inherits + Bracing -> + BodyOf body b -> + GuardStyle -> + GRHS GhcPs (LocatedA body) -> + Doc +guardedRhs ctx parentPlacement bracing mkBody style (GRHS _ guards body) = case guards of + [] -> printBody bound + _ -> + txt "|" + <> space + <> align (commaSep (map (align . hsStmt ctx) guards)) + <> space + <> indent (txt separator) + -- A guard laid out normally has its body indented one step further, so + -- that the body is clear of the guard. With everything on one line + -- that step would be indentation for its own sake. + <> nest + (if parentPlacement == Normal then 1 else 0) + (attach placement (printBody bound)) + where + bound = bodyIn mkBody bracing body + separator = case style of + EqualsSign -> "=" + RightArrow -> "->" + placement + | maybe True (\g -> sameLine (Just g) (spanOf body)) endOfGuards = + bodyPlacement bound + | otherwise = Normal + endOfGuards = case guards of + [] -> Nothing + _ -> spanOf (last guards) + +-- | A pattern synonym binding. +patSynBind :: Ctx -> PatSynBind GhcPs GhcPs -> Doc +patSynBind ctx PSB {..} = + txt "pattern" <> case psb_args of + PrefixCon args -> + space + <> name ctx psb_id + <> indent + ( layoutAcross ctx args (argsAfterName (map (name ctx) args) (null args)) + <> definition (spansOf args) + ) + RecCon args -> + space + <> name ctx psb_id + <> indent + ( layoutAcross + ctx + (vars args) + ( includeUnless (null args) breakOrSpace + <> braces (commaSep (map (name ctx) (vars args))) + ) + <> definition (spansOf (vars args)) + ) + where + vars = map recordPatSynPatVar + InfixCon l r -> + layoutFrom + ctx + (spanOf l <> spanOf r) + (space <> name ctx l <> breakOrSpace <> indent (name ctx psb_id <> space <> name ctx r)) + <> indent (definition (spanOf l <> spanOf r)) + where + argsAfterName rendered isEmpty = + includeUnless isEmpty breakOrSpace <> align (sepBy breakOrSpace rendered) + + definition argSpans = + space <> case psb_dir of + Unidirectional -> rhs "<-" + ImplicitBidirectional -> rhs "=" + ExplicitBidirectional mg -> + rhs "<-" + <> breakOrSpace + <> txt "where" + <> breakOrSpace + <> indent (matchGroup ctx NoBrace (ExprBody ctx) (FunctionStyle psb_id) mg) + where + rhs arrow = + layoutFrom ctx (spanOf psb_id <> spanOf psb_def <> argSpans) $ + txt arrow <> breakOrSpace <> hsPat ctx psb_def + +---------------------------------------------------------------------------- +-- Local bindings + +-- | The bindings of a @let@ or a @where@. +-- +-- The bindings and the signatures arrive in separate lists, because that is +-- how the syntax tree keeps them, and they have to be put back into the +-- order the author wrote them in before anything is printed. +localBinds :: Ctx -> Bracing -> HsLocalBinds GhcPs -> Doc +localBinds ctx bracing = \case + HsValBinds ann (ValBinds _ binds sigs) -> + anchored ann . align . items bracing $ + keepBlanks (separatedByBlank ctx) [(spanOf item, rendered place item) | (place, item) <- places sorted] + where + sorted = + sortBy + (leftmost_smallest `on` getLocA) + (map (fmap Left) binds <> map (fmap Right) sigs) + rendered place item = case place of + Last -> render NoBrace + Only -> render NoBrace + _ -> whenFlat NoBrace render + where + render b = + at_ ctx (either (valDecl ctx b) (knotSig (ctxKnot ctx) ctx)) item + HsValBinds _ _ -> error "Tilia: renamer-only local bindings" + HsIPBinds ann (IPBinds _ xs) -> + anchored ann (items bracing (map (at_ ctx implicitBind) xs)) + EmptyLocalBinds _ -> mempty + where + implicitBind (IPBind _ (L _ n) e) = + outputable n + <> joinedBy "=" + <> indent (hsExprIn ctx (withBracing MayBrace plainSite) e) + + -- The bindings have no wrapper of their own, so the annotation's anchor + -- is the only record of where they were, and the layout depends on it. + anchored ann d = case ann of + EpAnn {anns = AnnList {al_anchor}} + | not (isZeroWidthSpan (locA al_anchor)) -> + atSpan ctx (spanOfSrcSpan (locA al_anchor)) d + _ -> d + +-- | Where a @do@ or @mdo@ was written. +doKeywordSpan :: AnnList EpaLocation -> Maybe Span +doKeywordSpan = spanOfSrcSpan . locA . al_rest + +-- | Where the @where@ keyword of a group of local bindings was. +whereKeywordSpan :: HsLocalBinds GhcPs -> Maybe Span +whereKeywordSpan = + spanOfSrcSpan . \case + HsValBinds EpAnn {anns = AnnList {al_rest}} _ -> locA al_rest + HsIPBinds EpAnn {anns = AnnList {al_rest}} _ -> locA al_rest + EmptyLocalBinds _ -> noSrcSpan + +isEmptyLocalBinds :: HsLocalBinds GhcPs -> Bool +isEmptyLocalBinds = \case + EmptyLocalBinds _ -> True + HsValBinds _ (ValBinds _ binds sigs) -> null binds && null sigs + _ -> False + +---------------------------------------------------------------------------- +-- Splices + +-- | An untyped splice, either @$x@ or a quasi-quotation. +untypedSplice :: Ctx -> SpliceDecoration -> HsUntypedSplice GhcPs -> Doc +untypedSplice ctx deco = \case + HsUntypedSpliceExpr _ e -> spliceTH ctx False e deco + HsQuasiQuote _ quoter str -> + txt "[" + <> name ctx quoter + <> txt "|" + -- A quoter is handed the text exactly as written; laying it out would + -- change what the quoter receives. + <> at ctx str (verbatim . T.pack . unpackFS) + <> txt "|]" + +spliceTH :: Ctx -> Bool -> LHsExpr GhcPs -> SpliceDecoration -> Doc +spliceTH ctx isTyped e = \case + DollarSplice -> txt (if isTyped then "$$" else "$") <> spliced + BareSplice -> spliced + where + spliced = at ctx e (align . exprBody ctx plainSite (spanOf e)) + +-- | A Template Haskell quotation. +quotation :: Ctx -> HsQuote GhcPs -> Doc +quotation ctx = \case + ExpBr (bracketAnn, _) e -> quoted (flavour bracketAnn) (hsExpr ctx e) + where + flavour = \case + BracketNoE {} -> "" + BracketHasE {} -> "e" + PatBr _ p -> quoted "p" (hsPat ctx p) + DecBrL _ decls -> + quoted "d" (starGuard decls (knotDecls (ctxKnot ctx) ctx Free decls)) + DecBrG _ _ -> error "Tilia: DecBrG is produced by the renamer" + TypBr _ ty -> quoted "t" (starGuard ty (hsType ctx ty)) + VarBr _ isSingle n -> txt (if isSingle then "'" else "''") <> name ctx n + where + quoted flavour body = + txt "[" + <> txt flavour + <> txt "|" + <> breakOrNothing + <> indent (body <> breakOrNothing <> txt "|]") + + -- A quotation whose last token is punctuation runs into the @|@ that + -- closes it and the two lex as one operator: with @StarIsType@ it may + -- end in a @*@, giving @*|@, and an abstract closed type family ends in + -- @..@, giving @..|@. The test is deliberately coarse: either one + -- anywhere inside costs a space at each end and nothing else. + starGuard x body + | risky = space <> body <> space + | otherwise = body + where + risky = + any isStar (listify (const True :: HsType GhcPs -> Bool) x) + || any isAbstract (listify (const True :: FamilyInfo GhcPs -> Bool) x) + isStar = \case + HsStarTy {} -> True + _ -> False + isAbstract = \case + ClosedTypeFamily Nothing -> True + _ -> False diff --git a/src/Tilia/Render/Haddock.hs b/src/Tilia/Render/Haddock.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Haddock.hs @@ -0,0 +1,325 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Documentation comments. +-- +-- A Haddock is a comment that the syntax tree also knows about, which makes +-- it the one comment the printer places itself rather than leaving to +-- attachment. It has to: @-- ^ x@ documents what precedes it and @-- | x@ +-- what follows, so moving the construct moves the Haddock, and where it ends +-- up cannot be worked out from where it started. +-- +-- What the author wrote is reused whenever it can be, because rebuilding a +-- Haddock from the doc string the tree carries loses things the tree never +-- had: a @{- | … -}@ comes back as @-- |@ lines, and an empty @-- |@ comes +-- back as nothing at all. It cannot always be reused, since a trailing +-- @-- ^ x@ that is being moved in front of what it documents has to become +-- @-- | x@ or it will point at the wrong thing. +module Tilia.Render.Haddock + ( DocStyle (..), + Ending (..), + haddock, + haddockInline, + docSectionName, + brokenIfDocumented, + printsWholeLineDocs, + haddockSpans, + ) +where + +import Control.Applicative ((<|>)) +import Data.Data (Data) +import Data.Generics.Schemes (listify) +import Data.List (dropWhileEnd) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NE +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Hs +import GHC.Types.SrcLoc (GenLocated (..), getLoc, unLoc) +import Tilia.Doc.Combinators +import Tilia.Render.Context +import Tilia.Span +import Tilia.Span.Ghc + +-- | Which kind of Haddock is being printed. +data DocStyle + = -- | @-- |@, documenting what follows + Pipe + | -- | @-- ^@, documenting what precedes + Caret + | -- | @-- *@, a section heading, at the given depth + Section Int + | -- | @-- $name@, a named chunk + Chunk String + deriving (Eq, Show) + +-- | Whether the Haddock ends the line it is on. +data Ending + = -- | The caller will end the line itself. + Open + | -- | End it here. + Closed + deriving (Eq, Show) + +-- | Print a Haddock. +haddock :: Ctx -> DocStyle -> Ending -> LHsDoc GhcPs -> Doc +haddock ctx style ending doc = fst (docBody ctx style doc) <> close + where + close = case ending of + Open -> mempty + Closed -> hardBreak + +-- | A Haddock inside a construct that may legitimately stay on one line. +-- +-- A @{- | … -}@ delimits itself, so @data A = A {- | a number -} Int@ is +-- left as written. A @--@ Haddock owns the rest of its line and still has to +-- end it. +haddockInline :: Ctx -> DocStyle -> LHsDoc GhcPs -> Doc +haddockInline ctx style doc = + body <> (if isSelfClosing then breakOrSpace else hardBreak) + where + (body, isSelfClosing) = docBody ctx style doc + +-- | The Haddock itself, and whether the form it took delimits itself. +docBody :: Ctx -> DocStyle -> LHsDoc GhcPs -> (Doc, Bool) +docBody ctx style doc@(L l str) = + case reusableText ctx style doc of + Just written -> + ( maybe id located (spanOfSrcSpan l) $ + align (sepBy (verbatimBreak AtIndent) (map txt (NE.toList written))), + selfClosing written + ) + Nothing + | null written' -> (emptyBlock, True) + | blockForm -> (rebuiltBlock, False) + | otherwise -> (rebuilt, False) + where + emptyBlock = txt (blockOpener style) <> space <> txt "-}" + + -- No provenance on a rebuilt Haddock, unlike one whose text is reused. + -- Rebuilding is what happens when the author wrote it in another style, + -- and the commonest of those is a @-- ^@ being printed as @-- |@, which + -- moves it from after what it documents to before. Offering where it + -- used to be as somewhere a comment may attach would put that comment + -- ahead of comments that were written above it. + rebuilt = + sepBy hardBreak (zipWith line' (True : repeat False) written') + <> mconcat (replicate trailingBlanks (hardBreak <> txt "--")) + trailingBlanks = case writtenHaddock ctx (spanOfSrcSpan l) of + Nothing -> 0 + Just ls -> length (takeWhile isBlankLine (reverse (NE.toList ls))) + isBlankLine t = T.null (T.strip (fromMaybe t (T.stripPrefix "--" (T.strip t)))) + + line' isFirst t = + (if isFirst then txt (opener style) else txt "--") + <> space + <> txt t + + -- One the author wrote as a block comment over several lines is + -- rebuilt as one. Cut into @--@ lines it would stop being a single + -- comment: the lexer reads the first line as documentation and every + -- line after it as an ordinary comment, so a Haddock of two lines would + -- come back as a Haddock of one and a comment saying half a sentence. + -- A block of one line has no such lines to lose and is rebuilt as + -- @-- |@ like any other. + rebuiltBlock = + align $ + txt (blockOpener style) + <> space + <> sepBy (verbatimBreak AtIndent) (map txt written') + <> space + <> txt "-}" + + asBlock = writtenAsBlock ctx doc + written' = docLines asBlock str + blockForm = asBlock && length written' > 1 + +-- | How a rebuilt Haddock begins. +opener :: DocStyle -> Text +opener = \case + Pipe -> "-- |" + Caret -> "-- ^" + Section n -> "-- " <> T.replicate n "*" + Chunk n -> docSectionName n + +-- | How a rebuilt Haddock that stays a block comment begins. +blockOpener :: DocStyle -> Text +blockOpener = \case + Pipe -> "{- |" + Caret -> "{- ^" + Section n -> "{- " <> T.replicate n "*" + Chunk n -> "{- $" <> T.pack n + +-- | Did the author write this Haddock as a block comment? +writtenAsBlock :: Ctx -> LHsDoc GhcPs -> Bool +writtenAsBlock ctx doc = + maybe False isBlockForm (writtenHaddock ctx (spanOfSrcSpan (getLoc doc))) + +-- | The anchor of a named documentation chunk. +-- +-- Unlike a Haddock this carries no text of its own, so there is nothing to +-- reuse and nothing to report a position for. +docSectionName :: String -> Text +docSectionName n = "-- $" <> T.pack n + +-- | The author's own text, when it may be used. +-- +-- It may not when the Haddock is about to be printed in a style other than +-- the one it was written in, since the text carries the style in its first +-- characters. +reusableText :: Ctx -> DocStyle -> LHsDoc GhcPs -> Maybe (NonEmpty Text) +reusableText ctx style doc = do + written <- writtenHaddock ctx (spanOfSrcSpan (getLoc doc)) + if openedInStyle style (NE.head written) then Just written else Nothing + +-- | Was the Haddock written in the style it is about to come back out in? +openedInStyle :: DocStyle -> Text -> Bool +openedInStyle style firstLine = case afterOpener firstLine of + Nothing -> False + Just inside -> case style of + -- A chunk's name is the compiler's to delimit, and it may have stopped + -- somewhere the line carries on: @-- $Id: …@ names the chunk @Id@ and + -- then goes on with a colon that is no part of it. So the name is + -- matched as a prefix and where it ends is left to the compiler. + Chunk _ -> triggerFor style `T.isPrefixOf` inside + -- The rest are a run of characters that ends where the run ends, so the + -- run is read off the line and compared whole. Matching a prefix would + -- take @** x@ for a @* x@ that happens to be followed by a star. + _ -> triggerOn inside == Just (triggerFor style) + +-- | The trigger a style is written with. +triggerFor :: DocStyle -> Text +triggerFor = \case + Pipe -> "|" + Caret -> "^" + Section n -> T.replicate n "*" + Chunk n -> "$" <> T.pack n + +-- | What follows the @--@ or @{-@ that opens a comment, with the spaces +-- after it removed. +afterOpener :: Text -> Maybe Text +afterOpener firstLine = T.stripStart <$> opened (T.stripStart firstLine) + where + opened t = T.stripPrefix "--" t <|> T.stripPrefix "{-" t + +-- | The trigger an opened comment carries, for the triggers that are a run +-- of one character. +triggerOn :: Text -> Maybe Text +triggerOn inside = do + (c, rest) <- T.uncons inside + case c of + '|' -> Just "|" + '^' -> Just "^" + '*' -> Just (T.cons c (T.takeWhile (== '*') rest)) + _ -> Nothing + +-- | Was the reused text a block comment? +isBlockForm :: NonEmpty Text -> Bool +isBlockForm written = "{-" `T.isPrefixOf` T.stripStart (NE.head written) + +-- | May code follow the reused text on the line it ends? +selfClosing :: NonEmpty Text -> Bool +selfClosing written = isBlockForm written && null (NE.tail written) + +---------------------------------------------------------------------------- +-- Documentation and layout + +-- | Lay the document out on several lines if printing this fragment will +-- emit a Haddock that takes whole lines. +brokenIfDocumented :: (Data a) => Ctx -> a -> Doc -> Doc +brokenIfDocumented ctx x d + | printsWholeLineDocs ctx x = broken d + | otherwise = d + +-- | Will printing this fragment emit a Haddock as @--@ lines? +-- +-- Every site that asks prints in 'Pipe' style, which is what decides +-- whether the author's text can be reused. +printsWholeLineDocs :: (Data a) => Ctx -> a -> Bool +printsWholeLineDocs ctx x = case docsIn x of + [] -> not (null (docStringsIn x)) + docs -> any takesWholeLines docs + where + takesWholeLines doc = case reusableText ctx Pipe doc of + Just written -> not (selfClosing written) + Nothing -> not (null (docLines (writtenAsBlock ctx doc) (unLoc doc))) + +-- | The spans of every Haddock in a fragment. +-- +-- Attachment must not place these: the printer has already put them where +-- they belong, and a comment placed twice is worse than one placed badly. +haddockSpans :: (Data a) => a -> [Span] +haddockSpans x = mapMaybe (spanOfSrcSpan . getLoc) (docsIn x) <> namedSections x + +docsIn :: (Data a) => a -> [LHsDoc GhcPs] +docsIn = listify (const True :: LHsDoc GhcPs -> Bool) + +-- | The spans of the @-- $name@ anchors in an export list. +-- +-- These are the one kind of Haddock the syntax tree records without a doc +-- string: an anchor carries only its name, so there is no 'LHsDoc' to find +-- it by, and the item that holds it is the only record of where it was. +-- Without this the anchor is printed once from the tree and once more by +-- attachment, and each pass adds another copy. +namedSections :: (Data a) => a -> [Span] +namedSections = + mapMaybe anchorSpan . listify (const True :: LIE GhcPs -> Bool) + where + anchorSpan l = case unLoc l of + IEDocNamed {} -> spanOfSrcSpan (getHasLoc (getLoc l)) + _ -> Nothing + +docStringsIn :: (Data a) => a -> [HsDocString] +docStringsIn = listify (const True :: HsDocString -> Bool) + +---------------------------------------------------------------------------- +-- Doc strings + +-- | The lines of a doc string, normalised the way Haddock reads them. +docLines :: + -- | Was it written as a block comment? + Bool -> + WithHsDocIdentifiers HsDocString GhcPs -> + [Text] +docLines blockForm str + | null body = [] + | otherwise = map guardDollar (dedent (map unpad body)) + where + body = + dropWhileEnd T.null + . map (T.stripEnd . T.pack) + . lines + . renderHsDocString + $ hsDocString str + + unpad t + | padded, Just (' ', rest) <- T.uncons t = rest + | otherwise = t + padded = case dropWhile T.null body of + (t : _) -> " " `T.isPrefixOf` t + [] -> False + + -- Written as @{- | … -}@, the lines after the first are indented to sit + -- under the opening bracket, and that indentation is measured from a + -- column the text is about to leave: printed back as @--@ lines it + -- would show up as a run of spaces the author never typed. Only the + -- part they all share goes, so anything indented further—an example, a + -- code block—keeps the shape it was given. + dedent ls + | not blockForm = ls + | otherwise = case ls of + [] -> [] + (first' : rest) -> first' : map (T.drop (shared rest)) rest + + shared ls = case map indentation (filter (not . T.null) ls) of + [] -> 0 + ns -> minimum ns + indentation = T.length . T.takeWhile (== ' ') + + -- A line may not begin with a dollar: that is the spelling of a named + -- chunk, and one appearing by accident is a parse error. + guardDollar t + | "$" `T.isPrefixOf` t = T.cons '\\' t + | otherwise = t diff --git a/src/Tilia/Render/Header.hs b/src/Tilia/Render/Header.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Header.hs @@ -0,0 +1,428 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | The module header, and the module as a whole. +-- +-- The header is the one part of a module that is reordered rather than +-- merely re-laid-out: language pragmas are sorted, and a @{-# LANGUAGE A, B +-- #-}@ is split into one pragma per extension. That is safe because the +-- compiler reads the header as a set, with one exception—some extensions +-- turn others on, so the order within a few groups is load-bearing, and +-- 'pragmaOrder' is where that is written down. +module Tilia.Render.Header + ( -- * Pragmas + HeaderPragma (..), + takeHeaderPragmas, + takeStackHeader, + + -- * The module + hsModule, + ) +where + +import Data.Function (on) +import Data.List (sortOn) +import Data.List.NonEmpty qualified as NE +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Driver.Flags (Language) +import GHC.Hs +import GHC.LanguageExtensions.Type (Extension (..)) +import GHC.Types.PkgQual (RawPkgQual (..)) +import GHC.Types.SrcLoc (GenLocated (..), unLoc) +import Tilia.Comments (Comment (..), Pragma (..), commentPragma) +import Tilia.Doc.Combinators +import Tilia.Render.Context +import Tilia.Render.Declaration (decls) +import Tilia.Render.Haddock +import Tilia.Render.Layout +import Tilia.Render.Name +import Tilia.Render.Pragma (warningTxt) +import Tilia.Source (Source, directiveAt, sourceLines) +import Tilia.Span +import Tilia.Span.Ghc + +---------------------------------------------------------------------------- +-- Pragmas + +-- | A pragma of the file header. +data HeaderPragma = HeaderPragma + { -- | The region it was written in. + hpSpan :: Span, + -- | How many preprocessor directives the header has above it. + hpRun :: Int, + -- | Where it sorts. + hpOrder :: PragmaOrder, + -- | @LANGUAGE@, @OPTIONS_GHC@ or @OPTIONS_HADDOCK@. + hpName :: Text, + -- | One extension, or the whole of an options string. + hpBody :: Text + } + deriving (Eq, Show) + +-- | Where a pragma sorts among the others. +-- +-- The derived ordering is the whole of the policy: language pragmas first, +-- then @OPTIONS_GHC@, then @OPTIONS_HADDOCK@; and within the language +-- pragmas, by the class of extension. +data PragmaOrder + = LanguageOrder ExtensionClass + | OptionsGhcOrder + | OptionsHaddockOrder + deriving (Eq, Ord, Show) + +-- | Which group an extension sorts into. +-- +-- Sorting the extensions alphabetically outright would change what a module +-- means, because an extension can turn others on and a later one can turn +-- them off again. Sorting only within these groups keeps the relationships +-- that matter: a pack before what it enables, an enabling before a +-- disabling, and the stragglers that have to come last at the end. +data ExtensionClass + = -- | @GHC2021@, @Haskell2010@ and the like + Pack + | -- | Anything else + Enabling + | -- | An extension written with a @No@ prefix + Disabling + | -- | Extensions that only work when nothing follows them + Last' + deriving (Eq, Ord, Show) + +-- | Pick the header pragmas out of a comment stream. +-- +-- What comes back is the pragmas, in the order they were written, and the +-- comments that were not pragmas. A @{-# … #-}@ below the header is not a +-- pragma at all—the compiler never reads it—so hoisting it would give it a +-- meaning it did not have, and it is left in the stream as the comment it +-- is. +takeHeaderPragmas :: + -- | The module as written + Source -> + -- | Where the header ends + Maybe Span -> + [Comment] -> + ([HeaderPragma], [Comment]) +takeHeaderPragmas src headerEnd comments = (pragmas, plain) + where + recognised = [(c, headerPragma c) | c <- comments] + pragmas = [entry c p | (c, Just p) <- recognised] + plain = + [ if rightAbovePragma c then airless c else c + | (c, Nothing) <- recognised + ] + rightAbovePragma c = + Set.member (below (spanEndLine (commentSpan c) + 1)) pragmaStarts + below n = if directiveAt n (sourceLines src) then below (n + 1) else n + pragmaStarts = + Set.fromList [spanStartLine (commentSpan c) | (c, Just _) <- recognised] + airless c = c {commentGapAbove = False, commentGapBelow = False} + directivesAbove n = + length [k | k <- [1 .. n - 1], directiveAt k (sourceLines src)] + entry c p = + HeaderPragma + { hpSpan = commentSpan c, + hpRun = directivesAbove (spanStartLine (commentSpan c)), + hpOrder = orderOf p, + hpName = pragmaName p, + hpBody = pragmaBody p + } + headerPragma c = do + p <- commentPragma c + _ <- lookupOrder (pragmaName p) + if inHeader headerEnd (commentSpan c) then Just p else Nothing + orderOf p = case pragmaName p of + "LANGUAGE" -> LanguageOrder (classifyExtension (pragmaBody p)) + other -> maybe OptionsGhcOrder id (lookupOrder other) + lookupOrder = \case + "LANGUAGE" -> Just (LanguageOrder Enabling) + "OPTIONS_GHC" -> Just OptionsGhcOrder + "OPTIONS_HADDOCK" -> Just OptionsHaddockOrder + _ -> Nothing + +-- | Was this written above everything the compiler reads as code? +inHeader :: Maybe Span -> Span -> Bool +inHeader headerEnd s = case headerEnd of + Nothing -> True + Just end -> spanStartLine s < spanStartLine end + +-- | Take the Stack script header off the front of a comment stream. +takeStackHeader :: + -- | Where the header ends + Maybe Span -> + [Comment] -> + (Doc, [Comment]) +takeStackHeader headerEnd = \case + (c : cs) | isStackHeader c -> (reproduce c <> blankLine, cs) + cs -> (mempty, cs) + where + -- Being the first comment is not enough: @stack@ reads the header off + -- the top of the file, so a @-- stack …@ written further down is an + -- ordinary comment that happens to start with a word. + isStackHeader c = + inHeader headerEnd (commentSpan c) + && T.isPrefixOf "stack" (T.stripStart (T.drop 2 (NE.head (commentBody c)))) + reproduce c = + sepBy (verbatimBreak AtMargin) (map txt (NE.toList (commentBody c))) + +-- | The pragmas of a header, one per line, sorted. +pragmaBlock :: [HeaderPragma] -> Doc +pragmaBlock = foldMap render . dedupe . sortOn key . concatMap split + where + key p = (hpRun p, hpOrder p, hpBody p) + dedupe = map NE.head . NE.groupBy ((==) `on` key) + split p + | hpName p == "LANGUAGE" = + [ p {hpBody = body, hpOrder = LanguageOrder (classifyExtension body)} + | body <- map T.strip (T.splitOn "," (hpBody p)) + ] + | otherwise = [p] + + render p = + located + (hpSpan p) + (txt "{-# " <> txt (hpName p) <> space <> txt (hpBody p) <> txt " #-}") + <> hardBreak + +-- | Which group an extension belongs to. +classifyExtension :: Text -> ExtensionClass +classifyExtension t + | namesAnEdition t = Pack + -- @ImplicitPrelude@ and @CUSKs@ are turned off by other extensions, so + -- asking for either of them only takes effect at the end. + | t == "ImplicitPrelude" = Last' + | t == "CUSKs" = Last' + | otherwise = case T.uncons (T.drop 2 t) of + Just (c, _) | "No" `T.isPrefixOf` t, c `elem` ['A' .. 'Z'] -> Disabling + _ -> Enabling + +-- | Does this name a whole edition of the language rather than one +-- extension of it? +namesAnEdition :: Text -> Bool +namesAnEdition t = any spelledTheSame [minBound .. maxBound] + where + spelledTheSame edition = t == T.pack (show (edition :: Language)) + +---------------------------------------------------------------------------- +-- The module + +-- | A whole module. +hsModule :: Ctx -> [HeaderPragma] -> HsModule GhcPs -> Doc +hsModule ctx pragmas HsModule {hsmodExt = XModulePs {..}, ..} = + headerLayout $ + pragmaBlock pragmas + <> hardBreak + <> moduleLine + <> hardBreak + <> foldMap (\i -> at_ ctx (importDecl ctx) i <> hardBreak) hsmodImports + <> hardBreak + <> layoutFrom ctx (spansOf hsmodDecls) (decls ctx Free hsmodDecls) + where + exports = maybe [] unLoc hsmodExports + headerSpan = foldMap spanOf hsmodDeprecMessage <> foldMap spanOf hsmodExports + + headerLayout + | any (isDocEntry . unLoc) exports = broken + | otherwise = layoutFrom ctx headerSpan + + moduleLine = case hsmodName of + Nothing -> mempty + Just modName -> + documentation + <> at ctx modName (moduleHeadName ctx) + <> breakOrSpace + <> foldMap (\w -> at ctx w warningTxt <> breakOrSpace) hsmodDeprecMessage + <> foldMap exports' hsmodExports + <> txt "where" + <> hardBreak + + documentation = foldMap (haddock ctx Pipe Closed) hsmodHaddockModHeader + + exports' l = + at ctx l (\xs -> indent (exportList ctx (spanOf l) xs)) <> breakOrSpace + +---------------------------------------------------------------------------- +-- Export lists + +-- | The parenthesised list after a module name. +exportList :: Ctx -> Maybe Span -> [LIE GhcPs] -> Doc +exportList ctx enclosing xs = + layoutHere . parens . insideBrackets enclosing $ + importExportItems ctx xs + where + layoutHere + | any (isDocEntry . unLoc) xs = broken + | otherwise = layoutFrom ctx enclosing + +-- | The items of an import or export list. +-- +-- The comma travels with the item rather than sitting between two of them, +-- because a list that has been broken ends with one: adding an entry then +-- touches one line rather than two. +importExportItems :: Ctx -> [LIE GhcPs] -> Doc +importExportItems ctx xs = variant (laidOut False) (laidOut True) + where + laidOut broken' = + sepBy breakOrSpace (zipWith (item broken') (Nothing : map Just xs) (places xs)) + item broken' previous (place, x) = + gapAbove place (unLoc <$> previous) (unLoc x) + <> align (at ctx (widenToDoc x) (ieItem ctx (spanOf x) (comma' broken' place))) + gapAbove place previous here + | place == First || place == Only = mempty + | isSection here = hardBreak + | isPipe here, maybe False runsOn previous = hardBreak + | otherwise = mempty + isSection = \case + IEGroup {} -> True + _ -> False + isPipe = \case + IEDoc {} -> True + _ -> False + -- Documentation that takes in whatever is written directly under it. + runsOn = \case + IEDoc {} -> True + IEDocNamed {} -> True + _ -> False + comma' broken' place + | broken' = True + | otherwise = place == First || place == Middle + +-- | Widen an item's span to take in the documentation printed with it, so +-- that a documented item is laid out as one thing. +widenToDoc :: LIE GhcPs -> LIE GhcPs +widenToDoc l@(L ann ie) = case itemDoc ie of + Nothing -> l + Just (L docSpan _) -> L (ann <> noAnnSrcSpan docSpan) ie + +-- | One item of an import or export list. +ieItem :: Ctx -> Maybe Span -> Bool -> IE GhcPs -> Doc +ieItem ctx here withComma = \case + IEVar warning n doc -> + exportWarning warning + <> at ctx n (wrappedName ctx) + <> comma' + <> itemDocumentation doc + IEThingAbs warning n doc -> + exportWarning warning + <> at ctx n (wrappedName ctx) + <> comma' + <> itemDocumentation doc + IEThingAll (warning, _) n doc -> + exportWarning warning + <> at ctx n (wrappedName ctx) + <> space + <> txt "(..)" + <> comma' + <> itemDocumentation doc + IEThingWith (warning, _) n wildcard members doc -> + align + ( exportWarning warning + <> at ctx n (wrappedName ctx) + <> breakOrSpace + <> indent (parens (insideBrackets here (commaSep (align <$> withWildcard)))) + <> comma' + ) + <> itemDocumentation doc + where + rendered = map (at_ ctx (wrappedName ctx)) members + withWildcard = case wildcard of + NoIEWildcard -> rendered + IEWildcard n' -> + let (before, after) = splitAt n' rendered + in before <> [txt ".."] <> after + IEModuleContents (warning, _) m -> + exportWarning warning <> at ctx m (moduleHeadName ctx) <> comma' + IEGroup NoExtField n str -> haddock ctx (Section n) Open str + IEDoc NoExtField str -> haddock ctx Pipe Open str + IEDocNamed NoExtField n -> case writtenHaddock ctx here of + Just written -> sepBy (verbatimBreak AtIndent) (map txt (NE.toList written)) + Nothing -> txt (docSectionName n) + where + comma' = includeWhen withComma comma + exportWarning = + foldMap (\w -> at ctx w warningTxt <> breakOrSpace) + itemDocumentation = + foldMap (\d -> breakOrSpace <> haddock ctx Caret Open d) + +itemDoc :: IE GhcPs -> Maybe (ExportDoc GhcPs) +itemDoc = \case + IEVar _ _ doc -> doc + IEThingAbs _ _ doc -> doc + IEThingAll _ _ doc -> doc + IEThingWith _ _ _ _ doc -> doc + _ -> Nothing + +-- | Does this export list entry carry documentation? +-- +-- A list holding one cannot go on one line: the entry would swallow the rest +-- of it, closing bracket and all. +isDocEntry :: IE GhcPs -> Bool +isDocEntry = \case + IEDoc {} -> True + IEGroup {} -> True + IEDocNamed {} -> True + _ -> False + +---------------------------------------------------------------------------- +-- Imports + +-- | One import declaration. +importDecl :: Ctx -> ImportDecl GhcPs -> Doc +importDecl ctx ImportDecl {..} = + txt "import" + <> space + <> includeWhen (ideclSource == IsBoot) (txt "{-# SOURCE #-}") + <> space + <> includeWhen ideclSafe (txt "safe") + <> space + <> levelBefore + <> space + <> includeWhen (isQualified && not qualifiedLast) (txt "qualified") + <> space + <> packageQualifier + <> space + <> indent + ( at ctx ideclName outputable + <> space + <> levelAfter + <> includeWhen (isQualified && qualifiedLast) (space <> txt "qualified") + <> foldMap (\a -> space <> txt "as" <> space <> at ctx a outputable) ideclAs + <> space + <> importList + ) + where + qualifiedLast = extensionOn ctx ImportQualifiedPost + isQualified = isImportDeclQualified ideclQualified + + packageQualifier = case ideclPkgQual of + NoRawPkgQual -> mempty + RawPkgQual literal -> outputable literal + + levelBefore = case ideclLevelSpec of + LevelStylePre l -> declLevel l + _ -> mempty + levelAfter = case ideclLevelSpec of + LevelStylePost l -> declLevel l + _ -> mempty + + importList = case ideclImportList of + Nothing -> mempty + Just (interpretation, L listLoc xs) -> + hidden + <> breakOrSpace + <> parens + ( insideBrackets + (spanOfSrcSpan (locA listLoc)) + (importExportItems ctx xs) + ) + where + hidden = case interpretation of + Exactly -> mempty + EverythingBut -> txt "hiding" + +declLevel :: ImportDeclLevel -> Doc +declLevel = \case + ImportDeclSplice -> txt "splice" + ImportDeclQuote -> txt "quote" diff --git a/src/Tilia/Render/Layout.hs b/src/Tilia/Render/Layout.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Layout.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Runs of things: statements, bindings, equations, list elements. +module Tilia.Render.Layout + ( -- * Blocks + Bracing (..), + items, + itemsSepBy, + + -- * Blank lines + keepBlanks, + + -- * Positions in a run + Place (..), + places, + ) +where + +import Tilia.Doc.Combinators +import Tilia.Span + +---------------------------------------------------------------------------- +-- Blocks + +-- | May a block put braces around itself when it is laid out on one line? +-- +-- It may not when something outside it is already doing so: nested braces +-- would be correct but unreadable, and more to the point the outer block +-- has already made the items unambiguous. +data Bracing + = MayBrace + | NoBrace + deriving (Eq, Show) + +-- | A block: one item per line when broken, semicolons when flat. +items :: Bracing -> [Doc] -> Doc +items = itemsSepBy False + +-- | 'items', with control over whether the broken form carries semicolons +-- too. +-- +-- It has to when the block is standing in for something that would +-- otherwise be read as continuing: an or-pattern inside an as-pattern, for +-- instance, where a bare line break would let the next alternative be taken +-- for a new argument. +itemsSepBy :: + -- | Semicolons in the broken layout as well? + Bool -> + Bracing -> + [Doc] -> + Doc +itemsSepBy semisWhenBroken bracing xs = variant flatForm brokenForm + where + flatForm = case (bracing, xs) of + (MayBrace, []) -> txt "{}" + (NoBrace, []) -> mempty + (MayBrace, _) -> txt "{" <> space <> joined <> space <> txt "}" + (NoBrace, _) -> joined + joined = sepBy (semi <> space) xs + brokenForm = + sepBy (includeWhen semisWhenBroken semi <> hardBreak) xs + +---------------------------------------------------------------------------- +-- Blank lines + +-- | Put back the empty lines the author left between items. +keepBlanks :: + -- | Was there an empty line between two items? + (Maybe Span -> Maybe Span -> Bool) -> + -- | Where each item was, and what it prints as + [(Maybe Span, Doc)] -> + [Doc] +keepBlanks blank xs = zipWith gap (Nothing : map fst xs) xs + where + gap previous (here, d) = includeWhen (blank previous here) hardBreak <> d + +---------------------------------------------------------------------------- +-- Positions in a run + +-- | Where an item sits among its siblings. +data Place + = Only + | First + | Middle + | Last + deriving (Eq, Show) + +-- | Label each item of a list with its position. +places :: [a] -> [(Place, a)] +places [] = [] +places [x] = [(Only, x)] +places (x : xs) = (First, x) : go xs + where + go [] = [] + go [y] = [(Last, y)] + go (y : ys) = (Middle, y) : go ys diff --git a/src/Tilia/Render/Literal.hs b/src/Tilia/Render/Literal.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Literal.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +-- | String literals. +module Tilia.Render.Literal + ( stringLiteral, + ) +where + +import Control.Applicative ((<|>)) +import Control.Monad ((>=>)) +import Data.List (find) +import Data.Semigroup (Min (..)) +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Data.FastString (FastString, unpackFS) +import GHC.Parser.CharClass (is_space) +import Tilia.Doc.Combinators +import Tilia.Render.Layout (Place (..), places) + +-- | A string literal, from the text the author wrote. +stringLiteral :: FastString -> Doc +stringLiteral src = case takeApart (T.pack (unpackFS src)) of + Nothing -> error ("Tilia: unparsable string literal: " <> show src) + Just literal -> align (renderLiteral literal) + +renderLiteral :: Literal -> Doc +renderLiteral literal = + txt (litOpen literal) <> body <> txt (litClose literal) + where + body = case litKind literal of + Regular -> variant onOneLine acrossLines + Multiline -> sepBy (verbatimBreak AtIndent) (map txt (litParts literal)) + onOneLine = txt (joinParts (litParts literal)) + acrossLines = + sepBy breakOrSpace (map continued (places (litParts literal))) + continued (place, s) = case place of + Only -> txt s + First -> txt s <> txt "\\" + Middle -> txt "\\" <> txt s <> txt "\\" + Last -> txt "\\" <> txt s + +---------------------------------------------------------------------------- +-- Taking a literal apart + +-- | A literal split into the bits that may be laid out separately. +data Literal = Literal + { litOpen :: Text, + litClose :: Text, + litKind :: LiteralKind, + -- | For a regular literal, the runs between string gaps; for a + -- multi-line one, the lines. + litParts :: [Text] + } + deriving (Eq, Show) + +data LiteralKind + = Regular + | Multiline + deriving (Eq, Show) + +takeApart :: Text -> Maybe Literal +takeApart s = do + literal <- + stripMarkers Multiline "\"\"\"" s + <|> stripMarkers Regular "\"" s + let split = case litKind literal of + Regular -> runsBetweenGaps + Multiline -> splitMultiline + pure literal {litParts = concatMap split (litParts literal)} + +-- | Peel the quotes off, allowing for the @#@ that marks an unlifted +-- literal. +stripMarkers :: LiteralKind -> Text -> Text -> Maybe Literal +stripMarkers litKind marker s = do + inner <- T.stripPrefix marker s + litClose <- find (`T.isSuffixOf` inner) [marker <> "#", marker] + body <- T.stripSuffix litClose inner + pure Literal {litOpen = marker, litParts = [body], ..} + +-- | The runs of a literal either side of its string gaps. +runsBetweenGaps :: Text -> [Text] +runsBetweenGaps s = case gapAt 0 s of + Nothing -> [s] + Just (before, after) -> T.take before s : runsBetweenGaps after + where + -- How much comes before the first gap, and what comes after it. + gapAt n t = case T.uncons t of + Nothing -> Nothing + Just ('\\', rest) -> case afterGap rest of + Just resumes -> Just (n, resumes) + Nothing -> let taken = 1 + escapedWidth rest in gapAt (n + taken) (T.drop taken t) + Just (_, rest) -> gapAt (n + 1) rest + + -- Where the literal picks up again, if this backslash opened a gap. + afterGap t = case T.span is_space t of + (blank, rest) + | not (T.null blank), Just ('\\', resumes) <- T.uncons rest -> Just resumes + _ -> Nothing + + -- How much follows the backslash of an escape that is not a gap. Only + -- @\\^X@ reaches past the character after the backslash; the numeric + -- escapes run on further, but their digits are not backslashes and do + -- not need skipping. + escapedWidth t = case T.uncons t of + Just ('^', _) -> 2 + Just _ -> 1 + Nothing -> 0 + +-- | Split a multi-line literal the way GHC's lexer reads one, so that what +-- comes back out means what went in. +splitMultiline :: Text -> [Text] +splitMultiline = + dropCommonIndent + . map expandTabs + . splitLines + . joinParts + . runsBetweenGaps + +-- | The line terminators the Report recognises, not merely @\\n@. +splitLines :: Text -> [Text] +splitLines = T.splitOn "\r\n" >=> T.split newlineish + where + newlineish c = c == '\n' || c == '\r' || c == '\f' + +-- | Tabs advance to the next multiple of eight. +expandTabs :: Text -> Text +expandTabs = T.concat . go 0 + where + go column s = case T.breakOn "\t" s of + (before, T.uncons -> Just (_, after)) -> + let reached = column + T.length before + fill = 8 - (reached `mod` 8) + in before : T.replicate fill " " : go (reached + fill) after + _ -> [s] + +-- | Take the common indentation off every line but the first, and blank the +-- lines that were nothing but whitespace. +dropCommonIndent :: [Text] -> [Text] +dropCommonIndent = \case + [] -> [] + firstLine : rest -> firstLine : trimmed + where + (indents, trimmed) = unzip (map measure rest) + common = maybe 0 getMin (mconcat indents) + measure l + | T.all is_space l = (Nothing, "") + | otherwise = (Just (Min (T.length (T.takeWhile is_space l))), T.drop common l) + +-- | Rejoin runs with the smallest gap that keeps them apart. +-- +-- The gap cannot simply be dropped: it is what stops the end of one run and +-- the start of the next from lexing as a single escape sequence, so +-- @\"\\65\\ \\0\"@ and @\"\\650\"@ are different strings. +joinParts :: [Text] -> Text +joinParts = T.intercalate "\\ \\" diff --git a/src/Tilia/Render/Name.hs b/src/Tilia/Render/Name.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Name.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} + +-- | Names, and the decorations the author put around them. +module Tilia.Render.Name + ( -- * Rendering anything GHC can show + outputable, + showGhc, + sourceText, + + -- * Names + name, + moduleHeadName, + wrappedName, + namespaceSpec, + multiplicity, + + -- * Definition heads + defHead, + ) +where + +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Hs +import GHC.LanguageExtensions.Type (Extension (..)) +import GHC.Types.Name.Occurrence (OccName, occNameString) +import GHC.Types.Name.Reader +import GHC.Types.SourceText +import GHC.Types.SrcLoc (getLoc) +import GHC.Utils.Outputable (Outputable, ppr, showSDocUnsafe) +import Tilia.Doc.Combinators +import Tilia.Render.Context +import Tilia.Span +import Tilia.Span.Ghc + +-- | Anything GHC knows how to show. +-- +-- For the leaves that have no structure worth walking—numeric literals, +-- occurrence names, calling conventions. Never for anything that might need +-- a line break inside it, since the result is emitted as one fragment. +outputable :: (Outputable a) => a -> Doc +outputable = txt . showGhc + +-- | The text GHC would show for something. +showGhc :: (Outputable a) => a -> Text +showGhc = T.pack . showSDocUnsafe . ppr + +-- | The text the author wrote, when GHC kept it. +sourceText :: SourceText -> Doc +sourceText = \case + NoSourceText -> mempty + SourceText s -> outputable s + +---------------------------------------------------------------------------- +-- Names + +-- | A name, with whatever the author wrapped it in. +name :: Ctx -> LocatedN RdrName -> Doc +name ctx l = at ctx l $ \x -> adorn ctx (spanOf l) x (getLoc l) (bareName x) + +-- | The name itself, with nothing around it. +bareName :: RdrName -> Doc +bareName = \case + Unqual occName -> outputable occName + Qual mname occName -> qualifiedName mname occName + Orig _ occName -> outputable occName + Exact n -> outputable n + +-- | Put back whatever brackets, backticks or ticks the author used. +adorn :: Ctx -> Maybe Span -> RdrName -> EpAnn NameAnn -> Doc -> Doc +adorn ctx here x = go + where + go EpAnn {anns} = case anns of + -- A promotion tick, with whatever the name carries under it. + NameAnnQuote {nann_quoted} -> (txt "'" <>) . go nann_quoted + -- The empty unboxed sum and the empty list are written out whole: + -- there is no name under the brackets to print. + NameAnnOnly {nann_adornment = NameParensHash {}} -> const (txt "(# #)") + NameAnnOnly {nann_adornment = NameSquare {}} -> + const (txt "[" <> insideBrackets here mempty <> txt "]") + -- @->@ is the one name that is a keyword as well, and the parentheses + -- are recorded on their own rather than as an adornment. + NameAnnRArrow {nann_mopen = Just _} -> inParens + -- The name inside the brackets is claimed separately from the + -- brackets themselves, so that a comment written against it—@( {- + -- here -} :+: )@—is put where it was written rather than after the + -- closing bracket. + NameAnn {nann_adornment, nann_name} -> case nann_adornment of + NameParens {} -> inParens . spaceOutHash . itsOwn nann_name + NameBackquotes {} -> backticks . itsOwn nann_name + _ -> itsOwn nann_name + _ -> id + + itsOwn = atSpan ctx . annSpan + + inParens d = txt "(" <> d <> txt ")" + + -- With UnboxedSums on, @(#@ lexes as one token, so an operator starting + -- with @#@ cannot sit against its opening bracket. + spaceOutHash d + | extensionOn ctx UnboxedSums, + -- A qualified name never begins with a @#@. + Unqual (occNameString -> '#' : _) <- x = + space <> d <> space + | otherwise = d + +-- | A name written with its module. +qualifiedName :: ModuleName -> OccName -> Doc +qualifiedName mname occName = outputable mname <> txt "." <> outputable occName + +-- | The name in a module header, with the keyword that introduces it. +moduleHeadName :: Ctx -> ModuleName -> Doc +moduleHeadName ctx mname = + txt keyword <> space <> outputable mname + where + keyword = case ctxSourceType ctx of + ModuleSource -> "module" + SignatureSource -> "signature" + +-- | A name as it appears in an import or export list. +wrappedName :: Ctx -> IEWrappedName GhcPs -> Doc +wrappedName ctx = \case + IEName _ x -> name ctx x + IEDefault _ x -> keyed "default" x + IEPattern _ x -> keyed "pattern" x + IEType _ x -> keyed "type" x + IEData _ x -> keyed "data" x + where + keyed kw x = txt kw <> space <> name ctx x + +-- | The @type@ or @data@ that disambiguates which namespace is meant. +namespaceSpec :: NamespaceSpecifier -> Doc +namespaceSpec = \case + NoNamespaceSpecifier -> mempty + TypeNamespaceSpecifier _ -> txt "type" <> space + DataNamespaceSpecifier _ -> txt "data" <> space + +-- | A multiplicity annotation on an arrow or a field. +multiplicity :: (mult -> Doc) -> HsMultAnnOf mult GhcPs -> Doc +multiplicity render = \case + HsUnannotated _ -> mempty + HsLinearAnn _ -> txt "%1" + HsExplicitMult _ mult -> txt "%" <> render mult + +---------------------------------------------------------------------------- +-- Definition heads + +-- | The left-hand side of a definition: a name and the things it is applied +-- to. +-- +-- Written infix, the first two arguments straddle the name and any further +-- ones force the whole of that into parentheses, which is the only way the +-- source could have been written. Written prefix, the arguments simply +-- follow. The indentation flag is for the callers whose body is going to be +-- indented anyway, so that the arguments do not end up two steps in. +defHead :: + -- | Written infix? + Bool -> + -- | Indent the arguments? + Bool -> + -- | The name + Doc -> + -- | The arguments + [Doc] -> + Doc +defHead True indentArgs nameDoc (a0 : a1 : rest) = + wrap (a0 <> breakOrSpace <> indent (align (nameDoc <> space <> a1))) + <> includeUnless (null rest) (nest (steps indentArgs) (breakOrSpace <> spread rest)) + where + wrap = if null rest then id else parens +defHead _ indentArgs nameDoc args = + nameDoc + <> includeUnless (null args) (nest (steps indentArgs) (breakOrSpace <> spread args)) + +-- | Arguments, each aligned under itself, one per line when broken. +spread :: [Doc] -> Doc +spread = align . sepBy breakOrSpace . map align + +steps :: Bool -> Int +steps b = if b then 1 else 0 diff --git a/src/Tilia/Render/Operator.hs b/src/Tilia/Render/Operator.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Operator.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE LambdaCase #-} + +-- | Regrouping a chain of infix operators by precedence. +module Tilia.Render.Operator + ( -- * Chains + OpChain (..), + flatten, + flattenAround, + associate, + + -- * Asking about a chain + chainSpan, + lastOperand, + isSeparator, + ) +where + +import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NE +import Data.Maybe (isNothing, mapMaybe) +import Tilia.Fixity (Direction (..), Fixity (..)) +import Tilia.Span + +-- | A chain of operator applications. +-- +-- A branch holds @n + 1@ operands and @n@ operators, all of which bind +-- equally tightly. This is the shape layout wants: the operators of one +-- level are siblings, so the printer can decide once how that level breaks +-- rather than rediscovering it at every binary node. +data OpChain a op + = Operand a + | Chain (NonEmpty (OpChain a op)) [op] + deriving (Eq, Show) + +-- | Take a binary application tree apart into one flat run. +-- +-- The decomposition function returns the two operands and the operator of a +-- node that is an application of an infix operator, and nothing for a node +-- that is a leaf. +flatten :: + -- | Take one node apart, if it comes apart + (a -> Maybe (a, op, a)) -> + a -> + (NonEmpty a, [op]) +flatten split = go + where + go x = case split x of + Nothing -> (x :| [], []) + Just (l, op, r) -> + let (ls, lops) = go l + (rs, rops) = go r + in (ls <> rs, lops <> [op] <> rops) + +-- | 'flatten' for a node the caller has already taken apart. +-- +-- The printers match on the operator application in order to reach its +-- parts, so by the time a chain is being built the outermost node has +-- already been destructured and there is nothing left to hand to 'flatten'. +flattenAround :: + (a -> Maybe (a, op, a)) -> + a -> + op -> + a -> + (NonEmpty a, [op]) +flattenAround split l op r = + let (ls, lops) = flatten split l + (rs, rops) = flatten split r + in (ls <> rs, lops <> (op : rops)) + +-- | Regroup a flat run by precedence. +-- +-- The loosest-binding operators of the run become the operators of the top +-- branch, and everything between two of them becomes a subtree, regrouped +-- the same way. When any operator in the run has no known precedence the run +-- is left as one flat branch: nothing is asserted about how it associates, +-- so nothing is rearranged. +associate :: + -- | The fixity of an operator, if it was established + (op -> Maybe Fixity) -> + NonEmpty a -> + [op] -> + OpChain a op +associate fixityOf = build + where + build (x :| []) _ = Operand x + build operands ops + | any (isNothing . precedenceOf) ops = flatBranch operands ops + | otherwise = + case splitOn ((== Just loosest) . precedenceOf) operands ops of + (groups, splitters) -> Chain (fmap (uncurry build) groups) splitters + where + loosest = minimum (mapMaybe precedenceOf ops) + + flatBranch operands ops = Chain (Operand <$> operands) ops + precedenceOf = fmap fixityPrecedence . fixityOf + +-- | Cut a run wherever the operator satisfies the predicate. +splitOn :: + (op -> Bool) -> + NonEmpty a -> + [op] -> + (NonEmpty (NonEmpty a, [op]), [op]) +splitOn cuts (x0 :| xs) ops = go (x0 :| []) [] (zip ops xs) + where + go current currentOps [] = ((NE.reverse current, reverse currentOps) :| [], []) + go current currentOps ((op, y) : rest) + | cuts op = + let (groups, splitters) = go (y :| []) [] rest + in (NE.cons (NE.reverse current, reverse currentOps) groups, op : splitters) + | otherwise = go (NE.cons y current) (op : currentOps) rest + +---------------------------------------------------------------------------- +-- Asking about a chain + +-- | The region of the input a chain came from. +chainSpan :: (a -> Maybe Span) -> OpChain a op -> Maybe Span +chainSpan spanOfOperand = \case + Operand x -> spanOfOperand x + Chain xs _ -> foldr1 join' (chainSpan spanOfOperand <$> xs) + where + join' (Just a) (Just b) = Just (a <> b) + join' a b = maybe b Just a + +-- | The rightmost operand of a chain. +lastOperand :: OpChain a op -> a +lastOperand = \case + Operand x -> x + Chain xs _ -> lastOperand (NE.last xs) + +-- | Is this operator one of the ones that exist to separate rather than to +-- combine? +isSeparator :: Maybe Fixity -> Bool +isSeparator = \case + Just (Fixity RightAssoc 0) -> True + _ -> False diff --git a/src/Tilia/Render/Pattern.hs b/src/Tilia/Render/Pattern.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Pattern.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +-- | Patterns. +module Tilia.Render.Pattern + ( hsPat, + fieldOcc, + unboxedSum, + ) +where + +import Data.List.NonEmpty qualified as NE +import Data.Maybe (isJust) +import GHC.Hs +import GHC.LanguageExtensions.Type (Extension (..)) +import GHC.Types.Basic (Arity, Boxity (..), ConTag) +import GHC.Types.Name.Reader (RdrName) +import GHC.Types.SrcLoc (GenLocated (..)) +import Tilia.Doc.Combinators +import Tilia.Render.Context +import Tilia.Render.Layout +import Tilia.Render.Name +import Tilia.Render.Type +import Tilia.Span +import Tilia.Span.Ghc + +-- | A pattern. +hsPat :: Ctx -> LPat GhcPs -> Doc +hsPat ctx = hsPatIn ctx NoBrace False + +-- | A pattern that knows where it stands. +-- +-- Two things about the surroundings reach into a pattern. The first is +-- whether an alternative of an or-pattern may be brace-delimited, which is +-- the same question every block faces. The second is whether we are inside +-- an @as@-pattern, where an or-pattern's alternatives must keep their +-- semicolons even when they go on separate lines, since a bare line break +-- would let the next alternative be read as a new argument. +hsPatIn :: Ctx -> Bracing -> Bool -> LPat GhcPs -> Doc +hsPatIn ctx bracing inAsPat l = at ctx l (patBody ctx bracing inAsPat (spanOf l)) + +patBody :: Ctx -> Bracing -> Bool -> Maybe Span -> Pat GhcPs -> Doc +patBody ctx bracing inAsPat here = \case + WildPat _ -> txt "_" + VarPat _ n -> name ctx n + LazyPat _ p -> txt "~" <> recur p + AsPat _ n p -> name ctx n <> txt "@" <> hsPatIn ctx bracing True p + -- A pattern is nearly always an item of a layout block—an alternative of a + -- @case@, the left of a @<-@ in a @do@ block—so its brackets close one + -- step in. Where it is not, the extra step costs nothing. + ParPat _ p -> parensWith Indented (insideBrackets here (recur p)) + BangPat _ p -> txt "!" <> recur p + ListPat _ ps -> bracketsWith Indented (insideBrackets here (commaSep (map recur ps))) + TuplePat _ ps boxity -> + tupleBrackets boxity (insideBrackets here (commaSep (map (align . recur) ps))) + OrPat _ ps -> + itemsSepBy inAsPat bracing (map recur (NE.toList ps)) + SumPat _ p tag arity -> unboxedSum Indented tag arity (recur p) + ConPat _ con details -> conPattern ctx bracing inAsPat here con details + ViewPat _ e p -> + align $ + knotExpr (ctxKnot ctx) ctx plainSite e + <> joinedBy "->" + <> indent (recur p) + SplicePat _ splice -> knotSplice (ctxKnot ctx) ctx DollarSplice splice + LitPat _ lit -> outputable lit + NPat _ v (isJust -> negated) _ -> + includeWhen negated (txt "-" <> negativeGap ctx) + <> at ctx v (outputable . ol_val) + NPlusKPat _ n k _ _ _ -> + align $ + name ctx n + <> breakOrSpace + <> indent (txt "+" <> space <> at ctx k (outputable . ol_val)) + SigPat _ p HsPS {..} -> + recur p <> typeAscription ctx (asSigType hsps_body) + EmbTyPat _ (HsTP _ ty) -> txt "type" <> space <> hsType ctx ty + InvisPat _ (HsTP _ ty) -> txt "@" <> hsType ctx ty + where + recur = hsPatIn ctx bracing inAsPat + +-- | A constructor pattern, in whichever of its three forms. +conPattern :: + Ctx -> + Bracing -> + Bool -> + Maybe Span -> + LocatedN RdrName -> + HsConPatDetails GhcPs -> + Doc +conPattern ctx bracing inAsPat here con = \case + PrefixCon args -> + align $ + name ctx con + <> includeUnless (null args) breakOrSpace + <> indent (align (sepBy breakOrSpace (map (align . recur) args))) + RecCon (HsRecFields _ fields dotdot) -> + name ctx con + <> breakOrSpace + <> indent (braces (insideBrackets here (commaSep (map field (visibleFields dotdot fields))))) + InfixCon l r -> + layoutFrom ctx (spanOf l <> spanOf r) $ + recur l + <> breakOrSpace + <> indent (name ctx con <> space <> recur r) + where + recur = hsPatIn ctx bracing inAsPat + field = either wildcard (at_ ctx (patFieldBind ctx)) + -- The @..@ has a location of its own, and needs it: a comment written + -- against it has nothing else to attach to. + wildcard l = at ctx l (const (txt "..")) + -- A @..@ stands for the fields that were not written out, so it goes + -- after the ones that were. + visibleFields dotdot fields = case dotdot of + Nothing -> Right <$> fields + Just l@(L _ (RecFieldsDotDot n)) -> + (Right <$> take n fields) <> [Left l] + +patFieldBind :: Ctx -> HsRecField GhcPs (LPat GhcPs) -> Doc +patFieldBind ctx HsFieldBind {..} = + at ctx hfbLHS (fieldOcc ctx) + <> includeUnless + hfbPun + (joinedBy "=" <> indent (hsPat ctx hfbRHS)) + +-- | The name of a record field. +fieldOcc :: Ctx -> FieldOcc GhcPs -> Doc +fieldOcc ctx FieldOcc {..} = name ctx foLabel + +---------------------------------------------------------------------------- +-- Shapes shared with expressions + +-- | An unboxed sum: the one alternative that is present, with a bar for each +-- one that is not. +unboxedSum :: ClosingIndent -> ConTag -> Arity -> Doc -> Doc +unboxedSum closing tag arity d = + unboxedWith closing (sepBy (txt "|") (before <> [space <> d <> space] <> after)) + where + before = replicate (tag - 1) space + after = replicate (arity - tag) space + +tupleBrackets :: Boxity -> Doc -> Doc +tupleBrackets = \case + Boxed -> parensWith Indented + Unboxed -> unboxedWith Indented + +-- | With @NegativeLiterals@ on, @- 1@ and @-1@ are different expressions, so +-- the minus of a negated literal has to keep its distance. +negativeGap :: Ctx -> Doc +negativeGap ctx = includeWhen (extensionOn ctx NegativeLiterals) space diff --git a/src/Tilia/Render/Pragma.hs b/src/Tilia/Render/Pragma.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Pragma.hs @@ -0,0 +1,154 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +-- | The @{-# … #-}@ annotations that appear among declarations. +-- +-- These look like comments and are not: the compiler reads them, so their +-- content is not ours to reflow and their placement is not ours to change. +-- What is ours is where the braces break, which is all this module decides. +-- +-- The @LANGUAGE@ and @OPTIONS_GHC@ pragmas of the file header are not here. +-- They are part of the header rather than of any declaration, they are +-- sorted rather than left where they were, and they are handled in +-- "Tilia.Render.Header". +module Tilia.Render.Pragma + ( -- * Braces + pragmaBrackets, + pragma, + + -- * Inlining and rules + activation, + inlineSpec, + + -- * Instances + overlapMode, + + -- * Warnings + warnDecls, + warningTxt, + ) +where + +import Data.Text (Text) +import GHC.Hs +import GHC.Types.Basic hiding (overlapMode) +import GHC.Types.SourceText +import GHC.Types.SrcLoc (GenLocated (..), unLoc) +import GHC.Unit.Module.Warnings +import Tilia.Doc.Combinators +import Tilia.Render.Context +import Tilia.Render.Name + +---------------------------------------------------------------------------- +-- Braces + +-- | Wrap a body in pragma braces. +-- +-- The closing brace is indented when the pragma breaks, which keeps it from +-- being mistaken for the start of a new declaration. +pragmaBrackets :: Doc -> Doc +pragmaBrackets body = + align (txt "{-#" <> space <> body <> breakOrSpace <> indent (txt "#-}")) + +-- | A named pragma with a body. +pragma :: Text -> Doc -> Doc +pragma pragmaName body = + pragmaBrackets (txt pragmaName <> breakOrSpace <> body) + +---------------------------------------------------------------------------- +-- Inlining and rules + +-- | The phase control of an @INLINE@ or @RULES@ pragma. +activation :: Activation -> Doc +activation = \case + NeverActive -> txt "[~]" + AlwaysActive -> mempty + ActiveBefore _ n -> txt "[~" <> outputable n <> txt "]" + ActiveAfter _ n -> txt "[" <> outputable n <> txt "]" + FinalActive -> error "Tilia: FinalActive is not expected in parsed source" + +-- | Which flavour of inlining was asked for. +inlineSpec :: InlineSpec -> Doc +inlineSpec = \case + Inline _ -> txt "INLINE" + Inlinable _ -> txt "INLINEABLE" + NoInline _ -> txt "NOINLINE" + Opaque _ -> txt "OPAQUE" + NoUserInlinePrag -> mempty + +---------------------------------------------------------------------------- +-- Instances + +-- | The overlap pragma of an instance, and the separator after it. +overlapMode :: Maybe (LocatedP OverlapMode) -> Maybe Doc +overlapMode mode = txt . braced <$> (spelled . unLoc =<< mode) + where + -- Written out whole rather than built with 'pragmaBrackets': an overlap + -- mode is one word and must never be broken across lines. + braced keyword = "{-# " <> keyword <> " #-}" + + spelled = \case + Overlappable {} -> Just "OVERLAPPABLE" + Overlapping {} -> Just "OVERLAPPING" + Overlaps {} -> Just "OVERLAPS" + Incoherent {} -> Just "INCOHERENT" + -- The rest are what an instance means when it says nothing about + -- overlapping, so nothing is what they are written as. + _ -> Nothing + +---------------------------------------------------------------------------- +-- Warnings + +-- | A @WARNING@ or @DEPRECATED@ declaration. +warnDecls :: Ctx -> WarnDecls GhcPs -> Doc +warnDecls ctx (Warnings _ warnings) = case warnings of + [] -> mempty + (L _ (Warning _ _ wtxt) : _) -> + layoutAcross ctx warnings + . pragma (keywordOf wtxt) + . indent + $ sepBy (txt ";" <> breakOrSpace) (map (at_ ctx (warned ctx)) warnings) + where + keywordOf wtxt = let (keyword, _, _) = warningParts wtxt in keyword + +-- | One of the things a warning declaration names. +warned :: Ctx -> WarnDecl GhcPs -> Doc +warned ctx (Warning (namespace, _) names wtxt) = + category + <> namespaceSpec namespace + <> commaSep (map (name ctx) names) + <> breakOrSpace + <> literalList literals + where + (_, category, literals) = warningParts wtxt + +-- | A warning attached to a name in an export list or to an instance. +warningTxt :: WarningTxt GhcPs -> Doc +warningTxt wtxt = + indent (pragma keyword (indent (category <> literalList literals))) + where + (keyword, category, literals) = warningParts wtxt + +-- | Which keyword introduces a warning, which category it is filed under, +-- and what it says. +-- +-- The keyword is written once for a whole declaration even when it names +-- several things, whereas the category belongs to each of them separately. +-- That is why the two do not come back as one piece of text. +warningParts :: WarningTxt GhcPs -> (Text, Doc, [LocatedE StringLiteral]) +warningParts = \case + DeprecatedTxt _ literals -> ("DEPRECATED", mempty, said literals) + WarningTxt category _ literals -> + ("WARNING", foldMap named category, said literals) + where + said = map (fmap hsDocString) + named (unLoc -> InWarningCategory {..}) = + txt ("in \"" <> showGhc (unLoc iwc_wc) <> "\"") <> space + +-- | One message is written bare; several go in a list. +literalList :: [LocatedE StringLiteral] -> Doc +literalList = \case + [l] -> outputable l + ls -> brackets (commaSep (map outputable ls)) diff --git a/src/Tilia/Render/Signature.hs b/src/Tilia/Render/Signature.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Signature.hs @@ -0,0 +1,280 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | Signatures, and the pragmas that are written like them. +module Tilia.Render.Signature + ( sigDecl, + standaloneKindSig, + ruleDecls, + specialisedName, + ) +where + +import Data.Maybe (maybeToList) +import GHC.Data.BooleanFormula +import GHC.Hs +import GHC.Types.Basic + ( Activation (..), + InlinePragma (..), + InlineSpec (..), + RuleMatchInfo (..), + RuleName, + ) +import GHC.Types.Fixity (Fixity (..), FixityDirection (..)) +import GHC.Types.Name.Reader (RdrName) +import GHC.Types.SourceText +import GHC.Types.SrcLoc (GenLocated (..), unLoc) +import Tilia.Doc.Combinators +import Tilia.Render.Context +import Tilia.Render.Expression (hsExpr) +import Tilia.Render.Name +import Tilia.Render.Pragma +import Tilia.Render.Type +import Tilia.Span (startOf) +import Tilia.Span.Ghc (tokenSpan) + +-- | A signature declaration. +sigDecl :: Ctx -> Sig GhcPs -> Doc +sigDecl ctx = \case + TypeSig _ names hswc -> typeSig ctx True names (hswc_body hswc) + PatSynSig _ names sigType -> patSynSig ctx names sigType + ClassOpSig _ isDefault names sigType -> + includeWhen isDefault (txt "default" <> space) <> typeSig ctx True names sigType + FixSig _ sig -> fixitySig ctx sig + InlineSig _ n prag -> inlineSig ctx n prag + SpecSig _ n types prag -> + specialiseSig ctx Nothing (noLocA (HsVar NoExtField n)) types prag + SpecSigE _ binders e prag -> specialiseSigE ctx binders e prag + SpecInstSig _ sigType -> + pragma "SPECIALIZE instance" (indent (hsSigType ctx sigType)) + MinimalSig _ formula -> + at ctx formula (pragma "MINIMAL" . indent . booleanFormula ctx) + CompleteMatchSig _ names ty -> completeSig ctx names ty + SCCFunSig _ n literal -> sccSig ctx n literal + +-- | @f, g :: t@. +-- +-- Only the first name sits on the line the signature starts on; the rest +-- are indented under it, unless the caller says not to, which is what a +-- pattern synonym signature wants so that its names line up after +-- @pattern@. +typeSig :: + Ctx -> + -- | Indent the names after the first? + Bool -> + [LocatedN RdrName] -> + LHsSigType GhcPs -> + Doc +typeSig _ _ [] _ = mempty +typeSig ctx indentTail (n : ns) sigType + | null ns = name ctx n <> typeAscription ctx sigType + | otherwise = + name ctx n + <> nest + (if indentTail then 1 else 0) + ( comma + <> breakOrSpace + <> commaSep (map (name ctx) ns) + <> typeAscription ctx sigType + ) + +patSynSig :: Ctx -> [LocatedN RdrName] -> LHsSigType GhcPs -> Doc +patSynSig ctx names sigType + | length names > 1 = txt "pattern" <> breakOrSpace <> indent body + | otherwise = txt "pattern" <> space <> body + where + body = typeSig ctx False names sigType + +fixitySig :: Ctx -> FixitySig GhcPs -> Doc +fixitySig ctx (FixitySig namespace names (Fixity precedence direction)) = + txt keyword + <> space + <> outputable precedence + <> space + <> namespaceSpec namespace + <> align (commaSep (map (name ctx) names)) + where + keyword = case direction of + InfixL -> "infixl" + InfixR -> "infixr" + InfixN -> "infix" + +inlineSig :: Ctx -> LocatedN RdrName -> InlinePragma -> Doc +inlineSig ctx n InlinePragma {..} = + pragmaBrackets $ + inlineSpec inl_inline + <> space + <> conLike + <> space + <> includeUnless (inl_act == NeverActive) (activation inl_act) + <> space + <> name ctx n + where + conLike = case inl_rule of + ConLike -> txt "CONLIKE" + FunLike -> mempty + +-- | A @SPECIALIZE@ pragma. +specialiseSig :: + Ctx -> + Maybe (RuleBndrs GhcPs) -> + LHsExpr GhcPs -> + [LHsSigType GhcPs] -> + InlinePragma -> + Doc +specialiseSig ctx binders target types InlinePragma {..} = + pragmaBrackets $ + txt "SPECIALIZE" + <> space + <> inlineSpec inl_inline + <> space + <> phase + <> indent + ( space + <> foldMap (\bs -> ruleBinders ctx bs <> space) binders + <> hsExpr ctx target + <> includeUnless + (null types) + (joinedBy "::" <> commaSep (map (hsSigType ctx) types)) + ) + where + -- A pragma that says neither when to inline nor whether to is saying + -- nothing, so the phase is left off rather than printed as @[~]@. + phase = case (inl_inline, inl_act) of + (NoInline _, NeverActive) -> mempty + _ -> activation inl_act + +specialiseSigE :: + Ctx -> + RuleBndrs GhcPs -> + LHsExpr GhcPs -> + InlinePragma -> + Doc +specialiseSigE ctx binders e = + specialiseSig ctx (Just binders) target (maybeToList sigTy) + where + (_, target, sigTy) = takeApartSpecExpr e + +-- | Pull a @SPECIALIZE@ expression apart into the name, the application and +-- the signature. +-- +-- The expression in this position can only be a variable applied to +-- arguments, optionally with a type ascription, so the name is always +-- reachable by walking down the left spine. +takeApartSpecExpr :: + LHsExpr GhcPs -> + (LocatedN RdrName, LHsExpr GhcPs, Maybe (LHsSigType GhcPs)) +takeApartSpecExpr expr = (specHead applied, applied, signature) + where + (applied, signature) = specBody expr + +-- | A @SPECIALIZE@ expression without the type ascription it may carry. +-- +-- Everything else here works on the expression under the ascription: that +-- is what the pragma is about, and the ascription is printed separately. +specBody :: LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe (LHsSigType GhcPs)) +specBody = \case + L _ (ExprWithTySig _ e HsWC {hswc_body}) -> (e, Just hswc_body) + e -> (e, Nothing) + +-- | The function a @SPECIALIZE@ expression applies. +-- +-- Whatever else the expression does, it is an application, and the pragma +-- names whatever sits at the head of it. +specHead :: LHsExpr GhcPs -> LocatedN RdrName +specHead (L _ e) = case e of + HsVar _ n -> n + HsApp _ f _ -> specHead f + HsAppType _ f _ -> specHead f + _ -> error "Tilia: a SPECIALIZE expression always has a head variable" + +-- | The name a @SPECIALIZE@ pragma is about, for grouping declarations. +specialisedName :: Sig GhcPs -> Maybe RdrName +specialisedName = \case + SpecSig _ (L _ n) _ _ -> Just n + SpecSigE _ _ e _ -> Just (unLoc (specHead (fst (specBody e)))) + _ -> Nothing + +booleanFormula :: Ctx -> BooleanFormula GhcPs -> Doc +booleanFormula ctx = \case + Var n -> name ctx n + And xs -> align (commaSep (map (at_ ctx (booleanFormula ctx)) xs)) + Or xs -> + align (sepBy (breakOrSpace <> txt "|" <> space) (map (at_ ctx (booleanFormula ctx)) xs)) + Parens l -> at ctx l (parens . booleanFormula ctx) + +completeSig :: Ctx -> [LIdP GhcPs] -> Maybe (LocatedN RdrName) -> Doc +completeSig ctx names ty = + layoutAcross ctx names . pragma "COMPLETE" . indent $ + commaSep (map (name ctx) names) + <> foldMap + (\t -> joinedBy "::" <> indent (name ctx t)) + ty + +sccSig :: Ctx -> LocatedN RdrName -> Maybe (XRec GhcPs StringLiteral) -> Doc +sccSig ctx n literal = + pragma "SCC" . indent $ + name ctx n <> foldMap (\l -> breakOrSpace <> outputable l) literal + +-- | @type T :: k@. +standaloneKindSig :: Ctx -> StandaloneKindSig GhcPs -> Doc +standaloneKindSig ctx (StandaloneKindSig _ n sigTy) = + txt "type" + <> indent + ( space + <> name ctx n + <> joinedBy "::" + <> hsSigType ctx sigTy + ) + +---------------------------------------------------------------------------- +-- Rewrite rules + +-- | A @RULES@ block. +-- +-- The closing @#-\}@ is given an anchor of its own, so that a comment +-- written after the last rule and before it stays inside the pragma. There +-- is nothing else down there for such a comment to attach to, and outside +-- the braces it would read as a remark on whatever follows the block. +ruleDecls :: Ctx -> RuleDecls GhcPs -> Doc +ruleDecls ctx (HsRules ((_, close), _) rules) = + pragma "RULES" $ + sepBy breakOrSpace (map (align . at_ ctx (ruleDecl ctx)) rules) + <> foldMap (emptyAnchor . startOf) (tokenSpan close) + +ruleDecl :: Ctx -> RuleDecl GhcPs -> Doc +ruleDecl ctx (HsRule _ ruleName phase binders lhs rhs) = + at ctx ruleName ruleNameLiteral + <> space + <> activation phase + <> space + <> ruleBinders ctx binders + <> breakOrSpace + <> indent + ( hsExpr ctx lhs + <> space + <> txt "=" + <> indent (breakOrSpace <> hsExpr ctx rhs) + ) + +-- | A rule's name is a string literal, and printing it as one is what puts +-- the quotes back. +ruleNameLiteral :: RuleName -> Doc +ruleNameLiteral n = outputable (HsString NoSourceText n :: HsLit GhcPs) + +-- | The @forall@s a rule or a @SPECIALIZE@ pragma binds. +ruleBinders :: Ctx -> RuleBndrs GhcPs -> Doc +ruleBinders ctx (RuleBndrs HsRuleBndrsAnn {..} tyvars binders) = + foldMap + (\xs -> forallBndrs ctx Invisible (tyVarBndr ctx) xs <> space) + tyvars + <> case rb_tmanns of + Nothing -> mempty + Just _ -> forallBndrs ctx Invisible (ruleBinder ctx) binders + +ruleBinder :: Ctx -> RuleBndr GhcPs -> Doc +ruleBinder ctx = \case + RuleBndr _ n -> name ctx n + RuleBndrSig _ n HsPS {..} -> + parens (name ctx n <> typeAscription ctx (asSigType hsps_body)) diff --git a/src/Tilia/Render/Type.hs b/src/Tilia/Render/Type.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Render/Type.hs @@ -0,0 +1,479 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +-- | Types. +module Tilia.Render.Type + ( -- * Types + hsType, + hsTypeBody, + hsSigType, + hsSigTypeBody, + typeAscription, + + -- * Contexts + context, + contextOf, + + -- * Binders + TyVarBndrFlag (..), + tyVarBndr, + Visibility (..), + forallBndrs, + forallTelescope, + outerBndrs, + + -- * Record fields + recordFieldsAt, + conDeclField, + documentedConDeclField, + strictness, + + -- * Arguments + typeArgument, + typeArgSpan, + + -- * Asking about a type + typeIsDocumented, + + -- * Conversions + asSigType, + ) +where + +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Text qualified as T +import GHC.Hs +import GHC.Types.Name.Occurrence (isTvOcc) +import GHC.Types.Name.Reader (RdrName, rdrNameOcc) +import GHC.Types.SourceText +import GHC.Types.SrcLoc (GenLocated (..), getLoc, unLoc) +import GHC.Types.Var (Specificity (..)) +import Tilia.Doc.Combinators +import Tilia.Fixity (Namespace (..)) +import Tilia.Render.Context +import Tilia.Render.Haddock +import Tilia.Render.Literal (stringLiteral) +import Tilia.Render.Name +import Tilia.Render.Operator +import Tilia.Span +import Tilia.Span.Ghc + +---------------------------------------------------------------------------- +-- Types + +-- | A type. +hsType :: Ctx -> LHsType GhcPs -> Doc +hsType ctx l = at ctx l (hsTypeBody ctx (spanOf l)) + +-- | A type whose location the caller has already entered. +hsTypeBody :: Ctx -> Maybe Span -> HsType GhcPs -> Doc +hsTypeBody ctx here t = typeBody ctx (typeIsDocumented t) here t + +-- | The body of a type, with the decision about its arguments handed down. +-- +-- A type one of whose arguments carries documentation cannot keep its arrows +-- on one line: the Haddock takes the rest of the line with it. So the +-- question is settled once, at the outermost type, and passed inwards—a +-- nested arrow has to know what the whole signature decided rather than what +-- its own subtree would have decided on its own. +typeBody :: Ctx -> Bool -> Maybe Span -> HsType GhcPs -> Doc +typeBody ctx documented here = \case + HsForAllTy _ tele t -> + forallTelescope ctx tele <> betweenArgs <> hsType ctx t + HsQualTy _ qs t -> + context ctx qs + <> space + <> txt "=>" + <> betweenArgs + <> case unLoc t of + -- A nested context or arrow inherits the outer type's decision + -- rather than making a fresh one, so a signature breaks all of its + -- arrows or none of them. + HsQualTy {} -> recur (unLoc t) + HsFunTy {} -> hsType ctx t + _ -> at ctx t recur + HsTyVar _ promoted n -> promotion promoted n <> name ctx n + HsAppTy _ f x -> + let (func, args) = gatherAppArgs f [x] + in layoutFrom ctx (spanOf f <> spansOf args) . align $ + hsType ctx func + <> breakOrSpace + <> indent (sepBy breakOrSpace (map (hsType ctx) args)) + HsAppKindTy _ ty kd -> + align (hsType ctx ty <> breakOrSpace <> indent (txt "@" <> hsType ctx kd)) + HsFunTy _ multAnn x y -> + hsType ctx x + <> space + <> multiplicity (at_ ctx recur) multAnn + <> space + <> txt "->" + <> betweenArgs + <> case unLoc y of + HsFunTy {} -> recur (unLoc y) + _ -> at ctx y recur + HsListTy _ t -> + layoutWithin ctx here (spanOf t) $ + brackets (insideBrackets here (hsType ctx t)) + HsTupleTy _ sort xs -> + layoutWithin ctx here (spansOf xs) $ + tupleBrackets sort (insideBrackets here (commaSep (map (align . hsType ctx) xs))) + HsSumTy _ xs -> + unboxed (sepBy (joinedBy "|") (map (align . hsType ctx) xs)) + HsOpTy _ _ x op y -> typeChain ctx x op y + HsParTy _ t -> + layoutWithin ctx here (spanOf t) (parens (insideBrackets here (hsType ctx t))) + HsIParamTy _ n t -> + align (at ctx n outputable <> joinedBy "::" <> indent (hsType ctx t)) + HsStarTy _ _ -> txt "*" + HsKindSig _ t k -> + align (hsType ctx t <> joinedBy "::" <> indent (hsType ctx k)) + HsSpliceTy _ splice -> knotSplice (ctxKnot ctx) ctx DollarSplice splice + HsDocTy _ t str -> haddockInline ctx Pipe str <> hsType ctx t + HsExplicitListTy _ promoted xs -> + tick promoted + <> brackets (insideBrackets here (quoteGap promoted xs <> commaSep (map (align . hsType ctx) xs))) + HsExplicitTupleTy _ promoted xs -> + tick promoted + <> parens (insideBrackets here (quoteGap promoted xs <> commaSep (map (hsType ctx) xs))) + HsTyLit _ t -> case t of + HsStrTy (SourceText s) _ -> stringLiteral s + other -> outputable other + HsWildCardTy _ -> txt "_" + XHsType ext -> case ext of + HsCoreTy t -> outputable t + HsBangTy _ (HsSrcBang _ unpacked strict) t -> + unpackPragma unpacked <> strictness strict <> hsType ctx t + -- A bare record type has no wrapper of its own, so there is no span to + -- anchor a comment written inside empty braces to. + HsRecTy _ fields -> recordFields ctx Nothing fields + where + recur = typeBody ctx documented Nothing + betweenArgs = if documented then hardBreak else breakOrSpace + +---------------------------------------------------------------------------- +-- Operator chains + +-- | A chain of type operators, regrouped by precedence. +typeChain :: Ctx -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> Doc +typeChain ctx x op y = + renderChain ctx (uncurry (associate fixity) (flattenAround split x op y)) + where + split t = case unLoc t of + HsOpTy _ _ l o r -> Just (l, o, r) + _ -> Nothing + fixity o = operatorFixity ctx InTypes (unLoc o) + +renderChain :: Ctx -> OpChain (LHsType GhcPs) (LocatedN RdrName) -> Doc +renderChain ctx = \case + Operand t -> hsType ctx t + chain@(Chain (firstOne :| rest) operators) -> + layoutFrom ctx (chainSpan spanOf chain) $ + renderChain ctx firstOne <> mconcat (zipWith piece operators rest) + where + -- Type operators have no hanging form: no type absorbs a line break the + -- way a @do@ block does, so a broken chain always indents. + piece op operand = + attach Normal (name ctx op <> space <> renderChain ctx operand) + +---------------------------------------------------------------------------- +-- Pieces of a type + +-- | Gather a nest of applications into a head and its arguments. +-- +-- The tree is built one argument at a time, which would lay @F a b c@ out as +-- though each application were a separate decision. Collecting them first +-- lets the whole application break as one. +gatherAppArgs :: LHsType GhcPs -> [LHsType GhcPs] -> (LHsType GhcPs, [LHsType GhcPs]) +gatherAppArgs f known = case unLoc f of + HsAppTy _ l r -> gatherAppArgs l (r : known) + _ -> (f, known) + +tupleBrackets :: HsTupleSort -> Doc -> Doc +tupleBrackets = \case + HsUnboxedTuple -> unboxed + HsBoxedOrConstraintTuple -> parens + +tick :: PromotionFlag -> Doc +tick = \case + IsPromoted -> txt "'" + NotPromoted -> mempty + +-- | The tick on a promoted name, held off it when the name itself begins +-- with one, since @''@ is the spelling of a type-level quote. +promotion :: PromotionFlag -> LocatedN RdrName -> Doc +promotion NotPromoted _ = mempty +promotion IsPromoted n = txt "'" <> includeWhen (beginsWithTick (showGhc (unLoc n))) space + where + beginsWithTick shown = case T.uncons (T.drop 1 shown) of + Just ('\'', _) -> True + _ -> False + +-- | A promoted list or tuple whose first element is itself promoted needs a +-- space, or @'['a]@ would begin with a character literal. +quoteGap :: PromotionFlag -> [LHsType GhcPs] -> Doc +quoteGap IsPromoted (t : _) | startsWithTick (unLoc t) = space +quoteGap _ _ = mempty + +startsWithTick :: HsType GhcPs -> Bool +startsWithTick = \case + HsAppTy _ (L _ f) _ -> startsWithTick f + HsTyVar _ IsPromoted _ -> True + HsExplicitTupleTy {} -> True + HsExplicitListTy {} -> True + HsTyLit _ HsCharTy {} -> True + _ -> False + +-- | The pragma asking for a field to be unpacked, or not to be. +unpackPragma :: SrcUnpackedness -> Doc +unpackPragma = \case + SrcUnpack -> txt "{-# UNPACK #-}" <> space + SrcNoUnpack -> txt "{-# NOUNPACK #-}" <> space + NoSrcUnpack -> mempty + +-- | The @!@ or @~@ in front of a field. +strictness :: SrcStrictness -> Doc +strictness = \case + SrcLazy -> txt "~" + SrcStrict -> txt "!" + NoSrcStrict -> mempty + +-- | Does any argument of this type carry documentation? +typeIsDocumented :: HsType GhcPs -> Bool +typeIsDocumented = any documented . spine + where + documented = \case + HsDocTy {} -> True + _ -> False + +-- | The pieces of a type that a signature would put on lines of their own: +-- the argument and result types, and whatever a @forall@ or a context is +-- wrapped around. +-- +-- Not the types nested inside those. A Haddock written on an element of a +-- list argument documents the element and says nothing about how the +-- signature it sits in should be laid out. +spine :: HsType GhcPs -> [HsType GhcPs] +spine t = + t : case t of + HsFunTy _ _ a b -> spine (unLoc a) <> spine (unLoc b) + HsForAllTy _ _ b -> spine (unLoc b) + HsQualTy _ _ b -> spine (unLoc b) + _ -> [] + +---------------------------------------------------------------------------- +-- Contexts + +-- | A class context, as it appears before a @=>@. +context :: Ctx -> LHsContext GhcPs -> Doc +context ctx = at_ ctx (contextOf loneVariable (hsType ctx) . map unbracket) + +-- | Is this constraint nothing but a type variable? +loneVariable :: LHsType GhcPs -> Bool +loneVariable t = case unLoc t of + HsTyVar _ _ (L _ n) -> isTvOcc (rdrNameOcc n) + _ -> False + +-- | A constraint without the brackets a context puts around it anyway. +-- +-- Stripped before the context writes its own, or formatting would add a +-- layer every time it ran. +unbracket :: LHsType GhcPs -> LHsType GhcPs +unbracket t = case unLoc t of + HsParTy _ inner -> unbracket inner + _ -> t + +-- | A context over anything that can stand as a constraint. +contextOf :: + -- | Is this constraint nothing but a variable? + (a -> Bool) -> + (a -> Doc) -> + [a] -> + Doc +contextOf lone render = \case + [] -> txt "()" + [x] | lone x -> render x + xs -> parens (commaSep (map (align . render) xs)) + +---------------------------------------------------------------------------- +-- Binders + +-- | The flags a type variable binder may carry. +-- +-- Three kinds of binder exist with three different flag types, and each +-- decides both whether the binder is inferred—which is what braces around it +-- mean—and whether anything is printed in front of it. +class TyVarBndrFlag flag where + flagIsInferred :: flag -> Bool + flagPrefix :: flag -> Doc + flagPrefix _ = mempty + +instance TyVarBndrFlag () where + flagIsInferred () = False + +instance TyVarBndrFlag Specificity where + flagIsInferred = \case + InferredSpec -> True + SpecifiedSpec -> False + +instance TyVarBndrFlag (HsBndrVis GhcPs) where + flagIsInferred _ = False + flagPrefix = \case + HsBndrRequired NoExtField -> mempty + HsBndrInvisible _ -> txt "@" + +-- | One type variable binder. +tyVarBndr :: (TyVarBndrFlag flag) => Ctx -> HsTyVarBndr flag GhcPs -> Doc +tyVarBndr ctx HsTvb {..} = flagPrefix tvb_flag <> enclosed (binder <> kind) + where + binder = case tvb_var of + HsBndrVar _ x -> name ctx x + HsBndrWildCard _ -> txt "_" + + -- Whether a kind is written and whether brackets are needed are the same + -- question, so they are answered together. + (kind, kinded) = case tvb_kind of + HsBndrNoKind _ -> (mempty, False) + HsBndrKind _ k -> + (joinedBy "::" <> indent (hsType ctx k), True) + + enclosed + | flagIsInferred tvb_flag = braces + | kinded = parens + | otherwise = id + +-- | Whether a @forall@ binds visibly. +data Visibility + = -- | @forall a.@ + Invisible + | -- | @forall a ->@ + Visible + deriving (Eq, Show) + +-- | The variables of a @forall@, with the punctuation that closes it. +forallBndrs :: + (HasLoc l) => + Ctx -> + Visibility -> + (a -> Doc) -> + [GenLocated l a] -> + Doc +forallBndrs _ Invisible _ [] = txt "forall." +forallBndrs _ Visible _ [] = txt "forall ->" +forallBndrs ctx visibility render bndrs = + layoutAcross ctx bndrs $ + txt "forall" + <> breakOrSpace + <> indent (align (sepBy breakOrSpace (map (align . at_ ctx render) bndrs)) <> close) + where + close = case visibility of + Invisible -> txt "." + Visible -> space <> txt "->" + +-- | The @forall@ that opens a type. +forallTelescope :: Ctx -> HsForAllTelescope GhcPs -> Doc +forallTelescope ctx = \case + HsForAllInvis _ bndrs -> forallBndrs ctx Invisible (tyVarBndr ctx) bndrs + HsForAllVis _ bndrs -> forallBndrs ctx Visible (tyVarBndr ctx) bndrs + +-- | The binders a signature quantifies over, when it names them. +outerBndrs :: Ctx -> HsOuterTyVarBndrs Specificity GhcPs -> Doc +outerBndrs ctx = \case + HsOuterImplicit _ -> mempty + HsOuterExplicit _ bndrs -> forallTelescope ctx (mkHsForAllInvisTele noAnn bndrs) + +---------------------------------------------------------------------------- +-- Signatures + +-- | A type together with whatever it quantifies over. +hsSigType :: Ctx -> LHsSigType GhcPs -> Doc +hsSigType ctx = at_ ctx (hsSigTypeBody ctx) + +-- | A signature type whose location the caller has already entered. +hsSigTypeBody :: Ctx -> HsSigType GhcPs -> Doc +hsSigTypeBody ctx HsSig {..} = + outerBndrs ctx sig_bndrs + <> ( case sig_bndrs of + HsOuterImplicit {} -> mempty + HsOuterExplicit {} -> afterBinders + ) + <> hsType ctx sig_body + where + afterBinders + | typeIsDocumented (unLoc sig_body) = hardBreak + | otherwise = breakOrSpace + +-- | The @:: t@ that follows a name. +-- +-- A signature with documentation in it breaks unconditionally, since a +-- Haddock on the first argument would otherwise take the @::@ with it. +typeAscription :: Ctx -> LHsSigType GhcPs -> Doc +typeAscription ctx sigType = + indent (space <> txt "::" <> separator <> hsSigType ctx sigType) + where + separator + | typeIsDocumented (unLoc (sig_body (unLoc sigType))) = hardBreak + | otherwise = breakOrSpace + +-- | Give a plain type the shape of a signature type. +asSigType :: LHsType GhcPs -> LHsSigType GhcPs +asSigType ty = L (getLoc ty) (HsSig NoExtField (HsOuterImplicit NoExtField) ty) + +---------------------------------------------------------------------------- +-- Record fields + +-- | The braces of a record, and the fields inside them. +recordFieldsAt :: Ctx -> XRec GhcPs [LHsConDeclRecField GhcPs] -> Doc +recordFieldsAt ctx l = at ctx l (recordFields ctx (spanOf l)) + +-- | The fields of a record. +-- +-- A record with no fields still needs something between its braces for a +-- comment written there to attach to, or the comment would be pushed outside +-- them and end up documenting the constructor. +recordFields :: Ctx -> Maybe Span -> [LHsConDeclRecField GhcPs] -> Doc +recordFields ctx enclosing xs = + brokenIfDocumented ctx xs . braces . insideBrackets enclosing $ + commaSep (map (align . at_ ctx (recordField ctx)) xs) + +recordField :: Ctx -> HsConDeclRecField GhcPs -> Doc +recordField ctx HsConDeclRecField {..} = + foldMap (haddockInline ctx Pipe) (cdf_doc cdrf_spec) + <> align (commaSep (map (at_ ctx (name ctx . foLabel)) cdrf_names)) + <> space + <> multiplicity (hsType ctx) (cdf_multiplicity cdrf_spec) + <> joinedBy "::" + <> align (indent (conDeclField ctx cdrf_spec)) + +-- | A constructor field, without its documentation or its multiplicity. +-- +-- Those two are left to the caller because there is no one place they +-- belong: a record field puts the multiplicity before the @::@ and a GADT +-- argument puts it before the arrow. +conDeclField :: Ctx -> HsConDeclField GhcPs -> Doc +conDeclField ctx CDF {..} = + unpackPragma cdf_unpack + <> at ctx cdf_type (\ty -> strictness cdf_bang <> hsTypeBody ctx (spanOf cdf_type) ty) + +-- | A constructor field with its documentation in front of it. +documentedConDeclField :: Ctx -> HsConDeclField GhcPs -> Doc +documentedConDeclField ctx cdf = + foldMap (haddockInline ctx Pipe) (cdf_doc cdf) <> conDeclField ctx cdf + +---------------------------------------------------------------------------- +-- Arguments + +-- | One argument on the left of a family or data instance. +typeArgument :: Ctx -> LHsTypeArg GhcPs -> Doc +typeArgument ctx = \case + HsValArg NoExtField ty -> hsType ctx ty + -- The annotation holds the span of the @\@@, which is always immediately + -- in front of the type, so nothing is lost by not entering it. + HsTypeArg _ ty -> txt "@" <> hsType ctx ty + HsArgPar _ -> error "Tilia: HsArgPar is not expected in parsed source" + +-- | Where an argument was. +typeArgSpan :: LHsTypeArg GhcPs -> Maybe Span +typeArgSpan = spanOfSrcSpan . lhsTypeArgSrcSpan diff --git a/src/Tilia/Run.hs b/src/Tilia/Run.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Run.hs @@ -0,0 +1,262 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Running the formatter over a set of files. +module Tilia.Run + ( -- * Outcomes + Outcome (..), + declined, + failed, + differs, + exitCodeOf, + + -- * Execution + runOver, + readAsUtf8, + formattingOutcome, + writeBack, + inParallel, + + -- * Report + Report (..), + inplaceReport, + checkReport, + noted, + ) +where + +import Control.Concurrent (forkIO, getNumCapabilities, newEmptyMVar, putMVar, takeMVar) +import Control.Monad (replicateM) +import Data.ByteString qualified as BS +import Data.Foldable (for_, traverse_) +import Data.IORef +import Data.List (sortOn) +import Data.Map.Strict qualified as Map +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import System.FilePath (takeExtension) +import Tilia.Diff (diffInFull) +import Tilia.Format + ( FormatError (Unreadable), + Session, + describeFormatError, + formatErrorExitCode, + formatSource, + refused, + ) +import Tilia.Newline (NewlineStyle (Lf), getNewlineStyle, setNewlineStyle) +import Tilia.Palette (Color (Bad, Good, Middling, Place), Palette, marker, paint) +import Tilia.Utils (attempted, indent, lineWidth, wrapTo) + +---------------------------------------------------------------------------- +-- Outcomes + +-- | What became of one file. +data Outcome + = -- | Formatted, and it was already in that shape. + Unchanged + | -- | Formatted, and this is what it should say instead. + Changed Text Text + | -- | Declined. + Declined FormatError + | -- | Failed to format. + Failed FormatError + +-- | Was the file left alone because we would not touch it? +declined :: Outcome -> Bool +declined = \case + Declined {} -> True + _ -> False + +-- | Was the file left alone because something is wrong with it? +failed :: Outcome -> Bool +failed = \case + Failed {} -> True + _ -> False + +-- | Would formatting change the file? +differs :: Outcome -> Bool +differs = \case + Changed {} -> True + _ -> False + +-- | What a run that met a failure should exit with. +-- +-- 'Nothing' where nothing failed. Where several did, the lowest of their +-- codes: they are all true, and one of them has to be picked, so it may as +-- well be picked the same way every time. +exitCodeOf :: [(FilePath, Outcome)] -> Maybe Int +exitCodeOf outcomes = + case [formatErrorExitCode e | (_, Failed e) <- outcomes] of + [] -> Nothing + codes -> Just (minimum codes) + +---------------------------------------------------------------------------- +-- Execution + +-- | Format every file, as many at a time as the machine allows. +runOver :: Session -> [FilePath] -> IO [(FilePath, Outcome)] +runOver session = inParallel one + where + one path = do + !outcome <- + readAsUtf8 path >>= \case + Left why -> pure (Failed (Unreadable path why)) + Right before -> + formatSource session path (setNewlineStyle Lf before) >>= \case + Left e -> pure (if refused e then Declined e else Failed e) + Right formatted -> pure (formattingOutcome before formatted) + pure (path, outcome) + +-- | Read a source file as UTF-8. +readAsUtf8 :: FilePath -> IO (Either Text Text) +readAsUtf8 path = + attempted (BS.readFile path) >>= \case + Left why -> pure (Left why) + Right bytes -> pure $ case T.decodeUtf8' bytes of + Right text -> Right text + Left _ -> Left "it is not valid UTF-8" + +-- | Formatting outcome for a file. +formattingOutcome :: + -- | The file, as it is + Text -> + -- | Its formatted text, in newlines + Text -> + Outcome +formattingOutcome before formatted + | after == before = Unchanged + | otherwise = Changed before after + where + after = setNewlineStyle (getNewlineStyle before) formatted + +-- | Put a formatted file back, and only if it changed. +writeBack :: (FilePath, Outcome) -> IO () +writeBack (path, outcome) = case outcome of + Changed _ after -> BS.writeFile path (T.encodeUtf8 after) + _ -> pure () + +-- | Run an action over every element at once, as far as the machine allows. +inParallel :: (a -> IO b) -> [a] -> IO [b] +inParallel act xs = do + capabilities <- getNumCapabilities + queue <- newIORef (zip [0 :: Int ..] xs) + answers <- newIORef Map.empty + let worker = + atomicModifyIORef' queue (\case [] -> ([], Nothing); (y : ys) -> (ys, Just y)) >>= \case + Nothing -> pure () + Just (i, x) -> do + y <- act x + atomicModifyIORef' answers (\m -> (Map.insert i y m, ())) + worker + done <- replicateM (max 1 (min capabilities (length xs))) newEmptyMVar + for_ done $ \signal -> forkIO (worker >> putMVar signal ()) + traverse_ takeMVar done + Map.elems <$> readIORef answers + +---------------------------------------------------------------------------- +-- Report + +-- | What to print when a run is over, and on which stream. +data Report = Report + { -- | For standard output. + reportOut :: [Text], + -- | For standard error. + reportErr :: [Text] + } + deriving (Eq, Show) + +-- | The summary an @inplace@ run prints. +inplaceReport :: Palette -> [(FilePath, Outcome)] -> Report +inplaceReport palette outcomes = + Report + { reportOut = tally palette ("✓", Good) "Formatted" (not . skipped) outcomes, + reportErr = asides palette outcomes + } + where + skipped o = declined o || failed o + +-- | The diffs a @check@ run prints, and what it could not or would not do. +checkReport :: Palette -> [(FilePath, Outcome)] -> Report +checkReport palette outcomes = + Report + { reportOut = + [ diffInFull palette path before after + | (path, Changed before after) <- outcomes + ], + reportErr = asides palette outcomes + } + +-- | Everything said about the files that were not formatted. +asides :: Palette -> [(FilePath, Outcome)] -> [Text] +asides palette outcomes = + concat + [ tally palette ("=", Middling) "Declined" declined outcomes, + reasons declined, + tally palette ("✗", Bad) "Failed" failed outcomes, + reasons failed + ] + where + reasons wanted = + [ line + | (_, outcome) <- sortOn fst outcomes, + wanted outcome, + e <- why outcome, + line <- bulleted palette e + ] + why = \case + Declined e -> [e] + Failed e -> [e] + _ -> [] + +-- | One line per extension, for the files a test picks out. +tally :: + Palette -> + -- | The mark to set the line under, and the color to set it in + (Text, Color) -> + -- | What became of the files being counted + Text -> + (Outcome -> Bool) -> + [(FilePath, Outcome)] -> + [Text] +tally palette (mark, color) what wanted outcomes = + [ indent 1 <> marker palette color mark <> " " <> what <> " " <> count palette n extension + | (extension, n) <- countedBy (wanted . snd) outcomes + ] + +-- | How many files of each extension, among the ones a test picks out. +countedBy :: ((FilePath, Outcome) -> Bool) -> [(FilePath, Outcome)] -> [(Text, Int)] +countedBy wanted = + Map.toList + . Map.fromListWith (+) + . map (\(path, _) -> (T.pack (takeExtension path), 1 :: Int)) + . filter wanted + +-- | Render the number of files. +count :: Palette -> Int -> Text -> Text +count palette n extension = + T.pack (show n) + <> " " + <> paint palette Place extension + <> (if n == 1 then " file" else " files") + +-- | One case among several, opened by a bullet and wrapped underneath it. +bulleted :: Palette -> FormatError -> [Text] +bulleted palette e = case wrapTo (lineWidth - 6) (describeFormatError palette e) of + [] -> [] + (opening : rest) -> + (indent 2 <> "· " <> opening) : map (indent 3 <>) rest + +-- | Something to say under a mark of its own, wrapped to fit beneath it. +noted :: + Palette -> + -- | The mark to set it under, and the color to set that in + (Text, Color) -> + Text -> + [Text] +noted palette (mark, color) text = case wrapTo (lineWidth - 6) text of + [] -> [] + (opening : rest) -> + (indent 1 <> marker palette color mark <> " " <> opening) + : map (indent 3 <>) rest diff --git a/src/Tilia/Source.hs b/src/Tilia/Source.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Source.hs @@ -0,0 +1,74 @@ +-- | The module as its author wrote it. +-- +-- Almost everything the formatter decides about layout is a question about +-- the source: what is on the line above a comment, whether two constructs +-- had an empty line between them, whether a directive stands between a +-- comment and the pragma under it. All these questions are asked in a +-- single place here, or in "Tilia.Source.Lines" for the ones that can be +-- asked before the module has been parsed. +module Tilia.Source + ( -- * The source + SourceType (..), + Written (..), + Source, + sourceOf, + + -- * Its lines + Lines, + linesOf, + dropping, + lineTexts, + sourceLines, + lineAt, + blankAt, + blankBelow, + closesABranch, + directiveAt, + + -- * Its comments + comments, + ) +where + +import GHC.Hs (HsModule) +import GHC.Hs.Extension (GhcPs) +import GHC.Parser.Annotation (LEpaComment) +import Tilia.Comments (Comment, commentsOf) +import Tilia.Source.Lines + +-- | Whether a file is a module or a Backpack signature. +data SourceType + = ModuleSource + | SignatureSource + deriving (Eq, Show) + +-- | A module's source in a form that facilitates querying. +data Source = Source + { -- | The lines, numbered from one as the compiler numbers them. + srcLines :: !Lines, + -- | Every comment in the module, in source order. + srcComments :: [Comment] + } + +-- | The lines of a source. +sourceLines :: Source -> Lines +sourceLines = srcLines + +-- | Read a module's source. +sourceOf :: + -- | The lines of the module, as this configuration has them + Lines -> + -- | Comments the syntax tree does not carry. See 'commentsOf'. + [LEpaComment] -> + -- | The result of parsing + HsModule GhcPs -> + Source +sourceOf ls loose hsModule = + Source + { srcLines = ls, + srcComments = commentsOf ls loose hsModule + } + +-- | Every comment in a module, in source order. +comments :: Source -> [Comment] +comments = srcComments diff --git a/src/Tilia/Source/Lines.hs b/src/Tilia/Source/Lines.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Source/Lines.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | The lines of a module, and the questions that can be asked of them +-- without a parse. +-- +-- Apart from "Tilia.Source" because a 'Tilia.Source.Source' cannot be had +-- until the module has been parsed, and two things need these answers +-- earlier than that: the preprocessor support, which asks what the author +-- wrote on a line while it is still deciding what to hand the parser, and +-- the comment machinery, which "Tilia.Source" itself is built on top of. +module Tilia.Source.Lines + ( -- * The lines + Written (..), + Lines, + linesOf, + dropping, + lineTexts, + lineAt, + blankAt, + directiveAt, + blankBelow, + closesABranch, + ) +where + +import Data.Char (isAsciiLower, isSpace) +import Data.IntMap.Strict (IntMap) +import Data.IntMap.Strict qualified as IntMap +import Data.IntSet (IntSet) +import Data.IntSet qualified as IntSet +import Data.Text (Text) +import Data.Text qualified as T + +-- | The text of a module as its author wrote it. +-- +-- Distinguished from the text handed to the parser because the two are the +-- same only when the preprocessor is not involved. +newtype Written = Written Text + deriving (Eq, Show) + +-- | The lines of a source, numbered from one as the compiler numbers them, +-- but also the lines that a particular CPP configuration does not contain. +data Lines = Lines + { -- | Every line of the module as written. + lnWritten :: !(IntMap Text), + -- | The ones this configuration does not contain. + lnDropped :: !IntSet + } + +-- | Read the lines of a module, every one of which it has. +linesOf :: Written -> Lines +linesOf (Written text) = + Lines + { lnWritten = IntMap.fromList (zip [1 ..] (T.lines text)), + lnDropped = IntSet.empty + } + +-- | Drop the given ranges from the 'Lines'. +dropping :: [(Int, Int)] -> Lines -> Lines +dropping ranges ls = + ls + { lnDropped = + IntSet.union + (lnDropped ls) + (IntSet.fromList (concat [[from .. to] | (from, to) <- ranges])) + } + +-- | Every line of the module as written, in order, whatever this +-- configuration has of them. +lineTexts :: Lines -> [Text] +lineTexts = IntMap.elems . lnWritten + +-- | The text of a line, if this configuration of the module has one. +lineAt :: Int -> Lines -> Maybe Text +lineAt n ls + | IntSet.member n (lnDropped ls) = Nothing + | otherwise = IntMap.lookup n (lnWritten ls) + +-- | Was this line empty? +blankAt :: Int -> Lines -> Bool +blankAt n = maybe False (T.all isSpace) . lineAt n + +-- | Does this line hold a preprocessor directive? +directiveAt :: Int -> Lines -> Bool +directiveAt n = maybe False opensWithHash . lineAt n + where + opensWithHash l = case T.uncons (T.stripStart l) of + Just ('#', rest) -> + maybe False (isAsciiLower . fst) (T.uncons (T.stripStart rest)) + _ -> False + +-- | Did the author leave an empty line below this line? +blankBelow :: Int -> Lines -> Bool +blankBelow start ls = go (start + 1) + where + go n + | n > IntMap.size (lnWritten ls) = False + | Nothing <- lineAt n ls = go (n + 1) + | leadsOut n = go (n + 1) + | otherwise = blankAt n ls + leadsOut n = case lineAt n ls of + Just l | directiveAt n ls -> keywordOf l `elem` leavingKeywords + _ -> False + keywordOf l = T.takeWhile isAsciiLower (T.stripStart (T.drop 1 (T.stripStart l))) + +-- | Does the empty line under this one stand at the end of a branch? +closesABranch :: Int -> Lines -> Bool +closesABranch n ls = go False (n + 1) + where + go crossed k + | k > IntMap.size (lnWritten ls) = False + | otherwise = case lineAt k ls of + Nothing -> go crossed (k + 1) + Just l + | T.null (T.strip l) -> go True (k + 1) + | directiveAt k ls -> crossed && keywordOf l `elem` leavingKeywords + | otherwise -> False + keywordOf l = T.takeWhile isAsciiLower (T.stripStart (T.drop 1 (T.stripStart l))) + +-- | The directives that lead out of the region the line below them is in, +-- rather than into one it is not. +leavingKeywords :: [Text] +leavingKeywords = ["elif", "elifdef", "elifndef", "else", "endif"] diff --git a/src/Tilia/Span.hs b/src/Tilia/Span.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Span.hs @@ -0,0 +1,118 @@ +-- | Regions of the input, and the questions asked about them. +-- +-- Deliberately not GHC's @RealSrcSpan@. Almost everything here wants to ask +-- one of a handful of questions—did this occupy a single line, did that +-- begin on the line this ended on, was there an empty line between them—and +-- a type of our own keeps the modules that ask them free of the compiler's +-- libraries. Conversion happens at the edge, in "Tilia.Span.Ghc", which is +-- the only place that has to know what GHC's positions look like. +module Tilia.Span + ( -- * Spans + Span (..), + mkSpan, + + -- * Asking about one + isSingleLine, + + -- * Asking about two + sameLine, + blankBetween, + meets, + covers, + + -- * Narrowing + startOf, + endOf, + + -- * Positions + startPoint, + endPoint, + ) +where + +-- | A region of the input. +data Span = Span + { spanStartLine :: !Int, + spanStartColumn :: !Int, + spanEndLine :: !Int, + spanEndColumn :: !Int + } + deriving (Eq, Ord, Show) + +-- | Build a 'Span' from start and end positions, each a line and a column. +mkSpan :: (Int, Int) -> (Int, Int) -> Span +mkSpan (sl, sc) (el, ec) = Span sl sc el ec + +-- | The smallest span covering both arguments. +-- +-- Printing code needs this often enough—a construct the syntax tree has no +-- single node for still has to be laid out as a unit—that it is worth having +-- as an instance rather than as a function each caller reimplements. +instance Semigroup Span where + a <> b = + Span + { spanStartLine = min (spanStartLine a) (spanStartLine b), + spanStartColumn = case compare (spanStartLine a) (spanStartLine b) of + LT -> spanStartColumn a + GT -> spanStartColumn b + EQ -> min (spanStartColumn a) (spanStartColumn b), + spanEndLine = max (spanEndLine a) (spanEndLine b), + spanEndColumn = case compare (spanEndLine a) (spanEndLine b) of + GT -> spanEndColumn a + LT -> spanEndColumn b + EQ -> max (spanEndColumn a) (spanEndColumn b) + } + +-- | Did this occupy a single line of the input? +-- +-- The question the whole formatter turns on: what was written on one line +-- stays on one line, and what was spread out stays spread out. +isSingleLine :: Span -> Bool +isSingleLine s = spanStartLine s == spanEndLine s + +-- | Did the second thing begin on the line the first thing ended on? +-- +-- This is the question behind almost every hanging decision: a body may only +-- hang off what precedes it when the author had them starting together. +sameLine :: Maybe Span -> Maybe Span -> Bool +sameLine (Just a) (Just b) = spanEndLine a == spanStartLine b +sameLine _ _ = False + +-- | Was there an empty line between the two? +blankBetween :: Maybe Span -> Maybe Span -> Bool +blankBetween (Just a) (Just b) = spanStartLine b > spanEndLine a + 1 +blankBetween _ _ = False + +-- | Do the two cover any of the same input? +-- +-- Touching counts: a span ending where the next begins shares that position, +-- and the callers that ask this are asking whether the two are looking at +-- one thing, not whether either strictly contains the other. +meets :: Span -> Span -> Bool +meets a b = startPoint a <= endPoint b && startPoint b <= endPoint a + +-- | Does the first cover all of the second? +-- +-- Reflexive, so a span covers itself. Callers wanting one thing to be +-- strictly inside another want this and inequality. +covers :: Span -> Span -> Bool +covers a b = startPoint a <= startPoint b && endPoint b <= endPoint a + +-- | A zero-width span at the start of the given one. +startOf :: Span -> Span +startOf s = at (spanStartLine s, spanStartColumn s) + +-- | A zero-width span at the end of the given one. +endOf :: Span -> Span +endOf s = at (spanEndLine s, spanEndColumn s) + +at :: (Int, Int) -> Span +at position = mkSpan position position + +-- | Where a span begins, as a position two of them may be compared by. +startPoint :: Span -> (Int, Int) +startPoint s = (spanStartLine s, spanStartColumn s) + +-- | Where a span ends. +endPoint :: Span -> (Int, Int) +endPoint s = (spanEndLine s, spanEndColumn s) diff --git a/src/Tilia/Span/Ghc.hs b/src/Tilia/Span/Ghc.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Span/Ghc.hs @@ -0,0 +1,45 @@ +-- | Turning the compiler's positions into ours. +module Tilia.Span.Ghc + ( spanOfReal, + spanOfSrcSpan, + spanOf, + spansOf, + tokenSpan, + annSpan, + ) +where + +import Data.Maybe (mapMaybe) +import GHC.Parser.Annotation (EpToken, HasLoc, getEpTokenSrcSpan, getHasLoc) +import GHC.Types.SrcLoc (GenLocated) +import GHC.Types.SrcLoc qualified as GHC +import Tilia.Span (Span, mkSpan) + +-- | Convert a span the compiler knows to be real. +spanOfReal :: GHC.RealSrcSpan -> Span +spanOfReal s = + mkSpan + (GHC.srcSpanStartLine s, GHC.srcSpanStartCol s) + (GHC.srcSpanEndLine s, GHC.srcSpanEndCol s) + +-- | Convert a span that may not be real. +spanOfSrcSpan :: GHC.SrcSpan -> Maybe Span +spanOfSrcSpan = fmap spanOfReal . GHC.srcSpanToRealSrcSpan + +-- | The span of a located thing. +spanOf :: (HasLoc l) => GenLocated l a -> Maybe Span +spanOf = spanOfSrcSpan . getHasLoc + +-- | Where a keyword or a piece of punctuation was written. +tokenSpan :: EpToken sym -> Maybe Span +tokenSpan = spanOfSrcSpan . getEpTokenSrcSpan + +-- | Where an annotation says something was written. +annSpan :: (HasLoc l) => l -> Maybe Span +annSpan = spanOfSrcSpan . getHasLoc + +-- | The span covering every located thing in the list. +spansOf :: (HasLoc l) => [GenLocated l a] -> Maybe Span +spansOf xs = case mapMaybe spanOf xs of + [] -> Nothing + (s : ss) -> Just (foldr (<>) s ss) diff --git a/src/Tilia/Target.hs b/src/Tilia/Target.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Target.hs @@ -0,0 +1,352 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Working out which files a run was asked to format. +module Tilia.Target + ( Target (..), + Kind (..), + parseTarget, + Component (..), + TargetProblem (..), + describeTargetProblem, + componentsOfTarget, + componentInPlan, + filesOfComponents, + ) +where + +import Control.Monad (filterM) +import Data.ByteString qualified as BS +import Data.ByteString.Char8 qualified as BS8 +import Data.Char (toLower) +import Data.List (isPrefixOf, isSuffixOf, sort) +import Data.List.NonEmpty qualified as NE +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import Distribution.Fields.Field (Field (..), FieldLine (..), Name (..)) +import Distribution.Fields.ParseResult (runParseResult) +import Distribution.Fields.Parser (readFields) +import Distribution.PackageDescription + ( Benchmark (..), + BuildInfo (..), + CondTree (..), + Executable (..), + GenericPackageDescription (..), + Library (..), + PackageDescription (..), + TestSuite (..), + unPackageName, + unUnqualComponentName, + ) +import Distribution.PackageDescription.Parsec (parseGenericPackageDescription) +import Distribution.Parsec (showPError) +import Distribution.Types.PackageId (PackageIdentifier (..)) +import Distribution.Utils.Path (getSymbolicPath) +import System.Directory + ( doesDirectoryExist, + doesFileExist, + listDirectory, + ) +import System.FilePath (normalise, takeDirectory, takeExtension, ()) +import Tilia.Fixity.Plan (PlanComponent (..)) +import Tilia.Project (Marker (..), ProjectRoot (..), markerFile) +import Tilia.Utils (attempted, quietly) + +-- | Which components a run was asked for. +data Target + = -- | @all@, or nothing given at all: every component of every package. + Everything + | -- | One bare word, which may name a package or a component. + Called Text + | -- | @kind:name@, or @package:kind:name@. + Qualified (Maybe Text) Kind Text + deriving (Eq, Show) + +-- | The kinds of component a @.cabal@ file can declare. +data Kind = Lib | Exe | Test | Bench + deriving (Eq, Ord, Show) + +-- | Read a target as it was written on the command line. +parseTarget :: String -> Either Text Target +parseTarget written = case T.splitOn ":" (T.strip (T.pack written)) of + [""] -> Left "an empty target" + ["all"] -> Right Everything + [one] -> Right (Called one) + [k, name] | Just kind <- kindNamed k -> Right (Qualified Nothing kind name) + [package, k, name] | Just kind <- kindNamed k -> Right (Qualified (Just package) kind name) + _ -> Left unrecognised + where + unrecognised = + "unrecognised target " + <> T.pack (show written) + <> ": expected all, a package or component name, or one of\ + \ lib:, exe:, test:, bench: followed by a name" + kindNamed = \case + "lib" -> Just Lib + "exe" -> Just Exe + "test" -> Just Test + "bench" -> Just Bench + "benchmark" -> Just Bench + _ -> Nothing + +-- | Does a target ask for this component? +targetSelectsComponent :: Target -> Component -> Bool +targetSelectsComponent target c = case target of + Everything -> True + Called name -> name == componentName c || name == componentPackage c + Qualified package kind name -> + all (== componentPackage c) package + && kind == componentKind c + && name == componentName c + +-- | One component of one package, as far as formatting cares. +data Component = Component + { -- | The package it belongs to. + componentPackage :: Text, + -- | Which kind it is. + componentKind :: Kind, + -- | Its name, which for a library is the package's own. + componentName :: Text, + -- | The directory its @.cabal@ file sits in. + componentRoot :: FilePath, + -- | Its @hs-source-dirs@, relative to 'componentRoot'. + componentDirs :: [FilePath] + } + deriving (Eq, Show) + +-- | Why a run could not work out what to format. +data TargetProblem + = -- | A @cabal.project@ naming packages, none of which could be found. + NoPackages FilePath + | -- | A @.cabal@ file that would not parse, and what the parser said. + Unparseable FilePath [Text] + | -- | A target naming no component the project holds. + NoSuchTarget Text [Text] + deriving (Eq, Show) + +-- | Say what went wrong, in one line. +describeTargetProblem :: TargetProblem -> Text +describeTargetProblem = \case + NoPackages file -> + T.pack file <> " names no packages that exist" + Unparseable file complaints -> + T.pack file <> " does not parse:" <> foldMap ("\n " <>) complaints + NoSuchTarget asked available -> + "no component matches " + <> asked + <> ", and the targets this project takes are" + <> foldMap ("\n " <>) ("all" : available) + +-- | Every component of the project that the target asks for. +componentsOfTarget :: ProjectRoot -> Target -> IO (Either TargetProblem [Component]) +componentsOfTarget root target = do + files <- packageFilesOf root + if null files + then pure (Left (NoPackages (prPath root markerFile (prMarker root)))) + else + traverse componentsInCabalFile files >>= \case + results + | (problem : _) <- [p | Left p <- results] -> pure (Left problem) + | otherwise -> do + let found = concat [cs | Right cs <- results] + pure $ case filter (targetSelectsComponent target) found of + [] | Everything <- target -> Right [] + [] -> Left (NoSuchTarget (spellTarget target) (map spellComponent found)) + wanted -> Right wanted + +-- | How a component would have to be named to be asked for on its own. +spellComponent :: Component -> Text +spellComponent c = + componentPackage c + <> ":" + <> spellKind (componentKind c) + <> ":" + <> componentName c + +-- | How a build plan names this component. +-- +-- A plan writes a library as @lib@ and everything else as its kind and +-- name, which is not quite how a target is written: see 'spellComponent'. +componentInPlan :: Component -> PlanComponent +componentInPlan c = + PlanComponent + { pcPackage = componentPackage c, + pcName = case componentKind c of + Lib -> "lib" + kind -> spellKind kind <> ":" <> componentName c + } + +-- | Render 'Kind' the way it would be accepted on the command line. +spellKind :: Kind -> Text +spellKind = \case + Lib -> "lib" + Exe -> "exe" + Test -> "test" + Bench -> "bench" + +-- | A target, written the way it would have been given. +spellTarget :: Target -> Text +spellTarget = \case + Everything -> "all" + Called name -> name + Qualified package kind name -> + T.intercalate ":" (foldMap pure package <> [spellKind kind, name]) + +-- | Every Haskell file in a component, in a settled order. +filesOfComponent :: Component -> IO [FilePath] +filesOfComponent c = + sort . Set.toList . Set.fromList . map normalise . concat + <$> traverse (walk . (componentRoot c )) (componentDirs c) + where + walk directory = + quietly [] $ + doesDirectoryExist directory >>= \case + False -> pure [] + True -> do + entries <- listDirectory directory + concat <$> traverse (below directory) (sort entries) + below directory entry + | "." `isPrefixOf` entry = pure [] + | entry == "dist-newstyle" = pure [] + | otherwise = do + let path = directory entry + isDirectory <- quietly False (doesDirectoryExist path) + if isDirectory + then walk path + else pure [path | takeExtension path `elem` formattableFileExtensions] + +-- | Every Haskell file a set of components holds, each named once. +filesOfComponents :: [Component] -> IO [FilePath] +filesOfComponents components = + sort . Set.toList . Set.fromList . concat <$> traverse filesOfComponent components + +-- | The extensions a Haskell source file can have. +formattableFileExtensions :: [String] +formattableFileExtensions = [".hs", ".hs-boot", ".hsig"] + +-- | The @.cabal@ files the project is made of. +-- +-- A @cabal.project@ names them, possibly through globs; anything else means +-- the marker found by the walk upwards is itself the only package. +packageFilesOf :: ProjectRoot -> IO [FilePath] +packageFilesOf root = case prMarker root of + PackageFile named -> pure [prPath root named] + ProjectFile -> do + contents <- + quietly BS.empty (BS.readFile (prPath root "cabal.project")) + found <- + traverse + (packageToCabalFile (prPath root)) + (packagesInCabalProjectContents contents) + pure (Set.toList (Set.fromList (concat found))) + +-- | The entries of a @cabal.project@'s @packages@ field. +packagesInCabalProjectContents :: BS.ByteString -> [Text] +packagesInCabalProjectContents contents = case readFields contents of + Left _ -> [] + Right fields -> concatMap entries (packagesIn fields) + where + packagesIn = concatMap $ \case + Field (Name _ name) ls + | BS8.map toLower name == "packages" -> + [T.unwords [T.decodeUtf8Lenient value | FieldLine _ value <- ls]] + | otherwise -> [] + Section _ _ inner -> packagesIn inner + + entries = filter (not . T.null) . map T.strip . concatMap (T.split (== ',')) . T.words + +-- | Turn one entry of a @packages@ field into the @.cabal@ files it names. +packageToCabalFile :: FilePath -> Text -> IO [FilePath] +packageToCabalFile root entry = do + paths <- + packageGlobToCabalFiles + root + (map T.unpack (T.split (== '/') (T.dropWhile (== '.') stripped))) + concat <$> traverse asPackage paths + where + stripped = T.dropWhile (== '/') (T.strip entry) + asPackage path + | ".cabal" `isSuffixOf` path = do + there <- quietly False (doesFileExist path) + pure [path | there] + | otherwise = cabalFilesIn path + +-- | Resolve a path whose components may contain @*@. +packageGlobToCabalFiles :: FilePath -> [String] -> IO [FilePath] +packageGlobToCabalFiles here = \case + [] -> pure [here] + ("" : rest) -> packageGlobToCabalFiles here rest + ("." : rest) -> packageGlobToCabalFiles here rest + (component : rest) + | '*' `elem` component -> do + entries <- quietly [] (listDirectory here) + concat + <$> traverse + (\e -> packageGlobToCabalFiles (here e) rest) + (sort (filter (globMatching component) entries)) + | otherwise -> packageGlobToCabalFiles (here component) rest + +-- | Does a name match a pattern with @*@ in it? +globMatching :: String -> String -> Bool +globMatching pattern name = case break (== '*') pattern of + (before, []) -> before == name + (before, _ : after) -> + before `isPrefixOf` name + && after `isSuffixOf` drop (length before) name + +-- | The @.cabal@ files sitting directly in a directory. +cabalFilesIn :: FilePath -> IO [FilePath] +cabalFilesIn directory = quietly [] $ do + entries <- listDirectory directory + let named = sort (filter (".cabal" `isSuffixOf`) entries) + filterM doesFileExist (map (directory ) named) + +-- | Every component one @.cabal@ file declares. +componentsInCabalFile :: FilePath -> IO (Either TargetProblem [Component]) +componentsInCabalFile cabalFile = + attempted (BS.readFile cabalFile) >>= \case + Left why -> pure (Left (Unparseable cabalFile [why])) + Right bytes -> + case snd (runParseResult (parseGenericPackageDescription bytes)) of + Left (_, complaints) -> + pure (Left (Unparseable cabalFile (map said (NE.toList complaints)))) + where + said = T.pack . showPError cabalFile + Right described -> + pure (Right (declaredComponents (takeDirectory cabalFile) described)) + +-- | The components of a parsed @.cabal@ file, in the order declared. +declaredComponents :: FilePath -> GenericPackageDescription -> [Component] +declaredComponents root described = + concat + [ foldMap (pure . made Lib package . libBuildInfo . condTreeData) (condLibrary described), + [ made Lib (nameOf n) (libBuildInfo (condTreeData t)) + | (n, t) <- condSubLibraries described + ], + [ made Exe (nameOf n) (buildInfo (condTreeData t)) + | (n, t) <- condExecutables described + ], + [ made Test (nameOf n) (testBuildInfo (condTreeData t)) + | (n, t) <- condTestSuites described + ], + [ made Bench (nameOf n) (benchmarkBuildInfo (condTreeData t)) + | (n, t) <- condBenchmarks described + ] + ] + where + package = + T.pack (unPackageName (pkgName (package' described))) + package' = Distribution.PackageDescription.package . packageDescription + nameOf = T.pack . unUnqualComponentName + made kind name bi = + Component + { componentPackage = package, + componentKind = kind, + componentName = name, + componentRoot = root, + componentDirs = case map getSymbolicPath (hsSourceDirs bi) of + [] -> ["."] + ds -> ds + } diff --git a/src/Tilia/Utils.hs b/src/Tilia/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Tilia/Utils.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Miscellaneous utilities. +module Tilia.Utils + ( quietly, + attempted, + lineWidth, + indent, + wrapTo, + visibleLength, + ) +where + +import Control.Exception (SomeException, displayException, try) +import Data.Text (Text) +import Data.Text qualified as T + +-- | Run an action, falling back on the given value if it throws. +quietly :: a -> IO a -> IO a +quietly fallback action = + try action >>= \case + Left (_ :: SomeException) -> pure fallback + Right a -> pure a + +-- | Run an action, keeping what it threw rather than a fallback. +attempted :: IO a -> IO (Either Text a) +attempted action = + try action >>= \case + Left (e :: SomeException) -> pure (Left (T.pack (displayException e))) + Right a -> pure (Right a) + +-- | The widest line this program will print of its own accord. +lineWidth :: Int +lineWidth = 76 + +-- | Two spaces per level, which is what everything here is set in. +indent :: Int -> Text +indent level = T.replicate (2 * level) " " + +-- | Break text into lines that fit the room given, at spaces. +wrapTo :: Int -> Text -> [Text] +wrapTo room = concatMap (go . T.words) . T.lines + where + go [] = [] + go (w : ws) = let (line, rest) = fill w ws in line : go rest + fill line (w : ws) + | visibleLength line + 1 + visibleLength w <= room = fill (line <> " " <> w) ws + fill line ws = (line, ws) + +-- | How wide a piece of text is once printed. +visibleLength :: Text -> Int +visibleLength = go 0 + where + go !n t = case T.uncons t of + Nothing -> n + Just ('\ESC', rest) + | Just after <- T.stripPrefix "[" rest -> go n (T.drop 1 (T.dropWhile (/= 'm') after)) + Just (_, rest) -> go (n + 1) rest diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE LambdaCase #-} + +-- | Running the suite, or the share of it a run is for. +-- +-- On CI all tests are divided in two classes: those that exercise something +-- about the compiler and those that do not. The first group is run on every +-- compiler\/shard, the second group is split up between compilers\/shards. +-- +-- Set @TILIA_SHARD@ to @i/n@ — @1/3@, @2/3@, @3/3@ — to take the @i@th +-- share of @n@. Unset, which is what @cabal test@ gives you, runs +-- everything. +module Main (main) where + +import Data.Bits (xor) +import Data.Char (ord) +import Data.List (intercalate, isPrefixOf) +import Data.Word (Word64) +import Spec qualified +import System.Environment (lookupEnv) +import Test.Hspec.Runner (Config (..), Path, defaultConfig, hspecWith) +import Text.Read (readMaybe) + +main :: IO () +main = + shardFrom <$> lookupEnv "TILIA_SHARD" >>= \case + Everything -> Spec.main + Share i n -> + hspecWith defaultConfig {configFilterPredicate = Just (taking i n)} Spec.spec + +-- | Which share of the suite a run is for. +data Shard + = Everything + | -- | The @i@th share of @n@, counting from one. + Share Int Int + +-- | Read a share, or take the whole suite when nothing sensible is asked +-- for. Being wrong here runs too much rather than too little. +shardFrom :: Maybe String -> Shard +shardFrom = \case + Just asked + | (i, '/' : n) <- span (/= '/') asked, + Just i' <- readMaybe i, + Just n' <- readMaybe n, + n' > 0, + i' >= 1, + i' <= n' -> + Share i' n' + _ -> Everything + +-- | Which tests the @i@th share of @n@ takes: every one that leans on the +-- compiler, and its own share of the rest. +taking :: Int -> Int -> Path -> Bool +taking i n path = leansOnCompiler path || share path == i - 1 + where + share = fromIntegral . (`mod` fromIntegral n) . fingerprint . spell + +-- | A test's path, written out, so that a share is decided by what the test +-- is rather than by where it happens to fall in the order. +spell :: Path -> String +spell (groups, requirement) = intercalate "/" (groups <> [requirement]) + +-- | FNV-1a, so that a test lands in the same share on every machine and +-- every run, and adding one test does not move the others. +fingerprint :: String -> Word64 +fingerprint = foldl' step 14695981039346656037 + where + step h c = (h `xor` fromIntegral (ord c)) * 1099511628211 + +-- | Is this test one whose answer the compiler can change? +leansOnCompiler :: Path -> Bool +leansOnCompiler (groups, _) = case groups of + group : _ -> any (`isPrefixOf` group) compilerBound + [] -> False + +-- | The groups that ask the compiler, or its package database, or the plan +-- it solved, and could therefore fail on one compiler and pass on another. +compilerBound :: [String] +compilerBound = + [ "Tilia.Fixity.Dependencies", + "Tilia.Fixity.PackageDb", + "Tilia.Fixity.Plan" + ] diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} diff --git a/tests/Tilia/Comments/PlaceSpec.hs b/tests/Tilia/Comments/PlaceSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Comments/PlaceSpec.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Which region each comment is given to, and which side of it. +module Tilia.Comments.PlaceSpec (spec) where + +import Data.Text (Text) +import Test.Hspec +import Tilia.Comments (Comment (..), renderComment) +import Tilia.Comments.Place +import Tilia.Parser +import Tilia.Source (comments) +import Tilia.Span + +spec :: Spec +spec = do + describe "a comment written after code" $ do + it "goes to the region that ends where that code stops" $ + placedIn [foo, theOne] [] "foo = 1 -- note\n" + `shouldBe` [("-- note", Just (After, theOne))] + + it "goes to the nearest region before it when it ends its line" $ + placedIn [foo] [] "foo = 1 -- note\n" + `shouldBe` [("-- note", Just (After, foo))] + + it "is left to what follows when code follows it too" $ + placedIn [foo, lastOfLineOne] [] "foo = {- note -} 1\n" + `shouldBe` [("{- note -}", Just (Before, lastOfLineOne))] + + it "is taken back even so when it was written against a region" $ + placedIn [foo, upToTheEquals, lastOfLineOne] [] "foo = {- note -} 1\n" + `shouldBe` [("{- note -}", Just (After, upToTheEquals))] + + describe "choosing between the regions on a line" $ do + it "takes the one ending latest" $ + placedIn [foo, theOne] [] "foo = 1 -- note\n" + `shouldBe` [("-- note", Just (After, theOne))] + + it "takes the outermost of those ending together" $ + placedIn [theOne, wholeOfLineOne] [] "foo = 1 -- note\n" + `shouldBe` [("-- note", Just (After, wholeOfLineOne))] + + it "passes over one that has not ended when the comment begins" $ + placedIn [foo, pastTheComment] [] "foo = 1 -- note\n" + `shouldBe` [("-- note", Just (After, foo))] + + describe "a region the comment was not written inside" $ do + it "may not have it" $ + placedIn [foo, bar, rhsOfLineOne] [] "foo = 1 -- note\nbar = 2\n" + `shouldBe` [("-- note", Just (Before, bar))] + + it "may when the comment is inside it too" $ + placedIn [foo, bar] [] "foo = 1 -- note\nbar = 2\n" + `shouldBe` [("-- note", Just (After, foo))] + + describe "a fence" $ do + it "keeps a comment printed in place from crossing it" $ + placedIn [foo, bar] [rhsOfLineOne] "foo = 1 {- note -}\nbar = 2\n" + `shouldBe` [("{- note -}", Just (Before, bar))] + + it "leaves the same comment alone when there is no fence" $ + placedIn [foo, bar] [] "foo = 1 {- note -}\nbar = 2\n" + `shouldBe` [("{- note -}", Just (After, foo))] + + it "says nothing about a comment held back to the end of a line" $ + placedIn [foo, bar] [rhsOfLineOne] "foo = 1 -- note\nbar = 2\n" + `shouldBe` [("-- note", Just (After, foo))] + + describe "a comment carrying on a remark from the line above" $ do + it "goes where that remark went" $ + placedIn [operand, bar'] [] carriedOn + `shouldBe` [ ("-- said once", Just (After, operand)), + ("-- and again", Just (After, operand)) + ] + + it "does not when it is not lined up with that line" $ + placedIn [operand, bar'] [] indentedFurther + `shouldBe` [ ("-- said once", Just (After, operand)), + ("-- and again", Just (Before, bar')) + ] + + it "does not when that line ended in code" $ + placedIn [operand, bar'] [] nothingAbove + `shouldBe` [("-- and again", Just (Before, bar'))] + + it "does not when what follows lines up with it as well" $ + placedIn [operand, continuation] [] carriedOnThenMore + `shouldBe` [ ("-- said once", Just (After, operand)), + ("-- and again", Just (Before, continuation)) + ] + + describe "a comment with nothing written against it" $ do + it "goes above the region that starts first after it" $ + placedIn [bar, laterStill] [] "-- note\nbar = 2\n" + `shouldBe` [("-- note", Just (Before, bar))] + + it "goes above the outermost of those starting together" $ + placedIn [bar, wholeOfLineTwo] [] "-- note\nbar = 2\n" + `shouldBe` [("-- note", Just (Before, wholeOfLineTwo))] + + it "goes nowhere at all when nothing follows it" $ + placedIn [foo] [] "foo = 1\n-- note\n" + `shouldBe` [("-- note", Nothing)] + + describe "what a comment will look like" $ do + it "sits in the line before a region when code was written after it" $ + shapeOf Before (firstComment "foo = {- note -} 1\n") `shouldBe` InPlace + + it "ends the line before a region when it trailed something" $ + shapeOf Before (firstComment "foo = 1 -- note\n") `shouldBe` EndsTheLine + + it "takes lines of its own before a region otherwise" $ + shapeOf Before (firstComment "-- note\nfoo = 1\n") `shouldBe` OnItsOwnLines + + it "sits in the line after a region when it closes itself" $ + shapeOf After (firstComment "foo = 1 {- note -}\n") `shouldBe` InPlace + + it "is held back after a region when it is one line of dashes" $ + shapeOf After (firstComment "foo = 1 -- note\n") `shouldBe` HeldBack + + it "ends the line after a region when it runs over several" $ + shapeOf After (firstComment "foo = 1 {- one\ntwo -}\n") `shouldBe` EndsTheLine + +---------------------------------------------------------------------------- +-- The regions the snippets are placed against + +-- | @foo@, and the @1@ it is bound to, in @foo = 1@. +foo, theOne :: Span +foo = mkSpan (1, 1) (1, 4) +theOne = mkSpan (1, 7) (1, 8) + +-- | Everything on the first line, ending where @theOne@ does. +wholeOfLineOne :: Span +wholeOfLineOne = mkSpan (1, 1) (1, 8) + +-- | Up to and including the @=@ of @foo = {- note -} 1@, which is where the +-- code before that comment stops. +upToTheEquals :: Span +upToTheEquals = mkSpan (1, 5) (1, 6) + +-- | The @1@ at the end of @foo = {- note -} 1@. +lastOfLineOne :: Span +lastOfLineOne = mkSpan (1, 18) (1, 19) + +-- | A region that has not finished by the time the comment starts. +pastTheComment :: Span +pastTheComment = mkSpan (1, 1) (1, 16) + +-- | Everything after the @=@ of the first line, comment included. +-- +-- Wide enough to hold the comment and narrow enough to leave 'foo' outside +-- it, which is what it takes to keep the two apart. +rhsOfLineOne :: Span +rhsOfLineOne = mkSpan (1, 5) (1, 20) + +-- | @bar@ on the second line, and everything on that line. +bar, wholeOfLineTwo :: Span +bar = mkSpan (2, 1) (2, 4) +wholeOfLineTwo = mkSpan (2, 1) (2, 8) + +-- | A region further down than anything a test needs. +laterStill :: Span +laterStill = mkSpan (9, 1) (9, 4) + +-- | The @a + b@ of the snippets below, and the @bar@ under them. +operand, bar' :: Span +operand = mkSpan (2, 3) (2, 8) +bar' = mkSpan (4, 1) (4, 4) + +-- | The @+ c@ that carries the expression on, lined up with the comment. +continuation :: Span +continuation = mkSpan (4, 3) (4, 6) + +---------------------------------------------------------------------------- +-- The snippets that take more than one line + +carriedOn, indentedFurther, nothingAbove, carriedOnThenMore :: Text +carriedOn = + "foo =\n\ + \ a + b -- said once\n\ + \ -- and again\n\ + \bar = 2\n" +indentedFurther = + "foo =\n\ + \ a + b -- said once\n\ + \ -- and again\n\ + \bar = 2\n" +nothingAbove = + "foo =\n\ + \ a + b\n\ + \ -- and again\n\ + \bar = 2\n" +carriedOnThenMore = + "foo =\n\ + \ a + b -- said once\n\ + \ -- and again\n\ + \ + c\n" + +---------------------------------------------------------------------------- +-- Running the rules + +-- | Where each comment of a snippet was put, in the order they were +-- written. +-- +-- 'Nothing' is a comment nothing came for, which the printer writes after +-- the whole document. +placedIn :: + -- | The regions a comment may be given to + [Span] -> + -- | The boundaries a comment printed in place may not be carried across + [Span] -> + -- | A module for the comments to be read out of + Text -> + [(Text, Maybe (Position, Span))] +placedIn regions fences src = + [(renderComment c, lookup (commentSpan c) gathered) | c <- cs] + where + cs = commentsIn src + gathered = fst (foldl collect ([], placeComments regions fences cs) regions) + collect (found, placements) r = case takePlaced r placements of + (mine, rest) -> (found <> [(commentSpan c, (p, r)) | (p, c) <- mine], rest) + +firstComment :: Text -> Comment +firstComment src = case commentsIn src of + (c : _) -> c + [] -> error "the test input had no comments" + +commentsIn :: Text -> [Comment] +commentsIn src = case parseModule defaultParserConfig "test.hs" src of + Left _ -> error "the test input did not parse" + Right pm -> comments (pmSource pm) diff --git a/tests/Tilia/CommentsSpec.hs b/tests/Tilia/CommentsSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/CommentsSpec.hs @@ -0,0 +1,231 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Extraction of the comment stream from real source text, and the +-- normalizations applied on the way. +module Tilia.CommentsSpec (spec) where + +import Data.List.NonEmpty qualified as NE +import Data.Text (Text) +import Data.Text qualified as T +import Test.Hspec +import Tilia.Comments +import Tilia.Comments.Attach +import Tilia.Doc +import Tilia.Doc.Combinators +import Tilia.Parser +import Tilia.Source (comments) +import Tilia.Span + +spec :: Spec +spec = do + describe "extraction" $ do + it "finds a comment on its own line" $ + bodies "module M where\n-- a comment\nx = 1\n" + `shouldBe` [["-- a comment"]] + + it "finds several, in source order" $ + bodies "module M where\n-- one\nx = 1\n-- two\ny = 2\n" + `shouldBe` [["-- one"], ["-- two"]] + + it "finds a block comment and keeps its lines" $ + bodies "module M where\n{- one\n two -}\nx = 1\n" + `shouldBe` [["{- one", " two -}"]] + + it "reports no comments when there are none" $ + bodies "module M where\nx = 1\n" `shouldBe` [] + + describe "trailing" $ do + it "marks a comment that follows code on its line" $ + trailings "module M where\nx = 1 -- here\n" `shouldBe` [True] + it "does not mark one on a line of its own" $ + trailings "module M where\n-- here\nx = 1\n" `shouldBe` [False] + it "does not mark one indented on a line of its own" $ + trailings "module M where\nx =\n -- here\n 1\n" `shouldBe` [False] + + -- The lexer counts a tab as advancing to the next multiple of eight, so a + -- line holding one has more columns than characters. Everything here works + -- by cutting the source at a column the compiler reported, and cutting at + -- the wrong place is not a crash but a comment that quietly believes it + -- has nothing after it. + describe "lines indented with tabs" $ do + it "sees the code before a comment" $ + trailings "module M where\n\tx = 1 -- here\n" `shouldBe` [True] + + it "sees that a comment has the line to itself" $ + trailings "module M where\n\t-- here\n\tx = 1\n" `shouldBe` [False] + + it "sees the code after a block comment" $ + followeds "module M where\n\tx = f {- here -} 1\n" `shouldBe` [True] + + it "sees that nothing follows a block comment" $ + followeds "module M where\n\tx = f 1 {- here -}\n" `shouldBe` [False] + + it "takes the comment's text and no more" $ + bodies "module M where\n\tx = f {- here -} 1\n" `shouldBe` [["{- here -}"]] + + it "dedents a block comment by what precedes it" $ + bodies "module M where\n\t{- one\n\t two -}\nx = 1\n" + `shouldBe` [["{- one", " two -}"]] + + describe "normalization: space after dashes" $ do + it "adds a missing space" $ + bodies "module M where\n--tight\nx = 1\n" `shouldBe` [["-- tight"]] + it "leaves an existing space alone" $ + bodies "module M where\n-- loose\nx = 1\n" `shouldBe` [["-- loose"]] + it "leaves a divider alone" $ + bodies "module M where\n-------\nx = 1\n" `shouldBe` [["-------"]] + it "does not touch dashes inside a block comment" $ + bodies "module M where\n{--tight-}\nx = 1\n" `shouldBe` [["{--tight-}"]] + + describe "normalization: trailing whitespace" + $ it "strips it from every line" + $ bodies "module M where\n{- one \n two \n three -}\nx = 1\n" + `shouldBe` [["{- one", " two", " three -}"]] + + describe "normalization: dedent" $ do + it "drops the comment\'s own start column, not all indentation" $ + bodies "module M where\nx =\n {- one\n two\n three -}\n 1\n" + `shouldBe` [["{- one", " two", " three -}"]] + it "keeps relative indentation between continuation lines" $ + bodies "module M where\nx =\n {- one\n two\n three -}\n 1\n" + `shouldBe` [["{- one", " two", " three -}"]] + it "leaves an unindented comment alone" $ + bodies "module M where\n{- one\n two -}\nx = 1\n" + `shouldBe` [["{- one", " two -}"]] + + -- Widening is not part of extraction: whether a doc comment's trigger is + -- tidied or escaped depends on whether the syntax tree turned out to + -- carry it, which nothing here knows. So it is asked for. + describe "normalization: doc trigger" $ do + it "widens a tight trigger" $ + widened "module M where\n-- |Foo\nx = 1\n" `shouldBe` [["-- | Foo"]] + it "leaves an already spaced trigger alone" $ + widened "module M where\n-- | Foo\nx = 1\n" `shouldBe` [["-- | Foo"]] + it "widens a caret trigger" $ + widened "module M where\nx = 1\n-- ^Foo\n" `shouldBe` [["-- ^ Foo"]] + it "widens a section trigger, keeping its stars" $ + widened "module M where\n-- **Foo\nx = 1\n" `shouldBe` [["-- ** Foo"]] + it "leaves a named anchor alone" $ + widened "module M where\n-- $section\nx = 1\n" `shouldBe` [["-- $section"]] + it "leaves a trigger with nothing after it alone" $ + widened "module M where\n-- |\nx = 1\n" `shouldBe` [["-- |"]] + it "shifts continuation lines to match" $ + widened "module M where\n{-|Foo\n bar\n-}\nx = 1\n" + `shouldBe` [["{-| Foo", " bar", " -}"]] + it "does not widen an ordinary line comment" $ + widened "module M where\n-- x|y\nz = 1\n" `shouldBe` [["-- x|y"]] + + describe "pragmas" $ do + it "recognises one" $ + (commentPragma <$> commentsIn "{-# LANGUAGE CPP #-}\nmodule M where\nx = 1\n") + `shouldBe` [Just (Pragma "LANGUAGE" "CPP")] + it "upper-cases the name" $ + (fmap pragmaName . commentPragma <$> commentsIn "{-# language CPP #-}\nmodule M where\nx = 1\n") + `shouldBe` [Just "LANGUAGE"] + it "is not fooled by an ordinary block comment" $ + (commentPragma <$> commentsIn "module M where\n{- not a pragma -}\nx = 1\n") + `shouldBe` [Nothing] + it "reports the header boundary" $ + headerLine "{-# LANGUAGE CPP #-}\nmodule M where\nimport Data.List\nx = 1\n" + `shouldBe` Just 3 + it "reports no boundary for a module with only a header" $ + headerLine "{-# LANGUAGE CPP #-}\nmodule M where\n" `shouldBe` Nothing + + describe "what is deliberately not normalized" $ do + it "keeps blank lines inside a comment" $ + bodies "module M where\n{- one\n\n\n two -}\nx = 1\n" + `shouldBe` [["{- one", "", "", " two -}"]] + it "does not escape a Haddock trigger" $ + bodies "module M where\nx = 1\n\n-- | not attached to anything\n" + `shouldBe` [["-- | not attached to anything"]] + + describe "renderComment" + $ it "joins the lines back with newlines" + $ renderComment <$> commentsIn "module M where\n{- one\n two -}\nx = 1\n" + `shouldBe` ["{- one\n two -}"] + + describe "attachment" $ do + it "puts a comment before the node it precedes" $ + let c = one "module M where\n-- note\nx = 1\n" + d = located (mkSpan (3, 1) (3, 5)) (txt "x = 1") + in render (attachComments [c] d) `shouldBe` "-- note\nx = 1\n" + + it "keeps a trailing comment on the same line" $ + let c = one "module M where\nx = 1 -- note\n" + d = located (mkSpan (2, 1) (2, 6)) (txt "x = 1") + in render (attachComments [c] d) `shouldBe` "x = 1 -- note\n" + + it "descends into the node that contains the comment" $ + let c = one "module M where\nx =\n -- note\n 1\n" + inner = located (mkSpan (4, 3) (4, 4)) (txt "1") + d = located (mkSpan (2, 1) (4, 4)) (txt "x =" <> indent (hardBreak <> inner)) + in render (attachComments [c] d) `shouldBe` "x =\n -- note\n 1\n" + + it "appends a comment that follows every node rather than dropping it" $ + let c = one "module M where\nx = 1\n-- after\n" + d = located (mkSpan (2, 1) (2, 6)) (txt "x = 1") + in + -- The blank line is added: a comment after everything is about the + -- file rather than about the line it happens to follow. + render (attachComments [c] d) `shouldBe` "x = 1\n\n-- after\n" + + it "reaches inside a variant, whichever branch renders" $ + let c = one "module M where\nx = 1 -- note\n" + n = located (mkSpan (2, 1) (2, 6)) (txt "x = 1") + d = variant n (txt "(" <> n <> txt ")") + in ( countOf "-- note" (render (flat (attachComments [c] d))), + countOf "-- note" (render (broken (attachComments [c] d))) + ) + `shouldBe` (1, 1) + + it "places a comment inside an empty construct" $ + let c = one "module M where\nx = [ -- note\n ]\n" + d = + located (mkSpan (2, 5) (3, 4)) $ + txt "[" <> emptyAnchor (mkSpan (3, 4) (3, 4)) <> txt "]" + in render (attachComments [c] d) `shouldBe` "[ -- note\n]\n" + + it "emits every comment exactly once" $ + let cs = commentsIn "module M where\n-- a\nx = 1 -- b\n-- c\ny = 2\n" + d = located (mkSpan (3, 1) (5, 6)) (txt "code") + out = render (attachComments cs d) + in (length cs, countOf "-- a" out, countOf "-- b" out, countOf "-- c" out) + `shouldBe` (3, 1, 1, 1) + +---------------------------------------------------------------------------- +-- Helpers + +render :: Doc -> Text +render = printDoc defaultRenderOptions + +one :: Text -> Comment +one src = case commentsIn src of + (c : _) -> c + [] -> error "the test input had no comments" + +countOf :: Text -> Text -> Int +countOf needle = length . T.breakOnAll needle + +commentsIn :: Text -> [Comment] +commentsIn src = + case parseModule defaultParserConfig "test.hs" src of + Left _ -> error "the test input did not parse" + Right pm -> comments (pmSource pm) + +bodies :: Text -> [[Text]] +bodies = map (NE.toList . commentBody) . commentsIn + +-- | The bodies a doc comment comes out with once its trigger is tidied. +widened :: Text -> [[Text]] +widened = map (NE.toList . commentBody . widenTrigger) . commentsIn + +trailings :: Text -> [Bool] +trailings = map commentTrailing . commentsIn + +followeds :: Text -> [Bool] +followeds = map commentFollowed . commentsIn + +headerLine :: Text -> Maybe Int +headerLine src = case parseModule defaultParserConfig "test.hs" src of + Left _ -> error "the test input did not parse" + Right pm -> spanStartLine <$> pmHeaderEnd pm diff --git a/tests/Tilia/Corpus.hs b/tests/Tilia/Corpus.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Corpus.hs @@ -0,0 +1,1030 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Corpora of Haskell to run the formatter over. +module Tilia.Corpus + ( -- * Corpora + Corpus (..), + Source (..), + Reference (..), + Expectations (..), + Lists (..), + vendoredExamples, + ormoluExamples, + ghcTestSuite, + hackagePackages, + + -- * Obtaining one + Example (..), + obtain, + ) +where + +import Codec.Archive.Tar qualified as Tar +import Codec.Compression.GZip qualified as GZip +import Control.Exception (SomeException, try) +import Control.Monad (forM) +import Data.ByteString.Lazy qualified as BL +import Data.List (isPrefixOf, isSuffixOf, sort, stripPrefix) +import Data.Maybe (fromMaybe, listToMaybe, mapMaybe, maybeToList) +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import GHC.LanguageExtensions.Type (Extension) +import Network.HTTP.Client qualified as HTTP +import Network.HTTP.Req +import System.Directory + ( XdgDirectory (..), + createDirectoryIfMissing, + doesDirectoryExist, + doesFileExist, + getXdgDirectory, + listDirectory, + removePathForcibly, + renameDirectory, + renameFile, + ) +import System.Environment (lookupEnv) +import System.FilePath (splitDirectories, takeDirectory, ()) +import Tilia.Package (newPackageReader) + +---------------------------------------------------------------------------- +-- Corpora + +-- | Whether a corpus says what the formatted result should look like. +data Reference + = -- | It does not, so only the properties that hold of any input can be + -- checked. + NoReference + | -- | It does, in a file whose name is the input's with the given mark + -- put before the extension. + ReferenceMarked String + deriving (Eq, Show) + +-- | Where the examples of a corpus come from. +data Source + = -- | Fetched from the network and unpacked into a cache, once per + -- machine. + Fetched (Url 'Https, Option 'Https) FilePath + | -- | Hackage releases, each unpacked beside the others under one root. + HackageReleases [String] + | -- | Checked into this repository, so always at hand and never fetched. + Vendored FilePath + +-- | What a corpus says it expects of the formatter. +data Expectations + = -- | Named by hand, here. Every example not named is expected to format. + Listed Lists + | -- | Recorded in a file, one line per example, holding what each of them + -- does today. + Recorded FilePath + +-- | The exceptions a 'Listed' corpus makes, named in full. +data Lists = Lists + { -- | Examples to leave alone, named relative to the root of the corpus. + -- A name with no extension stands for a directory and takes everything + -- under it. + expectSkip :: [FilePath], + -- | Examples the formatter is supposed to refuse. + expectDeclined :: [FilePath] + } + +-- | Where a corpus comes from and what is in it. +data Corpus = Corpus + { -- | Used for the cache directory and in test names. + corpusName :: String, + -- | Where its examples come from. + corpusSource :: Source, + -- | Whether the corpus says what the formatted result should look like. + corpusReference :: Reference, + -- | What it expects the formatter to make of them. + corpusExpectations :: Expectations, + -- | Are these modules of the package around them? + -- + -- True for a corpus of releases, where a module is compiled with its + -- package's @default-extensions@ and does not parse without them. + corpusInPackages :: Bool + } + +-- | Our own examples. +vendoredExamples :: Corpus +vendoredExamples = + Corpus + { corpusName = "tilia", + corpusSource = Vendored ("corpora" "vendored"), + corpusReference = ReferenceMarked "-out", + corpusExpectations = + Listed + Lists + { expectSkip = [], + expectDeclined = + [ "other" "position-pragmas.hs", + "other" "cpp" "unbalanced.hs", + "other" "cpp" "define-in-a-quasiquote.hs" + ] + }, + corpusInPackages = False + } + +-- | Ormolu's examples. +ormoluExamples :: Corpus +ormoluExamples = + Corpus + { corpusName = "ormolu-0.9.0.0", + corpusSource = + Fetched + ( https "hackage.haskell.org" + /: "package" + /: "ormolu-0.9.0.0" + /: "ormolu-0.9.0.0.tar.gz", + mempty + ) + ("data" "examples"), + corpusReference = ReferenceMarked "-out", + corpusExpectations = + Listed Lists {expectSkip = ormoluSkip, expectDeclined = []}, + corpusInPackages = False + } + +-- | GHC's test suite. +ghcTestSuite :: Corpus +ghcTestSuite = + Corpus + { corpusName = "ghc-9.10.1-testsuite", + corpusSource = + Fetched + ( https "codeload.github.com" + /: "ghc" + /: "ghc" + /: "tar.gz" + /: "refs" + /: "tags" + /: "ghc-9.10.1-release", + mempty + ) + ("testsuite" "tests"), + corpusReference = NoReference, + corpusExpectations = + Listed + Lists + { expectSkip = + ["perf" "compiler" "parsing001.hs"] <> ghcUnreadable, + expectDeclined = ghcDeclined + }, + corpusInPackages = False + } + +-- | GHC test suite files the formatter is right to refuse. +ghcDeclined :: [FilePath] +ghcDeclined = + [ "ghci.debugger" "HappyTest.hs", + "parser" "should_compile" "ColumnPragma.hs", + "parser" "should_compile" "T7118.hs", + "perf" "compiler" "T20261.hs", + "perf" "compiler" "T5631.hs", + "programs" "joao-circular" "Funcs_Parser_Lazy.hs", + "quasiquotation" "T4150.hs" + ] + +-- | Packages from Hackage. +hackagePackages :: Corpus +hackagePackages = + Corpus + { corpusName = "hackage", + corpusSource = HackageReleases hackageReleases, + corpusReference = NoReference, + corpusExpectations = Recorded ("corpora" "hackage" "hackage.manifest"), + corpusInPackages = True + } + +hackageReleases :: [String] +hackageReleases = + [ "Agda-2.8.0", + "HUnit-1.6.2.0", + "QuickCheck-2.18.0.0", + "ShellCheck-0.11.0", + "adjunctions-4.4.4", + "aeson-2.3.1.0", + "ansi-terminal-1.1.5", + "async-2.2.6", + "attoparsec-0.14.4", + "aws-0.25.3", + "base64-bytestring-1.2.1.0", + "bifunctors-5.6.3", + "blaze-html-0.9.2.0", + "blaze-markup-0.8.3.0", + "brick-2.13", + "brittany-0.14.0.2", + "capability-0.5.0.1", + "cassava-0.5.5.0", + "comonad-5.0.10", + "conduit-1.3.6.1", + "contravariant-1.5.6", + "criterion-1.6.5.0", + "cryptonite-0.30", + "diagrams-core-1.5.1.2", + "distributed-process-0.7.8", + "dlist-1.0", + "esqueleto-3.6.0.3", + "exceptions-0.10.12", + "fay-0.24.2.0", + "free-5.2", + "hakyll-4.17.0.0", + "hashable-1.5.1.0", + "haxl-2.5.1.1", + "hedgehog-1.7", + "hledger-1.52.1", + "hlint-3.10", + "hspec-core-2.11.17", + "http-client-0.7.19", + "http-types-0.12.6", + "idris-1.3.4", + "intero-0.1.40", + "leksah-0.16.2.2", + "lens-5.3.6", + "megaparsec-9.8.1", + "microlens-0.5.0.0", + "mtl-2.3.2", + "optics-0.4.2.1", + "optparse-applicative-0.19.0.0", + "pandoc-3.10.2", + "pandoc-types-1.23.1.2", + "parsec3-1.0.1.8", + "parser-combinators-1.3.1", + "persistent-2.18.1.0", + "pipes-4.3.16", + "postgrest-9.0.1", + "profunctors-5.6.3", + "purescript-0.15.15", + "raaz-0.3.11", + "random-1.3.1", + "recursion-schemes-5.2.3", + "resourcet-1.3.0", + "retry-0.9.3.1", + "safe-exceptions-0.1.7.4", + "scientific-0.3.8.1", + "scotty-0.30", + "semigroupoids-6.0.2", + "servant-0.20.3.0", + "servant-server-0.20.3.0", + "shake-0.19.9", + "split-0.2.5", + "stack-9.9.9", + "statistics-0.16.5.0", + "stm-2.5.3.1", + "swagger2-2.9.1", + "tasty-1.5.4", + "tensorflow-0.2.0.1", + "text-2.1.4", + "th-abstraction-0.7.2.0", + "time-1.16.0.1", + "tls-2.4.3", + "transformers-0.6.3.0", + "typed-process-0.2.13.0", + "unliftio-0.2.25.1", + "unordered-containers-0.2.21", + "unpacked-containers-0", + "uuid-types-1.0.6.1", + "vector-0.13.2.0", + "vector-algorithms-0.9.1.0", + "wai-3.2.5", + "warp-3.4.15", + "xmonad-0.18.1", + "yesod-core-1.7.0.0" + ] + +-- | Ormolu examples we do not format the way Ormolu does. +ormoluSkip :: [FilePath] +ormoluSkip = + [ "other" "disabling", + "declaration" "value" "function" "required-type-arguments-2.hs", + "declaration" "data" "comment-in-empty-record.hs", + "import" "comment-inside-empty-import-list.hs", + "other" "comment-two-blocks.hs", + "other" "comment-glued-together.hs", + "other" "multiple-blank-line-comment.hs", + "declaration" "type" "parens-comments.hs", + "declaration" "value" "function" "parens-comments.hs", + "import" "comments-inside-imports.hs", + "import" "comment-between-merged-imports.hs", + "declaration" "data" "with-comment.hs", + "declaration" "data" "record-empty-haddock.hs", + "other" "empty-haddock.hs", + "declaration" "value" "function" "arrow" "proc-do-complex.hs", + "declaration" "value" "function" "comprehension" "transform-multi-line2.hs", + "declaration" "value" "function" "if-with-comment-next-to-keyword.hs", + "declaration" "value" "function" "operator-comments-2.hs", + "declaration" "value" "function" "record" "wildcard-comments-0.hs", + "declaration" "value" "function" "record" "wildcard-comments-1.hs", + "other" "pragma-comments-after.hs", + "declaration" "value" "function" "infix" "esqueleto-0.hs", + "declaration" "value" "function" "infix" "esqueleto-1.hs", + "declaration" "class" "default-signatures.hs", + "declaration" "type-families" "closed-type-family" "with-comments.hs", + "declaration" "deriving" "singleline.hs", + "declaration" "deriving" "multiline.hs", + "declaration" "deriving" "overlapping.hs", + "declaration" "warning" "warning-single-line.hs" + ] + <> ormoluUnreadable + +-- | Ormolu examples GHC's own parser cannot read. +ormoluUnreadable :: [FilePath] +ormoluUnreadable = + [ "declaration" "class" "type-operators3.hs", + "declaration" "data" "datatype-contexts.hs", + "declaration" "foreign" "foreign-import-multiline.hs", + "declaration" "value" "function" "application-1.hs", + "declaration" "value" "function" "application-2.hs", + "declaration" "value" "function" "arrow" "proc-cases.hs", + "declaration" "value" "function" "arrow" "proc-do-simple1.hs", + "declaration" "value" "function" "block-arguments.hs", + "declaration" "value" "function" "case-empty.hs", + "declaration" "value" "function" "do-single-line-lambda-case.hs", + "declaration" "value" "function" "if-multi-line.hs", + "declaration" "value" "function" "infix" "hanging.hs", + "declaration" "value" "function" "let-multi-line.hs", + "declaration" "value" "function" "let-single-line.hs", + "declaration" "value" "function" "negation.hs", + "declaration" "value" "function" "negative-literals.hs", + "declaration" "value" "function" "pattern" "or-patterns.hs", + "declaration" "value" "function" "type-applications.hs", + "other" "comment-before-hanging.hs", + "other" "cpp" "continuation.hs", + "other" "cpp" "cpp-and-imports.hs", + "other" "cpp" "lonely-hash.hs", + "other" "cpp" "separation-0a.hs", + "other" "cpp" "separation-0b.hs", + "other" "cpp" "separation-1a.hs", + "other" "cpp" "separation-1b.hs", + "other" "cpp" "separation-2a.hs", + "other" "cpp" "separation-2b.hs", + "other" "cpp" "shifted.hs", + "other" "cpp" "simple-import.hs", + "other" "necessary-brackets.hs" + ] + +-- | GHC test suite files GHC's own parser cannot read. +ghcUnreadable :: [FilePath] +ghcUnreadable = + [ "cabal" "sigcabal01" "p" "Map.hsig", + "driver" "dynamicToo" "dynamicToo005" "A005.hsig", + "annotations" "should_fail" "T19374b.hs", + "annotations" "should_fail" "T19374c.hs", + "annotations" "should_fail" "annfail13.hs", + "arrows" "should_fail" "T2111.hs", + "arrows" "should_fail" "arrowfail003.hs", + "cabal" "fileStatus.hs", + "codeGen" "should_run" "CheckBoundsOK.hs", + "codeGen" "should_run" "T10245.hs", + "codeGen" "should_run" "T12855.hs", + "codeGen" "should_run" "T2080.hs", + "codeGen" "should_run" "T7600.hs", + "codeGen" "should_run" "cas_int.hs", + "codeGen" "should_run" "cgrun044.hs", + "codeGen" "should_run" "cgrun071.hs", + "codeGen" "should_run" "cgrun072.hs", + "codeGen" "should_run" "cgrun075.hs", + "codeGen" "should_run" "cgrun076.hs", + "codeGen" "should_run" "cgrun077.hs", + "codeGen" "should_run" "cgrun079.hs", + "codeGen" "should_run" "cgrun080.hs", + "concurrent" "should_run" "T5611.hs", + "concurrent" "should_run" "T5611a.hs", + "concurrent" "should_run" "conc036.hs", + "concurrent" "should_run" "conc037.hs", + "concurrent" "should_run" "conc038.hs", + "concurrent" "should_run" "foreignInterruptible.hs", + "corelint" "T21115.hs", + "deSugar" "should_run" "T5742.hs", + "dependent" "should_fail" "RenamingStar.hs", + "dmdanal" "should_compile" "T9208.hs", + "driver" "FullGHCVersion.hs", + "driver" "T10869.hs", + "driver" "T10869A.hs", + "driver" "T10970.hs", + "driver" "T11763.hs", + "driver" "T12135.hs", + "driver" "T12674" "-T12674.hs", + "driver" "T12752pass.hs", + "driver" "T16167.hs", + "driver" "T16476a.hs", + "driver" "T16476b.hs", + "driver" "T16521" "A.hs", + "driver" "T17786.hs", + "driver" "T2464.hs", + "driver" "T3389.hs", + "driver" "T8526" "A.hs", + "driver" "bug1677" "Foo.hs", + "driver" "multipleHomeUnits" "c-file" "C.hs", + "driver" "multipleHomeUnits" "cpp-includes" "CPPIncludes.hs", + "driver" "multipleHomeUnits" "cpp-includes" "CPPIncludes_Down.hs", + "driver" "recomp011" "Main.hs", + "driver" "recomp021" "A.hs", + "driver" "should_fail" "T12752.hs", + "eyeball" "inline2.hs", + "ffi" "should_fail" "capi_wrapper.hs", + "ffi" "should_fail" "ccall_value.hs", + "ffi" "should_run" "T22159.hs", + "gadt" "records-fail1.hs", + "generics" "Uniplate" "GUniplate.hs", + "ghci.debugger" "mdo.hs", + "ghci.debugger" "scripts" "TupleN.hs", + "ghci.debugger" "scripts" "break015.hs", + "ghci.debugger" "scripts" "dynbrk005.hs", + "ghci" "prog009" "A3.hs", + "ghci" "prog013" "Bad.hs", + "ghci" "scripts" "ghci022.hs", + "ghci" "scripts" "ghci044a.hs", + "ghci" "should_run" "PackedDataCon" "ByteCode.hs", + "ghci" "should_run" "PackedDataCon" "Obj.hs", + "ghci" "should_run" "UnboxedTuples" "ByteCode.hs", + "ghci" "should_run" "UnboxedTuples" "Obj.hs", + "ghci" "should_run" "UnliftedDataTypeInterp" "ByteCode.hs", + "ghci" "should_run" "UnliftedDataTypeInterp" "Obj.hs", + "haddock" "should_compile_flag_haddock" "haddockA004.hs", + "haddock" "should_compile_flag_haddock" "haddockA011.hs", + "haddock" "should_compile_flag_haddock" "haddockA041.hs", + "haddock" "should_compile_noflag_haddock" "haddockC004.hs", + "haddock" "should_compile_noflag_haddock" "haddockC011.hs", + "haddock" "should_fail_flag_haddock" "haddockE003.hs", + "hiefile" "should_compile" "CPP.hs", + "hiefile" "should_compile" "T22416.hs", + "hiefile" "should_compile" "hie002.hs", + "indexed-types" "should_compile" "T12538.hs", + "javascript" "T23346.hs", + "lib" "integer" "IntegerConversionRules.hs", + "linear" "should_fail" "LinearNoExt.hs", + "linear" "should_fail" "LinearNoExtU.hs", + "linear" "should_fail" "T20083.hs", + "mdo" "should_compile" "mdo001.hs", + "mdo" "should_compile" "mdo002.hs", + "mdo" "should_compile" "mdo003.hs", + "mdo" "should_compile" "mdo004.hs", + "mdo" "should_compile" "mdo005.hs", + "mdo" "should_compile" "mdo006.hs", + "mdo" "should_fail" "mdofail001.hs", + "mdo" "should_fail" "mdofail002.hs", + "mdo" "should_fail" "mdofail003.hs", + "mdo" "should_fail" "mdofail004.hs", + "mdo" "should_fail" "mdofail005.hs", + "mdo" "should_fail" "mdofail006.hs", + "mdo" "should_run" "mdorun001.hs", + "mdo" "should_run" "mdorun002.hs", + "mdo" "should_run" "mdorun003.hs", + "mdo" "should_run" "mdorun005.hs", + "module" "Mod178_2.hs", + "module" "T11432.hs", + "module" "T11432a.hs", + "module" "T12026.hs", + "module" "mod183.hs", + "module" "mod69.hs", + "module" "mod70.hs", + "module" "mod76.hs", + "module" "mod89.hs", + "module" "mod98.hs", + "numeric" "should_run" "T12136.hs", + "numeric" "should_run" "T20291.hs", + "numeric" "should_run" "foundation.hs", + "parser" "should_compile" "T10582.hs", + "parser" "should_compile" "T15279.hs", + "parser" "should_compile" "read023.hs", + "parser" "should_compile" "read039.hs", + "parser" "should_compile" "read046.hs", + "parser" "should_compile" "read058.hs", + "parser" "should_fail" "ExportCommaComma.hs", + "parser" "should_fail" "InfixAppPatErr.hs", + "parser" "should_fail" "NoBlockArgumentsFail.hs", + "parser" "should_fail" "NoBlockArgumentsFail2.hs", + "parser" "should_fail" "NoBlockArgumentsFail3.hs", + "parser" "should_fail" "NoBlockArgumentsFailArrowCmds.hs", + "parser" "should_fail" "NoDoAndIfThenElse.hs", + "parser" "should_fail" "NoNumericUnderscores0.hs", + "parser" "should_fail" "NoNumericUnderscores1.hs", + "parser" "should_fail" "NoPatternSynonyms.hs", + "parser" "should_fail" "OpaqueParseFail1.hs", + "parser" "should_fail" "OpaqueParseFail2.hs", + "parser" "should_fail" "OpaqueParseFail3.hs", + "parser" "should_fail" "ParserNoLambdaCase.hs", + "parser" "should_fail" "ParserNoMultiWayIf.hs", + "parser" "should_fail" "ParserNoTH1.hs", + "parser" "should_fail" "ParserNoTH2.hs", + "parser" "should_fail" "RecordDotSyntaxFail0.hs", + "parser" "should_fail" "RecordDotSyntaxFail1.hs", + "parser" "should_fail" "RecordDotSyntaxFail2.hs", + "parser" "should_fail" "RecordDotSyntaxFail3.hs", + "parser" "should_fail" "RecordDotSyntaxFail4.hs", + "parser" "should_fail" "RecordDotSyntaxFail6.hs", + "parser" "should_fail" "RecordDotSyntaxFail7.hs", + "parser" "should_fail" "SuffixAtFail.hs", + "parser" "should_fail" "T10196Fail1.hs", + "parser" "should_fail" "T10196Fail2.hs", + "parser" "should_fail" "T10498a.hs", + "parser" "should_fail" "T10498b.hs", + "parser" "should_fail" "T12045d.hs", + "parser" "should_fail" "T12051.hs", + "parser" "should_fail" "T12429.hs", + "parser" "should_fail" "T12610.hs", + "parser" "should_fail" "T13260.hs", + "parser" "should_fail" "T1344a.hs", + "parser" "should_fail" "T1344b.hs", + "parser" "should_fail" "T1344c.hs", + "parser" "should_fail" "T13450.hs", + "parser" "should_fail" "T13450TH.hs", + "parser" "should_fail" "T15730.hs", + "parser" "should_fail" "T15730b.hs", + "parser" "should_fail" "T15849.hs", + "parser" "should_fail" "T16270.hs", + "parser" "should_fail" "T16270h.hs", + "parser" "should_fail" "T16999.hs", + "parser" "should_fail" "T17865.hs", + "parser" "should_fail" "T17879a.hs", + "parser" "should_fail" "T17879b.hs", + "parser" "should_fail" "T18251a.hs", + "parser" "should_fail" "T18251b.hs", + "parser" "should_fail" "T18251f.hs", + "parser" "should_fail" "T19504.hs", + "parser" "should_fail" "T19928.hs", + "parser" "should_fail" "T20609.hs", + "parser" "should_fail" "T20609a.hs", + "parser" "should_fail" "T20609b.hs", + "parser" "should_fail" "T20609c.hs", + "parser" "should_fail" "T20609d.hs", + "parser" "should_fail" "T21843a.hs", + "parser" "should_fail" "T21843b.hs", + "parser" "should_fail" "T21843c.hs", + "parser" "should_fail" "T21843d.hs", + "parser" "should_fail" "T21843e.hs", + "parser" "should_fail" "T21843f.hs", + "parser" "should_fail" "T22070.hs", + "parser" "should_fail" "T3095.hs", + "parser" "should_fail" "T3153.hs", + "parser" "should_fail" "T3751.hs", + "parser" "should_fail" "T3811.hs", + "parser" "should_fail" "T3811b.hs", + "parser" "should_fail" "T3811d.hs", + "parser" "should_fail" "T3811e.hs", + "parser" "should_fail" "T3811f.hs", + "parser" "should_fail" "T5425.hs", + "parser" "should_fail" "T8431.hs", + "parser" "should_fail" "T8501a.hs", + "parser" "should_fail" "T8501b.hs", + "parser" "should_fail" "T8506.hs", + "parser" "should_fail" "T9225.hs", + "parser" "should_fail" "T984.hs", + "parser" "should_fail" "cmdFail001.hs", + "parser" "should_fail" "cmdFail002.hs", + "parser" "should_fail" "cmdFail003.hs", + "parser" "should_fail" "cmdFail004.hs", + "parser" "should_fail" "cmdFail005.hs", + "parser" "should_fail" "cmdFail006.hs", + "parser" "should_fail" "cmdFail007.hs", + "parser" "should_fail" "cmdFail008.hs", + "parser" "should_fail" "cmdFail009.hs", + "parser" "should_fail" "patFail001.hs", + "parser" "should_fail" "patFail002.hs", + "parser" "should_fail" "patFail003.hs", + "parser" "should_fail" "patFail004.hs", + "parser" "should_fail" "patFail005.hs", + "parser" "should_fail" "patFail006.hs", + "parser" "should_fail" "patFail007.hs", + "parser" "should_fail" "patFail008.hs", + "parser" "should_fail" "patFail009.hs", + "parser" "should_fail" "position001.hs", + "parser" "should_fail" "position002.hs", + "parser" "should_fail" "proposal-229c.hs", + "parser" "should_fail" "readFail002.hs", + "parser" "should_fail" "readFail004.hs", + "parser" "should_fail" "readFail005.hs", + "parser" "should_fail" "readFail006.hs", + "parser" "should_fail" "readFail007.hs", + "parser" "should_fail" "readFail009.hs", + "parser" "should_fail" "readFail011.hs", + "parser" "should_fail" "readFail012.hs", + "parser" "should_fail" "readFail013.hs", + "parser" "should_fail" "readFail014.hs", + "parser" "should_fail" "readFail015.hs", + "parser" "should_fail" "readFail017.hs", + "parser" "should_fail" "readFail018.hs", + "parser" "should_fail" "readFail019.hs", + "parser" "should_fail" "readFail020.hs", + "parser" "should_fail" "readFail022.hs", + "parser" "should_fail" "readFail024.hs", + "parser" "should_fail" "readFail025.hs", + "parser" "should_fail" "readFail026.hs", + "parser" "should_fail" "readFail027.hs", + "parser" "should_fail" "readFail031.hs", + "parser" "should_fail" "readFail033.hs", + "parser" "should_fail" "readFail034.hs", + "parser" "should_fail" "readFail040.hs", + "parser" "should_fail" "readFail047.hs", + "parser" "should_fail" "readFailTraditionalRecords1.hs", + "parser" "should_fail" "readFailTraditionalRecords2.hs", + "parser" "should_fail" "readFailTraditionalRecords3.hs", + "parser" "should_fail" "strictnessDataCon_A.hs", + "parser" "should_fail" "strictnessDataCon_B.hs", + "parser" "should_fail" "typeopsDataCon_A.hs", + "parser" "should_fail" "typeopsDataCon_B.hs", + "parser" "should_fail" "typeops_A.hs", + "parser" "should_fail" "typeops_B.hs", + "parser" "should_fail" "typeops_C.hs", + "parser" "should_fail" "typeops_D.hs", + "parser" "should_fail" "unpack_before_opr.hs", + "parser" "should_fail" "unpack_empty_type.hs", + "parser" "unicode" "T10907.hs", + "parser" "unicode" "T1744.hs", + "parser" "unicode" "T18158b.hs", + "parser" "unicode" "T18225B.hs", + "parser" "unicode" "utf8_001.hs", + "parser" "unicode" "utf8_002.hs", + "parser" "unicode" "utf8_003.hs", + "parser" "unicode" "utf8_004.hs", + "parser" "unicode" "utf8_005.hs", + "parser" "unicode" "utf8_010.hs", + "parser" "unicode" "utf8_011.hs", + "parser" "unicode" "utf8_020.hs", + "parser" "unicode" "utf8_021.hs", + "parser" "unicode" "utf8_022.hs", + "parser" "unicode" "utf8_023.hs", + "partial-sigs" "should_compile" "T14217.hs", + "patsyn" "should_fail" "T10426.hs", + "patsyn" "should_fail" "export-syntax.hs", + "patsyn" "should_fail" "import-syntax.hs", + "perf" "compiler" "T12234.hs", + "perf" "compiler" "T14683.hs", + "perf" "compiler" "T18698" "T18698.hs", + "perf" "should_run" "T13623.hs", + "plugins" "T20803a.hs", + "plugins" "plugin-recomp" "Common.hs", + "primops" "should_run" "T4442.hs", + "primops" "should_run" "UnalignedAddrPrimOps.hs", + "printer" "Ppr010.hs", + "printer" "Ppr027.hs", + "profiling" "should_compile" "T19894" "Fold.hs", + "profiling" "should_compile" "T19894" "Operations.hs", + "profiling" "should_compile" "T19894" "Step.hs", + "profiling" "should_compile" "T19894" "StreamD.hs", + "profiling" "should_compile" "T19894" "StreamK.hs", + "profiling" "should_compile" "T19894" "Unfold.hs", + "profiling" "should_compile" "T19894" "inline.hs", + "profiling" "should_fail" "T17916.hs", + "profiling" "should_fail" "proffail001.hs", + "programs" "barton-mangler-bug" "Bug.hs", + "programs" "joao-circular" "Funcs_Lexer.hs", + "programs" "joao-circular" "LrcPrelude.hs", + "qualifieddo" "should_fail" "qdofail002.hs", + "qualifieddo" "should_fail" "qdofail005.hs", + "quasiquotation" "T5204.hs", + "quotes" "T20893.hs", + "quotes" "T3572.hs", + "quotes" "T4056.hs", + "quotes" "T4169.hs", + "quotes" "T4170.hs", + "quotes" "T8455.hs", + "quotes" "T8759a.hs", + "quotes" "T9824.hs", + "quotes" "TH_abstractFamily.hs", + "quotes" "TH_bracket1.hs", + "quotes" "TH_bracket2.hs", + "quotes" "TH_bracket3.hs", + "quotes" "TH_ppr1.hs", + "quotes" "TH_scope.hs", + "quotes" "TH_spliceViewPat" "A.hs", + "rename" "should_fail" "T12879.hs", + "rename" "should_fail" "T14907a.hs", + "rename" "should_fail" "T9032.hs", + "rename" "should_fail" "T9437.hs", + "rename" "should_fail" "rnfail016.hs", + "rename" "should_fail" "rnfail016a.hs", + "roles" "should_fail" "Roles7.hs", + "rts" "T12497.hs", + "rts" "linker" "T20494.hs", + "rts" "linker" "T5435.hs", + "rts" "stack002.hs", + "runghc" "T6132.hs", + "safeHaskell" "flags" "Flags01.hs", + "safeHaskell" "safeLanguage" "SafeLang18.hs", + "saks" "should_fail" "saks_fail007.hs", + "saks" "should_fail" "saks_fail024.hs", + "saks" "should_fail" "saks_fail025.hs", + "simplCore" "T9646" "Main.hs", + "simplCore" "T9646" "StrictPrim.hs", + "simplCore" "T9646" "Type.hs", + "simplCore" "should_compile" "T13658.hs", + "simplCore" "should_compile" "T21694.hs", + "simplCore" "should_compile" "T8832.hs", + "simplCore" "should_run" "T21575.hs", + "stage1" "T2632.hs", + "th" "T10279.hs", + "th" "T10638.hs", + "th" "T10819.hs", + "th" "T10891.hs", + "th" "T11484.hs", + "th" "T16180.hs", + "th" "T16326_TH.hs", + "th" "T16980a.hs", + "th" "T23309A.hs", + "th" "T23378A.hs", + "th" "T2817.hs", + "th" "T3177.hs", + "th" "T3177a.hs", + "th" "T4436.hs", + "th" "T5217.hs", + "th" "T6018th.hs", + "th" "T8807.hs", + "th" "T9209.hs", + "th" "TH_ExplicitForAllRules_a.hs", + "th" "TH_class1.hs", + "th" "TH_dataD1.hs", + "th" "TH_foreignCallingConventions.hs", + "th" "TH_implicitParams.hs", + "th" "TH_lookupName.hs", + "th" "TH_raiseErr1.hs", + "th" "TH_recover.hs", + "th" "TH_recursiveDo.hs", + "th" "TH_recursiveDoImport.hs", + "th" "TH_reifyDecl1.hs", + "th" "TH_reifyDecl2.hs", + "th" "TH_reifyExplicitForAllFams.hs", + "th" "TH_reifyInstances.hs", + "th" "TH_reifyLinear.hs", + "th" "TH_reifyLocalDefs.hs", + "th" "TH_reifyMkName.hs", + "th" "TH_repE2.hs", + "th" "TH_repGuard.hs", + "th" "TH_repGuardOutput.hs", + "th" "TH_repPatSig.hs", + "th" "TH_repPatSigTVar.hs", + "th" "TH_repPrim.hs", + "th" "TH_repPrim2.hs", + "th" "TH_repPrimOutput.hs", + "th" "TH_repPrimOutput2.hs", + "th" "TH_sections.hs", + "th" "TH_spliceD2.hs", + "th" "TH_spliceDecl1.hs", + "th" "TH_spliceDecl2.hs", + "th" "TH_spliceDecl3.hs", + "th" "TH_spliceE1.hs", + "th" "TH_spliceE3.hs", + "th" "TH_spliceE4.hs", + "th" "TH_spliceExpr1.hs", + "th" "TH_spliceGuard.hs", + "th" "TH_tf1.hs", + "th" "TH_tf3.hs", + "th" "TH_unresolvedInfix.hs", + "th" "TH_unresolvedInfix2.hs", + "typecheck" "should_compile" "FloatFDs.hs", + "typecheck" "should_compile" "tc134.hs", + "typecheck" "should_fail" "ExplicitSpecificity3.hs", + "typecheck" "should_fail" "ExplicitSpecificity8.hs", + "typecheck" "should_fail" "T13446.hs", + "typecheck" "should_fail" "T14761b.hs", + "typecheck" "should_fail" "T2126.hs", + "typecheck" "should_fail" "T3102.hs", + "typecheck" "should_fail" "T9634.hs", + "typecheck" "should_fail" "tcfail089.hs", + "typecheck" "should_run" "T1735.hs", + "typecheck" "should_run" "T1735_Help" "Main.hs", + "typecheck" "should_run" "T4809.hs", + "unboxedsums" "UnboxedSumsTH_Fail.hs", + "unboxedsums" "unboxedsums4.hs", + "warnings" "should_fail" "CaretDiagnostics2.hs", + "wcompat-warnings" "WCompatWarningsOff.hs", + "wcompat-warnings" "WCompatWarningsOn.hs", + "wcompat-warnings" "WCompatWarningsOnOff.hs" + ] + +---------------------------------------------------------------------------- +-- Obtaining one + +-- | One thing to format, and what it should come out as if that is known. +data Example = Example + { -- | Where the corpus puts it, relative to the corpus root, which is + -- what names the test: the absolute path runs through a cache directory + -- that differs on every machine. + exampleName :: FilePath, + -- | The file to format, as an absolute path on this machine. + exampleInput :: FilePath, + -- | The file holding what the corpus says formatting should produce, if + -- it says. 'Nothing' for a corpus that ships no expected outputs, and + -- for an example within one that happens to have none. + exampleReference :: Maybe FilePath, + -- | What the package around it puts in force, already resolved from its + -- @.cabal@ file. Empty for a corpus whose examples are not modules of a + -- package; see 'corpusInPackages'. + exampleExtensions :: [Extension] + } + deriving (Eq, Show) + +-- | Get a corpus, fetching and unpacking it if this machine does not have +-- it yet. +-- +-- Fetching happens once: an unpacked corpus is left in place and found +-- again, and a download interrupted half way leaves nothing behind to be +-- mistaken for a complete one. 'Left' is for the machine that cannot reach +-- the network rather than for a defect, and callers are expected to say so +-- and carry on rather than fail. A vendored corpus is already here and can +-- never fail this way. +obtain :: Corpus -> IO (Either Text [Example]) +obtain corpus = case corpusSource corpus of + Vendored dir -> Right <$> examplesIn corpus dir + Fetched url root -> do + home <- corpusCache + let unpacked = home corpusName corpus + createDirectoryIfMissing True home + fetch url (home corpusName corpus <> ".tar.gz") unpacked >>= \case + Left problem -> pure (Left problem) + Right () -> Right <$> examplesIn corpus (unpacked root) + HackageReleases releases -> do + home <- corpusCache + let root = home corpusName corpus + createDirectoryIfMissing True root + inTurn root releases >>= \case + Left problem -> pure (Left problem) + Right () -> Right <$> examplesIn corpus root + where + inTurn _ [] = pure (Right ()) + inTurn root (name : rest) = + fetch (hackage name) (root name <> ".tar.gz") (root name) >>= \case + Left problem -> pure (Left problem) + Right () -> inTurn root rest + +-- | Put an archive's contents where they are wanted, if they are not there. +-- +-- Fetching happens once and unpacking happens once, and either step already +-- done is skipped. +fetch :: (Url 'Https, Option 'Https) -> FilePath -> FilePath -> IO (Either Text ()) +fetch url archive unpacked = + doesDirectoryExist unpacked >>= \case + True -> pure (Right ()) + False -> do + have <- doesFileExist archive + got <- if have then pure (Right ()) else download url archive + either (pure . Left) (const (unpackTo archive unpacked)) got + +-- | Where Hackage keeps a release's sources. +hackage :: String -> (Url 'Https, Option 'Https) +hackage name = + ( https "hackage.haskell.org" + /: "package" + /: T.pack name + /: T.pack (name <> ".tar.gz"), + mempty + ) + +-- | Where corpora are kept. +-- +-- Beside the fixity cache, and for the same reason: it is data about the +-- outside world that is expensive to obtain and cheap to keep. +corpusCache :: IO FilePath +corpusCache = + lookupEnv "TILIA_CORPUS_DIR" >>= \case + Just dir -> pure dir + Nothing -> ( "corpus") <$> getXdgDirectory XdgCache "tilia" + +---------------------------------------------------------------------------- +-- Fetching + +-- | Fetch an archive. +-- +-- Written to a temporary name and moved into place. Anything that leaves a +-- partial file under the real name would be taken for a complete download +-- on the next run and never fetched again. +-- +-- 'Left' is for the machine that cannot reach the network rather than for a +-- defect, and callers are expected to say so and carry on. Only the fetch +-- is caught: a file that cannot be written is a fault worth hearing about. +download :: (Url 'Https, Option 'Https) -> FilePath -> IO (Either Text ()) +download (url, query) dest = + try get >>= \case + Left (e :: HttpException) -> pure (Left (explain e)) + Right bytes + | not (gzipped bytes) -> pure (Left "the answer was not an archive") + | otherwise -> do + BL.writeFile partial bytes + Right <$> renameFile partial dest + where + partial = dest <> ".part" + -- The two bytes every gzip stream opens with. + gzipped = (== [0x1f, 0x8b]) . BL.unpack . BL.take 2 + get = + runReq defaultHttpConfig $ + responseBody <$> req GET url NoReqBody lbsResponse query + explain = \case + VanillaHttpException (HTTP.HttpExceptionRequest _ reason) -> flatten reason + other -> flatten other + flatten :: (Show a) => a -> Text + flatten = T.take 200 . T.unwords . T.words . T.pack . show + +-- | Unpack the Haskell files of an archive, dropping its top-level +-- directory. +unpackTo :: FilePath -> FilePath -> IO (Either Text ()) +unpackTo archive dest = do + removePathForcibly staging + outcome <- quietly (Left "could not unpack") $ do + bytes <- BL.readFile archive + Tar.foldEntries write (pure ()) (const (pure ())) (Tar.read (GZip.decompress bytes)) + pure (Right ()) + case outcome of + Left problem -> do + removePathForcibly staging + pure (Left (problem <> " " <> T.pack archive)) + Right () -> do + there <- doesDirectoryExist staging + if there + then Right <$> renameDirectory staging dest + else pure (Left ("nothing to unpack in " <> T.pack archive)) + where + staging = dest <> ".part" + + write entry rest = do + case Tar.entryContent entry of + Tar.NormalFile content _ + | Just path <- beneathTop (Tar.entryPath entry), + any (`isSuffixOf` path) (".cabal" : haskellExtensions) -> do + createDirectoryIfMissing True (takeDirectory (staging path)) + BL.writeFile (staging path) content + _ -> pure () + rest + beneathTop path = case splitDirectories path of + (_ : rest@(_ : _)) | all safe rest -> Just (foldr1 () rest) + _ -> Nothing + safe part = part /= ".." && not ("/" `isPrefixOf` part) + +---------------------------------------------------------------------------- +-- Enumerating + +-- | Every example in an unpacked corpus, in a settled order. +examplesIn :: Corpus -> FilePath -> IO [Example] +examplesIn corpus root = do + found <- sort <$> haskellFilesIn root + reader <- packageReaderFor corpus + let present = Set.fromList found + files = filter (not . skipped) found + example f reference = Example (nameOf f) f reference <$> reader f + case corpusReference corpus of + NoReference -> traverse (`example` Nothing) files + ReferenceMarked mark -> + forM (filter (not . answerTo mark present) files) $ \f -> + if mark `isSuffixOf` stemOf f + then example f (Just f) + else do + let reference = stemOf f <> mark <> extensionOf f + there <- doesFileExist reference + example f (if there then Just reference else Nothing) + where + nameOf f = fromMaybe f (stripPrefix (root <> "/") f) + answerTo mark present f = case withoutSuffix mark (stemOf f) of + Just stem -> Set.member (stem <> extensionOf f) present + Nothing -> False + skipped f = any listed (nameOf f : maybeToList (inputFor (nameOf f))) + listed name = any covers skips + where + covers entry = entry == name || (entry <> "/") `isPrefixOf` name + skips = case corpusExpectations corpus of + Listed lists -> expectSkip lists + Recorded _ -> [] + inputFor name = case corpusReference corpus of + ReferenceMarked mark + | Just stem <- withoutSuffix mark (stemOf name) -> + Just (stem <> extensionOf name) + _ -> Nothing + withoutSuffix suffix name + | suffix `isSuffixOf` name = Just (take (length name - length suffix) name) + | otherwise = Nothing + stemOf f = + fromMaybe f (listToMaybe (mapMaybe (`withoutSuffix` f) haskellExtensions)) + extensionOf f = + fromMaybe "" (listToMaybe (filter (`isSuffixOf` f) haskellExtensions)) + +-- | What each of a corpus's examples has in force before its own pragmas. +packageReaderFor :: Corpus -> IO (FilePath -> IO [Extension]) +packageReaderFor corpus + | not (corpusInPackages corpus) = pure (const (pure [])) + | otherwise = do + reader <- newPackageReader + pure (fmap (either (const []) id) . reader) + +-- | The extensions an example may be written with. +haskellExtensions :: [String] +haskellExtensions = [".hs", ".hs-boot", ".hsig"] + +haskellFilesIn :: FilePath -> IO [FilePath] +haskellFilesIn dir = do + isDir <- doesDirectoryExist dir + if not isDir + then pure [dir | any (`isSuffixOf` dir) haskellExtensions] + else do + entries <- quietly [] (listDirectory dir) + concat <$> traverse (haskellFilesIn . (dir )) entries + +---------------------------------------------------------------------------- +-- Helpers + +quietly :: a -> IO a -> IO a +quietly fallback action = + try action >>= \case + Left (_ :: SomeException) -> pure fallback + Right a -> pure a diff --git a/tests/Tilia/Corpus/Manifest.hs b/tests/Tilia/Corpus/Manifest.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Corpus/Manifest.hs @@ -0,0 +1,183 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | What a corpus too large to argue about example by example is expected to +-- do. +module Tilia.Corpus.Manifest + ( -- * What an example does + Outcome (..), + outcomeName, + + -- * Records of it + Entry (..), + digestOf, + noDigest, + Manifest, + readManifest, + writeManifest, + writeReport, + accepting, + ) +where + +import Control.Exception (SomeException, try) +import Crypto.Hash.SHA256 qualified as SHA256 +import Data.ByteString.Base16 qualified as B16 +import Data.List (sortOn) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import Data.Text.IO qualified as T +import System.Directory (createDirectoryIfMissing) +import System.Environment (lookupEnv) +import System.FilePath (takeDirectory) + +---------------------------------------------------------------------------- +-- What an example does + +-- | What running the formatter over one example established, coarsely enough +-- to write down and compare. +data Outcome + = -- | Nothing was found wrong with it. + Formatted + | -- | Nothing was found wrong with it, and one of the things worth asking + -- went unasked because it could not be afforded. See + -- 'Tilia.CorpusSpec.checkCpp'. + PartlyChecked + | -- | The input is Haskell, and the formatter refuses to rewrite it. + Declined + | -- | GHC's own parser could not read it. Common in a corpus of real + -- releases, which carry files that are Haskell templates, files written + -- for compilers other than GHC, and files whose @CPP@ we do not expand. + DoesNotParse + | -- | The bytes are not UTF-8, so there was nothing to parse. + NotUtf8 + | -- | A property does not hold. The work list. + Broken + deriving (Eq, Ord, Show, Enum, Bounded) + +-- | What an outcome is called in a manifest. +outcomeName :: Outcome -> Text +outcomeName = \case + Formatted -> "formatted" + PartlyChecked -> "partly-checked" + Declined -> "declined" + DoesNotParse -> "does-not-parse" + NotUtf8 -> "not-utf8" + Broken -> "broken" + +-- | Reading one back, by the name it was written under. +outcomeNamed :: Text -> Maybe Outcome +outcomeNamed name = + lookup name [(outcomeName o, o) | o <- [minBound .. maxBound]] + +---------------------------------------------------------------------------- +-- Records of it + +-- | What one example did, and what it produced. +data Entry = Entry + { -- | Expected outcome + entryOutcome :: Outcome, + -- | A digest of what the formatter wrote, or 'noDigest' where it wrote + -- nothing. + entryDigest :: Text + } + deriving (Eq, Show) + +-- | A short digest of an example's output. +digestOf :: Text -> Text +digestOf = T.take 12 . T.decodeUtf8 . B16.encode . SHA256.hash . T.encodeUtf8 + +-- | What stands in the digest's place where the formatter wrote nothing. +noDigest :: Text +noDigest = "-" + +type Manifest = Map FilePath Entry + +-- | Read a manifest. +-- +-- A missing one is an empty one rather than an error, so that a corpus added +-- to this repository before its manifest has been generated says which +-- examples it does not know about, one line each, instead of failing once +-- with a message about a file. +readManifest :: FilePath -> IO Manifest +readManifest path = + try (T.readFile path) >>= \case + Left (_ :: SomeException) -> pure Map.empty + Right text -> pure (Map.fromList (concatMap entry (T.lines text))) + where + entry line = case T.words line of + (what : digest : rest) + | not ("#" `T.isPrefixOf` what), + Just outcome <- outcomeNamed what, + not (null rest) -> + [(T.unpack (T.unwords rest), Entry outcome digest)] + _ -> [] + +-- | Write a manifest, sorted by name so that a regeneration diff shows what +-- changed rather than what moved. +writeManifest :: FilePath -> Manifest -> IO () +writeManifest path manifest = do + createDirectoryIfMissing True (takeDirectory path) + T.writeFile path (T.unlines (header <> map line (Map.toAscList manifest))) + where + header = + [ "# What each example of this corpus does today, one line each.", + "# Generated: run the test suite with TILIA_CORPUS_ACCEPT=1.", + "# See Tilia.Corpus.Manifest for what the outcomes mean, and the", + "# matching .report for why each example that is not `formatted` is", + "# not.", + "" + ] + line (name, entry) = + T.justifyLeft width ' ' (outcomeName (entryOutcome entry)) + <> T.justifyLeft 14 ' ' (entryDigest entry) + <> T.pack name + width = + 2 + maximum (1 : map (T.length . outcomeName . entryOutcome) (Map.elems manifest)) + +-- | Write the reasons beside the record. +writeReport :: FilePath -> [(FilePath, Outcome, Text)] -> IO () +writeReport path entries = do + createDirectoryIfMissing True (takeDirectory path) + T.writeFile path (T.unlines (header <> concatMap section grouped)) + where + interesting = [e | e@(_, outcome, _) <- entries, outcome /= Formatted] + grouped = + [ (outcome, [(name, why) | (name, o, why) <- sortOn first interesting, o == outcome]) + | outcome <- sections + ] + first (name, _, _) = name + sections = [Broken, DoesNotParse, PartlyChecked, Declined, NotUtf8] + header = + [ "Why every example of this corpus that is not `formatted` is not.", + "", + "Generated beside the manifest, and compared against nothing: this", + "file is the work list, and it is free to say as much as it likes.", + "", + T.pack (show (length entries)) + <> " examples, " + <> T.pack (show (length entries - length interesting)) + <> " formatted.", + "" + ] + section (_, []) = [] + section (outcome, es) = + [ T.replicate 74 "=", + outcomeName outcome <> " (" <> T.pack (show (length es)) <> ")", + T.replicate 74 "=", + "" + ] + <> concatMap entry es + entry (name, why) = + [T.pack name] <> map (" " <>) (T.lines (T.strip why)) <> [""] + +-- | Is this run supposed to write the records rather than check against +-- them? +accepting :: IO Bool +accepting = + lookupEnv "TILIA_CORPUS_ACCEPT" >>= \case + Just s | s `notElem` ["", "0", "no", "false"] -> pure True + _ -> pure False diff --git a/tests/Tilia/CorpusSpec.hs b/tests/Tilia/CorpusSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/CorpusSpec.hs @@ -0,0 +1,479 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Formatting other people's Haskell. +module Tilia.CorpusSpec (spec) where + +import Control.Exception (SomeException, evaluate, try) +import Control.Monad (join, unless) +import Data.ByteString qualified as BS +import Data.Foldable (for_) +import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding (decodeUtf8') +import GHC.LanguageExtensions.Type (Extension) +import System.FilePath (replaceExtension) +import Test.Hspec hiding (Example, after, before, example) +import Tilia.Corpus +import Tilia.Corpus.Manifest +import Tilia.Cpp + ( answeredLeaves, + answeredLinearLeaves, + blankCpp, + countLeaves, + describeCppError, + formatWithCpp, + usesCpp, + ) +import Tilia.Diff (diff) +import Tilia.Doc (defaultRenderOptions, printDoc) +import Tilia.Equivalence (commentDifference, syntaxDifference) +import Tilia.Palette (Palette, paletteFor) +import Tilia.Parser + ( ParseError (..), + ParsedModule (..), + ParserConfig, + parseModule, + parserConfigFor, + ) +import Tilia.Pragma (effectiveExtensions, movesPositions) +import Tilia.Render (RenderConfig, defaultRenderConfig, renderModule) +import Tilia.Source (comments) +import Tilia.Span (spanStartColumn, spanStartLine) +import Tilia.Span.Ghc (spanOfSrcSpan) +import Tilia.TestConfig (exampleRenderConfig) + +spec :: Spec +spec = do + corpusSpec vendoredExamples + corpusSpec ormoluExamples + corpusSpec ghcTestSuite + corpusSpec hackagePackages + +-- | Every example of one corpus. +corpusSpec :: Corpus -> Spec +corpusSpec corpus = + describe (corpusName corpus) $ + runIO (obtain corpus) >>= \case + Left problem -> + it "is available" . pendingWith $ + "corpus not on this machine and could not be fetched: " <> T.unpack problem + Right examples -> do + palette <- runIO paletteFor + let run = check palette + case corpusExpectations corpus of + Listed lists -> againstLists lists run examples + Recorded path -> againstRecord path run examples + +-- | A corpus small enough to name its exceptions in "Tilia.Corpus". +againstLists :: Lists -> (Example -> IO Result) -> [Example] -> Spec +againstLists listed run examples = + parallel $ for_ examples $ \example -> + it (exampleName example) $ do + result <- run example + case verdict (Set.member (exampleName example) declines) result of + Passes -> pure () + Fails why -> expectationFailure (T.unpack why) + Reserved why -> pendingWith (T.unpack why) + where + declines = Set.fromList (expectDeclined listed) + +-- | A corpus checked against a generated record of what it does. +againstRecord :: FilePath -> (Example -> IO Result) -> [Example] -> Spec +againstRecord path run examples = do + accept <- runIO accepting + if accept then accepted else checked + where + reportPath = replaceExtension path ".report" + + accepted = do + seen <- runIO (newIORef []) + afterAll_ (record seen) $ + parallel $ + for_ examples $ \example -> + it (exampleName example) $ do + Result outcome why digest <- run example + note seen (exampleName example, Entry outcome digest, T.take reasonLength why) + + record seen = do + noted <- readIORef seen + if length noted /= length examples + then + putStrLn $ + "not writing " + <> path + <> ": " + <> show (length noted) + <> " of " + <> show (length examples) + <> " examples ran, so this run does not know what the rest do." + <> " Regenerate without --match." + else do + writeManifest path (Map.fromList [(n, e) | (n, e, _) <- noted]) + writeReport reportPath [(n, entryOutcome e, w) | (n, e, w) <- noted] + + note :: IORef [a] -> a -> IO () + note seen entry = atomicModifyIORef' seen (\es -> (entry : es, ())) + + checked = do + manifest <- runIO (readManifest path) + parallel $ for_ examples $ \example -> + it (exampleName example) $ do + Result outcome why digest <- run example + case Map.lookup (exampleName example) manifest of + Nothing -> expectationFailure (T.unpack (unrecorded outcome)) + Just expected + | entryOutcome expected /= outcome -> + expectationFailure (T.unpack (moved (entryOutcome expected) outcome why)) + | entryDigest expected /= digest -> + expectationFailure (T.unpack (rewritten (entryDigest expected) digest)) + | otherwise -> case outcome of + Formatted -> pure () + Declined -> pure () + DoesNotParse -> pure () + NotUtf8 -> pure () + PartlyChecked -> pendingWith (T.unpack why) + Broken -> pendingWith (T.unpack (T.take reasonLength why)) + it "records nothing it does not have" $ do + let had = Set.fromList (map exampleName examples) + gone = [n | n <- Map.keys manifest, not (Set.member n had)] + unless (null gone) . expectationFailure $ + show (length gone) + <> " entries name examples this corpus does not have, starting with " + <> unwords (take 5 gone) + <> regenerate + + unrecorded outcome = + "this is not in " + <> T.pack path + <> ", and it " + <> outcomeName outcome + <> T.pack regenerate + + rewritten was now = + T.pack path + <> " says this comes out as " + <> was + <> ", and it comes out as " + <> now + <> T.pack regenerate + + moved expected outcome why = + T.pack path + <> " says this " + <> outcomeName expected + <> ", and it " + <> outcomeName outcome + <> (if T.null why then "" else ": " <> why) + <> T.pack regenerate + + regenerate = + "\n\nIf that is the intended change, regenerate the record:" + <> "\n TILIA_CORPUS_ACCEPT=1 cabal test" + +-- | How much of an example's reason a record keeps. +reasonLength :: Int +reasonLength = 2000 + +---------------------------------------------------------------------------- +-- Checking one example + +-- | What running the formatter over one example established, and why. +data Result = Result + { -- | The outcome. + resultOutcome :: Outcome, + -- | Explanation in text. + resultWhy :: Text, + -- | A digest of what the formatter wrote, or + -- 'Tilia.Corpus.Manifest.noDigest' where it wrote nothing. + resultDigest :: Text + } + +-- | What the runner should do about what one example produced. +data Verdict + = -- | Nothing to report. + Passes + | -- | Something is wrong, and this is what. + Fails Text + | -- | Neither: everything that was asked of it held, and something worth + -- asking went unasked. Reported rather than passed over, so that the + -- number of examples whose properties were only partly established is + -- visible in the summary instead of implied by its absence. + Reserved Text + +-- | What is to be said about what one example produced. +verdict :: + -- | Does the corpus say this one should be declined? + Bool -> + Result -> + Verdict +verdict declines (Result outcome why _) = case outcome of + Broken -> Fails why + NotUtf8 -> Fails (unlisted "is not UTF-8") + DoesNotParse -> Fails (unlisted ("does not parse, at " <> why)) + Declined + | declines -> Passes + | otherwise -> Fails "the formatter declined this, and the corpus does not say it should" + PartlyChecked + | declines -> Fails wasNotDeclined + | otherwise -> Reserved why + Formatted + | declines -> Fails wasNotDeclined + | otherwise -> Passes + where + wasNotDeclined = "the corpus says this should be declined, and it was not" + unlisted what = + "this " <> what <> ", and the corpus does not list it under expectSkip" + +check :: Palette -> Example -> IO Result +check palette example = do + source <- readUtf8 (exampleInput example) + expected <- traverse readUtf8 (exampleReference example) + case source of + Nothing -> pure (Result NotUtf8 "" noDigest) + Just text -> + guarded (checkPure palette (exampleName example) (exampleExtensions example) text (join expected)) + +-- | Read a file that is supposed to be a Haskell module. +readUtf8 :: FilePath -> IO (Maybe Text) +readUtf8 path = either (const Nothing) Just . decodeUtf8' <$> BS.readFile path + +-- | Run a check, turning a crash into a failure rather than into a dead test +-- run. +guarded :: Result -> IO Result +guarded result = + try (evaluate (forced result)) >>= \case + Left (e :: SomeException) -> + pure (Result Broken ("the formatter raised an error: " <> firstLine (T.pack (show e))) noDigest) + Right settled -> pure settled + where + forced r = + resultOutcome r + `seq` T.length (resultWhy r) + `seq` T.length (resultDigest r) + `seq` r + firstLine = T.strip . T.takeWhile (/= '\n') + +-- | Everything that can be established about one example without doing any +-- more input or output. +checkPure :: Palette -> FilePath -> [Extension] -> Text -> Maybe Text -> Result +checkPure palette path package source expected + | movesPositions source = + Result Declined "a pragma that moves positions, which we do not rewrite" noDigest + | usesCpp inForce source = checkCpp palette path package source expected + | otherwise = case parseModule config path source of + Left problem -> Result DoesNotParse (parseProblem problem) noDigest + Right before -> + let formatted = render before + against name = diff palette ("input", name) source formatted + in case parse formatted of + Nothing -> + told + formatted + Broken + ( "the formatted output does not parse\n" + <> against "output (does not parse)" + ) + Just after + | Just difference <- syntaxDifference (pmModule before) (pmModule after) -> + told + formatted + Broken + ( "a different program: " + <> difference + <> "\n" + <> against "output" + ) + | Just difference <- + commentDifference + (pmModule before, pmModule after) + (comments (pmSource before)) + (comments (pmSource after)) -> + told + formatted + Broken + ( "comments: " + <> difference + <> "\n" + <> against "output" + ) + | settled <- render after, + settled /= formatted -> + told + formatted + Broken + ( "formatting is non-idempotent\n" + <> diff palette ("first pass", "second pass") formatted settled + ) + | Just reference <- expected, + reference /= formatted -> + told + formatted + Broken + ( "does not match the corpus's expected output\n" + <> diff palette ("expected", "ours") reference formatted + ) + | otherwise -> told formatted Formatted "" + where + told formatted outcome why = Result outcome why (digestOf formatted) + config = parserConfigFor package + inForce = effectiveExtensions package source + parse = either (const Nothing) Just . parseModule config path + render parsed = + printDoc + defaultRenderOptions + (renderModule (exampleRenderConfig package source (pmModule parsed)) parsed) + +---------------------------------------------------------------------------- +-- Checking an example that involved the preprocessor + +-- | Everything that can be established about an example with conditionals in +-- it. +checkCpp :: Palette -> FilePath -> [Extension] -> Text -> Maybe Text -> Result +checkCpp palette path package source expected = case formatWithCpp parser render path source of + Left why -> Result Declined (describeCppError why) noDigest + Right formatted -> case (countLeaves source, countLeaves formatted) of + (Left why, _) -> + told formatted Broken ("the input's configurations: " <> describeCppError why) + (_, Left why) -> + told formatted Broken ("the output's configurations: " <> describeCppError why <> "\n" <> against formatted) + (Right went, Right came) + | went /= came -> + told + formatted + Broken + ( "formatting changed how many configurations there are, from " + <> count went + <> " to " + <> count came + <> "\n" + <> against formatted + ) + | went <= configurationsToCheck -> quantified answeredLeaves Nothing formatted + | otherwise -> + quantified + answeredLinearLeaves + ( Just + ( count went + <> " configurations is more than the " + <> count configurationsToCheck + <> " this checks, so only the ones varying a single" + <> " conditional were compared" + ) + ) + formatted + where + told formatted outcome why = Result outcome why (digestOf formatted) + count :: Integer -> Text + count = T.pack . show + against formatted = diff palette ("input", "output") source formatted + quantified enumerate reservation formatted = + case (enumerate source, enumerate formatted) of + (Left why, _) -> + told formatted Broken ("the input's configurations: " <> describeCppError why) + (_, Left why) -> + told formatted Broken ("the output's configurations: " <> describeCppError why <> "\n" <> against formatted) + (Right went, Right came) + | (why : _) <- alongside went came -> + told formatted Broken (why <> "\n" <> against formatted) + | otherwise -> case formatWithCpp parser render path formatted of + Left why -> + told formatted Broken ("the output cannot be formatted again: " <> describeCppError why) + Right settled + | settled /= formatted -> + told + formatted + Broken + ( "formatting is non-idempotent\n" + <> diff palette ("first pass", "second pass") formatted settled + ) + | Just reference <- expected, + reference /= formatted -> + told + formatted + Broken + ( "does not match the corpus's expected output\n" + <> diff palette ("expected", "ours") reference formatted + ) + | otherwise -> + maybe (told formatted Formatted "") (told formatted PartlyChecked) reservation + alongside went came = + [ why + | (answers, before) <- went, + why <- case Map.lookup answers output of + Nothing -> ["a configuration of the input the output does not have"] + Just after -> maybe [] pure (sameProgram before after) + ] + <> [ "a configuration of the output the input does not have" + | any (\(answers, _) -> not (Map.member answers input)) came + ] + where + output = Map.fromList came + input = Map.fromList went + + sameProgram went came = case (parse went, parse came) of + (Left problem, _) -> + Just ("a configuration of the input does not parse: " <> parseProblem problem) + (_, Left problem) -> + Just + ( "a configuration of the output does not parse: " + <> parseProblem problem + <> "\n" + <> linesAround came problem + ) + (Right before, Right after) + | Just difference <- syntaxDifference (pmModule before) (pmModule after) -> + Just ("a different program, in one configuration: " <> difference) + | Just difference <- + commentDifference + (pmModule before, pmModule after) + (comments (pmSource before)) + (comments (pmSource after)) -> + Just ("comments, in one configuration: " <> difference) + | otherwise -> Nothing + + parse = parseModule parser path + + parser = parserConfigFor package + render = renderConfigFor parser path package source + +-- | Why a parse failed, and where in the file, but not which file. +-- +-- The example being reported already names it, and 'describeParseError' +-- opens with the path in full. +parseProblem :: ParseError -> Text +parseProblem problem = at <> peProblem problem + where + at = case spanOfSrcSpan (peSpan problem) of + Nothing -> T.empty + Just s -> + T.pack (show (spanStartLine s)) + <> ":" + <> T.pack (show (spanStartColumn s)) + <> ": " + +-- | The lines of a configuration around the one a parse error names. +linesAround :: Text -> ParseError -> Text +linesAround text problem = case spanStartLine <$> spanOfSrcSpan (peSpan problem) of + Nothing -> T.empty + Just line -> + T.unlines + [ (if n == line then "> " else " ") <> T.pack (show n) <> " " <> l + | (n, l) <- zip [1 :: Int ..] (T.lines text), + abs (n - line) <= 4 + ] + +-- | How many configurations one example gets compared over. +configurationsToCheck :: Integer +configurationsToCheck = 64 + +-- | What to print an example's configurations with. +renderConfigFor :: ParserConfig -> FilePath -> [Extension] -> Text -> RenderConfig +renderConfigFor parser path package source = + case parseModule parser path (blankCpp source) of + Right whole -> exampleRenderConfig package source (pmModule whole) + Left _ -> defaultRenderConfig diff --git a/tests/Tilia/Cpp/MacrosSpec.hs b/tests/Tilia/Cpp/MacrosSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Cpp/MacrosSpec.hs @@ -0,0 +1,223 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | What a build plan settles about a module's conditionals. +module Tilia.Cpp.MacrosSpec (spec) where + +import Data.Map.Strict qualified as Map +import Data.Text (Text) +import Data.Text qualified as T +import Test.Hspec +import Tilia.Cpp (withoutRuledOut) +import Tilia.Cpp.Macros + +-- | A plan with one dependency at 1.2.3 and a compiler at 9.10.3. +macros :: Macros +macros = + Macros + { macroVersions = + Map.fromList + [ ("MIN_VERSION_thing", [1, 2, 3]), + ("MIN_VERSION_GLASGOW_HASKELL", [9, 10, 3, 0]) + ], + macroNumbers = + Map.fromList + [ ("__GLASGOW_HASKELL__", 910), + ("__GLASGOW_HASKELL_PATCHLEVEL1__", 3), + ("__GLASGOW_HASKELL_PATCHLEVEL2__", 0) + ] + } + +-- | What this guard comes to, given the plan above. +answer :: Text -> Maybe Bool +answer = answerTo macros + +spec :: Spec +spec = do + describe "a guard about a version the plan fixed" $ do + it "is true where the plan is at least what it asks for" $ + map answer ["if MIN_VERSION_thing(1,2,3)", "if MIN_VERSION_thing(1,0,0)"] + `shouldBe` [Just True, Just True] + + it "is false where the plan is short of it" $ + map answer ["if MIN_VERSION_thing(1,2,4)", "if MIN_VERSION_thing(2,0,0)"] + `shouldBe` [Just False, Just False] + + it "compares the parts as numbers and not as text" $ + answer "if MIN_VERSION_thing(1,10,0)" `shouldBe` Just False + + it "pads the shorter side with zeros" $ + map answer ["if MIN_VERSION_thing(1,2)", "if MIN_VERSION_thing(1,2,3,1)"] + `shouldBe` [Just True, Just False] + + it "says nothing about a package the plan does not name" $ + answer "if MIN_VERSION_other(1,0,0)" `shouldBe` Nothing + + describe "a guard about the compiler" $ do + it "reads its version as the compiler spells it" $ + map answer ["if __GLASGOW_HASKELL__ >= 902", "if __GLASGOW_HASKELL__ >= 912"] + `shouldBe` [Just True, Just False] + + it "takes the four-part macro apart the same way" $ + map + answer + [ "if MIN_VERSION_GLASGOW_HASKELL(9,10,1,0)", + "if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)", + "if MIN_VERSION_GLASGOW_HASKELL(9,12,1,0)" + ] + `shouldBe` [Just True, Just True, Just False] + + describe "an answer that needs more than one question settled" $ do + it "carries a false through a conjunction whatever else is in it" $ + answer "if defined(SOMETHING) && MIN_VERSION_thing(2,0,0)" + `shouldBe` Just False + + it "carries a true through a disjunction the same way" $ + answer "if defined(SOMETHING) || MIN_VERSION_thing(1,0,0)" + `shouldBe` Just True + + it "gives up where what is left over decides it" $ + map + answer + [ "if defined(SOMETHING) && MIN_VERSION_thing(1,0,0)", + "if defined(SOMETHING) || MIN_VERSION_thing(2,0,0)" + ] + `shouldBe` [Nothing, Nothing] + + it "answers a version test behind a defined of the same macro" $ + answer "if defined(MIN_VERSION_thing) && MIN_VERSION_thing(1,0,0)" + `shouldBe` Just True + + it "negates what it knows and nothing else" $ + map answer ["if !MIN_VERSION_thing(2,0,0)", "if !defined(SOMETHING)"] + `shouldBe` [Just True, Nothing] + + it "reads brackets" $ + answer "if (MIN_VERSION_thing(1,0,0) || defined(X)) && !MIN_VERSION_thing(9,0,0)" + `shouldBe` Just True + + describe "a guard that is not about a version at all" $ do + it "answers a bare number, which is how a branch is turned off" $ + map answer ["if 0", "if 1"] `shouldBe` [Just False, Just True] + + it "says nothing about a flag" $ + map answer ["ifdef FOO", "ifndef FOO", "if defined FOO"] + `shouldBe` [Nothing, Nothing, Nothing] + + it "says a macro it has a value for is defined" $ + map answer ["ifdef MIN_VERSION_thing", "ifndef MIN_VERSION_thing"] + `shouldBe` [Just True, Just False] + + it "says nothing about arithmetic, which it does not read" $ + answer "if __GLASGOW_HASKELL__ + 1 > 900" `shouldBe` Nothing + + it "says nothing about a guard whose keyword asks nothing" $ + map answer ["else", "endif", "define FOO 1"] + `shouldBe` [Nothing, Nothing, Nothing] + + describe "blanking the branches a plan rules out" $ do + it "leaves the taken branch and blanks the rest" $ + ruledOut + [ "#if MIN_VERSION_thing(1,0,0)", + "import New", + "#else", + "import Old", + "#endif" + ] + `shouldBe` ["", "import New", "", "", ""] + + it "takes the #else where the condition fails" $ + ruledOut + [ "#if MIN_VERSION_thing(2,0,0)", + "import New", + "#else", + "import Old", + "#endif" + ] + `shouldBe` ["", "", "", "import Old", ""] + + it "leaves nothing where the condition fails and there is no #else" $ + ruledOut + [ "#if MIN_VERSION_thing(2,0,0)", + "import New", + "#endif" + ] + `shouldBe` ["", "", ""] + + it "takes the first branch of an #elif chain that holds" $ + ruledOut + [ "#if MIN_VERSION_thing(2,0,0)", + "import Newest", + "#elif MIN_VERSION_thing(1,0,0)", + "import New", + "#else", + "import Old", + "#endif" + ] + `shouldBe` ["", "", "", "import New", "", "", ""] + + it "leaves a conditional it cannot answer exactly as it was" $ + ruledOut + [ "#ifdef FOO", + "import One", + "#else", + "import Two", + "#endif" + ] + `shouldBe` ["#ifdef FOO", "import One", "#else", "import Two", "#endif"] + + it "leaves a chain alone from the first question it cannot answer" $ + ruledOut + [ "#if defined(FOO)", + "import One", + "#elif MIN_VERSION_thing(1,0,0)", + "import Two", + "#endif" + ] + `shouldBe` ["#if defined(FOO)", "import One", "#elif MIN_VERSION_thing(1,0,0)", "import Two", "#endif"] + + it "leaves the branches before a question it cannot answer as well" $ + ruledOut + [ "#if MIN_VERSION_thing(2,0,0)", + "import One", + "#elif defined(FOO)", + "import Two", + "#endif" + ] + `shouldBe` [ "#if MIN_VERSION_thing(2,0,0)", + "import One", + "#elif defined(FOO)", + "import Two", + "#endif" + ] + + it "rules out a shim defining a macro the plan already has" $ + ruledOut + [ "#ifndef MIN_VERSION_thing", + "#define MIN_VERSION_thing(a,b,c) 1", + "#endif" + ] + `shouldBe` ["", "", ""] + + it "reaches a conditional nested inside the branch that is taken" $ + ruledOut + [ "#if MIN_VERSION_thing(1,0,0)", + "#if MIN_VERSION_thing(2,0,0)", + "import Newest", + "#else", + "import New", + "#endif", + "#endif" + ] + `shouldBe` ["", "", "", "", "import New", "", ""] + + it "keeps every line where it was written" $ + let source = T.unlines ["module M where", "#if MIN_VERSION_thing(2,0,0)", "x = 1", "#endif"] + in length (T.lines (withoutRuledOut macros source)) + `shouldBe` length (T.lines source) + + it "leaves a module with no conditionals in it alone" $ + withoutRuledOut macros "module M where\n" `shouldBe` "module M where\n" + +-- | The lines of a module once the plan has ruled out what it can. +ruledOut :: [Text] -> [Text] +ruledOut = T.lines . withoutRuledOut macros . T.unlines diff --git a/tests/Tilia/Cpp/PropertiesSpec.hs b/tests/Tilia/Cpp/PropertiesSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Cpp/PropertiesSpec.hs @@ -0,0 +1,208 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Properties that should hold of every module the preprocessor is +-- involved in. +module Tilia.Cpp.PropertiesSpec (spec) where + +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import Test.Hspec hiding (after, before) +import Test.Hspec.QuickCheck (modifyMaxSuccess) +import Test.QuickCheck +import Tilia.Cpp (answeredLeaves, formatWithCpp, withoutRuledOut) +import Tilia.Cpp.Macros (Macros (..)) +import Tilia.Equivalence (syntaxDifference) +import Tilia.Parser (defaultParserConfig, parseModule, pmModule) +import Tilia.Render (defaultRenderConfig) + +spec :: Spec +spec = modifyMaxSuccess (const 5000) $ + describe "a module the preprocessor runs over" $ do + xit "reaches its answer in one pass" $ + property $ \m -> formatted m $ \out -> + case format out of + Left why -> counterexample (T.unpack ("re-formatting refused: " <> why)) False + Right settled -> + counterexample (T.unpack (diffed out settled)) (settled == out) + + it "comes out parseable in every configuration" $ + property $ \m -> formatted m $ \out -> + case answeredLeaves out of + Left _ -> property Discard + Right configurations -> + conjoin + [ counterexample (T.unpack ("this configuration does not parse:\n" <> t)) (parses t) + | (_, t) <- configurations + ] + + it "is read as configurations it already had, once a plan rules some out" $ + property $ \m -> + let source = sourceOf m + in case (answeredLeaves source, answeredLeaves (withoutRuledOut macros source)) of + (Right went, Right came) -> + let had = Set.fromList (map snd went) + in conjoin $ + counterexample "nothing was left to read" (not (null came)) + : [ counterexample + (T.unpack ("not a configuration the module had:\n" <> t)) + (Set.member t had) + | (_, t) <- came + ] + _ -> property Discard + + xit "is the same program in every configuration it went in as" $ + property $ \m -> formatted m $ \out -> + case (answeredLeaves (sourceOf m), answeredLeaves out) of + (Right went, Right came) -> + conjoin + [ counterexample (T.unpack (T.unlines [before, "became", after, why])) False + | (answers, before) <- went, + Just after <- [lookup answers came], + Just why <- [difference before after] + ] + _ -> property Discard + +---------------------------------------------------------------------------- +-- Running the formatter + +-- | A plan that settles the version the generator asks about and nothing +-- else, so that a module comes out with some of its conditionals answered +-- and some of them left open. +macros :: Macros +macros = + Macros + { macroVersions = Map.fromList [("MIN_VERSION_thing", [1, 2, 3])], + macroNumbers = Map.empty + } + +format :: Text -> Either Text Text +format source = case formatWithCpp defaultParserConfig defaultRenderConfig "M.hs" source of + Left _ -> Left "declined" + Right out -> Right out + +-- | Whatever holds of a module the formatter did not decline. +-- +-- Declining is an answer the formatter is allowed to give—a @#include@ it +-- cannot expand, a module with more configurations than its budget—and says +-- nothing about the properties below, so those runs are thrown away rather +-- than counted as passes. +formatted :: (Testable p) => CppModule -> (Text -> p) -> Property +formatted m k = case format (sourceOf m) of + Left _ -> property Discard + Right out -> property (k out) + +parses :: Text -> Bool +parses t = case parseModule defaultParserConfig "M.hs" t of + Left _ -> False + Right _ -> True + +difference :: Text -> Text -> Maybe Text +difference before after = do + b <- either (const Nothing) Just (parseModule defaultParserConfig "M.hs" before) + a <- either (const Nothing) Just (parseModule defaultParserConfig "M.hs" after) + syntaxDifference (pmModule b) (pmModule a) + +diffed :: Text -> Text -> Text +diffed a b = T.unlines ["first pass:", a, "second pass:", b] + +---------------------------------------------------------------------------- +-- Generating a module + +-- | One line, or one run of lines, of a generated module. +data Item + = -- | A declaration, named after the number so that a counterexample can + -- be read. + Decl Int + | -- | A comment written on a line of its own. + Note Text + | -- | An empty line, which is the point of half of these properties. + Blank + | -- | A directive that introduces no configuration of its own—@#define@ + -- and the rest of what "Tilia.Cpp" calls opaque. + Opaque Text + | -- | A conditional, and what it holds either side of the @#else@. + Cond Text [Item] [Item] + deriving (Eq, Show) + +-- | A module that uses the preprocessor. +-- +-- Conditionals wrap whole items and nothing smaller, which is what keeps +-- every configuration of the module a module: a branch that took half a +-- declaration away would leave the other half behind. +newtype CppModule = CppModule [Item] + deriving (Eq) + +-- | Shown as the source, since that is what a counterexample is read as. +instance Show CppModule where + show m = T.unpack ("\n" <> sourceOf m) + +instance Arbitrary CppModule where + arbitrary = CppModule <$> sized (items 2) + shrink (CppModule xs) = CppModule <$> smaller xs + +-- | The items of a module, given how deep a conditional may still nest. +items :: Int -> Int -> Gen [Item] +items depth size' = do + n <- choose (1, max 1 (min 6 size')) + mapM (const (item depth)) [1 .. n :: Int] + +item :: Int -> Gen Item +item depth = + frequency $ + [ (4, Decl <$> choose (1, 9)), + (3, Note <$> elements ["-- a remark", "-- | documentation", "{- a block -}", "-- * a heading"]), + (3, pure Blank), + (1, Opaque <$> elements ["define WIDE 1", "error \"no\"", "undef WIDE"]) + ] + <> [(3, conditional depth) | depth > 0] + +conditional :: Int -> Gen Item +conditional depth = do + guard' <- + elements + [ "if FLAG", + "ifdef OTHER", + "if FLAG", + "if MIN_VERSION_thing(1,0,0)", + "if MIN_VERSION_thing(9,0,0)" + ] + yes <- items (depth - 1) 3 + no <- frequency [(1, pure []), (1, items (depth - 1) 2)] + pure (Cond guard' yes no) + +-- | Every way of making a module smaller: drop an item, or replace a +-- conditional by one of the branches it was holding. +smaller :: [Item] -> [[Item]] +smaller xs = + [take i xs <> drop (i + 1) xs | i <- positions] + <> [take i xs <> branch <> drop (i + 1) xs | (i, Cond _ a b) <- indexed, branch <- [a, b]] + <> [take i xs <> [x'] <> drop (i + 1) xs | (i, x) <- indexed, x' <- inside x] + where + positions = [0 .. length xs - 1] + indexed = zip positions xs + inside = \case + Cond g a b -> [Cond g a' b | a' <- smaller a] <> [Cond g a b' | b' <- smaller b] + _ -> [] + +-- | The module as it is written out. +sourceOf :: CppModule -> Text +sourceOf (CppModule xs) = + T.unlines (["{-# LANGUAGE CPP #-}", "", "module M where", ""] <> concatMap written xs) + +written :: Item -> [Text] +written = \case + Decl n -> ["f" <> tshow n <> " = " <> tshow n] + Note t -> [t] + Blank -> [""] + Opaque t -> ["#" <> t] + Cond g yes no -> + ["#" <> g] + <> concatMap written yes + <> (if null no then [] else "#else" : concatMap written no) + <> ["#endif"] + +tshow :: Int -> Text +tshow = T.pack . show diff --git a/tests/Tilia/CppSpec.hs b/tests/Tilia/CppSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/CppSpec.hs @@ -0,0 +1,827 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Whether documents printed from different configurations line up. +module Tilia.CppSpec (spec) where + +import Data.Map.Strict qualified as Map +import Data.Text (Text) +import Data.Text qualified as T +import Test.Hspec +import Tilia.Cpp +import Tilia.Doc.Internal (Doc) +import Tilia.Equivalence (syntaxDifference) +import Tilia.Parser (defaultParserConfig, parseModule, pmModule) +import Tilia.Render (defaultRenderConfig, renderModule) +import Tilia.Span (Span) + +-- | Format a module which uses the C preprocessor, configured with nothing. +formatCpp :: Text -> Either Text Text +formatCpp = said . formatWithCpp defaultParserConfig defaultRenderConfig "example.hs" + +spec :: Spec +spec = do + describe "splitting a module on its conditional" $ do + it "keeps the directive as written, keyword and all" $ + cfgGuards <$> configurations atDeclarations + `shouldBe` Just (map Guard ["ifdef FOO"]) + + it "keeps every line where it was" $ + let sameLength c = all ((== length (T.lines atDeclarations)) . length . T.lines) (cfgTexts c) + in (sameLength <$> configurations atDeclarations) `shouldBe` Just True + + it "has one more configuration than it has directives" $ + let balanced c = length (cfgTexts c) == length (cfgGuards c) + 1 + in map (fmap balanced . configurations) [atDeclarations, withoutElse, withElif] + `shouldBe` [Just True, Just True, Just True] + + it "finds every directive of an #elif chain, in order" $ + cfgGuards <$> configurations withElif + `shouldBe` Just (map Guard ["if A", "elif B"]) + + it "takes only the outermost conditional, leaving the nested one alone" $ + cfgGuards <$> configurations nested + `shouldBe` Just (map Guard ["if OUTER"]) + + it "takes only the first of two conditionals side by side" $ + cfgGuards <$> configurations twoConditionals + `shouldBe` Just (map Guard ["if FIRST"]) + + it "declines a module with no conditional at all" $ + configurations "module M where\nf = 1\n" `shouldBe` Nothing + + describe "the regions the conditional does not touch" $ do + it "are most of the module, so the comparison is not vacuous" $ + overlap atDeclarations `shouldSatisfy` either (const False) (> 10) + + it "print identically in every configuration, at a declaration boundary" $ + disagreements atDeclarations `shouldBe` Right [] + + it "print identically when the branches are of different lengths" $ + disagreements unevenBranches `shouldBe` Right [] + + it "print identically when a comment sits next to the conditional" $ + disagreements withComments `shouldBe` Right [] + + it "print identically when a comment lives inside one branch" $ + disagreements commentInsideBranch `shouldBe` Right [] + + it "print identically with nothing to separate the conditional" $ + disagreements packedTogether `shouldBe` Right [] + + it "print identically when the conditional has no alternative" $ + disagreements withoutElse `shouldBe` Right [] + + it "print identically across all three branches of an #elif" $ + disagreements withElif `shouldBe` Right [] + + describe "every configuration of the output" + $ it "is the same program as that configuration of the input" + $ mapM_ (`shouldBe` Right ()) (map roundTrip everyFixture) + + describe "formatting an already formatted module" + $ it "changes nothing, for every module the prototype handles" + $ mapM_ (`shouldBe` Right ()) (map settles everyFixture) + + describe "an #elif chain" $ do + it "is printed back as one conditional rather than as nested ones" $ + formatCpp withElif + `shouldBe` Right + ( T.unlines + [ "module M where", + "", + "before = 1", + "", + "#if A", + "mid = 1", + "#elif B", + "mid = 2", + "#else", + "mid = 3", + "#endif", + "", + "after = 4" + ] + ) + + it "keeps its shape when the chain has no #else" $ + formatCpp elifWithoutElse + `shouldBe` Right + ( T.unlines + [ "module M where", + "", + "#if A", + "mid = 1", + "#elif B", + "mid = 2", + "#endif", + "", + "after = 4" + ] + ) + + describe "conditionals nested inside one another" $ do + it "are printed back nested, not flattened into compound conditions" $ + formatCpp nested + `shouldBe` Right + ( T.unlines + [ "module M where", + "", + "#if OUTER", + "a = 1", + "", + "#if INNER", + "b = 2", + "#endif", + "#else", + "a = 3", + "#endif", + "", + "after = 4" + ] + ) + + it "reach three leaf configurations rather than four" $ + said (length <$> leaves nested) `shouldBe` Right 3 + + describe "several conditionals side by side" $ do + it "each end up around what they were written around" $ + formatCpp twoConditionals + `shouldBe` Right + ( T.unlines + [ "module M where", + "", + "#if FIRST", + "a = 1", + "#else", + "a = 2", + "#endif", + "", + "between = 0", + "", + "#if SECOND", + "b = 1", + "#endif", + "", + "after = 4" + ] + ) + + it "multiply, as configurations" $ + said (length <$> leaves twoConditionals) `shouldBe` Right 4 + + it "add, as formattings: twenty of them are twenty-one, not a million" $ + formatCpp (sideBySide 20) `shouldSatisfy` isRight + + it "are refused once even the sum is more than the budget allows" $ + formatCpp (sideBySide 100) `shouldSatisfy` isLeft + + describe "counting the configurations" $ do + it "agrees with enumerating them, where enumerating them is possible" $ + let counted m = (said (countLeaves m), said (toInteger . length <$> leaves m)) + in map + counted + [ atDeclarations, + withElif, + elifWithoutElse, + withoutElse, + nested, + twoConditionals, + sideBySide 8 + ] + `shouldSatisfy` all (uncurry (==)) + + it "does not enumerate them, where enumerating them is not" $ + said (countLeaves (sideBySide 63)) `shouldBe` Right (2 ^ (63 :: Int)) + + it "counts two conditionals behind one guard as one conditional" $ + said (countLeaves (sameGuard 20)) `shouldBe` Right 2 + + describe "one guard asked at two depths" $ do + it "is one question, however deep the second asking is" $ + said (countLeaves guardAtTwoDepths) `shouldBe` Right 4 + + it "counts what enumerating them produces" $ + (said (countLeaves guardAtTwoDepths), said (toInteger . length <$> leaves guardAtTwoDepths)) + `shouldSatisfy` uncurry (==) + + it "is never answered one way at the top and the other way inside" $ + said (leaves guardAtTwoDepths) + `shouldSatisfy` either + (const False) + (all (\l -> not ("inner" `T.isInfixOf` l) || "outer" `T.isInfixOf` l)) + + describe "covering every branch" $ do + it "gives a module with no conditionals one configuration, its own" $ + said (length <$> branchLeaves "module M where\nx = 1\n") `shouldBe` Right 1 + + it "gives one per branch of a conditional" $ do + said (length <$> branchLeaves "module M where\n#if A\nx = 1\n#endif\n") `shouldBe` Right 2 + said (length <$> branchLeaves "module M where\n#if A\nx = 1\n#else\nx = 2\n#endif\n") + `shouldBe` Right 2 + + -- A module written on Windows ends every line with a carriage return, + -- @#endif@ included, and one that closes no group leaves the whole + -- module unsplittable. Every module of @crypton-pem@ is written this + -- way, and refusing them refused everything that reads a certificate. + it "gives one per branch when the lines end in a carriage return" $ + said (length <$> branchLeaves "module M where\r\n#if A\r\nx = 1\r\n#else\r\nx = 2\r\n#endif\r\n") + `shouldBe` Right 2 + + it "is their sum where enumerating them would be their product" $ + (said (length <$> branchLeaves (sideBySide 20)), said (countLeaves (sideBySide 20))) + `shouldBe` (Right 21, Right (2 ^ (20 :: Int))) + + describe "varying one conditional at a time" $ do + it "is the baseline and one configuration per further branch" $ + said (length <$> linearLeaves (sideBySide 63)) `shouldBe` Right 64 + + it "agrees with enumerating them where a module has one conditional" $ + (said (linearLeaves atDeclarations), said (leaves atDeclarations)) + `shouldSatisfy` uncurry (==) + + describe "conditionals that reach into the same construct" $ do + it "are still formatted, by varying them together" $ + roundTrip twoInOneExpression `shouldBe` Right () + + it "come back nested, still covering all four configurations" $ + (formatCpp twoInOneExpression >>= said . leaves) `shouldSatisfy` either (const False) ((== 4) . length) + + it "still settle" $ + settles twoInOneExpression `shouldBe` Right () + + describe "a conditional the construct around it straddles" $ do + it "comes to rest on the context, with nothing written out twice" $ + formatCpp conditionalContext + `shouldBe` Right + ( T.unlines + [ "module M where", + "", + "f ::", + "#ifdef A", + " (Ord a) =>", + "#endif", + " a -> [(String, Int)] -> Maybe String -> Either String Int -> IO ()", + "f x pairs fallback outcome = print (x, pairs, fallback, outcome)" + ] + ) + + it "gives back what was written" $ + formatCpp conditionalContext `shouldBe` Right conditionalContext + + it "settles on the first pass" $ + settles conditionalContext `shouldBe` Right () + + it "reads back as the same program in every configuration" $ + roundTrip conditionalContext `shouldBe` Right () + + describe "a conditional inside an expression" $ do + it "is left exactly where it was written" $ + formatCpp splitExpression + `shouldBe` Right "module M where\n\nf x =\n g x\n#ifdef FOO\n + 1\n#endif\n" + + it "still reads back as the same program in every configuration" $ + roundTrip splitExpression `shouldBe` Right () + + describe "a conditional whose branches say the same thing" + $ it "is kept, because the branches are not at the same spans" + $ formatCpp sameEitherWay + `shouldBe` Right "module M where\n\n#ifdef FOO\nmid = 2\n#else\nmid = 2\n#endif\n" + + describe "a directive that asks nothing" $ do + it "comes back at the line it was written on" $ + formatCpp withDefine + `shouldBe` Right "module M where\n\n#define N 1\nf = N\n" + + it "settles" $ + settles withDefine `shouldBe` Right () + + it "still reads back as the same program" $ + roundTrip withDefine `shouldBe` Right () + + it "is refused when the module is not Haskell without expanding it" $ + formatCpp macroDeclaration `shouldSatisfy` isLeft + + xit "does not run a Haddock into the comment under it" $ + roundTrip defineBetweenConditionals `shouldBe` Right () + + describe "directives the prototype cannot read" $ do + it "refuses a module whose conditionals do not balance" $ + formatCpp unbalanced `shouldSatisfy` isLeft + + it "refuses an #else that comes before an #elif" $ + formatCpp elseBeforeElif `shouldSatisfy` isLeft + + it "refuses a conditional no configuration can be parsed out of" $ + formatCpp unparseableAlone `shouldSatisfy` isLeft + +---------------------------------------------------------------------------- +-- The modules the question is asked of + +-- | Everything that is meant to come out the other side, for the properties +-- that should hold of all of it. +everyFixture :: [Text] +everyFixture = + [ atDeclarations, + unevenBranches, + withComments, + commentInsideBranch, + packedTogether, + differingImports, + withoutElse, + withElif, + elifWithoutElse, + nested, + twoConditionals, + twoInOneExpression, + splitExpression + ] + +-- | A directive that asks nothing, between two conditionals that ask the +-- same question. +-- +-- The merge has no answer for this and wraps the module in a conditional +-- rather than the conditionals in the module. See the held-back example that +-- names it. +defineBetweenConditionals :: Text +defineBetweenConditionals = + T.unlines + [ "module M where", + "", + "-- | documentation", + "#if FLAG", + "-- a remark", + "f9 = 9", + "#endif", + "#define WIDE 1", + "#if FLAG", + "-- a remark", + "#endif" + ] + +-- | A conditional between two whole declarations, which is the case the +-- design is meant to handle. +atDeclarations :: Text +atDeclarations = + T.unlines + [ "module M where", + "", + "before :: Int", + "before = 1", + "", + "#ifdef FOO", + "mid :: Int", + "mid = 2", + "#else", + "mid :: Int", + "mid = 3", + "#endif", + "", + "after :: Int", + "after = 4" + ] + +-- | Branches that print to different numbers of lines, so that anything +-- downstream of them would shift if positions were being followed. +unevenBranches :: Text +unevenBranches = + T.unlines + [ "module M where", + "", + "before = 1", + "", + "#ifdef FOO", + "mid = case x of", + " A -> 1", + " B -> 2", + "#else", + "mid = 3", + "#endif", + "", + "after = 4" + ] + +-- | A comment inside one branch and not the other. Comment placement reads +-- every region in the document, so the declarations outside the conditional +-- are being asked about under two different comment streams. +commentInsideBranch :: Text +commentInsideBranch = + T.unlines + [ "module M where", + "", + "before = 1", + "", + "#ifdef FOO", + "-- a note only this branch has", + "mid = 2 -- and a trailing one", + "#else", + "mid = 3", + "#endif", + "", + "after = 4" + ] + +-- | No blank lines anywhere, so that whether one is printed between +-- declarations is decided by what lies between their spans. +packedTogether :: Text +packedTogether = + T.unlines + [ "module M where", + "before = 1", + "#ifdef FOO", + "mid = 2", + "#else", + "mid = 3", + "#endif", + "after = 4" + ] + +-- | A comment on either side of the conditional. Comment attachment reads +-- the whole document, so this is where context-sensitivity would show. +withComments :: Text +withComments = + T.unlines + [ "module M where", + "", + "-- above", + "before = 1 -- trailing", + "", + "#ifdef FOO", + "mid = 2", + "#else", + "mid = 3", + "#endif", + "", + "-- below", + "after = 4" + ] + +-- | Branches that import different modules, which is the commonest thing a +-- real conditional does. +differingImports :: Text +differingImports = + T.unlines + [ "module M where", + "", + "#ifdef FOO", + "import Data.Map", + "#else", + "import Data.Set", + "#endif", + "", + "f = 1" + ] + +-- | A conditional with no alternative, which is what most conditionals in +-- real Haskell source are: a @MIN_VERSION@ test around a definition that +-- newer or older compilers do not want. +withoutElse :: Text +withoutElse = + T.unlines + [ "module M where", + "", + "before = 1", + "", + "#if MIN_VERSION_base(4,19,0)", + "mid = 2", + "#endif", + "", + "after = 4" + ] + +-- | Three branches, so that the choice is genuinely n-ary and not a pair +-- with extra steps. +withElif :: Text +withElif = + T.unlines + [ "module M where", + "", + "before = 1", + "", + "#if A", + "mid = 1", + "#elif B", + "mid = 2", + "#else", + "mid = 3", + "#endif", + "", + "after = 4" + ] + +-- | An @#elif@ chain that stops without an @#else@, so that the last +-- configuration is the one where nothing at all is taken. +elifWithoutElse :: Text +elifWithoutElse = + T.unlines + [ "module M where", + "", + "#if A", + "mid = 1", + "#elif B", + "mid = 2", + "#endif", + "", + "after = 4" + ] + +-- | A conditional inside a branch of another, which the splitter must leave +-- to the recursion rather than read as a chain. +nested :: Text +nested = + T.unlines + [ "module M where", + "", + "#if OUTER", + "a = 1", + "#if INNER", + "b = 2", + "#endif", + "#else", + "a = 3", + "#endif", + "", + "after = 4" + ] + +-- | Two conditionals with a declaration between them, neither inside the +-- other. +twoConditionals :: Text +twoConditionals = + T.unlines + [ "module M where", + "", + "#if FIRST", + "a = 1", + "#else", + "a = 2", + "#endif", + "", + "between = 0", + "", + "#if SECOND", + "b = 1", + "#endif", + "", + "after = 4" + ] + +-- | A module with @n@ conditionals in a row, for asking where the budget +-- stops. +sideBySide :: Int -> Text +sideBySide n = + T.unlines $ + ["module M where", ""] + <> concat + [ [ "#if C" <> T.pack (show i), + "x" <> T.pack (show i) <> " = 1", + "#else", + "x" <> T.pack (show i) <> " = 2", + "#endif" + ] + | i <- [1 .. n] + ] + +-- | A module with @n@ conditionals in a row, all asking the same question. +-- +-- Which makes them one question, however many times it is written down. The +-- shape a module reaches by being formatted, since aligning the alternatives +-- can leave one conditional printed as several. +sameGuard :: Int -> Text +sameGuard n = + T.unlines $ + ["module M where", ""] + <> concat + [ [ "#if C", + "x" <> T.pack (show i) <> " = 1", + "#else", + "x" <> T.pack (show i) <> " = 2", + "#endif" + ] + | i <- [1 .. n] + ] + +-- | One guard asked twice, once at the top level and once inside another +-- conditional's branch. +-- +-- Untied this has six configurations where it has four, and one of the two +-- extra ones answers @A@ both ways at once. +guardAtTwoDepths :: Text +guardAtTwoDepths = + T.unlines + [ "module M where", + "", + "#if A", + "outer = 1", + "#endif", + "", + "#ifdef B", + "beside = 2", + "#if A", + "inner = 3", + "#endif", + "#endif" + ] + +-- | A conditional around a signature's context, which the signature straddles. +-- +-- The branches are of unequal length, so the construct the conditional is +-- inside occupies different lines in the two configurations — which is the +-- one case where a span honestly differs without anything having gone wrong. +-- The type is written long enough not to fit on a line once the context is +-- there and to fit comfortably once it is not, so the two configurations also +-- disagree about how to lay the group out. +conditionalContext :: Text +conditionalContext = + T.unlines + [ "module M where", + "", + "f ::", + "#ifdef A", + " (Ord a) =>", + "#endif", + " a -> [(String, Int)] -> Maybe String -> Either String Int -> IO ()", + "f x pairs fallback outcome = print (x, pairs, fallback, outcome)" + ] + +-- | A conditional in the middle of an expression, which every configuration +-- can be parsed out of, but which no span survives. +splitExpression :: Text +splitExpression = + T.unlines + [ "module M where", + "", + "f x =", + " g x", + "#ifdef FOO", + " + 1", + "#endif" + ] + +-- | Two conditionals reaching into one expression, so that their +-- differences land in the same place and cannot be applied side by side. +twoInOneExpression :: Text +twoInOneExpression = + T.unlines + [ "module M where", + "", + "f =", + " a", + "#if X", + " + b", + "#endif", + "#if Y", + " + c", + "#endif" + ] + +-- | A conditional whose two branches say the same thing. +sameEitherWay :: Text +sameEitherWay = + T.unlines + [ "module M where", + "", + "#ifdef FOO", + "mid = 2", + "#else", + "mid = 2", + "#endif" + ] + +-- | A conditional that opens a bracket it does not close, so that dropping +-- the branch leaves something that is not a Haskell module at all. +-- +-- Harder to come by than it looks. A conditional holding the only statement +-- of a @do@ block, or the only alternative of a @case@, still leaves both +-- configurations parsing, since GHC2021 has @EmptyCase@ and takes an empty +-- @do@. It is unbalanced delimiters that no blanking can rescue. +unparseableAlone :: Text +unparseableAlone = + T.unlines + [ "module M where", + "", + "#ifdef FOO", + "f = (1", + "#endif", + " + 2)" + ] + +-- | An @#if@ with nothing to close it. +unbalanced :: Text +unbalanced = T.unlines ["module M where", "", "#ifdef FOO", "f = 1"] + +-- | A directive that is not a conditional, and so cannot be blanked away. +withDefine :: Text +withDefine = T.unlines ["module M where", "", "#define N 1", "f = N"] + +-- | A macro standing for a piece of syntax rather than for a piece of +-- program. +-- +-- @CLOSE@ is a bracket, so the module is only balanced once the macro has +-- been expanded. Nothing short of expanding it makes this Haskell, no +-- configuration of it parses, and there is no document to build. The same +-- shape as a conditional that opens a bracket it does not close, and refused +-- for the same reason. +macroDeclaration :: Text +macroDeclaration = + T.unlines + [ "module M where", + "", + "#define CLOSE )", + "f = (1 CLOSE" + ] + +-- | An @#else@ with an @#elif@ after it, which no preprocessor would accept +-- and which the splitter must not quietly reorder into something it would. +elseBeforeElif :: Text +elseBeforeElif = + T.unlines + [ "module M where", + "", + "#if A", + "f = 1", + "#else", + "f = 2", + "#elif B", + "f = 3", + "#endif" + ] + +---------------------------------------------------------------------------- +-- Asking it + +isLeft, isRight :: Either a b -> Bool +isLeft = either (const True) (const False) +isRight = either (const False) (const True) + +-- | Format a module, then check that every configuration of what came out is +-- the same program as that configuration of what went in. +-- +-- The variational form of the check the corpus already makes of every +-- example, with a @forall cfg@ in front of it. The conditionals come back in +-- the order they were written, so the two enumerations line up leaf for leaf +-- — and if they did not, the count would say so first. +roundTrip :: Text -> Either Text () +roundTrip source = do + formatted <- formatCpp source + went <- said (leaves source) + came <- said (leaves formatted) + if length went == length came + then mapM_ (uncurry sameProgram) (zip went came) + else Left ("the number of configurations changed: " <> T.pack (show (length went, length came))) + where + sameProgram before' after' = do + a <- moduleOf before' + b <- moduleOf after' + case syntaxDifference a b of + Nothing -> Right () + Just difference -> Left ("a different program: " <> difference) + moduleOf text = case parseModule defaultParserConfig "" text of + Left _ -> Left ("did not parse:\n" <> text) + Right parsed -> Right (pmModule parsed) + +-- | Whether formatting what was formatted changes anything. +-- +-- The property the corpus makes of every ordinary example. It is worth +-- asking separately here because the merge is the one part of the printer +-- whose input is its own output: directives go into the text, and the second +-- pass has to split on the very ones the first pass wrote. +settles :: Text -> Either Text () +settles source = do + once <- formatCpp source + twice <- formatCpp once + if once == twice + then Right () + else Left ("did not settle:\n" <> once <> "\nbecame:\n" <> twice) + +-- | A refusal as words, which is the only place these tests want one. +said :: Either CppError a -> Either Text a +said = either (Left . describeCppError) Right + +-- | The spans every configuration printed, but did not all print alike. +-- +-- 'Left' when a configuration did not parse or the module had no +-- conditional, so that a broken fixture is not mistaken for agreement. +disagreements :: Text -> Either String [Span] +disagreements = fmap (Map.keys . Map.filter not) . agreement + +-- | How many spans every configuration printed. +overlap :: Text -> Either String Int +overlap = fmap Map.size . agreement + +-- | The spans every configuration of a module's first conditional printed, +-- and whether they all printed them alike. +agreement :: Text -> Either String (Map.Map Span Bool) +agreement source = do + c <- maybe (Left "no conditional") Right (configurations source) + docs <- traverse documentOf (cfgTexts c) + case map regions docs of + [] -> Left "a conditional with no branches" + (first' : rest) -> Right (foldl' (narrow first') (True <$ first') rest) + where + narrow first' acc other = + Map.intersectionWith (&&) acc (Map.intersectionWith (==) first' other) + +documentOf :: Text -> Either String Doc +documentOf source = case parseModule defaultParserConfig "" source of + Left _ -> Left ("did not parse:\n" <> T.unpack source) + Right parsed -> Right (renderModule defaultRenderConfig parsed) diff --git a/tests/Tilia/Doc/BodySpec.hs b/tests/Tilia/Doc/BodySpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Doc/BodySpec.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Placement, attachment, and the 'Body' class. +module Tilia.Doc.BodySpec (spec) where + +import Data.Text (Text) +import Test.Hspec +import Tilia.Doc +import Tilia.Doc.Body +import Tilia.Doc.Combinators +import Tilia.Span + +-- | A stand-in for a real body type, enough to exercise the class: one +-- construct that hangs, one that does not, and one that takes its answer +-- from another. +data Toy + = Call Text Text + | Block [Text] + | Apply Toy Toy + +instance Body Toy where + printBody = \case + Call f x -> txt f <> space <> txt x + Block ss -> txt "do" <> indent (hardBreak <> sepBy hardBreak (map txt ss)) + Apply f x -> printBody f <> space <> printBody x + + bodyPlacement = \case + Call _ _ -> Normal + Block _ -> Hanging + Apply _ x -> bodyPlacement x + +spec :: Spec +spec = do + describe "attach" $ do + it "hands over the line when hanging" $ + out (broken (txt "=" <> attach Hanging (txt "do" <> indent (hardBreak <> txt "s")))) + `shouldBe` "= do\n s\n" + it "breaks and indents when normal" $ + out (broken (txt "=" <> attach Normal (txt "f" <> space <> txt "x"))) + `shouldBe` "=\n f x\n" + it "stays on one line when flat, either way" $ do + out (flat (txt "=" <> attach Normal (txt "x"))) `shouldBe` "= x\n" + out (flat (txt "=" <> attach Hanging (txt "x"))) `shouldBe` "= x\n" + + describe "hangingIfSingleLine" $ do + it "hangs for a single-line span" $ + hangingIfSingleLine (mkSpan (1, 1) (1, 9)) `shouldBe` Hanging + it "does not hang for a multi-line span" $ + hangingIfSingleLine (mkSpan (1, 1) (2, 9)) `shouldBe` Normal + + describe "Body" $ do + it "attaches a hanging body" $ + out (broken (txt "=" <> attachBody (Block ["a", "b"]))) + `shouldBe` "= do\n a\n b\n" + it "attaches a normal body" $ + out (broken (txt "=" <> attachBody (Call "f" "x"))) + `shouldBe` "=\n f x\n" + it "propagates placement through an application" $ + bodyPlacement (Apply (Call "f" "x") (Block ["a"])) `shouldBe` Hanging + it "stops propagating at a non-hanging tail" $ + bodyPlacement (Apply (Block ["a"]) (Call "f" "x")) `shouldBe` Normal + it "propagates through nesting" $ + bodyPlacement (Apply (Call "f" "x") (Apply (Call "g" "y") (Block ["a"]))) + `shouldBe` Hanging + +out :: Doc -> Text +out = printDoc defaultRenderOptions diff --git a/tests/Tilia/Doc/CombinatorsSpec.hs b/tests/Tilia/Doc/CombinatorsSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Doc/CombinatorsSpec.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | The vocabulary printing code is written in. +module Tilia.Doc.CombinatorsSpec (spec) where + +import Data.Text (Text) +import Test.Hspec +import Tilia.Doc +import Tilia.Doc.Combinators +import Tilia.Span + +spec :: Spec +spec = do + describe "groups" $ do + it "becomes a space when flat" $ + out (flat (txt "a" <> breakOrSpace <> txt "b")) `shouldBe` "a b\n" + it "becomes a break when broken" $ + out (broken (txt "a" <> breakOrSpace <> txt "b")) `shouldBe` "a\nb\n" + it "leaves nothing when flat" $ + out (flat (txt "a" <> breakOrNothing <> txt "b")) `shouldBe` "ab\n" + it "becomes a break when broken, leaving nothing behind" $ + out (broken (txt "a" <> breakOrNothing <> txt "b")) `shouldBe` "a\nb\n" + it "follows a single-line span" $ + out (group (mkSpan (1, 1) (1, 9)) (txt "a" <> breakOrSpace <> txt "b")) + `shouldBe` "a b\n" + it "follows a multi-line span" $ + out (group (mkSpan (1, 1) (2, 9)) (txt "a" <> breakOrSpace <> txt "b")) + `shouldBe` "a\nb\n" + it "lets an inner group override the enclosing layout" $ + out (flat (txt "a" <> broken (breakOrSpace <> txt "b"))) + `shouldBe` "a\nb\n" + it "ignores a hard line's enclosing layout" $ + out (flat (txt "a" <> hardBreak <> txt "b")) `shouldBe` "a\nb\n" + + describe "variant" $ do + it "takes the first branch when flat" $ + out (flat (variant (txt "one") (txt "many"))) `shouldBe` "one\n" + it "takes the second branch when broken" $ + out (broken (variant (txt "one") (txt "many"))) `shouldBe` "many\n" + it "follows the span like any other group" $ do + let v = variant (txt "one") (txt "many") + out (group (mkSpan (1, 1) (1, 9)) v) `shouldBe` "one\n" + out (group (mkSpan (1, 1) (2, 9)) v) `shouldBe` "many\n" + + describe "provenance" $ + it "does not affect layout" $ do + let d = txt "a" <> breakOrSpace <> txt "b" + s = mkSpan (1, 1) (1, 9) + out (flat (located s d)) `shouldBe` out (flat d) + + describe "combining" $ do + it "separates with commaSep when flat" $ + out (flat (commaSep [txt "a", txt "b", txt "c"])) + `shouldBe` "a, b, c\n" + it "keeps commas on the line above when broken" $ + out (broken (commaSep [txt "a", txt "b"])) + `shouldBe` "a,\nb\n" + it "punctuates all but the last" $ + out (flat (hsep (punctuate comma [txt "a", txt "b", txt "c"]))) + `shouldBe` "a, b, c\n" + it "handles an empty list" $ + out (flat (commaSep [])) `shouldBe` "" + it "handles a single element" $ + out (broken (commaSep [txt "a"])) `shouldBe` "a\n" + it "joins with hsep" $ + out (flat (hsep [txt "a", txt "b"])) `shouldBe` "a b\n" + it "joins with vsep" $ + out (flat (vsep [txt "a", txt "b"])) `shouldBe` "a\nb\n" + + describe "brackets" $ do + it "adds nothing when flat" $ + out (flat (parens (commaSep [txt "a", txt "b"]))) + `shouldBe` "(a, b)\n" + it "keeps the opening bracket company when broken" $ + out (broken (parens (commaSep [txt "a", txt "b"]))) + `shouldBe` "( a,\n b\n)\n" + it "lines the body up under itself" $ + out (broken (brackets (commaSep [txt "a", txt "b", txt "c"]))) + `shouldBe` "[ a,\n b,\n c\n]\n" + it "keeps the closing bracket in when asked" $ + out (broken (parensWith Indented (commaSep [txt "a", txt "b"]))) + `shouldBe` "( a,\n b\n )\n" + it "renders an empty bracket pair flat" $ + out (flat (brackets mempty)) `shouldBe` "[]\n" + it "spaces the unboxed pair" $ + out (flat (unboxed (commaSep [txt "a", txt "b"]))) + `shouldBe` "(# a, b #)\n" + it "gives a spaced pair its own lines when broken" $ + out (broken (unboxed (commaSep [txt "a", txt "b"]))) + `shouldBe` "(#\n a,\n b\n#)\n" + it "wraps in backticks" $ + out (flat (backticks (txt "div"))) `shouldBe` "`div`\n" + + describe "conditionals" $ do + it "includes when the condition holds" $ + out (flat (txt "a" <> includeWhen True (space <> txt "b"))) + `shouldBe` "a b\n" + it "omits when it does not" $ + out (flat (txt "a" <> includeWhen False (space <> txt "b"))) + `shouldBe` "a\n" + it "inverts with includeUnless" $ + out (flat (includeUnless True (txt "a"))) `shouldBe` "" + +out :: Doc -> Text +out = printDoc defaultRenderOptions diff --git a/tests/Tilia/Doc/InternalSpec.hs b/tests/Tilia/Doc/InternalSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Doc/InternalSpec.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | The span algebra and the rendering engine's primitives. +module Tilia.Doc.InternalSpec (spec) where + +import Data.Text (Text) +import Test.Hspec +import Tilia.Doc +import Tilia.Doc.Combinators +import Tilia.Doc.Internal (groupLayout) +import Tilia.Span + +spec :: Spec +spec = do + describe "Span" $ do + it "recognises a single-line span" $ + isSingleLine (mkSpan (3, 1) (3, 40)) `shouldBe` True + it "recognises a multi-line span" $ + isSingleLine (mkSpan (3, 1) (4, 1)) `shouldBe` False + it "unions to cover both operands" $ + mkSpan (1, 5) (1, 9) <> mkSpan (3, 2) (4, 1) + `shouldBe` mkSpan (1, 5) (4, 1) + it "takes the earlier start column when starts share a line" $ + mkSpan (1, 9) (1, 20) <> mkSpan (1, 3) (1, 5) + `shouldBe` mkSpan (1, 3) (1, 20) + + describe "groupLayout" $ do + it "goes flat with no span" $ + groupLayout Nothing `shouldBe` Flat + it "goes flat for a single-line span" $ + groupLayout (Just (mkSpan (1, 1) (1, 9))) `shouldBe` Flat + it "goes broken for a multi-line span" $ + groupLayout (Just (mkSpan (1, 1) (2, 9))) `shouldBe` Broken + + describe "atoms" $ do + it "renders nothing for an empty document" $ + out mempty `shouldBe` "" + it "terminates output with a newline" $ + out (txt "x") `shouldBe` "x\n" + it "collapses repeated spaces" $ + out (txt "a" <> space <> space <> txt "b") `shouldBe` "a b\n" + it "drops a space before a line break" $ + out (txt "a" <> space <> hardBreak <> txt "b") `shouldBe` "a\nb\n" + it "drops a leading space" $ + out (space <> txt "a") `shouldBe` "a\n" + it "ignores an empty fragment" $ + out (txt "a" <> txt "" <> txt "b") `shouldBe` "ab\n" + + describe "blank lines" $ do + it "collapses runs" $ + out (txt "a" <> blankLine <> blankLine <> txt "b") + `shouldBe` "a\n\nb\n" + it "drops a leading blank line" $ + out (blankLine <> txt "a") `shouldBe` "a\n" + it "drops a trailing blank line" $ + out (txt "a" <> blankLine) `shouldBe` "a\n" + it "separates when there is content on both sides" $ + out (txt "a" <> blankLine <> txt "b") `shouldBe` "a\n\nb\n" + it "caps a run of hard breaks at one blank line" $ do + out (txt "a" <> hardBreak <> hardBreak <> txt "b") + `shouldBe` "a\n\nb\n" + out (txt "a" <> hardBreak <> hardBreak <> hardBreak <> txt "b") + `shouldBe` "a\n\nb\n" + out (txt "a" <> mconcat (replicate 8 hardBreak) <> txt "b") + `shouldBe` "a\n\nb\n" + it "caps a mixture of hard breaks and blank lines" $ + out (txt "a" <> hardBreak <> blankLine <> hardBreak <> blankLine <> txt "b") + `shouldBe` "a\n\nb\n" + it "still breaks once for a single hard break" $ + out (txt "a" <> hardBreak <> txt "b") `shouldBe` "a\nb\n" + + describe "indentation" $ do + it "indents by one step" $ + out (broken (txt "a" <> indent (breakOrSpace <> txt "b"))) + `shouldBe` "a\n b\n" + it "nests relative to the enclosing level" $ + out (broken (txt "a" <> indent (breakOrSpace <> txt "b" <> indent (breakOrSpace <> txt "c")))) + `shouldBe` "a\n b\n c\n" + it "aligns to the current column" $ + out (broken (txt "ab" <> space <> align (txt "c" <> breakOrSpace <> txt "d"))) + `shouldBe` "ab c\n d\n" + it "leaves no trailing whitespace on an empty line" $ + out (broken (indent (txt "a" <> hardBreak <> hardBreak <> txt "b"))) + `shouldBe` " a\n\n b\n" + it "does not indent a line with nothing on it" $ + out (broken (indent (txt "a" <> hardBreak))) + `shouldBe` " a\n" + +out :: Doc -> Text +out = printDoc defaultRenderOptions diff --git a/tests/Tilia/Doc/PropertiesSpec.hs b/tests/Tilia/Doc/PropertiesSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Doc/PropertiesSpec.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Properties that should hold of every document the engine renders. +module Tilia.Doc.PropertiesSpec (spec) where + +import Data.Char (isSpace) +import Data.Text (Text) +import Data.Text qualified as T +import Test.Hspec +import Test.QuickCheck +import Tilia.Doc +import Tilia.Doc.Combinators +import Tilia.Gen +import Tilia.Span + +spec :: Spec +spec = do + describe "output shape" $ do + it "never leaves trailing whitespace on a line" $ + property $ \(AnyDoc d) -> + let ls = T.lines (out d) + in counterexample (show ls) (all (\l -> l == T.stripEnd l) ls) + + it "is empty or ends in exactly one newline" $ + property $ \(AnyDoc d) -> + let t = out d + in T.null t || (T.isSuffixOf "\n" t && not (T.isSuffixOf "\n\n" t)) + + it "never begins with a blank line" $ + property $ \(AnyDoc d) -> + let t = out d + in not (T.isPrefixOf "\n" t) + + it "never carries two blank lines in a row" $ + property $ \(AnyDoc d) -> + let ls = T.lines (out d) + pairs = zip ls (drop 1 ls) + in counterexample (show ls) (not (any (\(a, b) -> T.null a && T.null b) pairs)) + + describe "content" $ + it "emits exactly the text it was given, and nothing else" $ + property $ \(PlainDoc d) -> + let expected = squash (T.concat (docTexts d)) + actual = squash (out d) + in counterexample (show (expected, actual)) (expected == actual) + + describe "layout" $ do + it "keeps a flat document on one line" $ + property $ \(FlatSafeDoc d) -> + let t = out (flat d) + in counterexample (show t) (length (T.lines t) <= 1) + + it "renders a group with a single-line span as flat" $ + property $ \(FlatSafeDoc d) (SingleLineSpan s) -> + out (group s d) === out (flat d) + + it "renders a group with a multi-line span as broken" $ + property $ \(FlatSafeDoc d) (MultiLineSpan s) -> + out (group s d) === out (broken d) + + describe "provenance" $ + it "does not affect the output" $ + property $ \(AnyDoc d) (AnySpan s) -> + out (located s d) === out d + + describe "monoid" $ do + it "renders associatively" $ + property $ \(AnyDoc a) (AnyDoc b) (AnyDoc c) -> + out (broken ((a <> b) <> c)) === out (broken (a <> (b <> c))) + + it "has mempty as a rendering identity" $ + property $ \(AnyDoc d) -> do + out (broken (mempty <> d)) === out (broken d) + .&&. out (broken (d <> mempty)) === out (broken d) + + describe "Span" $ do + it "unions associatively" $ + property $ \(AnySpan a) (AnySpan b) (AnySpan c) -> + (a <> b) <> c === a <> (b <> c) + + it "unions to something covering both operands" $ + property $ \(AnySpan a) (AnySpan b) -> + let u = a <> b + in counterexample (show u) (covers u a && covers u b) + + it "is idempotent under union" $ + property $ + \(AnySpan a) -> a <> a === a + +-- | Everything that is not whitespace, in order. +-- +-- Whitespace is exactly what the engine is entitled to add, move and +-- remove; what remains is what it must not touch. +squash :: Text -> Text +squash = T.filter (not . isSpace) + +out :: Doc -> Text +out = printDoc defaultRenderOptions diff --git a/tests/Tilia/EquivalenceSpec.hs b/tests/Tilia/EquivalenceSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/EquivalenceSpec.hs @@ -0,0 +1,177 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Whether formatting changed what a module says. +module Tilia.EquivalenceSpec (spec) where + +import Data.Maybe (isJust) +import Data.Text (Text) +import Data.Text qualified as T +import GHC.Hs (HsModule) +import GHC.Hs.Extension (GhcPs) +import Test.Hspec +import Tilia.Comments (Comment) +import Tilia.Equivalence +import Tilia.Parser + ( ParsedModule, + defaultParserConfig, + describeParseError, + parseModule, + pmModule, + pmSource, + ) +import Tilia.Source (comments) + +spec :: Spec +spec = do + describe "what a formatter is allowed to do" $ do + it "sees past layout" $ + "module M where\nf x = x\n" `saysTheSameAs` "module M where\n\nf x = x\n" + + it "sees past a line broken in a different place" $ + "module M where\nf x = x + 1\n" + `saysTheSameAs` "module M where\nf x =\n x\n + 1\n" + + it "sees past the two spellings of a qualified import" $ + "module M where\nimport qualified Data.Map as M\n" + `saysTheSameAs` "module M where\nimport Data.Map qualified as M\n" + + it "sees past the order the imports were written in" $ + "module M where\nimport Data.Set\nimport Data.Map\n" + `saysTheSameAs` "module M where\nimport Data.Map\nimport Data.Set\n" + + it "sees past the brackets around a deriving clause" $ + "module M where\ndata T = T deriving Eq\n" + `saysTheSameAs` "module M where\ndata T = T deriving (Eq)\n" + + it "sees past an empty context" $ + "module M where\nclass () => C a where\n m :: a\n" + `saysTheSameAs` "module M where\nclass C a where\n m :: a\n" + + it "sees past the brackets around one constraint" $ + "module M where\nf :: (Show a) => a -> a\nf x = x\n" + `saysTheSameAs` "module M where\nf :: Show a => a -> a\nf x = x\n" + + it "sees past a documentation comment set differently" $ + "module M where\n\n-- | Says something.\nf :: Int\nf = 1\n" + `saysTheSameAs` "module M where\n\n-- | Says something.\nf :: Int\nf = 1\n" + + it "sees past a documentation comment that says nothing at all" $ + "module M where\n\n-- |\nf :: Int\nf = 1\n" + `saysTheSameAs` "module M where\n\nf :: Int\nf = 1\n" + + it "sees past comments, which are not the tree's business" $ + "module M where\n\n-- a remark\nf :: Int\nf = 1\n" + `saysTheSameAs` "module M where\n\nf :: Int\nf = 1\n" + + describe "what it must not let through" $ do + it "catches a changed literal" $ + "module M where\nf = 1\n" `saysSomethingElseThan` "module M where\nf = 2\n" + + it "catches a changed name" $ + "module M where\nf x = x\n" `saysSomethingElseThan` "module M where\nf x = y\n" + + it "catches an operator regrouped" $ + "module M where\nf = a + b * c\n" + `saysSomethingElseThan` "module M where\nf = (a + b) * c\n" + + it "catches a declaration dropped" $ + "module M where\nf = 1\ng = 2\n" `saysSomethingElseThan` "module M where\nf = 1\n" + + it "catches an import dropped" $ + "module M where\nimport Data.Map\nimport Data.Set\n" + `saysSomethingElseThan` "module M where\nimport Data.Map\n" + + it "catches an import list losing an entry" $ + "module M where\nimport Data.List (sort, nub)\n" + `saysSomethingElseThan` "module M where\nimport Data.List (sort)\n" + + it "catches an import that stopped being qualified" $ + "module M where\nimport qualified Data.Map as M\n" + `saysSomethingElseThan` "module M where\nimport Data.Map as M\n" + + it "catches an export list losing an entry" $ + "module M (f, g) where\nf = 1\ng = 2\n" + `saysSomethingElseThan` "module M (f) where\nf = 1\ng = 2\n" + + it "catches a documentation comment losing a word" $ + "module M where\n\n-- | Says something.\nf :: Int\nf = 1\n" + `saysSomethingElseThan` "module M where\n\n-- | Says.\nf :: Int\nf = 1\n" + + it "says where the difference is, not merely that there is one" $ + case syntaxDifference (treeOf "module M where\nf = 1\n") (treeOf "module M where\nf = 2\n") of + Nothing -> expectationFailure "found no difference" + Just why -> do + why `shouldSatisfy` T.isInfixOf "HsOverLit" + why `shouldSatisfy` T.isInfixOf "1 became 2" + + describe "the comments a formatter must carry over" $ do + it "is content when they all came through" $ + "module M where\n\n-- a remark\nf = 1\n" + `keepsTheCommentsOf` "module M where\n\n-- a remark\nf = 1\n" + + it "notices one that went missing" $ + "module M where\n\n-- a remark\nf = 1\n" + `losesTheCommentsOf` "module M where\n\nf = 1\n" + + it "notices one that was invented" $ + "module M where\n\nf = 1\n" + `losesTheCommentsOf` "module M where\n\n-- a remark\nf = 1\n" + + it "notices a pragma that went missing, and names it" $ + case difference "{-# LANGUAGE LambdaCase #-}\nmodule M where\nf = 1\n" "module M where\nf = 1\n" of + Nothing -> expectationFailure "let the pragma go" + Just why -> do + why `shouldSatisfy` T.isInfixOf "lost the pragma" + why `shouldSatisfy` T.isInfixOf "LambdaCase" + + it "notices a pragma that was invented" $ + case difference "module M where\nf = 1\n" "{-# LANGUAGE LambdaCase #-}\nmodule M where\nf = 1\n" of + Nothing -> expectationFailure "let the pragma through" + Just why -> why `shouldSatisfy` T.isInfixOf "invented the pragma" + + it "does not mind the order of what stands above the module header" $ + "{-# LANGUAGE LambdaCase #-}\n{-# LANGUAGE TupleSections #-}\nmodule M where\nf = 1\n" + `keepsTheCommentsOf` "{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE LambdaCase #-}\nmodule M where\nf = 1\n" + + it "does not mind a comment that moved with the import it belongs to" $ + "module M where\n\n-- about Set\nimport Data.Set\n\n-- about Map\nimport Data.Map\n" + `keepsTheCommentsOf` "module M where\n\n-- about Map\nimport Data.Map\n\n-- about Set\nimport Data.Set\n" + +---------------------------------------------------------------------------- +-- Helpers + +-- | Two modules that a formatter could turn one into the other. +saysTheSameAs :: Text -> Text -> Expectation +saysTheSameAs went came = + syntaxDifference (treeOf went) (treeOf came) `shouldBe` Nothing + +-- | Two modules that no formatter may turn one into the other. +saysSomethingElseThan :: Text -> Text -> Expectation +saysSomethingElseThan went came = + syntaxDifference (treeOf went) (treeOf came) `shouldSatisfy` isJust + +keepsTheCommentsOf :: Text -> Text -> Expectation +keepsTheCommentsOf went came = difference went came `shouldBe` Nothing + +losesTheCommentsOf :: Text -> Text -> Expectation +losesTheCommentsOf went came = + difference went came `shouldSatisfy` isJust + +-- | What 'commentDifference' makes of two spellings of a module. +difference :: Text -> Text -> Maybe Text +difference went came = + commentDifference + (treeOf went, treeOf came) + (commentsOf went) + (commentsOf came) + +treeOf :: Text -> HsModule GhcPs +treeOf = pmModule . parsed + +commentsOf :: Text -> [Comment] +commentsOf = comments . pmSource . parsed + +parsed :: Text -> ParsedModule +parsed source = case parseModule defaultParserConfig "Test.hs" source of + Left problem -> error (T.unpack (describeParseError problem)) + Right m -> m diff --git a/tests/Tilia/Fixity/CabalSpec.hs b/tests/Tilia/Fixity/CabalSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Fixity/CabalSpec.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Reading a @.cabal@ file's fields without a cabal parser. +module Tilia.Fixity.CabalSpec (spec) where + +import Codec.Archive.Tar qualified as Tar +import Codec.Archive.Tar.Entry qualified as Tar +import Data.ByteString.Lazy qualified as BL +import Data.Text (Text) +import Data.Text.Encoding qualified as T +import GHC.LanguageExtensions.Type (Extension (..)) +import Test.Hspec +import Tilia.Fixity.Cabal + +spec :: Spec +spec = do + describe "finding the cabal file in an archive" $ do + it "spells an entry's path the way the archive holds it" $ + entryPosixPath (entryFor "hspec-2.11.17/hspec.cabal" "") + `shouldBe` "hspec-2.11.17/hspec.cabal" + + it "is the same spelling on every machine" $ + entryPosixPath (entryFor "hspec-2.11.17/hspec.cabal" "") + `shouldBe` Tar.fromTarPathToPosixPath + (Tar.entryTarPath (entryFor "hspec-2.11.17/hspec.cabal" "")) + + it "knows a package's own cabal file from one further down" $ + map + cabalFileAtTop + [ "hspec-2.11.17/hspec.cabal", + "hspec-2.11.17/vendor/other.cabal", + "hspec.cabal" + ] + `shouldBe` [True, False, False] + + it "reads only a path written with the separator a tar file uses" $ + cabalFileAtTop "hspec-2.11.17\\hspec.cabal" `shouldBe` False + + it "takes the modules out of an archive's cabal file" $ + cabalFileInArchive + ( archiveOf + [ ("hspec-2.11.17/Setup.lhs", "main = undefined\n"), + ("hspec-2.11.17/hspec.cabal", "library\n exposed-modules: Test.Hspec, Test.Hspec.Runner\n") + ] + ) + `shouldSatisfy` maybe False (elem "Test.Hspec.Runner" . containedModules) + + describe "plain fields" $ do + it "reads a one-line field" $ + exposed "library\n exposed-modules: A.B, C.D\n" + `shouldMatchList` ["A.B", "C.D"] + + it "reads a field spread over indented lines" $ + exposed "library\n exposed-modules:\n A.B\n C.D\n E\n" + `shouldMatchList` ["A.B", "C.D", "E"] + + it "reads a mixture of commas and lines" $ + exposed "library\n exposed-modules: A.B,\n C.D\n" + `shouldMatchList` ["A.B", "C.D"] + + it "is not confused by the field name's case" $ + exposed "library\n Exposed-Modules: A.B\n" `shouldMatchList` ["A.B"] + + it "finds nothing when there is no such field" $ + exposed "library\n build-depends: base\n" `shouldBe` [] + + describe "what must not be picked up" $ do + it "takes other-modules too, which a re-export may lead into" $ + exposed "library\n exposed-modules: A\n other-modules: B\n" + `shouldMatchList` ["A", "B"] + + it "ignores reexported-modules" $ + exposed "library\n exposed-modules: A\n reexported-modules: B\n" + `shouldMatchList` ["A"] + + it "stops at the next field" $ + exposed "library\n exposed-modules:\n A\n build-depends: base\n" + `shouldMatchList` ["A"] + + it "ignores anything that is not a module name" $ + exposed "library\n exposed-modules: A, base >=4, -Wall\n" + `shouldMatchList` ["A"] + + describe "conditionals" $ do + it "takes a branch nested inside an if" $ + exposed + "library\n\ + \ exposed-modules: A\n\ + \ if flag(fancy)\n\ + \ exposed-modules: B\n" + `shouldMatchList` ["A", "B"] + + it "takes both branches of an if/else" $ + exposed + "library\n\ + \ if os(windows)\n\ + \ exposed-modules: W\n\ + \ else\n\ + \ exposed-modules: U\n" + `shouldMatchList` ["W", "U"] + + it "takes a branch nested two deep" $ + exposed + "library\n\ + \ if flag(a)\n\ + \ if flag(b)\n\ + \ exposed-modules: Deep\n" + `shouldMatchList` ["Deep"] + + it "takes every library stanza, including named ones" $ + exposed + "library\n\ + \ exposed-modules: Main.Lib\n\ + \\n\ + \library internal\n\ + \ exposed-modules: Internal.Lib\n" + `shouldMatchList` ["Main.Lib", "Internal.Lib"] + + describe "comments" $ do + it "does not let one at the margin cut a module list short" $ + exposed "library\n exposed-modules:\n A\n-- B\n C\n" + `shouldMatchList` ["A", "C"] + + it "does not count a module somebody commented out" $ + exposed "library\n exposed-modules:\n A\n -- B\n C\n" + `shouldMatchList` ["A", "C"] + + it "keeps reading source directories past one" $ + sourceDirs "library\n hs-source-dirs: src\n-- a comment\ntest-suite t\n hs-source-dirs: tests\n" + `shouldBe` ["src", "tests", "."] + + describe "where a component with no hs-source-dirs lives" $ do + it "offers the package directory even when other components name one" $ + sourceDirs "library\n build-depends: base\ntest-suite t\n hs-source-dirs: tests\n" + `shouldBe` ["tests", "."] + + it "offers it last, so a named directory is tried first" $ + last (sourceDirs "library\n hs-source-dirs: src\n") `shouldBe` "." + + it "offers it once when it is named as well" $ + sourceDirs "library\n hs-source-dirs: .\n" `shouldBe` ["."] + + it "offers it when nothing names anything" $ + sourceDirs "library\n build-depends: base\n" `shouldBe` ["."] + + describe "what the package puts in force" $ do + it "reads an extension the .cabal turns on" $ + extensions "library\n default-extensions: LambdaCase\n" + `shouldSatisfy` elem LambdaCase + + it "reads several, however they are written" $ do + let found = extensions "library\n default-extensions:\n LambdaCase\n MultiWayIf, BlockArguments\n" + found `shouldSatisfy` elem LambdaCase + found `shouldSatisfy` elem MultiWayIf + found `shouldSatisfy` elem BlockArguments + + it "takes one back that the .cabal turns off" $ + extensions "library\n default-extensions: ImplicitPrelude, NoImplicitPrelude\n" + `shouldSatisfy` notElem ImplicitPrelude + + it "starts from what the language edition puts in force" $ do + extensions "library\n default-language: GHC2021\n" + `shouldSatisfy` elem TypeOperators + extensions "library\n default-language: Haskell2010\n" + `shouldSatisfy` notElem TypeOperators + + it "takes what every edition in the file puts in force" $ + extensions + "library\n\ + \ default-language: Haskell2010\n\ + \test-suite spec\n\ + \ default-language: GHC2021\n" + `shouldSatisfy` elem TypeOperators + + it "still has the earlier edition's own extensions" $ + extensions + "library\n\ + \ default-language: Haskell2010\n\ + \test-suite spec\n\ + \ default-language: GHC2021\n" + `shouldSatisfy` elem ImplicitPrelude + + it "passes over a name no compiler knows" $ + extensions "library\n default-extensions: LambdaCase, NotAnExtension\n" + `shouldSatisfy` elem LambdaCase + + it "takes every component's, since it does not know which one asks" $ do + let found = + extensions + "library\n default-extensions: LambdaCase\ntest-suite t\n default-extensions: MultiWayIf\n" + found `shouldSatisfy` elem LambdaCase + found `shouldSatisfy` elem MultiWayIf + + describe "the union is deliberate" $ + it "does not need to know which branch a build would take" $ do + let both = + exposed + "library\n\ + \ if impl(ghc >= 9.6)\n\ + \ exposed-modules: New\n\ + \ else\n\ + \ exposed-modules: Old\n" + both `shouldMatchList` ["New", "Old"] + +-- | The modules a @.cabal@ of this shape holds. +exposed :: Text -> [Text] +exposed = containedModules + +-- | What a @.cabal@ of this shape puts in force. +extensions :: Text -> [Extension] +extensions = declaredExtensions + +-- | A tar entry at the given path, holding the given text. +entryFor :: FilePath -> Text -> Tar.Entry +entryFor path contents = case Tar.toTarPath False path of + Left why -> error why + Right tarPath -> Tar.fileEntry tarPath (BL.fromStrict (T.encodeUtf8 contents)) + +-- | An archive of those entries, in order. +archiveOf :: [(FilePath, Text)] -> Tar.Entries e +archiveOf = foldr (Tar.Next . uncurry entryFor) Tar.Done diff --git a/tests/Tilia/Fixity/CacheSpec.hs b/tests/Tilia/Fixity/CacheSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Fixity/CacheSpec.hs @@ -0,0 +1,321 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | The on-disk cache of what was read out of a package. +module Tilia.Fixity.CacheSpec (spec) where + +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import System.Directory (getModificationTime, setModificationTime) +import System.Environment (setEnv, unsetEnv) +import System.FilePath (()) +import System.IO.Temp (withSystemTempDirectory) +import Test.Hspec +import Tilia.Fixity +import Tilia.Fixity.Cache +import Tilia.Fixity.PackageDb (Installed (..), InstalledPackage (..)) + +spec :: Spec +spec = do + tokens + database + around withIsolatedCache $ do + describe "modules" $ do + it "remembers a package's module list" $ \cache -> do + storeModules cache "thing-1.0-abc" ["A.B", "C"] + cachedModules cache "thing-1.0-abc" `shouldReturn` Just ["A.B", "C"] + + it "knows nothing about a package it was never told about" $ \cache -> + cachedModules cache "absent-1.0" `shouldReturn` Nothing + + it "remembers an empty list as a fact, not as absence" $ \cache -> do + storeModules cache "empty-1.0" [] + cachedModules cache "empty-1.0" `shouldReturn` Just [] + + describe "fixities" $ do + it "round-trips every direction" $ \cache -> do + let fixities = + Map.fromList + [ ((InTerms, OpName "<+>"), Fixity LeftAssoc 6), + ((InTerms, OpName ">>="), Fixity RightAssoc 1), + ((InTerms, OpName "==="), Fixity NoAssoc 4) + ] + storeFixities cache "thing-1.0" "A.B" (Declares fixities) + cachedFixities cache "thing-1.0" "A.B" `shouldReturn` Just (Declares fixities) + + it "round-trips the extremes of precedence" $ \cache -> do + let fixities = + Map.fromList + [ ((InTerms, OpName "!"), Fixity LeftAssoc 0), + ((InTerms, OpName "?"), Fixity LeftAssoc 9), + ((InTerms, OpName "->"), Fixity RightAssoc (-1)) + ] + storeFixities cache "thing-1.0" "Edges" (Declares fixities) + cachedFixities cache "thing-1.0" "Edges" `shouldReturn` Just (Declares fixities) + + it "remembers that a module declares nothing" $ \cache -> do + storeFixities cache "thing-1.0" "Quiet" (Declares Map.empty) + cachedFixities cache "thing-1.0" "Quiet" `shouldReturn` Just (Declares Map.empty) + + it "remembers that a module could not be read" $ \cache -> do + storeFixities cache "thing-1.0" "Opaque" (Unreadable Nothing) + cachedFixities cache "thing-1.0" "Opaque" `shouldReturn` Just (Unreadable Nothing) + + it "remembers which module below it stopped the reading" $ \cache -> do + storeFixities cache "thing-1.0" "Opaque" (Unreadable (Just "Deep.Down")) + cachedFixities cache "thing-1.0" "Opaque" + `shouldReturn` Just (Unreadable (Just "Deep.Down")) + + it "tells one stopped below it from one stopped on its own account" $ \cache -> do + storeFixities cache "thing-1.0" "Blamed" (Unreadable (Just "Deep.Down")) + storeFixities cache "thing-1.0" "Itself" (Unreadable Nothing) + blamed <- cachedFixities cache "thing-1.0" "Blamed" + itself <- cachedFixities cache "thing-1.0" "Itself" + (blamed, itself) + `shouldBe` (Just (Unreadable (Just "Deep.Down")), Just (Unreadable Nothing)) + + it "tells an unread module from one it was never told about" $ \cache -> do + storeFixities cache "thing-1.0" "Opaque" (Unreadable Nothing) + unread <- cachedFixities cache "thing-1.0" "Opaque" + never <- cachedFixities cache "thing-1.0" "Absent" + (unread, never) `shouldBe` (Just (Unreadable Nothing), Nothing) + + it "tells an unread module from one that declares nothing" $ \cache -> do + storeFixities cache "thing-1.0" "Opaque" (Unreadable Nothing) + storeFixities cache "thing-1.0" "Quiet" (Declares Map.empty) + opaque <- cachedFixities cache "thing-1.0" "Opaque" + quiet <- cachedFixities cache "thing-1.0" "Quiet" + (opaque, quiet) `shouldBe` (Just (Unreadable Nothing), Just (Declares Map.empty)) + + it "replaces an unread answer once the module can be read" $ \cache -> do + storeFixities cache "thing-1.0" "M" (Unreadable Nothing) + storeFixities cache "thing-1.0" "M" (Declares (Map.fromList [((InTerms, OpName "!"), Fixity LeftAssoc 9)])) + cachedFixities cache "thing-1.0" "M" + `shouldReturn` Just (Declares (Map.fromList [((InTerms, OpName "!"), Fixity LeftAssoc 9)])) + + it "knows nothing about a module it was never told about" $ \cache -> + cachedFixities cache "thing-1.0" "Absent" `shouldReturn` Nothing + + it "keeps packages apart" $ \cache -> do + let ops = Map.fromList [((InTerms, OpName "<>"), Fixity RightAssoc 6)] + storeFixities cache "a-1.0" "M" (Declares ops) + storeFixities cache "b-1.0" "M" (Declares Map.empty) + a <- cachedFixities cache "a-1.0" "M" + b <- cachedFixities cache "b-1.0" "M" + (a, b) `shouldBe` (Just (Declares ops), Just (Declares Map.empty)) + + it "treats a different hash in the key as a different package" $ \cache -> do + storeFixities cache "thing-1.0-aaaa" "M" (Declares (Map.fromList [((InTerms, OpName "!"), Fixity LeftAssoc 9)])) + cachedFixities cache "thing-1.0-bbbb" "M" `shouldReturn` Nothing + + it "overwrites a previous answer for the same key" $ \cache -> do + storeFixities cache "thing-1.0" "M" (Declares (Map.fromList [((InTerms, OpName "!"), Fixity LeftAssoc 9)])) + storeFixities cache "thing-1.0" "M" (Declares (Map.fromList [((InTerms, OpName "!"), Fixity RightAssoc 3)])) + cachedFixities cache "thing-1.0" "M" + `shouldReturn` Just (Declares (Map.fromList [((InTerms, OpName "!"), Fixity RightAssoc 3)])) + + describe "export names" $ do + it "round-trips the names an export list gave" $ \cache -> do + let names = Exports (Set.fromList [OpName "<+>", OpName ":|", OpName "f"]) + storeExportNames cache "thing-1.0" "M" names + cachedExportNames cache "thing-1.0" "M" `shouldReturn` Just names + + it "remembers a module that keeps its own counsel" $ \cache -> do + storeExportNames cache "thing-1.0" "M" Untellable + cachedExportNames cache "thing-1.0" "M" `shouldReturn` Just Untellable + + it "tells one that keeps its own counsel from one never asked about" $ \cache -> do + storeExportNames cache "thing-1.0" "Quiet" Untellable + cachedExportNames cache "thing-1.0" "Quiet" `shouldReturn` Just Untellable + cachedExportNames cache "thing-1.0" "Unasked" `shouldReturn` Nothing + + it "tells one that exports nothing from one that will not say" $ \cache -> do + storeExportNames cache "thing-1.0" "Bare" (Exports Set.empty) + storeExportNames cache "thing-1.0" "Quiet" Untellable + cachedExportNames cache "thing-1.0" "Bare" + `shouldReturn` Just (Exports Set.empty) + cachedExportNames cache "thing-1.0" "Quiet" `shouldReturn` Just Untellable + + it "keeps packages apart" $ \cache -> do + storeExportNames cache "one-1.0" "M" (Exports (Set.singleton (OpName "<+>"))) + storeExportNames cache "two-1.0" "M" (Exports (Set.singleton (OpName ""))) + cachedExportNames cache "one-1.0" "M" + `shouldReturn` Just (Exports (Set.singleton (OpName "<+>"))) + + it "keeps them apart from the fixities of the same module" $ \cache -> do + storeFixities cache "thing-1.0" "M" (Unreadable Nothing) + storeExportNames cache "thing-1.0" "M" (Exports (Set.singleton (OpName "<+>"))) + cachedFixities cache "thing-1.0" "M" `shouldReturn` Just (Unreadable Nothing) + cachedExportNames cache "thing-1.0" "M" + `shouldReturn` Just (Exports (Set.singleton (OpName "<+>"))) + + it "overwrites a previous answer for the same key" $ \cache -> do + storeExportNames cache "thing-1.0" "M" Untellable + storeExportNames cache "thing-1.0" "M" (Exports (Set.singleton (OpName "<+>"))) + cachedExportNames cache "thing-1.0" "M" + `shouldReturn` Just (Exports (Set.singleton (OpName "<+>"))) + + describe "what a name carries with it" $ do + it "round-trips what each name carries" $ \cache -> do + let kept = + Map.fromList + [ (OpName "NonEmpty", Set.fromList [OpName ":|"]), + (OpName "Seq", Set.fromList [OpName ":<|", OpName ":|>"]) + ] + storeChildren cache "thing-1.0" "M" kept + cachedChildren cache "thing-1.0" "M" `shouldReturn` Just kept + + it "remembers a module that carries nothing anywhere" $ \cache -> do + storeChildren cache "thing-1.0" "Bare" Map.empty + cachedChildren cache "thing-1.0" "Bare" `shouldReturn` Just Map.empty + + it "tells that from a module it was never told about" $ \cache -> do + storeChildren cache "thing-1.0" "Bare" Map.empty + cachedChildren cache "thing-1.0" "Unasked" `shouldReturn` Nothing + + it "remembers a name that carries nothing among ones that do" $ \cache -> do + let kept = + Map.fromList + [ (OpName "Empty", Set.empty), + (OpName "NonEmpty", Set.singleton (OpName ":|")) + ] + storeChildren cache "thing-1.0" "M" kept + cachedChildren cache "thing-1.0" "M" `shouldReturn` Just kept + + it "keeps packages apart" $ \cache -> do + storeChildren cache "one-1.0" "M" (Map.singleton (OpName "T") (Set.singleton (OpName ":|"))) + cachedChildren cache "two-1.0" "M" `shouldReturn` Nothing + + describe "module names with dots" $ + it "files a deeply qualified module without confusion" $ \cache -> do + storeFixities cache "thing-1.0" "A.B.C.D" (Declares (Map.fromList [((InTerms, OpName "%"), Fixity NoAssoc 5)])) + cachedFixities cache "thing-1.0" "A.B.C.D" + `shouldReturn` Just (Declares (Map.fromList [((InTerms, OpName "%"), Fixity NoAssoc 5)])) + +-- | What the compiler can see, and what it takes to stop believing it. +-- +-- The database stands in for @ghc-pkg@ here: what is under test is that a +-- change to it is noticed, not what @ghc-pkg@ would have said about it. +database :: Spec +database = around withIsolatedCache $ do + it "gives back what it was told, while the database sits still" $ \cache -> + withDatabase $ \db -> do + storeInstalled cache (Installed [containers] [db]) + cachedInstalled cache `shouldReturn` Just [containers] + + it "gives back nothing once a package has been registered" $ \cache -> + withDatabase $ \db -> do + storeInstalled cache (Installed [containers] [db]) + writeFile (db "new-1.0.conf") "" + cachedInstalled cache `shouldReturn` Nothing + + it "gives back nothing once the database is gone" $ \cache -> do + db <- withDatabase pure + storeInstalled cache (Installed [containers] [db]) + cachedInstalled cache `shouldReturn` Nothing + + it "remembers nothing it has no way to stop believing" $ \cache -> do + storeInstalled cache (Installed [containers] []) + cachedInstalled cache `shouldReturn` Nothing + + it "gives back nothing to a token it was not written under" $ \_ -> + withIsolatedDirectory $ \dir -> + withDatabase $ \db -> do + before' <- open dir (PlanToken "one") + storeInstalled before' (Installed [containers] [db]) + after' <- open dir (PlanToken "two") + cachedInstalled after' `shouldReturn` Nothing + + it "gives it back under the token it was written under" $ \_ -> + withIsolatedDirectory $ \dir -> + withDatabase $ \db -> do + before' <- open dir (PlanToken "one") + storeInstalled before' (Installed [containers] [db]) + again <- open dir (PlanToken "one") + cachedInstalled again `shouldReturn` Just [containers] + + it "keeps one token's answer when another writes its own" $ \_ -> + withIsolatedDirectory $ \dir -> + withDatabase $ \db -> do + one <- open dir (PlanToken "one") + storeInstalled one (Installed [containers] [db]) + two <- open dir (PlanToken "two") + storeInstalled two (Installed [quiet] [db]) + cachedInstalled one `shouldReturn` Just [containers] + cachedInstalled two `shouldReturn` Just [quiet] + + it "carries a package that exposes nothing" $ \cache -> + withDatabase $ \db -> do + storeInstalled cache (Installed [containers, quiet] [db]) + cachedInstalled cache `shouldReturn` Just [containers, quiet] + where + containers = + InstalledPackage + { ipName = "containers", + ipVersion = "0.7", + ipModules = ["Data.Map", "Data.Map.Strict", "Data.Set"], + ipImportDirs = ["/nowhere/containers-0.7"] + } + quiet = + InstalledPackage + { ipName = "rts", + ipVersion = "1.0", + ipModules = [], + ipImportDirs = [] + } + +-- | A directory standing in for a package database, with a timestamp that +-- can be set rather than waited for. +withDatabase :: (FilePath -> IO a) -> IO a +withDatabase action = + withSystemTempDirectory "tilia-db" $ \db -> do + -- Something long ago, so that anything happening to the directory + -- afterwards is a change whatever the clock's resolution. + setModificationTime db =<< getModificationTime "/" + action db + +-- | What an answer of \"could not be read\" is tied to, and what it is not. +tokens :: Spec +tokens = around withIsolatedDirectory $ do + it "does not offer an unread answer written under another token" $ \dir -> do + before' <- open dir (PlanToken "one") + storeFixities before' "thing-1.0" "M" (Unreadable Nothing) + after' <- open dir (PlanToken "two") + cachedFixities after' "thing-1.0" "M" `shouldReturn` Nothing + + it "still offers one written under the same token" $ \dir -> do + before' <- open dir (PlanToken "one") + storeFixities before' "thing-1.0" "M" (Unreadable Nothing) + again <- open dir (PlanToken "one") + cachedFixities again "thing-1.0" "M" `shouldReturn` Just (Unreadable Nothing) + + it "keeps an answer that was read, whatever the token" $ \dir -> do + let fixities = Map.fromList [((InTerms, OpName "<+>"), Fixity RightAssoc 6)] + before' <- open dir (PlanToken "one") + storeFixities before' "thing-1.0" "M" (Declares fixities) + after' <- open dir (PlanToken "two") + cachedFixities after' "thing-1.0" "M" `shouldReturn` Just (Declares fixities) + + it "keeps what an export list said, whatever the token" $ \dir -> do + before' <- open dir (PlanToken "one") + storeExportNames before' "thing-1.0" "M" Untellable + after' <- open dir (PlanToken "two") + cachedExportNames after' "thing-1.0" "M" `shouldReturn` Just Untellable + +-- | Give each test its own cache directory, so nothing leaks between them +-- or into the developer's real cache. +withIsolatedCache :: (Cache -> IO ()) -> IO () +withIsolatedCache action = + withIsolatedDirectory (\dir -> open dir (PlanToken "plan") >>= action) + +withIsolatedDirectory :: (FilePath -> IO ()) -> IO () +withIsolatedDirectory = withSystemTempDirectory "tilia-cache" + +-- | Open a cache in a given directory, under a given token. +open :: FilePath -> PlanToken -> IO Cache +open dir token = do + setEnv "XDG_CACHE_HOME" dir + opened <- openCache token + unsetEnv "XDG_CACHE_HOME" + case opened of + Nothing -> fail "could not open a cache in a temporary directory" + Just cache -> pure cache diff --git a/tests/Tilia/Fixity/DebugSpec.hs b/tests/Tilia/Fixity/DebugSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Fixity/DebugSpec.hs @@ -0,0 +1,227 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} + +-- | The account a run gives of how it settled a module's operators. +module Tilia.Fixity.DebugSpec (spec) where + +import Data.Choice (pattern Is) +import Data.Map.Strict qualified as Map +import Data.Text (Text) +import Data.Text qualified as T +import Test.Hspec +import Tilia.Fixity + ( Direction (..), + Fixity (..), + Known (..), + OpName (..), + inBothNamespaces, + nothingKnown, + resolveScope, + ) +import Tilia.Fixity.Debug (fixityNotes, renderFixityNotes) +import Tilia.Palette (Palette (Plain)) +import Tilia.Parser (defaultParserConfig, describeParseError, parseModule, pmModule) +import Tilia.Utils (lineWidth, visibleLength) + +spec :: Spec +spec = do + describe "what each import brought" $ do + it "counts the operators a module was read for" $ + notesFor [("Prelude", Just []), ("Data.Map", Just [("!", infixl' 9)])] "import Data.Map\n" + >>= (`shouldContain'` "· Data.Map: 1 operator") + + it "says so when a module could not be read" $ + notesFor [("Prelude", Just [])] "import Criterion.Main\n" + >>= (`shouldContain'` "· Criterion.Main: could not be read") + + it "keeps the alias a qualified import goes under" $ + notesFor [("Prelude", Just []), ("Data.Map", Just [])] "import qualified Data.Map as M\n" + >>= (`shouldContain'` "· Data.Map qualified as M: 0 operators") + + it "names the Prelude, which nobody wrote but everybody imports" $ + notesFor [("Prelude", Just [("+", infixl' 6)])] "f = 1\n" + >>= (`shouldContain'` "· Prelude: 1 operator") + + describe "what became of each operator" $ do + it "names the import that carried the fixity" $ + notesFor + [("Prelude", Just []), ("Data.Map", Just [("!", infixl' 9)])] + "import Data.Map\nf m = m ! 1\n" + >>= (`shouldContain'` "· ! infixl 9, declared in Data.Map") + + it "says when the module declared it itself" $ + notesFor [("Prelude", Just [])] "infixr 5 <+>\nf a b = a <+> b\n" + >>= (`shouldContain'` "· <+> infixr 5, declared in this module") + + it "says when nothing in scope declares it and everything was read" $ + notesFor [("Prelude", Just [])] "f a b = a b\n" + >>= (`mentions` " infixl 9, the Report's default") + + it "says which unread module the answer might have been in" $ + notesFor [("Prelude", Just [])] "import Criterion.Main\nf a b = a b\n" + >>= ( `shouldContain'` + "· unknown: may be declared in Criterion.Main, which this run could not read" + ) + + it "counts the unread modules when there is more than one" $ + notesFor + [("Prelude", Just [])] + "import Criterion.Main\nimport Test.Tasty\nf a b = a b\n" + >>= ( `mentions` + "may be declared in Criterion.Main or Test.Tasty, neither of which this run could read" + ) + + it "keeps the qualifier an operator was written under" $ + notesFor + [("Prelude", Just []), ("Data.Map", Just [("!", infixl' 9)])] + "import qualified Data.Map as M\nf m = m M.! 1\n" + >>= (`shouldContain'` "· M.! infixl 9, declared in Data.Map") + + it "says when two imports disagree about one" $ + notesFor + [ ("Prelude", Just []), + ("Left", Just [("<+>", infixl' 6)]), + ("Right", Just [("<+>", Fixity RightAssoc 5)]) + ] + "import Left\nimport Right\nf a b = a <+> b\n" + >>= (`mentions` "two modules in scope disagree about it") + + it "gives an operator one line however often it is written" $ do + told <- notesFor [("Prelude", Just [])] "f a b c = a b c a\n" + length (filter (T.isInfixOf "") told) `shouldBe` 1 + + describe "how far reading an import got" $ do + it "names the module that stopped it rather than the import above it" $ + throughHspec + >>= ( `mentions` + "may be declared in Test.Hspec → Test.Hspec.Core.Spec \ + \→ Test.QuickCheck.Property, which this run could not read" + ) + + it "says what an import that could not be read was reached through" $ + throughHspec + >>= ( `mentions` + "Test.Hspec: could not be read, through Test.Hspec.Core.Spec \ + \→ Test.QuickCheck.Property" + ) + + it "adds nothing for an import unread on its own account" $ + notesFor [("Prelude", Just [])] "import Criterion.Main\nf a b = a b\n" + >>= (`shouldContain'` "· Criterion.Main: could not be read") + + describe "the shape of it" $ do + it "keeps every line it prints inside the width" $ do + told <- throughHspec + filter ((> lineWidth) . visibleLength) told `shouldBe` [] + + it "sets a line it had to break further in than the entry it belongs to" $ do + told <- throughHspec + let indentOf = T.length . T.takeWhile (== ' ') + opens l = "·" `T.isPrefixOf` T.stripStart l + case break (T.isInfixOf "Test.QuickCheck.Property") told of + (above, broken : _) + | not (opens broken), + (entry : _) <- filter opens (reverse above) -> + indentOf broken `shouldSatisfy` (> indentOf entry) + _ -> expectationFailure (show told) + + it "sets out under headings" $ do + told <- notesFor [("Prelude", Just [("+", infixl' 6)])] "f a b = a + b\n" + map T.stripStart told `shouldContain` ["· imports"] + map T.stripStart told `shouldContain` ["· operators"] + + it "leaves out a heading it would have nothing to put under" $ + notesFor [("Prelude", Just [])] "f = 1\n" + >>= (`shouldSatisfy` all ((/= "· operators") . T.stripStart)) + + it "indents an entry further than the heading it sits under" $ do + told <- notesFor [("Prelude", Just [])] "import Data.Map\n" + let indentOf = T.length . T.takeWhile (== ' ') + under heading = [indentOf l | l <- told, heading `T.isInfixOf` l] + case (under "· imports", under "· Data.Map") of + ([heading], [there]) -> there `shouldSatisfy` (> heading) + (headings, entries) -> + expectationFailure (show (headings, entries)) + + it "says nothing about declarations a module does not make" $ + notesFor [("Prelude", Just [])] "f = 1\n" + >>= (`shouldSatisfy` all (not . T.isInfixOf "declared here")) + + it "lists what the module declares for itself" $ + notesFor [("Prelude", Just [])] "infixr 5 <+>\nf a b = a <+> b\n" + >>= (`shouldContain'` "· <+> infixr 5") + +---------------------------------------------------------------------------- +-- Helpers + +-- | The account given of a module, against a world of imports that could be +-- read and imports that could not. +-- +-- A module named in the world is readable and exports what is listed; a +-- module absent from it is one the resolver could not read at all. +notesFor :: [(Text, Maybe [(Text, Fixity)])] -> Text -> IO [Text] +notesFor = notesThrough [] + +-- | The same, told how far reading got below each import it could not read. +notesThrough :: + -- | What lies below an import, ending at the module that stopped it + [(Text, [Text])] -> + [(Text, Maybe [(Text, Fixity)])] -> + Text -> + IO [Text] +notesThrough chains world source = + renderFixityNotes Plain . Map.singleton "M.hs" + <$> fixityNotes (Is #implicitPrelude) (pure . exportsOf) chainOf scope hsModule + where + scope = + resolveScope + (Is #implicitPrelude) + nothingKnown {knownFixities = exportsOf, knownChain = chainFor} + hsModule + chainFor m = maybe [] id (lookup m chains) + chainOf = pure . chainFor + hsModule = pmModule parsed + parsed = case parseModule defaultParserConfig "M.hs" ("module M where\n" <> source) of + Left problem -> error (T.unpack (describeParseError problem)) + Right m -> m + exportsOf m = do + declared <- lookup m world + inBothNamespaces . Map.fromList . map (\(op, fixity) -> (OpName op, fixity)) + <$> declared + +infixl' :: Int -> Fixity +infixl' = Fixity LeftAssoc + +-- | A module whose one import could not be read, and whose reading stopped +-- two modules further down. The real shape, and long enough to have to be +-- broken to fit the width. +throughHspec :: IO [Text] +throughHspec = + notesThrough + [("Test.Hspec", ["Test.Hspec.Core.Spec", "Test.QuickCheck.Property"])] + [("Prelude", Just [])] + "import Test.Hspec\nf a b = a b\n" + +-- | Is this line among them, whatever it was indented by? +shouldContain' :: [Text] -> Text -> Expectation +shouldContain' told wanted = + map T.stripStart (rejoined told) `shouldContain` [wanted] + +-- | Does some line say this much, whatever else it goes on to say? +mentions :: [Text] -> Text -> Expectation +mentions told wanted = rejoined told `shouldSatisfy` any (T.isInfixOf wanted) + +-- | The entries as they read before they were broken to fit the width. +rejoined :: [Text] -> [Text] +rejoined = foldl add [] + where + add seen l + | null seen || "·" `T.isPrefixOf` T.stripStart l = seen <> [l] + | otherwise = case unsnoc seen of + Just (earlier, one) -> earlier <> [one <> " " <> T.stripStart l] + Nothing -> [l] + unsnoc xs = case reverse xs of + [] -> Nothing + (x : rest) -> Just (reverse rest, x) diff --git a/tests/Tilia/Fixity/DependenciesSpec.hs b/tests/Tilia/Fixity/DependenciesSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Fixity/DependenciesSpec.hs @@ -0,0 +1,374 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TupleSections #-} + +-- | The fixity machinery, run over every dependency this project has. +-- +-- "Tilia.Fixity.PlanSpec" checks the pipeline on a handful of modules +-- picked for what each one exercises. This checks it on all of them. Every +-- module of every package in this project's build plan is read out of the +-- package's source tarball and compared against what the compiler recorded +-- when it built that same package: two independent readings of one fact, +-- one by us and one by GHC. +module Tilia.Fixity.DependenciesSpec (spec) where + +import Control.Monad (filterM) +import Data.ByteString qualified as BS +import Data.Choice (pattern Is) +import Data.Foldable (for_) +import Data.List (isSuffixOf, sort) +import Data.Map.Strict qualified as Map +import Data.Maybe (listToMaybe) +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import GHC.Hs (HsModule) +import GHC.Hs.Extension (GhcPs) +import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) +import System.FilePath (takeDirectory, ()) +import Test.Hspec +import Tilia.Fixity +import Tilia.Fixity.Builtin (builtinFixities) +import Tilia.Fixity.Interface (Interface (..), readInterface) +import Tilia.Fixity.PackageDb +import Tilia.Fixity.Plan +import Tilia.Parser + +spec :: Spec +spec = do + plan <- runIO (readBuildPlan (planPathFor ".")) + case plan of + Left _ -> + it "needs a built project" $ + pendingWith "no build plan; run cabal build first" + Right p -> withPlan p + +withPlan :: BuildPlan -> Spec +withPlan plan = do + installed <- runIO readInstalledPackages + fromSource <- runIO (askFixities <$> newResolverVia [FromSource] plan) + fromInterface <- runIO (askFixities <$> newResolverVia [FromInterface] plan) + resolver <- runIO (newResolver plan) + let resolve = askFixities resolver + own <- runIO ownModules + let isShippedModule m = Map.member m builtinFixities + dependencies <- runIO (dependenciesOf (not . isShippedModule) plan installed) + preloaded <- runIO (dependenciesOf isShippedModule plan installed) + let modules = concatMap depModules dependencies + compilerDir = + listToMaybe + [ takeDirectory dir + | p <- installedPackages installed, + ipName p == "ghc", + dir <- take 1 (ipImportDirs p) + ] + shippedPackages = + Set.fromList + [ ipName p + | p <- installedPackages installed, + dir <- take 1 (ipImportDirs p), + Just (takeDirectory dir) == compilerDir + ] + readFromSourcePackages = + Set.fromList (map depPackage dependencies) + `Set.difference` shippedPackages + missing <- + runIO $ + filterM (fmap not . doesFileExist . snd) + . filter ((`Set.member` readFromSourcePackages) . ppName . fst) + =<< plannedTarballs plan + describe "the tree this project is built against" $ do + it "is a real dependency tree and not an empty plan" $ + length dependencies `shouldSatisfy` (>= 30) + + it "holds modules the compiler does not ship a fixity table for" $ + length modules `shouldSatisfy` (>= 500) + + -- What every comparison below reads one of its two sides out of. A + -- source that is not here contradicts nothing, so the comparisons would + -- pass without having compared anything: this is where that is caught, + -- rather than in a hundred quietly hollow ticks. + it "has the source of every package it reads" $ + case map (T.unpack . ppName . fst) missing of + [] -> pure () + names -> + expectationFailure $ + "no source for " + <> unwords names + <> "; fetch them with nix run .#sources" + + describe "the operators the compiler ships with" $ + parallel $ + for_ (concatMap testsFor preloaded) $ \(label, chunk) -> + it label $ do + wrong <- traverse contradicts chunk + concat wrong `shouldBe` [] + + describe "every dependency declares what the compiler recorded" $ + parallel $ + for_ (concatMap testsFor dependencies) $ \(label, chunk) -> + it label $ do + wrong <- traverse (undeclared fromSource) chunk + concat wrong `shouldBe` [] + + describe "every dependency reads the same both ways" $ + parallel $ + for_ (concatMap testsFor dependencies) $ \(label, chunk) -> + it label $ do + wrong <- traverse (conflicting fromSource fromInterface . fst) chunk + concat wrong `shouldBe` [] + + describe "how much of the tree it reaches" $ do + it "answers for every module of every dependency" $ do + answers <- traverse (\(m, _) -> (m,) <$> resolve m) modules + [m | (m, Nothing) <- answers] `shouldBe` [] + + it "answers for every one of them out of the interfaces alone" $ do + answers <- traverse (\(m, _) -> (m,) <$> fromInterface m) modules + [m | (m, Nothing) <- answers] `shouldBe` [] + + -- A loose floor on purpose. How much of the tree source alone reaches + -- depends on the order the modules are asked for: a module in a + -- re-export cycle is answered with what the cycle held when the chase + -- reached it, and which module of the cycle gives way is whichever was + -- entered first. Measured over ghc-lib-parser's 450 modules, sweeping + -- them forwards, backwards and from twelve threads moved two of them + -- either way, and over the whole tree the figure has been seen between + -- 74% and 80%. The check is here to catch the route collapsing, not to + -- pin a number that is not pinned. + it "reads most of them out of source alone" $ do + answers <- traverse (fromSource . fst) modules + let reached = length [() | Just _ <- answers] + percent reached (length modules) `shouldSatisfy` (>= 70) + + it "finds the operators that are in it" $ do + answers <- traverse (fromSource . fst) modules + sum [Map.size fixities | Just fixities <- answers] `shouldSatisfy` (>= 300) + + describe "this project's own modules" $ do + it "parses every one of them" $ + [path | (path, Nothing) <- own] `shouldBe` [] + + it "resolves every module they import" $ do + answers <- traverse (\m -> (m,) <$> resolve m) (importedByOwn own) + [m | (m, Nothing) <- answers] `shouldBe` [] + + it "settles every operator they use" $ do + unsettled <- traverse (unsettledIn resolver) [(path, m) | (path, Just m) <- own] + concat unsettled `shouldBe` [] + +---------------------------------------------------------------------------- +-- The dependencies + +-- | A package this project is built against, as the compiler holds it. +data Dependency = Dependency + { -- | The package name + depPackage :: Text, + -- | Each module the package holds, with the interface file the compiler + -- wrote for it. + depModules :: [(Text, FilePath)] + } + +-- | The modules of every package in the plan that the compiler can also +-- see, keeping the ones the predicate wants. +dependenciesOf :: (Text -> Bool) -> BuildPlan -> Installed -> IO [Dependency] +dependenciesOf wanted plan installed = + filter (not . null . depModules) <$> traverse ofPackage candidates + where + candidates = + [ (package, dir) + | package <- installedPackages installed, + Set.member (ipName package) planned, + dir <- take 1 (ipImportDirs package) + ] + ofPackage (package, dir) = + Dependency (ipName package) + <$> filterM + (doesFileExist . snd) + [ (m, dir T.unpack (T.replace "." "/" m) <> ".hi") + | m <- ipModules package, + wanted m + ] + planned = Set.fromList [ppName p | p <- bpPackages plan, not (isLocal p)] + isLocal p = case ppSource p of + LocalPackage _ -> True + _ -> False + +-- | One test per package, splitting the large ones up. +testsFor :: Dependency -> [(String, [(Text, FilePath)])] +testsFor dependency = case chunksOf 32 (depModules dependency) of + [whole] -> [(name, whole)] + pieces -> + [ (name <> " (" <> show i <> " of " <> show (length pieces) <> ")", piece) + | (i, piece) <- zip [1 :: Int ..] pieces + ] + where + name = T.unpack (depPackage dependency) + +chunksOf :: Int -> [a] -> [[a]] +chunksOf n = \case + [] -> [] + xs -> let (chunk, rest) = splitAt n xs in chunk : chunksOf n rest + +-- | Where the built-in table and the compiler both hold a fixity for an +-- operator and it is not the same fixity. +-- +-- The table in "Tilia.Fixity.Builtin" was written by asking a GHC of one +-- version what its boot packages export. The tests run against whichever +-- GHC built the project, which this package supports three of. This is what +-- says the answer has not moved underneath the table. +contradicts :: (Text, FilePath) -> IO [String] +contradicts (modName, interfaceFile) = + readInterface modName interfaceFile >>= \case + Nothing -> pure [] + Just interface -> + pure + [ T.unpack modName + <> ": " + <> show op + <> " is " + <> show declared + <> " per the compiler, " + <> show ours + <> " in the table" + | (op, declared) <- Map.toList (interfaceDeclares interface), + Just ours <- [Map.lookup op table], + ours /= declared + ] + where + table = Map.findWithDefault Map.empty modName builtinFixities + +-- | Every fixity the compiler recorded for a module that reading the +-- package's source did not produce. +undeclared :: + -- | What a module declares, read from the package's source + (Text -> IO (Maybe (Fixities))) -> + -- | The module, and the interface the compiler wrote for it + (Text, FilePath) -> + IO [String] +undeclared fromSource (modName, interfaceFile) = + readInterface modName interfaceFile >>= \case + Nothing -> pure [] + Just interface -> + fromSource modName >>= \case + Nothing -> pure [] + Just fixities -> + pure + [ T.unpack modName + <> ": " + <> show op + <> " is " + <> show declared + <> " per the compiler, " + <> show (Map.lookup op fixities) + <> " from source" + | (op, declared) <- Map.toList (interfaceDeclares interface), + writable declared, + Map.lookup op fixities /= Just declared + ] + where + -- GHC files @->@ under a module's fixities at precedence -1, below + -- anything a source file is allowed to declare. + writable f = fixityPrecedence f >= 0 && fixityPrecedence f <= 9 + +-- | Where the two routes both have an answer for an operator and it is not +-- the same answer. +-- +-- Wider than 'undeclared', because a module's own declarations are the +-- smaller part of what it offers: most operators reach the module that +-- exports them through a chain of re-exports, and following that chain +-- through source text is the part of this most likely to go wrong. The +-- compiler followed the same chain when it built the package, so the two +-- have to arrive at the same place. +conflicting :: + -- | The answer read out of the package's source + (Text -> IO (Maybe (Fixities))) -> + -- | The answer read out of the compiler's interfaces + (Text -> IO (Maybe (Fixities))) -> + Text -> + IO [String] +conflicting fromSource fromInterface modName = do + source <- fromSource modName + compiled <- fromInterface modName + pure $ case (source, compiled) of + (Just a, Just b) -> + [ T.unpack modName + <> ": " + <> show op + <> " is " + <> show fromText + <> " from source, " + <> show fromIface + <> " from the interface" + | (op, (fromText, fromIface)) <- Map.toList (Map.intersectionWith (,) a b), + fromText /= fromIface + ] + _ -> [] + +percent :: Int -> Int -> Int +percent part whole = if whole == 0 then 0 else part * 100 `div` whole + +---------------------------------------------------------------------------- +-- This project + +-- | Every Haskell file this project is made of, parsed. +-- +-- 'Nothing' where one did not parse, which is a failure of its own rather +-- than something to skip over quietly. +ownModules :: IO [(FilePath, Maybe (HsModule GhcPs))] +ownModules = do + paths <- concat <$> traverse haskellFilesIn ["src", "app", "tests"] + traverse parsed paths + where + parsed path = do + source <- T.decodeUtf8Lenient <$> BS.readFile path + pure + ( path, + case parseModule defaultParserConfig path source of + Left _ -> Nothing + Right pm -> Just (pmModule pm) + ) + +haskellFilesIn :: FilePath -> IO [FilePath] +haskellFilesIn dir = do + entries <- sort <$> listDirectory dir + concat <$> traverse below entries + where + below entry = do + let path = dir entry + isDir <- doesDirectoryExist path + if isDir + then haskellFilesIn path + else pure [path | ".hs" `isSuffixOf` path] + +-- | Every module this project's own source imports. +importedByOwn :: [(FilePath, Maybe (HsModule GhcPs))] -> [Text] +importedByOwn own = + Set.toList . Set.fromList $ + [ importModule i + | (_, Just hsModule) <- own, + i <- moduleImports (Is #implicitPrelude) hsModule, + not ("Paths_" `T.isPrefixOf` importModule i) + ] + +-- | The operators one of this project's modules uses that its imports, +-- resolved for real, cannot settle. +-- +-- This is the whole machinery end to end: the plan is read, the packages +-- are found, their modules are read, the scope is assembled and the +-- operators are looked up in it. Anything left over is an operator this +-- project could not be laid out from. +unsettledIn :: + Resolver -> + (FilePath, HsModule GhcPs) -> + IO [String] +unsettledIn resolver (path, hsModule) = do + scope <- scopeFor resolver (Is #implicitPrelude) hsModule + pure + [ path <> ": " <> T.unpack (operatorSpelling qualifier op) <> " " <> show why + | ((qualifier, op), why) <- unknownOperators scope hsModule + ] diff --git a/tests/Tilia/Fixity/InterfaceSpec.hs b/tests/Tilia/Fixity/InterfaceSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Fixity/InterfaceSpec.hs @@ -0,0 +1,204 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Reading what @ghc --show-iface@ prints. +-- +-- The samples below are cut from real output rather than invented, since +-- the whole risk here is in the format: this is a pretty-printer's idea of +-- an interface, not a documented one. +module Tilia.Fixity.InterfaceSpec (spec) where + +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text (Text) +import Test.Hspec +import Tilia.Fixity +import Tilia.Fixity.Interface + +spec :: Spec +spec = do + describe "what a module declares" $ do + it "reads a fixity line" $ + declares "fixities infixl 9 !, infixl 9 !?, infixl 9 \\\\\n" + `shouldBe` [ (OpName "!", Fixity LeftAssoc 9), + (OpName "!?", Fixity LeftAssoc 9), + (OpName "\\\\", Fixity LeftAssoc 9) + ] + + it "reads one wrapped across lines" $ + declares + "fixities infixr 0 $, infixr 0 $!, infixl 4 *>, infixr 5 ++,\n\ + \ infixr 9 ., infixr 5 :|, infixl 4 <$\n" + `shouldBe` [ (OpName "$", Fixity RightAssoc 0), + (OpName "$!", Fixity RightAssoc 0), + (OpName "*>", Fixity LeftAssoc 4), + (OpName "++", Fixity RightAssoc 5), + (OpName ".", Fixity RightAssoc 9), + (OpName ":|", Fixity RightAssoc 5), + (OpName "<$", Fixity LeftAssoc 4) + ] + + it "reads every direction, and a name used in backticks" $ + declares "fixities infixl 7 div, infix 4 ===, infixr 1 .&&.\n" + `shouldBe` [ (OpName ".&&.", Fixity RightAssoc 1), + (OpName "===", Fixity NoAssoc 4), + (OpName "div", Fixity LeftAssoc 7) + ] + + it "reads the precedence GHC gives the function arrow" $ + declares "fixities infixr -1 ->\n" + `shouldBe` [(OpName "->", Fixity RightAssoc (-1))] + + it "reads it alongside ordinary ones" $ + declares "fixities infixr -1 ->, infixl 9 !\n" + `shouldBe` [(OpName "!", Fixity LeftAssoc 9), (OpName "->", Fixity RightAssoc (-1))] + + it "passes over an entry it cannot read, and keeps the rest" $ + declares "fixities infixl notadigit ?, infixl 9 !, infixl\n" + `shouldBe` [(OpName "!", Fixity LeftAssoc 9)] + + it "says nothing for a module that declares nothing" $ + declares "exports:\n member\n" `shouldBe` [] + + describe "what a module passes on" $ do + it "names the module an operator was declared in" $ + passesOn "exports:\n Data.Aeson.Types.FromJSON..:\n" + `shouldBe` [("Data.Aeson.Types.FromJSON", OpName ".:")] + + it "leaves out what the module declared itself" $ + passesOn "exports:\n decode'\n <+>\n" `shouldBe` [] + + it "takes the members of a class along with it" $ + passesOn + "exports:\n\ + \ Data.Aeson.Types.FromJSON.FromJSON{Data.Aeson.Types.FromJSON.parseJSON}\n" + `shouldBe` [ ("Data.Aeson.Types.FromJSON", OpName "FromJSON"), + ("Data.Aeson.Types.FromJSON", OpName "parseJSON") + ] + + it "takes a record field, written after a bar" $ + passesOn "exports:\n Data.Aeson.Encoding.Internal.Encoding'|{Data.Aeson.Encoding.Internal.fromEncoding}\n" + `shouldBe` [ ("Data.Aeson.Encoding.Internal", OpName "Encoding'"), + ("Data.Aeson.Encoding.Internal", OpName "fromEncoding") + ] + + it "keeps a type apart from the module holding it" $ + passesOn "exports:\n Data.Aeson.Types.Internal.Value\n" + `shouldBe` [("Data.Aeson.Types.Internal", OpName "Value")] + + it "reads an operator that is nothing but a dot" $ + passesOn "exports:\n Data.Function..\n" + `shouldBe` [("Data.Function", OpName ".")] + + it "leaves a capitalised name this module declared alone" $ + passesOn "exports:\n Value\n" `shouldBe` [] + + describe "which namespace a fixity governs" $ do + it "gives one to types where the module declares a type of that name" $ + declaresIn "fixities infix 4 :~:\nab12\n data (:~:) a b where\n" + `shouldBe` [((InTypes, OpName ":~:"), Fixity NoAssoc 4)] + + it "gives one to terms where nothing declares a type of that name" $ + declaresIn "fixities infixl 9 !\nab12\n (!) :: Int -> Int -> Int\n" + `shouldBe` [((InTerms, OpName "!"), Fixity LeftAssoc 9)] + + it "reads a type synonym as a type" $ + declaresIn "fixities infixr 5 :+\nab12\n type (:+) :: * -> * -> *\n" + `shouldBe` [((InTypes, OpName ":+"), Fixity RightAssoc 5)] + + it "reads a type family as a type" $ + declaresIn "fixities infixl 6 ==\nab12\n type family (==) a b where\n" + `shouldBe` [((InTypes, OpName "=="), Fixity LeftAssoc 6)] + + it "reads a class as a type" $ + declaresIn "fixities infixl 4 <%>\nab12\n class (<%>) a where\n" + `shouldBe` [((InTypes, OpName "<%>"), Fixity LeftAssoc 4)] + + it "takes a role declaration as saying the name is a type" $ + declaresIn "fixities infixl 9 !\nab12\n type role (!) nominal\n" + `shouldBe` [((InTypes, OpName "!"), Fixity LeftAssoc 9)] + + it "is not misled by declarations of other names" $ + declaresIn "fixities infixl 9 !\nab12\n data Other a b where\n (!) :: Int\n" + `shouldBe` [((InTerms, OpName "!"), Fixity LeftAssoc 9)] + + describe "what a name carries with it" $ do + it "takes the members an entry wears in braces" $ + carries "exports:\n GHC.Internal.Base.NonEmpty{GHC.Internal.Base.:|}\n" + `shouldBe` [(OpName "NonEmpty", [OpName ":|"])] + + it "takes every one of them" $ + carries + "exports:\n\ + \ GHC.Internal.Base.Applicative{GHC.Internal.Base.*> GHC.Internal.Base.<*> GHC.Internal.Base.pure}\n" + `shouldBe` [(OpName "Applicative", [OpName "*>", OpName "<*>", OpName "pure"])] + + it "takes them from a partial export, which still says what it has" $ + carries "exports:\n GHC.Internal.Base.Functor|{GHC.Internal.Base.<$}\n" + `shouldBe` [(OpName "Functor", [OpName "<$"])] + + it "takes a name this module declared, written without a module" $ + carries "exports:\n WrappedArrow{WrapArrow unwrapArrow}\n" + `shouldBe` [(OpName "WrappedArrow", [OpName "WrapArrow", OpName "unwrapArrow"])] + + it "keeps entries apart where several sit on one line" $ + carries "exports:\n A{B} C{D}\n" + `shouldBe` [(OpName "A", [OpName "B"]), (OpName "C", [OpName "D"])] + + it "has nothing to say about a name that carries nothing" $ + carries "exports:\n decode'\n Data.Aeson.Types.FromJSON..:\n" `shouldBe` [] + + describe "sections it has no use for" $ + it "is not confused by the rest of the file" $ do + let out = + "Magic: Wanted 33214052,\n\ + \ got 33214052\n\ + \interface Data.Aeson 9103\n\ + \ interface hash: 6b4f\n\ + \exports:\n\ + \ Data.Aeson.Types.FromJSON..:\n\ + \fixities infixl 9 !\n\ + \direct package dependencies: base-4.20.2.0 bytestring-0.12.2.0\n\ + \orphans: Data.Orphans\n\ + \trusted: none\n" + fmap (Map.toList . interfaceDeclares) (parseInterface "Data.Aeson" out) + `shouldBe` Just [((InTerms, OpName "!"), Fixity LeftAssoc 9)] + fmap interfacePassedOn (parseInterface "Data.Aeson" out) + `shouldBe` Just [("Data.Aeson.Types.FromJSON", OpName ".:")] + + describe "output it will not read" $ do + it "refuses what does not name a module at all" $ + parseInterface "M" "some future rendering we do not recognise\n" + `shouldBe` Nothing + + it "refuses an interface for a different module" $ + parseInterface "Data.Map.Strict" (header "Data.Map.Lazy" <> "fixities infixl 9 !\n") + `shouldBe` Nothing + + it "reads one that names the module asked for" $ + declares "fixities infixl 9 !\n" `shouldBe` [(OpName "!", Fixity LeftAssoc 9)] + +header :: Text -> Text +header modName = "interface " <> modName <> " 9103\n" + +-- | The fixities an interface of this shape declares, by name alone. +declares :: Text -> [(OpName, Fixity)] +declares = + map (\((_, op), fixity) -> (op, fixity)) + . maybe [] (Map.toList . interfaceDeclares) + . parseInterface "M" + . (header "M" <>) + +-- | The same, keeping the namespace each governs. +declaresIn :: Text -> [((Namespace, OpName), Fixity)] +declaresIn = + maybe [] (Map.toList . interfaceDeclares) . parseInterface "M" . (header "M" <>) + +passesOn :: Text -> [(Text, OpName)] +passesOn = maybe [] interfacePassedOn . parseInterface "M" . (header "M" <>) + +-- | What each exported name carries with it, in a settled order. +carries :: Text -> [(OpName, [OpName])] +carries = + maybe [] (map (fmap Set.toList) . Map.toList . interfaceChildren) + . parseInterface "M" + . (header "M" <>) diff --git a/tests/Tilia/Fixity/PackageDbSpec.hs b/tests/Tilia/Fixity/PackageDbSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Fixity/PackageDbSpec.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Reading what the compiler says it has. +module Tilia.Fixity.PackageDbSpec (spec) where + +import Data.List (isInfixOf) +import Data.Map.Strict qualified as Map +import Data.Text (Text) +import Test.Hspec +import Tilia.Fixity.PackageDb + +spec :: Spec +spec = do + describe "one record of ghc-pkg dump" $ do + it "reads the directories a package's interfaces are in" $ + dirsOf [("import-dirs", "/opt/ghc/lib/base-4.20.2.0")] + `shouldBe` Just ["/opt/ghc/lib/base-4.20.2.0"] + + it "puts the package root where the registration left a variable" $ + dirsOf + [ ("pkgroot", "\"/opt/ghc/lib\""), + ("import-dirs", "${pkgroot}/../lib/base-4.20.2.0") + ] + `shouldBe` Just ["/opt/ghc/lib/../lib/base-4.20.2.0"] + + it "leaves the variable alone when the record does not say" $ + dirsOf [("import-dirs", "${pkgroot}/../lib/base-4.20.2.0")] + `shouldBe` Just ["${pkgroot}/../lib/base-4.20.2.0"] + + it "roots every directory a package names" $ + dirsOf + [ ("pkgroot", "/opt/ghc/lib"), + ("import-dirs", "${pkgroot}/one ${pkgroot}/two") + ] + `shouldBe` Just ["/opt/ghc/lib/one", "/opt/ghc/lib/two"] + + it "says nothing of a record that names no package" $ + fromFields (Map.fromList [("import-dirs", "/opt/ghc/lib")]) + `shouldBe` Nothing + + describe "what this compiler reports" $ + it "leaves no path variable in any import directory" $ do + installed <- readInstalledPackages + [ dir + | p <- installedPackages installed, + dir <- ipImportDirs p, + "${" `isInfixOf` dir + ] + `shouldBe` [] + +-- | The import directories one record amounts to, given its fields. +dirsOf :: [(Text, Text)] -> Maybe [FilePath] +dirsOf fields = + ipImportDirs + <$> fromFields (Map.fromList (named <> fields)) + where + named = [("name", "base"), ("version", "4.20.2.0")] diff --git a/tests/Tilia/Fixity/PlanSpec.hs b/tests/Tilia/Fixity/PlanSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Fixity/PlanSpec.hs @@ -0,0 +1,1517 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} + +-- | The whole fixity pipeline, run against this project's own dependencies. +-- +-- These tests read the real build plan, the real package cache and real +-- Hackage sources. That is the point: every other test in the suite works +-- on constructed inputs, and constructed inputs are exactly what a pipeline +-- that talks to the outside world will not fail on. +-- +-- Running the test suite implies the project was built, so the plan and the +-- sources are there. Where they are not — a sandboxed build with no package +-- cache — each test says so and is marked pending rather than failing. +module Tilia.Fixity.PlanSpec (spec) where + +import Codec.Archive.Tar qualified as Tar +import Codec.Archive.Tar.Entry qualified as Tar +import Codec.Compression.GZip qualified as GZip +import Control.Exception (bracket) +import Control.Monad (when) +import Data.ByteString.Lazy qualified as BL +import Data.Choice (pattern Is) +import Data.Foldable (traverse_) +import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef) +import Data.List (isInfixOf) +import Data.List qualified +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import Data.Text.IO qualified as T +import System.Directory (createDirectoryIfMissing) +import System.Environment (lookupEnv, setEnv, unsetEnv) +import System.FilePath (dropExtension, takeBaseName, takeDirectory, ()) +import System.IO.Temp (withSystemTempDirectory) +import Test.Hspec +import Tilia.Fixity +import Tilia.Fixity.PackageDb (compilerIdentity) +import Tilia.Fixity.Plan +import Tilia.Parser +import Tilia.Process (readProgramOutput) + +spec :: Spec +spec = do + preparation + tokens + reexports + hscModules + generatedModuleSpec + gitDependencies + repositories + packageCache + plan <- runIO (readBuildPlan (planPathFor ".")) + case plan of + Left _ -> unavailable "no build plan; run cabal build first" + Right p -> withPlan p + +-- | What a cached failure is filed under. +-- +-- A failure to read a module leans on the plan and on the compiler this run +-- can ask, so both have to be in the token. Were the environment left out, +-- a shell that cannot see a package would hand its "could not be read" to +-- one that can. +tokens :: Spec +tokens = describe "the token a plan is cached under" $ do + it "differs between environments over the same plan" $ + planToken "/one/bin/ghc-pkg" onePackage + `shouldNotBe` planToken "/another/bin/ghc-pkg" onePackage + + it "differs between plans in the same environment" $ + planToken here onePackage `shouldNotBe` planToken here noPackages + + it "is the same twice over for the same plan and environment" $ + planToken here onePackage `shouldBe` planToken here onePackage + + it "asks the environment it is actually going to read in" $ do + asked <- tokenFor onePackage + environment <- compilerIdentity + asked `shouldBe` planToken environment onePackage + where + here = "/somewhere/bin/ghc-pkg" + noPackages = BuildPlan {bpCompiler = "ghc-9.10.3", bpPackages = []} + onePackage = + BuildPlan + { bpCompiler = "ghc-9.10.3", + bpPackages = + [ PlanPackage + { ppName = "containers", + ppVersion = "0.7", + ppSource = PreExisting, + ppComponents = [] + } + ] + } + +-- | What a run does before it trusts the plan. +-- +-- These need no plan of their own and no @cabal@: the point is the order of +-- the steps, so the steps are recorded rather than taken. +preparation :: Spec +preparation = describe "preparing a project" $ do + it "solves and then fetches, in the one run" $ + withTempProject Nothing $ \dir -> do + steps <- newIORef [] + let cabal args = do + record steps args + when (args == solving) (writePlan dir wantingATarball) + pure (Right ()) + checkReadiness [] dir `shouldReturn` PlanMissing + prepareWith cabal forgetfulSolves [] dir PlanMissing `shouldReturn` Right () + readIORef steps + `shouldReturn` [solving, fetching] + + it "fetches without solving when the plan is already good" $ + withTempProject (Just wantingATarball) $ \dir -> do + steps <- newIORef [] + readiness <- checkReadiness [] dir + readiness `shouldBe` SourcesMissing ["tilia-phantom"] + prepareWith (obliging steps) forgetfulSolves [] dir readiness `shouldReturn` Right () + readIORef steps `shouldReturn` [fetching] + + it "runs nothing at all when nothing is missing" $ do + steps <- newIORef [] + prepareWith (obliging steps) forgetfulSolves [] "." Ready `shouldReturn` Right () + readIORef steps `shouldReturn` [] + + it "does not go on to fetch when the solve fails" $ + withTempProject Nothing $ \dir -> do + steps <- newIORef [] + let cabal args = record steps args >> pure (Left "cabal said no") + prepareWith cabal forgetfulSolves [] dir PlanMissing `shouldReturn` Left "cabal said no" + readIORef steps `shouldReturn` [solving, narrowSolve] + + it "asks about the test suites and the benchmarks, not the library alone" $ + withTempProject Nothing $ \dir -> do + steps <- newIORef [] + let cabal args = do + record steps args + when (args == solving) (writePlan dir wantingATarball) + pure (Right ()) + _ <- prepareWith cabal forgetfulSolves [] dir PlanMissing + asked <- readIORef steps + asked `shouldSatisfy` all (\args -> wholeProject `Data.List.isSuffixOf` args) + + it "settles for what will solve when the whole project will not" $ + withTempProject Nothing $ \dir -> do + steps <- newIORef [] + let cabal args = do + record steps args + if wholeProject `Data.List.isSuffixOf` args + then pure (Left "a test suite will not solve") + else do + when (args == narrowSolve) (writePlan dir wantingATarball) + pure (Right ()) + prepareWith cabal forgetfulSolves [] dir PlanMissing `shouldReturn` Right () + readIORef steps + `shouldReturn` [solving, narrowSolve, fetching, narrowFetch] + + describe "a plan narrower than the run" $ do + it "notices a component the plan says nothing about" $ + withTempProject (Just twoComponents) $ \dir -> + checkReadiness [component "test:tests"] dir + `shouldReturn` PlanNarrow ["thing:test:tests"] + + it "names every one it is missing" $ + withTempProject (Just twoComponents) $ \dir -> + checkReadiness [component "test:tests", component "bench:speed"] dir + `shouldReturn` PlanNarrow ["thing:test:tests", "thing:bench:speed"] + + it "is content with the components the plan does cover" $ + withTempProject (Just twoComponents) $ \dir -> + checkReadiness [component "lib", component "exe:thing"] dir + `shouldReturn` Ready + + it "asks for nothing when the run asks about nothing" $ + withTempProject (Just twoComponents) $ \dir -> + checkReadiness [] dir `shouldReturn` Ready + + it "solves again rather than trusting it" $ + withTempProject (Just twoComponents) $ \dir -> do + steps <- newIORef [] + let cabal args = do + record steps args + when (args == solving) (writePlan dir twoComponents) + pure (Right ()) + prepareWith cabal forgetfulSolves [component "test:tests"] dir (PlanNarrow ["thing:test:tests"]) + `shouldReturn` Right () + readIORef steps `shouldReturn` [solving] + + it "counts the components of this very project as covered" $ do + plan' <- readBuildPlan (planPathFor ".") + case plan' of + Left _ -> pendingWith "no build plan; run cabal build first" + Right p -> + checkReadiness (plannedComponents p) "." + `shouldNotReturn` PlanNarrow [] + + it "solves only the once when solving does not widen it" $ + withTempProject (Just twoComponents) $ \dir -> do + steps <- newIORef [] + futile <- newIORef False + let cabal args = do + record steps args + when (args == solving) (writePlan dir twoComponents) + pure (Right ()) + solves = + forgetfulSolves + { solveWasFutile = readIORef futile, + rememberFutileSolve = writeIORef futile True + } + narrow = PlanNarrow ["thing:test:tests"] + once = prepareWith cabal solves [component "test:tests"] dir narrow + once `shouldReturn` Right () + readIORef futile `shouldReturn` True + once `shouldReturn` Right () + readIORef steps `shouldReturn` [solving] + + it "fetches what a plan it cannot widen is short of" $ + withTempProject (Just narrowAndWanting) $ \dir -> do + steps <- newIORef [] + let cabal args = do + record steps args + when (args == solving) (writePlan dir narrowAndWanting) + pure (Right ()) + narrow = PlanNarrow ["thing:test:tests"] + prepareWith cabal forgetfulSolves [component "test:tests"] dir narrow + `shouldReturn` Right () + readIORef steps + `shouldReturn` [solving, fetching] + + it "fetches it even once solving again has been given up on" $ + withTempProject (Just narrowAndWanting) $ \dir -> do + steps <- newIORef [] + futile <- newIORef True + let solves = + forgetfulSolves + { solveWasFutile = readIORef futile, + rememberFutileSolve = writeIORef futile True + } + narrow = PlanNarrow ["thing:test:tests"] + prepareWith (obliging steps) solves [component "test:tests"] dir narrow + `shouldReturn` Right () + readIORef steps `shouldReturn` [fetching] + + it "does not ask again for what fetching did not bring in" $ + withTempProject (Just narrowAndWanting) $ \dir -> do + steps <- newIORef [] + refused <- newIORef [] + let solves = + forgetfulSolves + { solveWasFutile = pure True, + fetchWasFutileFor = readIORef refused, + rememberFutileFetch = writeIORef refused + } + narrow = PlanNarrow ["thing:test:tests"] + again = prepareWith (obliging steps) solves [component "test:tests"] dir narrow + again `shouldReturn` Right () + readIORef refused `shouldReturn` ["tilia-phantom"] + again `shouldReturn` Right () + readIORef steps `shouldReturn` [fetching] + + it "goes on solving while solving still widens it" $ + withTempProject (Just twoComponents) $ \dir -> do + steps <- newIORef [] + futile <- newIORef False + let cabal args = do + record steps args + when (args == solving) (writePlan dir threeComponents) + pure (Right ()) + solves = + forgetfulSolves + { solveWasFutile = readIORef futile, + rememberFutileSolve = writeIORef futile True + } + prepareWith cabal solves [component "test:tests"] dir (PlanNarrow ["thing:test:tests"]) + `shouldReturn` Right () + readIORef futile `shouldReturn` False + readIORef steps `shouldReturn` [solving] + + describe "a package the plan could not take apart" $ do + it "counts the components it lists under one entry" $ + withTempProject (Just plannedWhole) $ \dir -> + checkReadiness [component "lib", component "test:spec"] dir + `shouldReturn` Ready + + it "still misses one that entry does not list" $ + withTempProject (Just plannedWhole) $ \dir -> + checkReadiness [component "bench:speed"] dir + `shouldReturn` PlanNarrow ["thing:bench:speed"] + + it "does not offer the Setup program as a component" $ do + plan' <- withTempProject (Just plannedWhole) (readBuildPlan . planPathFor) + fmap plannedComponents plan' + `shouldBe` Right [component "lib", component "test:spec"] + +-- | Chasing an operator a module passes on rather than declares. +-- +-- No plan and no network here: the modules a name could have come from +-- answer out of a table written below, which is what makes it possible to +-- ask not merely whether an answer came back but which module it came from. +reexports :: Spec +reexports = describe "an operator a module passes on" $ do + it "comes from the module the qualifier names" $ + chased "module M ((Disp.<+>)) where\nimport Control.Arrow (first)\nimport qualified Text.PrettyPrint as Disp\n" + `shouldReturn` Just (Fixity LeftAssoc 6) + + it "comes from an import that brings it in, not one that hides it" $ + chased "module M ((<+>)) where\nimport Control.Arrow hiding ((<+>))\nimport Text.PrettyPrint\n" + `shouldReturn` Just (Fixity LeftAssoc 6) + + it "comes from an import that brings it in, not one that never names it" $ + chased "module M ((<+>)) where\nimport Control.Arrow (first)\nimport Text.PrettyPrint\n" + `shouldReturn` Just (Fixity LeftAssoc 6) + + it "does not come from a qualified import when it is written plainly" $ + chased "module M ((<+>)) where\nimport Control.Arrow\nimport qualified Text.PrettyPrint as Disp\n" + `shouldReturn` Just (Fixity RightAssoc 5) + + it "is the module's own where the module declares it" $ + chased "module M ((<+>)) where\nimport Control.Arrow\ninfixr 3 <+>\n(<+>) :: Int -> Int -> Int\na <+> b = a + b\n" + `shouldReturn` Just (Fixity RightAssoc 3) + + it "is not answered at all when the module it came from cannot be read" $ + chased "module M ((<+>)) where\nimport No.Such.Module\n" + `shouldReturn` Nothing + + it "comes from a type handed on whole, which carries it" $ + chased "module M (Doc (..)) where\nimport Text.PrettyPrint\n" + `shouldReturn` Just (Fixity LeftAssoc 6) + + it "does not come from a type handed on by an import that hides it" $ + chased "module M (Doc (..)) where\nimport Text.PrettyPrint hiding (Doc (..))\nimport Control.Arrow\n" + `shouldReturn` Nothing + +-- | What a module written for @hsc2hs@ amounts to, by either route to one. +-- +-- Both fixtures below are what @hsc2hs@ takes and no compiler does, and +-- both write a fixity that the answer is expected to ignore. That is the +-- point: a module nothing can read is answered out of +-- 'Tilia.Fixity.ByHand.hscFixities' or not at all, and were either answer +-- arrived at by reading the file there would be no answer to give. +hscModules :: Spec +hscModules = describe "a module written for hsc2hs" $ do + it "declares nothing, where it is one of the project's own" $ + withFakeProject [("src/Cursed.hsc", cursed)] $ + \rs -> do + askFixities rs "Cursed" `shouldReturn` Just Map.empty + askExportNames rs "Cursed" `shouldReturn` Just Set.empty + askChildren rs "Cursed" `shouldReturn` Map.empty + + it "declares what the table says, where it comes out of a tarball" + $ withFakeArchive + [ ("Cursed.hsc", cursed), + ("System/Posix/Signals.hsc", signals) + ] + $ \rs -> do + askFixities rs "Cursed" `shouldReturn` Just Map.empty + askExportNames rs "System.Posix.Signals" + `shouldReturn` Just (Set.fromList [OpName "addSignal", OpName "deleteSignal"]) + +-- | Where a package fetched from a repository is looked for. +repositories :: Spec +repositories = describe "a package fetched from a repository" $ do + it "finds one Hackage downloaded" + $ withCache + [("hackage.haskell.org", "thing", "1.0")] + (fromRepository "{\"type\":\"secure-repo\",\"uri\":\"http://hackage.haskell.org/\"}") + $ \found -> found `shouldSatisfy` isUnder "hackage.haskell.org" + + it "finds one a private repository downloaded, named after its host" + $ withCache + [("packages.example.com", "thing", "1.0")] + (fromRepository "{\"type\":\"secure-repo\",\"uri\":\"https://packages.example.com/\"}") + $ \found -> found `shouldSatisfy` isUnder "packages.example.com" + + it "finds one whose directory is not named after its host" + $ withCache + [("my-company", "thing", "1.0")] + (fromRepository "{\"type\":\"secure-repo\",\"uri\":\"https://packages.example.com/\"}") + $ \found -> found `shouldSatisfy` isUnder "my-company" + + it "leaves a file+noindex repository's tarballs where they are" $ + withSystemTempDirectory "tilia-noindex" $ \repo -> do + T.writeFile (repo "thing-1.0.tar.gz") "not really a tarball" + withCache + [] + (fromRepository ("{\"type\":\"local-repo-no-index\",\"path\":\"" <> T.pack repo <> "\"}")) + $ \found -> found `shouldBe` (repo "thing-1.0.tar.gz") + + it "says where its own repository would put one nothing has downloaded" $ + withCache [] (fromRepository "{\"type\":\"secure-repo\",\"uri\":\"https://packages.example.com/\"}") $ + \found -> found `shouldSatisfy` isUnder "packages.example.com" + + it "falls back on Hackage for a plan that names no repository at all" $ + withCache [("hackage.haskell.org", "thing", "1.0")] planWithoutARepository $ + \found -> found `shouldSatisfy` isUnder "hackage.haskell.org" + +-- | Is the tarball under this repository's directory of the cache? +isUnder :: FilePath -> FilePath -> Bool +isUnder repo path = ("/" <> repo <> "/") `Data.List.isInfixOf` path + +-- | Where the package cache is looked for. +-- +-- @cabal@ answers this differently on each platform and has answered it two +-- ways on this one, so the rule is to look everywhere it could be and take +-- whichever place holds an index. These drive the search by moving the +-- directories it derives from, which on Unix are these two variables. +packageCache :: Spec +packageCache = describe "where the package cache is looked for" $ do + -- Whatever cabal says it is. Checked against cabal rather than against a + -- path spelled out here, because the whole point of asking is that this + -- suite cannot know what the answer should be on somebody else's + -- machine—and did not, on Windows. + it "is the directory cabal reports" $ do + said <- readProgramOutput "cabal" ["path", "--remote-repo-cache"] + case said of + Nothing -> pendingWith "no cabal on the path to ask" + Just reported -> + packageCacheRoot `shouldReturn` T.unpack (T.strip reported) + + describe "and where it is guessed, for a cabal too old to ask" $ do + it "is what CABAL_DIR says, above all else" $ + withSystemTempDirectory "tilia-cabal-dir" $ \dir -> + withEnvironment [("CABAL_DIR", dir)] $ + guessedPackageCacheRoot `shouldReturn` (dir "packages") + + it "is the XDG cache where the index is there" $ + withLayouts $ \xdg _ -> do + withIndexIn xdg + guessedPackageCacheRoot `shouldReturn` xdg + + it "is still the old directory where the index is there instead" $ + withLayouts $ \_ legacy -> do + withIndexIn legacy + guessedPackageCacheRoot `shouldReturn` legacy + + it "is the platform's own default where there is no index anywhere" $ + withLayouts $ + \xdg _ -> guessedPackageCacheRoot `shouldReturn` xdg + +-- | Run something against a home and an XDG cache directory of its own, +-- handing it both of the places a cache could then be in. +withLayouts :: (FilePath -> FilePath -> Expectation) -> Expectation +withLayouts act = + withSystemTempDirectory "tilia-home" $ \home -> + withSystemTempDirectory "tilia-xdg" $ \cache -> + withEnvironment [("HOME", home), ("XDG_CACHE_HOME", cache)] $ + bracket + (lookupEnv "CABAL_DIR" <* unsetEnv "CABAL_DIR") + (traverse_ (setEnv "CABAL_DIR")) + (const (act (cache "cabal" "packages") (home ".cabal" "packages"))) + +-- | Put a Hackage index where a cache directory would have one. +withIndexIn :: FilePath -> IO () +withIndexIn root = do + createDirectoryIfMissing True (root "hackage.haskell.org") + T.writeFile (root "hackage.haskell.org" "01-index.tar") "" + +-- | Run something on where @plannedTarballs@ looked, against a package +-- cache holding the entries given. +withCache :: + -- | Repository directory, package, version — one per cached tarball + [(FilePath, Text, Text)] -> + -- | The plan to read it against + Text -> + (FilePath -> Expectation) -> + Expectation +withCache cached planText act = + withSystemTempDirectory "tilia-cabal" $ \cabalDir -> do + traverse_ (put cabalDir) cached + createDirectoryIfMissing True (cabalDir "packages") + withEnvironment [("CABAL_DIR", cabalDir)] $ + withSystemTempDirectory "tilia-repo-plan" $ \dir -> do + createDirectoryIfMissing True (takeDirectory (planPathFor dir)) + T.writeFile (planPathFor dir) planText + readBuildPlan (planPathFor dir) >>= \case + Left why -> expectationFailure (T.unpack why) + Right plan -> + plannedTarballs plan >>= \case + [(_, found)] -> act found + other -> expectationFailure (show (map snd other)) + where + put cabalDir (repo, held, version) = do + let at = + cabalDir + "packages" + repo + T.unpack held + T.unpack version + createDirectoryIfMissing True at + T.writeFile + (at T.unpack (held <> "-" <> version <> ".tar.gz")) + "not really a tarball" + +-- | A plan naming one package fetched from the repository described. +fromRepository :: Text -> Text +fromRepository repo = + "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ + \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\ + \\"pkg-src\":{\"type\":\"repo-tar\",\"repo\":" + <> repo + <> "}}]}" + +-- | The same, as an older @cabal@ wrote it: a tarball and no more. +planWithoutARepository :: Text +planWithoutARepository = + "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ + \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\ + \\"pkg-src\":{\"type\":\"repo-tar\"}}]}" + +-- | A dependency that arrived as a @source-repository-package@. +-- +-- @cabal@ clones one into the project's own @dist-newstyle@ and says +-- nothing in the plan about where, so the whole question is whether the +-- clone is found. Once it is, it is a directory of sources like any other +-- and nothing below here is new. +gitDependencies :: Spec +gitDependencies = describe "a dependency that arrived as a git checkout" $ do + it "finds where cabal unpacked it" $ + withFakeCheckout [("thing-2a9f", "1.0")] $ \dir -> + sourcesOf dir + `shouldReturn` [CheckedOut (dir "dist-newstyle" "src" "thing-2a9f")] + + it "leaves one alone that cabal has not unpacked yet" $ + withFakeCheckout [] $ + \dir -> sourcesOf dir `shouldReturn` [SourceRepo] + + it "passes over the clone of a revision that has been moved on from" $ + withFakeCheckout [("thing-0000", "0.9"), ("thing-ffff", "1.0")] $ \dir -> + sourcesOf dir + `shouldReturn` [CheckedOut (dir "dist-newstyle" "src" "thing-ffff")] + + it "passes over a directory named for another package" $ + withFakeCheckout [("other-2a9f", "1.0")] $ \dir -> + sourcesOf dir `shouldReturn` [SourceRepo] + + it "reads a module out of it, fixity and all" $ + withFakeCheckout [("thing-2a9f", "1.0")] $ \dir -> do + plan <- readBuildPlan (planPathFor dir) + case plan of + Left why -> expectationFailure (T.unpack why) + Right p -> do + rs <- newResolver p + askFixities rs "Private.Ops" + >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity RightAssoc 3))) + +-- | What the plan says each of its packages came from. +sourcesOf :: FilePath -> IO [PackageSource] +sourcesOf dir = + readBuildPlan (planPathFor dir) >>= \case + Left why -> error (T.unpack why) + Right plan -> pure (map ppSource (bpPackages plan)) + +-- | A project whose one dependency is a @source-repository-package@, with +-- the clones given unpacked where @cabal@ unpacks them. +-- +-- Each clone is a directory name and the version its @.cabal@ file claims, +-- because telling one clone from another is the whole of the work. +withFakeCheckout :: [(FilePath, Text)] -> (FilePath -> IO a) -> IO a +withFakeCheckout clones act = + withSystemTempDirectory "tilia-checkout" $ \dir -> do + createDirectoryIfMissing True (takeDirectory (planPathFor dir)) + T.writeFile (planPathFor dir) fromAGitRepository + traverse_ (unpack dir) clones + act dir + where + unpack dir (named, version) = do + let at = dir "dist-newstyle" "src" named + belongsTo = takeWhile (/= '-') named + createDirectoryIfMissing True (at "src" "Private") + T.writeFile (at belongsTo <> ".cabal") (describing (T.pack belongsTo) version) + T.writeFile (at "src" "Private" "Ops.hs") privateOps + describing named' version = + T.unlines + [ "cabal-version: 2.4", + "name: " <> named', + "version: " <> version, + "library", + " exposed-modules: Private.Ops", + " hs-source-dirs: src", + " default-language: Haskell2010" + ] + +-- | A plan naming one package that came out of a git repository. +fromAGitRepository :: Text +fromAGitRepository = + "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ + \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\ + \\"pkg-src\":{\"type\":\"source-repo\",\ + \\"source-repo\":{\"type\":\"git\",\"location\":\"git://example/thing\"}}}]}" + +-- | A module of that package, declaring something worth resolving. +privateOps :: Text +privateOps = + T.unlines + [ "module Private.Ops ((<+>)) where", + "infixr 3 <+>", + "(<+>) :: Int -> Int -> Int", + "a <+> b = a + b" + ] + +-- | The modules @cabal@ writes, which no package carries a file for. +generatedModuleSpec :: Spec +generatedModuleSpec = describe "a module cabal generates" $ do + it "declares nothing, rather than being one we could not read" $ + withFakeProject [("src/M.hs", "module M where\nimport Paths_fake\n")] $ + \rs -> askFixities rs "Paths_fake" `shouldReturn` Just Map.empty + + it "answers for the newer one cabal writes beside it" $ + withFakeProject [("src/M.hs", "module M where\n")] $ + \rs -> askFixities rs "PackageInfo_fake" `shouldReturn` Just Map.empty + + it "says nothing about a package the plan does not hold" $ + withFakeProject [("src/M.hs", "module M where\n")] $ + \rs -> askFixities rs "Paths_not_a_package" `shouldReturn` Nothing + + it "lets a module that imports one be read" + $ withFakeProject + [ ( "src/Facade.hs", + "module Facade ((<+>)) where\nimport Paths_fake\nimport Inner\n" + ), + ("src/Inner.hs", "module Inner ((<+>)) where\ninfixr 5 <+>\na <+> b = a\n") + ] + $ \rs -> + askFixities rs "Facade" + >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity RightAssoc 5))) + + it "reads one somebody wrote by hand rather than assuming" + $ withFakeProject + [ ( "src/Paths_fake.hs", + "module Paths_fake ((<+>)) where\ninfixr 5 <+>\na <+> b = a\n" + ) + ] + $ \rs -> + askFixities rs "Paths_fake" + >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity RightAssoc 5))) + +-- | A module of the kind @hsc2hs@ takes, declaring an operator nothing can +-- get at. +cursed :: Text +cursed = + T.unlines + [ "#include ", + "module Cursed (interrupt, (<+>)) where", + "infixr 5 <+>", + "(<+>) :: Int -> Int -> Int", + "a <+> b = a + b", + "interrupt :: Int", + "interrupt = #const SIGINT" + ] + +-- | What @unix@ writes, in miniature: a fixity declaration for a name used +-- in backticks, in a file no reading of ours reaches. +signals :: Text +signals = + T.unlines + [ "#include ", + "module System.Posix.Signals (addSignal, deleteSignal) where", + "infixr `addSignal`, `deleteSignal`", + "addSignal :: Int -> Int -> Int", + "addSignal s m = m + #const SIGINT" + ] + +-- | What the chase makes of one module's @<+>@, against a world of modules +-- that disagree about it. +chased :: Text -> IO (Maybe Fixity) +chased source = do + answer <- + withReexports (Is #implicitPrelude) reach carries Set.empty "M" (pmModule parsed) + pure $ case answer of + Declares fixities -> Map.lookup (InTerms, OpName "<+>") fixities + Unreadable _ -> Nothing + where + carries m = + pure $ case m of + "Text.PrettyPrint" -> + Map.fromList [(OpName "Doc", Set.fromList [OpName "<+>"])] + _ -> Map.empty + parsed = case parseModule defaultParserConfig "M.hs" source of + Left _ -> error "the test input did not parse" + Right m -> m + reach m = + pure $ case m of + "Control.Arrow" -> Just (Map.fromList [((InTerms, OpName "<+>"), Fixity RightAssoc 5)]) + "Text.PrettyPrint" -> Just (Map.fromList [((InTerms, OpName "<+>"), Fixity LeftAssoc 6)]) + "Prelude" -> Just Map.empty + _ -> Nothing + +withPlan :: BuildPlan -> Spec +withPlan plan = do + resolver <- runIO (newResolver plan) + let resolve = askFixities resolver + exported = askExportNames resolver + + describe "the plan itself" $ do + it "names the compiler" $ + T.unpack (bpCompiler plan) `shouldSatisfy` isInfixOf "ghc-" + + it "has the dependencies a real project has" $ + length (bpPackages plan) `shouldSatisfy` (> 20) + + it "gives every fetchable package a source hash to check against" $ do + let fetchable = filter isFetchable (bpPackages plan) + filter (null . sourceHashOf) fetchable `shouldBe` [] + + it "does not mark the project itself as fetchable" $ do + let locals = filter (\p -> ppName p == "tilia") (bpPackages plan) + filter isFetchable locals `shouldBe` [] + + it "records the project as a local directory, with its path" $ do + let locals = [s' | p <- bpPackages plan, ppName p == "tilia", let s' = ppSource p] + locals `shouldSatisfy` all (\s' -> case s' of LocalPackage path -> not (null path); _ -> False) + + it "puts every package in exactly one of the three kinds" $ do + let kinds p = length (filter id [isPreExisting p, isFetchable p, isLocal p]) + isPreExisting p = ppSource p == PreExisting + isLocal p = case ppSource p of LocalPackage _ -> True; _ -> False + filter ((/= 1) . kinds) (bpPackages plan) `shouldBe` [] + + describe "resolving a module that declares its own operators" $ do + it "finds <+> in prettyprinter, with the right fixity" $ + needs resolve "Prettyprinter.Internal" $ \fixities -> + Map.lookup (InTerms, OpName "<+>") fixities `shouldBe` Just (Fixity RightAssoc 6) + + it "resolves the same module twice to the same answer" $ + needs resolve "Prettyprinter.Internal" $ \first' -> do + again <- resolve "Prettyprinter.Internal" + again `shouldBe` Just first' + + describe "re-exports" $ + it "finds an operator a module exports but does not declare" $ + needs resolve "Prettyprinter" $ \fixities -> + Map.lookup (InTerms, OpName "<+>") fixities `shouldBe` Just (Fixity RightAssoc 6) + + describe "boot packages" $ do + it "answers for Prelude from the built-in table" $ + needs resolve "Prelude" $ \fixities -> do + Map.lookup (InTerms, OpName "$") fixities `shouldBe` Just (Fixity RightAssoc 0) + Map.lookup (InTerms, OpName ">>=") fixities `shouldBe` Just (Fixity LeftAssoc 1) + Map.lookup (InTerms, OpName ".") fixities `shouldBe` Just (Fixity RightAssoc 9) + Map.lookup (InTerms, OpName ":") fixities `shouldBe` Just (Fixity RightAssoc 5) + + it "answers for Control.Applicative" $ + needs resolve "Control.Applicative" $ \fixities -> + Map.lookup (InTerms, OpName "<|>") fixities `shouldBe` Just (Fixity LeftAssoc 3) + + it "covers the containers and text modules a project actually imports" $ do + let expected = + [ ("Data.Map", "!", Fixity LeftAssoc 9), + ("Data.Map", "\\\\", Fixity LeftAssoc 9), + ("Data.Set", "\\\\", Fixity LeftAssoc 9), + ("Data.Sequence", "|>", Fixity LeftAssoc 5), + ("Data.Sequence", "<|", Fixity RightAssoc 5), + ("Data.Bits", ".&.", Fixity LeftAssoc 7), + ("Data.Ratio", "%", Fixity LeftAssoc 7), + ("Data.Functor", "<&>", Fixity LeftAssoc 1), + ("Control.Monad", ">=>", Fixity RightAssoc 1), + ("Data.Semigroup", "<>", Fixity RightAssoc 6) + ] + wrong <- traverse (check resolve) expected + concat wrong `shouldBe` [] + + it "carries re-exports already resolved" $ do + p <- resolve "Prelude" + m <- resolve "Data.Map" + ( Map.lookup (InTerms, OpName "$") =<< p, + Map.lookup (InTerms, OpName "!") =<< m + ) + `shouldBe` (Just (Fixity RightAssoc 0), Just (Fixity LeftAssoc 9)) + + it "gives the same operator different fixities in different modules" $ do + inList <- resolve "Data.List" + inMap <- resolve "Data.Map" + ( Map.lookup (InTerms, OpName "\\\\") =<< inList, + Map.lookup (InTerms, OpName "\\\\") =<< inMap + ) + `shouldBe` (Just (Fixity NoAssoc 5), Just (Fixity LeftAssoc 9)) + + describe "modules it cannot answer for" $ do + it "says so rather than claiming no operators" $ + resolve "Not.A.Real.Module.At.All" `shouldReturn` Nothing + + it "says so for a module no package exposes" $ + resolve "Some.Package.That.Does.Not.Exist" `shouldReturn` Nothing + + it "distinguishes a boot module with no operators from an unknown one" $ do + quiet <- resolve "Data.Char" + quiet `shouldBe` Just Map.empty + + describe "a module that leans on its package's extensions" $ do + it "reads it, given what the .cabal puts in force" $ + withFakeProject [("fake.cabal", package ["LambdaCase"]), ("src/Fancy.hs", fancy)] $ + \rs -> + askFixities rs "Fancy" + >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity RightAssoc 5))) + + it "cannot read it when the .cabal puts nothing in force" $ + withFakeProject [("fake.cabal", package []), ("src/Fancy.hs", fancy)] $ + \rs -> askFixities rs "Fancy" `shouldReturn` Nothing + + it "takes an extension the .cabal turns off into account" + $ withFakeProject + [ ("fake.cabal", package ["LambdaCase", "NoLambdaCase"]), + ("src/Fancy.hs", fancy) + ] + $ \rs -> askFixities rs "Fancy" `shouldReturn` Nothing + + describe "modules whose source defeats us" $ do + it "answers for Test.QuickCheck.Property, which cannot be parsed" $ + needs resolve "Test.QuickCheck.Property" $ \fixities -> do + Map.lookup (InTerms, OpName "===") fixities `shouldBe` Just (Fixity NoAssoc 4) + Map.lookup (InTerms, OpName ".&&.") fixities `shouldBe` Just (Fixity RightAssoc 1) + Map.lookup (InTerms, OpName "==>") fixities `shouldBe` Just (Fixity RightAssoc 0) + + it "carries that through the re-export chain to Test.QuickCheck" $ + needs resolve "Test.QuickCheck" $ \fixities -> + Map.lookup (InTerms, OpName "===") fixities `shouldBe` Just (Fixity NoAssoc 4) + + describe "a module with more than one configuration" $ do + -- Built in a temporary directory with a build plan written by hand, so + -- that the shapes below can be exactly the shapes worth testing. These + -- are the ones criterion's dependencies turned out to be written in. + it "answers from the configurations it can read" + $ withFakeProject + [ ( "src/Platform.hs", + T.unlines + [ "{-# LANGUAGE CPP #-}", + "module Platform (sort, (<+>)) where", + "#ifdef WINDOWS", + "import No.Such.Module.At.All", + "#endif", + "import Data.List (sort)", + "infixl 6 <+>", + "(<+>) :: Int -> Int -> Int", + "a <+> b = a + b" + ] + ) + ] + $ \rs -> + -- The WINDOWS branch imports a module nothing has, which is what + -- System.IO.CodePage does with System.Win32.CodePage. That branch + -- is passed over rather than taken as a reason to say nothing. + askFixities rs "Platform" + >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity LeftAssoc 6))) + + it "answers from the configurations that are Haskell at all" + $ withFakeProject + [ ( "src/Guarded.hs", + T.unlines + [ "{-# LANGUAGE CPP #-}", + "module Guarded ((<+>)) where", + "infixl 6 <+>", + "(<+>) :: Int -> Int -> Int", + "a <+> b = a + b", + "#ifdef ANCIENT", + "f x = case", + "#endif" + ] + ) + ] + $ \rs -> + askFixities rs "Guarded" + >>= (`shouldBe` Just (Map.singleton (InTerms, OpName "<+>") (Fixity LeftAssoc 6))) + + it "still refuses when the configurations it can read disagree" + $ withFakeProject + [ ( "src/Disagree.hs", + T.unlines + [ "{-# LANGUAGE CPP #-}", + "module Disagree (sort, (<+>)) where", + "import Data.List (sort)", + "#ifdef FAST", + "infixl 6 <+>", + "#else", + "infixr 7 <+>", + "#endif", + "(<+>) :: Int -> Int -> Int", + "a <+> b = a + b" + ] + ) + ] + $ \rs -> askFixities rs "Disagree" `shouldReturn` Nothing + + it "says nothing when it can read no configuration at all" + $ withFakeProject + [ ( "src/Bothbad.hs", + T.unlines + [ "{-# LANGUAGE CPP #-}", + "module Bothbad (sort) where", + "#ifdef WINDOWS", + "import No.Such.One", + "#else", + "import No.Such.Two", + "#endif", + "import Data.List (sort)" + ] + ) + ] + $ \rs -> + -- Not @Just mempty@: that would be claiming the module declares + -- nothing, which is a guess rather than the silence it deserves. + askFixities rs "Bothbad" `shouldReturn` Nothing + + describe "modules that re-export one another" $ + it "answers for one whose re-exports are mutually entangled" $ do + answer <- resolve "GHC.Hs" + answer `shouldSatisfy` (/= Nothing) + + describe "what a package module says it exports" $ + it "names them, read out of the package's own tarball" $ + exported "Prettyprinter" >>= \case + Nothing -> pendingWith "could not read prettyprinter's source" + Just names -> names `shouldSatisfy` Set.member (OpName "<+>") + + describe "what a module keeps under each of its names" $ do + it "reads them out of a package's interface" $ do + kept <- askChildren resolver "Data.List.NonEmpty" + Map.lookup (OpName "NonEmpty") kept + `shouldSatisfy` maybe False (Set.member (OpName ":|")) + + it "has nothing to say about a module it cannot find" $ + askChildren resolver "No.Such.Module" `shouldReturn` Map.empty + + it "reads them out of a local module's source" + $ withFakeProject + [("src/Carrier.hs", "module Carrier (T (..)) where\ndata T = A | Int :| Int\n")] + $ \rs -> do + kept <- askChildren rs "Carrier" + Map.lookup (OpName "T") kept + `shouldBe` Just (Set.fromList [OpName "A", OpName ":|"]) + + it "follows a type to the module that declares it" + $ withFakeProject + [ ("src/Facade.hs", "module Facade (T (..)) where\nimport Inner\n"), + ("src/Inner.hs", "module Inner (T (..)) where\ninfixr 5 :|\ndata T = A | Int :| Int\n") + ] + $ \rs -> do + kept <- askChildren rs "Facade" + Map.lookup (OpName "T") kept + `shouldBe` Just (Set.fromList [OpName "A", OpName ":|"]) + + it "carries the fixity along with it, so the name can be looked up" + $ withFakeProject + [ ("src/Facade.hs", "module Facade (T (..)) where\nimport Inner\n"), + ("src/Inner.hs", "module Inner (T (..)) where\ninfixr 5 :|\ndata T = A | Int :| Int\n") + ] + $ \rs -> do + fixities <- askFixities rs "Facade" + (Map.lookup (InTerms, OpName ":|") =<< fixities) + `shouldBe` Just (Fixity RightAssoc 5) + + it "settles an operator that arrives through a façade" + $ withFakeProject + [ ("src/Facade.hs", "module Facade (T (..)) where\nimport Inner\n"), + ("src/Inner.hs", "module Inner (T (..)) where\ninfixr 5 :|\ndata T = A | Int :| Int\n") + ] + $ \rs -> do + let m = parse "module M where\nimport Facade (T (..))\n" + scope <- scopeFor rs (Is #implicitPrelude) (pmModule m) + lookupFixity scope InTerms Nothing (OpName ":|") + `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Facade") + + it "follows a whole module handed on" + $ withFakeProject + [ ("src/Facade.hs", "module Facade (module Inner) where\nimport Inner\n"), + ("src/Inner.hs", "module Inner (T (..)) where\ninfixr 5 :|\ndata T = A | Int :| Int\n") + ] + $ \rs -> do + kept <- askChildren rs "Facade" + Map.lookup (OpName "T") kept + `shouldBe` Just (Set.fromList [OpName "A", OpName ":|"]) + + it "comes back from two modules that hand each other on" + $ withFakeProject + [ ("src/Ping.hs", "module Ping (T (..)) where\nimport Pong\n"), + ("src/Pong.hs", "module Pong (T (..)) where\nimport Ping\n") + ] + $ \rs -> askChildren rs "Ping" `shouldReturn` Map.singleton (OpName "T") Set.empty + + it "keeps to what a local module's export list hands on" + $ withFakeProject + [("src/Carrier.hs", "module Carrier (T (A)) where\ndata T = A | Int :| Int\n")] + $ \rs -> do + kept <- askChildren rs "Carrier" + Map.lookup (OpName "T") kept `shouldBe` Just (Set.singleton (OpName "A")) + + describe "what a module says it exports, where its fixities are beyond us" $ do + it "names them though the module itself went unresolved" $ + withFakeProject [("src/Opaque.hs", opaqueSource)] $ + \rs -> do + askFixities rs "Opaque" `shouldReturn` Nothing + askExportNames rs "Opaque" + `shouldReturn` Just (Set.fromList [OpName "<+>", OpName "f"]) + + it "says nothing for a module that hands a whole module on" + $ withFakeProject + [ ( "src/Wide.hs", + T.unlines + [ "module Wide (module Data.List) where", + "import Data.List", + "import No.Such.Module" + ] + ) + ] + $ \rs -> askExportNames rs "Wide" `shouldReturn` Nothing + + it "says nothing for a module it cannot find at all" $ + withFakeProject [("src/Opaque.hs", opaqueSource)] $ + \rs -> askExportNames rs "No.Such.Module" `shouldReturn` Nothing + + it "follows a type it hands on to the module that declares it" + $ withFakeProject + [ ("src/Facade.hs", "module Facade (T (..), (<+>)) where\nimport Inner\n"), + ("src/Inner.hs", "module Inner (T (..)) where\ndata T = A | Int :| Int\n") + ] + $ \rs -> + askExportNames rs "Facade" + `shouldReturn` Just (Set.fromList [OpName "T", OpName "A", OpName ":|", OpName "<+>"]) + + it "follows a whole module it hands on" + $ withFakeProject + [ ("src/Facade.hs", "module Facade (module Inner) where\nimport Inner\n"), + ("src/Inner.hs", "module Inner ((<+>)) where\ninfixl 6 <+>\n(<+>) :: Int -> Int -> Int\na <+> b = a + b\n") + ] + $ \rs -> + askExportNames rs "Facade" `shouldReturn` Just (Set.singleton (OpName "<+>")) + + it "says nothing when what it hands on cannot be read" + $ withFakeProject + [("src/Facade.hs", "module Facade (module No.Such.Module) where\nimport No.Such.Module\n")] + $ \rs -> askExportNames rs "Facade" `shouldReturn` Nothing + + it "says nothing when a type it hands on is beyond us" + $ withFakeProject + [("src/Facade.hs", "module Facade (T (..)) where\nimport No.Such.Module\n")] + $ \rs -> askExportNames rs "Facade" `shouldReturn` Nothing + + it "comes back from two modules that hand each other on" + $ withFakeProject + [ ("src/Ping.hs", "module Ping (module Pong) where\nimport Pong\n"), + ("src/Pong.hs", "module Pong (module Ping) where\nimport Ping\n") + ] + $ \rs -> askExportNames rs "Ping" `shouldReturn` Nothing + + it "says nothing for a module whose source will not parse" $ + withFakeProject [("src/Bad.hs", "module Bad ((<+>)) where\nf = (((\n")] $ + \rs -> askExportNames rs "Bad" `shouldReturn` Nothing + + it "takes them from every configuration the preprocessor allows" + $ withFakeProject + [ ( "src/Both.hs", + T.unlines + [ "{-# LANGUAGE CPP #-}", + "#ifdef WINDOWS", + "module Both ((<+>)) where", + "#else", + "module Both (()) where", + "#endif", + "import No.Such.Module" + ] + ) + ] + $ \rs -> + askExportNames rs "Both" `shouldReturn` Just (Set.fromList [OpName "<+>", OpName ""]) + + it "says nothing when one configuration hands a whole module on" + $ withFakeProject + [ ( "src/Half.hs", + T.unlines + [ "{-# LANGUAGE CPP #-}", + "#ifdef WINDOWS", + "module Half ((<+>)) where", + "#else", + "module Half (module Data.List) where", + "#endif", + "import Data.List", + "import No.Such.Module" + ] + ) + ] + $ \rs -> askExportNames rs "Half" `shouldReturn` Nothing + + it "settles an operator no unread module in scope could have declared" $ + withFakeProject [("src/Opaque.hs", opaqueSource)] $ + \rs -> do + let m = parse "module M where\nimport Opaque\n" + scope <- scopeFor rs (Is #implicitPrelude) (pmModule m) + lookupFixity scope InTerms Nothing (OpName "") + `shouldBe` Resolved defaultFixity ReportDefault + + it "leaves one alone that the unread module's list does name" $ + withFakeProject [("src/Opaque.hs", opaqueSource)] $ + \rs -> do + let m = parse "module M where\nimport Opaque\n" + scope <- scopeFor rs (Is #implicitPrelude) (pmModule m) + lookupFixity scope InTerms Nothing (OpName "<+>") + `shouldBe` Unresolved (ModuleChain ("Opaque" :| ["No.Such.Module"]) :| []) + + it "names the module that stopped it rather than the import above it" $ + withFakeProject [("src/Opaque.hs", opaqueSource)] $ + \rs -> askChain rs "Opaque" `shouldReturn` ["No.Such.Module"] + + it "follows the reasons down more than one module" + $ withFakeProject + [ ("src/Near.hs", "module Near ((<+>)) where\nimport Middle\n"), + ("src/Middle.hs", "module Middle ((<+>)) where\nimport No.Such.Module\n") + ] + $ \rs -> askChain rs "Near" `shouldReturn` ["Middle", "No.Such.Module"] + + it "has nothing to say about a module that could be read" $ + withFakeProject [("src/Opaque.hs", opaqueSource)] $ + \rs -> askChain rs "Prelude" `shouldReturn` [] + + describe "the whole pipeline, from source text to a fixity" $ do + it "resolves an operator through a real import" $ + endToEnd resolver "module M where\nimport Prettyprinter\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName "<+>") + `shouldBe` Resolved (Fixity RightAssoc 6) (DeclaredIn "Prettyprinter") + + it "prefers the module's own declaration to an imported one" $ + endToEnd resolver "module M where\nimport Prettyprinter\ninfixl 2 <+>\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName "<+>") + `shouldBe` Resolved (Fixity LeftAssoc 2) DeclaredHere + + it "honours a qualified import" $ + endToEnd resolver "module M where\nimport qualified Prettyprinter as P\n" $ \scope -> do + lookupFixity scope InTerms (Just "P") (OpName "<+>") + `shouldBe` Resolved (Fixity RightAssoc 6) (DeclaredIn "Prettyprinter") + -- Qualified-only, so nothing arrives unqualified. + lookupFixity scope InTerms Nothing (OpName "<+>") + `shouldBe` Resolved defaultFixity ReportDefault + + it "honours an explicit import list" $ + endToEnd resolver "module M where\nimport Prettyprinter ((<+>))\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName "<+>") + `shouldBe` Resolved (Fixity RightAssoc 6) (DeclaredIn "Prettyprinter") + + it "honours a hiding list" $ + endToEnd resolver "module M where\nimport Prettyprinter hiding ((<+>))\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName "<+>") + `shouldBe` Resolved defaultFixity ReportDefault + + it "concludes the Report default when everything in scope was read" $ + endToEnd resolver "module M where\nimport Prettyprinter\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName "") + `shouldBe` Resolved defaultFixity ReportDefault + + it "refuses to conclude anything when an import could not be read" $ + endToEnd resolver "module M where\nimport No.Such.Module\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName "") + `shouldBe` Unresolved (unreadOnly "No.Such.Module") + + it "still answers for what it did find, despite an unreadable import" $ + endToEnd resolver "module M where\nimport Prettyprinter\nimport No.Such.Module\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName "<+>") + `shouldBe` Resolved (Fixity RightAssoc 6) (DeclaredIn "Prettyprinter") + + it "concludes the default through a boot import that exports no operators" $ + endToEnd resolver "module M where\nimport Data.Char\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName "") + `shouldBe` Resolved defaultFixity ReportDefault + + it "resolves an operator imported from a boot package" $ + endToEnd resolver "module M where\nimport Data.Map\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName "!") + `shouldBe` Resolved (Fixity LeftAssoc 9) (DeclaredIn "Data.Map") + + it "resolves an operator that arrives under a type's own name" $ + endToEnd resolver "module M where\nimport Data.List.NonEmpty (NonEmpty (..))\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName ":|") + `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Data.List.NonEmpty") + + it "resolves one written out beside its type" $ + endToEnd resolver "module M where\nimport Data.List.NonEmpty (NonEmpty ((:|)))\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName ":|") + `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Data.List.NonEmpty") + + it "leaves out an operator no item of the list brings in" $ + endToEnd resolver "module M where\nimport Data.List.NonEmpty (toList)\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName ":|") + `shouldBe` Resolved defaultFixity ReportDefault + + it "hides one hidden along with its type" $ + endToEnd resolver "module M where\nimport Data.List.NonEmpty hiding (NonEmpty (..))\n" $ \scope -> + lookupFixity scope InTerms Nothing (OpName ":|") + `shouldBe` Resolved defaultFixity ReportDefault + + it "brings one in under the qualifier it was imported with" $ + endToEnd resolver "module M where\nimport qualified Data.List.NonEmpty as NE (NonEmpty (..))\n" $ \scope -> + lookupFixity scope InTerms (Just "NE") (OpName ":|") + `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Data.List.NonEmpty") + + it "reports no ambiguity for a module that compiles" $ + endToEnd resolver "module M where\nimport Prettyprinter\n" $ \scope -> + reachAmbiguous (scopeInTerms scope) `shouldBe` [] + + describe "readiness" $ do + it "reports something other than a missing plan for this project" $ do + readiness <- checkReadiness [] "." + readiness `shouldNotBe` PlanMissing + + it "reports a missing plan for a directory that has none" $ + checkReadiness [] "/" `shouldReturn` PlanMissing + +---------------------------------------------------------------------------- +-- Helpers + +-- | An empty project directory, holding a plan where @cabal@ writes one if +-- it is to hold a plan at all. +withTempProject :: Maybe Text -> (FilePath -> IO a) -> IO a +withTempProject plan act = + withSystemTempDirectory "tilia-prepare" $ \dir -> do + createDirectoryIfMissing True (takeDirectory (planPathFor dir)) + traverse_ (writePlan dir) plan + act dir + +writePlan :: FilePath -> Text -> IO () +writePlan dir = T.writeFile (planPathFor dir) + +-- | A plan naming one package that no package cache can have a tarball +-- for, so that reading it leaves something to fetch. +wantingATarball :: Text +wantingATarball = + "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ + \[{\"pkg-name\":\"tilia-phantom\",\"pkg-version\":\"9.9.9\",\ + \\"pkg-src\":{\"type\":\"repo-tar\"}}]}" + +-- | A plan holding a local package with a library and an executable, and +-- no test suite. +twoComponents :: Text +twoComponents = + "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ + \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"lib\",\ + \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}},\ + \{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"exe:thing\",\ + \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}}]}" + +-- | The same, with a component a solve could go on to add. +threeComponents :: Text +threeComponents = + "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ + \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"lib\",\ + \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}},\ + \{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"exe:thing\",\ + \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}},\ + \{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"test:tests\",\ + \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}}]}" + +-- | Narrow and short at once: two components, neither of them the one a +-- run wants, and a dependency whose tarball is nowhere. +-- +-- The shape @servant@ has, where two cookbook executables are named by the +-- project and left out of every plan @cabal@ writes. +narrowAndWanting :: Text +narrowAndWanting = + "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ + \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"component-name\":\"lib\",\ + \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}},\ + \{\"pkg-name\":\"tilia-phantom\",\"pkg-version\":\"9.9.9\",\ + \\"pkg-src\":{\"type\":\"repo-tar\"}}]}" + +-- | A package planned whole, as @cabal@ plans one with a @Custom@ build +-- type: no @component-name@, and a @components@ object instead. +plannedWhole :: Text +plannedWhole = + "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ + \[{\"pkg-name\":\"thing\",\"pkg-version\":\"1.0\",\"type\":\"configured\",\ + \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"},\ + \\"components\":{\"lib\":{},\"test:spec\":{},\"setup\":{}}}]}" + +-- | A component of that package, by the name a plan gives it. +component :: Text -> PlanComponent +component = PlanComponent "thing" + +-- | Note that @cabal@ was asked for something. +-- | What a solve and a fetch are asked for. +-- +-- Both name the test suites and the benchmarks, because both are things a +-- run formats and so things the plan has to reach. +solving, fetching :: [String] +solving = narrowSolve <> wholeProject +fetching = narrowFetch <> wholeProject + +-- | The same two, asked only about what @cabal@ builds by default. What is +-- fallen back on where the whole project will not solve. +narrowSolve, narrowFetch :: [String] +narrowSolve = ["build", "all", "--dry-run"] +narrowFetch = ["build", "all", "--only-download"] + +wholeProject :: [String] +wholeProject = ["--enable-tests", "--enable-benchmarks"] + +record :: IORef [[String]] -> [String] -> IO () +record steps args = modifyIORef' steps (<> [args]) + +-- | A @cabal@ that does nothing and says it went well. +obliging :: IORef [[String]] -> [String] -> IO (Either Text ()) +obliging steps args = record steps args >> pure (Right ()) + +-- | Run an assertion on a module's fixities, or mark the test pending if +-- the module could not be resolved at all. +-- +-- Pending rather than failing, because an unpopulated package cache is an +-- environment problem and not a defect in the code under test. +needs :: + (Text -> IO (Maybe (Fixities))) -> + Text -> + (Fixities -> Expectation) -> + Expectation +needs resolve modName assertion = + resolve modName >>= \case + Nothing -> pendingWith ("could not resolve " <> T.unpack modName) + Just fixities -> assertion fixities + +-- | Parse a module, resolve its imports for real, and hand over the scope. +endToEnd :: + Resolver -> + Text -> + (Scope -> Expectation) -> + Expectation +endToEnd resolver source assertion = + case parseModule defaultParserConfig "test.hs" source of + Left _ -> expectationFailure "the test input did not parse" + Right pm -> do + scope <- scopeFor resolver (Is #implicitPrelude) (pmModule pm) + assertion scope + +-- | Check one expected fixity, returning a description of any mismatch. +check :: + (Text -> IO (Maybe (Fixities))) -> + (Text, Text, Fixity) -> + IO [String] +check resolve (modName, op, expected) = do + got <- resolve modName + let actual = Map.lookup (InTerms, OpName op) =<< got + pure + [ T.unpack modName + <> "." + <> T.unpack op + <> ": expected " + <> show expected + <> " but got " + <> show actual + | actual /= Just expected + ] + +-- | A module that needs @LambdaCase@ to parse, and declares a fixity worth +-- finding once it does. +fancy :: Text +fancy = + T.unlines + [ "module Fancy where", + "infixr 5 <+>", + "(<+>) :: Int -> Int -> Int", + "a <+> b = a + b", + "describe :: Int -> Int", + "describe = \\case", + " 0 -> 1", + " _ -> 2" + ] + +-- | A @.cabal@ for the fake project, putting the named extensions in force. +package :: [Text] -> Text +package extensions = + T.unlines $ + [ "cabal-version: 2.4", + "name: fake", + "version: 0.1.0.0", + "library", + " exposed-modules: Fancy", + " hs-source-dirs: src", + " default-language: Haskell2010" + ] + <> [" default-extensions: " <> T.intercalate ", " extensions | not (null extensions)] + +-- | A module that is perfectly readable and still cannot be resolved: the +-- operator it exports comes from somewhere nothing can be read from. +opaqueSource :: Text +opaqueSource = + T.unlines + [ "module Opaque ((<+>), f) where", + "import No.Such.Module", + "f :: Int", + "f = 1" + ] + +parse :: Text -> ParsedModule +parse source = case parseModule defaultParserConfig "M.hs" source of + Left _ -> error "the test input did not parse" + Right pm -> pm + +-- | A project of made-up modules, with a build plan written by hand. +-- +-- The plan names one local package and nothing else, which is enough for a +-- resolver: local modules are read straight off disk, and everything they +-- import here is either a boot module or does not exist. +withFakeProject :: [(FilePath, Text)] -> (Resolver -> IO a) -> IO a +withFakeProject sources act = + withFakePlan sources (\plan -> newResolver plan >>= act) + +withFakePlan :: [(FilePath, Text)] -> (BuildPlan -> IO a) -> IO a +withFakePlan sources act = + withSystemTempDirectory "tilia-plan" $ \dir -> do + createDirectoryIfMissing True (dir "src") + if any ((".cabal" `Data.List.isSuffixOf`) . fst) sources + then pure () + else + T.writeFile (dir "fake.cabal") $ + T.unlines + [ "cabal-version: 2.4", + "name: fake", + "version: 0.1.0.0", + "library", + " exposed-modules: " <> T.intercalate ", " (map named (haskellIn sources)), + " hs-source-dirs: src", + " default-language: Haskell2010" + ] + traverse_ (\(path, text) -> T.writeFile (dir path) text) sources + T.writeFile (dir "plan.json") $ + "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ + \[{\"pkg-name\":\"fake\",\"pkg-version\":\"0.1.0.0\",\ + \\"pkg-src\":{\"type\":\"local\",\"path\":\"" + <> T.pack dir + <> "\"}}]}" + readBuildPlan (dir "plan.json") >>= \case + Left why -> error (T.unpack why) + Right plan -> act plan + where + haskellIn = filter (isModule . fst) + isModule path = any (`Data.List.isSuffixOf` path) [".hs", ".hsc"] + named (path, _) = T.pack (takeBaseName path) + +-- | A project whose one dependency is a package off Hackage, with the +-- tarball @cabal@ would have fetched written where it would have put it. +-- +-- Nothing here is local: this is the other route to a module, the one that +-- opens an archive. @CABAL_DIR@ says where the package cache is and +-- @XDG_CACHE_HOME@ where what is read gets remembered, so the run reaches +-- the tarball below and no further, and leaves nothing behind. +withFakeArchive :: [(FilePath, Text)] -> (Resolver -> IO a) -> IO a +withFakeArchive sources act = + withSystemTempDirectory "tilia-archive" $ \dir -> do + let held = T.unpack (name <> "-" <> version) + tarball = + dir + "packages" + "hackage.haskell.org" + T.unpack name + T.unpack version + held + <> ".tar.gz" + createDirectoryIfMissing True (takeDirectory tarball) + writeTarball tarball $ + (held T.unpack name <> ".cabal", cabal) + : [(held path, text) | (path, text) <- sources] + T.writeFile (dir "plan.json") plan + withEnvironment [("CABAL_DIR", dir), ("XDG_CACHE_HOME", dir "cache")] $ + readBuildPlan (dir "plan.json") >>= \case + Left why -> error (T.unpack why) + Right p -> newResolver p >>= act + where + name = "tilia-hsc-fixture" + version = "1.0" + cabal = + T.unlines + [ "cabal-version: 2.4", + "name: " <> name, + "version: " <> version, + "library", + " exposed-modules: " <> T.intercalate ", " (map moduleIn sources), + " hs-source-dirs: .", + " default-language: Haskell2010" + ] + moduleIn (path, _) = T.replace "/" "." (T.pack (dropExtension path)) + plan = + "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ + \[{\"pkg-name\":\"" + <> name + <> "\",\"pkg-version\":\"" + <> version + <> "\",\"pkg-src\":{\"type\":\"repo-tar\"}}]}" + +-- | Write the named files as a gzipped tarball. +writeTarball :: FilePath -> [(FilePath, Text)] -> IO () +writeTarball path entries = + BL.writeFile path . GZip.compress . Tar.write =<< traverse entry entries + where + entry (inside, text) = case Tar.toTarPath False inside of + Left why -> error why + Right tarPath -> pure (Tar.fileEntry tarPath (BL.fromStrict (T.encodeUtf8 text))) + +-- | Run something with the given variables set, and the environment as it +-- was afterwards however it turns out. +withEnvironment :: [(String, String)] -> IO a -> IO a +withEnvironment vars act = bracket set restore (const act) + where + set = traverse remember vars + remember (key, value) = do + was <- lookupEnv key + setEnv key value + pure (key, was) + restore = traverse_ (\(key, was) -> maybe (unsetEnv key) (setEnv key) was) + +-- | The one import blamed for an operator, unread on its own account and so +-- with nothing below it. +unreadOnly :: Text -> NonEmpty ModuleChain +unreadOnly m = ModuleChain (m :| []) :| [] + +-- | Say why nothing could be tested, once, instead of failing repeatedly. +unavailable :: String -> Spec +unavailable reason = + it "needs a built project" $ pendingWith reason diff --git a/tests/Tilia/FixitySpec.hs b/tests/Tilia/FixitySpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/FixitySpec.hs @@ -0,0 +1,757 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} + +-- | Whether fixities can be resolved exactly from source alone. +module Tilia.FixitySpec (spec) where + +import Data.Choice (Choice, pattern Is, pattern Isn't) +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text (Text) +import Test.Hspec +import Tilia.Fixity +import Tilia.Parser + +spec :: Spec +spec = do + describe "layer 1: what a module declares" $ do + it "reads a left-associative declaration" $ + declaredIn "module M where\ninfixl 6 <+>\n" + `shouldBe` [(OpName "<+>", Fixity LeftAssoc 6)] + + it "reads a right-associative declaration" $ + declaredIn "module M where\ninfixr 5 <>>\n" + `shouldBe` [(OpName "<>>", Fixity RightAssoc 5)] + + it "reads a non-associative declaration" $ + declaredIn "module M where\ninfix 4 ===\n" + `shouldBe` [(OpName "===", Fixity NoAssoc 4)] + + it "reads several operators from one declaration" $ + declaredIn "module M where\ninfixl 7 <.>, <:>\n" + `shouldBe` [(OpName "<.>", Fixity LeftAssoc 7), (OpName "<:>", Fixity LeftAssoc 7)] + + it "reads a backticked function name" $ + declaredIn "module M where\ninfixl 7 `quot`\n" + `shouldBe` [(OpName "quot", Fixity LeftAssoc 7)] + + it "finds nothing when nothing is declared" $ + declaredIn "module M where\nx = 1\n" `shouldBe` [] + + it "reads a declaration that appears after its use" $ + declaredIn "module M where\ny = a <+> b\ninfixl 6 <+>\n" + `shouldBe` [(OpName "<+>", Fixity LeftAssoc 6)] + + it "reads one a class makes about its own method" $ + declaredIn "module M where\nclass C a where\n infixr 8 .=\n (.=) :: a -> a -> Int\n" + `shouldBe` [(OpName ".=", Fixity RightAssoc 8)] + + it "reads those at the margin and in a class together" $ + declaredIn "module M where\ninfixl 1 <+>\nclass C a where\n infixr 8 .=\n (.=) :: a -> a -> Int\n" + `shouldBe` [(OpName ".=", Fixity RightAssoc 8), (OpName "<+>", Fixity LeftAssoc 1)] + + it "leaves a declaration local to a binding where it is" $ + declaredIn "module M where\nf = g\n where\n infixr 3 ###\n g = 1\n" + `shouldBe` [] + + describe "which namespace a declaration governs" $ do + it "gives a type operator's fixity to types" $ + declaredWithNamespaces "module M where\ninfixr 4 :>\ndata a :> b = Sub a b\n" + `shouldBe` [((InTypes, OpName ":>"), Fixity RightAssoc 4)] + + it "gives a value operator's fixity to terms" $ + declaredWithNamespaces "module M where\ninfixl 6 <+>\na <+> b = a\n" + `shouldBe` [((InTerms, OpName "<+>"), Fixity LeftAssoc 6)] + + it "gives a pattern synonym's fixity to terms" $ + declaredWithNamespaces + "{-# LANGUAGE PatternSynonyms #-}\nmodule M where\ninfixl 5 :>\npattern x :> y = (x, y)\n" + `shouldBe` [((InTerms, OpName ":>"), Fixity LeftAssoc 5)] + + it "honours a declaration that names the type namespace itself" $ + declaredWithNamespaces "module M where\ninfixr 4 type :>\n" + `shouldBe` [((InTypes, OpName ":>"), Fixity RightAssoc 4)] + + it "honours one that names the data namespace" $ + declaredWithNamespaces "module M where\ninfixr 4 data :>\n" + `shouldBe` [((InTerms, OpName ":>"), Fixity RightAssoc 4)] + + it "gives both to a name the module declares in neither" $ + declaredWithNamespaces "module M where\ninfixr 4 \n" + `shouldBe` [ ((InTypes, OpName ""), Fixity RightAssoc 4), + ((InTerms, OpName ""), Fixity RightAssoc 4) + ] + + it "gives both to a name the module declares in both" $ + declaredWithNamespaces "module M where\ninfixr 4 :>\ndata a :> b = a :> b\n" + `shouldBe` [ ((InTypes, OpName ":>"), Fixity RightAssoc 4), + ((InTerms, OpName ":>"), Fixity RightAssoc 4) + ] + + it "gives a class's fixity to types and its method's to terms" $ + declaredWithNamespaces + "module M where\ninfixl 3 <%>\nclass a <%> b where\n infixl 7 .=\n (.=) :: a -> b -> Int\n" + `shouldBe` [ ((InTypes, OpName "<%>"), Fixity LeftAssoc 3), + ((InTerms, OpName ".="), Fixity LeftAssoc 7) + ] + + describe "one spelling in two namespaces" $ do + it "settles a type use against the type declaration" $ + lookupFixity (scopeOfBoth "import Types\nimport Terms\n") InTypes Nothing (OpName ":>") + `shouldBe` Resolved (Fixity RightAssoc 4) (DeclaredIn "Types") + + it "settles a term use against the term declaration" $ + lookupFixity (scopeOfBoth "import Types\nimport Terms\n") InTerms Nothing (OpName ":>") + `shouldBe` Resolved (Fixity LeftAssoc 5) (DeclaredIn "Terms") + + it "reports no ambiguity between them" $ do + let scope = scopeOfBoth "import Types\nimport Terms\n" + reachAmbiguous (scopeInTypes scope) `shouldBe` [] + reachAmbiguous (scopeInTerms scope) `shouldBe` [] + + it "still reports one where both are in the same namespace" $ + reachAmbiguous (scopeInTerms (scopeOfBoth "import Terms\nimport Other.Terms\n")) + `shouldBe` [(Nothing, OpName ":>")] + + it "takes a promoted constructor's fixity from the terms" $ + lookupFixity (scopeOfBoth "import Terms\n") InTypes Nothing (OpName ":>") + `shouldBe` Resolved (Fixity LeftAssoc 5) (DeclaredIn "Terms") + + it "does not take a type's fixity for a term" $ + lookupFixity (scopeOfBoth "import Types\n") InTerms Nothing (OpName ":>") + `shouldBe` Resolved defaultFixity ReportDefault + + it "prefers the type it finds to the term it could fall back on" $ + lookupFixity (scopeOfBoth "import Types\nimport Terms\n") InTypes Nothing (OpName ":>") + `shouldBe` Resolved (Fixity RightAssoc 4) (DeclaredIn "Types") + + it "lets a module that writes the type be formatted" $ + unsettledIn "module M where\nimport Types\nimport Terms\ntype T = Int :> Int\n" + `shouldBe` [] + + it "declines one that writes an operator both agree to disagree about" $ + map snd (unsettledIn "module M where\nimport Terms\nimport Other.Terms\nf a b = a :> b\n") + `shouldBe` [Ambiguous] + + describe "what a module says it exports" $ do + it "has nothing to say about a module with no export list" $ + exportsOfSource "module M where\nf = 1\n" `shouldBe` Nothing + + it "keeps the qualifier a name was written under" $ + exportsOfSource "module M ((Disp.<+>)) where\n" + `shouldBe` Just [ExportName (Just "Disp") (OpName "<+>")] + + it "has none for a name written plainly" $ + exportsOfSource "module M ((<+>)) where\n" + `shouldBe` Just [ExportName Nothing (OpName "<+>")] + + it "reads a whole module passed on as the module it names" $ + exportsOfSource "module M (module Data.Map) where\n" + `shouldBe` Just [ExportModule "Data.Map"] + + describe "the operators an export list names" $ do + it "takes them from an explicit list" $ + exportedIn "module M ((<+>), (), f) where\n" + `shouldBe` Just [OpName "<+>", OpName "", OpName "f"] + + it "takes the members of a class the module declares itself" $ + exportedIn + "module M (C (..)) where\nclass C a where\n infixr 8 .=\n (.=) :: a -> a -> Int\n" + `shouldBe` Just [OpName ".=", OpName "C"] + + it "takes the constructors of a type the module declares itself" $ + exportedIn "module M (T (..)) where\ndata T = A | Int :| Int\n" + `shouldBe` Just [OpName ":|", OpName "A", OpName "T"] + + it "knows nothing of a type the module only passes on" $ + exportedIn "module M (C (..)) where\nimport Elsewhere\n" `shouldBe` Nothing + + it "knows nothing of a module that hands a whole module on" $ + exportedIn "module M ((<+>), module Data.Map) where\n" `shouldBe` Nothing + + it "takes what a module with no export list declares" $ + exportedIn "module M where\ninfixr 5 <+>\ninfixl 6 \n" + `shouldBe` Just [OpName "<+>", OpName ""] + + it "finds nothing in a module with no list and no declarations" $ + exportedIn "module M where\nf = 1\n" `shouldBe` Just [] + + describe "which unread module an unsettled operator is blamed on" $ do + it "passes over one whose export list has no such operator" $ + lookupFixity (scopeKnowing [("Opaque", ["<+>"])] usesUnknown) InTerms Nothing (OpName "") + `shouldBe` Resolved defaultFixity ReportDefault + + it "blames one whose export list names it" $ + lookupFixity (scopeKnowing [("Opaque", [""])] usesUnknown) InTerms Nothing (OpName "") + `shouldBe` Unresolved (unreadOnly "Opaque") + + it "blames one that will not say what it exports" $ + lookupFixity (scopeKnowing [] usesUnknown) InTerms Nothing (OpName "") + `shouldBe` Unresolved (unreadOnly "Opaque") + + it "still passes over an import list that does not name it" $ + lookupFixity + (scopeKnowing [("Opaque", [""])] "module M where\nimport Opaque ((<+>))\n") + InTerms + Nothing + (OpName "") + `shouldBe` Resolved defaultFixity ReportDefault + + it "blames only the ones that could supply it, of several unread" $ + lookupFixity + (scopeKnowing [("Opaque", ["<+>"]), ("Other.Opaque", [""])] twoUnread) + InTerms + Nothing + (OpName "") + `shouldBe` Unresolved (unreadOnly "Other.Opaque") + + it "settles nothing on its own account when told nothing" $ + lookupFixity (fullScope usesUnknown) InTerms Nothing (OpName "") + `shouldBe` Unresolved (unreadOnly "Opaque") + + it "passes over one whose import list carries no such operator" $ + lookupFixity + (scopeSuspecting [("Opaque", [("T", ["<+>"])])] "import Opaque (T (..))\n") + InTerms + Nothing + (OpName "") + `shouldBe` Resolved defaultFixity ReportDefault + + it "blames one whose import list carries it" $ + lookupFixity + (scopeSuspecting [("Opaque", [("T", [""])])] "import Opaque (T (..))\n") + InTerms + Nothing + (OpName "") + `shouldBe` Unresolved (unreadOnly "Opaque") + + it "blames one whose (..) nothing is known about" $ + lookupFixity + (scopeSuspecting [] "import Opaque (T (..))\n") + InTerms + Nothing + (OpName "") + `shouldBe` Unresolved (unreadOnly "Opaque") + + it "passes over one that hides the operator along with its type" $ + lookupFixity + (scopeSuspecting [("Opaque", [("T", [""])])] "import Opaque hiding (T (..))\n") + InTerms + Nothing + (OpName "") + `shouldBe` Resolved defaultFixity ReportDefault + + it "lets a file be formatted when no unread module could have declared it" $ + unknownOperators + (scopeKnowing [("Opaque", ["<+>"])] usesUnknown) + (pmModule (parsed usesUnknown)) + `shouldBe` [] + + describe "what a name carries with it" $ do + it "takes a type's constructors" $ + childrenIn "module M where\ndata T = A | Int :| Int\n" + `shouldBe` [(OpName "T", [OpName ":|", OpName "A"])] + + it "takes a record's fields, which may be operators" $ + childrenIn "module M where\ndata T = T {(#) :: Int, name :: Int}\n" + `shouldBe` [(OpName "T", [OpName "#", OpName "T", OpName "name"])] + + it "takes a GADT's constructors" $ + childrenIn "module M where\ndata T where\n A :: T\n (:|) :: T -> T\n" + `shouldBe` [(OpName "T", [OpName ":|", OpName "A"])] + + it "takes a class's methods" $ + childrenIn "module M where\nclass C a where\n (.=) :: a -> a -> Int\n named :: a\n" + `shouldBe` [(OpName "C", [OpName ".=", OpName "named"])] + + it "takes a class's associated families" $ + childrenIn "module M where\nclass C a where\n type F a\n" + `shouldBe` [(OpName "C", [OpName "F"])] + + it "has nothing to say about a type synonym" $ + childrenIn "module M where\ntype T = Int\n" `shouldBe` [] + + it "keeps to what an export list hands on" $ + exportedChildrenIn "module M (T (A)) where\ndata T = A | Int :| Int\n" + `shouldBe` [(OpName "T", [OpName "A"])] + + it "hands on everything under a name exported with (..)" $ + exportedChildrenIn "module M (T (..)) where\ndata T = A | Int :| Int\n" + `shouldBe` [(OpName "T", [OpName ":|", OpName "A"])] + + it "hands on nothing under a type it does not declare" $ + exportedChildrenIn "module M (T (..)) where\nimport Elsewhere\n" + `shouldBe` [(OpName "T", [])] + + describe "layer 2: imports" $ do + it "brings in an operator a type carries" $ + lookupFixity (scopeCarrying "import Carrier (T (..))\n") InTerms Nothing (OpName ":|") + `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Carrier") + + it "leaves out an operator the type does not carry" $ + lookupFixity (scopeCarrying "import Carrier (T (..))\n") InTerms Nothing (OpName "<+>") + `shouldBe` Resolved defaultFixity ReportDefault + + it "hides an operator hidden along with its type" $ + lookupFixity (scopeCarrying "import Carrier hiding (T (..))\n") InTerms Nothing (OpName ":|") + `shouldBe` Resolved defaultFixity ReportDefault + + it "keeps what a hiding list leaves alone" $ + lookupFixity (scopeCarrying "import Carrier hiding (T (..))\n") InTerms Nothing (OpName "<+>") + `shouldBe` Resolved (Fixity LeftAssoc 6) (DeclaredIn "Carrier") + + it "brings in one a T(..) may carry, where nothing is known" $ + lookupFixity + (fullScope "module M where\nimport Carrier (T (..))\n") + InTerms + Nothing + (OpName ":|") + `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Carrier") + + it "leaves out one no item of that list could carry" $ + lookupFixity + (fullScope "module M where\nimport Carrier (f)\n") + InTerms + Nothing + (OpName ":|") + `shouldBe` Resolved defaultFixity ReportDefault + + it "keeps one a hiding T(..) cannot be shown to have hidden" $ + lookupFixity + (fullScope "module M where\nimport Carrier hiding (T (..))\n") + InTerms + Nothing + (OpName ":|") + `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Carrier") + + it "brings it in under a qualifier too" $ + lookupFixity + (scopeCarrying "import qualified Carrier as C (T (..))\n") + InTerms + (Just "C") + (OpName ":|") + `shouldBe` Resolved (Fixity RightAssoc 5) (DeclaredIn "Carrier") + + it "sees an unqualified import in both scopes" $ + scopeOf "module M where\nimport Data.Map\n" + `shouldBe` ( [(OpName "!", Fixity LeftAssoc 9)], + [(("Data.Map", OpName "!"), Fixity LeftAssoc 9)], + [] + ) + + it "does not bring a qualified import into unqualified scope" $ + scopeOf "module M where\nimport qualified Data.Map\n" + `shouldBe` ([], [(("Data.Map", OpName "!"), Fixity LeftAssoc 9)], []) + + it "makes an alias the qualifier" $ + scopeOf "module M where\nimport qualified Data.Map as M\n" + `shouldBe` ([], [(("M", OpName "!"), Fixity LeftAssoc 9)], []) + + it "keeps unqualified names when an alias is not qualified" $ + scopeOf "module M where\nimport Data.Map as M\n" + `shouldBe` ( [(OpName "!", Fixity LeftAssoc 9)], + [(("M", OpName "!"), Fixity LeftAssoc 9)], + [] + ) + + it "honours an explicit import list" $ + scopeOf "module M where\nimport Data.Sequence ((|>))\n" + `shouldBe` ( [(OpName "|>", Fixity LeftAssoc 5)], + [(("Data.Sequence", OpName "|>"), Fixity LeftAssoc 5)], + [] + ) + + it "honours a hiding list" $ + scopeOf "module M where\nimport Data.Sequence hiding ((|>))\n" + `shouldBe` ( [(OpName "<|", Fixity RightAssoc 5)], + [(("Data.Sequence", OpName "<|"), Fixity RightAssoc 5)], + [] + ) + + it "lets the module's own declaration win over an import" $ + let (unq, _, _) = scopeOf "module M where\nimport Data.Map\ninfixr 3 !\n" + in unq `shouldBe` [(OpName "!", Fixity RightAssoc 3)] + + describe "ambiguity" $ do + it "reports an operator imported with two different fixities" $ + let (_, _, amb) = scopeOf "module M where\nimport Data.Map\nimport Other\n" + in amb `shouldBe` [(Nothing, OpName "!")] + + it "reports nothing when two imports agree" $ + let (_, _, amb) = scopeOf "module M where\nimport Data.Map\nimport Agreeing\n" + in amb `shouldBe` [] + + it "reports nothing when the two go under different names" $ + let (_, _, amb) = + scopeOf "module M where\nimport Data.Map\nimport qualified Other\n" + in amb `shouldBe` [] + + it "reports an alias two imports disagree under" $ + let (_, _, amb) = + scopeOf + "module M where\nimport qualified Data.Map as M\nimport qualified Other as M\n" + in amb `shouldBe` [(Just "M", OpName "!")] + + it "reports nothing when two imports under one alias agree" $ + let (_, _, amb) = + scopeOf + "module M where\nimport qualified Data.Map as M\nimport qualified Agreeing as M\n" + in amb `shouldBe` [] + + it "counts an unqualified import towards the name it goes under" $ + let (_, _, amb) = + scopeOf + "module M where\nimport Data.Map\nimport qualified Other as Data.Map\n" + in amb `shouldBe` [(Just "Data.Map", OpName "!")] + + it "keeps a clashing alias apart from a clashing bare name" $ + let (_, _, amb) = + scopeOf + "module M where\nimport Data.Map\nimport Other\nimport qualified Data.Map as M\nimport qualified Other as M\n" + in amb `shouldBe` [(Nothing, OpName "!"), (Just "M", OpName "!")] + + describe "a module compiled with NoImplicitPrelude" $ do + it "settles an operator on the one module that is really in scope" $ + let s = + scopeAboutPrelude (Isn't #implicitPrelude) takesItsPreludeElsewhere + in lookupFixity s InTerms Nothing (OpName "<%>") + `shouldBe` Resolved (Fixity LeftAssoc 6) (DeclaredIn "Pretty") + + it "is left with nothing unsettled" $ + unsettledAboutPrelude (Isn't #implicitPrelude) usingItBothWays + `shouldBe` [] + + it "would be caught between two spellings were the Prelude assumed" $ + map snd (unsettledAboutPrelude (Is #implicitPrelude) usingItBothWays) + `shouldBe` [Ambiguous] + + it "still takes the Prelude where the module does import it" $ + let s = + scopeAboutPrelude + (Isn't #implicitPrelude) + "module M where\nimport Prelude\n" + in lookupFixity s InTerms Nothing (OpName "<%>") + `shouldBe` Resolved (Fixity RightAssoc 6) (DeclaredIn "Prelude") + + describe "lookupFixity" $ do + it "finds an unqualified operator" $ + let s = fullScope "module M where\nimport Data.Map\n" + in lookupFixity s InTerms Nothing (OpName "!") + `shouldBe` Resolved (Fixity LeftAssoc 9) (DeclaredIn "Data.Map") + + it "finds a qualified operator through its alias" $ + let s = fullScope "module M where\nimport qualified Data.Map as M\n" + in lookupFixity s InTerms (Just "M") (OpName "!") + `shouldBe` Resolved (Fixity LeftAssoc 9) (DeclaredIn "Data.Map") + + it "concludes infixl 9 when every module in scope was read" $ + let s = fullScope "module M where\nimport Data.Map\n" + in lookupFixity s InTerms Nothing (OpName "") + `shouldBe` Resolved defaultFixity ReportDefault + + it "refuses to conclude anything when a module could not be read" $ + let s = fullScope "module M where\nimport Data.Map\nimport Opaque\n" + in lookupFixity s InTerms Nothing (OpName "") + `shouldBe` Unresolved (unreadOnly "Opaque") + + it "still answers for an operator it did find, despite an unread module" $ + let s = fullScope "module M where\nimport Data.Map\nimport Opaque\n" + in lookupFixity s InTerms Nothing (OpName "!") + `shouldBe` Resolved (Fixity LeftAssoc 9) (DeclaredIn "Data.Map") + + it "attributes the module\'s own declaration to itself" $ + let s = fullScope "module M where\ninfixr 3 <+>\n" + in lookupFixity s InTerms Nothing (OpName "<+>") + `shouldBe` Resolved (Fixity RightAssoc 3) DeclaredHere + + it "does not find a qualified-only operator unqualified" $ + let s = fullScope "module M where\nimport qualified Data.Map\n" + in lookupFixity s InTerms Nothing (OpName "!") + `shouldBe` Resolved defaultFixity ReportDefault + + describe "a qualified use is answered from qualified scope alone" $ do + it "does not answer a qualifier that brought nothing in from what did" $ + let s = fullScope "module M where\nimport Data.Map\n" + in lookupFixity s InTerms (Just "Q") (OpName "!") + `shouldBe` Resolved defaultFixity ReportDefault + + it "does not lend the module's own declaration to a foreign qualifier" $ + let s = fullScope "module M where\ninfixr 3 <+>\n" + in lookupFixity s InTerms (Just "Q") (OpName "<+>") + `shouldBe` Resolved defaultFixity ReportDefault + + it "does not answer through an alias the import does not go under" $ + let s = fullScope "module M where\nimport qualified Data.Map as M\n" + in lookupFixity s InTerms (Just "Data.Map") (OpName "!") + `shouldBe` Resolved defaultFixity ReportDefault + + it "answers a use qualified by the module's own name" $ + let s = fullScope "module M where\ninfixr 3 <+>\n" + in lookupFixity s InTerms (Just "M") (OpName "<+>") + `shouldBe` Resolved (Fixity RightAssoc 3) DeclaredHere + + it "answers a plain import under the module's own name" $ + let s = fullScope "module M where\nimport Data.Map\n" + in lookupFixity s InTerms (Just "Data.Map") (OpName "!") + `shouldBe` Resolved (Fixity LeftAssoc 9) (DeclaredIn "Data.Map") + + it "weighs only the unread imports the qualifier reaches" $ + let s = fullScope "module M where\nimport qualified Data.Map as M\nimport Opaque\n" + in lookupFixity s InTerms (Just "M") (OpName "") + `shouldBe` Resolved defaultFixity ReportDefault + + it "refuses to conclude when the qualifier reaches an unread import" $ + let s = fullScope "module M where\nimport qualified Opaque as O\n" + in lookupFixity s InTerms (Just "O") (OpName "") + `shouldBe` Unresolved (unreadOnly "Opaque") + + describe "what could not be settled" $ do + it "says which qualifier the unsettled use was written under" $ + unsettledIn "module M where\nimport qualified Opaque as O\nf a b = a O.<+> b\n" + `shouldBe` [((Just "O", OpName "<+>"), NotRead (unreadOnly "Opaque"))] + + it "keeps a qualified use apart from an unqualified one" $ + unsettledIn + "module M where\nimport Opaque\nimport qualified Opaque as O\nf a b = a <+> b\ng a b = a O.<+> b\n" + `shouldBe` [ ((Nothing, OpName "<+>"), NotRead (unreadOnly "Opaque")), + ((Just "O", OpName "<+>"), NotRead (unreadOnly "Opaque")) + ] + + it "leaves a settled qualified use out, unread imports notwithstanding" $ + unsettledIn "module M where\nimport qualified Data.Map as M\nimport Opaque\nf m = m M.! 1\n" + `shouldBe` [] + + it "holds an ambiguous operator against its unqualified use only" $ + unsettledIn + "module M where\nimport Data.Map\nimport Other\nimport qualified Data.Map as M\nf a b = (a ! b, a M.! b)\n" + `shouldBe` [((Nothing, OpName "!"), Ambiguous)] + + it "holds a clashing alias against the use written under it" $ + unsettledIn + "module M where\nimport qualified Data.Map as M\nimport qualified Other as M\nf a b = a M.! b\n" + `shouldBe` [((Just "M", OpName "!"), Ambiguous)] + + it "leaves the bare operator alone when only an alias is in doubt" $ + unsettledIn + "module M where\nimport Data.Map\nimport qualified Data.Map as M\nimport qualified Other as M\nf a b = (a ! b, a M.! b)\n" + `shouldBe` [((Just "M", OpName "!"), Ambiguous)] + + it "spells a use the way the module wrote it" $ + map (uncurry operatorSpelling . fst) (unsettledIn "module M where\nimport qualified Opaque as O\nf a b = a O.<+> b\n") + `shouldBe` ["O.<+>"] + + describe "parsing with the module's own pragmas" + $ it "parses a module that needs an extension it declares" + $ declaredIn "{-# LANGUAGE MagicHash #-}\nmodule M where\ninfixl 6 <+>\n" + `shouldBe` [(OpName "<+>", Fixity LeftAssoc 6)] + +---------------------------------------------------------------------------- +-- Helpers + +-- | Stand-in for layer 3. The real one reads a build plan, maps modules to +-- packages and parses their sources; what it returns is exactly this shape, +-- so everything above it can be exercised without any of that. +exportsOf :: Text -> Maybe Fixities +exportsOf = \case + "Data.Map" -> whichever [(OpName "!", Fixity LeftAssoc 9)] + "Data.Sequence" -> + whichever + [ (OpName "|>", Fixity LeftAssoc 5), + (OpName "<|", Fixity RightAssoc 5) + ] + "Other" -> whichever [(OpName "!", Fixity RightAssoc 4)] + "Agreeing" -> whichever [(OpName "!", Fixity LeftAssoc 9)] + "Carrier" -> + whichever + [ (OpName ":|", Fixity RightAssoc 5), + (OpName "<+>", Fixity LeftAssoc 6) + ] + -- Spell @:>@ in different namespaces, as servant and text do. + "Types" -> Just (Map.fromList [((InTypes, OpName ":>"), Fixity RightAssoc 4)]) + "Terms" -> Just (Map.fromList [((InTerms, OpName ":>"), Fixity LeftAssoc 5)]) + "Other.Terms" -> Just (Map.fromList [((InTerms, OpName ":>"), Fixity RightAssoc 9)]) + "Opaque" -> Nothing + "Other.Opaque" -> Nothing + _ -> Just Map.empty + where + whichever = Just . inBothNamespaces . Map.fromList + +parsed :: Text -> ParsedModule +parsed src = case parseModule defaultParserConfig "test.hs" src of + Left _ -> error "the test input did not parse" + Right pm -> pm + +-- | The fixities a module declares, by name alone. +-- +-- One entry per operator: a fixity that governs both namespaces is one +-- declaration, however many places it lands in. +declaredIn :: Text -> [(OpName, Fixity)] +declaredIn = + Map.toList . Map.fromList . map (\((_, op), fixity) -> (op, fixity)) . declaredWithNamespaces + +-- | The same, keeping the namespace each governs. +declaredWithNamespaces :: Text -> [((Namespace, OpName), Fixity)] +declaredWithNamespaces = Map.toList . declaredFixities . pmModule . parsed + +exportsOfSource :: Text -> Maybe [ExportItem] +exportsOfSource = moduleExports . pmModule . parsed + +-- | A scope knowing what every module it can read exports, and nothing +-- about the ones it cannot. +fullScope :: Text -> Scope +fullScope = + resolveScope (Is #implicitPrelude) knowingExports . pmModule . parsed + +-- | What is known in a world made of 'exportsOf' alone. +knowingExports :: Known +knowingExports = nothingKnown {knownFixities = exportsOf} + +-- | The one import blamed for an operator, unread on its own account and so +-- with nothing below it. What every answer here was before a chain could be +-- reported at all. +unreadOnly :: Text -> NonEmpty ModuleChain +unreadOnly m = ModuleChain (m :| []) :| [] + +-- | A module that uses an operator nothing in scope declares, alongside an +-- import that could not be read. +usesUnknown :: Text +usesUnknown = "module M where\nimport Opaque\nf a b = a b\n" + +-- | The same, with a second unread import to tell apart from the first. +twoUnread :: Text +twoUnread = "module M where\nimport Opaque\nimport Other.Opaque\nf a b = a b\n" + +-- | A scope in which the unread modules listed say what they export. +-- +-- A module absent from the list says nothing, which is what 'fullScope' +-- assumes of every one of them. +scopeKnowing :: [(Text, [Text])] -> Text -> Scope +scopeKnowing said = + resolveScope + (Is #implicitPrelude) + knowingExports {knownExportNames = exportNamesOf} + . pmModule + . parsed + where + exportNamesOf m = Set.fromList . map OpName <$> lookup m said + +-- | What each name a module declares carries with it, in a settled order. +childrenIn :: Text -> [(OpName, [OpName])] +childrenIn = settled . declaredChildren . pmModule . parsed + +-- | The same, as the module's export list hands them on. +exportedChildrenIn :: Text -> [(OpName, [OpName])] +exportedChildrenIn = settled . moduleChildren . pmModule . parsed + +settled :: Map.Map OpName (Set.Set OpName) -> [(OpName, [OpName])] +settled = map (fmap Set.toList) . Map.toList + +-- | A scope over a world where Carrier keeps @:|@ under @T@. +-- +-- Carrier declares @<+>@ as well, under nothing, so that a list naming +-- @T(..)@ can be seen to bring the one in and leave the other out. +scopeCarrying :: Text -> Scope +scopeCarrying source = + resolveScope + (Is #implicitPrelude) + knowingExports {knownChildren = childrenOf} + (pmModule (parsed ("module M where\n" <> source))) + where + childrenOf = \case + "Carrier" -> Map.fromList [(OpName "T", Set.fromList [OpName ":|"])] + _ -> Map.empty + +-- | A scope over the two modules that spell @:>@ in different namespaces. +scopeOfBoth :: Text -> Scope +scopeOfBoth source = + resolveScope + (Is #implicitPrelude) + knowingExports + (pmModule (parsed ("module M where\n" <> source))) + +-- | A scope over an unread module, told what it keeps under its names. +-- +-- Opaque cannot be read for fixities and says nothing about what it +-- exports, so what the import list brings in is all there is to go on. +scopeSuspecting :: [(Text, [(Text, [Text])])] -> Text -> Scope +scopeSuspecting carries source = + resolveScope + (Is #implicitPrelude) + knowingExports {knownChildren = childrenOf} + (pmModule (parsed ("module M where\n" <> source <> "f a b = a b\n"))) + where + childrenOf m = + Map.fromList + [ (OpName parent, Set.fromList (map OpName kids)) + | (parent, kids) <- Map.findWithDefault [] m (Map.fromList carries) + ] + +-- | The operators a module's export list names, in a settled order. +exportedIn :: Text -> Maybe [OpName] +exportedIn = fmap Set.toList . exportedOperators . pmModule . parsed + +-- | The uses of an operator a module makes that its scope cannot settle. +unsettledIn :: Text -> [((Maybe Text, OpName), Unknown)] +unsettledIn src = + let hsModule = pmModule (parsed src) + in unknownOperators + (resolveScope (Is #implicitPrelude) knowingExports hsModule) + hsModule + +-- | A module that takes its Prelude from elsewhere and hides an operator +-- from it, in order to take that operator from a module which spells it the +-- other way round. +takesItsPreludeElsewhere :: Text +takesItsPreludeElsewhere = + "module M where\nimport Prelude.Compat hiding ((<%>))\nimport Pretty\n" + +-- | The same, going on to use the operator it took. +usingItBothWays :: Text +usingItBothWays = takesItsPreludeElsewhere <> "f a b = a <%> b\n" + +-- | A world in which the Prelude and a pretty-printer spell one operator +-- the two different ways, as @base@ and @pretty@ really do for @<>@. +-- +-- Kept out of 'exportsOf' so that a Prelude which declares something does +-- not have to be reckoned with by every other test in the file. +disagreeingAboutPrelude :: Known +disagreeingAboutPrelude = nothingKnown {knownFixities = said} + where + said = \case + "Prelude" -> whichever [(OpName "<%>", Fixity RightAssoc 6)] + "Pretty" -> whichever [(OpName "<%>", Fixity LeftAssoc 6)] + _ -> Just Map.empty + whichever = Just . inBothNamespaces . Map.fromList + +-- | That world's scope for a module, told whether it has the Prelude. +scopeAboutPrelude :: Choice "implicitPrelude" -> Text -> Scope +scopeAboutPrelude implicitPrelude = + resolveScope implicitPrelude disagreeingAboutPrelude . pmModule . parsed + +-- | What that world leaves unsettled in a module. +unsettledAboutPrelude :: + Choice "implicitPrelude" -> + Text -> + [((Maybe Text, OpName), Unknown)] +unsettledAboutPrelude implicitPrelude src = + let hsModule = pmModule (parsed src) + in unknownOperators + (resolveScope implicitPrelude disagreeingAboutPrelude hsModule) + hsModule + +scopeOf :: + Text -> + ( [(OpName, Fixity)], + [((Text, OpName), Fixity)], + [(Maybe Text, OpName)] + ) +scopeOf src = + let reach = scopeInTerms (fullScope src) + in ( Map.toList (Map.map fst (reachUnqualified reach)), + Map.toList (Map.map fst (reachQualified reach)), + reachAmbiguous reach + ) diff --git a/tests/Tilia/Gen.hs b/tests/Tilia/Gen.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Gen.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Generators for documents and spans. +module Tilia.Gen + ( AnyDoc (..), + PlainDoc (..), + FlatSafeDoc (..), + AnySpan (..), + SingleLineSpan (..), + MultiLineSpan (..), + docTexts, + ) +where + +import Data.Text (Text) +import Data.Text qualified as T +import Test.QuickCheck +import Tilia.Doc.Internal +import Tilia.Span + +---------------------------------------------------------------------------- +-- Spans + +-- | An arbitrary span. +newtype AnySpan = AnySpan Span + deriving (Eq, Show) + +instance Arbitrary AnySpan where + arbitrary = AnySpan <$> genSpan + shrink (AnySpan s) = AnySpan <$> shrinkSpan s + +-- | A span that occupied one line. +newtype SingleLineSpan = SingleLineSpan Span + deriving (Eq, Show) + +instance Arbitrary SingleLineSpan where + arbitrary = do + l <- choose (1, 20) + c0 <- choose (1, 40) + c1 <- choose (c0, 80) + pure (SingleLineSpan (mkSpan (l, c0) (l, c1))) + +-- | A span that ran across several lines. +newtype MultiLineSpan = MultiLineSpan Span + deriving (Eq, Show) + +instance Arbitrary MultiLineSpan where + arbitrary = do + l0 <- choose (1, 20) + n <- choose (1, 5) + c0 <- choose (1, 40) + c1 <- choose (1, 80) + pure (MultiLineSpan (mkSpan (l0, c0) (l0 + n, c1))) + +genSpan :: Gen Span +genSpan = do + l0 <- choose (1, 20) + n <- choose (0, 5) + c0 <- choose (1, 40) + c1 <- choose (1, 80) + pure (mkSpan (l0, c0) (l0 + n, c1)) + +shrinkSpan :: Span -> [Span] +shrinkSpan s = + [ mkSpan (spanStartLine s, spanStartColumn s) (spanStartLine s, spanEndColumn s) + | spanStartLine s /= spanEndLine s + ] + +---------------------------------------------------------------------------- +-- Documents + +-- | Text for a 'DText' node. +genText :: Gen Text +genText = T.pack <$> resize 4 (listOf1 (elements "abcxyz(),;")) + +-- | Any document at all. +newtype AnyDoc = AnyDoc Doc + deriving (Eq, Show) + +instance Arbitrary AnyDoc where + arbitrary = AnyDoc <$> sized (genDoc True True) + shrink (AnyDoc d) = AnyDoc <$> shrinkDoc d + +-- | A document with no 'DVariant'. +newtype PlainDoc = PlainDoc Doc + deriving (Eq, Show) + +instance Arbitrary PlainDoc where + arbitrary = PlainDoc <$> sized (genDoc False True) + shrink (PlainDoc d) = PlainDoc <$> shrinkDoc d + +-- | A document that cannot break on its own. +newtype FlatSafeDoc = FlatSafeDoc Doc + deriving (Eq, Show) + +instance Arbitrary FlatSafeDoc where + arbitrary = FlatSafeDoc <$> sized (genDoc False False) + shrink (FlatSafeDoc d) = FlatSafeDoc <$> shrinkDoc d + +-- | Build a document. +genDoc :: + -- | Whether 'DVariant' may appear + Bool -> + -- | Whether things that force a break may appear + Bool -> + -- | The size parameter + Int -> + Gen Doc +genDoc withVariant withBreaks = go + where + go n + | n <= 1 = leaf + | otherwise = oneof (leaf : branches) + where + half = n `div` 2 + branches = + [ DCat <$> go half <*> go half, + DNest <$> choose (0, 2) <*> go (n - 1), + DAlign <$> go (n - 1), + DLocated <$> genSpan <*> go (n - 1), + DFence <$> genSpan <*> go (n - 1) + ] + <> [ DGroup <$> elements [Flat, Broken] <*> go (n - 1) + | withBreaks + ] + <> [ DVariant <$> go half <*> go half + | withVariant + ] + leaf = + oneof $ + [ pure DEmpty, + DText <$> genText, + pure DSpace, + pure DBreak, + pure DSoftBreak + ] + <> (if withBreaks then [pure DHardBreak] else []) + +shrinkDoc :: Doc -> [Doc] +shrinkDoc = \case + DEmpty -> [] + DText t -> DText <$> filter (not . T.null) (T.inits t) + DSpace -> [DEmpty] + DBreak -> [DEmpty, DSpace] + DSoftBreak -> [DEmpty] + DHardBreak -> [DEmpty] + DVerbatimBreak _ -> [DEmpty] + DCloseLine -> [DEmpty] + DHoldBack t -> DHoldBack <$> filter (not . T.null) (T.inits t) + DCat a b -> [DEmpty, a, b] <> [DCat a' b | a' <- shrinkDoc a] <> [DCat a b' | b' <- shrinkDoc b] + DNest n d -> [DEmpty, d] <> [DNest n d' | d' <- shrinkDoc d] + DAlign d -> [DEmpty, d] <> [DAlign d' | d' <- shrinkDoc d] + DGroup l d -> [DEmpty, d] <> [DGroup l d' | d' <- shrinkDoc d] + DVariant a b -> [DEmpty, a, b] + DLocated s d -> [DEmpty, d] <> [DLocated s d' | d' <- shrinkDoc d] + DFence s d -> [DEmpty, d] <> [DFence s d' | d' <- shrinkDoc d] + DCppChoice bs e -> [DEmpty, e] <> map snd bs + DCppDirective _ _ -> [DEmpty] + +-- | Every fragment of literal text the document contains, in order. +-- +-- Undefined in the presence of 'DVariant', which contributes one of two +-- possible sequences depending on a layout this function cannot see; that +-- is what 'PlainDoc' exists to exclude. +docTexts :: Doc -> [Text] +docTexts = \case + DEmpty -> [] + DText t -> [t] + DSpace -> [] + DBreak -> [] + DSoftBreak -> [] + DHardBreak -> [] + DVerbatimBreak _ -> [] + DCloseLine -> [] + DHoldBack t -> [t] + DCat a b -> docTexts a <> docTexts b + DNest _ d -> docTexts d + DAlign d -> docTexts d + DGroup _ d -> docTexts d + DVariant a _ -> docTexts a + DLocated _ d -> docTexts d + DFence _ d -> docTexts d + DCppChoice bs e -> concat [c : docTexts d | (c, d) <- bs] <> docTexts e + DCppDirective _ t -> [t] diff --git a/tests/Tilia/NewlineSpec.hs b/tests/Tilia/NewlineSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/NewlineSpec.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | How a text ends its lines. +module Tilia.NewlineSpec (spec) where + +import Test.Hspec +import Tilia.Newline + +spec :: Spec +spec = do + describe "the style a text is written in" $ do + it "is read off the first ending there is" $ + map getNewlineStyle ["a\r\nb\n", "a\nb\r\n", "a\nb\n", "a\r\nb\r\n"] + `shouldBe` [CrLf, Lf, Lf, CrLf] + + it "is newlines for a text that ends no line at all" $ + getNewlineStyle "module A where" `shouldBe` Lf + + it "is newlines for a text with nothing in it" $ + getNewlineStyle "" `shouldBe` Lf + + describe "setting the style" $ do + it "goes either way round" $ do + setNewlineStyle CrLf "a\nb\n" `shouldBe` "a\r\nb\r\n" + setNewlineStyle Lf "a\r\nb\r\n" `shouldBe` "a\nb\n" + + it "can be told to set the style already there, and change nothing" $ + map (\(style, t) -> setNewlineStyle style t) [(CrLf, "a\r\nb\r\n"), (Lf, "a\nb\n")] + `shouldBe` ["a\r\nb\r\n", "a\nb\n"] + + it "brings a text whose endings disagree to one of them" $ do + setNewlineStyle CrLf "a\r\nb\nc\r\n" `shouldBe` "a\r\nb\r\nc\r\n" + setNewlineStyle Lf "a\r\nb\nc\r\n" `shouldBe` "a\nb\nc\n" + + it "leaves a carriage return that ends no line where it is" $ do + setNewlineStyle Lf "x = \"a\\\r b\"\r\n" `shouldBe` "x = \"a\\\r b\"\n" + setNewlineStyle CrLf "x = \"a\\\r b\"\n" `shouldBe` "x = \"a\\\r b\"\r\n" + + it "has nothing to do to a text that ends no line" $ + map (`setNewlineStyle` "module A where") [Lf, CrLf] + `shouldBe` ["module A where", "module A where"] + + it "takes a text out and back unchanged, whichever style it began in" $ + [setNewlineStyle style (setNewlineStyle Lf t) | (style, t) <- [(CrLf, crlf), (Lf, lf)]] + `shouldBe` [crlf, lf] + where + crlf = "module A where\r\n\r\nf :: Int\r\n" + lf = "module A where\n\nf :: Int\n" diff --git a/tests/Tilia/PackageSpec.hs b/tests/Tilia/PackageSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/PackageSpec.hs @@ -0,0 +1,218 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Information obtained from @.cabal@ files. +module Tilia.PackageSpec (spec) where + +import Data.List (isSuffixOf, sort) +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.IO qualified as T +import GHC.LanguageExtensions.Type (Extension (..)) +import System.Directory (createDirectoryIfMissing, removeFile) +import System.FilePath (()) +import System.IO.Temp (withSystemTempDirectory) +import Test.Hspec +import Tilia.Package (PackageProblem (..), newPackageReader) + +spec :: Spec +spec = do + describe "the component a file belongs to" $ do + it "is the one whose source directory holds it" $ + inPackage twoComponents ["src", "test"] $ \root -> do + library <- asked (root "src" "M.hs") + suite <- asked (root "test" "S.hs") + (has ImportQualifiedPost library, has ImportQualifiedPost suite) + `shouldBe` (True, False) + + it "settles the extensions separately for each" $ + inPackage twoComponents ["src", "test"] $ \root -> do + library <- asked (root "src" "M.hs") + suite <- asked (root "test" "S.hs") + (has OverloadedStrings library, has OverloadedStrings suite) + `shouldBe` (False, True) + + it "is none of them when the file is outside every source directory" $ + inPackage twoComponents ["src", "test", "scratch"] $ \root -> + (unclaimed <$> asked (root "scratch" "X.hs")) + `shouldReturn` True + + it "is the package's own directory when it names no source directory" $ + inPackage besideTheCabalFile [] $ \root -> + (has ImportQualifiedPost <$> asked (root "M.hs")) + `shouldReturn` True + + it "is the nearer one when a wider component covers it as well" $ + inPackage overTheWholeTree ["tests"] $ \root -> + (has ImportQualifiedPost <$> asked (root "tests" "S.hs")) + `shouldReturn` True + + it "is still the wider one for a file only it covers" $ + inPackage overTheWholeTree ["tests"] $ \root -> + (has ImportQualifiedPost <$> asked (root "M.hs")) + `shouldReturn` False + + describe "the extensions a component puts in force" $ do + it "are the language edition's" $ + inPackage twoComponents ["src"] $ \root -> do + library <- asked (root "src" "M.hs") + (length <$> library) `shouldSatisfy` either (const False) (> 40) + + it "can be turned off again by default-extensions" $ + inPackage refusesAnEdition ["src"] $ \root -> + (has ImportQualifiedPost <$> asked (root "src" "M.hs")) + `shouldReturn` False + + describe "a file nothing can be settled for" $ do + it "says so when there is no package above it" $ + withSystemTempDirectory "tilia-nopackage" $ \root -> + asked (root "M.hs") + `shouldReturn` Left NoPackageFile + + it "says so, and how, when the package does not parse" $ + inPackage "library\n hs-source-dirs\n" [] $ \root -> + asked (root "M.hs") >>= \case + Left (PackageMalformed file complaints) -> do + file `shouldSatisfy` (("demo.cabal" `isSuffixOf`)) + complaints `shouldSatisfy` not . null + other -> expectationFailure ("expected a parse failure, got " <> show other) + + describe "a reader kept between files" $ do + it "answers as a fresh one would" $ + inPackage twoComponents ["src", "test"] $ \root -> do + ask <- newPackageReader + kept <- traverse ask (modules root) + fresh <- traverse asked (modules root) + kept `shouldBe` fresh + + it "reads a package once, not once per file" $ + inPackage twoComponents ["src"] $ \root -> do + ask <- newPackageReader + first <- ask (root "src" "A.hs") + removeFile (root "demo.cabal") + ask (root "src" "B.hs") `shouldReturn` first + + it "remembers every directory the walk went through" $ + inPackage twoComponents ["src" "deep"] $ \root -> do + ask <- newPackageReader + deep <- ask (root "src" "deep" "A.hs") + removeFile (root "demo.cabal") + ask (root "src" "B.hs") `shouldReturn` deep + + it "is what makes those pass, and not the file surviving" $ + inPackage twoComponents ["src"] $ \root -> do + removeFile (root "demo.cabal") + (unreadableOrMissing <$> asked (root "src" "A.hs")) + `shouldReturn` True + +---------------------------------------------------------------------------- +-- The packages the tests are run against + +-- | A library on @GHC2021@ and a test suite on @Haskell2010@, so that the +-- two disagree about everything worth asking. +twoComponents :: Text +twoComponents = + T.unlines + [ "cabal-version: 2.4", + "name: demo", + "version: 0", + "", + "library", + " exposed-modules: M", + " hs-source-dirs: src", + " default-language: GHC2021", + "", + "test-suite spec", + " type: exitcode-stdio-1.0", + " main-is: S.hs", + " hs-source-dirs: test", + " default-language: Haskell2010", + " default-extensions: OverloadedStrings" + ] + +-- | A library that names no @hs-source-dirs@, so its modules sit beside the +-- @.cabal@ file. +besideTheCabalFile :: Text +besideTheCabalFile = + T.unlines + [ "cabal-version: 2.4", + "name: demo", + "version: 0", + "", + "library", + " exposed-modules: M", + " default-language: GHC2021" + ] + +-- | A library that spreads over the whole tree, and a suite inside it. +-- +-- The library names no @hs-source-dirs@ and so takes the package +-- directory, which holds the test suite's directory as well as its own +-- modules. +overTheWholeTree :: Text +overTheWholeTree = + T.unlines + [ "cabal-version: 2.4", + "name: demo", + "version: 0", + "", + "library", + " exposed-modules: M", + " default-language: Haskell2010", + "", + "test-suite spec", + " type: exitcode-stdio-1.0", + " main-is: S.hs", + " hs-source-dirs: tests", + " default-language: GHC2021" + ] + +-- | An edition, and then one of the things it brings taken back out. +refusesAnEdition :: Text +refusesAnEdition = + T.unlines + [ "cabal-version: 2.4", + "name: demo", + "version: 0", + "", + "library", + " exposed-modules: M", + " hs-source-dirs: src", + " default-language: GHC2021", + " default-extensions: NoImportQualifiedPost" + ] + +---------------------------------------------------------------------------- +-- Running one + +-- | Write a @.cabal@ file and the given directories, and hand back the root. +inPackage :: Text -> [FilePath] -> (FilePath -> IO a) -> IO a +inPackage contents dirs use = + withSystemTempDirectory "tilia-package" $ \root -> do + T.writeFile (root "demo.cabal") contents + mapM_ (createDirectoryIfMissing True . (root )) (sort dirs) + use root + +-- | Ask about one file with a reader of its own, which is what a test that +-- is not about caching wants. +asked :: FilePath -> IO (Either PackageProblem [Extension]) +asked path = do + ask <- newPackageReader + ask path + +-- | One module in each of the two components. +modules :: FilePath -> [FilePath] +modules root = [root "src" "M.hs", root "test" "S.hs"] + +unreadableOrMissing :: Either PackageProblem [Extension] -> Bool +unreadableOrMissing = either (const True) (const False) + +has :: Extension -> Either PackageProblem [Extension] -> Bool +has e = either (const False) (e `elem`) + +unclaimed :: Either PackageProblem [Extension] -> Bool +unclaimed = either isFileUnclaimed (const False) + where + isFileUnclaimed = \case + FileUnclaimed _ -> True + _ -> False diff --git a/tests/Tilia/PragmaSpec.hs b/tests/Tilia/PragmaSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/PragmaSpec.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | What a module's pragmas say, read off the text. +module Tilia.PragmaSpec (spec) where + +import Data.Text (Text) +import GHC.LanguageExtensions.Type (Extension (..)) +import Test.Hspec +import Tilia.Pragma + +spec :: Spec +spec = do + describe "movesPositions" $ do + describe "says so" $ do + for_' + [ ("a LINE pragma", "{-# LINE 1 \"Other.hs\" #-}\n"), + ("a COLUMN pragma", "{-# COLUMN 20 #-}\n"), + ("one written in lower case", "{-# line 1 \"Other.hs\" #-}\n"), + ("one written without spaces", "{-#LINE 1 \"Other.hs\"#-}\n"), + ("one written over several lines", "{-# LINE 1\n \"Other.hs\" #-}\n"), + ("one below the header", "module M where\nx = 1\n{-# LINE 9 \"O.hs\" #-}\n"), + ("one among pragmas that do not move anything", langThenLine) + ] + (\source -> movesPositions source `shouldBe` True) + + describe "says nothing of" $ do + for_' + [ ("a module with no pragma at all", "module M where\nx = 1\n"), + ("a LANGUAGE pragma", "{-# LANGUAGE LambdaCase #-}\nmodule M where\n"), + ("an INLINE pragma", "module M where\n{-# INLINE f #-}\nf = id\n"), + ("a pragma whose name merely starts with one", "{-# LINEAR 1 #-}\n"), + ("an unclosed pragma", "{-# LINE 1 \"Other.hs\"\n"), + ("the word in a comment", "-- {-* LINE 1 *-}\nmodule M where\n") + ] + (\source -> movesPositions source `shouldBe` False) + describe "the extensions in force" $ do + it "starts from what is on by default" $ + effectiveExtensions [] "module M where\n" `shouldBe` [ImplicitPrelude] + it "keeps what the package puts in force" $ + effectiveExtensions [ImplicitPrelude, GADTs] "module M where\n" + `shouldBe` [ImplicitPrelude, GADTs] + it "leaves the Prelude off where the package's own set does" $ + effectiveExtensions [GADTs] "module M where\n" `shouldBe` [GADTs] + it "reads one extension" $ + effectiveExtensions [] "{-# LANGUAGE BangPatterns #-}\nmodule M where\n" + `shouldBe` [ImplicitPrelude, BangPatterns] + it "reads several from one pragma" $ + effectiveExtensions [] "{-# LANGUAGE GADTs, RankNTypes #-}\nmodule M where\n" + `shouldBe` [ImplicitPrelude, GADTs, RankNTypes] + it "reads several pragmas" $ + effectiveExtensions [] "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE MagicHash #-}\n" + `shouldBe` [ImplicitPrelude, GADTs, MagicHash] + it "ignores other pragmas" $ + effectiveExtensions [] "{-# OPTIONS_GHC -Wall #-}\n{-# LANGUAGE GADTs #-}\n" + `shouldBe` [ImplicitPrelude, GADTs] + it "ignores an unknown extension rather than failing" $ + effectiveExtensions [] "{-# LANGUAGE GADTs, NotARealExtension #-}\n" + `shouldBe` [ImplicitPrelude, GADTs] + it "treats a No-prefix as turning one off" $ + effectiveExtensions [] "{-# LANGUAGE NoImplicitPrelude #-}\n" `shouldBe` [] + it "lets a module refuse what its package put in force" $ + effectiveExtensions [ImplicitPrelude, GADTs] "{-# LANGUAGE NoGADTs #-}\n" + `shouldBe` [ImplicitPrelude] + it "lets a module take back a Prelude its package turned off" $ + effectiveExtensions [GADTs] "{-# LANGUAGE ImplicitPrelude #-}\n" + `shouldBe` [GADTs, ImplicitPrelude] + it "does not repeat an extension named twice" $ + effectiveExtensions [] "{-# LANGUAGE GADTs #-}\n{-# LANGUAGE GADTs #-}\n" + `shouldBe` [ImplicitPrelude, GADTs] + + describe "lookupExtension" $ do + it "knows an extension by the name one writes" $ + lookupExtension "LambdaCase" `shouldBe` Just LambdaCase + it "says nothing of a name no compiler knows" $ + lookupExtension "NotARealExtension" `shouldBe` Nothing + it "does not accept the No-prefixed spelling as a name" $ + lookupExtension "NoImplicitPrelude" `shouldBe` Nothing + where + for_' cases expect = mapM_ (\(what, source) -> it what (expect source)) cases + + langThenLine :: Text + langThenLine = "{-# LANGUAGE LambdaCase #-}\nmodule M where\n{-# LINE 3 \"O.hs\" #-}\n" diff --git a/tests/Tilia/ProcessSpec.hs b/tests/Tilia/ProcessSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/ProcessSpec.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Running a program and collecting its output. +module Tilia.ProcessSpec (spec) where + +import Data.Text qualified as T +import System.Timeout (timeout) +import Test.Hspec +import Tilia.Process (readProgramOutput) + +spec :: Spec +spec = do + describe "what a program printed" $ do + it "comes back as it was printed" $ + shell "printf 'one\\ntwo\\n'" `shouldReturn` Just "one\ntwo\n" + + it "is read as UTF-8, whatever the machine's locale is" $ + shell "printf 'ma\\303\\257ntainer\\n'" `shouldReturn` Just "maïntainer\n" + + it "survives bytes that are not UTF-8 at all" $ + (fmap survived <$> shell "printf 'before\\377after'") + `shouldReturn` Just True + + it "ends its lines with newlines however the program ended them" $ + shell "printf 'a\\r\\nb\\r\\n'" `shouldReturn` Just "a\nb\n" + + describe "a program that has nothing to say" $ do + it "is nothing when it failed" $ + shell "printf 'half an answer'; exit 3" `shouldReturn` Nothing + + it "is nothing when it is not there to run" $ + readProgramOutput "tilia-no-such-program-exists" [] `shouldReturn` Nothing + + it "is nothing rather than a crash when it is a directory" $ + readProgramOutput "." [] `shouldReturn` Nothing + + describe "a program that says a great deal on its error stream" $ + it "is read to the end all the same" $ do + answered <- + timeout (30 * 1000000) $ + shell "yes error | head -c 200000 >&2; printf 'the answer'" + answered `shouldBe` Just (Just "the answer") + +-- | Run a shell command and take what it printed. +shell :: String -> IO (Maybe T.Text) +shell command = readProgramOutput "sh" ["-c", command] + +-- | Did what was printed either side of the unreadable byte come through? +survived :: T.Text -> Bool +survived out = T.isInfixOf "before" out && T.isInfixOf "after" out diff --git a/tests/Tilia/ProjectSpec.hs b/tests/Tilia/ProjectSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/ProjectSpec.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Finding the project a file belongs to. +module Tilia.ProjectSpec (spec) where + +import System.Directory (createDirectoryIfMissing, withCurrentDirectory) +import System.FilePath (()) +import System.IO.Temp (withSystemTempDirectory) +import Test.Hspec +import Tilia.Project + +spec :: Spec +spec = do + describe "in this repository" $ do + it "finds the root from the root" $ do + root <- findProjectRoot "." + (prMarker <$> root) `shouldBe` Just ProjectFile + + it "finds the root from a nested source directory" $ do + root <- findProjectRoot "src/Tilia/Printer" + (prMarker <$> root) `shouldBe` Just ProjectFile + + it "finds the root from a file rather than a directory" $ do + root <- findProjectRoot "src/Tilia/Fixity.hs" + (prMarker <$> root) `shouldBe` Just ProjectFile + + it "returns the same directory however it is reached" $ do + a <- findProjectRoot "." + b <- findProjectRoot "tests/Tilia" + c <- findProjectRoot "src/Tilia/Printer/Internal.hs" + (prPath <$> a, prPath <$> b) `shouldBe` (prPath <$> a, prPath <$> c) + (prPath <$> b) `shouldBe` (prPath <$> c) + + describe "marker precedence" $ do + it "prefers cabal.project to a bare .cabal file" $ + withTree [("cabal.project", ""), ("thing.cabal", "")] $ \dir -> do + root <- findProjectRoot dir + (prMarker <$> root) `shouldBe` Just ProjectFile + + it "accepts a bare .cabal file when there is no project" $ + withTree [("thing.cabal", "")] $ \dir -> do + root <- findProjectRoot dir + (prMarker <$> root) `shouldBe` Just (PackageFile "thing.cabal") + + it "passes over a stack.yaml, which cabal does not read" $ + withTree [("stack.yaml", ""), ("thing.cabal", "")] $ \dir -> do + root <- findProjectRoot dir + (prMarker <$> root) `shouldBe` Just (PackageFile "thing.cabal") + + it "climbs out of a stack project to the package it is asked about" $ + withTree [("stack.yaml", ""), ("packages/inner/inner.cabal", "")] $ + \dir -> do + root <- findProjectRoot (dir "packages" "inner") + prPath <$> root `shouldBe` Just (dir "packages" "inner") + + it "climbs past a package to the project that contains it" + $ withTree + [ ("cabal.project", ""), + ("packages/inner/placeholder", "") + ] + $ \dir -> do + root <- findProjectRoot (dir "packages" "inner") + (prMarker <$> root) `shouldBe` Just ProjectFile + + it "climbs past a package that has its own .cabal" + $ withTree + [ ("cabal.project", ""), + ("packages/inner/inner.cabal", "") + ] + $ \dir -> do + root <- findProjectRoot (dir "packages" "inner") + (prPath <$> root) `shouldBe` Just dir + (prMarker <$> root) `shouldBe` Just ProjectFile + + it "takes the nearest project of the ones above" + $ withTree + [ ("cabal.project", ""), + ("packages/inner/cabal.project", ""), + ("packages/inner/inner.cabal", "") + ] + $ \dir -> do + root <- findProjectRoot (dir "packages" "inner") + prPath <$> root `shouldBe` Just (dir "packages" "inner") + + it "takes the nearest package when no project is above either" + $ withTree + [ ("outer.cabal", ""), + ("packages/inner/inner.cabal", "") + ] + $ \dir -> do + root <- findProjectRoot (dir "packages" "inner") + (prMarker <$> root) `shouldBe` Just (PackageFile "inner.cabal") + + it "climbs to a project past a package that is not the one asked about" + $ withTree + [ ("cabal.project", ""), + ("outer.cabal", ""), + ("packages/inner/inner.cabal", "") + ] + $ \dir -> do + root <- findProjectRoot (dir "packages" "inner") + (prMarker <$> root) `shouldBe` Just ProjectFile + + describe "no project" $ + it "gives up rather than guessing" $ + withTree [("lonely/Thing.hs", "module Thing where")] $ \dir -> + -- A temporary directory has no project above it, so this walks to + -- the filesystem root and finds nothing. + withCurrentDirectory dir $ do + root <- findProjectRoot "lonely" + case root of + Nothing -> pure () + Just found -> + -- Some machines have a stray marker in a parent of the + -- system temporary directory; only a genuine find inside the + -- tree would be a failure. + prPath found `shouldNotBe` (dir "lonely") + +-- | Build a throwaway tree of files and run an action on its root. +withTree :: [(FilePath, String)] -> (FilePath -> IO a) -> IO a +withTree files action = + withSystemTempDirectory "tilia-project" $ \dir -> do + mapM_ (create dir) files + action dir + where + create dir (path, contents) = do + let full = dir path + createDirectoryIfMissing True (parentOf full) + writeFile full contents + parentOf = reverse . drop 1 . dropWhile (/= '/') . reverse diff --git a/tests/Tilia/Render/OperatorSpec.hs b/tests/Tilia/Render/OperatorSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/Render/OperatorSpec.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE LambdaCase #-} + +-- | Regrouping operator chains by precedence. +module Tilia.Render.OperatorSpec (spec) where + +import Data.List.NonEmpty (NonEmpty (..)) +import Test.Hspec +import Tilia.Fixity (Direction (..), Fixity (..)) +import Tilia.Render.Operator + +spec :: Spec +spec = do + describe "flatten" $ do + it "leaves a leaf alone" $ + flatten split (Leaf 'a') `shouldBe` (Leaf 'a' :| [], []) + it "reads a chain left to right" $ + flatten split (Apply (Apply (Leaf 'a') '+' (Leaf 'b')) '*' (Leaf 'c')) + `shouldBe` (Leaf 'a' :| [Leaf 'b', Leaf 'c'], ['+', '*']) + it "does not go inside a leaf" $ + flatten split (Apply (Leaf 'a') '+' (Opaque (Apply (Leaf 'b') '*' (Leaf 'c')))) + `shouldBe` (Leaf 'a' :| [Opaque (Apply (Leaf 'b') '*' (Leaf 'c'))], ['+']) + + describe "associate" $ do + it "makes one level of a chain that binds equally" $ + associate known (leaves "abc") ['+', '+'] + `shouldBe` Chain (Operand (Leaf 'a') :| [Operand (Leaf 'b'), Operand (Leaf 'c')]) ['+', '+'] + + it "splits at the loosest operator" $ + associate known (leaves "abc") ['*', '+'] + `shouldBe` Chain + ( Chain (Operand (Leaf 'a') :| [Operand (Leaf 'b')]) ['*'] + :| [Operand (Leaf 'c')] + ) + ['+'] + + it "puts every level in its place" $ + associate known (leaves "abcd") ['*', '+', '*'] + `shouldBe` Chain + ( Chain (Operand (Leaf 'a') :| [Operand (Leaf 'b')]) ['*'] + :| [Chain (Operand (Leaf 'c') :| [Operand (Leaf 'd')]) ['*']] + ) + ['+'] + + it "keeps a single operand as one" $ + associate known (Leaf 'a' :| []) [] + `shouldBe` Operand (Leaf 'a') + + -- What the author wrote is the only information left when a fixity + -- cannot be established, so it is what the layout follows. + it "leaves the chain flat when one fixity is unknown" $ + associate known (leaves "abc") ['*', '?'] + `shouldBe` Chain (Operand (Leaf 'a') :| [Operand (Leaf 'b'), Operand (Leaf 'c')]) ['*', '?'] + + describe "separators" $ do + it "recognises an operator that introduces its operand" $ + isSeparator (Just (Fixity RightAssoc 0)) `shouldBe` True + it "does not mistake a tight right-associative operator for one" $ + isSeparator (Just (Fixity RightAssoc 6)) `shouldBe` False + it "says nothing about an operator it does not know" $ + isSeparator Nothing `shouldBe` False + +---------------------------------------------------------------------------- +-- A stand-in for the syntax tree + +-- | Just enough of an expression to have operators in it. +data E + = Leaf Char + | Apply E Char E + | -- | Something the chain builder must not look inside, standing in for a + -- parenthesised subexpression. + Opaque E + deriving (Eq, Show) + +split :: E -> Maybe (E, Char, E) +split = \case + Apply l o r -> Just (l, o, r) + _ -> Nothing + +leaves :: [Char] -> NonEmpty E +leaves = \case + [] -> error "leaves: none" + (c : cs) -> Leaf c :| map Leaf cs + +-- | @?@ is the operator nothing is known about. +known :: Char -> Maybe Fixity +known = \case + '+' -> Just (Fixity LeftAssoc 6) + '*' -> Just (Fixity LeftAssoc 7) + _ -> Nothing diff --git a/tests/Tilia/RenderSpec.hs b/tests/Tilia/RenderSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/RenderSpec.hs @@ -0,0 +1,346 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Formatting whole modules. +module Tilia.RenderSpec (spec) where + +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text (Text) +import Data.Text qualified as T +import GHC.LanguageExtensions.Type (Extension (..)) +import Test.Hspec +import Tilia.Doc (defaultRenderOptions, printDoc) +import Tilia.Fixity + ( Direction (..), + Fixity (..), + OpName (..), + Provenance (..), + Reach (..), + Scope (..), + ) +import Tilia.Parser (defaultParserConfig, parseModule) +import Tilia.Render + +spec :: Spec +spec = do + describe "the module header" $ do + it "puts the pragmas above the module and sorts them" $ + format + [ "{-# LANGUAGE OverloadedStrings, GADTs #-}", + "module M where" + ] + `shouldBe` [ "{-# LANGUAGE GADTs #-}", + "{-# LANGUAGE OverloadedStrings #-}", + "", + "module M where" + ] + + it "puts an extension pack before what it enables" $ + format + [ "{-# LANGUAGE ApplicativeDo #-}", + "{-# LANGUAGE GHC2021 #-}", + "module M where" + ] + `shouldBe` [ "{-# LANGUAGE GHC2021 #-}", + "{-# LANGUAGE ApplicativeDo #-}", + "", + "module M where" + ] + + it "puts qualified first throughout when the extension is off" $ + format + [ "module M where", + "import Data.Map qualified as M", + "import qualified Data.Set as S" + ] + `shouldBe` [ "module M where", + "", + "import qualified Data.Map as M", + "import qualified Data.Set as S" + ] + + it "puts qualified last throughout when the extension is on" $ + formatUnder + [ImportQualifiedPost] + [ "module M where", + "import Data.Map qualified as M", + "import qualified Data.Set as S" + ] + `shouldBe` [ "module M where", + "", + "import Data.Map qualified as M", + "import Data.Set qualified as S" + ] + + it "parses a module that takes back an extension the edition puts in force" $ + format + [ "{-# LANGUAGE NoStarIsType #-}", + "{-# LANGUAGE TypeOperators #-}", + "module M (type (*)) where", + "import GHC.TypeLits (type (*))" + ] + `shouldBe` [ "{-# LANGUAGE TypeOperators #-}", + "{-# LANGUAGE NoStarIsType #-}", + "", + "module M (type (*)) where", + "", + "import GHC.TypeLits (type (*))" + ] + + describe "comments" $ do + it "keeps one written between declarations" $ + format + [ "module M where", + "", + "-- a note", + "f = 1" + ] + `shouldBe` [ "module M where", + "", + "-- a note", + "f = 1" + ] + + it "keeps one written inside a binding" $ + format + [ "module M where", + "", + "f = g", + " where", + " -- about g", + " g = 1" + ] + `shouldBe` [ "module M where", + "", + "f = g", + " where", + " -- about g", + " g = 1" + ] + + it "keeps a self-delimiting one on the line it was written on" $ + format ["module M where", "", "f =", " {- here -} 1"] + `shouldBe` ["module M where", "", "f =", " {- here -} 1"] + + it "will not put a construct holding one on a single line" $ + format + [ "module M where", + "", + "f =", + " ( -- here", + " 1", + " )" + ] + `shouldBe` [ "module M where", + "", + "f =", + " ( -- here", + " 1", + " )" + ] + + describe "operator chains" $ do + -- With the fixities known, the chain is regrouped so that what binds + -- tightly stays together and the break falls where the reader expects. + it "breaks a chain at its loosest operator" $ + formatWith (Just arithmetic) spreadChain + `shouldBe` [ "module M where", + "", + "f =", + " a * b", + " + c * d" + ] + + -- Without them nothing is asserted about how the chain associates, so + -- nothing is rearranged and every operator is treated alike. + it "leaves a chain alone when the fixities are unknown" $ + formatWith Nothing spreadChain + `shouldBe` [ "module M where", + "", + "f =", + " a", + " * b", + " + c", + " * d" + ] + + it "lets a separator hand a block to what precedes it" $ + formatWith + (Just arithmetic) + ["module M where", "", "f = g $ do", " h", " i"] + `shouldBe` [ "module M where", + "", + "f = g $ do", + " h", + " i" + ] + + describe "where a comment lands" $ do + -- A comment the author wrote after code ends a line here too, and the + -- printer has not finished with that line: the comma of a record field, + -- the arrow of an alternative and the closing bracket of a list all + -- still have to be emitted, and all of them belong before it. + it "keeps a comment at the end of the line it was written on" $ + format + [ "module M where", + "", + "f = case x of", + " a -> -- why", + " b" + ] + `shouldBe` [ "module M where", + "", + "f = case x of", + " a -> -- why", + " b" + ] + + it "leaves a comment written on its own line on one" $ + format + [ "module M where", + "", + "f = case x of", + " a ->", + " -- why", + " b" + ] + `shouldBe` [ "module M where", + "", + "f = case x of", + " a ->", + " -- why", + " b" + ] + + it "keeps one written before the closing bracket inside it" $ + format + [ "module M where", + "", + "xs =", + " [ a,", + " b", + " -- and that is all", + " ]" + ] + `shouldBe` [ "module M where", + "", + "xs =", + " [ a,", + " b", + " -- and that is all", + " ]" + ] + + -- Formatting an already formatted file must change nothing. The property + -- is easy to lose the moment comments move, since where a comment goes is + -- read off the input and moving it changes what the next pass reads. + describe "settling" + $ it "reaches its answer in one pass" + $ let once = format awkward + in formatWith Nothing once `shouldBe` once + + describe "layout follows the input" $ do + it "keeps a declaration that was on one line on one line" $ + format ["module M where", "", "f x = (x, x)"] + `shouldBe` ["module M where", "", "f x = (x, x)"] + + it "keeps one that was spread out spread out" $ + format ["module M where", "", "f x =", " ( x,", " x", " )"] + `shouldBe` [ "module M where", + "", + "f x =", + " ( x,", + " x", + " )" + ] + +---------------------------------------------------------------------------- +-- Helpers + +-- | Format the given lines and give the result back as lines. +format :: [Text] -> [Text] +format = formatWith Nothing + +-- | Format with the given extensions in force, as a package would put them. +formatUnder :: [Extension] -> [Text] -> [Text] +formatUnder exts = withSettings defaultRenderConfig {rcExtensions = Set.fromList exts} + +formatWith :: Maybe Scope -> [Text] -> [Text] +formatWith scope = withSettings defaultRenderConfig {rcScope = scope} + +withSettings :: RenderConfig -> [Text] -> [Text] +withSettings settings input = + case parseModule defaultParserConfig "" source of + Left _ -> error ("did not parse:\n" <> T.unpack source) + Right parsed -> + T.lines (printDoc defaultRenderOptions (renderModule settings parsed)) + where + source = T.unlines input + +-- | A module with comments in all the places that are hard to put them +-- back. +awkward :: [Text] +awkward = + [ "module M where", + "", + "-- | A heading", + "", + "-- and a note under it", + "data T = T", + " { a :: Int, -- the first", + " -- the second", + " b :: Int", + " }", + "", + "f x -- what to do with this?", + " | x > 0 = g x", + " | otherwise = h x", + " where", + " g = id", + "", + " -- about h", + " h = negate", + "", + "xs =", + " [ one,", + " {- inline -} two", + " -- last", + " ]" + ] + +-- | A chain the author already spread over more than one line, so that the +-- question is where it breaks rather than whether it does. +spreadChain :: [Text] +spreadChain = + [ "module M where", + "", + "f =", + " a * b", + " + c * d" + ] + +-- | A scope that knows the operators the tests use. +arithmetic :: Scope +arithmetic = + Scope + { scopeInTypes = nothingReaches, + scopeInTerms = + nothingReaches + { reachUnqualified = + Map.fromList + [ (OpName "$", (Fixity RightAssoc 0, DeclaredHere)), + (OpName "+", (Fixity LeftAssoc 6, DeclaredHere)), + (OpName "*", (Fixity LeftAssoc 7, DeclaredHere)) + ] + }, + scopeUnread = [] + } + +-- | A namespace with nothing in it. +nothingReaches :: Reach +nothingReaches = + Reach + { reachUnqualified = Map.empty, + reachQualified = Map.empty, + reachAmbiguous = [] + } diff --git a/tests/Tilia/RunSpec.hs b/tests/Tilia/RunSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/RunSpec.hs @@ -0,0 +1,512 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Running the formatter over a set of files. +module Tilia.RunSpec (spec) where + +import Control.Concurrent (getNumCapabilities, threadDelay) +import Data.ByteString qualified as BS +import Data.Either (isLeft) +import Data.IORef +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import Data.Text.IO qualified as T +import GHC.Clock (getMonotonicTime) +import System.Directory (getModificationTime) +import System.FilePath (()) +import System.IO.Temp (withSystemTempDirectory) +import Test.Hspec +import Tilia.Cpp (CppError (..)) +import Tilia.Fixity (ModuleChain (..), OpName (..), Unknown (..)) +import Tilia.Format (FormatError (..), formatErrorExitCode, refused) +import Tilia.Package (PackageProblem (..)) +import Tilia.Palette (Color (Bad), Palette (..)) +import Tilia.Run +import Tilia.Utils (lineWidth, visibleLength, wrapTo) + +spec :: Spec +spec = do + describe "telling a refusal from a failure" $ do + it "counts what we would not touch as a refusal" $ + map + refused + [ PositionPragmas "A.hs", + CppUnsupported "A.hs" UnsplittableConditional, + UnknownFixity "A.hs" [] + ] + `shouldBe` [True, True, True] + + it "counts what we could not read or make sense of as a failure" $ + map + refused + [ Unreadable "A.hs" "no such file", + NoPackage "A.hs" NoPackageFile, + NoProject "A.hs", + NoBuildPlan "." "cabal said no", + NotEquivalent "A.hs" "f = 1 became f = 2", + NotIdempotent "A.hs" "line 12 differs" + ] + `shouldBe` [False, False, False, False, False, False] + + describe "what became of a file" $ do + it "counts a rewrite as a difference and nothing else" $ + map differs [Changed "a" "b", Unchanged, decline, failure] + `shouldBe` [True, False, False, False] + + it "keeps refusals and failures apart" $ do + map declined [decline, failure, Unchanged] `shouldBe` [True, False, False] + map failed [decline, failure, Unchanged] `shouldBe` [False, True, False] + + describe "the status a run leaves behind" $ do + it "has none to give when nothing failed" $ + exitCodeOf [("A.hs", Unchanged), ("B.hs", decline), ("C.hs", Changed "a" "b")] + `shouldBe` Nothing + + it "gives the code of the failure when there is one" $ + exitCodeOf [("A.hs", failure)] + `shouldBe` Just (formatErrorExitCode (Unreadable "A.hs" "gone")) + + it "gives the lowest code when there are several" $ + exitCodeOf [("A.hs", failure), ("B.hs", otherFailure)] + `shouldBe` Just (min (formatErrorExitCode unreadable) (formatErrorExitCode unclaimed)) + + it "does not depend on the order the failures came back in" $ + exitCodeOf [("A.hs", failure), ("B.hs", otherFailure)] + `shouldBe` exitCodeOf [("B.hs", otherFailure), ("A.hs", failure)] + + it "is not swayed by a refusal, however many there are" $ + exitCodeOf [("A.hs", decline), ("B.hs", decline)] `shouldBe` Nothing + + describe "the summary an inplace run prints" $ do + it "counts the files it formatted, indented, by extension" $ + reportOut (inplaceReport Plain [("A.hs", Unchanged), ("B.hs", Changed "a" "b")]) + `shouldBe` [" [✓] Formatted 2 .hs files"] + + it "counts each extension on its own line, in a settled order" $ + reportOut + ( inplaceReport + Plain + [("C.hsig", Unchanged), ("A.hs", Unchanged), ("B.hs-boot", Unchanged)] + ) + `shouldBe` [ " [✓] Formatted 1 .hs file", + " [✓] Formatted 1 .hs-boot file", + " [✓] Formatted 1 .hsig file" + ] + + it "says file rather than files when there is one" $ + reportOut (inplaceReport Plain [("A.hs", Unchanged)]) + `shouldBe` [" [✓] Formatted 1 .hs file"] + + it "counts neither a refusal nor a failure among the formatted" $ + reportOut (inplaceReport Plain [("A.hs", Unchanged), ("B.hs", decline), ("C.hs", failure)]) + `shouldBe` [" [✓] Formatted 1 .hs file"] + + it "says nothing at all about a run with no files" $ + inplaceReport Plain [] `shouldBe` Report [] [] + + describe "the files a run did not format" $ do + let mixed = + [ ("b.hs", decline), + ("a.hs", Failed (Unreadable "a.hs" "no such file")), + ("c.hs-boot", decline) + ] + + it "tallies refusals and failures apart, and puts refusals first" $ + filter (T.isInfixOf "] ") (reportErr (inplaceReport Plain mixed)) + `shouldBe` [ " [=] Declined 1 .hs file", + " [=] Declined 1 .hs-boot file", + " [✗] Failed 1 .hs file" + ] + + it "gives a reason for every one of them" $ + length (filter opensAReason (reportErr (inplaceReport Plain mixed))) + `shouldBe` 3 + + it "says what a file that would not settle did" $ + reportErr + (inplaceReport Plain [("A.hs", Failed (NotIdempotent "A.hs" "line 12 differs"))]) + `shouldSatisfy` any (T.isInfixOf "A.hs is not idempotent: line 12 differs") + + it "names the file in the reason, once" $ + reportErr (inplaceReport Plain mixed) + `shouldSatisfy` any (T.isInfixOf "cannot read a.hs: no such file") + + it "orders the reasons by file, not by arrival" $ + reportErr (inplaceReport Plain mixed) + `shouldBe` reportErr (inplaceReport Plain (reverse mixed)) + + it "opens every case with a bullet" $ + filter opensAReason (reportErr (inplaceReport Plain mixed)) + `shouldSatisfy` all (T.isPrefixOf " · ") + + it "lines a wrapped case up with the text of its bullet" $ + reportErr (inplaceReport Plain [("A.hs", Failed (Unreadable "A.hs" (T.replicate 20 "and more words ")))]) + `shouldSatisfy` \case + (_tallyLine : opening : continuation : _) -> + T.isPrefixOf " · " opening + && T.takeWhile (== ' ') continuation == " " + _ -> False + + it "lays an unsettled operator at the door of the run, not of the module" $ + flattened (inplaceReport Plain [("A.hs", missing "Criterion.Main")]) + `shouldSatisfy` T.isInfixOf + "the fixity of <|> may be declared in Criterion.Main, which this run could not read" + + it "counts the modules when the answer could be in more than one" $ + flattened (inplaceReport Plain [("A.hs", missingIn ["Criterion.Main", "Test.Tasty"])]) + `shouldSatisfy` T.isInfixOf + "may be declared in Criterion.Main or Test.Tasty, neither of which this run could read" + + it "names the module reading stopped at, not only the import above it" $ + flattened + (inplaceReport Plain [("A.hs", missingThrough [ModuleChain ("Test.Hspec" :| ["Test.QuickCheck.Property"])])]) + `shouldSatisfy` T.isInfixOf + "may be declared in Test.Hspec → Test.QuickCheck.Property, which this run could not read" + + it "gives one answer once however many operators share it" $ + flattened (inplaceReport Plain [("A.hs", missingTwice "Criterion.Main")]) + `shouldSatisfy` T.isInfixOf + "the fixities of <|> and <+> may be declared in Criterion.Main, which this run could not read" + + it "puts a comma before the and once there are three of them" $ + flattened (inplaceReport Plain [("A.hs", missingAll ["<|>", "<+>", "<*>"] "Criterion.Main")]) + `shouldSatisfy` T.isInfixOf "the fixities of <|>, <+>, and <*> may be declared in" + + it "leaves a pair without one" $ + flattened (inplaceReport Plain [("A.hs", missingAll ["<|>", "<+>"] "Criterion.Main")]) + `shouldSatisfy` T.isInfixOf "the fixities of <|> and <+> may be declared in" + + it "counts each answer's operators rather than the file's" $ + flattened (inplaceReport Plain [("A.hs", twoAnswers)]) + `shouldSatisfy` T.isInfixOf + "the fixity of <|> may be declared in Criterion.Main, which this run \ + \could not read, and the fixity of <+> is declared differently by two \ + \modules in scope" + + it "keeps all of it off the stream the summary goes to" $ + reportOut (inplaceReport Plain mixed) `shouldBe` [] + + it "says the same about them in either command" $ + reportErr (checkReport Plain mixed) `shouldBe` reportErr (inplaceReport Plain mixed) + + describe "what a check run prints" $ do + it "shows a diff for a file that would change" $ + reportOut (checkReport Plain [("A.hs", Changed "one\n" "two\n")]) + `shouldSatisfy` any (T.isInfixOf "--- a/A.hs") + + it "heads it the way git heads one" $ + reportOut (checkReport Plain [("A.hs", Changed "one\n" "two\n")]) + `shouldSatisfy` any (T.isInfixOf "diff --git a/A.hs b/A.hs") + + it "shows the removal and the addition" $ do + let shown = T.unlines (reportOut (checkReport Plain [("A.hs", Changed "one\n" "two\n")])) + shown `shouldSatisfy` T.isInfixOf "-one" + shown `shouldSatisfy` T.isInfixOf "+two" + + it "says nothing on standard output about a file it did not format" $ + reportOut (checkReport Plain [("A.hs", Unchanged), ("B.hs", decline), ("C.hs", failure)]) + `shouldBe` [] + + describe "color" $ do + it "leaves everything bare when there is nobody to see it" $ + reportOut (inplaceReport Plain [("A.hs", Unchanged)]) + `shouldSatisfy` all (not . T.isInfixOf "\ESC") + + it "colors the tick and not the brackets around it" $ + reportOut (inplaceReport Colors [("A.hs", Unchanged)]) + `shouldSatisfy` any (T.isInfixOf "[\ESC[32m✓\ESC[0m]") + + it "colors the equals sign yellow" $ + reportErr (inplaceReport Colors [("A.hs", decline)]) + `shouldSatisfy` any (T.isInfixOf "[\ESC[33m=\ESC[0m]") + + it "sets the extension in the summary in bold" $ + reportOut (inplaceReport Colors [("A.hs", Unchanged)]) + `shouldSatisfy` any (T.isInfixOf "\ESC[1m.hs\ESC[0m") + + it "sets the file a case is about in bold, and nothing around it" $ + reportErr (inplaceReport Colors [("src/A.hs", failureAbout "src/A.hs")]) + `shouldSatisfy` any (T.isInfixOf "\ESC[1msrc/A.hs\ESC[0m") + + it "leaves the file bare when there is nobody to see it" $ + reportErr (inplaceReport Plain [("src/A.hs", failureAbout "src/A.hs")]) + `shouldSatisfy` all (not . T.isInfixOf "\ESC") + + it "sets an operator a message names in cyan" $ + reportErr (inplaceReport Colors [("A.hs", about "<|>")]) + `shouldSatisfy` any (T.isInfixOf "\ESC[36m<|>\ESC[0m") + + it "matches an operator as a whole word and not as a fragment" $ do + let shown = T.unlines (reportErr (inplaceReport Colors [("A.hs", about ".")])) + T.count "\ESC[36m" shown `shouldBe` 1 + shown `shouldSatisfy` T.isInfixOf "\ESC[1mA.hs\ESC[0m" + + it "leaves the operator bare when there is nobody to see it" $ + reportErr (inplaceReport Plain [("A.hs", about "<|>")]) + `shouldSatisfy` all (not . T.isInfixOf "\ESC") + + it "sets a module a message names in bold" $ + reportErr (inplaceReport Colors [("A.hs", missing "Criterion.Main")]) + `shouldSatisfy` any (T.isInfixOf "\ESC[1mCriterion.Main\ESC[0m") + + it "colors a module even where a comma follows it" $ + reportErr (inplaceReport Colors [("A.hs", missing "Criterion.Main")]) + `shouldSatisfy` any (T.isInfixOf "\ESC[1mCriterion.Main\ESC[0m,") + + it "colors the cross red" $ + reportErr (inplaceReport Colors [("A.hs", failure)]) + `shouldSatisfy` any (T.isInfixOf "[\ESC[31m✗\ESC[0m]") + + describe "breaking text to fit" $ do + it "keeps every line within the room given" $ + map T.length (wrapTo 20 (T.replicate 40 "word ")) `shouldSatisfy` all (<= 20) + + it "breaks at spaces and nowhere else" $ + wrapTo 12 "one two three four" `shouldBe` ["one two", "three four"] + + it "gives a word too long for the room a line of its own" $ + wrapTo 8 "a supercalifragilistic b" + `shouldBe` ["a", "supercalifragilistic", "b"] + + it "keeps a line break that was already there" $ + wrapTo 40 "first thing\nsecond thing" + `shouldBe` ["first thing", "second thing"] + + it "has nothing to say about nothing" $ + wrapTo 20 "" `shouldBe` [] + + it "measures what a reader will see, not what the text holds" $ do + visibleLength "abc" `shouldBe` 3 + visibleLength "\ESC[31mabc\ESC[0m" `shouldBe` 3 + visibleLength "\ESC[1m\ESC[36mab\ESC[0mc" `shouldBe` 3 + + it "breaks a colored line exactly where it breaks the bare one" $ do + let bare = "alpha beta gamma delta epsilon zeta eta theta" + lit = T.replace "gamma" "\ESC[36mgamma\ESC[0m" bare + map visibleLength (wrapTo 20 lit) `shouldBe` map T.length (wrapTo 20 bare) + + describe "how wide anything gets" $ do + let sprawling = + [ ("some/quite/deeply/nested/directory/Module.hs", decline), + ("another/quite/deeply/nested/one/Module.hs", failure) + ] + it "never prints a line wider than it allows itself" $ + map T.length (reportErr (inplaceReport Plain sprawling)) + `shouldSatisfy` all (<= lineWidth) + + it "does the same when the reason is enormous" $ + map T.length (reportErr (inplaceReport Plain [("A.hs", Failed (Unreadable "A.hs" (T.replicate 40 "and more words ")))])) + `shouldSatisfy` all (<= lineWidth) + + it "wraps what it says when it gives up, too" $ + map T.length (noted Plain ("✗", Bad) (T.replicate 40 "and more words ")) + `shouldSatisfy` all (<= lineWidth) + + describe "reading a file" $ do + it "reads it as UTF-8" $ + withBytes (T.encodeUtf8 "-- λ über ✓\n") $ \path -> + readAsUtf8 path `shouldReturn` Right "-- λ über ✓\n" + + it "reads it as UTF-8 whatever the machine's locale is" $ + withBytes (BS.pack [0xC3, 0xA9, 0x0A]) $ \path -> + readAsUtf8 path `shouldReturn` Right "é\n" + + it "says so when it is not UTF-8 at all" $ + withBytes (BS.pack [0x6D, 0xFF, 0xFE, 0x0A]) $ \path -> + readAsUtf8 path `shouldReturn` Left "it is not valid UTF-8" + + it "says so when it is not there" $ + withSystemTempDirectory "tilia-run" $ \directory -> + (isLeft <$> readAsUtf8 (directory "gone.hs")) + `shouldReturn` True + + it "hands over the line endings it found, rather than the platform's" $ + withBytes "module A where\r\n" $ \path -> + readAsUtf8 path `shouldReturn` Right "module A where\r\n" + + describe "what would be written back" $ do + it "is unchanged when the formatter gave back what was there" $ + differs (formattingOutcome "module A where\n" "module A where\n") + `shouldBe` False + + it "is unchanged when a file with Windows endings formats to itself" $ + differs (formattingOutcome "module A where\r\n" "module A where\n") + `shouldBe` False + + it "puts the file's own endings back on what it writes" $ + written (formattingOutcome "module A where\r\n" "module B where\n") + `shouldBe` Just "module B where\r\n" + + it "leaves a file that ends its lines with newlines alone" $ + written (formattingOutcome "module A where\n" "module B where\n") + `shouldBe` Just "module B where\n" + + it "takes the endings from the first line, over a file of many" $ + written (formattingOutcome "a\r\nb\r\nc\r\n" "a\nb\nd\n") + `shouldBe` Just "a\r\nb\r\nd\r\n" + + it "counts a file whose endings disagree as one that would change" $ + differs (formattingOutcome "a\r\nb\nc\r\n" "a\nb\nc\n") `shouldBe` True + + it "says as much in the diff, having nothing else to show" $ + T.unlines (reportOut (checkReport Plain [("A.hs", formattingOutcome "a\r\nb\nc\r\n" "a\nb\nc\n")])) + `shouldSatisfy` T.isInfixOf "differ only in how they end their lines" + + it "leaves a carriage return that is not a line ending where it is" $ + written (formattingOutcome "x = \"a\\\r b\"\r\n" "y = \"a\\\r b\"\n") + `shouldBe` Just "y = \"a\\\r b\"\r\n" + + describe "putting a file back" $ do + it "writes one that changed" $ + withSource "module A where\n" $ \path -> do + writeBack (path, Changed "module A where\n" "module B where\n") + T.readFile path `shouldReturn` "module B where\n" + + it "writes it as UTF-8, and as the bytes it was given" $ + withSource "module A where\n" $ \path -> do + writeBack (path, Changed "module A where\n" "-- ✓ über\r\n") + BS.readFile path `shouldReturn` T.encodeUtf8 "-- ✓ über\r\n" + + it "takes back exactly what it read, over a whole round trip" $ + withBytes (T.encodeUtf8 "-- ü\r\nmodule A where\r\n") $ \path -> do + Right asItIs <- readAsUtf8 path + writeBack (path, formattingOutcome asItIs "-- ü\nmodule B where\n") + BS.readFile path `shouldReturn` T.encodeUtf8 "-- ü\r\nmodule B where\r\n" + + it "leaves one that did not alone, down to its modification time" $ + untouched Unchanged + + it "leaves one it would not format alone" $ + untouched decline + + it "leaves one it could not format alone" $ + untouched failure + + describe "running over many files at once" $ do + it "answers in the order it was asked, not the order it finished" $ do + answers <- inParallel (\n -> threadDelay (1000 * (40 - n)) >> pure n) [1 .. 20 :: Int] + answers `shouldBe` [1 .. 20] + + it "runs every one of them exactly once" $ do + seen <- newIORef (0 :: Int) + _ <- inParallel (\_ -> atomicModifyIORef' seen (\n -> (n + 1, ()))) [1 .. 500 :: Int] + readIORef seen `shouldReturn` 500 + + it "copes with having nothing to do" $ + inParallel pure ([] :: [Int]) `shouldReturn` [] + + it "really does run them at once" $ do + capabilities <- getNumCapabilities + let rounds = ceiling (20 / fromIntegral capabilities :: Double) :: Int + started <- getMonotonicTime + _ <- inParallel (\_ -> threadDelay 100000) [1 .. 20 :: Int] + finished <- getMonotonicTime + (finished - started) `shouldSatisfy` (< fromIntegral rounds * 0.1 + 0.4) + +---------------------------------------------------------------------------- +-- Helpers + +unreadable, unclaimed :: FormatError +unreadable = Unreadable "A.hs" "gone" +unclaimed = NoPackage "B.hs" NoPackageFile + +-- | A file we would not touch, and two we could not. +decline, failure, otherFailure :: Outcome +decline = Declined (PositionPragmas "A.hs") +failure = Failed unreadable +otherFailure = Failed unclaimed + +-- | A file with the given contents, in a directory of its own. +withSource :: Text -> (FilePath -> IO a) -> IO a +withSource contents act = + withSystemTempDirectory "tilia-run" $ \directory -> do + let path = directory "A.hs" + T.writeFile path contents + act path + +-- | The same, for a file that has to hold exactly these bytes. +withBytes :: BS.ByteString -> (FilePath -> IO a) -> IO a +withBytes contents act = + withSystemTempDirectory "tilia-run" $ \directory -> do + let path = directory "A.hs" + BS.writeFile path contents + act path + +-- | What writing this outcome back would put in the file. +written :: Outcome -> Maybe Text +written = \case + Changed _ wouldBe -> Just wouldBe + _ -> Nothing + +-- | Writing this outcome back should do nothing whatsoever. +untouched :: Outcome -> Expectation +untouched outcome = + withSource "module A where\n" $ \path -> do + stamped <- getModificationTime path + threadDelay 10000 + writeBack (path, outcome) + stampedAgain <- getModificationTime path + stampedAgain `shouldBe` stamped + T.readFile path `shouldReturn` "module A where\n" + +-- | Is this the first line of an explanation rather than a continuation? +opensAReason :: Text -> Bool +opensAReason line = T.isPrefixOf " " line && not (T.isPrefixOf " " line) + +-- | A failure that names the file it is about, as the real ones do. +failureAbout :: FilePath -> Outcome +failureAbout path = Failed (Unreadable path "no such file") + +-- | A case about one operator whose fixity could not be settled. +about :: Text -> Outcome +about op = Declined (UnknownFixity "A.hs" [((Nothing, OpName op), Ambiguous)]) + +-- | A case about an operator whose fixity is in a module we could not read. +missing :: Text -> Outcome +missing modName = missingIn [modName] + +-- | The same, where more than one module could have declared it. +missingIn :: [Text] -> Outcome +missingIn = missingThrough . map (ModuleChain . (:| [])) + +-- | Two operators with the one answer between them, which is said once. +missingTwice :: Text -> Outcome +missingTwice = missingAll ["<|>", "<+>"] + +-- | Two operators with an answer each, so neither is a plurality. +twoAnswers :: Outcome +twoAnswers = + Declined + ( UnknownFixity + "A.hs" + [ ((Nothing, OpName "<|>"), NotRead (ModuleChain ("Criterion.Main" :| []) :| [])), + ((Nothing, OpName "<+>"), Ambiguous) + ] + ) + +-- | Any number of them, all with the one answer between them. +missingAll :: [Text] -> Text -> Outcome +missingAll ops modName = + Declined + ( UnknownFixity + "A.hs" + [((Nothing, OpName op), NotRead names) | op <- ops] + ) + where + names = ModuleChain (modName :| []) :| [] + +-- | The same again, where each import is given down to the module that +-- actually stopped the reading. +missingThrough :: [ModuleChain] -> Outcome +missingThrough chains = + Declined (UnknownFixity "A.hs" [((Nothing, OpName "<|>"), NotRead names)]) + where + names = case chains of + [] -> error "an operator has to be missing from somewhere" + c : cs -> c :| cs + +-- | A report as one piece of text, with the breaks it was wrapped at undone. +flattened :: Report -> Text +flattened = T.unwords . map T.strip . reportErr diff --git a/tests/Tilia/TargetSpec.hs b/tests/Tilia/TargetSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/TargetSpec.hs @@ -0,0 +1,307 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Working with cabal targets. +module Tilia.TargetSpec (spec) where + +import Data.List (isSuffixOf, sort) +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.IO qualified as T +import System.Directory (createDirectoryIfMissing) +import System.FilePath (takeFileName, ()) +import System.IO.Temp (withSystemTempDirectory) +import Test.Hspec +import Tilia.Project (Marker (..), ProjectRoot (..), findProjectRoot) +import Tilia.Target + +spec :: Spec +spec = do + describe "reading a target as it was written" $ do + it "takes all as everything" $ + parseTarget "all" `shouldBe` Right Everything + + it "takes a bare word as a name that may be either" $ + parseTarget "tilia" `shouldBe` Right (Called "tilia") + + it "takes each kind of component" $ do + parseTarget "lib:tilia" `shouldBe` Right (Qualified Nothing Lib "tilia") + parseTarget "exe:tilia" `shouldBe` Right (Qualified Nothing Exe "tilia") + parseTarget "test:tests" `shouldBe` Right (Qualified Nothing Test "tests") + parseTarget "bench:speed" `shouldBe` Right (Qualified Nothing Bench "speed") + + it "takes benchmark as a spelling of bench" $ + parseTarget "benchmark:speed" `shouldBe` Right (Qualified Nothing Bench "speed") + + it "takes a package in front of the kind" $ + parseTarget "tilia:lib:tilia" `shouldBe` Right (Qualified (Just "tilia") Lib "tilia") + + it "ignores space around it" $ + parseTarget " lib:tilia " `shouldBe` Right (Qualified Nothing Lib "tilia") + + it "refuses an empty target" $ + parseTarget "" `shouldSatisfy` failed + + it "refuses a kind it does not know" $ + parseTarget "flib:thing" `shouldSatisfy` failed + + it "refuses more colons than it can account for" $ + parseTarget "a:lib:b:c" `shouldSatisfy` failed + + it "says what it would have accepted" $ + case parseTarget "flib:thing" of + Left why -> why `shouldSatisfy` T.isInfixOf "lib:" + Right _ -> expectationFailure "should not have parsed" + + describe "against this very project" $ do + root <- runIO (findProjectRoot ".") + case root of + Nothing -> it "needs a project" $ pendingWith "no project above the working directory" + Just here -> do + it "is rooted at the cabal.project, not the .cabal file" $ + prMarker here `shouldBe` ProjectFile + + it "finds the three components this package declares" $ + componentsOfTarget here Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> + sort (map (\c -> (componentKind c, componentName c)) cs) + `shouldBe` sort [(Lib, "tilia"), (Exe, "tilia"), (Test, "tests")] + + it "narrows to one component when asked for one" $ + componentsOfTarget here (Qualified Nothing Lib "tilia") >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> map componentDirs cs `shouldBe` [["src"]] + + it "takes the package name as all of its components" $ + componentsOfTarget here (Called "tilia") >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> length cs `shouldBe` 3 + + it "refuses a target the project does not hold, and says what it does" $ + componentsOfTarget here (Called "nothing-like-this") >>= \case + Right cs -> expectationFailure ("matched " <> show (length cs) <> " components") + Left problem -> do + let said = describeTargetProblem problem + said `shouldSatisfy` T.isInfixOf "tilia:lib:tilia" + said `shouldSatisfy` T.isInfixOf "tilia:test:tests" + said `shouldSatisfy` T.isInfixOf "\n all" + + it "finds this module among the test component's files" $ + componentsOfTarget here (Qualified Nothing Test "tests") >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> do + files <- filesOfComponents cs + map takeFileName files `shouldSatisfy` elem "TargetSpec.hs" + + it "finds only Haskell in it" $ + componentsOfTarget here Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> do + files <- filesOfComponents cs + filter (not . haskell) files `shouldBe` [] + + it "does not wander into the build directory" $ + componentsOfTarget here Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> do + files <- filesOfComponents cs + filter (T.isInfixOf "dist-newstyle" . T.pack) files `shouldBe` [] + + describe "against a project made up for the purpose" $ do + it "reads the packages a cabal.project names" + $ withProject + [ ("cabal.project", "packages: one two\n"), + ("one/one.cabal", package "one" "src"), + ("one/src/A.hs", "module A where\n"), + ("two/two.cabal", package "two" "lib"), + ("two/lib/B.hs", "module B where\n") + ] + $ \root -> + componentsOfTarget root Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> sort (map componentPackage cs) `shouldBe` ["one", "two"] + + it "expands a glob in the packages field" + $ withProject + [ ("cabal.project", "packages: pkgs/*/*.cabal\n"), + ("pkgs/one/one.cabal", package "one" "src"), + ("pkgs/two/two.cabal", package "two" "src") + ] + $ \root -> + componentsOfTarget root Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> sort (map componentPackage cs) `shouldBe` ["one", "two"] + + it "passes over a package a comment has taken out" + $ withProject + [ ("cabal.project", "packages:\n one\n -- two\n"), + ("one/one.cabal", package "one" "src"), + ("two/two.cabal", package "two" "src") + ] + $ \root -> + componentsOfTarget root Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> map componentPackage cs `shouldBe` ["one"] + + it "reads a packages field continued onto later lines" + $ withProject + [ ("cabal.project", "packages:\n one\n two\n"), + ("one/one.cabal", package "one" "src"), + ("two/two.cabal", package "two" "src") + ] + $ \root -> + componentsOfTarget root Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> sort (map componentPackage cs) `shouldBe` ["one", "two"] + + it "reads one continued with tabs, as cabal itself does" + $ withProject + [ ("cabal.project", "packages:\n\tone\n\ttwo\n"), + ("one/one.cabal", package "one" "src"), + ("two/two.cabal", package "two" "src") + ] + $ \root -> + componentsOfTarget root Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> sort (map componentPackage cs) `shouldBe` ["one", "two"] + + it "finds one a conditional has put inside a section" + $ withProject + [ ("cabal.project", "if impl(ghc >= 9.4)\n packages: one\n"), + ("one/one.cabal", package "one" "src") + ] + $ \root -> + componentsOfTarget root Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> map componentPackage cs `shouldBe` ["one"] + + it "walks every source directory a component names" + $ withProject + [ ("only.cabal", packageWith "only" ["src", "gen"]), + ("src/A.hs", "module A where\n"), + ("gen/B.hs", "module B where\n") + ] + $ \root -> + componentsOfTarget root Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> do + files <- filesOfComponents cs + sort (map takeFileName files) `shouldBe` ["A.hs", "B.hs"] + + it "spells a path through a dot source directory without the dot" + $ withProject + [ ("only.cabal", packageWith "only" ["."]), + ("A.hs", "module A where\n"), + ("nested/B.hs", "module B where\n") + ] + $ \root -> + componentsOfTarget root Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> do + files <- filesOfComponents cs + filter (T.isInfixOf "/./" . T.pack) files `shouldBe` [] + + it "names a file once even when two components reach it" + $ withProject + [ ("both.cabal", twoComponents), + ("bench/Main.hs", "module Main where\n") + ] + $ \root -> + componentsOfTarget root Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> do + files <- filesOfComponents cs + length cs `shouldBe` 2 + map takeFileName files `shouldBe` ["Main.hs"] + + it "leaves hidden directories alone" + $ withProject + [ ("only.cabal", package "only" "src"), + ("src/A.hs", "module A where\n"), + ("src/.hidden/B.hs", "module B where\n") + ] + $ \root -> + componentsOfTarget root Everything >>= \case + Left problem -> expectationFailure (T.unpack (describeTargetProblem problem)) + Right cs -> do + files <- filesOfComponents cs + map takeFileName files `shouldBe` ["A.hs"] + + it "says so when a cabal.project names nothing that exists" $ + withProject [("cabal.project", "packages: nowhere\n")] $ \root -> + componentsOfTarget root Everything >>= \case + Right cs -> expectationFailure ("found " <> show (length cs) <> " components") + Left problem -> describeTargetProblem problem `shouldSatisfy` T.isInfixOf "no packages" + + it "says so when a .cabal file will not parse" + $ withProject + [ ("cabal.project", "packages: .\n"), + ("broken.cabal", "this is not a cabal file at all\n") + ] + $ \root -> + componentsOfTarget root Everything >>= \case + Right cs -> expectationFailure ("found " <> show (length cs) <> " components") + Left problem -> describeTargetProblem problem `shouldSatisfy` T.isInfixOf "does not parse" + +---------------------------------------------------------------------------- +-- Helpers + +failed :: Either Text Target -> Bool +failed = \case + Left _ -> True + Right _ -> False + +haskell :: FilePath -> Bool +haskell path = any (`isSuffixOf` path) [".hs", ".hs-boot", ".hsig"] + +-- | A @.cabal@ file for a package with one library. +package :: Text -> Text -> Text +package name dir = packageWith name [dir] + +packageWith :: Text -> [Text] -> Text +packageWith name dirs = + T.unlines + [ "cabal-version: 2.4", + "name: " <> name, + "version: 0.1.0.0", + "", + "library", + " hs-source-dirs: " <> T.intercalate ", " dirs, + " default-language: Haskell2010" + ] + +-- | Lay out a project in a temporary directory and hand over its root. +withProject :: [(FilePath, Text)] -> (ProjectRoot -> IO a) -> IO a +withProject files act = + withSystemTempDirectory "tilia-target" $ \directory -> do + mapM_ (place directory) files + act (ProjectRoot directory (marker files)) + where + place directory (path, contents) = do + createDirectoryIfMissing True (directory parent path) + T.writeFile (directory path) contents + parent = reverse . drop 1 . dropWhile (/= '/') . reverse + marker fs + | any ((== "cabal.project") . fst) fs = ProjectFile + | (named : _) <- [p | (p, _) <- fs, ".cabal" `isSuffixOf` p] = PackageFile named + | otherwise = ProjectFile + +-- | A package whose library sweeps the whole directory and whose benchmark +-- names a directory inside it, so that the two overlap. +twoComponents :: Text +twoComponents = + T.unlines + [ "cabal-version: 2.4", + "name: both", + "version: 0.1.0.0", + "", + "library", + " default-language: Haskell2010", + "", + "benchmark speed", + " type: exitcode-stdio-1.0", + " main-is: Main.hs", + " hs-source-dirs: bench", + " default-language: Haskell2010" + ] diff --git a/tests/Tilia/TestConfig.hs b/tests/Tilia/TestConfig.hs new file mode 100644 --- /dev/null +++ b/tests/Tilia/TestConfig.hs @@ -0,0 +1,192 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} + +-- | The settings every corpus example is formatted with. +module Tilia.TestConfig + ( exampleRenderConfig, + ) +where + +import Data.Choice (pattern Is) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text (Text) +import GHC.Hs (HsModule) +import GHC.Hs.Extension (GhcPs) +import GHC.LanguageExtensions.Type (Extension) +import Tilia.Fixity + ( Direction (..), + Fixities, + Fixity (..), + Known (..), + Namespace (..), + OpName (..), + Provenance (..), + Reach (..), + Scope (..), + inBothNamespaces, + nothingKnown, + operatorsUsed, + resolveScope, + ) +import Tilia.Fixity.Builtin (builtinFixities) +import Tilia.Pragma (effectiveExtensions) +import Tilia.Render (RenderConfig (..), defaultRenderConfig) + +-- | How to format one corpus example. +exampleRenderConfig :: + -- | What the package around it puts in force, if it is a module of one. + [Extension] -> + Text -> + HsModule GhcPs -> + RenderConfig +exampleRenderConfig package source hsModule = + defaultRenderConfig + { rcExtensions = + Set.fromList (effectiveExtensions package source), + rcScope = + Just + ( underEveryQualifier + (resolveScope (Is #implicitPrelude) known hsModule) + ) + } + where + known = nothingKnown {knownFixities = exportsOf} + underEveryQualifier scope = + scope + { scopeInTypes = alsoQualified (scopeInTypes scope), + scopeInTerms = alsoQualified (scopeInTerms scope) + } + alsoQualified reach = + reach + { reachQualified = + Map.union + (reachQualified reach) + ( Map.fromList + [ ((qualifier, op), (fixity, DeclaredIn qualifier)) + | (_, (Just qualifier, op)) <- operatorsUsed hsModule, + Just exported <- [exportsOf qualifier], + Just fixity <- [Map.lookup (InTerms, op) exported] + ] + ) + } + +-- | What a module in scope exports, as far as the corpus is concerned. +exportsOf :: Text -> Maybe Fixities +exportsOf name = Just (Map.union ours (inBothNamespaces elsewhere)) + where + ours = case Map.lookup name builtinFixities of + Just exact -> exact + Nothing -> everythingKnown + +-- | Every operator any boot module exports. +everythingKnown :: Fixities +everythingKnown = Map.unions (Map.elems builtinFixities) + +-- | Operators the examples use that no boot package exports. +-- +-- The same list Ormolu's test suite carries, for the same reason: these +-- turn up in the examples, their fixities are not discoverable from +-- anything to hand, and without them those examples are laid out as though +-- every one of these were @infixl 9@. +elsewhere :: Map OpName Fixity +elsewhere = + Map.fromList $ + concat + [ ormoluOverrides, + lens, + esqueleto, + servant, + hspec, + preludeInfix, + outsideBoot + ] + where + infixL p ops = [(OpName o, Fixity LeftAssoc p) | o <- ops] + infixR p ops = [(OpName o, Fixity RightAssoc p) | o <- ops] + infixN p ops = [(OpName o, Fixity NoAssoc p) | o <- ops] + + -- Five operators the corpus uses that belong to no package we can + -- consult, and whose fixities are therefore whatever the corpus was laid + -- out with. Two disagree with the library the spelling comes from—@.=@ + -- is @infix 4@ in lens and @#@ is @infixr 8@ there—but the expected + -- outputs settle it, since matching them is the only thing these are + -- for. + ormoluOverrides = + infixR 8 [".="] + <> infixR 5 ["#"] + -- Ormolu gives these 3, 3.3 and 3.7, which it can because its + -- precedences are fractional and ours are whole numbers. Only their + -- order relative to one another is ever exercised, and that is kept. + <> infixR 3 [">~<"] + <> infixR 4 ["|~|"] + <> infixR 5 ["<~>"] + + -- @lens@, and the packages that copy its spelling. + lens = + infixL 8 ["^.", "^..", "^?", "^?!", "^@.", "^@..", "^@?"] + <> infixR + 4 + [ ".~", + "%~", + "?~", + "+~", + "-~", + "*~", + "//~", + "^~", + "^^~", + "**~", + "||~", + "&&~", + "<>~", + "<.~", + " infixN 4 ["%=", "?=", "+=", "-=", "*=", "//=", "<>=", ".~=", "%%="] + <> infixR 9 ["<.", ".>", "<.>"] + + -- @esqueleto@, whose comparisons are the SQL ones with a dot on the end. + esqueleto = + infixL 9 ["?."] + <> infixN 4 ["==.", "!=.", ">=.", ">.", "<=.", "like", "%."] + <> infixR 3 ["&&."] + <> infixR 2 ["||."] + <> infixL 6 ["+.", "-."] + <> infixL 7 ["*.", "/."] + <> infixL 2 [":&"] + + -- @servant@'s way of spelling an API. + servant = infixR 4 [":>"] <> infixR 3 [":<|>"] + + -- @hspec@ writes its expectations infix, and they are meant to be the + -- loosest thing on the line. + hspec = + infixN + 1 + [ "shouldBe", + "shouldNotBe", + "shouldSatisfy", + "shouldNotSatisfy", + "shouldContain", + "shouldNotContain", + "shouldMatchList", + "shouldReturn", + "shouldNotReturn", + "shouldThrow", + "shouldStartWith", + "shouldEndWith" + ] + + -- Functions written infix often enough to be worth knowing the fixity + -- of, and which the list of module exports does not carry. + preludeInfix = infixR 0 ["seq"] <> infixL 0 ["on"] + + -- Loosest-binding operators from packages outside the boot libraries. + -- These decide layout rather than grouping: an @infixr 0@ is written at + -- the end of the line it breaks, the way @$@ is, and without the fixity + -- the examples come out with the operator at the start of the next one. + outsideBoot = infixR 0 ["deepseq", "?:"] diff --git a/tilia.cabal b/tilia.cabal new file mode 100644 --- /dev/null +++ b/tilia.cabal @@ -0,0 +1,254 @@ +cabal-version: 2.4 +name: tilia +version: 0.0.1.0 +license: BSD-3-Clause +license-file: LICENSE.md +maintainer: Mark Karpov +tested-with: + ghc ==9.10.3 + ghc ==9.12.4 + ghc ==9.14.1 + +homepage: https://github.com/mrkkrp/tilia +bug-reports: https://github.com/mrkkrp/tilia/issues +synopsis: A formatter for Haskell source code +description: A formatter for Haskell source code. +category: Development, Formatting +build-type: Simple +extra-source-files: + corpora/hackage/hackage.manifest + corpora/hackage/hackage.report + corpora/vendored/**/*.hs + +extra-doc-files: + CHANGELOG.md + README.md + +source-repository head + type: git + location: https://github.com/mrkkrp/tilia.git + +flag dev + description: Turn on development settings. + default: False + manual: True + +library + exposed-modules: + Tilia.Comments + Tilia.Comments.Attach + Tilia.Comments.Place + Tilia.Cpp + Tilia.Cpp.Macros + Tilia.Diff + Tilia.Doc + Tilia.Doc.Body + Tilia.Doc.Combinators + Tilia.Doc.Internal + Tilia.Equivalence + Tilia.Fixity + Tilia.Fixity.Builtin + Tilia.Fixity.ByHand + Tilia.Fixity.Cabal + Tilia.Fixity.Cache + Tilia.Fixity.Debug + Tilia.Fixity.Interface + Tilia.Fixity.PackageDb + Tilia.Fixity.Plan + Tilia.Format + Tilia.Imports + Tilia.Newline + Tilia.Package + Tilia.Palette + Tilia.Parser + Tilia.Pragma + Tilia.Process + Tilia.Project + Tilia.Render + Tilia.Render.Body + Tilia.Render.Class + Tilia.Render.Context + Tilia.Render.Data + Tilia.Render.Declaration + Tilia.Render.Expression + Tilia.Render.Haddock + Tilia.Render.Header + Tilia.Render.Layout + Tilia.Render.Literal + Tilia.Render.Name + Tilia.Render.Operator + Tilia.Render.Pattern + Tilia.Render.Pragma + Tilia.Render.Signature + Tilia.Render.Type + Tilia.Run + Tilia.Source + Tilia.Source.Lines + Tilia.Span + Tilia.Span.Ghc + Tilia.Target + Tilia.Utils + + hs-source-dirs: src + default-language: GHC2021 + build-depends: + Cabal-syntax >=3.12 && <3.17, + Diff >=0.4 && <2, + aeson >=2.1 && <3, + base >=4.14 && <5, + base16-bytestring >=1 && <2, + bytestring >=0.11 && <0.13, + choice >=0.2 && <0.3, + containers >=0.5 && <0.9, + cryptohash-sha256 >=0.11 && <0.12, + directory ^>=1.3, + filepath >=1.4 && <1.6, + ghc-lib-parser >=9.14 && <9.15, + process >=1.6 && <1.7, + syb >=0.7 && <0.8, + tar >=0.6 && <0.7, + text >=2.1 && <3, + transformers >=0.5 && <0.7, + zlib >=0.6 && <0.8, + + if flag(dev) + ghc-options: + -O2 + -Wall + -Werror + -Wredundant-constraints + -Wpartial-fields + -Wunused-packages + -haddock + -Winvalid-haddock + else + ghc-options: + -O2 + -Wall + +executable tilia + main-is: Main.hs + hs-source-dirs: app + other-modules: Paths_tilia + autogen-modules: Paths_tilia + default-language: GHC2021 + build-depends: + base >=4.14 && <5, + choice >=0.2 && <0.3, + directory ^>=1.3, + optparse-applicative >=0.14 && <0.20, + text >=2.1 && <3, + tilia, + + -- Twelve capabilities rather than -N, because formatting a project stops + -- getting faster well before a machine runs out of cores and every + -- capability past that point costs about 40 MiB and 0.15s of CPU while + -- formatting nothing. Over this project's 43 files: 1.88s at -N1, 575ms + -- at -N8, 518ms at -N12, 499ms at -N16, and back to 509ms at -N24. Asking + -- for -N here instead is the same wall time as -N12 give or take noise, + -- for 50% more CPU and 940 MiB against 520 MiB. Twelve is no worse on a + -- smaller machine either: pinned to four cores it lands within 3% of -N4. + -- + -- The nursery is the flag that pays for itself. At the default size the + -- same run takes 828ms rather than 522ms, which is what the extra 320 MiB + -- buys. + ghc-options: + -threaded + -rtsopts + "-with-rtsopts=-N12 -A32m" + + if flag(dev) + ghc-options: + -O2 + -Wall + -Werror + -Wredundant-constraints + -Wpartial-fields + -Wunused-packages + -haddock + -Winvalid-haddock + else + ghc-options: + -O2 + -Wall + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + build-tool-depends: hspec-discover:hspec-discover >=2 && <3 + hs-source-dirs: tests + other-modules: + Spec + Tilia.Comments.PlaceSpec + Tilia.CommentsSpec + Tilia.Corpus + Tilia.Corpus.Manifest + Tilia.CorpusSpec + Tilia.Cpp.MacrosSpec + Tilia.Cpp.PropertiesSpec + Tilia.CppSpec + Tilia.Doc.BodySpec + Tilia.Doc.CombinatorsSpec + Tilia.Doc.InternalSpec + Tilia.Doc.PropertiesSpec + Tilia.EquivalenceSpec + Tilia.Fixity.CabalSpec + Tilia.Fixity.CacheSpec + Tilia.Fixity.DebugSpec + Tilia.Fixity.DependenciesSpec + Tilia.Fixity.InterfaceSpec + Tilia.Fixity.PackageDbSpec + Tilia.Fixity.PlanSpec + Tilia.FixitySpec + Tilia.Gen + Tilia.NewlineSpec + Tilia.PackageSpec + Tilia.PragmaSpec + Tilia.ProcessSpec + Tilia.ProjectSpec + Tilia.Render.OperatorSpec + Tilia.RenderSpec + Tilia.RunSpec + Tilia.TargetSpec + Tilia.TestConfig + + default-language: GHC2021 + build-depends: + QuickCheck >=2.14 && <3, + base >=4.14 && <5, + base16-bytestring >=1 && <2, + bytestring >=0.11 && <0.13, + choice >=0.2 && <0.3, + containers >=0.5 && <0.9, + cryptohash-sha256 >=0.11 && <0.12, + directory ^>=1.3, + filepath >=1.4 && <1.6, + ghc-lib-parser >=9.14 && <9.15, + hspec >=2 && <3, + http-client >=0.7 && <0.8, + req >=3.13 && <4, + tar >=0.6 && <0.7, + temporary ^>=1.3, + text >=2.1 && <3, + tilia, + zlib >=0.6 && <0.8, + + ghc-options: + -threaded + -rtsopts + "-with-rtsopts=-M8G -N" + + if flag(dev) + ghc-options: + -O2 + -Wall + -Werror + -Wredundant-constraints + -Wpartial-fields + -Wunused-packages + -haddock + -Winvalid-haddock + else + ghc-options: + -O2 + -Wall