diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,67 @@ +## Tilia 0.1.1.0 + +* Keep code that every configuration prints alike out of the branches of a + conditional in many more cases rather than copying it into each of them. + [PR 229](https://github.com/mrkkrp/tilia/pull/229). +* Lay a construct holding a quasi-quotation written over several lines out + as if the quasi-quotation were written on one line, since its lines are + reproduced. It stays on the line of what comes before it, and what follows + its `|]` stays on the line of the `|]`, rather than going on lines of + their own. [Issue 208](https://github.com/mrkkrp/tilia/issues/208). +* A run whose build plan is up to date and whose cache is filled starts no + other program: where `cabal` keeps the sources it downloads is remembered, + the compiler's version is taken from the plan, and a plan that solving + left as it was is not solved again on every run after a `.cabal` file is + saved. [PR 236](https://github.com/mrkkrp/tilia/pull/236). +* The fixity a module declares for an operator it does not export is no + longer taken to be that operator's fixity in the modules importing it, + whether the module is read from its source or from its interface file. A + module that brings in an operator of the same name from elsewhere is no + longer declined over the two disagreeing. + [Issue 238](https://github.com/mrkkrp/tilia/issues/238). +* A record field whose first line is written in each branch of a + conditional, with a body the branches share after the `#endif`, comes out + as written, rather than as its name, a `=` on a line of its own and a + second conditional, which formatting again indented further. Where several + such fields follow one another, the body of the first is no longer copied + into each branch. [Issue 240](https://github.com/mrkkrp/tilia/issues/240). +* The `VERSION_` and `MIN_VERSION_` macros of a package the build plan does + not hold are taken to be undefined, as Cabal defines them only for the + dependencies of a component. A module is no longer declined over an + operator that only a branch behind `#ifdef VERSION_x` imports where the + plan has no `x`. [Issue 241](https://github.com/mrkkrp/tilia/issues/241). +* A pattern written over several lines keeps `<-` and the expression after + it on its last line where they were written there, in a pattern guard as + in a `do` block, and the closing bracket of a list or tuple pattern in a + pattern guard comes out under the opening one, rather than a step further + in, which only a layout block needs. + [Issue 210](https://github.com/mrkkrp/tilia/issues/210). +* The `of` of a `case` written on a line of its own after a conditional + comes out indented past the `case`, as written, rather than at the column + of the statement, where it began a new one and the module no longer + parsed. [Issue 237](https://github.com/mrkkrp/tilia/issues/237). +* `--check-ast` no longer reports a comment as lost where it carries on the + trailing comment of the last import and sorting moves that import, with + the comment, above another. + [Issue 252](https://github.com/mrkkrp/tilia/issues/252). +* A type or class imported with `(..)` from a module that exports it without + its members, such as `ParseError (..)` from `Text.Parsec`, is no longer + taken to bring in every operator that module exports. A module that brings + in an operator of the same name from elsewhere is no longer declined over + the two disagreeing. [Issue 253](https://github.com/mrkkrp/tilia/issues/253). +* A `case` whose head is written whole in each branch of a conditional comes + out as written, rather than with `case` once above the conditional and the + scrutinee at the column of the statement, where it began a new one and the + module no longer parsed. An `of` written after the `#endif` goes at the + end of each branch, and a comment written after `of` stays after it rather + than in front of it. [Issue 250](https://github.com/mrkkrp/tilia/issues/250). +* A `let` whose `in` ends its line, followed by another `let` on the next + line, is kept as one of a chain however many lines its bindings take. One + written in each branch of a conditional stays there as written, rather + than coming out with its `let` and `in` outside the conditional and, once + formatted again, as an `in let` on one line. + [Issue 251](https://github.com/mrkkrp/tilia/issues/251). + ## Tilia 0.1.0.0 ### Conditional compilation diff --git a/bench/Tilia/Bench/Fixity.hs b/bench/Tilia/Bench/Fixity.hs --- a/bench/Tilia/Bench/Fixity.hs +++ b/bench/Tilia/Bench/Fixity.hs @@ -17,7 +17,7 @@ import Data.ByteString.Base16 qualified as B16 import Data.Choice (pattern Do, pattern Don't) import Data.Either (rights) -import Data.Foldable (for_) +import Data.Foldable (find, for_) import Data.IORef (newIORef, readIORef, writeIORef) import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import Data.Text (Text) @@ -48,22 +48,51 @@ import Tilia.Fixity.Plan -- | The packages of the Hackage corpus whose every module is read. -resolved :: [String] +resolved :: [Text] resolved = - [ "lens-5.3.6", - "aeson-2.3.1.0", - "megaparsec-9.8.1", - "servant-0.20.3.0", - "conduit-1.3.6.1", - "vector-0.13.2.0", - "text-2.1.4", - "free-5.2", - "optics-0.4.2.1", - "semigroupoids-6.0.2", - "pandoc-types-1.23.1.2", - "mtl-2.3.2" + [ "lens", + "aeson", + "megaparsec", + "servant", + "conduit", + "vector", + "text", + "free", + "optics", + "semigroupoids", + "pandoc-types", + "mtl" ] +-- | The packages of the Hackage corpus the libraries of the resolved ones +-- depend on, which the plan holds with their tarballs. +heldDependencies :: [Text] +heldDependencies = + [ "QuickCheck", + "ansi-terminal", + "attoparsec", + "bifunctors", + "comonad", + "contravariant", + "dlist", + "exceptions", + "hashable", + "http-types", + "optparse-applicative", + "parser-combinators", + "profunctors", + "random", + "resourcet", + "scientific", + "stm", + "tasty", + "th-abstraction", + "time", + "transformers", + "unordered-containers", + "uuid-types" + ] + -- | The packages the compiler ships with whose every interface is decoded. decoded :: [Text] decoded = @@ -75,21 +104,36 @@ "text" ] --- | The packages the compiler ships with and the corpus does not hold, at --- the versions it ships, which the plan names so that the macros of their --- versions are defined. -shipped :: [(Text, Text)] -shipped = - [ ("array", "0.5.8.0"), +-- | The packages the corpus's packages depend on and it does not hold, at +-- the versions the compiler ships or versions those packages accept, which +-- the plan names so that the macros of their versions are defined. +-- +-- The plan is a fixed input rather than a model of a build: a regression +-- shows because every run reads the same branches of the same conditionals, +-- and how close the plan comes to one cabal would solve only changes which +-- branches those are, and so how the work is weighted. It need not follow +-- the base compiler or the corpus. +dependencies :: [(Text, Text)] +dependencies = + [ ("StateVar", "1.2.2"), + ("array", "0.5.8.0"), ("base", "4.20.2.0"), ("binary", "0.8.9.3"), ("bytestring", "0.12.2.0"), ("containers", "0.7"), ("deepseq", "1.5.0.0"), ("directory", "1.3.8.5"), + ("distributive", "0.6.3"), ("filepath", "1.5.4.0"), ("ghc-prim", "0.12.0"), + ("http-media", "0.8.1.1"), + ("indexed-traversable", "0.1.5"), + ("mono-traversable", "1.0.21.0"), + ("os-string", "2.0.7"), + ("primitive", "0.9.1.0"), ("process", "1.6.26.1"), + ("tagged", "0.8.11"), + ("tasty-inspection-testing", "0.2.1"), ("template-haskell", "2.22.0.0"), ("unix", "2.8.7.0") ] @@ -104,29 +148,51 @@ -- collections fall in the benchmarks that run after it, so this goes after -- the benchmarks of formatting. withFixityBenchmarks :: (([Benchmark], Text) -> IO a) -> IO (Either Text a) -withFixityBenchmarks use = do - pid <- getCurrentPid - let dir = printf "/tmp/tilia-bench-%010d" (fromIntegral pid :: Int) - bracket_ - (createDirectoryIfMissing True (dir "tarballs")) - (removePathForcibly dir) - (fixityBenchmarks dir >>= traverse use) +withFixityBenchmarks use = case releases of + Left problem -> pure (Left problem) + Right (toResolve, held) -> do + pid <- getCurrentPid + let dir = printf "/tmp/tilia-bench-%010d" (fromIntegral pid :: Int) + bracket_ + (createDirectoryIfMissing True (dir "tarballs")) + (removePathForcibly dir) + (fixityBenchmarks dir toResolve held >>= traverse use) + where + releases = + (,) + <$> traverse corpusRelease resolved + <*> traverse corpusRelease heldDependencies +-- | The release of a package the Hackage corpus holds. +corpusRelease :: Text -> Either Text String +corpusRelease name = + maybe (Left ("The Hackage corpus holds no " <> name <> ".")) Right $ + find ((== name) . ppName . planned) releases + where + releases = case corpusSource hackagePackages of + HackageReleases names -> names + _ -> [] + -- | The benchmarks of fixity resolution, set up in the directory given, and -- a digest of the interfaces they decode. -fixityBenchmarks :: FilePath -> IO (Either Text ([Benchmark], Text)) -fixityBenchmarks dir = do +fixityBenchmarks :: + -- | The directory to set them up in. + FilePath -> + -- | The releases whose every module is read. + [String] -> + -- | The releases the plan holds besides them. + [String] -> + IO (Either Text ([Benchmark], Text)) +fixityBenchmarks dir toResolve held = do corpus <- ( corpusName hackagePackages) <$> corpusCache - let releases = case corpusSource hackagePackages of - HackageReleases names -> names - _ -> [] + let releases = toResolve <> held tarballOf release = dir "tarballs" release <.> "tar.gz" tarballs = [(planned release, tarballOf release) | release <- releases] plan = BuildPlan { bpCompiler = "ghc-9.10.3", bpPackages = - [PlanPackage n v PreExisting [] | (n, v) <- shipped] + [PlanPackage n v PreExisting [] | (n, v) <- dependencies] <> fmap fst tarballs } fetched release = corpus release <.> "tar.gz" @@ -145,7 +211,7 @@ pure $ do answers <- traverse (askModule resolver) modules length <$> evaluate (force answers) - packages <- for resolved $ \release -> do + packages <- for toResolve $ \release -> do modules <- fromMaybe [] <$> packageModules (tarballOf release) filled <- newIORef False let recalling = do @@ -167,15 +233,18 @@ digestOf interfaces ) where - planned release = - let (name, version) = T.breakOnEnd "-" (T.pack release) - in PlanPackage (T.dropEnd 1 name) version PreExisting [] decoding files = do fresh <- evaluate (force [(m, BS.copy bytes) | (m, bytes) <- files]) pure $ length . rights <$> evaluate (force [fromHiFile m =<< decodeHiFile bytes | (m, bytes) <- fresh]) + +-- | A release of the Hackage corpus as a package of the plan. +planned :: String -> PlanPackage +planned release = + let (name, version) = T.breakOnEnd "-" (T.pack release) + in PlanPackage (T.dropEnd 1 name) version PreExisting [] -- | A cache of fixities in a directory. cacheUnder :: FilePath -> IO Cache diff --git a/bench/bench.record b/bench/bench.record --- a/bench/bench.record +++ b/bench/bench.record @@ -29,93 +29,93 @@ interfaces 1c28e35fa2432d89 # stage allocated instructions benchmark -check 305488704 625342633 Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs -check 414949976 860211242 ShellCheck-0.11.0/src/ShellCheck/Analytics.hs -check 266244704 469758919 aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs -check 200596704 518019905 blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs -check 64909672 129343878 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs -check 90215968 179673175 distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs -check 128706544 268524094 esqueleto-3.6.0.3/test/PostgreSQL/Test.hs -check 523131744 947995155 haxl-2.5.1.1/Haxl/Core/Monad.hs -check 221699688 460191261 idris-1.3.4/src/Idris/Elab/Term.hs -check 337906104 578770578 lifted-base-0.2.3.12/Control/Exception/Lifted.hs -check 61404488 129978443 megaparsec-9.8.1/Text/Megaparsec/Internal.hs -check 82146616 174226709 optparse-applicative-0.19.0.0/tests/test.hs -check 51737448 90786165 pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs -check 164869144 342530190 pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs -check 222989200 447577790 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs -check 178219144 361706711 purescript-0.15.15/src/Language/PureScript/Errors.hs -check 88773224 186246171 purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs -check 84087680 185592218 recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs -check 98129704 205010076 servant-server-0.20.3.0/src/Servant/Server/Internal.hs -check 103037600 205852438 swagger2-2.9.1/src/Data/Swagger/Internal.hs -check 104700064 193733706 text-2.1.4/tests/Tests/Properties/Folds.hs -check 62559504 129686156 time-1.16.0.1/test/main/Test/Format/ParseTime.hs -check 71026768 139004696 tls-2.4.3/Network/TLS/Extension.hs -check 341584848 787667598 unpacked-containers-0/src/Map/Internal.hs -check 448129968 861308134 vector-0.13.2.0/src/Data/Vector/Generic.hs -check 72654288 151625740 xmonad-0.18.1/src/XMonad/Operations.hs -decode 27001936 44723576 base-4.20.2.0 -decode 6037648 7373905 bytestring-0.12.2.0 -decode 9504912 12150537 containers-0.7 -decode 43420720 56428241 ghc-internal-9.1003.0 -decode 11465032 15574443 template-haskell-2.22.0.0 -decode 6206680 6722861 text-2.1.3 -format 585714216 1132097581 Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs -format 4268801648 8215706409 QuickCheck-2.18.0.0/src/Test/QuickCheck/Arbitrary.hs -format 903988776 1715848497 ShellCheck-0.11.0/src/ShellCheck/Analytics.hs -format 357145072 586914529 aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs -format 174816696 326120695 blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs -format 125166848 237762136 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs -format 181178648 342948784 distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs -format 313098528 589185783 esqueleto-3.6.0.3/test/PostgreSQL/Test.hs -format 3393194280 6954000450 haxl-2.5.1.1/Haxl/Core/Monad.hs -format 504082456 960666098 idris-1.3.4/src/Idris/Elab/Term.hs -format 1416130080 2802504216 lens-5.3.6/src/Control/Lens/Wrapped.hs -format 463051392 807326375 lifted-base-0.2.3.12/Control/Exception/Lifted.hs -format 114862912 219768412 megaparsec-9.8.1/Text/Megaparsec/Internal.hs -format 152090416 277909846 optparse-applicative-0.19.0.0/tests/test.hs -format 54641464 96646205 pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs -format 376993600 717475372 pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs -format 464955472 876728022 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs -format 374179808 706887086 purescript-0.15.15/src/Language/PureScript/Errors.hs -format 157522504 292522941 purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs -format 129205776 233199212 recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs -format 172818000 323062459 servant-server-0.20.3.0/src/Servant/Server/Internal.hs -format 174783648 327330430 swagger2-2.9.1/src/Data/Swagger/Internal.hs -format 716385648 1505690911 synthetic/comments -format 130290424 266483756 synthetic/conditionals -format 75942320 111837572 synthetic/imports -format 99529016 207055043 synthetic/nesting -format 838934048 1650403409 text-2.1.4/src/Data/Text/Internal/Fusion/CaseMapping.hs -format 251223896 409088661 text-2.1.4/tests/Tests/Properties/Folds.hs -format 138891552 257772182 time-1.16.0.1/test/main/Test/Format/ParseTime.hs -format 139419512 262626146 tls-2.4.3/Network/TLS/Extension.hs -format 1012155416 1980797816 unordered-containers-0.2.21/Data/HashMap/Internal.hs -format 507741568 947272176 unpacked-containers-0/src/Map/Internal.hs -format 551670016 1042468240 vector-0.13.2.0/src/Data/Vector/Generic.hs -format 139272304 260498387 xmonad-0.18.1/src/XMonad/Operations.hs -recall 8851176 20620493 aeson-2.3.1.0 -recall 5953760 14216861 conduit-1.3.6.1 -recall 5407168 12260501 free-5.2 -recall 14502904 42766044 lens-5.3.6 -recall 5564520 13033858 megaparsec-9.8.1 -recall 5891216 13516032 mtl-2.3.2 -recall 5062032 12025312 optics-0.4.2.1 -recall 5291120 12823256 pandoc-types-1.23.1.2 -recall 6078088 13974670 semigroupoids-6.0.2 -recall 6898696 15358696 servant-0.20.3.0 -recall 8956408 18332091 text-2.1.4 -recall 7805920 17845506 vector-0.13.2.0 -resolve 1934880160 3452012967 aeson-2.3.1.0 -resolve 542464296 969320825 conduit-1.3.6.1 -resolve 561754720 998716408 free-5.2 -resolve 3142664696 5507450217 lens-5.3.6 -resolve 235724304 461395455 megaparsec-9.8.1 -resolve 252811728 486168500 mtl-2.3.2 -resolve 84982856 215535259 optics-0.4.2.1 -resolve 97405360 228106463 pandoc-types-1.23.1.2 -resolve 237916832 461574873 semigroupoids-6.0.2 -resolve 248183728 503102068 servant-0.20.3.0 -resolve 1224151032 2166708926 text-2.1.4 -resolve 2505871344 4300748284 vector-0.13.2.0 +check 272354648 575981358 Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs +check 411823456 855523727 ShellCheck-0.11.0/src/ShellCheck/Analytics.hs +check 260526152 461063479 aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs +check 196550504 511610069 blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs +check 63623696 127394098 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs +check 84949968 171830970 distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs +check 127362696 266504214 esqueleto-3.6.0.3/test/PostgreSQL/Test.hs +check 506858784 923788756 haxl-2.5.1.1/Haxl/Core/Monad.hs +check 215891816 451467945 idris-1.3.4/src/Idris/Elab/Term.hs +check 333601000 572292120 lifted-base-0.2.3.12/Control/Exception/Lifted.hs +check 60171824 128139113 megaparsec-9.8.1/Text/Megaparsec/Internal.hs +check 81898560 173856514 optparse-applicative-0.19.0.0/tests/test.hs +check 51558504 90521497 pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs +check 160564576 336134147 pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs +check 217005264 438646778 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs +check 177263168 360271324 purescript-0.15.15/src/Language/PureScript/Errors.hs +check 86199456 182395610 purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs +check 76944368 174894002 recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs +check 90285488 193297667 servant-server-0.20.3.0/src/Servant/Server/Internal.hs +check 99785848 200988911 swagger2-2.9.1/src/Data/Swagger/Internal.hs +check 104406992 193276384 text-2.1.4/tests/Tests/Properties/Folds.hs +check 62082528 128971807 time-1.16.0.1/test/main/Test/Format/ParseTime.hs +check 69973984 137412179 tls-2.4.3/Network/TLS/Extension.hs +check 322427128 758963691 unpacked-containers-0/src/Map/Internal.hs +check 438419048 846475201 vector-0.13.2.0/src/Data/Vector/Generic.hs +check 70657680 148642078 xmonad-0.18.1/src/XMonad/Operations.hs +decode 25613816 43571594 base-4.20.2.0 +decode 5830408 7145065 bytestring-0.12.2.0 +decode 9126328 11777525 containers-0.7 +decode 42252744 55499725 ghc-internal-9.1003.0 +decode 11189560 15486875 template-haskell-2.22.0.0 +decode 6097120 6605095 text-2.1.3 +format 586993080 1135630753 Agda-2.8.0/src/full/Agda/Syntax/Translation/ConcreteToAbstract.hs +format 4059772616 8036874388 QuickCheck-2.18.0.0/src/Test/QuickCheck/Arbitrary.hs +format 907373856 1723990920 ShellCheck-0.11.0/src/ShellCheck/Analytics.hs +format 330306320 571456793 aeson-2.3.1.0/src/Data/Aeson/KeyMap.hs +format 174818320 326282752 blaze-html-0.9.2.0/src/Text/Blaze/Html5/Attributes.hs +format 125893136 239428886 brittany-0.14.0.2/source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs +format 181975648 344891996 distributed-process-0.7.8/src/Control/Distributed/Process/Node.hs +format 313302256 590497159 esqueleto-3.6.0.3/test/PostgreSQL/Test.hs +format 772624688 1542323569 haxl-2.5.1.1/Haxl/Core/Monad.hs +format 505622568 964281131 idris-1.3.4/src/Idris/Elab/Term.hs +format 1340529160 2711040392 lens-5.3.6/src/Control/Lens/Wrapped.hs +format 403478464 737112328 lifted-base-0.2.3.12/Control/Exception/Lifted.hs +format 115314000 221071613 megaparsec-9.8.1/Text/Megaparsec/Internal.hs +format 152138968 278467498 optparse-applicative-0.19.0.0/tests/test.hs +format 54506128 96618849 pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs +format 377550600 719032510 pandoc-3.10.2/src/Text/Pandoc/Readers/Markdown.hs +format 466875216 881659030 pandoc-3.10.2/src/Text/Pandoc/Writers/Powerpoint/Output.hs +format 374789216 709072870 purescript-0.15.15/src/Language/PureScript/Errors.hs +format 157590744 293012445 purescript-0.15.15/src/Language/PureScript/TypeChecker/Types.hs +format 129266384 233552107 recursion-schemes-5.2.3/src/Data/Functor/Foldable.hs +format 173044184 323789142 servant-server-0.20.3.0/src/Servant/Server/Internal.hs +format 174955608 327851739 swagger2-2.9.1/src/Data/Swagger/Internal.hs +format 716397560 1506784284 synthetic/comments +format 107750736 237375293 synthetic/conditionals +format 75942320 112110399 synthetic/imports +format 99934472 207607344 synthetic/nesting +format 838934536 1651811978 text-2.1.4/src/Data/Text/Internal/Fusion/CaseMapping.hs +format 223463632 390867496 text-2.1.4/tests/Tests/Properties/Folds.hs +format 139006432 258150558 time-1.16.0.1/test/main/Test/Format/ParseTime.hs +format 139530880 263037198 tls-2.4.3/Network/TLS/Extension.hs +format 1012732608 1984898669 unordered-containers-0.2.21/Data/HashMap/Internal.hs +format 509614800 951730877 unpacked-containers-0/src/Map/Internal.hs +format 551766528 1043391813 vector-0.13.2.0/src/Data/Vector/Generic.hs +format 139402192 260910396 xmonad-0.18.1/src/XMonad/Operations.hs +recall 5159192 11629716 aeson-2.3.1.0 +recall 2222736 5117209 conduit-1.3.6.1 +recall 1711296 3256971 free-5.2 +recall 11087912 34729465 lens-5.3.6 +recall 1794808 3797182 megaparsec-9.8.1 +recall 2130864 4316158 mtl-2.3.2 +recall 1290456 2773511 optics-0.4.2.1 +recall 1533048 3627916 pandoc-types-1.23.1.2 +recall 2303032 4716532 semigroupoids-6.0.2 +recall 3296464 6712375 servant-0.20.3.0 +recall 5195216 9137639 text-2.1.4 +recall 4064960 8696024 vector-0.13.2.0 +resolve 1871048824 3295554158 aeson-2.3.1.0 +resolve 444504256 757669620 conduit-1.3.6.1 +resolve 487648992 826960067 free-5.2 +resolve 3076558528 5353588555 lens-5.3.6 +resolve 216507192 378740037 megaparsec-9.8.1 +resolve 233565064 403415365 mtl-2.3.2 +resolve 65725248 132703282 optics-0.4.2.1 +resolve 78157216 145313962 pandoc-types-1.23.1.2 +resolve 138235048 248322418 semigroupoids-6.0.2 +resolve 219372680 404689330 servant-0.20.3.0 +resolve 1185759448 2051011736 text-2.1.4 +resolve 2471261160 4205683979 vector-0.13.2.0 diff --git a/corpora/hackage/hackage.manifest b/corpora/hackage/hackage.manifest --- a/corpora/hackage/hackage.manifest +++ b/corpora/hackage/hackage.manifest @@ -57,7 +57,7 @@ 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 712b081948e2 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Dot/Backend.hs -formatted c6bb09f6d106 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Dot/Base.hs +formatted fffa70657044 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 4f4d736f1b38 Agda-2.8.0/src/full/Agda/Interaction/Highlighting/FromAbstract.hs formatted 5731f6a6b8ee Agda-2.8.0/src/full/Agda/Interaction/Highlighting/Generate.hs @@ -230,7 +230,7 @@ formatted ae0893a4561e Agda-2.8.0/src/full/Agda/TypeChecking/LevelConstraints.hs formatted 07c423dfa0e3 Agda-2.8.0/src/full/Agda/TypeChecking/Lock.hs formatted 00b8f5e75aa7 Agda-2.8.0/src/full/Agda/TypeChecking/Lock.hs-boot -formatted 97862a8dea84 Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars.hs +formatted b1629098648f Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars.hs formatted 52101179c5b2 Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars.hs-boot formatted e1fc76d1f4fb Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars/Mention.hs formatted 9825c48e7a9c Agda-2.8.0/src/full/Agda/TypeChecking/MetaVars/Occurs.hs @@ -333,7 +333,7 @@ formatted 2fe7b7e43894 Agda-2.8.0/src/full/Agda/TypeChecking/Rules/Record.hs formatted 31facbc5e0fe 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 49e329be866f Agda-2.8.0/src/full/Agda/TypeChecking/Serialise.hs +formatted 1750e7e26332 Agda-2.8.0/src/full/Agda/TypeChecking/Serialise.hs formatted 3c2ae59cbddd 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 6c20bf188f6d Agda-2.8.0/src/full/Agda/TypeChecking/Serialise/Instances/Abstract.hs @@ -462,7 +462,7 @@ formatted 598740b3d57c QuickCheck-2.18.0.0/examples/Simple.hs partly-checked 9da7c6c96a36 QuickCheck-2.18.0.0/src/Test/QuickCheck.hs formatted 02ad02d885d3 QuickCheck-2.18.0.0/src/Test/QuickCheck/All.hs -partly-checked beeaa8cce68d QuickCheck-2.18.0.0/src/Test/QuickCheck/Arbitrary.hs +partly-checked 2c029612a111 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 24dc2fbcd085 QuickCheck-2.18.0.0/src/Test/QuickCheck/Features.hs @@ -586,7 +586,7 @@ formatted a2e378d49eb8 aeson-2.3.1.0/tests/PropertyRTFunctors.hs formatted d54279308532 aeson-2.3.1.0/tests/PropertyRoundTrip.hs formatted 5c1372b7a444 aeson-2.3.1.0/tests/PropertyTH.hs -formatted 816e57772780 aeson-2.3.1.0/tests/RFC8785.hs +formatted 5b4efaf27bc6 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 f000e9c51f1a aeson-2.3.1.0/tests/Regression/Issue571.hs @@ -735,7 +735,7 @@ formatted 09bf54b50d8a aws-0.25.3/Aws/S3/Commands/GetObject.hs formatted b2f36afa32e0 aws-0.25.3/Aws/S3/Commands/GetService.hs formatted d6ff6d8b8056 aws-0.25.3/Aws/S3/Commands/HeadObject.hs -formatted bc19177d1d47 aws-0.25.3/Aws/S3/Commands/Multipart.hs +formatted 342f7fc5f61d aws-0.25.3/Aws/S3/Commands/Multipart.hs formatted 311a84a6ddb3 aws-0.25.3/Aws/S3/Commands/PutBucket.hs formatted 2428bf962e66 aws-0.25.3/Aws/S3/Commands/PutBucketVersioning.hs formatted 046379db06b2 aws-0.25.3/Aws/S3/Commands/PutObject.hs @@ -785,10 +785,10 @@ formatted 5886bbdd46c9 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 b1dc0288cc34 base64-bytestring-1.2.1.0/Data/ByteString/Base64.hs +formatted 10172e7983b9 base64-bytestring-1.2.1.0/Data/ByteString/Base64.hs formatted 8d1de483b9c4 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 3a5cbd3642e2 base64-bytestring-1.2.1.0/Data/ByteString/Base64/URL.hs +formatted efdde917444c 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 @@ -1093,9 +1093,9 @@ 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 f91c2de89707 brittany-0.14.0.2/data/Test255.hs +formatted fc8afe1bc2d8 brittany-0.14.0.2/data/Test256.hs +formatted 4b1d0ac4424f 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 @@ -1569,7 +1569,7 @@ formatted bf88ceabad43 conduit-1.3.6.1/src/Data/Conduit.hs formatted 1a953cd53139 conduit-1.3.6.1/src/Data/Conduit/Combinators.hs formatted f520242138c3 conduit-1.3.6.1/src/Data/Conduit/Combinators/Stream.hs -formatted ba13516336bd conduit-1.3.6.1/src/Data/Conduit/Combinators/Unqualified.hs +formatted 7d754c7349cf conduit-1.3.6.1/src/Data/Conduit/Combinators/Unqualified.hs formatted 8e861a915c2f conduit-1.3.6.1/src/Data/Conduit/Internal.hs formatted c35f5a66accc conduit-1.3.6.1/src/Data/Conduit/Internal/Conduit.hs formatted bbfd28e5b98b conduit-1.3.6.1/src/Data/Conduit/Internal/Fusion.hs @@ -1611,7 +1611,7 @@ formatted 741778047cc1 criterion-1.6.5.0/examples/GoodReadFile.hs formatted e85b2e0c3354 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 fbcb8025853e criterion-1.6.5.0/examples/Overhead.hs formatted 3a50edf5477c criterion-1.6.5.0/examples/Quotes.hs formatted e88811d40513 criterion-1.6.5.0/tests/Cleanup.hs formatted 78253dc00e1a criterion-1.6.5.0/tests/Properties.hs @@ -1897,10 +1897,10 @@ formatted 7db3ef49d34f esqueleto-3.6.0.3/test/Common/Test.hs formatted 07d3054c5606 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 c62efabf2305 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 585ace4874f8 esqueleto-3.6.0.3/test/PostgreSQL/MigrateJSON.hs formatted b9c4d713d02f 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 @@ -1964,7 +1964,7 @@ 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 b21a6a7c7e2f 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 @@ -2188,6 +2188,41 @@ 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 3842f9681941 flatparse-0.5.6.1/bench/Attoparsec.hs +formatted b150292cdb35 flatparse-0.5.6.1/bench/Bench.hs +formatted 238be2e5d5b3 flatparse-0.5.6.1/bench/Common.hs +formatted 008c0e1a942c flatparse-0.5.6.1/bench/FPBasic.hs +formatted de5590d5ade3 flatparse-0.5.6.1/bench/FPStateful.hs +formatted 691876a14ba8 flatparse-0.5.6.1/bench/Megaparsec.hs +formatted 4e5c403e7a3b flatparse-0.5.6.1/bench/Parsec.hs +formatted 767291fb667b flatparse-0.5.6.1/bench/ReadInteger.hs +formatted 94b6d379ba91 flatparse-0.5.6.1/src/FlatParse/Basic.hs +formatted 162dda57b01e flatparse-0.5.6.1/src/FlatParse/Basic/Addr.hs +formatted e944703d9644 flatparse-0.5.6.1/src/FlatParse/Basic/Base.hs +formatted 2f38d187e067 flatparse-0.5.6.1/src/FlatParse/Basic/Bytes.hs +formatted a10fb5a46059 flatparse-0.5.6.1/src/FlatParse/Basic/Integers.hs +formatted 6a3463af4ece flatparse-0.5.6.1/src/FlatParse/Basic/Parser.hs +formatted 91f628bd7bbb flatparse-0.5.6.1/src/FlatParse/Basic/Switch.hs +formatted 402aaa49becf flatparse-0.5.6.1/src/FlatParse/Basic/Text.hs +formatted fbb54c111b6d flatparse-0.5.6.1/src/FlatParse/Common/Assorted.hs +formatted 3022f28f8121 flatparse-0.5.6.1/src/FlatParse/Common/GHCExts.hs +formatted c0055f39a562 flatparse-0.5.6.1/src/FlatParse/Common/Numbers.hs +formatted b9e95be8021e flatparse-0.5.6.1/src/FlatParse/Common/Parser.hs +formatted 1b42e699bc93 flatparse-0.5.6.1/src/FlatParse/Common/Position.hs +formatted 10cb24214eea flatparse-0.5.6.1/src/FlatParse/Common/Switch.hs +formatted 412fc97e8505 flatparse-0.5.6.1/src/FlatParse/Examples/BasicLambda/Lexer.hs +formatted 2c72cb96232c flatparse-0.5.6.1/src/FlatParse/Examples/BasicLambda/Parser.hs +formatted e5272a875046 flatparse-0.5.6.1/src/FlatParse/Minimal.hs +formatted 3f356742f6e5 flatparse-0.5.6.1/src/FlatParse/Minimal/Internal.hs +formatted 7ecd84a0c48e flatparse-0.5.6.1/src/FlatParse/Stateful.hs +formatted 122b007be519 flatparse-0.5.6.1/src/FlatParse/Stateful/Addr.hs +formatted bc3b9c3f288a flatparse-0.5.6.1/src/FlatParse/Stateful/Base.hs +formatted 944f11f97db1 flatparse-0.5.6.1/src/FlatParse/Stateful/Bytes.hs +formatted 68018af3f1d4 flatparse-0.5.6.1/src/FlatParse/Stateful/Integers.hs +formatted b48d8164beaa flatparse-0.5.6.1/src/FlatParse/Stateful/Parser.hs +formatted b1441b8d4e2e flatparse-0.5.6.1/src/FlatParse/Stateful/Switch.hs +formatted c4498f63da8b flatparse-0.5.6.1/src/FlatParse/Stateful/Text.hs +formatted 1a4004f0ef57 flatparse-0.5.6.1/test/Test.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 @@ -2331,7 +2366,7 @@ formatted 270cd401eb34 haxl-2.5.1.1/Haxl/Core/Fetch.hs formatted b4afaa8d717d haxl-2.5.1.1/Haxl/Core/Flags.hs formatted 6116af7c8eab haxl-2.5.1.1/Haxl/Core/Memo.hs -formatted 331b6d94ce03 haxl-2.5.1.1/Haxl/Core/Monad.hs +formatted 7f70ce88402f haxl-2.5.1.1/Haxl/Core/Monad.hs formatted 19ee0e1d26fe haxl-2.5.1.1/Haxl/Core/Parallel.hs formatted d03eb9460c3a haxl-2.5.1.1/Haxl/Core/Profile.hs formatted 015cb76495fb haxl-2.5.1.1/Haxl/Core/RequestStore.hs @@ -2490,7 +2525,7 @@ formatted aab2b0975534 hlint-3.10/src/Hint/Import.hs formatted 7fa5ea0b1e9a hlint-3.10/src/Hint/Lambda.hs formatted 272b8222175a hlint-3.10/src/Hint/List.hs -formatted 8f1d0c686e2b hlint-3.10/src/Hint/ListRec.hs +formatted 1601e1e0f2da hlint-3.10/src/Hint/ListRec.hs formatted 3027b7686bbd hlint-3.10/src/Hint/Match.hs formatted 7215f269ef89 hlint-3.10/src/Hint/Monad.hs formatted 4d078aac9ede hlint-3.10/src/Hint/Naming.hs @@ -2502,7 +2537,7 @@ formatted 5dd8e1ba7821 hlint-3.10/src/Hint/Restrict.hs formatted a55fbaad4a77 hlint-3.10/src/Hint/Smell.hs formatted 3308ee100b88 hlint-3.10/src/Hint/Type.hs -formatted a7c7f90eb40c hlint-3.10/src/Hint/Unsafe.hs +formatted c433ccccd5d9 hlint-3.10/src/Hint/Unsafe.hs formatted 48cd04ad2e02 hlint-3.10/src/HsColour.hs formatted dd9801a47942 hlint-3.10/src/Idea.hs formatted 576b754ba5d4 hlint-3.10/src/Language/Haskell/HLint.hs @@ -2529,7 +2564,7 @@ formatted f5ded9eab569 hspec-core-2.11.17/src/Test/Hspec/Core/Config.hs formatted b9ed2689f1a4 hspec-core-2.11.17/src/Test/Hspec/Core/Config/Definition.hs formatted 93914a41d318 hspec-core-2.11.17/src/Test/Hspec/Core/Config/Options.hs -formatted 38a2774bf309 hspec-core-2.11.17/src/Test/Hspec/Core/Example.hs +formatted 56fd96dcc2e6 hspec-core-2.11.17/src/Test/Hspec/Core/Example.hs formatted 78f6f2a2f383 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 @@ -2543,7 +2578,7 @@ 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 337da9e04e1d hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Internal.hs -formatted 463fbae99397 hspec-core-2.11.17/src/Test/Hspec/Core/Formatters/Pretty.hs +formatted 64062a11578e 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 @@ -2558,7 +2593,7 @@ formatted 559e8587e33c 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 486c3e882e3e hspec-core-2.11.17/src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs -formatted 800cbdaf0858 hspec-core-2.11.17/src/Test/Hspec/Core/Runner/Result.hs +formatted 451fa815b3f7 hspec-core-2.11.17/src/Test/Hspec/Core/Runner/Result.hs formatted d699e2b567f5 hspec-core-2.11.17/src/Test/Hspec/Core/Shuffle.hs formatted 929d1248e847 hspec-core-2.11.17/src/Test/Hspec/Core/Spec.hs formatted 0aaa70c4113f hspec-core-2.11.17/src/Test/Hspec/Core/Spec/Monad.hs @@ -2594,7 +2629,7 @@ formatted 7eadb8336461 hspec-core-2.11.17/test/Test/Hspec/Core/Runner/JobQueueSpec.hs formatted 0d283fd19887 hspec-core-2.11.17/test/Test/Hspec/Core/Runner/PrintSlowSpecItemsSpec.hs formatted 2781ae88628b hspec-core-2.11.17/test/Test/Hspec/Core/Runner/ResultSpec.hs -formatted 5c98171187e3 hspec-core-2.11.17/test/Test/Hspec/Core/RunnerSpec.hs +formatted b677cdaeef95 hspec-core-2.11.17/test/Test/Hspec/Core/RunnerSpec.hs formatted 711af46b8809 hspec-core-2.11.17/test/Test/Hspec/Core/ShuffleSpec.hs formatted 109f785c9f28 hspec-core-2.11.17/test/Test/Hspec/Core/SpecSpec.hs formatted ccd964421c9d hspec-core-2.11.17/test/Test/Hspec/Core/TimerSpec.hs @@ -2690,7 +2725,7 @@ formatted 3b956c85cb93 idris-1.3.4/src/Idris/Core/Elaborate.hs formatted d0216dc5a258 idris-1.3.4/src/Idris/Core/Evaluate.hs formatted 9e811f74925b idris-1.3.4/src/Idris/Core/Execute.hs -formatted 823bce2a23e1 idris-1.3.4/src/Idris/Core/ProofState.hs +formatted a0c632cd26d6 idris-1.3.4/src/Idris/Core/ProofState.hs formatted 0ccd6a932fe8 idris-1.3.4/src/Idris/Core/ProofTerm.hs formatted cd52f6495e8c idris-1.3.4/src/Idris/Core/TT.hs formatted d6069959015f idris-1.3.4/src/Idris/Core/Typecheck.hs @@ -2739,7 +2774,7 @@ formatted 05a01adec344 idris-1.3.4/src/Idris/Package.hs formatted 2a5fae85b8c9 idris-1.3.4/src/Idris/Package/Common.hs formatted 90885df148d3 idris-1.3.4/src/Idris/Package/Parser.hs -formatted ab0906fb24a3 idris-1.3.4/src/Idris/Parser.hs +formatted da68c807f135 idris-1.3.4/src/Idris/Parser.hs formatted e4d16cf46f6b idris-1.3.4/src/Idris/Parser/Data.hs formatted 56341a9cef2a idris-1.3.4/src/Idris/Parser/Expr.hs formatted de7138f89659 idris-1.3.4/src/Idris/Parser/Helpers.hs @@ -2768,8 +2803,8 @@ formatted 9df5a10ea1fd idris-1.3.4/test/TestData.hs formatted 720af8681b46 idris-1.3.4/test/TestRun.hs formatted e865ae48f11b intero-0.1.40/Setup.hs -formatted 41797b039ec2 intero-0.1.40/src/Completion.hs -formatted 808924ac99ff intero-0.1.40/src/GhciFind.hs +formatted 621065d3b05d intero-0.1.40/src/Completion.hs +formatted b0784cea4075 intero-0.1.40/src/GhciFind.hs partly-checked c0aea4c4237d intero-0.1.40/src/GhciInfo.hs formatted e0fd727cd7cd intero-0.1.40/src/GhciMonad.hs formatted 43c5576cb10f intero-0.1.40/src/GhciTags.hs @@ -2829,11 +2864,11 @@ formatted 36523e19eb43 leksah-0.16.2.2/src/IDE/Pane/WebKit/Output.hs formatted 6d01b337aa2d leksah-0.16.2.2/src/IDE/Pane/Workspace.hs formatted 9b92bdd95195 leksah-0.16.2.2/src/IDE/PaneGroups.hs -formatted 043a3ca4d21e leksah-0.16.2.2/src/IDE/Preferences.hs +formatted bc4a7202f565 leksah-0.16.2.2/src/IDE/Preferences.hs formatted b428f06dc6a8 leksah-0.16.2.2/src/IDE/Session.hs formatted 8fd5bd558558 leksah-0.16.2.2/src/IDE/SourceCandy.hs formatted 402da8621309 leksah-0.16.2.2/src/IDE/Statusbar.hs -formatted 188c4e9a0936 leksah-0.16.2.2/src/IDE/SymbolNavigation.hs +formatted 3df2a9c1d21f leksah-0.16.2.2/src/IDE/SymbolNavigation.hs formatted 265b135c829e leksah-0.16.2.2/src/IDE/TextEditor.hs formatted fc7e53f0e945 leksah-0.16.2.2/src/IDE/TextEditor/Class.hs formatted 1c4c5952013a leksah-0.16.2.2/src/IDE/TextEditor/CodeMirror.hs @@ -3082,7 +3117,7 @@ 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 e2b41d9d63a2 pandoc-3.10.2/src/Text/Pandoc/Class/IO.hs +formatted 9c00e6af7063 pandoc-3.10.2/src/Text/Pandoc/Class/IO.hs formatted 554e3fd3f722 pandoc-3.10.2/src/Text/Pandoc/Class/PandocIO.hs formatted c65acaaeb3de pandoc-3.10.2/src/Text/Pandoc/Class/PandocMonad.hs formatted af26c6ef7be1 pandoc-3.10.2/src/Text/Pandoc/Class/PandocPure.hs @@ -3478,7 +3513,7 @@ 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 148f97b27fd9 persistent-2.18.1.0/test/Database/Persist/TH/NoFieldSelectorsSpec.hs +formatted a12885a494b5 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 @@ -3510,13 +3545,13 @@ formatted 04688f64c4e1 postgrest-9.0.1/src/PostgREST/Auth.hs formatted 0abbe3feaa05 postgrest-9.0.1/src/PostgREST/CLI.hs formatted 1b3df3371712 postgrest-9.0.1/src/PostgREST/Config.hs -formatted 26e0ccfa04f8 postgrest-9.0.1/src/PostgREST/Config/Database.hs +formatted 9796d49489e0 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 6c2ca99e2760 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 738b5e18a7a6 postgrest-9.0.1/src/PostgREST/DbStructure.hs +formatted 9961291af0c6 postgrest-9.0.1/src/PostgREST/DbStructure.hs formatted a0f5c884d319 postgrest-9.0.1/src/PostgREST/DbStructure/Identifiers.hs formatted 29d8af69557a postgrest-9.0.1/src/PostgREST/DbStructure/Proc.hs formatted 8670bffe5d4a postgrest-9.0.1/src/PostgREST/DbStructure/Relationship.hs @@ -3527,7 +3562,7 @@ formatted 1dacd910468e postgrest-9.0.1/src/PostgREST/Middleware.hs formatted 17654b363841 postgrest-9.0.1/src/PostgREST/OpenAPI.hs formatted cdec9328f2d4 postgrest-9.0.1/src/PostgREST/Query/QueryBuilder.hs -formatted 9ac8d5c64df2 postgrest-9.0.1/src/PostgREST/Query/SqlFragment.hs +formatted 5f8a401dbb67 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 4cecd3055b78 postgrest-9.0.1/src/PostgREST/Request/ApiRequest.hs @@ -3539,7 +3574,7 @@ formatted 793800bb054f postgrest-9.0.1/src/PostgREST/Version.hs formatted 900b9c705574 postgrest-9.0.1/src/PostgREST/Workers.hs formatted c719f882d27c postgrest-9.0.1/test/doc/Main.hs -formatted 0aa4fe971d52 postgrest-9.0.1/test/spec/Feature/AndOrParamsSpec.hs +formatted 8293711c23f6 postgrest-9.0.1/test/spec/Feature/AndOrParamsSpec.hs formatted ff8246e7adcd postgrest-9.0.1/test/spec/Feature/AsymmetricJwtSpec.hs formatted bac4b7907402 postgrest-9.0.1/test/spec/Feature/AudienceJwtSecretSpec.hs formatted acbe9362314e postgrest-9.0.1/test/spec/Feature/AuthSpec.hs @@ -3548,12 +3583,12 @@ 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 42728b5ce4a4 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 2e6a9474e718 postgrest-9.0.1/test/spec/Feature/IgnorePrivOpenApiSpec.hs -formatted ea599ebfe99c postgrest-9.0.1/test/spec/Feature/InsertSpec.hs +formatted 6fef53a41695 postgrest-9.0.1/test/spec/Feature/InsertSpec.hs formatted 6f6ff9c35189 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 @@ -3563,13 +3598,13 @@ 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 343a60a46b7c postgrest-9.0.1/test/spec/Feature/QuerySpec.hs +formatted 05c3032a3ad6 postgrest-9.0.1/test/spec/Feature/QuerySpec.hs formatted 06632a6a8e0a 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 79c99d7ebcf6 postgrest-9.0.1/test/spec/Feature/RpcSpec.hs +formatted 88cbb7230a8c 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 @@ -4303,7 +4338,7 @@ formatted 8a25795f0c0a stack-9.9.9/src/Stack/Config.hs formatted db186c830bf3 stack-9.9.9/src/Stack/Constants.hs formatted 607b56eb6fc7 stack-9.9.9/src/Stack/Docker.hs -formatted 107229bac31d stack-9.9.9/src/Stack/Docker/GlobalDB.hs +formatted 07449f4ddba3 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 69a1b5e114c2 stack-9.9.9/src/Stack/Fetch.hs @@ -4454,12 +4489,12 @@ 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 92d24f16cf77 swagger2-2.9.1/test/Data/Swagger/CommonTestTypes.hs +formatted 9054cc190971 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 f1eacb0cba50 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 be895fbebcab 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 @@ -4539,14 +4574,14 @@ formatted 7580816061c0 text-2.1.4/src/Data/Text/Foreign.hs formatted d26ae280631c text-2.1.4/src/Data/Text/IO.hs formatted 8c24fec0de81 text-2.1.4/src/Data/Text/IO/Utf8.hs -formatted 653829dd073b text-2.1.4/src/Data/Text/Internal.hs +formatted abda1730fe53 text-2.1.4/src/Data/Text/Internal.hs formatted 48c631518261 text-2.1.4/src/Data/Text/Internal/ArrayUtils.hs formatted bc619fb754b4 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 b4bfb3453a3f text-2.1.4/src/Data/Text/Internal/Encoding.hs +formatted 4815054ed2f6 text-2.1.4/src/Data/Text/Internal/Encoding.hs formatted 43a1a670b3db text-2.1.4/src/Data/Text/Internal/Encoding/Fusion.hs formatted 88e5c54a218b 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 @@ -5093,16 +5128,16 @@ formatted f6f63b59cfb0 xmonad-0.18.1/tests/Properties/View.hs formatted cd8d73c03759 xmonad-0.18.1/tests/Properties/Workspace.hs formatted 4e65334f7f2a xmonad-0.18.1/tests/Utils.hs -formatted d8adcc5e8871 yesod-core-1.7.0.0/bench/widget.hs +formatted 0ddb1fa8af3e 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 d94322757109 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 96d18ec66a91 yesod-core-1.7.0.0/src/Yesod/Core/Class/Handler.hs -formatted 55ca7aed8601 yesod-core-1.7.0.0/src/Yesod/Core/Class/Yesod.hs +formatted 3b253a2dbaa1 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 bc567e14f9ae yesod-core-1.7.0.0/src/Yesod/Core/Dispatch.hs -formatted dad160e4138f yesod-core-1.7.0.0/src/Yesod/Core/Handler.hs +formatted 180c2fc8e3b6 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 b02eb40e75c3 yesod-core-1.7.0.0/src/Yesod/Core/Internal/Request.hs @@ -5136,11 +5171,11 @@ 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 929e2576fe48 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 ccb5ba6f357d 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 3a68d4c4db75 yesod-core-1.7.0.0/test/Route/InstanceProbeSpec.hs @@ -5149,98 +5184,98 @@ 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 2b6dc0f5b281 yesod-core-1.7.0.0/test/Route/RenderRouteSpec.hs +formatted 7c4edfc6aaf4 yesod-core-1.7.0.0/test/Route/RouteAttrSpec.hs formatted 9303c7a203b3 yesod-core-1.7.0.0/test/Route/SubDispatchAritySpec.hs -formatted f355aa443a8a yesod-core-1.7.0.0/test/RouteSpec.hs +formatted 9f64037d04f8 yesod-core-1.7.0.0/test/RouteSpec.hs formatted 186318ce7e7a 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 3b947e4eb93d yesod-core-1.7.0.0/test/YesodCoreTest/Auth.hs +formatted 6642299a9e79 yesod-core-1.7.0.0/test/YesodCoreTest/BangSeparatorRuntime.hs formatted e22fa3279a0b yesod-core-1.7.0.0/test/YesodCoreTest/Breadcrumb.hs -formatted 3380dd13fc46 yesod-core-1.7.0.0/test/YesodCoreTest/Cache.hs -formatted 01cab2974794 yesod-core-1.7.0.0/test/YesodCoreTest/CleanPath.hs +formatted d238709329bc yesod-core-1.7.0.0/test/YesodCoreTest/Cache.hs +formatted bc94d0ffbb1b yesod-core-1.7.0.0/test/YesodCoreTest/CleanPath.hs formatted 36a004c6a4e3 yesod-core-1.7.0.0/test/YesodCoreTest/Content.hs -formatted 25b4b6405959 yesod-core-1.7.0.0/test/YesodCoreTest/Csrf.hs -formatted b5d6ec2cfe62 yesod-core-1.7.0.0/test/YesodCoreTest/ErrorHandling.hs -formatted d369eb73b47a yesod-core-1.7.0.0/test/YesodCoreTest/ErrorHandling/CustomApp.hs -formatted 59bcbb168336 yesod-core-1.7.0.0/test/YesodCoreTest/Exceptions.hs -formatted 82e178e31f61 yesod-core-1.7.0.0/test/YesodCoreTest/FallthroughDispatch/Resources.hs +formatted c32367062763 yesod-core-1.7.0.0/test/YesodCoreTest/Csrf.hs +formatted 4cf415b23a2b yesod-core-1.7.0.0/test/YesodCoreTest/ErrorHandling.hs +formatted 34f03e725295 yesod-core-1.7.0.0/test/YesodCoreTest/ErrorHandling/CustomApp.hs +formatted 7bf251212b4a yesod-core-1.7.0.0/test/YesodCoreTest/Exceptions.hs +formatted a4440e79281d 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 948b8bdc1c2f 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 69eb694028b1 yesod-core-1.7.0.0/test/YesodCoreTest/Header.hs formatted 58f029383018 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 b9334b4bc3fb yesod-core-1.7.0.0/test/YesodCoreTest/JsAttributes.hs +formatted c0d239626dd9 yesod-core-1.7.0.0/test/YesodCoreTest/JsLoader.hs +formatted 21bf15831aa6 yesod-core-1.7.0.0/test/YesodCoreTest/JsLoaderSites/Bottom.hs +formatted d5d77fa729fa yesod-core-1.7.0.0/test/YesodCoreTest/Json.hs +formatted 2b74547d4334 yesod-core-1.7.0.0/test/YesodCoreTest/Links.hs formatted ab54e89c96fb yesod-core-1.7.0.0/test/YesodCoreTest/LiteApp.hs formatted 418e263ba672 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 b7985ba8cf16 yesod-core-1.7.0.0/test/YesodCoreTest/MediaData.hs +formatted 2e1b831d2b2d yesod-core-1.7.0.0/test/YesodCoreTest/Meta.hs +formatted 8bfcf819eb45 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 e8ef84185226 yesod-core-1.7.0.0/test/YesodCoreTest/NestedDispatch/Resources.hs formatted a5347308f9b0 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 14c0f6cfed84 yesod-core-1.7.0.0/test/YesodCoreTest/NoOverloadedStrings.hs +formatted 7624728d5d99 yesod-core-1.7.0.0/test/YesodCoreTest/NoOverloadedStringsSub.hs +formatted 982dc60b18aa 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 93933a8e4c0d 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 caf19758a717 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 179fb9bca0b8 yesod-core-1.7.0.0/test/YesodCoreTest/ParamSubsite/InstanceRuntime.hs formatted 3597a9c3f0b7 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 98d7865bd49f yesod-core-1.7.0.0/test/YesodCoreTest/ParamSubsite/SplitRuntime.hs +formatted eb2add72057d 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 fa83ece3173f yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/Compat.hs +formatted e39ccad26de5 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/PolyAny.hs +formatted 9fd56f7011c4 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/PolyShow.hs +formatted c9b7c8d2f647 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSite/SubRoute.hs +formatted 0295cf17281c 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 03a668e5cea8 yesod-core-1.7.0.0/test/YesodCoreTest/Redirect.hs +formatted 235413c6bdea yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubDispatch/Data.hs +formatted 611119a277d4 yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubDispatchRuntime.hs +formatted 5ce3614534ad yesod-core-1.7.0.0/test/YesodCoreTest/ParameterizedSubDispatchRuntime/Data.hs +formatted 30f807016614 yesod-core-1.7.0.0/test/YesodCoreTest/RawResponse.hs +formatted 4cc4d0ea318e 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 1db9d98dbf8c yesod-core-1.7.0.0/test/YesodCoreTest/Reps.hs -formatted e18610f848a2 yesod-core-1.7.0.0/test/YesodCoreTest/RequestBodySize.hs +formatted 18f4acb4f7f4 yesod-core-1.7.0.0/test/YesodCoreTest/Reps.hs +formatted 4f0780801c93 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 a03f5bc57962 yesod-core-1.7.0.0/test/YesodCoreTest/SplitSubsite/Data.hs formatted df70dd2651a7 yesod-core-1.7.0.0/test/YesodCoreTest/SplitSubsite/NestedR.hs -formatted a55ad04cebf6 yesod-core-1.7.0.0/test/YesodCoreTest/SplitSubsite/Runtime.hs +formatted 6b2e0c152d09 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 7b7f0025954e yesod-core-1.7.0.0/test/YesodCoreTest/SubSub.hs -formatted b9e29405eb1b yesod-core-1.7.0.0/test/YesodCoreTest/SubSubData.hs -formatted dbed829ecef5 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteFallthrough/Data.hs +formatted 1bb69ad8619d yesod-core-1.7.0.0/test/YesodCoreTest/StubLaxSameSite.hs +formatted 4d3bca26a6db yesod-core-1.7.0.0/test/YesodCoreTest/StubSslOnly.hs +formatted 71fb08d5eb96 yesod-core-1.7.0.0/test/YesodCoreTest/StubStrictSameSite.hs +formatted 7fea39a22dcb yesod-core-1.7.0.0/test/YesodCoreTest/StubUnsecured.hs +formatted 65fb43f7be25 yesod-core-1.7.0.0/test/YesodCoreTest/SubSub.hs +formatted 51df86ac759c yesod-core-1.7.0.0/test/YesodCoreTest/SubSubData.hs +formatted 7cd0e7170008 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteFallthrough/Data.hs formatted d10fd62ff3f7 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 ce40781b74ec yesod-core-1.7.0.0/test/YesodCoreTest/WaiSubsite.hs -formatted 67eac096b1a7 yesod-core-1.7.0.0/test/YesodCoreTest/Widget.hs +formatted 3b18d5d17513 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteFallthrough/Runtime.hs +formatted 440f7a2f5da2 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteOptsFallthrough/Data.hs +formatted 9726650eef04 yesod-core-1.7.0.0/test/YesodCoreTest/SubsiteOptsFallthrough/Runtime.hs +formatted f8c3fc7e4983 yesod-core-1.7.0.0/test/YesodCoreTest/WaiSubsite.hs +formatted f7823af32c7d 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 84b97f6c84a6 yesod-core-1.7.0.0/test/YesodCoreTest/ZeroPieceShadow/FallApp.hs +formatted 655445cfd3a8 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 --- a/corpora/hackage/hackage.report +++ b/corpora/hackage/hackage.report @@ -1,6 +1,6 @@ Hackage modules that currently do not format cleanly. -5240 examples, 5188 formatted. +5275 examples, 5223 formatted. ========================================================================== does-not-parse (1) diff --git a/corpora/vendored/declaration/value/comment-across-a-separator-out.hs b/corpora/vendored/declaration/value/comment-across-a-separator-out.hs --- a/corpora/vendored/declaration/value/comment-across-a-separator-out.hs +++ b/corpora/vendored/declaration/value/comment-across-a-separator-out.hs @@ -16,10 +16,11 @@ 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. +-- A token in the middle of a construct is another matter: a comment after +-- it stays after it, neither leaving the construct nor landing in front of +-- it. inTheMiddle n = - case n {- worth a look -} of + case n of {- worth a look -} 0 -> stop _ -> go n diff --git a/corpora/vendored/declaration/value/comment-across-a-separator.hs b/corpora/vendored/declaration/value/comment-across-a-separator.hs --- a/corpora/vendored/declaration/value/comment-across-a-separator.hs +++ b/corpora/vendored/declaration/value/comment-across-a-separator.hs @@ -13,8 +13,9 @@ 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. +-- A token in the middle of a construct is another matter: a comment after +-- it stays after it, neither leaving the construct nor landing in front of +-- it. inTheMiddle n = case n of {- worth a look -} 0 -> stop diff --git a/corpora/vendored/declaration/value/function/let-chain-out.hs b/corpora/vendored/declaration/value/function/let-chain-out.hs --- a/corpora/vendored/declaration/value/function/let-chain-out.hs +++ b/corpora/vendored/declaration/value/function/let-chain-out.hs @@ -14,3 +14,12 @@ -- Written all on one line, the chain stays on it. fire :: Int -> Int fire x = let a = x + 1 in let b = a * 2 in a + b + +-- A let whose bindings take several lines chains the same way where its in +-- ends the last of them. +cool :: Int -> Int +cool x = + let a = x + 1 + b = a * 2 in + let c = a + b + in c diff --git a/corpora/vendored/declaration/value/function/let-chain.hs b/corpora/vendored/declaration/value/function/let-chain.hs --- a/corpora/vendored/declaration/value/function/let-chain.hs +++ b/corpora/vendored/declaration/value/function/let-chain.hs @@ -14,3 +14,12 @@ -- Written all on one line, the chain stays on it. fire :: Int -> Int fire x = let a = x + 1 in let b = a * 2 in a + b + +-- A let whose bindings take several lines chains the same way where its in +-- ends the last of them. +cool :: Int -> Int +cool x = + let a = x + 1 + b = a * 2 in + let c = a + b in + c diff --git a/corpora/vendored/declaration/value/list-pattern-written-across-lines-in-a-guard-out.hs b/corpora/vendored/declaration/value/list-pattern-written-across-lines-in-a-guard-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/list-pattern-written-across-lines-in-a-guard-out.hs @@ -0,0 +1,23 @@ +primitives :: [Maybe Int] -> Int +primitives args = case () of + _ + | [ Just a, + Just b + ] <- args -> + a + b + | otherwise -> 0 + +hdlTemplate :: [Maybe Int] -> Int +hdlTemplate args + | [ Just a, + Just b + ] <- args = + a + b + | otherwise = 0 + +fromArguments :: IO [Maybe Int] -> IO Int +fromArguments getArgs = do + [ Just a, + Just b + ] <- getArgs + pure (a + b) diff --git a/corpora/vendored/declaration/value/list-pattern-written-across-lines-in-a-guard.hs b/corpora/vendored/declaration/value/list-pattern-written-across-lines-in-a-guard.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/list-pattern-written-across-lines-in-a-guard.hs @@ -0,0 +1,22 @@ +primitives :: [Maybe Int] -> Int +primitives args = case () of + _ + | [ Just a + , Just b + ] <- args + -> a + b + | otherwise -> 0 + +hdlTemplate :: [Maybe Int] -> Int +hdlTemplate args + | [ Just a + , Just b + ] <- args = a + b + | otherwise = 0 + +fromArguments :: IO [Maybe Int] -> IO Int +fromArguments getArgs = do + [ Just a + , Just b + ] <- getArgs + pure (a + b) diff --git a/corpora/vendored/declaration/value/quasi-quotation-written-across-lines-out.hs b/corpora/vendored/declaration/value/quasi-quotation-written-across-lines-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/quasi-quotation-written-across-lines-out.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE QuasiQuotes #-} + +exceptions :: [String] -> String +exceptions es = [i| + Encountered one or more exceptions. + |] <> concat es + +unexpected :: Int -> Maybe String +unexpected sp = Just (render sp [i| + Something went wrong. + |] Nothing) + +checked :: IO () +checked = withMessage [i| + Checking. + |] $ do + check + report + +check :: Int +check = 1 +{-# ANN check (Prim [Verilog, VHDL] [i| + BlackBox: + name: check + |]) #-} diff --git a/corpora/vendored/declaration/value/quasi-quotation-written-across-lines.hs b/corpora/vendored/declaration/value/quasi-quotation-written-across-lines.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/declaration/value/quasi-quotation-written-across-lines.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE QuasiQuotes #-} + +exceptions :: [String] -> String +exceptions es = [i| + Encountered one or more exceptions. + |] <> concat es + +unexpected :: Int -> Maybe String +unexpected sp = Just (render sp [i| + Something went wrong. + |] Nothing) + +checked :: IO () +checked = withMessage [i| + Checking. + |] $ do + check + report + +check :: Int +check = 1 +{-# ANN check (Prim [Verilog, VHDL] [i| + BlackBox: + name: check + |]) #-} diff --git a/corpora/vendored/other/cpp/bind-statement-begun-in-each-branch-out.hs b/corpora/vendored/other/cpp/bind-statement-begun-in-each-branch-out.hs --- a/corpora/vendored/other/cpp/bind-statement-begun-in-each-branch-out.hs +++ b/corpora/vendored/other/cpp/bind-statement-begun-in-each-branch-out.hs @@ -8,13 +8,11 @@ y <- g (h x) - a - b #else y <- k (h x) +#endif a b -#endif pure y diff --git a/corpora/vendored/other/cpp/branch-continuing-the-line-before-out.hs b/corpora/vendored/other/cpp/branch-continuing-the-line-before-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/branch-continuing-the-line-before-out.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Report.Flush (flush) where + +flush :: Bool -> IO () +flush verbose = +#if defined(TRACE) + when verbose $ + do + traceIO "flushing" + hFlush stdout +#else + when verbose $ + hFlush stdout +#endif diff --git a/corpora/vendored/other/cpp/branch-continuing-the-line-before.hs b/corpora/vendored/other/cpp/branch-continuing-the-line-before.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/branch-continuing-the-line-before.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE CPP #-} + +module Report.Flush (flush) where + +flush :: Bool -> IO () +flush verbose = when verbose $ +#if defined(TRACE) + do traceIO "flushing" +#endif + hFlush stdout diff --git a/corpora/vendored/other/cpp/case-head-in-each-branch-out.hs b/corpora/vendored/other/cpp/case-head-in-each-branch-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/case-head-in-each-branch-out.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE CPP #-} + +module Data.Aeson.BetterErrors.Internal (key, keyMay) where + +key :: Text -> Object -> Parse Value +key k obj = do +#if MIN_VERSION_aeson(2,0,0) + case KeyMap.lookup (Key.fromText k) obj of +#else + case HashMap.lookup k obj of +#endif + Just v -> pure v + Nothing -> missing k + +keyMay :: Text -> Maybe Object -> Parse (Maybe Value) +keyMay k value = case value of + Just obj -> +#if MIN_VERSION_aeson(2,0,0) + case KeyMap.lookup (Key.fromText k) obj of +#else + case HashMap.lookup k obj of +#endif + Just v -> pure (Just v) + Nothing -> pure Nothing + Nothing -> pure Nothing diff --git a/corpora/vendored/other/cpp/case-head-in-each-branch.hs b/corpora/vendored/other/cpp/case-head-in-each-branch.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/case-head-in-each-branch.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE CPP #-} + +module Data.Aeson.BetterErrors.Internal (key, keyMay) where + +key :: Text -> Object -> Parse Value +key k obj = do +#if MIN_VERSION_aeson(2,0,0) + case KeyMap.lookup (Key.fromText k) obj of +#else + case HashMap.lookup k obj of +#endif + Just v -> pure v + Nothing -> missing k + +keyMay :: Text -> Maybe Object -> Parse (Maybe Value) +keyMay k value = case value of + Just obj -> +#if MIN_VERSION_aeson(2,0,0) + case KeyMap.lookup (Key.fromText k) obj of +#else + case HashMap.lookup k obj of +#endif + Just v -> pure (Just v) + Nothing -> pure Nothing + Nothing -> pure Nothing diff --git a/corpora/vendored/other/cpp/case-of-after-a-conditional-out.hs b/corpora/vendored/other/cpp/case-of-after-a-conditional-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/case-of-after-a-conditional-out.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE CPP #-} + +module Lookup (check, find) where + +check :: IO () +check = do + case answer +#ifdef SECOND + second of +#else + first of +#endif + _ -> pure () + +find :: IO () +find = do + case lookupModule +#if __GLASGOW_HASKELL__ >= 900 + unitState +#else + flags +#endif + (moduleName "Polysemy") +#if __GLASGOW_HASKELL__ >= 904 + NoQualifier of +#else + Nothing of +#endif + Found _ -> pure () + _ -> fail "not found" diff --git a/corpora/vendored/other/cpp/case-of-after-a-conditional.hs b/corpora/vendored/other/cpp/case-of-after-a-conditional.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/case-of-after-a-conditional.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE CPP #-} + +module Lookup (check, find) where + +check :: IO () +check = do + case answer +#ifdef SECOND + second +#else + first +#endif + of + _ -> pure () + +find :: IO () +find = do + case lookupModule +#if __GLASGOW_HASKELL__ >= 900 + unitState +#else + flags +#endif + (moduleName "Polysemy") +#if __GLASGOW_HASKELL__ >= 904 + NoQualifier +#else + Nothing +#endif + of + Found _ -> pure () + _ -> fail "not found" diff --git a/corpora/vendored/other/cpp/code-finishing-what-each-branch-begins-out.hs b/corpora/vendored/other/cpp/code-finishing-what-each-branch-begins-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/code-finishing-what-each-branch-begins-out.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} + +-- What follows a conditional finishes the construct each of its branches +-- begins, and stays after the conditional rather than going into each +-- branch. +module Session.Store where + +import Control.Arrow ((>>>)) +import Control.Monad (forM_) + +-- Left-hand sides. +lookupKey :: Maybe (Int, Int) -> Int -> Int +#if MIN_VERSION_base(4,16,0) +lookupKey (Just (k, _)) d = +#else +lookupKey (Just (k, _)) _d = +#endif + k + 1 +lookupKey Nothing d = d + +-- Alternatives of a case. +expiry :: Maybe (Int, Int) -> Int +expiry m = case m of +#if MIN_VERSION_base(4,16,0) + Just (_, t) -> +#else + Just (t, _) -> +#endif + t * 60 + Nothing -> 0 + +-- Signatures. +#if MIN_VERSION_base(4,16,0) +store :: + (Show k, Ord k) => +#else +store :: + (Show k) => +#endif + k -> String +store = show + +-- Applications. +#if MIN_VERSION_base(4,16,0) +render k = + pad + 4 +#else +render k = + pad + 4 + ' ' +#endif + (show k) + +-- Blocks. +dump :: [Int] -> IO () +dump ks = do +#if MIN_VERSION_base(4,16,0) + forM_ ks $ \k -> do +#else + forM_ (reverse ks) $ \k -> do +#endif + print k + print (k * 2) + +-- The alternatives of a lambda case. +classify :: Int -> Int +#if MIN_VERSION_base(4,16,0) +classify = + negate >>> abs >>> \case +#else +classify = + abs >>> \case +#endif + 0 -> 1 + n -> n + +-- The qualifiers of a list comprehension. +names :: [(Int, String)] -> [String] +#if MIN_VERSION_base(4,16,0) +names xs = + [ show n ++ s +#else +names xs = + [ s +#endif + | (n, s) <- xs + ] diff --git a/corpora/vendored/other/cpp/code-finishing-what-each-branch-begins.hs b/corpora/vendored/other/cpp/code-finishing-what-each-branch-begins.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/code-finishing-what-each-branch-begins.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} + +-- What follows a conditional finishes the construct each of its branches +-- begins, and stays after the conditional rather than going into each +-- branch. +module Session.Store where + +import Control.Arrow ((>>>)) +import Control.Monad (forM_) + +-- Left-hand sides. +lookupKey :: Maybe (Int, Int) -> Int -> Int +#if MIN_VERSION_base(4,16,0) +lookupKey (Just (k, _)) d = +#else +lookupKey (Just (k, _)) _d = +#endif + k + 1 +lookupKey Nothing d = d + +-- Alternatives of a case. +expiry :: Maybe (Int, Int) -> Int +expiry m = case m of +#if MIN_VERSION_base(4,16,0) + Just (_, t) -> +#else + Just (t, _) -> +#endif + t * 60 + Nothing -> 0 + +-- Signatures. +#if MIN_VERSION_base(4,16,0) +store :: (Show k, Ord k) +#else +store :: Show k +#endif + => k -> String +store = show + +-- Applications. +#if MIN_VERSION_base(4,16,0) +render k = pad 4 +#else +render k = pad 4 ' ' +#endif + (show k) + +-- Blocks. +dump :: [Int] -> IO () +dump ks = do +#if MIN_VERSION_base(4,16,0) + forM_ ks $ \k -> do +#else + forM_ (reverse ks) $ \k -> do +#endif + print k + print (k * 2) + +-- The alternatives of a lambda case. +classify :: Int -> Int +#if MIN_VERSION_base(4,16,0) +classify = negate >>> abs >>> \ case +#else +classify = abs >>> \ case +#endif + 0 -> 1 + n -> n + +-- The qualifiers of a list comprehension. +names :: [(Int, String)] -> [String] +#if MIN_VERSION_base(4,16,0) +names xs = [ show n ++ s +#else +names xs = [ s +#endif + | (n, s) <- xs + ] diff --git a/corpora/vendored/other/cpp/comments-around-code-shared-after-a-conditional-out.hs b/corpora/vendored/other/cpp/comments-around-code-shared-after-a-conditional-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/comments-around-code-shared-after-a-conditional-out.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE CPP #-} + +module Config.Load where + +#if MIN_VERSION_base(4,16,0) +load (Just path) verbose = -- with a path +#else +load path verbose = -- without one +#endif + -- before the body + readConfig path verbose -- after the body +-- after the declaration + +retry r = +#if MIN_VERSION_base(4,16,0) + backoff + r -- end of the first branch +#else + backoff + r + 2 +#endif + -- before the argument + (limit r) -- trailing + -- under the argument diff --git a/corpora/vendored/other/cpp/comments-around-code-shared-after-a-conditional.hs b/corpora/vendored/other/cpp/comments-around-code-shared-after-a-conditional.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/comments-around-code-shared-after-a-conditional.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE CPP #-} + +module Config.Load where + +#if MIN_VERSION_base(4,16,0) +load (Just path) verbose = -- with a path +#else +load path verbose = -- without one +#endif + -- before the body + readConfig path verbose -- after the body +-- after the declaration + +retry r = +#if MIN_VERSION_base(4,16,0) + backoff r -- end of the first branch +#else + backoff r 2 +#endif + -- before the argument + (limit r) -- trailing + -- under the argument diff --git a/corpora/vendored/other/cpp/context-in-one-branch-out.hs b/corpora/vendored/other/cpp/context-in-one-branch-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/context-in-one-branch-out.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExplicitForAll #-} + +-- A context in one branch only, before a type written over several lines. +module Terminal.Trace where + +import GHC.Stack (HasCallStack) + +traceMessage :: +#ifdef WITH_CALLSTACK + (HasCallStack) => +#endif + String -> + [(String, Int)] -> + IO () +traceMessage message _pairs = putStrLn message + +traceLevel :: + forall a. +#ifdef WITH_CALLSTACK + (HasCallStack) => +#endif + (Show a) => + a -> + IO () +traceLevel = print diff --git a/corpora/vendored/other/cpp/context-in-one-branch.hs b/corpora/vendored/other/cpp/context-in-one-branch.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/context-in-one-branch.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExplicitForAll #-} + +-- A context in one branch only, before a type written over several lines. +module Terminal.Trace where + +import GHC.Stack (HasCallStack) + +traceMessage :: +#ifdef WITH_CALLSTACK + HasCallStack => +#endif + String -> + [(String, Int)] -> + IO () +traceMessage message _pairs = putStrLn message + +traceLevel :: + forall a. +#ifdef WITH_CALLSTACK + HasCallStack => +#endif + Show a => + a -> + IO () +traceLevel = print diff --git a/corpora/vendored/other/cpp/data-or-newtype-out.hs b/corpora/vendored/other/cpp/data-or-newtype-out.hs --- a/corpora/vendored/other/cpp/data-or-newtype-out.hs +++ b/corpora/vendored/other/cpp/data-or-newtype-out.hs @@ -9,12 +9,11 @@ data Cell = Cell { cellRef :: {-# UNPACK #-} !(IORef Char), cellCount :: {-# UNPACK #-} !Int - } #else newtype Cell = Cell { cellRef :: IORef Char - } #endif + } blank :: Char blank = ' ' diff --git a/corpora/vendored/other/cpp/guard-head-in-each-branch-out.hs b/corpora/vendored/other/cpp/guard-head-in-each-branch-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/guard-head-in-each-branch-out.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +module FlatParse.Common.Numbers (anyDigit, report) where + +anyDigit :: Word# -> Addr# -> Result +anyDigit acc s = case indexWord8OffAddr# s 0# of +#if MIN_VERSION_base(4,16,0) + w + | 1# <- leWord8# (wordToWord8# 0x30##) w, + 1# <- leWord8# w (wordToWord8# 0x39##) -> case timesWord2# acc 10## of +#else + w + | 1# <- leWord# 0x30## w, + 1# <- leWord# w 0x39## -> case timesWord2# acc 10## of +#endif + (# 0##, r #) -> OK r + _ -> Overflow + _ -> Fail + +report :: Handle -> Status -> IO () +report h status +#ifdef mingw32_HOST_OS + | isFailure status = do + hPutStrLn h "failed" +#else + | isFailure status, + colour = do + hPutStrLn h "\ESC[31mfailed\ESC[0m" +#endif + hFlush h + | otherwise = pure () diff --git a/corpora/vendored/other/cpp/guard-head-in-each-branch.hs b/corpora/vendored/other/cpp/guard-head-in-each-branch.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/guard-head-in-each-branch.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +module FlatParse.Common.Numbers (anyDigit, report) where + +anyDigit :: Word# -> Addr# -> Result +anyDigit acc s = case indexWord8OffAddr# s 0# of +#if MIN_VERSION_base(4,16,0) + w | 1# <- leWord8# (wordToWord8# 0x30##) w + , 1# <- leWord8# w (wordToWord8# 0x39##) + -> case timesWord2# acc 10## of +#else + w | 1# <- leWord# 0x30## w + , 1# <- leWord# w 0x39## + -> case timesWord2# acc 10## of +#endif + (# 0##, r #) -> OK r + _ -> Overflow + _ -> Fail + +report :: Handle -> Status -> IO () +report h status +#ifdef mingw32_HOST_OS + | isFailure status + = do + hPutStrLn h "failed" +#else + | isFailure status, colour + = do + hPutStrLn h "\ESC[31mfailed\ESC[0m" +#endif + hFlush h + | otherwise = pure () diff --git a/corpora/vendored/other/cpp/haddock-after-a-conditional-holding-a-class-head-out.hs b/corpora/vendored/other/cpp/haddock-after-a-conditional-holding-a-class-head-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/haddock-after-a-conditional-holding-a-class-head-out.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} + +module Test.Example where + +-- A method's Haddock and signature written once, after a conditional that +-- holds the head of the class in each branch. +class +#ifdef ENABLE_HOOK_ARGS + Example e where + type Arg e +#else + Example e where +#endif + + -- | Evaluates an example. + evaluate :: e -> IO Bool diff --git a/corpora/vendored/other/cpp/haddock-after-a-conditional-holding-a-class-head.hs b/corpora/vendored/other/cpp/haddock-after-a-conditional-holding-a-class-head.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/haddock-after-a-conditional-holding-a-class-head.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} + +module Test.Example where + +-- A method's Haddock and signature written once, after a conditional that +-- holds the head of the class in each branch. +#ifdef ENABLE_HOOK_ARGS +class Example e where + type Arg e +#else +class Example e where +#endif + -- | Evaluates an example. + evaluate :: e -> IO Bool diff --git a/corpora/vendored/other/cpp/let-chain-behind-a-conditional-out.hs b/corpora/vendored/other/cpp/let-chain-behind-a-conditional-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/let-chain-behind-a-conditional-out.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Kiln.Batch (batch) where + +-- The first let of a chain, written in each branch with in at the end of +-- its line, stays in each branch as written. +batch :: Int -> Int -> Int +batch x s = +#if defined(LARGE) + let a = large x in +#else + let a = small x in +#endif + let b = s + a + in scale b diff --git a/corpora/vendored/other/cpp/let-chain-behind-a-conditional.hs b/corpora/vendored/other/cpp/let-chain-behind-a-conditional.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/let-chain-behind-a-conditional.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Kiln.Batch (batch) where + +-- The first let of a chain, written in each branch with in at the end of +-- its line, stays in each branch as written. +batch :: Int -> Int -> Int +batch x s = +#if defined(LARGE) + let a = large x in +#else + let a = small x in +#endif + let b = s + a in + scale b diff --git a/corpora/vendored/other/cpp/list-items-behind-two-questions-out.hs b/corpora/vendored/other/cpp/list-items-behind-two-questions-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/list-items-behind-two-questions-out.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} + +module Laws.Mod (laws) where + +#ifdef MIN_VERSION_semirings +laws :: (Ring a) => Proxy a -> [Laws] +#else +laws :: Proxy a -> [Laws] +#endif +laws p = + [ eqLaws p +#ifdef MIN_VERSION_semirings + , ringLaws p +#endif +#ifdef MIN_VERSION_vector + , primLaws p +#endif + ] diff --git a/corpora/vendored/other/cpp/list-items-behind-two-questions.hs b/corpora/vendored/other/cpp/list-items-behind-two-questions.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/list-items-behind-two-questions.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} + +module Laws.Mod (laws) where + +#ifdef MIN_VERSION_semirings +laws :: (Ring a) => Proxy a -> [Laws] +#else +laws :: Proxy a -> [Laws] +#endif +laws p = + [ eqLaws p +#ifdef MIN_VERSION_semirings + , ringLaws p +#endif +#ifdef MIN_VERSION_vector + , primLaws p +#endif + ] diff --git a/corpora/vendored/other/cpp/method-moving-to-an-instance-of-its-own-out.hs b/corpora/vendored/other/cpp/method-moving-to-an-instance-of-its-own-out.hs --- a/corpora/vendored/other/cpp/method-moving-to-an-instance-of-its-own-out.hs +++ b/corpora/vendored/other/cpp/method-moving-to-an-instance-of-its-own-out.hs @@ -11,10 +11,8 @@ #if MIN_VERSION_base(4,11,0) instance Semigroup Summary where - Summary x1 x2 `mappend` Summary y1 y2 = Summary (x1 + y1) (x2 + y2) -#else - Summary x1 x2 `mappend` Summary y1 y2 = Summary (x1 + y1) (x2 + y2) #endif + Summary x1 x2 `mappend` Summary y1 y2 = Summary (x1 + y1) (x2 + y2) isSuccess :: Summary -> Bool isSuccess (Summary _ failures) = failures == 0 diff --git a/corpora/vendored/other/cpp/question-asked-again-inside-a-declaration-out.hs b/corpora/vendored/other/cpp/question-asked-again-inside-a-declaration-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/question-asked-again-inside-a-declaration-out.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} + +module Network.Client (connect) where + +#if MIN_VERSION_network(3,0,0) +connect :: Socket -> SockAddr -> Int -> IO Connection +connect sock addr timeout = do +#else +connect :: Socket -> SockAddr -> IO Connection +connect sock addr = do +#endif + handle <- socketToHandle sock ReadWriteMode + peer <- getPeerName sock +#if MIN_VERSION_network(3,0,0) + withTimeout timeout (open handle peer) +#else + open handle peer +#endif diff --git a/corpora/vendored/other/cpp/question-asked-again-inside-a-declaration.hs b/corpora/vendored/other/cpp/question-asked-again-inside-a-declaration.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/question-asked-again-inside-a-declaration.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} + +module Network.Client (connect) where + +#if MIN_VERSION_network(3,0,0) +connect :: Socket -> SockAddr -> Int -> IO Connection +connect sock addr timeout = do +#else +connect :: Socket -> SockAddr -> IO Connection +connect sock addr = do +#endif + handle <- socketToHandle sock ReadWriteMode + peer <- getPeerName sock +#if MIN_VERSION_network(3,0,0) + withTimeout timeout (open handle peer) +#else + open handle peer +#endif diff --git a/corpora/vendored/other/cpp/record-field-begun-in-each-branch-out.hs b/corpora/vendored/other/cpp/record-field-begun-in-each-branch-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/record-field-begun-in-each-branch-out.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE CPP #-} + +module Xeno.DOM (parse) where + +parse :: Process +parse = + Process + { +#if MIN_VERSION_bytestring(0,11,0) + openF = \(BS name_start name_len) -> do +#else + openF = \(PS _ name_start name_len) -> do +#endif + index <- readRef sizeRef + write index name_start name_len + } diff --git a/corpora/vendored/other/cpp/record-field-begun-in-each-branch.hs b/corpora/vendored/other/cpp/record-field-begun-in-each-branch.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/record-field-begun-in-each-branch.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} + +module Xeno.DOM (parse) where + +parse :: Process +parse = Process { +#if MIN_VERSION_bytestring(0,11,0) + openF = \(BS name_start name_len) -> do +#else + openF = \(PS _ name_start name_len) -> do +#endif + index <- readRef sizeRef + write index name_start name_len + } diff --git a/corpora/vendored/other/cpp/record-fields-begun-in-each-branch-out.hs b/corpora/vendored/other/cpp/record-fields-begun-in-each-branch-out.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/record-fields-begun-in-each-branch-out.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE CPP #-} + +module Xeno.DOM.Robust (parse) where + +parse :: Process +parse = + Process + { +#if MIN_VERSION_bytestring(0,11,0) + openF = \(BS name_start name_len) -> do +#else + openF = \(PS _ name_start name_len) -> do +#endif + index <- readRef sizeRef + write index name_start name_len, +#if MIN_VERSION_bytestring(0,11,0) + textF = \(BS text_start text_len) -> do +#else + textF = \(PS _ text_start text_len) -> do +#endif + write 0 text_start text_len, +#if MIN_VERSION_bytestring(0,11,0) + closeF = \closeTag@(BS _ _) -> do +#else + closeF = \closeTag@(PS s _ _) -> do +#endif + parent <- readRef parentRef +#if MIN_VERSION_bytestring(0,11,0) + let openTag = BS (plusForeignPtr offset0 parent) 0 +#else + let openTag = PS s (parent + offset0) 0 +#endif + pure (openTag == closeTag) + } diff --git a/corpora/vendored/other/cpp/record-fields-begun-in-each-branch.hs b/corpora/vendored/other/cpp/record-fields-begun-in-each-branch.hs new file mode 100644 --- /dev/null +++ b/corpora/vendored/other/cpp/record-fields-begun-in-each-branch.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE CPP #-} + +module Xeno.DOM.Robust (parse) where + +parse :: Process +parse = Process { +#if MIN_VERSION_bytestring(0,11,0) + openF = \(BS name_start name_len) -> do +#else + openF = \(PS _ name_start name_len) -> do +#endif + index <- readRef sizeRef + write index name_start name_len +#if MIN_VERSION_bytestring(0,11,0) + , textF = \(BS text_start text_len) -> do +#else + , textF = \(PS _ text_start text_len) -> do +#endif + write 0 text_start text_len +#if MIN_VERSION_bytestring(0,11,0) + , closeF = \closeTag@(BS _ _) -> do +#else + , closeF = \closeTag@(PS s _ _) -> do +#endif + parent <- readRef parentRef +#if MIN_VERSION_bytestring(0,11,0) + let openTag = BS (plusForeignPtr offset0 parent) 0 +#else + let openTag = PS s (parent + offset0) 0 +#endif + pure (openTag == closeTag) + } diff --git a/src/Tilia/Cabal/Package.hs b/src/Tilia/Cabal/Package.hs --- a/src/Tilia/Cabal/Package.hs +++ b/src/Tilia/Cabal/Package.hs @@ -23,6 +23,7 @@ ) where +import Control.Concurrent.MVar (modifyMVar, newMVar) import Data.ByteString qualified as BS import Data.Generics.Schemes (listify) import Data.IORef @@ -111,17 +112,20 @@ type PackageReader = FilePath -> IO (Either PackageProblem [Extension]) -- | A 'PackageReader' that remembers what it has already worked out. -newPackageReader :: IO PackageReader -newPackageReader = do +newPackageReader :: + -- | The compiler's version, where the build plan names it, which spares + -- asking the compiler. + Maybe Version -> + IO PackageReader +newPackageReader planned = do covering <- newIORef Map.empty described <- newIORef Map.empty - asked <- newIORef Nothing - let compiler = - readIORef asked >>= \case - Just version -> pure version - Nothing -> do - version <- compilerVersion - version <$ writeIORef asked (Just version) + known <- newMVar (Just <$> planned) + let compiler = modifyMVar known $ \case + Just version -> pure (Just version, version) + Nothing -> do + version <- compilerVersion + pure (Just version, version) pure $ \path -> quietly (Left NoPackageFile) $ do file <- canonicalizePath path from <- startingDirectory file diff --git a/src/Tilia/Cpp/Macros.hs b/src/Tilia/Cpp/Macros.hs --- a/src/Tilia/Cpp/Macros.hs +++ b/src/Tilia/Cpp/Macros.hs @@ -21,49 +21,62 @@ import Data.Text (Text) import Data.Text qualified as T --- | What is known about macros. +-- | What is known about macros, either from a build plan or implied by the +-- answers a configuration gives its conditionals. data Macros = Macros - { -- | The macros that take a version apart and compare it: - -- @MIN_VERSION_containers@ and the 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, - -- | The macros known to be defined, though not to what. + { -- | The versions from the build plan that @MIN_VERSION_@ macros compare + -- with, by macro name, for packages the plan holds at one version only, + -- and the compiler's version for @MIN_VERSION_GLASGOW_HASKELL@. + macroExactVersions :: Map Text [Integer], + -- | The numbers that @__GLASGOW_HASKELL__@ and its patch levels expand + -- to, from the build plan. + macroExactNumbers :: Map Text Integer, + -- | The macros known to be defined as implied by the answers that reach + -- a configuration. macroDefined :: Set Text, - -- | The macros known not to be defined, such as those of the compilers - -- other than the one the plan is for, like @__MHS__@. + -- | The macros known not to be defined: from the build plan, those of + -- the compilers other than the one it is for, like @__MHS__@, and + -- otherwise implied by the answers that reach a configuration. macroUndefined :: Set Text, - -- | The version, or number, each macro is known to reach, a number - -- being a version of one part. - macroAtLeast :: Map Text [Integer], - -- | The version, or number, each macro is known to stay below. - macroBelow :: Map Text [Integer] + -- | Every package the build plan holds, at however many versions, as + -- their version macros spell them: the @VERSION_@ and @MIN_VERSION_@ + -- macros of any other package are not defined. 'Nothing' without a + -- build plan. + macroPlannedPackages :: Maybe (Set Text), + -- | Implied by answers, the version, or number, each macro is known to + -- reach, a number being a version of one part. + macroLowerBounds :: Map Text [Integer], + -- | Implied by answers, the version, or number, each macro is known to + -- stay below. + macroUpperBounds :: Map Text [Integer] } deriving (Eq, Show) instance Semigroup Macros where a <> b = Macros - { macroVersions = macroVersions a <> macroVersions b, - macroNumbers = macroNumbers a <> macroNumbers b, + { macroExactVersions = macroExactVersions a <> macroExactVersions b, + macroExactNumbers = macroExactNumbers a <> macroExactNumbers b, macroDefined = macroDefined a <> macroDefined b, macroUndefined = macroUndefined a <> macroUndefined b, - macroAtLeast = Map.unionWith max (macroAtLeast a) (macroAtLeast b), - macroBelow = Map.unionWith min (macroBelow a) (macroBelow b) + macroPlannedPackages = + macroPlannedPackages a <|> macroPlannedPackages b, + macroLowerBounds = + Map.unionWith max (macroLowerBounds a) (macroLowerBounds b), + macroUpperBounds = + Map.unionWith min (macroUpperBounds a) (macroUpperBounds b) } instance Monoid Macros where mempty = Macros - { macroVersions = Map.empty, - macroNumbers = Map.empty, + { macroExactVersions = Map.empty, + macroExactNumbers = Map.empty, macroDefined = Set.empty, macroUndefined = Set.empty, - macroAtLeast = Map.empty, - macroBelow = Map.empty + macroPlannedPackages = Nothing, + macroLowerBounds = Map.empty, + macroUpperBounds = Map.empty } -- | Does a conditional's guard hold, where what is known settles it? @@ -83,26 +96,30 @@ | h -> mempty{macroDefined = Set.singleton n} | otherwise -> mempty{macroUndefined = Set.singleton n} Reaches n v - | h -> mempty{macroAtLeast = Map.singleton n (trimmed v)} - | otherwise -> mempty{macroBelow = Map.singleton n (trimmed v)} + | h -> mempty{macroLowerBounds = Map.singleton n (trimmed v)} + | otherwise -> mempty{macroUpperBounds = Map.singleton n (trimmed v)} Macro n | h -> mempty{macroDefined = Set.singleton n} _ -> mempty -- | Whether a macro is defined, where that is known. isDefined :: Macros -> Text -> Maybe Bool isDefined macros n - | Map.member n (macroVersions macros) - || Map.member n (macroNumbers macros) + | Map.member n (macroExactVersions macros) + || Map.member n (macroExactNumbers macros) || Set.member n (macroDefined macros) = Just True | Set.member n (macroUndefined macros) = Just False + | Just held <- macroPlannedPackages macros, + Just p <- T.stripPrefix "VERSION_" n <|> T.stripPrefix "MIN_VERSION_" n, + Set.notMember p held = + Just False | otherwise = Nothing -- | The number a macro stands for, where that is known. numberOf :: Macros -> Text -> Maybe Integer numberOf macros n = case isDefined macros n of Just False -> Just 0 - _ -> Map.lookup n (macroNumbers macros) + _ -> Map.lookup n (macroExactNumbers macros) -- | Does a macro's version, or number, reach this one, where what is known -- settles it? @@ -110,13 +127,13 @@ reaches macros n wanted = case held of Just v -> Just (trimmed v >= w) Nothing - | any (>= w) (Map.lookup n (macroAtLeast macros)) -> Just True - | any (<= w) (Map.lookup n (macroBelow macros)) -> Just False + | any (>= w) (Map.lookup n (macroLowerBounds macros)) -> Just True + | any (<= w) (Map.lookup n (macroUpperBounds macros)) -> Just False | otherwise -> Nothing where w = trimmed wanted held = - Map.lookup n (macroVersions macros) <|> (pure <$> numberOf macros n) + Map.lookup n (macroExactVersions macros) <|> (pure <$> numberOf macros n) -- | A version without the zeros at its end, which 'compare' orders as -- versions are ordered. diff --git a/src/Tilia/Cpp/Merge.hs b/src/Tilia/Cpp/Merge.hs --- a/src/Tilia/Cpp/Merge.hs +++ b/src/Tilia/Cpp/Merge.hs @@ -13,9 +13,12 @@ import Control.Monad (guard) import Data.Char (isSpace) import Data.Function (on) -import Data.List (groupBy, maximumBy, sortOn, stripPrefix, transpose, unsnoc) -import Data.Maybe (fromMaybe, listToMaybe, mapMaybe, maybeToList) +import Data.List (groupBy, maximumBy, minimumBy, sortOn, stripPrefix, transpose, unsnoc) +import Data.Maybe (fromMaybe, isJust, listToMaybe, mapMaybe, maybeToList) +import Data.Monoid (All (..), Any (..)) import Data.Ord (comparing) +import Data.Set (Set) +import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T import Tilia.Cpp.Directives (Guard (..), Varied (..), untouched) @@ -30,6 +33,7 @@ conditionalRange, foldChildren, layoutInside, + mapChildren, onlyBreaks, onlySpacing, printedFrom, @@ -40,14 +44,7 @@ wrap, ) import Tilia.Source (Lines, lineAt) -import Tilia.Span - ( Span, - covers, - meets, - spanEndLine, - spanStartColumn, - spanStartLine, - ) +import Tilia.Span (Span (..), covers, endOf, endPoint, meets, startOf, startPoint) -- | A conditional other than the one asked about that answering a question -- settles, for some answers at least. @@ -80,10 +77,12 @@ merge written conditionals guards varied settledOthers = go Broken where go _ [] = mempty - go layout ds@(d : rest) - | all (agree varied layout d) rest = d + go layout ds@(d : _) + | s : others <- spines, + all (agreeAll varied layout s) others = + d | Just xs <- traverse only spines = alongside layout xs - | otherwise = factored layout spines + | otherwise = factored middle layout spines where spines = fmap (spineAt layout) ds @@ -92,8 +91,9 @@ | Just wds <- traverse unwrap xs, Just w <- joint wds = case (w, go (layoutInside layout w) (fmap snd wds)) of - (WLocated _, DCppChoice{}) - | spans <- [s | (WLocated s, _) <- wds], + (WLocated _, merged) + | onlyChoice merged, + spans <- [s | (WLocated s, _) <- wds], Just opened <- unwrapping layout spans xs -> opened (WGroup l, DCppChoice{}) @@ -131,19 +131,24 @@ Just (w, x) -> wrap w <$> openedAgainst inside (layoutInside l w) x Nothing -> case spineAt l d of parts@(_ : _ : _) -> - Just . factored l $ + Just . factored middle l $ [if k == inside then parts else [e] | (k, e) <- zip [0 ..] xs] _ -> Nothing - factored layout ss = - let same = agree varied layout - shared = foldl1 (lcs anchoring same) ss - cut = fmap (segments (anchored same) shared) ss + factored within layout ss = + let same (x, _) (y, _) = agree varied layout x y + common as bs = + [ (x, is <> js) + | ((x, is), (_, js)) <- lcs (anchoring . fst) same as bs + ] + shared = foldl1 common [zip s (pure <$> [0 :: Int ..]) | s <- ss] + cut = + [cutAt [is !! k | (_, is) <- shared] s | (k, s) <- zip [0 ..] ss] stretches = transpose (fmap fst cut) anchors = transpose (fmap snd cut) - in mconcat (woven layout stretches (fmap (go layout) anchors)) + in mconcat (woven within layout stretches (fmap (go layout) anchors)) - woven layout (s : ss) (c : cs) + woven within layout (s : ss) (c : cs) | all (maybe False ((== DSpace) . snd) . unsnoc) s, Just r <- regionOf c, spanStartLine r == spanEndLine r, @@ -154,12 +159,13 @@ ws [(g, b <> gap <> c) | (g, b) <- bs] (e <> gap <> c) - : woven layout ss cs - | otherwise = stretch : c : woven layout ss cs + : woven within layout ss cs + | otherwise = stretch : c : woven within layout ss cs where - stretch = foldMap (varying layout) (cutAtConditionals s) - woven layout ss [] = fmap (foldMap (varying layout) . cutAtConditionals) ss - woven _ [] _ = [] + stretch = foldMap (varying within layout) (cutAtConditionals s) + woven within layout ss [] = + fmap (foldMap (varying within layout) . cutAtConditionals) ss + woven _ _ [] _ = [] -- A stretch the configurations disagree over, cut where one conditional -- asking the question ends and the next begins, so that each comes out @@ -194,13 +200,13 @@ | otherwise = sortOn fst (o : os) ascending os = and (zipWith (<=) os (drop 1 os)) - varying layout ss = + varying within 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 + <> within layout ss3 <> mconcat trail <> mconcat closing @@ -225,13 +231,39 @@ | all (alike layout s) rest = mconcat s | Just xs <- traverse only ss = go layout xs | Just (c, tails) <- commaLed layout ss = c <> middle layout tails - | Just merged <- alongsideHeads layout ss, - weigh layout merged < weigh layout apart = - merged - | otherwise = apart + | otherwise = + minimumBy + (comparing (weigh layout)) + (apart : maybeToList (alongsideHeads layout ss) <> byLines) where apart = choice (fmap (mconcat . commaFirst) ss) + byLines + | not (any continuing ss), + not (null (foldr1 Set.intersection (foldMap writtenAt <$> ss))), + (ls, cuts) <- unzip (fmap (linesOf layout) ss), + or cuts = + [factored whole layout ls] + | otherwise = [] + continuing = \case + x : xs + | printsNothing x -> continuing xs + | Just (_, y) <- unwrap x -> continuing (spine y <> xs) + | otherwise -> x == DSpace + [] -> False + whole _ [] = mempty + whole layout ss@(s : rest) + | all (alike layout s) rest = mconcat s + | Just splits <- traverse firstPart ss, + not (any (\(_, x, _) -> onOneLine layout x) splits) = + go layout [mconcat (spacing <> [x]) | (spacing, x, _) <- splits] + <> whole layout [more | (_, _, more) <- splits] + | otherwise = choice (fmap mconcat ss) + + firstPart parts = case break (not . blank) parts of + (spacing, x : more) -> Just (spacing, x, more) + _ -> Nothing + commaFirst = \case x : DBreak : rest | x == Doc.comma -> x : Doc.space : rest xs -> xs @@ -275,7 +307,7 @@ ( joined (glued (go layout heads)) (middle layout tails) - (varying layout tails) + (varying middle layout tails) ) _ -> Nothing where @@ -353,6 +385,9 @@ breaking = \case DDeclarationsStart -> True + DCat a b -> breaking a && breaking b + DNest _ d -> not (printsNothing d) && breaking d + DGroup _ d -> not (printsNothing d) && breaking d d -> onlyBreaks d choice ds @@ -386,34 +421,55 @@ -- | 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)) +agree varied layout a b + | lone a, lone b = agreeOn varied layout a b + | otherwise = agreeAll varied layout (spineAt layout a) (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 onlySpacing ds - in Left (spaceOf layout space) : case rest of - [] -> [] - x : more -> Right x : chunked more - inside x y = agree varied layout x y - here x y = case (x, y) of - (DLocated s x', DLocated t y') -> - s == t - && ( untouched varied (reach s x') && untouched varied (reach t y') - || inside x' y' - ) - (DCppChoice ws bs x', DCppChoice ws' cs y') -> - ws == ws' - && length bs == length cs - && and [g == h && inside p q | ((g, p), (h, q)) <- zip bs cs] - && inside x' y' - _ -> case (unwrap x, unwrap y) of - (Just (w, x'), Just (v, y')) -> - w == v && agree varied (layoutInside layout w) x' y' - _ -> x == y + lone = \case + DCat{} -> False + DVariant{} -> False + d -> not (onlySpacing d) +-- | Would these two spines print the same, laid out like this? +agreeAll :: Varied -> Layout -> [Doc] -> [Doc] -> Bool +agreeAll varied layout xs ys = + spaceOf layout space == spaceOf layout space' && case (rest, rest') of + ([], []) -> True + (x : more, y : more') -> + agreeOn varied layout x y && agreeAll varied layout more more' + _ -> False + where + (space, rest) = span onlySpacing xs + (space', rest') = span onlySpacing ys + +-- | Would these two elements of spines print the same, laid out like this? +agreeOn :: Varied -> Layout -> Doc -> Doc -> Bool +agreeOn varied layout x y = case (x, y) of + (DLocated s x', DLocated t y') -> + s == t + && ( untouched varied (reach s x') + && untouched varied (reach t y') + && startPoint s /= endPoint s + || inside x' y' + ) + (DCppChoice ws bs x', DCppChoice ws' cs y') -> + ws == ws' + && length bs == length cs + && and [g == h && inside p q | ((g, p), (h, q)) <- zip bs cs] + && inside x' y' + _ -> case (unwrap x, unwrap y) of + (Just (w, x'), Just (v, y')) -> + w == v && agree varied (layoutInside layout w) x' y' + _ -> x == y + where + inside = agree varied layout + +-- | Is this document one choice, in nothing but wrappers? +onlyChoice :: Doc -> Bool +onlyChoice = \case + DCppChoice{} -> True + d -> maybe False (onlyChoice . snd) (unwrap d) + -- | Does this document, laid out flat, print a choice before anything else? beginsWithChoice :: Doc -> Bool beginsWithChoice d = case filter (not . onlySpacing) (spineAt Flat d) of @@ -602,23 +658,18 @@ [Doc] -> [Doc] -> [Change] -changesAgainst varied same bs xs = go 0 bs xs (lcs anchoring same bs xs) +changesAgainst varied same bs xs = + go 0 0 bs xs (lcs held (same `on` snd) bs' xs') where - anchor = anchored same - - 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 + bs' = zip [0 ..] bs + xs' = zip [0 ..] xs + held = anchoring . snd - held j (Just b') (Just x') - | not (same b' x') = - [Change{chFrom = j, chTo = j + 1, chWith = [x'], chVaried = varied}] - held _ _ _ = [] + go i _ b x [] = between i b x + go i j b x (((p, _), (q, _)) : cs) = + let (b', b'') = splitAt (p - i) b + (x', x'') = splitAt (q - j) x + in between i b' x' <> go (p + 1) (q + 1) (drop 1 b'') (drop 1 x'') cs between i b x = [ Change @@ -705,6 +756,135 @@ (lineAt (spanStartLine s) written) Nothing -> False +-- | The lines a run of documents prints and the space between them, each in +-- the wrappers it is printed in, and whether that cuts an element of the +-- run. +linesOf :: Layout -> [Doc] -> ([Doc], Bool) +linesOf layout xs = (plain . mconcat <$> filter (not . null) ps, cut) + where + (ps, _, cut) = partsOf layout Within xs + +-- | Does this document print on one line, holding neither a line break nor +-- a choice? +onOneLine :: Layout -> Doc -> Bool +onOneLine layout = all single . spineAt layout + where + single x = case unwrap x of + Just (w, y) -> onOneLine (layoutInside layout w) y + Nothing -> case x of + DHardBreak -> False + DBreak -> layout == Flat + DSoftBreak -> layout == Flat + DVerbatimBreak{} -> False + DCppChoice{} -> False + _ -> True + +-- | A line less the wrappers that make no difference to it: a group around +-- what does not depend on the layout, and a region around regions and +-- nothing else, which say where the line was written already. +plain :: Doc -> Doc +plain = \case + DGroup _ d | layoutFree d -> plain d + DLocated _ d | onlyRegions d -> plain d + DFence _ d | onlyRegions d -> plain d + d -> mapChildren plain d + where + layoutFree = \case + DBreak -> False + DSoftBreak -> False + DVariant{} -> False + DCppChoice{} -> False + DGroup{} -> True + d -> getAll (foldChildren (All . layoutFree) d) + onlyRegions d = isJust (regionOf d) && not (bare d) + bare = \case + DLocated{} -> False + DFence{} -> False + DText t -> not (T.null t) + DHoldBack{} -> True + d -> getAny (foldChildren (Any . bare) d) + +-- | Where a part of a run of documents begins. +data Place + = -- | On a line, after what the line already holds. + Within + | -- | Between two lines. + Between + deriving (Eq) + +-- | The parts a run of documents is cut into: its lines and the space +-- between them, each in the wrappers it is printed in. +partsOf :: + -- | The layout the run is printed in. + Layout -> + -- | Where the run begins. + Place -> + -- | The run. + [Doc] -> + -- | The parts in order, the first of them what the run adds to the part + -- it begins in, empty where the run begins a part of its own; where the + -- run ends, which is where what follows it begins; and whether an element + -- of the run holds what is printed on more than one line, so that the cut + -- went through it. + ([[Doc]], Place, Bool) +partsOf layout = walk [[]] False + where + walk ls cut place = \case + [] -> (reverse ls, place, cut) + x : xs + | Just (w, y) <- unwrap x, + w /= WCppMarginNote, + w /= WAlign || place == Between, + let inside = layoutInside layout w, + (ps, place', cut') <- partsOf inside place (spineAt inside y), + length (filter (not . null) ps) > 1 -> + walk + (onto (if w == WAlign then ps else wrapped w ps) ls) + (cut || cut' || length (filter (not . all blank) ps) > 1) + place' + xs + | printsNothing x || x == DSpace -> walk (onto [[x]] ls) cut place xs + | opensWithBreak layout x, + place == Between -> + walk (onto [[x]] ls) cut place xs + | opensWithBreak layout x -> walk ([x] : ls) cut Between xs + | place == Within -> walk (onto [[x]] ls) cut place xs + | otherwise -> walk ([x] : ls) cut Within xs + onto ps ls = case (ps, ls) of + (p : rest, l : done) -> reverse rest <> ((l <> p) : done) + _ -> reverse ps <> ls + wrapped w = case w of + WLocated s -> marked DLocated s (startOf s) True + WFence s -> marked DFence s (startOf s) True + _ -> fmap (\p -> [wrap w (mconcat p) | not (null p)]) + marked region s from first = \case + [] -> [] + p : rest + | all blank p -> p : marked region s from first rest + | Just r <- regionOf d -> p : marked region s (endOf r) False rest + | otherwise -> [region s' d] : marked region s s' False rest + where + d = mconcat p + final = all (all blank) rest + s' + | first && final = s + | first = startOf s + | final = endOf s + | otherwise = from + +-- | Where the regions a document holds were written. +writtenAt :: Doc -> Set Span +writtenAt = \case + DLocated s d -> Set.insert s (writtenAt d) + DFence s d -> Set.insert s (writtenAt d) + d -> foldChildren writtenAt d + +-- | Does this document print nothing but space and what ends a line? +blank :: Doc -> Bool +blank = all spacing . spine + where + spacing x = onlySpacing x || maybe False (blank . snd) (unwrap x) + -- | Does the first thing this document puts on the page end a line? opensWithBreak :: Layout -> Doc -> Bool opensWithBreak layout d = case dropWhile (== DSpace) (spineAt layout d) of @@ -740,10 +920,12 @@ -- | The longest run of elements two spines have in common, in order, -- allowing for anything either of them has that the other does not, of --- those that could hold them together. -lcs :: (a -> Bool) -> (a -> a -> Bool) -> [a] -> [a] -> [a] +-- those that could hold them together, each with its counterpart. +lcs :: (a -> Bool) -> (a -> b -> Bool) -> [a] -> [b] -> [(a, b)] lcs holds same xs ys = - filter holds opening <> table middleX middleY <> filter holds closing + filter (holds . fst) (zip opening ys) + <> table middleX middleY + <> filter (holds . fst) closing where agreeing as bs = length (takeWhile id (zipWith same as bs)) @@ -751,8 +933,9 @@ (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 + (middleX, closingX) = splitAt (length xs1 - behind) xs1 + (middleY, closingY) = splitAt (length ys1 - behind) ys1 + closing = zip closingX closingY table [] _ = [] table _ [] = [] @@ -765,23 +948,19 @@ (n, acc) : case rest of [] -> [] ((y, (dn, ds), (an, as')) : more) - | holds x, same x y -> cells (dn + 1) (x : ds) more + | holds x, same x y -> cells (dn + 1) ((x, y) : ds) more | n >= an -> cells n acc more | otherwise -> cells an as' more --- | 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 DVerbatimBreak _ _ -> False DText "," -> False DDeclarationsStart -> False - DNest _ d -> located d || not (printsNothing d) + DNest _ d -> located d || not (blank d) DAlign d -> located d || not (printsNothing d) - DGroup _ d -> located d || not (printsNothing d) + DGroup _ d -> located d || not (blank d) d -> not (onlySpacing d) where located = \case @@ -793,27 +972,14 @@ DGroup _ d -> located d _ -> False --- | 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. --- --- The matched elements come back rather than being dropped because the --- caller cannot assume they are interchangeable: 'agree' does not look --- inside a region the conditional leaves alone. -segments :: - -- | Whether an element of the spine is the shared one being looked for. - (a -> a -> Bool) -> - -- | The shared elements, in order, to cut at. - [a] -> - -- | The spine to cut. - [a] -> - -- | The stretches between the cuts, and the elements cut at. - ([[a]], [a]) -segments same = go +-- | A spine cut at the given positions: one stretch before each of them, +-- and one after the last. +cutAt :: [Int] -> [a] -> ([[a]], [a]) +cutAt = go 0 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) + go _ [] s = ([s], []) + go i (p : ps) s = case splitAt (p - i) s of + (before, x : after) -> + let (stretches, xs) = go (p + 1) ps after + in (before : stretches, x : xs) + (before, []) -> ([before], []) diff --git a/src/Tilia/Doc/Combinators.hs b/src/Tilia/Doc/Combinators.hs --- a/src/Tilia/Doc/Combinators.hs +++ b/src/Tilia/Doc/Combinators.hs @@ -23,7 +23,6 @@ -- * Layout Layout (..), - group, flat, broken, variant, @@ -81,7 +80,6 @@ Layout (..), LineStart (..), TrailingWhitespace (..), - groupLayout, mapChildren, printsNothing, ) @@ -103,7 +101,7 @@ 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 +-- 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 @@ -153,11 +151,6 @@ ---------------------------------------------------------------------------- -- 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 @@ -166,7 +159,7 @@ broken :: Doc -> Doc broken = DGroup Broken --- | Choose according to the layout the enclosing 'group' settled on. +-- | 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. diff --git a/src/Tilia/Doc/Internal.hs b/src/Tilia/Doc/Internal.hs --- a/src/Tilia/Doc/Internal.hs +++ b/src/Tilia/Doc/Internal.hs @@ -23,7 +23,6 @@ Layout (..), LineStart (..), TrailingWhitespace (..), - groupLayout, -- * Rendering RenderOptions (..), @@ -37,7 +36,7 @@ import Data.Maybe (listToMaybe, mapMaybe) import Data.Text (Text) import Data.Text qualified as T -import Tilia.Span (Span, isSingleLine, spanEndLine, spanStartLine) +import Tilia.Span (Span, spanEndLine, spanStartLine) ---------------------------------------------------------------------------- -- Documents @@ -292,14 +291,6 @@ | -- | Keep it. KeepWhitespace deriving (Eq, Show) - --- | Decide how to lay a group out. -groupLayout :: Maybe Span -> Layout -groupLayout = \case - Nothing -> Flat - Just s - | isSingleLine s -> Flat - | otherwise -> Broken ---------------------------------------------------------------------------- -- Rendering diff --git a/src/Tilia/Equivalence.hs b/src/Tilia/Equivalence.hs --- a/src/Tilia/Equivalence.hs +++ b/src/Tilia/Equivalence.hs @@ -21,7 +21,7 @@ import Data.Choice (pattern Is) import Data.Data import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) -import Data.List (sortOn) +import Data.List (sortOn, unsnoc) import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map) @@ -61,6 +61,7 @@ ( Comment (..), Pragma (..), asOrdinary, + carriedOnFrom, commentPragma, commentTrailing, triggerEscaped, @@ -466,13 +467,13 @@ asRead m = concatMap (asOrdinary (sourceLines (pmSource m))) (comments (pmSource m)) - belowHeader m = filter (not . inHeader m) . ordinary - withinHeader m = filter (inHeader m) . ordinary + belowHeader m cs = filter (not . inHeader m cs) (ordinary cs) + withinHeader m cs = filter (inHeader m cs) (ordinary cs) settled = sortOn bodyKey - inHeader m c = case lastRearrangedLine m of - Nothing -> False - Just lastLine -> spanStartLine (commentSpan c) <= lastLine + inHeader m cs = case lastRearrangedLine m cs of + Nothing -> const False + Just lastLine -> (<= lastLine) . spanStartLine . commentSpan lost = pragmasOf before `Set.difference` pragmasOf after gained = pragmasOf after `Set.difference` pragmasOf before @@ -523,16 +524,32 @@ ls -> ls -- | The last line the formatter may reorder: the end of the last import, or --- of the module header where there are no imports. +-- of the module header where there are no imports, and of the comments +-- under it that carry on a remark at its end and travel with it. -- -- 'Nothing' where the module has neither header nor imports. -lastRearrangedLine :: HsModule GhcPs -> Maybe Int -lastRearrangedLine m = spanEndLine <$> (spansOf (hsmodImports m) <> header) +lastRearrangedLine :: HsModule GhcPs -> [Comment] -> Maybe Int +lastRearrangedLine m cs = + carriedPast . spanEndLine <$> (spansOf (hsmodImports m) <> header) where header = foldMap spanOf (hsmodName m) <> foldMap spanOf (hsmodDeprecMessage (hsmodExt m)) <> foldMap spanOf (hsmodExports m) + carriedPast lastLine = + maybe lastLine (spanEndLine . commentSpan . snd) . unsnoc $ + takeWhile + (maybe False ((<= lastLine) . fst) . carriedOnFrom (remarks <> run)) + run + where + remarks = [c | c <- cs, spanEndLine (commentSpan c) == lastLine] + run = following (lastLine + 1) cs + following n = \case + c : more + | spanStartLine (commentSpan c) < n -> following n more + | spanStartLine (commentSpan c) == n -> + c : following (spanEndLine (commentSpan c) + 1) more + _ -> [] -- | The pragmas a module carries, however they were written. -- diff --git a/src/Tilia/Fixity.hs b/src/Tilia/Fixity.hs --- a/src/Tilia/Fixity.hs +++ b/src/Tilia/Fixity.hs @@ -344,6 +344,7 @@ where declared = Map.map (Set.map snd) (declaredMembers hsModule) fromIE = \case + IEThingAbs _ n _ -> [(nameOf n, Set.empty)] IEThingAll _ n _ -> [(nameOf n, kids) | Just kids <- [Map.lookup (nameOf n) declared]] IEThingWith _ n _ ns _ -> [(nameOf n, Set.fromList (fmap nameOf ns))] _ -> [] diff --git a/src/Tilia/Fixity/Cache.hs b/src/Tilia/Fixity/Cache.hs --- a/src/Tilia/Fixity/Cache.hs +++ b/src/Tilia/Fixity/Cache.hs @@ -21,6 +21,10 @@ storeFutileSolve, cachedFutileFetch, storeFutileFetch, + cachedSolveTime, + storeSolveTime, + cachedPackageCache, + storePackageCache, ) where @@ -37,7 +41,9 @@ import Data.Text qualified as T import Data.Text.IO qualified as T import Data.Text.Read qualified as T +import Data.Time (UTCTime) import Data.Time.Format (defaultTimeLocale, formatTime) +import Data.Time.Format.ISO8601 (iso8601ParseM, iso8601Show) import System.Directory ( XdgDirectory (XdgCache), createDirectoryIfMissing, @@ -437,6 +443,31 @@ storeFutileFetch :: Cache -> [Text] -> IO () storeFutileFetch cache = writeAtomically (at cache ["fetches", tokenOf cache]) . T.unlines + +-- | When the project was last solved under this plan. +cachedSolveTime :: Cache -> IO (Maybe UTCTime) +cachedSolveTime cache = + join + <$> readIfPresent + (at cache ["solve-times", tokenOf cache]) + (iso8601ParseM . T.unpack . T.strip) + +-- | Remember when the project was solved under this plan. +storeSolveTime :: Cache -> UTCTime -> IO () +storeSolveTime cache = + writeAtomically (at cache ["solve-times", tokenOf cache]) + . T.pack + . iso8601Show + +-- | Where @cabal@ last said it keeps the sources it downloads. +cachedPackageCache :: Cache -> IO (Maybe FilePath) +cachedPackageCache cache = + readIfPresent (at cache ["package-cache", tokenOf cache]) (T.unpack . T.strip) + +-- | Remember where @cabal@ keeps the sources it downloads. +storePackageCache :: Cache -> FilePath -> IO () +storePackageCache cache = + writeAtomically (at cache ["package-cache", tokenOf cache]) . T.pack -- | Render a fixity declaration as fields. renderFixity :: ((Namespace, OpName), Fixity) -> [Text] diff --git a/src/Tilia/Fixity/Interface.hs b/src/Tilia/Fixity/Interface.hs --- a/src/Tilia/Fixity/Interface.hs +++ b/src/Tilia/Fixity/Interface.hs @@ -17,7 +17,7 @@ import Data.Char (isUpper) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map -import Data.Maybe (mapMaybe, maybeToList) +import Data.Maybe (isNothing, mapMaybe, maybeToList) import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text) @@ -31,8 +31,8 @@ -- | What an interface says about the operators a module offers. data Interface = Interface - { -- | The fixities the module declares itself, by the namespace each - -- governs. + { -- | The fixities the module declares itself for the names it exports, + -- by the namespace each governs. interfaceDeclares :: Fixities, -- | The names it reexports, each with the source module. interfaceReexports :: [(Text, OpName)], @@ -74,7 +74,11 @@ Right Interface { interfaceDeclares = - Map.fromList [((namespace, op), fixity) | (namespace, op, fixity) <- hiFixities], + Map.fromList + [ ((namespace, op), fixity) + | (namespace, op, fixity) <- hiFixities, + Set.member (namespace, op) exportedHere + ], interfaceReexports = [ (m, op) | names <- exports, @@ -85,22 +89,22 @@ interfaceExports = Just Certain - { certainNames = Set.fromList [(namespace, op) | (_, namespace, op) <- exported], + { certainNames = exportedHere, certainMembers = members } } where exports = concatMap resolved hiExports exported = concatMap exportedNames hiExports + exportedHere = + Set.fromList [(namespace, op) | (_, namespace, op) <- exported] members = Map.fromListWith Set.union [ (op, Set.fromList [(namespace, kid) | (_, namespace, kid) <- kids]) - | parent@(_, _, op) : named <- exports, - let kids = case named of - first : rest | first == parent -> rest - _ -> named, - not (null kids) + | AvailTC p ns <- hiExports, + Just parent@(_, _, op) <- [known p], + let kids = filter (/= parent) (mapMaybe known ns) ] exportedNames = \case Avail n -> maybeToList (known n) @@ -125,7 +129,10 @@ { interfaceDeclares = namespaced (typeNamesIn out) - (Map.fromList (concatMap declared (sectionsNamed "fixities"))), + ( Map.restrictKeys + fixities + (foldMap ownExports (sectionsNamed "exports:")) + ), interfaceReexports = concatMap reexports (sectionsNamed "exports:"), interfaceMembers = Map.unionsWith Set.union (fmap membersIn (sectionsNamed "exports:")), @@ -140,7 +147,15 @@ | (heading, body) <- sections out, heading == name ] + fixities = Map.fromList (concatMap declared (sectionsNamed "fixities")) declared = mapMaybe fixityEntry . T.splitOn "," + ownExports section = + Set.fromList + [ OpName name + | (parent, kids) <- exportEntries section, + name <- parent : kids, + isNothing (moduleOf name) + ] reexports = concatMap reexportsIn . T.words membersIn section = Map.fromListWith diff --git a/src/Tilia/Fixity/Plan.hs b/src/Tilia/Fixity/Plan.hs --- a/src/Tilia/Fixity/Plan.hs +++ b/src/Tilia/Fixity/Plan.hs @@ -20,6 +20,7 @@ tokenForEnvAndBuildPlan, tokenForBuildPlan, macrosOf, + plannedCompiler, -- * Readiness Readiness (..), @@ -33,6 +34,7 @@ guessedPackageCacheRoot, Futility (..), undiscoveredFutility, + futilityFor, prepareWith, loadPlan, @@ -97,7 +99,9 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.Text.Read qualified as T +import Data.Time (UTCTime, getCurrentTime) import Data.Unique (Unique, newUnique) +import Distribution.Version (Version, mkVersion) import GHC.Generics (Generic) import GHC.Hs (HsModule) import GHC.Hs.Extension (GhcPs) @@ -382,14 +386,14 @@ macrosOf :: BuildPlan -> Macros macrosOf plan = mempty - { macroVersions = + { macroExactVersions = 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 = + macroExactNumbers = Map.fromList [ entry | (major : minor : patches) <- toList compiler, @@ -402,7 +406,9 @@ macroUndefined = if null compiler then Set.empty - else Set.fromList ["__MHS__", "__HUGS__"] + else Set.fromList ["__MHS__", "__HUGS__"], + macroPlannedPackages = + Just (Set.fromList [underscored (ppName p) | p <- bpPackages plan]) } where versions = @@ -420,6 +426,12 @@ _ -> Nothing nth i xs = if i < length xs then xs !! i else 0 +-- | The version of GHC a plan is for, where it is for GHC. +plannedCompiler :: BuildPlan -> Maybe Version +plannedCompiler plan = + mkVersion . fmap fromInteger + <$> (numberedVersion =<< T.stripPrefix "ghc-" (bpCompiler plan)) + -- | The modules @cabal@ writes itself for a plan's packages. generatedModules :: BuildPlan -> Set Text generatedModules plan = @@ -500,7 +512,8 @@ readBuildPlan (planPathFor projectDir) >>= \case Left _ -> pure PlanMissing Right plan -> do - newer <- filesNewerThanPlan plan projectDir + solved <- cachedSolveTime =<< openCache caching =<< tokenForBuildPlan plan + newer <- filesNewerThanPlan plan projectDir solved let covered = plannedComponents plan missing = [spellComponent c | c <- wanted, c `notElem` covered] case (newer, missing) of @@ -514,16 +527,14 @@ -- | The packages the plan expects to fetch whose sources are not here. sourcesShortOf :: Choice "useCache" -> BuildPlan -> IO [PlanPackage] sourcesShortOf caching plan = do - tarballs <- filter (isFetchable . fst) <$> plannedTarballs plan + cache <- openCache caching =<< tokenForBuildPlan plan + tarballs <- filter (isFetchable . fst) <$> plannedTarballs cache plan absent <- fmap fst <$> filterM (fmap not . doesFileExist . snd) tarballs - short <- - if null absent - then pure [] - else do - cache <- openCache caching =<< tokenForBuildPlan plan - installed <- getInstalledPackages cache - pure (filter (not . builtAlready installed) absent) - pure short + if null absent + then pure [] + else do + installed <- getInstalledPackages cache + pure (filter (not . builtAlready installed) absent) -- | Has the compiler got this package already? builtAlready :: [InstalledPackage] -> PlanPackage -> Bool @@ -531,10 +542,12 @@ where matches i = ipName i == ppName p && ipVersion i == ppVersion p --- | The project files that have changed since the plan was written. -filesNewerThanPlan :: BuildPlan -> FilePath -> IO [FilePath] -filesNewerThanPlan plan projectDir = quietly [] $ do - planTime <- getModificationTime (planPathFor projectDir) +-- | The project files that have changed since the plan was written, and +-- since the last solve, which leaves a plan it would not change as it was. +filesNewerThanPlan :: BuildPlan -> FilePath -> Maybe UTCTime -> IO [FilePath] +filesNewerThanPlan plan projectDir solved = quietly [] $ do + written <- getModificationTime (planPathFor projectDir) + let planTime = maybe written (max written) solved atRoot <- quietly [] (listDirectory projectDir) inPackages <- concat <$> traverse cabalFilesIn (localDirs plan) let candidates = @@ -565,7 +578,10 @@ -- | The packages an earlier fetch was still short of afterwards. fetchWasFutileFor :: IO [Text], -- | Remember what a fetch left missing. - rememberFutileFetch :: [Text] -> IO () + rememberFutileFetch :: [Text] -> IO (), + -- | Remember when a solve started, so that no change made before it + -- makes the plan stale. + rememberSolveTime :: UTCTime -> IO () } -- | The state when we know nothing about futile actions yet. @@ -575,7 +591,8 @@ { solveWasFutile = pure False, rememberFutileSolve = pure (), fetchWasFutileFor = pure [], - rememberFutileFetch = const (pure ()) + rememberFutileFetch = const (pure ()), + rememberSolveTime = const (pure ()) } -- | A memory kept in the cache, under the plan the project has now. @@ -586,7 +603,8 @@ rememberFutileSolve = withCache () storeFutileSolve, fetchWasFutileFor = withCache [] cachedFutileFetch, rememberFutileFetch = \packages -> - withCache () (`storeFutileFetch` packages) + withCache () (`storeFutileFetch` packages), + rememberSolveTime = \started -> withCache () (`storeSolveTime` started) } where withCache fallback use = @@ -645,10 +663,12 @@ left <- sourcesShortOf caching plan rememberFutileFetch futility (fmap ppName left) pure (Right ()) - solveThenFetch = + solveThenFetch = do + started <- getCurrentTime tryWholeProject ["build", ":all", "--dry-run"] >>= \case Left err -> pure (Left err) - Right () -> + Right () -> do + rememberSolveTime futility started checkReadiness caching wanted projectDir >>= \case SourcesMissing _ -> fetch PlanNarrow _ -> rememberFutileSolve futility >> fetchWhatIsShort @@ -724,15 +744,29 @@ _ -> readBuildPlan (planPathFor projectDir) -- | Every planned package whose source could be in the package cache, with --- where that would be. -plannedTarballs :: BuildPlan -> IO [(PlanPackage, FilePath)] -plannedTarballs plan = do - cacheRoot <- packageCacheRoot - repos <- quietly [] (Data.List.sort <$> listDirectory cacheRoot) - traverse - (\p -> (,) p <$> tarballFor cacheRoot repos p) - [p | p <- bpPackages plan, not (isLocal p)] +-- where that would be: under the package cache @cabal@ last named, unless +-- a tarball it downloads is not there, when @cabal@ is asked again. +plannedTarballs :: Cache -> BuildPlan -> IO [(PlanPackage, FilePath)] +plannedTarballs cache plan = + cachedPackageCache cache >>= \case + Just remembered -> do + tarballs <- under remembered + absent <- + filterM + (fmap not . doesFileExist . snd) + (filter (isFetchable . fst) tarballs) + if null absent then pure tarballs else asked + Nothing -> asked where + asked = do + cacheRoot <- packageCacheRoot + storePackageCache cache cacheRoot + under cacheRoot + under cacheRoot = do + repos <- quietly [] (Data.List.sort <$> listDirectory cacheRoot) + traverse + (\p -> (,) p <$> tarballFor cacheRoot repos p) + [p | p <- bpPackages plan, not (isLocal p)] isLocal p = case ppSource p of LocalPackage _ -> True CheckedOut _ -> True @@ -870,11 +904,11 @@ BuildPlan -> IO Resolver newResolverVia caching routes plan = do + cache <- openCache caching =<< tokenForBuildPlan plan tarballs <- if FromSource `elem` routes - then plannedTarballs plan + then plannedTarballs cache plan else pure [] - cache <- openCache caching =<< tokenForBuildPlan plan installed <- getInstalledPackages cache newResolverWith routes cache installed tarballs plan @@ -898,7 +932,7 @@ local <- localModules plan flights <- newMVar (Flights Map.empty Map.empty) answersRead <- newMemo - askPackage <- newPackageReader + askPackage <- newPackageReader (plannedCompiler plan) extensionsRead <- newMemo summariesRead <- newMemo archivesRead <- newMemo @@ -1518,12 +1552,16 @@ more <- reached $ \i -> Map.notMember (importModule i) listed && any (suppliedBy i) members let answers = Map.union listed more + parts = fmap (exported answers reexported) items pure . together $ mempty - { establishedFixities = summaryFixities summary, + { establishedFixities = + Map.restrictKeys + (summaryFixities summary) + (foldMap (certainNames . establishedCertain) parts), establishedMembers = summaryListedMembers summary } - : fmap (exported answers reexported) items + : parts where imports = summaryImports summary declared = summaryDeclaredMembers summary diff --git a/src/Tilia/Format.hs b/src/Tilia/Format.hs --- a/src/Tilia/Format.hs +++ b/src/Tilia/Format.hs @@ -67,6 +67,7 @@ loadPlan, macrosOf, newResolverVia, + plannedCompiler, readGivenPlan, scopeFor, ) @@ -259,7 +260,7 @@ then [FromInterface, FromSource] <$ liftIO (fetchUninstalled caching root plan) else pure [FromInterface] (,) plan <$> liftIO (newResolverVia caching routes plan) - askPackage <- liftIO newPackageReader + askPackage <- liftIO (newPackageReader (plannedCompiler plan)) notes <- if isTrue debugFixity then Just <$> liftIO (newIORef Map.empty) diff --git a/src/Tilia/Parser.hs b/src/Tilia/Parser.hs --- a/src/Tilia/Parser.hs +++ b/src/Tilia/Parser.hs @@ -104,7 +104,7 @@ Right ParsedModule { pmModule = hsModule, - pmSource = sourceOf written (lexedComments start), + pmSource = uncurry (sourceOf written) (lexed start), pmGathered = gathered hsModule, pmSourceType = sourceType, pmPrologue = prologueOf (lineTexts written), @@ -182,16 +182,26 @@ GHC.ITsemi -> False t -> not (isComment t) --- | Lex every comment, in source order, from the state a parse starts in. -lexedComments :: GHC.PState -> [LEpaComment] -lexedComments s = +-- | Lex every comment, in source order, and the line each quasi-quotation +-- written over several lines ends on, by the line it begins on, from the +-- state a parse starts in. +lexed :: GHC.PState -> ([LEpaComment], IntMap Int) +lexed s = case GHC.lexTokenStream (GHC.options s) (GHC.buffer s) loc of GHC.PFailed _ -> error "Tilia: a module that parses cannot fail to lex" GHC.POk _ tokens -> - [ GHC.commentToAnnotation (GHC.L l t) - | GHC.L (GHC.RealSrcSpan l _) t <- tokens, - isComment t - ] + ( [ GHC.commentToAnnotation (GHC.L l t) + | GHC.L (GHC.RealSrcSpan l _) t <- tokens, + isComment t + ], + IntMap.fromList + [ (GHC.srcSpanStartLine l, GHC.srcSpanEndLine l) + | GHC.xtest GHC.QqBit (GHC.pExtsBitmap (GHC.options s)), + GHC.L (GHC.RealSrcSpan l _) t <- tokens, + isQuasiQuote t, + GHC.srcSpanStartLine l < GHC.srcSpanEndLine l + ] + ) where loc = GHC.psRealLoc (GHC.loc s) @@ -202,6 +212,13 @@ GHC.ITblockComment _ _ -> True GHC.ITdocComment _ _ -> True GHC.ITdocOptions _ _ -> True + _ -> False + +-- | Is this token a quasi-quotation? +isQuasiQuote :: GHC.Token -> Bool +isQuasiQuote = \case + GHC.ITquasiQuote _ -> True + GHC.ITqQuasiQuote _ -> True _ -> False -- | The state to start reading a module in. diff --git a/src/Tilia/Render/Context.hs b/src/Tilia/Render/Context.hs --- a/src/Tilia/Render/Context.hs +++ b/src/Tilia/Render/Context.hs @@ -34,6 +34,7 @@ layoutFrom, layoutWithin, layoutAcross, + writtenOnOneLine, attachOperator, -- * Haddocks @@ -70,6 +71,7 @@ SourceType, blankAt, directivePresentOnLine, + quoteEndingFrom, sourceLines, ) import Tilia.Span @@ -294,7 +296,7 @@ -- of an @if@—and for nothing else. atSpan :: Ctx -> Maybe Span -> Doc -> Doc atSpan _ Nothing d = d -atSpan _ (Just s) d = located s (group s d) +atSpan ctx (Just s) d = located s (layoutFrom ctx (Just s) d) -- | A keyword, claiming the span it was written on. keywordAt :: Ctx -> Maybe Span -> Text -> Doc @@ -309,10 +311,12 @@ -- | 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. +-- line or several. The lines of a quasi-quotation count as one, since they +-- are reproduced rather than laid out. layoutFrom :: Ctx -> Maybe Span -> Doc -> Doc -layoutFrom _ Nothing d = flat d -layoutFrom _ (Just s) d = group s d +layoutFrom ctx s + | maybe True (writtenOnOneLine ctx) s = flat + | otherwise = broken -- | Lay a construct out from the region its contents occupy rather than the -- region it occupies. @@ -328,7 +332,7 @@ Doc layoutWithin ctx whole contents d | any (holdsLineComment ctx) whole = broken d - | otherwise = maybe (flat d) (`group` d) contents + | otherwise = layoutFrom ctx contents d -- | 'layoutFrom' over the region several located things cover. layoutAcross :: (HasLoc l) => Ctx -> [GenLocated l a] -> Doc -> Doc @@ -364,6 +368,15 @@ where indentation o = located (mkSpan (spanStartLine o, 1) (startPoint o)) mempty + +-- | Was the region written on one line, the lines of a quasi-quotation +-- counting as one? +writtenOnOneLine :: Ctx -> Span -> Bool +writtenOnOneLine ctx s = from (spanStartLine s) + where + from n = + n >= spanEndLine s + || maybe False from (quoteEndingFrom n (ctxSource ctx)) -- | Does a comment that takes whole lines begin inside this span? holdsLineComment :: Ctx -> Span -> Bool diff --git a/src/Tilia/Render/Expression.hs b/src/Tilia/Render/Expression.hs --- a/src/Tilia/Render/Expression.hs +++ b/src/Tilia/Render/Expression.hs @@ -101,7 +101,7 @@ 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 + HsCase anns e mg -> caseOf ctx site (ExprBody ctx) anns e mg HsIf anns c t e -> ifThenElse ctx (bodyIn (ExprBody ctx) (siteBracing site)) anns c t e HsMultiIf _ guards -> txt "if" @@ -237,7 +237,7 @@ lastArg = NE.last args initSpan = spanOf f <> (startOf <$> spanOf lastArg) placement - | maybe False isSingleLine initSpan = exprHangs (unLoc lastArg) + | maybe False (writtenOnOneLine ctx) initSpan = exprHangs (unLoc lastArg) | otherwise = Normal headAndInit bracing = hsExprIn ctx site{siteApplicand = True, siteBracing = bracing} func @@ -301,7 +301,12 @@ Doc fieldBind ctx label HsFieldBind{..} = label hfbLHS - <> includeUnless hfbPun (space <> txt "=" <> attach placement (hsExpr ctx hfbRHS)) + <> includeUnless + hfbPun + ( space + <> maybe id located (tokenSpan =<< hfbAnn) (txt "=") + <> attach placement (hsExpr ctx hfbRHS) + ) where placement | sameLine (spanOf hfbLHS) (spanOf hfbRHS) = exprHangs (unLoc hfbRHS) @@ -400,7 +405,7 @@ endsHanging = exprHangs (unLoc (lastOperand chain)) == Hanging couldTrail previous o = isSeparator (fixityOf ctx o) - && maybe False isSingleLine (chainSpan spanOf previous) + && maybe False (writtenOnOneLine ctx) (chainSpan spanOf previous) && placement == Normal && not (isDoBlock (lastOperand previous)) @@ -461,9 +466,12 @@ LastStmt _ body _ _ -> printBody (mkBody site body) BodyStmt _ body _ _ -> printBody (mkBody site body) BindStmt arrow p f -> - hsPat ctx p + hsPatClosing ctx (closingFor site) p <> nest 1 (space <> maybe id located (uniTokenSpan arrow) (txt "<-")) - <> layoutFrom ctx (spanOf p <> spanOf f) (attach placement (printBody bound)) + <> layoutFrom + ctx + (fmap endOf (spanOf p) <> spanOf f) + (attach placement (printBody bound)) where bound = mkBody plainSite f placement @@ -582,14 +590,17 @@ Ctx -> Site -> BodyOf body b -> + EpAnnHsCase -> LHsExpr GhcPs -> MatchGroup GhcPs (LocatedA body) -> Doc -caseOf ctx site mkBody scrutinee mg = - txt "case" +caseOf ctx site mkBody EpAnnHsCase{..} scrutinee mg = + maybe id located (tokenSpan hsCaseAnnCase) (txt "case") <> space <> hsExpr ctx scrutinee - <> joinedBy "of" + <> space + <> indent (maybe id located (tokenSpan hsCaseAnnOf) (txt "of")) + <> breakOrSpace <> bracedForSite site alternatives where alternatives b = underSite site (matchGroup ctx b mkBody CaseStyle mg) @@ -664,18 +675,19 @@ Doc letIn ctx bodyOf nested (letToken, inToken) binds body = align $ - txt "let" + written (tokenSpan letToken) (txt "let") <> space <> align ( localBinds ctx NoBrace binds <> foldMap (emptyAnchor . startOf) (tokenSpan inToken) ) - <> (if chained then space else variant space (hardBreak <> txt " ")) - <> txt "in" + <> written (tokenSpan inToken) (separator <> txt "in") <> (if chained then breakOrSpace else space) <> align (printBody (bodyOf body)) where - chained = nested && sameLine (tokenSpan letToken) (tokenSpan inToken) + chained = nested && not (sameLine (tokenSpan inToken) (spanOf body)) + separator = if chained then space else variant space (hardBreak <> txt " ") + written s d = if chained then fenceWithin ctx s d else d -- | The bindings of a @let@ or a @where@. localBinds :: Ctx -> Bracing -> HsLocalBinds GhcPs -> Doc @@ -768,7 +780,7 @@ <> 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 + HsCmdCase anns e mg -> caseOf ctx site (CmdBody ctx) anns e mg HsCmdIf anns _ c t e -> ifThenElse ctx (bodyIn (CmdBody ctx) (siteBracing site)) anns c t e HsCmdLet tokens binds c -> @@ -1088,16 +1100,19 @@ [] -> atSpan ctx (grhsSpan grhs) (printBody bound) _ -> maybe id located (spanOf lgrhs) . layoutFrom ctx (grhsSpan grhs) $ + maybe id fence headSpan guardHead + <> nest + (if parentPlacement == Normal then 1 else 0) + (attach placement (printBody bound)) + where + GRHS EpAnn{anns = GrhsAnn{ga_vbar, ga_sep}} guards body = grhs + guardHead = txt "|" <> space <> align (commaSep (fmap (align . hsStmt ctx) guards)) <> space <> indent (txt separator) - <> nest - (if parentPlacement == Normal then 1 else 0) - (attach placement (printBody bound)) - where - GRHS EpAnn{anns = GrhsAnn{ga_sep}} guards body = grhs + headSpan = (<>) <$> (tokenSpan =<< ga_vbar) <*> separatorSpan bound = bodyIn mkBody bracing body separator = case style of EqualsSign -> "=" diff --git a/src/Tilia/Render/Pattern.hs b/src/Tilia/Render/Pattern.hs --- a/src/Tilia/Render/Pattern.hs +++ b/src/Tilia/Render/Pattern.hs @@ -9,6 +9,7 @@ -- | Patterns. module Tilia.Render.Pattern ( hsPat, + hsPatClosing, fieldOcc, unboxedSum, ) @@ -32,8 +33,12 @@ -- | A pattern. hsPat :: Ctx -> LPat GhcPs -> Doc -hsPat ctx = hsPatIn ctx NoBrace (Isn't #inAsPat) +hsPat ctx = hsPatClosing ctx Indented +-- | A pattern whose outermost bracket closes where it is told to. +hsPatClosing :: Ctx -> ClosingIndent -> LPat GhcPs -> Doc +hsPatClosing ctx = hsPatIn ctx NoBrace (Isn't #inAsPat) + -- | A pattern that knows where it stands. hsPatIn :: -- | The context. @@ -42,10 +47,13 @@ Bracing -> -- | Is this inside an as-pattern? Choice "inAsPat" -> + -- | Where its outermost bracket closes. + ClosingIndent -> -- | The pattern. LPat GhcPs -> Doc -hsPatIn ctx bracing inAsPat l = at ctx l (patBody ctx bracing inAsPat (spanOf l)) +hsPatIn ctx bracing inAsPat closing l = + at ctx l (patBody ctx bracing inAsPat closing (spanOf l)) -- | Every shape a pattern can take. patBody :: @@ -55,24 +63,31 @@ Bracing -> -- | Is this inside an as-pattern? Choice "inAsPat" -> + -- | Where its outermost bracket closes. + ClosingIndent -> -- | Where the pattern was written. Maybe Span -> -- | The pattern. Pat GhcPs -> Doc -patBody ctx bracing inAsPat here = \case +patBody ctx bracing inAsPat closing here = \case WildPat _ -> txt "_" VarPat _ n -> name ctx n LazyPat _ p -> txt "~" <> recur p - AsPat _ n p -> name ctx n <> txt "@" <> hsPatIn ctx bracing (Is #inAsPat) p - ParPat _ p -> parensWith Indented (insideBrackets here (recur p)) + AsPat _ n p -> + name ctx n <> txt "@" <> hsPatIn ctx bracing (Is #inAsPat) Indented p + ParPat _ p -> parensWith closing (insideBrackets here (recur p)) BangPat _ p -> txt "!" <> recur p - ListPat _ ps -> bracketsWith Indented (insideBrackets here (commaSep (fmap recur ps))) + ListPat _ ps -> + bracketsWith closing (insideBrackets here (commaSep (fmap recur ps))) TuplePat _ ps boxity -> - tupleBrackets boxity (insideBrackets here (commaSep (fmap (align . recur) ps))) + tupleBrackets + boxity + closing + (insideBrackets here (commaSep (fmap (align . recur) ps))) OrPat _ ps -> itemsSepBy (fromBool (isTrue inAsPat)) bracing (fmap recur (NE.toList ps)) - SumPat _ p tag arity -> unboxedSum Indented tag arity (recur p) + SumPat _ p tag arity -> unboxedSum closing tag arity (recur p) ConPat _ con details -> conPattern ctx bracing inAsPat here con details ViewPat _ e p -> align $ @@ -94,7 +109,7 @@ EmbTyPat _ (HsTP _ ty) -> txt "type" <> space <> hsType ctx ty InvisPat _ (HsTP _ ty) -> txt "@" <> hsType ctx ty where - recur = hsPatIn ctx bracing inAsPat + recur = hsPatIn ctx bracing inAsPat Indented -- | A constructor pattern, in whichever of its three forms. conPattern :: @@ -126,7 +141,7 @@ recur l <> attachOperator Normal (spanOf l) (spanOf con) (spanOf r) (name ctx con) (recur r) where - recur = hsPatIn ctx bracing inAsPat + recur = hsPatIn ctx bracing inAsPat Indented field = either wildcard (at_ ctx (patFieldBind ctx)) wildcard l = at ctx l (const (txt "..")) visibleFields dotdot fields = case dotdot of @@ -156,10 +171,10 @@ after = replicate (arity - tag) space -- | The brackets a tuple pattern is written with. -tupleBrackets :: Boxity -> Doc -> Doc +tupleBrackets :: Boxity -> ClosingIndent -> Doc -> Doc tupleBrackets = \case - Boxed -> parensWith Indented - Unboxed -> unboxedWith Indented + Boxed -> parensWith + Unboxed -> unboxedWith -- | With @NegativeLiterals@ on, @- 1@ and @-1@ are different expressions, so -- the minus of a negated literal has to keep its distance. diff --git a/src/Tilia/Source.hs b/src/Tilia/Source.hs --- a/src/Tilia/Source.hs +++ b/src/Tilia/Source.hs @@ -19,9 +19,14 @@ -- * Its comments comments, + + -- * Its quasi-quotations + quoteEndingFrom, ) where +import Data.IntMap.Strict (IntMap) +import Data.IntMap.Strict qualified as IntMap import GHC.Parser.Annotation (LEpaComment) import Tilia.Comments (Comment, commentsOf) import Tilia.Source.Lines @@ -37,7 +42,10 @@ { -- | The lines, numbered from one as the compiler numbers them. srcLines :: !Lines, -- | Every comment in the module, in source order. - srcComments :: [Comment] + srcComments :: [Comment], + -- | The line each quasi-quotation written over several lines ends on, + -- by the line it begins on. + srcQuotes :: IntMap Int } -- | The lines of a source. @@ -50,13 +58,22 @@ Lines -> -- | Every comment of the module, in source order. [LEpaComment] -> + -- | The line each quasi-quotation written over several lines ends on, by + -- the line it begins on. + IntMap Int -> Source -sourceOf ls cs = +sourceOf ls cs qs = Source { srcLines = ls, - srcComments = commentsOf ls cs + srcComments = commentsOf ls cs, + srcQuotes = qs } -- | Every comment in a module, in source order. comments :: Source -> [Comment] comments = srcComments + +-- | The line a quasi-quotation that begins on this line ends on, if it ends +-- on another. +quoteEndingFrom :: Int -> Source -> Maybe Int +quoteEndingFrom n = IntMap.lookup n . srcQuotes diff --git a/tests/Tilia/Cabal/PackageSpec.hs b/tests/Tilia/Cabal/PackageSpec.hs --- a/tests/Tilia/Cabal/PackageSpec.hs +++ b/tests/Tilia/Cabal/PackageSpec.hs @@ -14,6 +14,7 @@ import System.IO.Temp (withSystemTempDirectory) import Test.Hspec import Tilia.Cabal.Package (PackageProblem (..), newPackageReader) +import Tilia.Fixity.Plan (BuildPlan (..), plannedCompiler) spec :: Spec spec = do @@ -112,6 +113,13 @@ (has BangPatterns library, has Strict library) `shouldBe` (False, False) + it "take the compiler's version from the plan where it names one" $ + inPackage conditionalExtensions ["src"] $ \root -> do + ask <- newPackageReader (plannedCompiler (BuildPlan "ghc-8.4.4" [])) + library <- ask (root "src" "M.hs") + (has StarIsType library, has BangPatterns library) + `shouldBe` (True, True) + it "take in their own branch's too, for a module only it declares" $ inPackage conditionalExtensions ["src", "old"] $ \root -> do old <- asked (root "old" "Old.hs") @@ -134,21 +142,21 @@ describe "a reader kept between files" $ do it "answers as a fresh one would" $ inPackage twoComponents ["src", "test"] $ \root -> do - ask <- newPackageReader + ask <- newPackageReader Nothing 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 + ask <- newPackageReader Nothing 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 + ask <- newPackageReader Nothing deep <- ask (root "src" "deep" "A.hs") removeFile (root "demo.cabal") ask (root "src" "B.hs") `shouldReturn` deep @@ -362,7 +370,7 @@ -- is not about caching wants. asked :: FilePath -> IO (Either PackageProblem [Extension]) asked path = do - ask <- newPackageReader + ask <- newPackageReader Nothing ask path -- | One module in each of the two components. diff --git a/tests/Tilia/Corpus.hs b/tests/Tilia/Corpus.hs --- a/tests/Tilia/Corpus.hs +++ b/tests/Tilia/Corpus.hs @@ -236,6 +236,7 @@ "esqueleto-3.6.0.3", "exceptions-0.10.12", "fay-0.24.2.0", + "flatparse-0.5.6.1", "free-5.2", "fsnotify-0.4.4.0", "hakyll-4.17.0.0", @@ -357,7 +358,10 @@ "declaration" "data" "multiline-arg-parens.hs", "module-header" "multiline-with-comments.hs", "declaration" "value" "function" "awkward-comment-1.hs", - "declaration" "signature" "pattern" "multiline.hs" + "declaration" "signature" "pattern" "multiline.hs", + "declaration" "splice" "quasiquote.hs", + "declaration" "value" "function" "quasi-quotes.hs", + "declaration" "value" "function" "operator-comments-0.hs" ] <> ormoluRecordBraces <> ormoluUnreadable @@ -1075,7 +1079,7 @@ packageReaderFor corpus | not (corpusInPackages corpus) = pure (const (pure [])) | otherwise = do - reader <- newPackageReader + reader <- newPackageReader Nothing pure (fmap (either (const []) id) . reader) -- | The extensions an example may be written with. diff --git a/tests/Tilia/Cpp/MacrosSpec.hs b/tests/Tilia/Cpp/MacrosSpec.hs --- a/tests/Tilia/Cpp/MacrosSpec.hs +++ b/tests/Tilia/Cpp/MacrosSpec.hs @@ -15,18 +15,19 @@ macros :: Macros macros = mempty - { macroVersions = + { macroExactVersions = Map.fromList [ ("MIN_VERSION_thing", [1, 2, 3]), ("MIN_VERSION_GLASGOW_HASKELL", [9, 10, 3, 0]) ], - macroNumbers = + macroExactNumbers = Map.fromList [ ("__GLASGOW_HASKELL__", 910), ("__GLASGOW_HASKELL_PATCHLEVEL1__", 3), ("__GLASGOW_HASKELL_PATCHLEVEL2__", 0) ], - macroUndefined = Set.fromList ["__MHS__", "__HUGS__"] + macroUndefined = Set.fromList ["__MHS__", "__HUGS__"], + macroPlannedPackages = Just (Set.fromList ["thing"]) } -- | What this guard comes to, given the plan above. @@ -51,8 +52,19 @@ fmap 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 + it "has the macros of a package the plan does not hold undefined" $ + fmap + answer + [ "ifdef VERSION_other", + "ifndef VERSION_other", + "if defined(MIN_VERSION_other)", + "if MIN_VERSION_other(1,0,0)" + ] + `shouldBe` [Just False, Just True, Just False, Just False] + + it "says nothing about other packages where the plan's are unknown" $ + guardHolds macros{macroPlannedPackages = Nothing} "ifdef VERSION_other" + `shouldBe` Nothing describe "a guard about the compiler" $ do it "reads its version as the compiler spells it" $ diff --git a/tests/Tilia/Cpp/PropertiesSpec.hs b/tests/Tilia/Cpp/PropertiesSpec.hs --- a/tests/Tilia/Cpp/PropertiesSpec.hs +++ b/tests/Tilia/Cpp/PropertiesSpec.hs @@ -83,7 +83,8 @@ -- else, so that a module comes out with some of its conditionals answered -- and some of them left open. macros :: Macros -macros = mempty{macroVersions = Map.fromList [("MIN_VERSION_thing", [1, 2, 3])]} +macros = + mempty{macroExactVersions = Map.fromList [("MIN_VERSION_thing", [1, 2, 3])]} format :: Text -> Either Text Text format source = case formatWithCpp defaultParserConfig defaultRenderConfig "M.hs" source of diff --git a/tests/Tilia/Doc/CombinatorsSpec.hs b/tests/Tilia/Doc/CombinatorsSpec.hs --- a/tests/Tilia/Doc/CombinatorsSpec.hs +++ b/tests/Tilia/Doc/CombinatorsSpec.hs @@ -20,12 +20,6 @@ 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" @@ -37,10 +31,6 @@ 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 diff --git a/tests/Tilia/Doc/InternalSpec.hs b/tests/Tilia/Doc/InternalSpec.hs --- a/tests/Tilia/Doc/InternalSpec.hs +++ b/tests/Tilia/Doc/InternalSpec.hs @@ -10,7 +10,6 @@ import Tilia.Doc.Internal ( Doc (DCppDirective, DHoldBack), Spill (..), - groupLayout, ) import Tilia.Span @@ -27,14 +26,6 @@ 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" $ diff --git a/tests/Tilia/Doc/PropertiesSpec.hs b/tests/Tilia/Doc/PropertiesSpec.hs --- a/tests/Tilia/Doc/PropertiesSpec.hs +++ b/tests/Tilia/Doc/PropertiesSpec.hs @@ -50,14 +50,6 @@ 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) -> diff --git a/tests/Tilia/EquivalenceSpec.hs b/tests/Tilia/EquivalenceSpec.hs --- a/tests/Tilia/EquivalenceSpec.hs +++ b/tests/Tilia/EquivalenceSpec.hs @@ -134,6 +134,14 @@ "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" + it "does not mind a comment carried on under the last import moving with it" $ + "module M where\nimport Data.Maybe\nimport Data.Char () -- not needed, just\n -- re-exported\n" + `keepsTheCommentsOf` "module M where\n\nimport Data.Char () -- not needed, just\n -- re-exported\nimport Data.Maybe\n" + + it "notices a comment carried on under the last import going missing" $ + "module M where\nimport Data.Maybe\nimport Data.Char () -- not needed, just\n -- re-exported\n" + `losesTheCommentsOf` "module M where\n\nimport Data.Char () -- not needed, just\nimport Data.Maybe\n" + ---------------------------------------------------------------------------- -- Helpers diff --git a/tests/Tilia/Fixity/DependenciesSpec.hs b/tests/Tilia/Fixity/DependenciesSpec.hs --- a/tests/Tilia/Fixity/DependenciesSpec.hs +++ b/tests/Tilia/Fixity/DependenciesSpec.hs @@ -17,7 +17,7 @@ import Control.Monad (filterM) import Data.ByteString qualified as BS -import Data.Choice (pattern Do, pattern Is) +import Data.Choice (pattern Do, pattern Don't, pattern Is) import Data.Foldable (for_) import Data.List (isSuffixOf, sort) import Data.Map.Strict qualified as Map @@ -33,6 +33,7 @@ import Tilia.BootFixities (bootFixities) import Tilia.Cpp (blankCpp) import Tilia.Fixity +import Tilia.Fixity.Cache (PlanToken (..), openCache) import Tilia.Fixity.Interface (Interface (..), readInterface) import Tilia.Fixity.PackageDb import Tilia.Fixity.Plan @@ -65,11 +66,12 @@ readFromSourcePackages = Set.fromList (fmap depPackage dependencies) `Set.difference` shippedPackages + noCache <- runIO (openCache (Don't #useCache) (PlanToken "")) missing <- runIO $ filterM (fmap not . doesFileExist . snd) . filter ((`Set.member` readFromSourcePackages) . ppName . fst) - =<< plannedTarballs plan + =<< plannedTarballs noCache plan describe "the tree this project is built against" $ do it "is a real dependency tree and not an empty plan" $ length dependencies `shouldSatisfy` (>= 30) diff --git a/tests/Tilia/Fixity/InterfaceSpec.hs b/tests/Tilia/Fixity/InterfaceSpec.hs --- a/tests/Tilia/Fixity/InterfaceSpec.hs +++ b/tests/Tilia/Fixity/InterfaceSpec.hs @@ -19,7 +19,7 @@ spec = do describe "what a module declares" $ do it "reads a fixity line" $ - declares "fixities infixl 9 !, infixl 9 !?, infixl 9 \\\\\n" + declares "exports:\n !\n !?\n \\\\\nfixities infixl 9 !, infixl 9 !?, infixl 9 \\\\\n" `shouldBe` [ (OpName "!", Fixity LeftAssoc 9), (OpName "!?", Fixity LeftAssoc 9), (OpName "\\\\", Fixity LeftAssoc 9) @@ -27,7 +27,8 @@ it "reads one wrapped across lines" $ declares - "fixities infixr 0 $, infixr 0 $!, infixl 4 *>, infixr 5 ++,\n\ + "exports:\n $\n $!\n *>\n ++\n .\n :|\n <$\n\ + \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), @@ -39,22 +40,22 @@ ] it "reads every direction, and a name used in backticks" $ - declares "fixities infixl 7 div, infix 4 ===, infixr 1 .&&.\n" + declares "exports:\n div\n ===\n .&&.\nfixities 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" + declares "exports:\n ->\nfixities infixr -1 ->\n" `shouldBe` [(OpName "->", Fixity RightAssoc (-1))] it "reads it alongside ordinary ones" $ - declares "fixities infixr -1 ->, infixl 9 !\n" + declares "exports:\n ->\n !\nfixities 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" + declares "exports:\n ?\n !\nfixities infixl notadigit ?, infixl 9 !, infixl\n" `shouldBe` [(OpName "!", Fixity LeftAssoc 9)] it "says nothing for a module that declares nothing" $ @@ -114,31 +115,31 @@ 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" + declaresIn "exports:\n :~:\nfixities 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" + declaresIn "exports:\n !\nfixities 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" + declaresIn "exports:\n :+\nfixities 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" + declaresIn "exports:\n ==\nfixities 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" + declaresIn "exports:\n <%>\nfixities 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" + declaresIn "exports:\n !\nfixities 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" + declaresIn "exports:\n !\nfixities infixl 9 !\nab12\n data Other a b where\n (!) :: Int\n" `shouldBe` [((InTerms, OpName "!"), Fixity LeftAssoc 9)] describe "the members of a name" $ do @@ -180,12 +181,42 @@ ) ) + it "gives a type exported without its members none" $ + fmap + interfaceMembers + (fromHiFile "M" (HiFile "M" [AvailTC (inM InTypes "T") [inM InTypes "T"]] [])) + `shouldBe` Right (Map.fromList [(OpName "T", Set.empty)]) + it "does not take a type for exported where only its field is" $ fmap (fmap certainNames . interfaceExports) (fromHiFile "M" (HiFile "M" [AvailTC (inM InTypes "T") [inM InTerms "field"]] [])) `shouldBe` Right (Just (Set.fromList [(InTerms, OpName "field")])) + describe "a fixity for a name the module does not export" $ do + it "is left out of a decoded interface" $ + fmap + (Map.toList . interfaceDeclares) + ( fromHiFile + "M" + ( HiFile + "M" + [Avail (inM InTerms "<+>")] + [ (InTerms, OpName "<+>", Fixity LeftAssoc 3), + (InTerms, OpName "<~>", Fixity RightAssoc 2) + ] + ) + ) + `shouldBe` Right [((InTerms, OpName "<+>"), Fixity LeftAssoc 3)] + + it "is left out of what ghc --show-iface prints" $ + declares "exports:\n <+>\n parser\nfixities infixl 3 <+>, infixr 2 <~>\n" + `shouldBe` [(OpName "<+>", Fixity LeftAssoc 3)] + + it "is left out where the module passes on another name spelled the same" $ + declares "exports:\n GHC.Internal.Base.>>=\nfixities infixr 2 >>=\n" + `shouldBe` [] + describe "sections it has no use for" $ it "is not confused by the rest of the file" $ do let out = @@ -194,6 +225,7 @@ \interface Data.Aeson 9103\n\ \ interface hash: 6b4f\n\ \exports:\n\ + \ !\n\ \ Data.Aeson.Types.FromJSON..:\n\ \fixities infixl 9 !\n\ \direct package dependencies: base-4.20.2.0 bytestring-0.12.2.0\n\ @@ -214,7 +246,7 @@ `shouldBe` Nothing it "reads one that names the module asked for" $ - declares "fixities infixl 9 !\n" `shouldBe` [(OpName "!", Fixity LeftAssoc 9)] + declares "exports:\n !\nfixities infixl 9 !\n" `shouldBe` [(OpName "!", Fixity LeftAssoc 9)] header :: Text -> Text header modName = "interface " <> modName <> " 9103\n" diff --git a/tests/Tilia/Fixity/PlanSpec.hs b/tests/Tilia/Fixity/PlanSpec.hs --- a/tests/Tilia/Fixity/PlanSpec.hs +++ b/tests/Tilia/Fixity/PlanSpec.hs @@ -33,10 +33,12 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.Text.IO qualified as T +import Data.Time (addUTCTime, getCurrentTime) import System.Directory ( createDirectoryIfMissing, doesFileExist, getPermissions, + setModificationTime, setOwnerExecutable, setPermissions, ) @@ -48,6 +50,7 @@ import Test.Hspec import Tilia.Cpp.Macros (Macros (..)) import Tilia.Fixity +import Tilia.Fixity.Cache (PlanToken (..), openCache, storePackageCache) import Tilia.Fixity.PackageDb ( Installed (..), InstalledPackage (..), @@ -65,7 +68,7 @@ spec = do preparation tokens - compilerMacros + plannedMacros reexports hscModules generatedModuleSpec @@ -117,17 +120,34 @@ ] } --- | What a plan says about the macros of the compiler it is for. -compilerMacros :: Spec -compilerMacros = describe "the macros a plan settles" $ do +-- | What a plan says about macros. +plannedMacros :: Spec +plannedMacros = describe "the macros a plan settles" $ do it "has those of other compilers undefined under a plan for GHC" $ macroUndefined (macrosOf (planFor "ghc-9.10.3")) `shouldBe` Set.fromList ["__MHS__", "__HUGS__"] it "has nothing undefined under a plan for another compiler" $ macroUndefined (macrosOf (planFor "mhs-0.15.4.0")) `shouldBe` Set.empty + + it "holds every package of the plan, as its version macros spell it" $ + macroPlannedPackages (macrosOf twoPackages) + `shouldBe` Just (Set.fromList ["base", "data_default"]) where planFor compiler = BuildPlan{bpCompiler = compiler, bpPackages = []} + twoPackages = + BuildPlan + { bpCompiler = "ghc-9.10.3", + bpPackages = + [ PlanPackage + { ppName = name, + ppVersion = "1.0", + ppSource = PreExisting, + ppComponents = [] + } + | name <- ["base", "data-default"] + ] + } -- | 'Plan.checkReadiness', with the cache in use as it is by default. checkReadiness :: [PlanComponent] -> FilePath -> IO Readiness @@ -215,6 +235,25 @@ readIORef steps `shouldReturn` [solving, narrowSolve, fetching, narrowFetch] + it "does not solve again where solving left the plan as it was" $ + withChangedPackage $ \dir -> do + stale <- checkReadiness [] dir + stale `shouldBe` PlanStale [dir "thing.cabal"] + steps <- newIORef [] + prepareWith (obliging steps) (futilityFor (Do #useCache) dir) [] dir stale + `shouldReturn` Right () + readIORef steps `shouldReturn` [solving] + checkReadiness [] dir `shouldReturn` Ready + + it "solves again where a file changed after the last solve" $ + withChangedPackage $ \dir -> do + stale <- checkReadiness [] dir + steps <- newIORef [] + _ <- prepareWith (obliging steps) (futilityFor (Do #useCache) dir) [] dir stale + later <- addUTCTime 60 <$> getCurrentTime + setModificationTime (dir "thing.cabal") later + checkReadiness [] dir `shouldReturn` PlanStale [dir "thing.cabal"] + describe "a plan narrower than the run" $ do it "notices a component the plan says nothing about" $ withTempProject (Just twoComponents) $ \dir -> @@ -379,6 +418,19 @@ 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 the module's own where the module does not export it" $ + chased "module M (parser) where\ninfixr 3 <+>\n(<+>) :: Int -> Int -> Int\na <+> b = a + b\nparser :: Int\nparser = 1 <+> 2\n" + `shouldReturn` Nothing + + it "is the module's own for a constructor handed on with its type" $ do + answer <- chasedModule "module M (T (..)) where\ndata T = Int :+ Int\ninfixl 6 :+\n" + Map.lookup (InTerms, OpName ":+") (establishedFixities answer) + `shouldBe` Just (Fixity LeftAssoc 6) + + it "is not the module's own for a constructor its type is handed on without" $ do + answer <- chasedModule "module M (T) where\ndata T = Int :+ Int\ninfixl 6 :+\n" + Map.lookup (InTerms, OpName ":+") (establishedFixities answer) `shouldBe` Nothing + 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 @@ -575,6 +627,41 @@ withLayouts $ \xdg _ -> guessedPackageCacheRoot `shouldReturn` xdg + describe "and where it was remembered" $ do + it "is not asked again where the plan's tarballs are there" $ + withRemembered True $ \root asked found -> do + asked `shouldBe` [] + found `shouldBe` [root "hackage.haskell.org/thing/1.0/thing-1.0.tar.gz"] + + it "is asked again where a tarball of the plan is not there" $ + withRemembered False $ \_ asked _ -> + asked `shouldBe` ["path"] + +-- | Find the tarballs of a plan wanting one package from Hackage, where the +-- package cache was remembered to be a directory of its own, holding the +-- tarball or not, and hand over the directory, the commands the stand-in +-- for @cabal@ was given, and where each tarball was found. +withRemembered :: + Bool -> + (FilePath -> [String] -> [FilePath] -> Expectation) -> + Expectation +withRemembered holding act = + withSystemTempDirectory "tilia-remembered" $ \root -> do + let at = root "hackage.haskell.org" "thing" "1.0" + when holding $ do + createDirectoryIfMissing True at + T.writeFile (at "thing-1.0.tar.gz") "not really a tarball" + cache <- openCache (Do #useCache) (PlanToken (T.pack (takeBaseName root))) + storePackageCache cache root + withTempProject (Just (fromRepository hackage)) $ \dir -> + readBuildPlan (planPathFor dir) >>= \case + Left why -> expectationFailure (T.unpack why) + Right plan -> do + (asked, found) <- runsCabal (plannedTarballs cache plan) + act root asked (fmap snd found) + where + hackage = "{\"type\":\"secure-repo\",\"uri\":\"https://hackage.haskell.org/\"}" + -- | A plan handed over to be taken as it is. givenPlans :: Spec givenPlans = describe "a plan trusted as up to date" $ do @@ -721,9 +808,11 @@ readBuildPlan (planPathFor dir) >>= \case Left why -> expectationFailure (T.unpack why) Right plan -> - plannedTarballs plan >>= \case - [(_, found)] -> act found - other -> expectationFailure (show (fmap snd other)) + openCache (Don't #useCache) (PlanToken "") + >>= (`plannedTarballs` plan) + >>= \case + [(_, found)] -> act found + other -> expectationFailure (show (fmap snd other)) where put cabalDir (repo, held, version) = do let at = @@ -1287,6 +1376,13 @@ Map.lookup (OpName "T") members `shouldBe` Just (Set.fromList [OpName "A", OpName ":|"]) + it "reads none for a type a local module exports without them" + $ withFakeProject + [("src/Members.hs", "module Members (T) where\ndata T = A | Int :| Int\n")] + $ \rs -> do + members <- membersIn rs "Members" + Map.lookup (OpName "T") members `shouldBe` Just Set.empty + it "follows a type to the module that declares it" $ withFakeProject [ ("src/Facade.hs", "module Facade (T (..)) where\nimport Inner\n"), @@ -1591,6 +1687,17 @@ lookupFixity scope InTerms Nothing (OpName "Node") `shouldBe` Unresolved (ModuleChain ("Core" :| ["A"]) :| []) + it "brings in no operator with a type exported without its members" + $ withFakeProject + [ ("src/Ops.hs", "module Ops (T, (<+>)) where\ninfixr 1 <+>\ndata T = T\n(<+>) :: Int -> Int -> Int\na <+> b = a + b\n"), + ("src/Other.hs", "module Other ((<+>)) where\ninfixl 6 <+>\n(<+>) :: Int -> Int -> Int\na <+> b = a - b\n") + ] + $ \rs -> do + let m = parse "module C (w) where\nimport Ops (T (..))\nimport Other\nw = 1 <+> 2\n" + scope <- scopeFor rs (Is #implicitPrelude) (pure (pmModule m)) + lookupFixity scope InTerms Nothing (OpName "<+>") + `shouldBe` Resolved (Fixity LeftAssoc 6) (DeclaredIn "Other") + 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 -> @@ -1733,6 +1840,23 @@ writePlan :: FilePath -> Text -> IO () writePlan dir = T.writeFile (planPathFor dir) + +-- | A project whose @.cabal@ file changed after its plan was written, under +-- a plan of its own, so that what it leaves in the cache is its own. +withChangedPackage :: (FilePath -> IO a) -> IO a +withChangedPackage act = + withTempProject Nothing $ \dir -> do + writePlan dir $ + "{\"compiler-id\":\"ghc-0.0\",\"install-plan\":\ + \[{\"pkg-name\":\"" + <> T.pack (takeBaseName dir) + <> "\",\"pkg-version\":\"1.0\",\"component-name\":\"lib\",\ + \\"pkg-src\":{\"type\":\"local\",\"path\":\"/nowhere\"}}]}" + now <- getCurrentTime + setModificationTime (planPathFor dir) (addUTCTime (-60) now) + T.writeFile (dir "thing.cabal") "" + setModificationTime (dir "thing.cabal") (addUTCTime (-30) now) + act dir -- | A plan naming one package that no package cache can have a tarball -- for, so that reading it leaves something to fetch. diff --git a/tests/Tilia/FixitySpec.hs b/tests/Tilia/FixitySpec.hs --- a/tests/Tilia/FixitySpec.hs +++ b/tests/Tilia/FixitySpec.hs @@ -459,6 +459,10 @@ listedMembersIn "module M (T (..)) where\nimport Elsewhere\n" `shouldBe` [] + it "hands on no members of a name exported without them" $ + listedMembersIn "module M (T, U) where\nimport Elsewhere\ndata T = A | Int :| Int\n" + `shouldBe` [(OpName "T", []), (OpName "U", [])] + describe "layer 2: imports" $ do it "brings in an operator among the members of a type" $ lookupFixity (scopeWithMembers "import Members (T (..))\n") InTerms Nothing (OpName ":|") diff --git a/tests/Tilia/Gen.hs b/tests/Tilia/Gen.hs --- a/tests/Tilia/Gen.hs +++ b/tests/Tilia/Gen.hs @@ -7,8 +7,6 @@ PlainDoc (..), FlatSafeDoc (..), AnySpan (..), - SingleLineSpan (..), - MultiLineSpan (..), docTexts, ) where @@ -29,29 +27,6 @@ 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 diff --git a/tests/Tilia/WithProjectPlan.hs b/tests/Tilia/WithProjectPlan.hs --- a/tests/Tilia/WithProjectPlan.hs +++ b/tests/Tilia/WithProjectPlan.hs @@ -14,7 +14,7 @@ where import Control.Monad (filterM, unless) -import Data.Choice (pattern Do) +import Data.Choice (pattern Do, pattern Don't) import Data.Maybe (isNothing, listToMaybe, mapMaybe) import Data.Set (Set) import Data.Set qualified as Set @@ -31,6 +31,7 @@ componentsOfTarget, describeTargetProblem, ) +import Tilia.Fixity.Cache (PlanToken (..), openCache) import Tilia.Fixity.PackageDb ( Installed (..), InstalledPackage (..), @@ -76,11 +77,12 @@ fetchMissingSources :: BuildPlan -> IO () fetchMissingSources plan = do installed <- readInstalledPackages + noCache <- openCache (Don't #useCache) (PlanToken "") let unread = modulelessIn installed absent <- filterM (fmap not . doesFileExist . snd) . filter (not . (`Set.member` unread) . ppName . fst) - =<< plannedTarballs plan + =<< plannedTarballs noCache plan unless (null absent) $ do putStrLn ("fetching the source of " <> show (length absent) <> " package(s)") refused <- filterM (fmap isNothing . fetch . fst) absent diff --git a/tilia.cabal b/tilia.cabal --- a/tilia.cabal +++ b/tilia.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: tilia -version: 0.1.0.0 +version: 0.1.1.0 license: BSD-3-Clause license-file: LICENSE.md maintainer: Mark Karpov @@ -252,6 +252,7 @@ temporary ^>=1.3, text >=2.1 && <3, tilia, + time >=1.9 && <1.16, zlib >=0.6 && <0.8, ghc-options: