arch-hs 0.16.1 → 0.16.2
raw patch · 21 files changed
+821/−253 lines, 21 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Distribution.ArchHs.Compat: pattern ZeroBSD :: LicenseId
+ Distribution.ArchHs.Local: ghcPlaceholderVersions :: Map Version (Map PackageName Version)
+ Distribution.ArchHs.Name: ghcProvidedPackages :: ExtraDB -> Set PackageName
+ Distribution.ArchHs.PkgDesc: [_buildDate] :: PkgDesc -> Maybe Integer
+ Distribution.ArchHs.Types: [_buildDate] :: PkgDesc -> Maybe Integer
- Distribution.ArchHs.PkgDesc: PkgDesc :: ArchLinuxName -> ArchLinuxVersion -> ArchLinuxVersion -> String -> Maybe String -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDesc
+ Distribution.ArchHs.PkgDesc: PkgDesc :: ArchLinuxName -> ArchLinuxVersion -> ArchLinuxVersion -> Maybe Integer -> String -> Maybe String -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDesc
- Distribution.ArchHs.Types: PkgDesc :: ArchLinuxName -> ArchLinuxVersion -> ArchLinuxVersion -> String -> Maybe String -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDesc
+ Distribution.ArchHs.Types: PkgDesc :: ArchLinuxName -> ArchLinuxVersion -> ArchLinuxVersion -> Maybe Integer -> String -> Maybe String -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDependentList -> PkgDesc
Files
- CHANGELOG.md +14/−0
- README.md +41/−90
- arch-hs.cabal +4/−1
- cbits/clib.c +3/−2
- cbits/clib.h +4/−1
- diff/Diff.hs +25/−28
- plan/Plan.hs +46/−39
- src/Distribution/ArchHs/Compat.hs +10/−0
- src/Distribution/ArchHs/ExtraDB.hs +38/−15
- src/Distribution/ArchHs/Local.hs +40/−1
- src/Distribution/ArchHs/Name.hs +14/−0
- src/Distribution/ArchHs/PkgBuild.hs +3/−6
- src/Distribution/ArchHs/PkgDesc.hs +4/−0
- src/Distribution/ArchHs/Types.hs +1/−0
- sync/Args.hs +1/−15
- sync/Check.hs +36/−15
- sync/Check/Options.hs +43/−0
- sync/Main.hs +7/−9
- sync/Submit.hs +6/−3
- test/Main.hs +402/−9
- test/PlanSpec.hs +79/−19
CHANGELOG.md view
@@ -3,6 +3,20 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.16.2++- Show `arch-hs-diff` metadata, dependency, and flag changes together in the existing report, with `-`/`+` markers and unchanged entries shown once, while retaining repository dependency checks++- Recognize `rts` and `system-cxx-std-lib` as part of GHC, and honor compiler `provides` metadata consistently in sync checks, Hackage distribution links, and ordinary update planning without excluding standalone versions of newer bundled libraries++- Resolve compiler-provided dependency versions in `arch-hs-plan`, `arch-hs-diff`, and sync dependency checks even when repository aliases are missing, using known GHC placeholder versions without bypassing version bounds++- Add `arch-hs-sync check --sort name|updated|pkgrel` and `--reverse`, using Arch build timestamps (newest first) or numeric package release numbers (lowest first)++- Preserve shell line continuations and spacing in generated PKGBUILDs by keeping Cabal license compatibility CPP outside the template module++- Combine planned update commit messages and `genrebuild -H` into a copyable `dorebuild 'rebuild with ...'` command+ ## 0.16.1 - Count existing direct dependency failures as `dep-old` warnings in `arch-hs-sync check --depcheck`, keeping only newly unmet dependencies blocking
README.md view
@@ -422,100 +422,30 @@ By default, `arch-hs-diff` reads revision 0 cabal files from the local Hackage index. `-h`/`--hackage` can be used to specify the index tarball path. Use `--online` to download revision 0 cabal files from Hackage instead.-This is useful in the subsequent maintenance of a package. For example: -```-$ arch-hs-diff comonad 5.0.6 5.0.7-ⓘ Loading extra.db from /var/lib/pacman/sync/extra.db-ⓘ Loading hackage from /home/berberman/.cabal/packages/hackage.haskell.org/01-index.tar-ⓘ Start running...-ⓘ Reading revision 0 cabal file from /home/berberman/.cabal/packages/hackage.haskell.org/01-index.tar: comonad/5.0.6/comonad.cabal-ⓘ Reading revision 0 cabal file from /home/berberman/.cabal/packages/hackage.haskell.org/01-index.tar: comonad/5.0.7/comonad.cabal-Package: comonad-Version: 5.0.6 ⇒ 5.0.7-Synopsis: Comonads-URL: http://github.com/ekmett/comonad/-Depends:- base >=4 && <5- containers >=0.3 && <0.7- distributive >=0.2.2 && <1- tagged >=0.7 && <1- transformers >=0.2 && <0.6- transformers-compat >=0.3 && <1---------------------------------------- base >=4 && <5- containers >=0.3 && <0.7- distributive >=0.2.2 && <1- indexed-traversable >=0.1 && <0.2- tagged >=0.7 && <1- transformers >=0.2 && <0.6- transformers-compat >=0.3 && <1- -MakeDepends:- base -any- doctest >=0.11.1 && <0.17---------------------------------------- base -any- doctest >=0.11.1 && <0.18-"doctest" is required to be in range (>=0.11.1 && <0.17), but [extra] provides (0.17). -Flags:- comonad- ⚐ test-doctests:- description:- - default: True- isManual: True- ⚐ containers:- description:- You can disable the use of the `containers` package using `-f-containers`.-- Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users.- default: True- isManual: True- ⚐ distributive:- description:- You can disable the use of the `distributive` package using `-f-distributive`.-- Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users.-- If disabled we will not supply instances of `Distributive`-- default: True- isManual: True---------------------------------------- comonad- ⚐ test-doctests:- description:- - default: True- isManual: True- ⚐ containers:- description:- You can disable the use of the `containers` package using `-f-containers`.-- Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users.- default: True- isManual: True- ⚐ distributive:- description:- You can disable the use of the `distributive` package using `-f-distributive`.-- Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users.-- If disabled we will not supply instances of `Distributive`+Changes appear together within the metadata, `Depends`, `MakeDepends`, and `Flags` sections. Removed lines are prefixed with `-`, added lines with `+`, and unchanged entries appear once. Flag descriptions, defaults, and manual settings are compared line by line. Repository dependency warnings remain below the relevant dependency section. This format is used with both the local index and `--online`. - default: True- isManual: True- ⚐ indexed-traversable:- description:- You can disable the use of the `indexed-traversable` package using `-f-indexed-traversable`.+For example: - Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users.+```+$ arch-hs-diff minisat 0.1.3 0.1.4+Package: minisat+- Version: 0.1.3++ Version: 0.1.4+Synopsis: A Haskell bundle of the Minisat SAT solver+License: BSD-3-Clause+URL: https://github.com/jbransen/minisat-bundle.git+Depends:+ - async >=0+ + async >=2.0.0.0+ base >=3 && <5+ + system-cxx-std-lib ==1.0 - If disabled we will not supply instances of `FunctorWithIndex`+MakeDepends:+ [] - default: True- isManual: True+Flags:+ [] ✔ Success! ``` @@ -612,8 +542,14 @@ The output lists installed and proposed versions, marking automatically included packages with `(added by solver)`. It also shows the number of candidate sets checked and any blocking dependency or reverse dependency ranges. If no working set can be found, it reports the remaining conflicts and exits unsuccessfully. -Plans with version changes also print a commit message listing all updated packages and versions on one comma-separated line, including packages added by the solver. A copyable `genrebuild -H <pkgbases...>` command follows, using the corresponding Arch package bases of all packages in the plan and respecting package name presets. Blocked plans include both too, so their updates can be tried manually.+Plans with version changes also print a copyable full rebuild command, combining a `rebuild with ...` commit message listing all updated packages and versions (including packages added by the solver) with `genrebuild -H` using the corresponding Arch package bases of all packages in the plan and respecting package name presets: +```sh+dorebuild 'rebuild with dbus 1.3.4, network 3.2.0.0' `genrebuild -H haskell-dbus haskell-network`+```++Blocked plans include the command too, so their updates can be tried manually. Plans with no version changes omit it.+ The planner compares the latest Cabal revision with revision 0 for the chosen packages and their reverse dependencies, showing only dependencies whose check outcomes change. Range-only differences are hidden when both revisions pass, block, warn, or remain unchecked; adding or removing an already-satisfied dependency is also hidden. Changes between those outcomes, including whether a revision can be checked, remain visible. Version selection and the final status use the latest revision; revision 0 is shown for comparison. Existing repository incompatibilities are yellow `dep-old` or `rdep-old` warnings and do not block a plan. Missing metadata for existing reverse dependencies is reported as an unchecked warning. Newly introduced incompatibilities and missing or unparseable candidate metadata still block the plan.@@ -622,6 +558,10 @@ The planner reads the latest revisions from the local Hackage index and accepts the usual `--extra` and `--hackage` paths. It does not build or install packages, validate non-Haskell system dependencies or ABI compatibility, or determine a build order. GHC and its bundled libraries remain fixed unless `ghc` is explicitly requested. Only GHC plans fetch upstream metadata; ordinary package plans remain local. A GHC plan checks ecosystem metadata compatibility, not compiler bootstrap requirements or Arch-specific changes to the upstream bundle. Refresh the local databases before planning against newer repository or Hackage metadata. +Ordinary plans also keep packages provided by the repository's `ghc` and `ghc-libs` fixed, including compiler tools. Libraries added in newer GHC releases, such as `os-string`, `file-io`, and `haddock-library`, remain independently upgradable when installed as standalone packages with an older compiler. The compiler's `rts` and `system-cxx-std-lib` packages are always treated as part of GHC, even when absent from repository `provides` metadata.++Dependency version checks in the planner, diff, and sync commands also resolve compiler `provides` entries when their package aliases are missing. For `rts` and `system-cxx-std-lib`, known GHC release metadata supplies fallback versions when Arch omits the entries entirely. These fallbacks use the compiler version in the selected repository database and retain dependency range checks; they require neither the host compiler nor a network lookup. Unknown compiler releases require explicit repository version metadata.+ ## Sync For Hackage distribution maintainers, `arch-hs-sync check` compares Haskell package versions in [extra] with Hackage:@@ -634,6 +574,17 @@ Only non-deprecated Hackage versions newer than the [extra] version are reported. Version checks use Hackage index metadata, so they also report packages whose `.cabal` format is newer than the Cabal library used to build `arch-hs`. GHC and its bundled libraries and tools, including `hsc2hs`, are excluded by default because they are updated with the compiler rather than independently. This includes packages listed in the repository `provides` metadata for `ghc` and `ghc-libs`. Pass `--show-ghc-libs` to include them.++This also excludes `rts` and `system-cxx-std-lib`, GHC's placeholder package for the system C++ standard library, even when the repository omits their `provides` entries. Other libraries introduced in newer compiler bundles are excluded when the installed GHC packages provide them; standalone packages remain visible. Hackage distribution CSV entries use the same classification to link compiler-provided packages to GHC.++Use `--sort name` for alphabetical Arch package names, `--sort updated` for the newest Arch builds first, or `--sort pkgrel` for the lowest Arch package release numbers first. Add `--reverse` for the opposite order, for example:++```+$ arch-hs-sync check --sort updated --reverse+$ arch-hs-sync check --depcheck --sort pkgrel+```++`updated` uses the package's build timestamp from the local `extra.db`, including when loading through `--alpm`; it does not fetch the Arch website's last-update time. Package releases are compared numerically, including subreleases such as `2.1`. Equal sort values use alphabetical Arch package names, and missing or invalid values always appear last. Without `--sort`, the existing package order is preserved. Sorting also works with `--depcheck` and `--verbose`, keeping each package's details together. Pass `--depcheck` to check whether each newer Hackage version is currently upgradable with the packages already in [extra]. A version is shown as `ok` only when both its dependency ranges are satisfied by [extra] and all current reverse dependency ranges accept that version:
arch-hs.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: arch-hs-version: 0.16.1+version: 0.16.2 synopsis: Distribute hackage packages to archlinux description: @arch-hs@ is a command-line program, which simplifies the process of producing@@ -150,6 +150,7 @@ other-modules: Args Check+ Check.Options Submit Submit.CSV Utils@@ -197,6 +198,7 @@ main-is: Main.hs other-modules: Check+ Check.Options Diff Plan Plan.Args@@ -206,6 +208,7 @@ PlanSpec RDepCheck RDepCheck.Args+ Submit Submit.CSV Utils
cbits/clib.c view
@@ -32,6 +32,7 @@ const char *ver = alpm_pkg_get_version(i->data); const char *desc = alpm_pkg_get_desc(i->data); const char *url = alpm_pkg_get_url(i->data);+ alpm_time_t builddate = alpm_pkg_get_builddate(i->data); alpm_list_t *depends = alpm_pkg_get_depends(i->data); alpm_list_t *makedepends = alpm_pkg_get_makedepends(i->data); alpm_list_t *checkdepends = alpm_pkg_get_checkdepends(i->data);@@ -39,7 +40,7 @@ alpm_list_t *conflicts = alpm_pkg_get_conflicts(i->data); alpm_list_t *replaces = alpm_pkg_get_replaces(i->data); alpm_list_t *optdepends = alpm_pkg_get_optdepends(i->data);- pkg_callback(name, ver, desc, url);+ pkg_callback(name, ver, desc, url, builddate); if (strcmp(name, "ghc") == 0 || strcmp(name, "ghc-libs") == 0) { alpm_list_t *v, *provides; provides = alpm_pkg_get_provides(i->data);@@ -48,7 +49,7 @@ const char *d_name = d->name; const char *d_ver = d->version; // promote- pkg_callback(d_name, d_ver, "", "");+ pkg_callback(d_name, d_ver, "", "", builddate); } }
cbits/clib.h view
@@ -1,9 +1,12 @@ #ifndef CLIB_H #define CLIB_H +#include <stdint.h>+ typedef void file_callback_t(const char *pkg_name, const char *file_path); typedef void extra_pkg_callback_t(const char *pkg_name, const char *version,- const char *desc, const char *url);+ const char *desc, const char *url,+ int64_t builddate); typedef void extra_list_callback_t(const char *pkg_name, const char *key, const char *dependent_pkg_name, const char *dependent_pkg_version);
diff/Diff.hs view
@@ -16,6 +16,7 @@ import Data.IORef (modifyIORef', newIORef, readIORef) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes)+import qualified Data.Text as Text import Conduit import Distribution.ArchHs.DepCheck import Distribution.ArchHs.Exception@@ -123,11 +124,10 @@ diffTerm :: String -> (a -> String) -> a -> a -> Doc AnsiStyle diffTerm s f a b = let (ra, rb) = (f a, f b)- in annMagneta (pretty s) <> colon- <+> ( if ra == rb- then pretty ra- else ppFromTo 2 (annRed (pretty ra)) (annGreen (pretty rb))- )+ heading = pretty s <> colon+ in if ra == rb+ then annMagneta heading <+> pretty ra+ else vsep [annRed $ "-" <+> heading <+> pretty ra, annGreen $ "+" <+> heading <+> pretty rb] desc :: PackageDescription -> PackageDescription -> Doc AnsiStyle desc = diffTerm "Synopsis" $ fromShortText . synopsis@@ -174,35 +174,32 @@ old <- fmap (pp False) <$> mapM inRange diffOld return $ vsep [cat $ catMaybes old, cat $ catMaybes new] +ppUnified :: [Text.Text] -> [Text.Text] -> Doc AnsiStyle+ppUnified before after = indent 2 $+ case renderChanges $ getGroupedDiff before after of+ [] -> "[]"+ changes -> vsep changes+ where+ renderChanges (Second added : First removed : rest) = renderChanges $ First removed : Second added : rest+ renderChanges (change : rest) =+ (case change of+ First removed -> fmap (annRed . ("-" <+>) . pretty) removed+ Second added -> fmap (annGreen . ("+" <+>) . pretty) added+ Both unchanged _ -> fmap ((" " <+>) . pretty) unchanged)+ <> renderChanges rest+ renderChanges [] = []+ dep :: Doc AnsiStyle -> VersionedList -> VersionedList -> Doc AnsiStyle dep s va vb = annMagneta s <> colon <> line- <> if noDiff diff- then joinToString da- else- joinToString da- <> splitLine- <> joinToString db+ <> ppUnified (joinVersionWithName <$> va) (joinVersionWithName <$> vb) where- a = joinVersionWithName <$> va- b = joinVersionWithName <$> vb- da = mconcat $ ppDiffColored <$> filterFirstAndBothDiff diff- db = mconcat $ ppDiffColored <$> filterSecondAndBothDiff diff- diff = getGroupedDiff a b- joinToString [] = indent 2 "[]"- joinToString xs = indent 2 $ vsep xs- joinVersionWithName (n, range) = unPackageName n <> " " <> prettyShow range+ joinVersionWithName (name, range) = Text.pack $ unPackageName name <> " " <> prettyShow range flags :: PackageName -> [PkgFlag] -> [PkgFlag] -> Doc AnsiStyle flags name a b = annMagneta "Flags" <> colon <> line- <> if noDiff diff- then joinToString a- else- joinToString a- <> splitLine- <> joinToString b+ <> ppUnified (flagLines a) (flagLines b) where- diff = getGroupedDiff a b- joinToString [] = indent 2 "[]"- joinToString xs = indent 2 $ prettyFlags [(name, xs)]+ flagLines [] = []+ flagLines xs = Text.lines $ render $ unAnnotate $ prettyFlags [(name, xs)]
plan/Plan.hs view
@@ -20,7 +20,7 @@ import Distribution.ArchHs.Hackage import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Local (ghcLibList)-import Distribution.ArchHs.Name (isGHCLibs, isHaskellPackage, toArchLinuxName, toHackageName)+import Distribution.ArchHs.Name (ghcProvidedPackages, isGHCLibs, isHaskellPackage, toArchLinuxName, toHackageName) import Distribution.ArchHs.PP import Distribution.ArchHs.RDepCheck import Distribution.ArchHs.Types@@ -62,31 +62,35 @@ planUpdates releases solve targets | null targets = pure $ Left "At least one target is required." | length names /= Set.size (Set.fromList names) = pure $ Left "Each target must be specified only once."- | any (\name -> name /= "ghc" && isGHCLibs name) names = pure $ Left "GHC bundled libraries cannot be updated independently; request ghc to update the toolchain." | otherwise = do- tracePlan "Selecting starting versions..."- installed <- Map.fromList <$> forM names (\name -> (name,) <$> currentVersion name)- choices <- forM targets $ \(name, requested) -> do- newer <- if not solve && requested /= Nothing then pure [] else- if name == "ghc"- then pure [release | release <- Map.keys releases, stableGHCRelease release, release > installed Map.! name]- else getNewerVersions name (installed Map.! name)- pure $ case requested of- Just version- | version < installed Map.! name -> Left $ "Downgrades are not supported: " <> unPackageName name- | name == "ghc", Map.notMember version releases -> Left $ "No upstream bundled-library metadata for GHC " <> prettyShow version- | otherwise -> Right (name, version : [v | solve, v <- newer, v > version])- Nothing -> case newer of- [] -> Left $ if name == "ghc" then "No newer stable GHC release is available in upstream metadata." else "No newer preferred version is available for " <> unPackageName name- first : rest -> Right (name, first : [v | solve, v <- rest])- case sequence choices of- Left err -> pure $ Left err- Right options -> do- initial <- selectToolchain releases (Map.fromList [(name, first) | (name, first : _) <- options]) emptyDependencies- let bundled = Set.unions [Map.keysSet packages | release <- fromMaybe [] $ lookup "ghc" options, Just packages <- [Map.lookup release releases]]- if any (\name -> name /= "ghc" && (Set.member name bundled || fixedPackage initial name)) names- then pure $ Left "Bundled libraries and compiler tools cannot be updated independently of the requested GHC releases."- else Right <$> search releases solve installed (Map.fromList options)+ extra <- ask @ExtraDB+ let provided = ghcProvidedPackages extra+ if any (\name -> name /= "ghc" && Set.member name provided) names+ then pure $ Left "GHC bundled libraries and compiler tools cannot be updated independently; request ghc to update the toolchain."+ else do+ tracePlan "Selecting starting versions..."+ installed <- Map.fromList <$> forM names (\name -> (name,) <$> currentVersion name)+ choices <- forM targets $ \(name, requested) -> do+ newer <- if not solve && requested /= Nothing then pure [] else+ if name == "ghc"+ then pure [release | release <- Map.keys releases, stableGHCRelease release, release > installed Map.! name]+ else getNewerVersions name (installed Map.! name)+ pure $ case requested of+ Just version+ | version < installed Map.! name -> Left $ "Downgrades are not supported: " <> unPackageName name+ | name == "ghc", Map.notMember version releases -> Left $ "No upstream bundled-library metadata for GHC " <> prettyShow version+ | otherwise -> Right (name, version : [v | solve, v <- newer, v > version])+ Nothing -> case newer of+ [] -> Left $ if name == "ghc" then "No newer stable GHC release is available in upstream metadata." else "No newer preferred version is available for " <> unPackageName name+ first : rest -> Right (name, first : [v | solve, v <- rest])+ case sequence choices of+ Left err -> pure $ Left err+ Right options -> do+ initial <- selectToolchain releases (Map.fromList [(name, first) | (name, first : _) <- options]) $ emptyDependencies extra+ let bundled = Set.unions [Map.keysSet packages | release <- fromMaybe [] $ lookup "ghc" options, Just packages <- [Map.lookup release releases]]+ if any (\name -> name /= "ghc" && (Set.member name bundled || fixedPackage initial name)) names+ then pure $ Left "Bundled libraries and compiler tools cannot be updated independently of the requested GHC releases."+ else Right <$> search releases solve installed (Map.fromList options) where names = fst <$> targets @@ -101,13 +105,14 @@ cachedDependencyVariants :: Map.Map (PackageName, Version, [Bool]) (Either MyException (VersionedList, VersionedList)), cachedExistingDependencies :: Map.Map PackageName ExistingDependencies, cachedCandidateChecks :: Map.Map (Version, PackageName, Version, Bool, Map.Map PackageName Version) ([PlanProblem], [PlanProblem]),- cachedToolchain :: Maybe Toolchain+ cachedToolchain :: Maybe Toolchain,+ cachedGHCProvided :: Set.Set PackageName } type ExistingDependencies = Map.Map (DepSrc, PackageName) (VersionRange, Maybe Version) type ReverseChecks = [(PackageName, [ReverseDep], [SkippedReverseDep])] -emptyDependencies :: DependencyCache-emptyDependencies = DependencyCache Map.empty Map.empty Map.empty Map.empty Map.empty Nothing+emptyDependencies :: ExtraDB -> DependencyCache+emptyDependencies extra = DependencyCache Map.empty Map.empty Map.empty Map.empty Map.empty Nothing (ghcProvidedPackages extra) selectToolchain :: PlanEffects r => GHCReleases -> Map.Map PackageName Version -> DependencyCache -> Sem r DependencyCache selectToolchain releases selected cache = case Map.lookup "ghc" selected of@@ -137,7 +142,7 @@ pure cache {cachedToolchain = Just $ Toolchain release packages installed tools} fixedPackage :: DependencyCache -> PackageName -> Bool-fixedPackage cache name = maybe (isGHCLibs name) (`toolchainContains` name) $ cachedToolchain cache+fixedPackage cache name = maybe (Set.member name $ cachedGHCProvided cache) (`toolchainContains` name) $ cachedToolchain cache unknownCompilerTool :: DependencyCache -> PackageName -> Bool unknownCompilerTool cache name = maybe False (Set.member name . toolchainTools) $ cachedToolchain cache@@ -222,7 +227,7 @@ isHaskellPackage $ _name desc, dependency <- _depends desc <> _makeDepends desc <> _checkDepends desc ]- (requiredRanges, origins, dependencies) <- if updatingGHC then pure (Map.empty, Map.empty, emptyDependencies) else requestedRanges choices emptyDependencies+ (requiredRanges, origins, dependencies) <- if updatingGHC then pure (Map.empty, Map.empty, emptyDependencies extra) else requestedRanges choices (emptyDependencies extra) let initial = SearchCache installed choices dependencies Map.empty reversePackages Map.empty requiredRanges origins Map.empty Map.empty Map.empty tracePlan "Propagating dependency constraints..." (conflict, directCache) <- if solve && not updatingGHC then propagateRanges False (Map.keysSet choices) initial else pure (Nothing, initial)@@ -405,7 +410,7 @@ cache ) Nothing- | not solve || isGHCLibs name -> pure (neighbors, cache)+ | not solve || fixedPackage (searchDependencies cache) name -> pure (neighbors, cache) | otherwise -> do cache' <- discoverVersions name cache pure ([(name, Map.insert name 0 indices) | not $ null $ searchChoices cache' Map.! name] <> neighbors, cache')@@ -685,7 +690,7 @@ pure (RepairBound minimumFailures repairs compilerFailures, restored) domain name cache- | isGHCLibs name || unknownCompilerTool (searchDependencies cache) name = pure ([], cache)+ | Set.member name (cachedGHCProvided $ searchDependencies cache) || unknownCompilerTool (searchDependencies cache) name = pure ([], cache) | otherwise = do known <- discoverVersions name cache let versions = Map.findWithDefault [] name $ searchChoices known@@ -917,10 +922,10 @@ if Set.notMember name requested && maybe False (`withinRange` required) current then go rest examined withCurrent else do- known <- if isGHCLibs name then pure withCurrent else discoverVersions name withCurrent+ known <- if fixedPackage (searchDependencies withCurrent) name then pure withCurrent else discoverVersions name withCurrent let available | Set.member name requested = searchChoices known Map.! name- | isGHCLibs name = maybe [] pure current+ | fixedPackage (searchDependencies known) name = maybe [] pure current | otherwise = maybe [] pure current <> Map.findWithDefault [] name (searchChoices known) inRange = filter (`withinRange` required) available (eligible, known') <- if includeReverse then compatibleReleases name inRange known else pure (inRange, known)@@ -968,7 +973,7 @@ foldM force initial $ Set.toList $ Map.findWithDefault Set.empty (toArchLinuxName target) (searchReversePackages initial) where force cache archName- | isGHCLibs (toHackageName archName) = pure cache+ | fixedPackage (searchDependencies cache) (toHackageName archName) = pure cache | otherwise = do let owner = toHackageName archName installed <- try @MyException $ currentVersion owner@@ -1222,7 +1227,7 @@ comparePlanRevisions :: PlanEffects r => RawHackageDB -> PlanResult -> Sem r PlanResult comparePlanRevisions original plan = do extra <- ask @ExtraDB- let emptyCache = emptyDependencies {cachedToolchain = planToolchain plan}+ let emptyCache = (emptyDependencies extra) {cachedToolchain = planToolchain plan} (notes, _, _) <- foldM compareOwner ([], emptyCache, emptyCache) (revisionOwners extra plan) pure plan {planRevisionNotes = reverse notes} where@@ -1337,9 +1342,11 @@ <> (prettyWarning <$> planWarnings) <> [line <> vsep planSearchNotes | not $ null planSearchNotes] <> [line <> vsep planRevisionNotes | not $ null planRevisionNotes]- <> [ line <> "Commit message:" <> line <> pretty (intercalate ", " updates)- <> line <> line <> ("genrebuild -H"- <+> hsep [if name == "ghc" then "ghc" else pretty $ unArchLinuxName $ toArchLinuxName name | name <- Map.keys planVersions])+ <> [ line <> "Rebuild command:" <> line+ <> ("dorebuild" <+> squotes ("rebuild with" <+> pretty (intercalate ", " updates))+ <+> ("`genrebuild -H"+ <+> hsep [if name == "ghc" then "ghc" else pretty $ unArchLinuxName $ toArchLinuxName name | name <- Map.keys planVersions]+ <> "`")) | not $ null updates ] where
src/Distribution/ArchHs/Compat.hs view
@@ -4,11 +4,14 @@ module Distribution.ArchHs.Compat ( pattern PkgFlag, PkgFlag,+ pattern ZeroBSD, licenseFile, ) where import Data.Maybe (listToMaybe)+import Distribution.SPDX.LicenseId (LicenseId)+import qualified Distribution.SPDX.LicenseId as SPDX import Distribution.Types.ConfVar import Distribution.Types.Flag import Distribution.Types.PackageDescription (PackageDescription, licenseFiles)@@ -19,6 +22,13 @@ type PkgFlag = PackageFlag pattern PkgFlag x = PackageFlag x++pattern ZeroBSD :: LicenseId+#if MIN_VERSION_Cabal_syntax(3,16,0)+pattern ZeroBSD = SPDX.N_0BSD+#else+pattern ZeroBSD = SPDX.NullBSD+#endif licenseFile :: PackageDescription -> Maybe FilePath licenseFile = fmap getSymbolicPath . listToMaybe . licenseFiles
src/Distribution/ArchHs/ExtraDB.hs view
@@ -25,9 +25,10 @@ import qualified Data.Conduit.Tar as Tar import qualified Data.Conduit.Zlib as Zlib import qualified Data.Map.Strict as Map-import Data.Maybe (mapMaybe)+import Data.Maybe (listToMaybe, mapMaybe) import Distribution.ArchHs.Exception import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Local (ghcPlaceholderVersions) import Distribution.ArchHs.Name import Distribution.ArchHs.PkgDesc import Distribution.ArchHs.Types@@ -35,27 +36,32 @@ ----------------------------------------------------------------------------- #ifdef ALPM+import Data.Int (Int64) import Data.IORef (IORef, modifyIORef', newIORef, readIORef) import Distribution.ArchHs.Utils (extractFromEVR) import Foreign.C.String (CString, peekCString) import Foreign.Ptr (FunPtr, freeHaskellFunPtr) foreign import ccall "wrapper"- wrap :: (CString -> CString -> CString -> CString -> IO ()) -> IO (FunPtr (CString -> CString -> CString -> CString -> IO ()))+ wrapPkg :: (CString -> CString -> CString -> CString -> Int64 -> IO ()) -> IO (FunPtr (CString -> CString -> CString -> CString -> Int64 -> IO ())) +foreign import ccall "wrapper"+ wrapList :: (CString -> CString -> CString -> CString -> IO ()) -> IO (FunPtr (CString -> CString -> CString -> CString -> IO ()))+ foreign import ccall "clib.h query_extra"- query_extra :: FunPtr (CString -> CString -> CString -> CString -> IO ()) -> FunPtr (CString -> CString -> CString -> CString -> IO ()) -> IO ()+ query_extra :: FunPtr (CString -> CString -> CString -> CString -> Int64 -> IO ()) -> FunPtr (CString -> CString -> CString -> CString -> IO ()) -> IO () -type RawPkgSet = IORef (Map.Map ArchLinuxName ((ArchLinuxVersion, ArchLinuxVersion, String, String), IORef (Map.Map String [(ArchLinuxName, Maybe ArchLinuxVersion)])))+type RawPkgSet = IORef (Map.Map ArchLinuxName ((ArchLinuxVersion, ArchLinuxVersion, String, String, Maybe Integer), IORef (Map.Map String [(ArchLinuxName, Maybe ArchLinuxVersion)]))) -pkgCallback :: RawPkgSet -> CString -> CString -> CString -> CString -> IO ()-pkgCallback ref name version desc url = do+pkgCallback :: RawPkgSet -> CString -> CString -> CString -> CString -> Int64 -> IO ()+pkgCallback ref name version desc url buildDate = do name' <- peekCString name version' <- peekCString version desc' <- peekCString desc url' <- peekCString url m <- newIORef Map.empty- modifyIORef' ref (Map.insert (ArchLinuxName name') ((extractFromEVR version', version', desc', url'), m))+ let buildDate' = if buildDate > 0 then Just (toInteger buildDate) else Nothing+ modifyIORef' ref (Map.insert (ArchLinuxName name') ((extractFromEVR version', version', desc', url', buildDate'), m)) listCallback :: RawPkgSet -> CString -> CString -> CString -> CString -> IO () listCallback ref name key dm dv = do@@ -70,15 +76,15 @@ loadExtraDBFFI :: IO ExtraDB loadExtraDBFFI = do ref <- newIORef Map.empty- pkgCallbackW <- wrap $ pkgCallback ref- listCallbackW <- wrap $ listCallback ref+ pkgCallbackW <- wrapPkg $ pkgCallback ref+ listCallbackW <- wrapList $ listCallback ref query_extra pkgCallbackW listCallbackW freeHaskellFunPtr pkgCallbackW freeHaskellFunPtr listCallbackW s <- readIORef ref re <- mapM- ( \(name, ((ver, rawVer, desc, url), r)) -> do+ ( \(name, ((ver, rawVer, desc, url, buildDate), r)) -> do l <- readIORef r let f (Just xs) = uncurry PkgDependent <$> xs f Nothing = []@@ -88,6 +94,7 @@ { _name = name, _version = ver, _rawVersion = rawVer,+ _buildDate = buildDate, _desc = desc, _url = if null url then Nothing else Just url, _depends = f $ l Map.!? "depends",@@ -124,7 +131,7 @@ desc : ( if _name desc == ArchLinuxName "ghc" || _name desc == ArchLinuxName "ghc-libs"- then mapMaybe promoteDependent (_provides desc)+ then map (\provided -> provided {_buildDate = _buildDate desc}) $ mapMaybe promoteDependent (_provides desc) else [] ) -- Drop it if failed to parse@@ -143,15 +150,31 @@ isInExtra :: (HasMyName n, Member ExtraEnv r) => n -> Sem r Bool isInExtra name = ask @ExtraDB >>= \db -> return $ toArchLinuxName name `Map.member` db --- | Get the version of a package in archlinux extra repo.+-- | Get the version of a repository package or compiler-provided library. -- If the package does not exist, 'PkgNotFound' will be thrown. versionInExtra :: (HasMyName n, Members [ExtraEnv, WithMyErr] r) => n -> Sem r ArchLinuxVersion versionInExtra name = _version <$> getPkgDesc name --- | Get the pkgdesc a package in archlinux extra repo.+-- | Get the description of a repository package or compiler-provided library. -- If the package does not exist, 'PkgNotFound' will be thrown. getPkgDesc :: (HasMyName n, Members [ExtraEnv, WithMyErr] r) => n -> Sem r PkgDesc-getPkgDesc name =- ask @ExtraDB >>= \db -> case db Map.!? toArchLinuxName name of+getPkgDesc name = do+ db <- ask @ExtraDB+ let providers = mapMaybe (\provider -> Map.lookup (ArchLinuxName provider) db) ["ghc", "haskell-ghc", "ghc-libs"]+ provided = listToMaybe+ [ promoted {_buildDate = _buildDate provider}+ | provider <- providers,+ dependency <- _provides provider,+ _pdName dependency == toArchLinuxName name,+ Just promoted <- [promoteDependent dependency]+ ]+ placeholder = do+ provider <- listToMaybe providers+ compiler <- simpleParsec $ _version provider+ packages <- Map.lookup compiler ghcPlaceholderVersions+ version <- Map.lookup (toHackageName name) packages+ promoted <- promoteDependent $ PkgDependent (toArchLinuxName name) (Just $ prettyShow version)+ pure promoted {_buildDate = _buildDate provider}+ case Map.lookup (toArchLinuxName name) db <|> provided <|> placeholder of Just x -> pure x _ -> throw $ PkgNotFound name
src/Distribution/ArchHs/Local.hs view
@@ -7,11 +7,14 @@ module Distribution.ArchHs.Local ( ignoreList, ghcLibList,+ ghcPlaceholderVersions, ) where +import qualified Data.Map.Strict as Map import Distribution.ArchHs.Types import Distribution.Types.PackageName+import Distribution.Types.Version (Version, mkVersion) -- | Packages should be dropped in dependency resolving. ignoreList :: PkgList@@ -39,7 +42,7 @@ "unzip" ] --- | Packages already provided by <https://www.archlinux.org/packages/extra/x86_64/ghc-libs/ ghc-libs>.+-- | Packages provided by GHC, including runtime and system-library placeholders. ghcLibList :: PkgList ghcLibList = mkPackageName@@ -69,7 +72,9 @@ "parsec", "pretty", "process",+ "rts", "stm",+ "system-cxx-std-lib", "template-haskell", "terminfo", "text",@@ -78,3 +83,37 @@ "unix", "xhtml" ]++-- | Versions omitted from Arch's compiler provides, from Stackage's+-- @stack/global-hints.yaml@. Unknown compiler releases have no fallback.+ghcPlaceholderVersions :: Map.Map Version (Map.Map PackageName Version)+ghcPlaceholderVersions = Map.fromList+ [ ( compiler,+ Map.fromList $+ [(mkPackageName "rts", mkVersion runtime)]+ <> [(mkPackageName "system-cxx-std-lib", mkVersion [1, 0]) | compiler >= mkVersion [9, 4, 1]]+ )+ | (major, minor, patches, runtime) <-+ [ (7, 8, [3, 4], [1, 0]),+ (7, 10, [1 .. 3], [1, 0]),+ (8, 0, [1, 2], [1, 0]),+ (8, 2, [1, 2], [1, 0]),+ (8, 4, [1 .. 4], [1, 0]),+ (8, 6, [1 .. 5], [1, 0]),+ (8, 8, [1 .. 4], [1, 0]),+ (8, 10, [1 .. 4], [1, 0]),+ (8, 10, [5 .. 7], [1, 0, 1]),+ (9, 0, [1], [1, 0]),+ (9, 0, [2], [1, 0, 2]),+ (9, 2, [2 .. 8], [1, 0, 2]),+ (9, 4, [1 .. 8], [1, 0, 2]),+ (9, 6, [1 .. 7], [1, 0, 2]),+ (9, 8, [1 .. 4], [1, 0, 2]),+ (9, 10, [1 .. 3], [1, 0, 2]),+ (9, 12, [1 .. 3], [1, 0, 2]),+ (9, 12, [4], [1, 0, 3]),+ (9, 14, [1], [1, 0, 3])+ ],+ patch <- patches,+ let compiler = mkVersion [major, minor, patch]+ ]
src/Distribution/ArchHs/Name.hs view
@@ -47,10 +47,13 @@ toHackageName, isHaskellPackage, isGHCLibs,+ ghcProvidedPackages, ) where import Data.Char (toLower)+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set import Data.String (IsString, fromString) import Distribution.ArchHs.Internal.NamePresetLoader import Distribution.ArchHs.Internal.Prelude@@ -171,3 +174,14 @@ -- False isGHCLibs :: PackageName -> Bool isGHCLibs name = name == "ghc" || name `elem` ghcLibList++ghcProvidedPackages :: ExtraDB -> Set.Set PackageName+ghcProvidedPackages extra =+ Set.fromList $+ mkPackageName "ghc" : ghcLibList+ <> [ toHackageName name+ | provider <- ["ghc", "ghc-libs"],+ Just desc <- [Map.lookup (ArchLinuxName provider) extra],+ PkgDependent name _ <- _provides desc,+ isHaskellPackage name+ ]
src/Distribution/ArchHs/PkgBuild.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} @@ -19,6 +19,7 @@ where import Data.Text (Text, pack, unpack)+import Distribution.ArchHs.Compat (pattern ZeroBSD) import Distribution.SPDX.LicenseId import Lens.Micro ((&), (<&>)) import NeatInterpolation (text)@@ -56,11 +57,7 @@ -- | Map 'LicenseId' to 'ArchLicense'. License not provided by system will be mapped to @custom:...@. mapLicense :: LicenseId -> Arch.License-#if MIN_VERSION_Cabal_syntax(3,16,0)-mapLicense N_0BSD = Arch.N_0BSD-#else-mapLicense NullBSD = Arch.N_0BSD-#endif+mapLicense ZeroBSD = Arch.N_0BSD mapLicense AAL = Arch.AAL mapLicense Abstyles = Arch.Abstyles mapLicense Adobe_2006 = Arch.Adobe_2006
src/Distribution/ArchHs/PkgDesc.hs view
@@ -17,12 +17,14 @@ ) where +import Control.Monad (mfilter) import qualified Data.Map.Strict as Map import Data.Maybe (isJust) import qualified Data.Text as T import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Types import Distribution.ArchHs.Utils (extractFromEVR)+import Text.Read (readMaybe) -- Common fields {- fieldList =@@ -54,6 +56,7 @@ { _name = _pdName, _version = ver, _rawVersion = ver,+ _buildDate = Nothing, _desc = "", _url = Nothing, _provides = [],@@ -94,6 +97,7 @@ _name <- ArchLinuxName . T.unpack <$> lookupSingle "NAME" _rawVersion <- T.unpack <$> lookupSingle "VERSION" let _version = extractFromEVR _rawVersion+ _buildDate = mfilter (> 0) $ lookupSingle "BUILDDATE" >>= readMaybe . T.unpack _desc <- T.unpack <$> lookupSingle "DESC" _depends <- toDepList $ lookupList "DEPENDS" _makeDepends <- toDepList $ lookupList "MAKEDEPENDS"
src/Distribution/ArchHs/Types.hs view
@@ -85,6 +85,7 @@ { _name :: ArchLinuxName, _version :: ArchLinuxVersion, _rawVersion :: ArchLinuxVersion,+ _buildDate :: Maybe Integer, _desc :: String, _url :: Maybe String, _provides :: PkgDependentList,
sync/Args.hs view
@@ -8,6 +8,7 @@ ) where +import Check.Options import Distribution.ArchHs.Options import Distribution.ArchHs.Utils (archHsVersion) @@ -45,21 +46,6 @@ <> short 'u' <> help "Upload to hackage" )---------------------------------------------------------------------------------data CheckOptions = CheckOptions- { optShowGHCLibs :: Bool,- optDepCheck :: Bool,- optVerbose :: Bool- }--checkOptionsParser :: Parser CheckOptions-checkOptionsParser =- CheckOptions- <$> switch (long "show-ghc-libs" <> help "Include GHC and its bundled libraries and tools")- <*> switch (long "depcheck" <> help "Check whether newer Hackage versions are currently upgradable")- <*> switch (long "verbose" <> help "Show failing dependency and reverse dependency ranges for --depcheck candidates") -----------------------------------------------------------------------------
sync/Check.hs view
@@ -4,6 +4,7 @@ module Check (check, checkNewerVersions, prettyNewerVersions) where +import Check.Options import Control.Monad (forM) import Data.List (partition) import qualified Data.Map.Strict as Map@@ -12,10 +13,11 @@ import Distribution.ArchHs.Exception import Distribution.ArchHs.Hackage import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.Name (isGHCLibs)+import Distribution.ArchHs.Name (ghcProvidedPackages) import Distribution.ArchHs.PP import Distribution.ArchHs.RDepCheck import Distribution.ArchHs.Types+import Text.Read (readMaybe) import Utils data NewerVersion@@ -44,32 +46,25 @@ Embed IO ] r =>- Bool ->- Bool ->- Bool ->+ CheckOptions -> Sem r ()-check includeGHC runDepCheck verbose = do+check CheckOptions {..} = do extra <- ask @ExtraDB- let providedByGHC = Set.fromList- [ name- | provider <- ["ghc", "ghc-libs"],- Just desc <- [Map.lookup (ArchLinuxName provider) extra],- PkgDependent name _ <- _provides desc- ]- linked <- linkedHaskellPackageDescs+ let providedByGHC = ghcProvidedPackages extra+ linked <- sortPackages optSort optReverse <$> linkedHaskellPackageDescs checked <- traverse ( \(archName, desc, hackageName) -> do let rawArchVersion = _version desc case simpleParsec rawArchVersion of Just archVersion- | includeGHC || (not (isGHCLibs hackageName) && Set.notMember archName providedByGHC) -> do+ | optShowGHCLibs || Set.notMember hackageName providedByGHC -> do hackageVersions <- getNewerVersions hackageName archVersion if null hackageVersions then pure ([], []) else do- (newerVersions, skipped) <- checkNewerVersions runDepCheck hackageName archVersion hackageVersions- pure ([prettyNewerVersions verbose archName (_rawVersion desc) hackageName archVersion newerVersions], skipped)+ (newerVersions, skipped) <- checkNewerVersions optDepCheck hackageName archVersion hackageVersions+ pure ([prettyNewerVersions optVerbose archName (_rawVersion desc) hackageName archVersion newerVersions], skipped) _ -> pure ([], []) ) linked@@ -81,6 +76,32 @@ else do printWarn "Finished checking with inconsistenc(ies):" embed $ putDoc $ vcat result <> line++sortPackages :: Maybe CheckSort -> Bool -> [(ArchLinuxName, PkgDesc, PackageName)] -> [(ArchLinuxName, PkgDesc, PackageName)]+sortPackages Nothing reverseOrder = if reverseOrder then reverse else id+sortPackages (Just sortKey) reverseOrder = sortBy comparePackage+ where+ comparePackage (leftName, leftDesc, _) (rightName, rightDesc, _) =+ ( case sortKey of+ SortName -> compareKey False leftName rightName+ SortUpdated -> compareOptional True (_buildDate leftDesc) (_buildDate rightDesc)+ SortPkgrel -> compareOptional False (pkgrelKey $ _rawVersion leftDesc) (pkgrelKey $ _rawVersion rightDesc)+ )+ <> compare leftName rightName++ compareKey :: Ord key => Bool -> key -> key -> Ordering+ compareKey descending left right+ | descending /= reverseOrder = compare right left+ | otherwise = compare left right++ compareOptional :: Ord key => Bool -> Maybe key -> Maybe key -> Ordering+ compareOptional _ Nothing Nothing = EQ+ compareOptional _ Nothing (Just _) = GT+ compareOptional _ (Just _) Nothing = LT+ compareOptional descending (Just left) (Just right) = compareKey descending left right++pkgrelKey :: ArchLinuxVersion -> Maybe [Integer]+pkgrelKey rawVersion = pkgrelSuffix rawVersion >>= traverse readMaybe . splitOn "." . drop 1 checkNewerVersions :: Members
+ sync/Check/Options.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DerivingStrategies #-}++module Check.Options+ ( CheckOptions (..),+ CheckSort (..),+ checkOptionsParser,+ )+where++import Distribution.ArchHs.Options++data CheckOptions = CheckOptions+ { optShowGHCLibs :: Bool,+ optDepCheck :: Bool,+ optVerbose :: Bool,+ optSort :: Maybe CheckSort,+ optReverse :: Bool+ }+ deriving stock (Eq, Show)++data CheckSort = SortName | SortUpdated | SortPkgrel+ deriving stock (Eq, Show)++checkOptionsParser :: Parser CheckOptions+checkOptionsParser =+ CheckOptions+ <$> switch (long "show-ghc-libs" <> help "Include GHC and its bundled libraries and tools")+ <*> switch (long "depcheck" <> help "Check whether newer Hackage versions are currently upgradable")+ <*> switch (long "verbose" <> help "Show failing dependency and reverse dependency ranges for --depcheck candidates")+ <*> optional+ ( option+ ( eitherReader $ \case+ "name" -> Right SortName+ "updated" -> Right SortUpdated+ "pkgrel" -> Right SortPkgrel+ _ -> Left "Expected one of: name, updated, pkgrel"+ )+ ( long "sort"+ <> metavar "name|updated|pkgrel"+ <> help "Sort by package name (A-Z), Arch build time (newest first), or pkgrel (lowest first)"+ )+ )+ <*> switch (long "reverse" <> help "Reverse the package sort order")
sync/Main.hs view
@@ -30,11 +30,9 @@ ExtraDB -> HackageDB -> RawHackageDB ->- Bool ->- Bool ->- Bool ->+ CheckOptions -> IO (Either MyException ())-runCheck extra hackage rawHackage includeGHC runDepCheck verbose =+runCheck extra hackage rawHackage options@CheckOptions {..} = ( runFinal . embedToFinal @IO . errorToIOFinal@@ -45,9 +43,9 @@ . runReader hackage . runReader extra )- ( if runDepCheck- then subsumeGHCVersion $ check includeGHC runDepCheck verbose- else runReader nullVersion $ check includeGHC runDepCheck verbose+ ( if optDepCheck+ then subsumeGHCVersion $ check options+ else runReader nullVersion $ check options ) runSubmit ::@@ -93,7 +91,7 @@ manager <- newTlsManager runSubmit extra hackage manager token optOutput optUpload & printAppResult- Check CommonOptions {..} CheckOptions {..} -> do+ Check CommonOptions {..} options@CheckOptions {..} -> do extra <- loadExtraDBFromOptions optExtraDB (hackage, rawHackage) <- if optDepCheck@@ -101,7 +99,7 @@ else do hackage <- loadHackageDBFromOptions optHackage pure (hackage, Map.empty)- runCheck extra hackage rawHackage optShowGHCLibs optDepCheck optVerbose & printAppResult+ runCheck extra hackage rawHackage options & printAppResult List ExtraDBOptions {..} ListOptions {..} -> do extra <- loadExtraDBFromOptions putStrLn $
sync/Submit.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -module Submit (submit) where+module Submit (submit, genCSV) where import Control.Monad (unless) import Data.Algorithm.Diff (getGroupedDiff)@@ -9,10 +9,11 @@ import qualified Data.ByteString.Lazy as LBS import Data.List (sortOn) import Data.Maybe (fromJust)+import qualified Data.Set as Set import qualified Data.Text as T import Distribution.ArchHs.Exception import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.Name (isGHCLibs)+import Distribution.ArchHs.Name (ghcProvidedPackages) import Distribution.ArchHs.PP import Distribution.ArchHs.Types import Distribution.ArchHs.Utils@@ -24,14 +25,16 @@ -- | Generate Distro CSV from Extra DB genCSV :: Members [ExtraEnv, HackageEnv, WithMyErr, Embed IO] r => Sem r DistroCSV genCSV = do+ extra <- ask linked <- linkedHaskellPackages+ let providedByGHC = ghcProvidedPackages extra pure $ sortOn (^. _1) [ (unPackageName hackageName, version, prefix <> tweakedName) | (archLinuxName, version, hackageName) <- linked, let tweakedName =- if isGHCLibs hackageName+ if Set.member hackageName providedByGHC then "ghc" else unArchLinuxName archLinuxName prefix = "https://archlinux.org/packages/extra/x86_64/"
test/Main.hs view
@@ -1,24 +1,34 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} module Main (main) where import qualified Check as Sync+import qualified Check.Options as SyncOptions import qualified Conduit as C import Control.Exception (bracket, try) import Control.Monad (forM_, void)+import Data.Bifunctor (first) import qualified Data.ByteString.Char8 as B8 import qualified Data.Conduit.Tar as Tar import Data.List (intercalate, isInfixOf, isPrefixOf, sortOn) import qualified Data.Map.Strict as Map import Data.Maybe (listToMaybe, mapMaybe)-import Diff (inRange)+import qualified Data.Text as Text+import Data.Text.Encoding (decodeUtf8)+import Diff (CabalSource (..), diffCabal, inRange) import Distribution.ArchHs.Exception import Distribution.ArchHs.ExtraDB (defaultExtraDBPath, loadExtraDB)+#ifdef ALPM+import Distribution.ArchHs.ExtraDB (loadExtraDBFFI)+#endif import Distribution.ArchHs.Hackage (getCabalIncludingDeprecated, getNewerVersions, loadHackageDBsWithRevisions, loadRawHackageDB, loadRawHackageRevisions)-import Distribution.ArchHs.Name (isGHCLibs, isHaskellPackage, toArchLinuxName, toHackageName)+import Distribution.ArchHs.Name (ghcProvidedPackages, isGHCLibs, isHaskellPackage, toArchLinuxName, toHackageName) import Distribution.ArchHs.Options (ParserResult (..), defaultPrefs, execParserPure, info) import Distribution.ArchHs.PP (AnsiStyle, Doc)+import qualified Distribution.ArchHs.PkgBuild as PkgBuild+import Distribution.ArchHs.PkgDesc (parseDescEntry) import Distribution.ArchHs.RDepCheck (DepSrc (..), ReverseDep (..)) import Distribution.ArchHs.Types import qualified Distribution.Hackage.DB.Parsed as Hackage@@ -38,16 +48,52 @@ import Polysemy.Trace (ignoreTrace) import qualified RDepCheck import qualified RDepCheck.Args as RDepArgs+import qualified Submit import Submit.CSV import System.Directory (doesFileExist, getTemporaryDirectory, removeFile) import System.Exit (ExitCode (..)) import System.IO (hClose, hFlush, openBinaryTempFile, stdout) import Test.Hspec import Utils (linkedHaskellPackageDescs)+import qualified Web.ArchLinux.Types as Arch main :: IO () main = hspec $ do PlanSpec.spec+ describe "PKGBUILD template" $ do+ it "preserves configure continuations and spacing before the build command" $ do+ let output = PkgBuild.applyTemplate templatePkgBuild+ output `shouldContain` unlines+ [ " runhaskell Setup configure -O --enable-shared --enable-debug-info --enable-executable-dynamic --disable-library-vanilla \\",+ " --prefix=/usr --docdir=/usr/share/doc/$pkgname --datasubdir=$pkgname --enable-tests \\",+ " --dynlibdir=/usr/lib --libsubdir=\\$compiler/site-local/\\$pkgid \\",+ " --ghc-option=-optl-Wl\\,-z\\,relro\\,-z\\,now \\",+ " --ghc-option='-pie' ",+ "",+ " runhaskell Setup build $MAKEFLAGS"+ ]++ it "continues configure flags on the following line" $ do+ let output = PkgBuild.applyTemplate templatePkgBuild {PkgBuild._flags = "-fexample -f-another"}+ output `shouldContain` unlines+ [ " --ghc-option='-pie' \\",+ " -fexample -f-another",+ "",+ " runhaskell Setup build $MAKEFLAGS"+ ]++ it "preserves prepare, check, and license installation blocks" $ do+ let output = PkgBuild.applyTemplate templatePkgBuild+ { PkgBuild._enableUusi = True,+ PkgBuild._removeBoundsWithUusi = ["aeson", "text"]+ }+ output `shouldContain` "prepare() {\n cd $_hkgname-$pkgver\n uusi -u aeson -u text\n}\n\nbuild() {"+ output `shouldContain` "check() {\n cd $_hkgname-$pkgver\n runhaskell Setup test --show-details=direct\n}\n\npackage() {"+ output `shouldContain` " runhaskell Setup copy --destdir=\"$pkgdir\"\n install -D -m644 LICENSE -t \"$pkgdir\"/usr/share/licenses/$pkgname/"++ it "retains the 0BSD license mapping across Cabal-syntax versions" $+ PkgBuild.mapLicense <$> simpleParsec "0BSD" `shouldBe` Just Arch.N_0BSD+ describe "reverse dependency target arguments" $ do forM_ [ (["aeson"], [("aeson", Nothing)]),@@ -168,13 +214,181 @@ _rawVersion `shouldSatisfy` (_version `isPrefixOf`) drop (length _version) _rawVersion `shouldSatisfy` isPkgrelSuffix + it "keeps build timestamps for real Haskell packages" $ do+ extra <- loadLiveExtraDB+ samples <- requireHaskellSamples extra+ forM_ samples $ \(_, desc) ->+ _buildDate desc `shouldSatisfy` maybe False (> 0)++#ifdef ALPM+ it "loads the same build timestamps through libalpm" $ do+ extra <- loadLiveExtraDB+ samples <- requireHaskellSamples extra+ alpmExtra <- loadExtraDBFFI+ forM_ samples $ \(name, desc) ->+ (_buildDate <$> Map.lookup name alpmExtra) `shouldBe` Just (_buildDate desc)+#endif+ it "renders Hackage distro CSV rows from current extra.db and parses them back" $ do extra <- loadLiveExtraDB let rows = take 20 $ liveDistroRows extra rows `shouldSatisfy` not . null parseDistroCSV (renderDistroCSV rows) `shouldBe` rows + describe "unified package diffs" $ do+ let cabal release body = B8.pack $ unlines $+ ["cabal-version: 1.24", "name: sample", "version: " <> release, "build-type: Simple"] <> body+ plainOutput ('\ESC' : '[' : rest) = plainOutput $ drop 1 $ dropWhile (/= 'm') rest+ plainOutput (character : rest) = character : plainOutput rest+ plainOutput [] = []+ compareEntries entries = withIndexEntries entries $ \path -> do+ (result, output) <- captureStdout $+ runM . runError @MyException . evalState (Map.empty :: Map.Map PackageName [VersionRange])+ . ignoreTrace . runReader (Offline path) . runReader (Map.empty :: FlagAssignments)+ . runReader (parseVersion "9.6.7") . runReader (ghcExtraDB "9.6.7")+ $ diffCabal (mkPackageName "sample") (parseVersion "1.0") (parseVersion "2.0")+ first show result `shouldBe` Right ()+ pure $ plainOutput $ Text.unpack $ decodeUtf8 $ B8.pack output+ compareCabals old new = compareEntries+ [("sample/1.0/sample.cabal", cabal "1.0" old), ("sample/2.0/sample.cabal", cabal "2.0" new)]+ library dependencies = ["library", " build-depends: " <> dependencies]+ flag name description def manual =+ ["flag " <> name, " description: " <> description, " default: " <> def, " manual: " <> manual]++ it "keeps the original report sections and marks changed metadata" $ do+ output <- compareCabals+ ["synopsis: Old synopsis", "license: BSD3", "homepage: https://example.org/old", "-- old source comment"]+ ["synopsis: New synopsis", "license: MIT", "homepage: https://example.org/new", "-- new source comment"]+ output `shouldContain` "Package: sample\n- Version: 1.0\n+ Version: 2.0"+ output `shouldContain` "- Synopsis: Old synopsis\n+ Synopsis: New synopsis"+ output `shouldContain` "- License: BSD-3-Clause\n+ License: MIT"+ output `shouldContain` "- URL: https://example.org/old\n+ URL: https://example.org/new"+ forM_ ["Depends:", "MakeDepends:", "Flags:"] $ \heading -> output `shouldContain` heading+ forM_ ["cabal-version:", "source comment", "--- sample-", "+++ sample-", "@@"] $ \raw -> output `shouldNotContain` raw++ it "shows unchanged dependencies once and puts range changes next to each other" $ do+ output <- compareCabals+ (library "base >=4 && <5, bytestring >=0.10 && <0.11")+ (library "base >=4 && <5, bytestring >=0.11 && <0.12, text >=2")+ output `shouldContain` unlines+ ["Depends:", " base >=4 && <5", " - bytestring >=0.10 && <0.11", " + bytestring >=0.11 && <0.12", " + text >=2"]+ length (filter (isInfixOf "base >=4 && <5") $ lines output) `shouldBe` 1+ output `shouldNotContain` replicate 38 '-'++ it "uses the same unified presentation for build dependencies" $ do+ let testSuite range = library "base >=4 && <5" <>+ ["test-suite tests", " type: exitcode-stdio-1.0", " main-is: Main.hs", " build-depends: base >=4 && <5, doctest " <> range]+ output <- compareCabals (testSuite ">=0.11 && <0.17") (testSuite ">=0.11 && <0.18")+ output `shouldContain` "MakeDepends:\n - doctest >=0.11 && <0.17\n + doctest >=0.11 && <0.18"++ it "shows removed dependencies and retains empty sections" $ do+ output <- compareCabals (library "text >=1") []+ output `shouldContain` "Depends:\n - text >=1"+ output `shouldContain` "MakeDepends:\n []"+ output `shouldContain` "Flags:\n []"++ it "shows flag field changes together while displaying unchanged flags once" $ do+ let stable = flag "stable" "Keep this flag" "True" "True"+ output <- compareCabals+ (flag "debug" "Old description" "False" "True" <> stable)+ (flag "debug" "New description" "True" "False" <> stable)+ output `shouldContain` "Flags:\n sample\n ⚐ debug:"+ output `shouldContain` unlines+ [" - Old description", " - default: False", " - isManual: True",+ " + New description", " + default: True", " + isManual: False"]+ length (filter (isInfixOf "⚐ stable:") $ lines output) `shouldBe` 1+ length (filter (isInfixOf "Keep this flag") $ lines output) `shouldBe` 1++ forM_ [(False, "+"), (True, "-")] $ \(removed, marker) ->+ it ("marks a whole " <> (if removed then "removed" else "added") <> " flag") $ do+ let newFlag = flag "debug" "Debug output" "False" "True"+ output <- compareCabals (if removed then newFlag else []) (if removed then [] else newFlag)+ output `shouldContain` (" " <> marker <> " ⚐ debug:")+ output `shouldContain` (" " <> marker <> " default: False")+ output `shouldContain` (" " <> marker <> " isManual: True")++ it "retains unchanged metadata, dependencies, and flags without change markers" $ do+ let body = ["synopsis: Same synopsis"] <> flag "debug" "Debug output" "False" "True" <> library "base >=4 && <5"+ output <- compareCabals body body+ output `shouldContain` "Synopsis: Same synopsis"+ length (filter (isInfixOf "base >=4 && <5") $ lines output) `shouldBe` 1+ length (filter (isInfixOf "⚐ debug:") $ lines output) `shouldBe` 1+ filter (isPrefixOf " -") (lines output) `shouldBe` []+ filter (isPrefixOf " +") (lines output) `shouldBe` []++ forM_ [("unavailable >=1", "does not provide this package"), ("system-cxx-std-lib >=2", "provides")] $ \(dependency, warning) ->+ it ("compares revision 0 metadata while retaining checks for " <> dependency) $ do+ let oldPath = "sample/1.0/sample.cabal"+ newPath = "sample/2.0/sample.cabal"+ output <- compareEntries+ [(oldPath, cabal "1.0" ["synopsis: Old original"]),+ (oldPath, cabal "1.0" ["synopsis: Revised old"]),+ (newPath, cabal "2.0" $ ["synopsis: New original"] <> library dependency),+ (newPath, cabal "2.0" ["synopsis: Revised new"])]+ output `shouldContain` "- Synopsis: Old original\n+ Synopsis: New original"+ output `shouldNotContain` "Revised old"+ output `shouldNotContain` "Revised new"+ output `shouldContain` warning+ describe "diff dependency range checks" $ do+ forM_ [("system-cxx-std-lib", "1.0"), ("rts", "1.0.2")] $ \(package, release) ->+ it ("checks " <> package <> " without a repository package or provides entry") $ do+ let extra = ghcExtraDB "9.6.7"+ placeholderName = mkPackageName package+ first show (runInRange extra placeholderName (parseRange $ "==" <> release))+ `shouldBe` Right (Right (placeholderName, parseRange $ "==" <> release, parseVersion release, True))+ first show (runInRange extra placeholderName (parseRange ">=2"))+ `shouldBe` Right (Right (placeholderName, parseRange ">=2", parseVersion release, False))++ it "uses the repository compiler's runtime version rather than the host compiler's" $ do+ let placeholderName = mkPackageName "rts"+ forM_ [("9.12.3", "1.0.2"), ("9.12.4", "1.0.3")] $ \(compiler, release) ->+ first show (runInRange (ghcExtraDB compiler) placeholderName (parseRange $ "==" <> release))+ `shouldBe` Right (Right (placeholderName, parseRange $ "==" <> release, parseVersion release, True))++ it "does not invent placeholders for older or unknown compilers" $ do+ let placeholderName = mkPackageName "system-cxx-std-lib"+ forM_ ["9.2.8", "99.0.1"] $ \compiler ->+ first show (runInRange (ghcExtraDB compiler) placeholderName anyVersion)+ `shouldBe` Right (Left (placeholderName, anyVersion))++ it "honors explicit compiler provides before placeholder fallback versions" $ do+ let placeholderName = mkPackageName "system-cxx-std-lib"+ extra = Map.adjust (\desc -> desc {_provides = [PkgDependent (toArchLinuxName placeholderName) (Just "2.0")]})+ (ArchLinuxName "ghc") (ghcExtraDB "9.6.7")+ first show (runInRange extra placeholderName (parseRange ">=2"))+ `shouldBe` Right (Right (placeholderName, parseRange ">=2", parseVersion "2.0", True))++ it "uses ghc-libs placeholder metadata when no compiler entry is present" $ do+ let compiler = ghcExtraDB "9.6.7" Map.! ArchLinuxName "ghc"+ extra = Map.singleton (ArchLinuxName "ghc-libs") compiler {_name = ArchLinuxName "ghc-libs"}+ placeholderName = mkPackageName "system-cxx-std-lib"+ first show (runInRange extra placeholderName anyVersion)+ `shouldBe` Right (Right (placeholderName, anyVersion, parseVersion "1.0", True))++ it "does not hide a malformed explicit placeholder version with a fallback" $ do+ let extra = ghcExtraDB "9.6.7"+ placeholderName = mkPackageName "system-cxx-std-lib"+ placeholderArch = toArchLinuxName placeholderName+ desc = (extra Map.! ArchLinuxName "ghc") {_name = placeholderArch, _version = "invalid"}+ case runInRange (Map.insert placeholderArch desc extra) placeholderName anyVersion of+ Left (VersionNoParse rawVersion) -> rawVersion `shouldBe` "invalid"+ result -> expectationFailure $ "expected VersionNoParse, got: " <> show result++ it "does not report a newly added compiler placeholder as missing in diff output" $ do+ let cabal release deps = B8.pack $ unlines $+ ["cabal-version: 1.24", "name: sample", "version: " <> release, "build-type: Simple"]+ <> if null deps then [] else ["library", " build-depends: " <> deps]+ withIndexEntries [("sample/1.0/sample.cabal", cabal "1.0" ""), ("sample/2.0/sample.cabal", cabal "2.0" "system-cxx-std-lib ==1.0")] $ \path -> do+ (result, output) <- captureStdout $+ runM . runError @MyException . evalState (Map.empty :: Map.Map PackageName [VersionRange])+ . ignoreTrace . runReader (Offline path) . runReader (Map.empty :: FlagAssignments)+ . runReader (parseVersion "9.6.7") . runReader (ghcExtraDB "9.6.7")+ $ diffCabal (mkPackageName "sample") (parseVersion "1.0") (parseVersion "2.0")+ first show result `shouldBe` Right ()+ output `shouldContain` "system-cxx-std-lib"+ output `shouldNotContain` "does not provide this package"+ it "uses a live extra.db version when checking a Hackage dependency range" $ do extra <- loadLiveExtraDB (hackageName, expectedVersion) <- requireParseableHackagePackage extra@@ -216,6 +430,75 @@ Left err -> expectationFailure $ "expected masked cabal lookup to succeed, got: " <> show err + describe "pacman build timestamp parsing" $ do+ forM_ ["100", "4000000000"] $ \timestamp ->+ it ("reads build timestamp " <> timestamp) $+ (_buildDate <$> parseDescEntry (syncDescEntry "example" "1.0-1" $ Just timestamp))+ `shouldBe` Just (Just $ read timestamp)++ forM_ [Nothing, Just "", Just "invalid", Just "0", Just "-1"] $ \timestamp ->+ it ("keeps packages with missing or invalid build timestamps: " <> show timestamp) $+ (_buildDate <$> parseDescEntry (syncDescEntry "example" "1.0-1" timestamp))+ `shouldBe` Just Nothing++ describe "sync sorting arguments" $ do+ forM_+ [ ([], Nothing, False),+ (["--reverse"], Nothing, True),+ (["--sort", "name"], Just SyncOptions.SortName, False),+ (["--sort", "updated"], Just SyncOptions.SortUpdated, False),+ (["--sort=pkgrel"], Just SyncOptions.SortPkgrel, False),+ (["--sort", "updated", "--reverse"], Just SyncOptions.SortUpdated, True)+ ] $ \(args, sortKey, reverseOrder) ->+ it ("parses sorting options " <> show args) $+ case execParserPure defaultPrefs (info SyncOptions.checkOptionsParser mempty) args of+ Success options -> options `shouldBe` SyncOptions.CheckOptions False False False sortKey reverseOrder+ _ -> expectationFailure "expected sorting arguments to parse"++ it "combines sorting with existing check options" $+ case execParserPure defaultPrefs (info SyncOptions.checkOptionsParser mempty)+ ["--show-ghc-libs", "--depcheck", "--verbose", "--sort", "pkgrel", "--reverse"] of+ Success options -> options `shouldBe` SyncOptions.CheckOptions True True True (Just SyncOptions.SortPkgrel) True+ _ -> expectationFailure "expected combined check arguments to parse"++ forM_ [["--sort", "unknown"], ["--sort"], ["--reverse", "true"]] $ \args ->+ it ("rejects malformed sorting options " <> show args) $+ case execParserPure defaultPrefs (info SyncOptions.checkOptionsParser mempty) args of+ Success _ -> expectationFailure "expected malformed sorting arguments to fail"+ _ -> pure ()++ describe "sync package sorting" $ do+ forM_ [False, True] $ \depCheck ->+ forM_+ [ ("preserves the existing default order", Nothing, False, ["golf", "foxtrot", "echo", "delta", "charlie", "bravo", "alpha"]),+ ("reverses the default order", Nothing, True, ["alpha", "bravo", "charlie", "delta", "echo", "foxtrot", "golf"]),+ ("sorts by Arch package name", Just SyncOptions.SortName, False, ["alpha", "bravo", "charlie", "delta", "echo", "foxtrot", "golf"]),+ ("reverses package name sorting", Just SyncOptions.SortName, True, ["golf", "foxtrot", "echo", "delta", "charlie", "bravo", "alpha"]),+ ("sorts newest builds first with missing dates last and alphabetical ties", Just SyncOptions.SortUpdated, False, ["bravo", "charlie", "delta", "alpha", "echo", "foxtrot", "golf"]),+ ("sorts oldest builds first with missing dates last and alphabetical ties", Just SyncOptions.SortUpdated, True, ["alpha", "charlie", "delta", "bravo", "echo", "foxtrot", "golf"]),+ ("sorts lowest numeric pkgrel and subreleases first ignoring epochs", Just SyncOptions.SortPkgrel, False, ["alpha", "echo", "delta", "charlie", "bravo", "foxtrot", "golf"]),+ ("sorts highest pkgrel first with reverse, missing releases last and alphabetical ties", Just SyncOptions.SortPkgrel, True, ["bravo", "charlie", "delta", "alpha", "echo", "foxtrot", "golf"])+ ] $ \(label, sortKey, reverseOrder, expected) ->+ it (label <> ", depcheck=" <> show depCheck) $ do+ let (hackage, raw, extra) = syncSortDBs+ options = SyncOptions.CheckOptions False depCheck True sortKey reverseOrder+ (result, output) <- captureStdout $ runSyncCheckWithOptions extra hackage raw options+ show result `shouldBe` "Right ()"+ let packages = [package | entry <- lines output, package <- expected, ("haskell-" <> package) `isInfixOf` entry]+ packages `shouldBe` expected+ let candidates = filter (isInfixOf "has newer versions") $ lines output+ length candidates `shouldBe` length expected+ forM_ candidates $ \entry -> do+ entry `shouldContain` "1.1"+ entry `shouldContain` "1.2"+ if depCheck+ then do+ length (filter (isInfixOf "missing requires >=1") $ lines output) `shouldBe` 2 * length expected+ let details = filter (\entry -> "haskell-" `isInfixOf` entry || "dep:" `isInfixOf` entry) $ lines output+ [listToMaybe [package | package <- expected, ("haskell-" <> package) `isInfixOf` entry] | entry <- details]+ `shouldBe` concatMap (\package -> [Just package, Nothing, Nothing]) expected+ else output `shouldNotContain` "dep:"+ describe "sync with unsupported cabal formats" $ do it "lists newer versions without parsing their cabal files" $ do let (preferred, _, _, name) = unsupportedHackageDBs@@ -237,22 +520,33 @@ result <- runSyncCheck extra preferred raw False True show result `shouldBe` "Right ()" + describe "GHC-provided package classification" $ do+ forM_ ["rts", "system-cxx-std-lib"] $ \package ->+ it ("recognizes " <> package <> " without repository provides") $ do+ let name = mkPackageName package+ isGHCLibs name `shouldBe` True+ name `shouldSatisfy` (`elem` ghcProvidedPackages Map.empty)++ forM_ modernGHCPackages $ \package ->+ it ("keeps standalone " <> package <> " outside the unconditional bundled list") $+ isGHCLibs (mkPackageName package) `shouldBe` False+ describe "sync GHC-provided packages" $ do forM_ [False, True] $ \depCheck -> do it ("excludes bundled tools and libraries by default, depcheck=" <> show depCheck) $ do let (hackage, raw, extra) = syncGHCDBs (result, output) <- captureStdout $ runSyncCheck extra hackage raw False depCheck show result `shouldBe` "Right ()"- forM_ ["haskell-hsc2hs", "haskell-haddock", "haskell-bundled-library", "haskell-base"] $ \package ->- output `shouldNotContain` package+ forM_ (["hsc2hs", "haddock", "bundled-library", "base", "rts", "system-cxx-std-lib"] <> modernGHCPackages) $ \package ->+ output `shouldNotContain` ("haskell-" <> package) output `shouldContain` "haskell-standalone" it ("includes bundled tools and libraries with show-ghc-libs, depcheck=" <> show depCheck) $ do let (hackage, raw, extra) = syncGHCDBs (result, output) <- captureStdout $ runSyncCheck extra hackage raw True depCheck show result `shouldBe` "Right ()"- forM_ ["haskell-hsc2hs", "haskell-haddock", "haskell-bundled-library", "haskell-base", "haskell-standalone"] $ \package ->- output `shouldContain` package+ forM_ (["hsc2hs", "haddock", "bundled-library", "base", "rts", "system-cxx-std-lib", "standalone"] <> modernGHCPackages) $ \package ->+ output `shouldContain` ("haskell-" <> package) it ("still checks hsc2hs when it is not provided by GHC, depcheck=" <> show depCheck) $ do let (hackage, raw, extra) = syncGHCDBs@@ -260,6 +554,28 @@ show result `shouldBe` "Right ()" output `shouldContain` "haskell-hsc2hs" + it ("checks newer bundled libraries when installed as standalone packages, depcheck=" <> show depCheck) $ do+ let (hackage, raw, extra) = syncGHCDBs+ (result, output) <- captureStdout $ runSyncCheck (Map.delete (ArchLinuxName "ghc-libs") extra) hackage raw False depCheck+ show result `shouldBe` "Right ()"+ forM_ modernGHCPackages $ \package ->+ output `shouldContain` ("haskell-" <> package)+ forM_ ["rts", "system-cxx-std-lib"] $ \package ->+ output `shouldNotContain` ("haskell-" <> package)++ forM_ [True, False] $ \provided ->+ it ("links GHC-provided CSV rows to the compiler and standalone rows to their packages, provided=" <> show provided) $ do+ let (hackage, _, extra) = syncGHCDBs+ repository = if provided then extra else Map.delete (ArchLinuxName "ghc-libs") extra+ compilerPackages = ["hsc2hs", "haddock", "base", "rts", "system-cxx-std-lib"]+ <> [package | provided, package <- "bundled-library" : modernGHCPackages]+ result <- runM . runError @MyException . runReader hackage . runReader repository $ Submit.genCSV+ case result of+ Left err -> expectationFailure $ show err+ Right rows -> forM_ rows $ \(package, _, url) -> do+ let target = if package `elem` compilerPackages then "ghc" else "haskell-" <> package+ url `shouldBe` "https://archlinux.org/packages/extra/x86_64/" <> target+ describe "sync direct dependency failure classification" $ do forM_ [ ("warns about unchanged upper bounds", ["ansi-wl-pprint ^>=1.0.2"], ["ansi-wl-pprint ^>=1.0.2"], "existing: dep-old=1"),@@ -558,6 +874,23 @@ show doc `shouldContain` "unchecked: Unable to parse" show doc `shouldContain` "rdep: 2.0 is outside Depends range (<2)" +templatePkgBuild :: PkgBuild.PkgBuild+templatePkgBuild = PkgBuild.PkgBuild+ { PkgBuild._hkgName = "vcr",+ PkgBuild._pkgName = "haskell-vcr",+ PkgBuild._pkgVer = "0.1.0",+ PkgBuild._pkgDesc = "Record and replay HTTP interactions",+ PkgBuild._url = "https://github.com/assertible/vcr#readme",+ PkgBuild._license = "MIT",+ PkgBuild._depends = "",+ PkgBuild._makeDepends = "",+ PkgBuild._sha256sums = "'checksum'",+ PkgBuild._licenseFile = Just "LICENSE",+ PkgBuild._enableUusi = False,+ PkgBuild._removeBoundsWithUusi = [],+ PkgBuild._flags = ""+ }+ loadLiveExtraDB :: IO ExtraDB loadLiveExtraDB = do exists <- doesFileExist defaultExtraDBPath@@ -628,6 +961,12 @@ . runReader extra $ inRange (name, range) +ghcExtraDB :: String -> ExtraDB+ghcExtraDB compiler =+ let (_, _, extra) = syncGHCDBs+ desc = extra Map.! ArchLinuxName "ghc"+ in Map.singleton (ArchLinuxName "ghc") desc {_version = compiler, _rawVersion = compiler <> "-1", _provides = []}+ maskedHackageDBs :: (Hackage.HackageDB, RawHackage.HackageDB, PackageName, Version, Version) maskedHackageDBs = (Hackage.parseDB raw, raw, name, version100, version101)@@ -723,6 +1062,7 @@ { _name = archName, _version = "1.0", _rawVersion = "1.0-1",+ _buildDate = Nothing, _desc = "Diff algorithm in pure Haskell", _url = Nothing, _provides = [],@@ -737,7 +1077,7 @@ syncGHCDBs :: (Hackage.HackageDB, RawHackage.HackageDB, ExtraDB) syncGHCDBs = (Hackage.parseDB raw, raw, extra) where- packages = ["hsc2hs", "haddock", "bundled-library", "base", "standalone"]+ packages = ["hsc2hs", "haddock", "bundled-library", "base", "rts", "system-cxx-std-lib", "standalone"] <> modernGHCPackages raw = Map.fromList [ ( mkPackageName package, RawHackage.PackageData B8.empty $ Map.singleton (parseVersion "1.1") $@@ -752,7 +1092,7 @@ <> [ ( archName, desc archName [PkgDependent (toArchLinuxName $ mkPackageName package) (Just "1.0") | package <- bundled] )- | (provider, bundled) <- [("ghc", ["hsc2hs", "haddock"]), ("ghc-libs", ["bundled-library"])],+ | (provider, bundled) <- [("ghc", ["hsc2hs", "haddock"]), ("ghc-libs", "bundled-library" : modernGHCPackages)], let archName = ArchLinuxName provider ] desc package provides =@@ -760,6 +1100,7 @@ { _name = package, _version = "1.0", _rawVersion = "1.0-1",+ _buildDate = Nothing, _desc = "GHC-provided package fixture", _url = Nothing, _provides = provides,@@ -771,8 +1112,18 @@ _checkDepends = [] } +modernGHCPackages :: [String]+modernGHCPackages =+ [ "file-io", "ghc-byteorder", "ghc-experimental", "ghc-internal", "ghc-platform", "ghc-toolchain",+ "haddock-api", "haddock-library", "os-string", "semaphore-compat", "template-haskell-lift", "template-haskell-quasiquoter"+ ]+ runSyncCheck :: ExtraDB -> Hackage.HackageDB -> RawHackage.HackageDB -> Bool -> Bool -> IO (Either MyException ()) runSyncCheck extra hackage raw includeGHC depCheck =+ runSyncCheckWithOptions extra hackage raw $ SyncOptions.CheckOptions includeGHC depCheck True Nothing False++runSyncCheckWithOptions :: ExtraDB -> Hackage.HackageDB -> RawHackage.HackageDB -> SyncOptions.CheckOptions -> IO (Either MyException ())+runSyncCheckWithOptions extra hackage raw options = runM . runError @MyException . evalState (Map.empty :: Map.Map PackageName [VersionRange])@@ -782,8 +1133,49 @@ . runReader raw . runReader hackage . runReader extra- $ Sync.check includeGHC depCheck True+ $ Sync.check options +syncDescEntry :: String -> ArchLinuxVersion -> Maybe String -> Text.Text+syncDescEntry package version buildDate =+ Text.pack $ unlines $+ ["%NAME%", "haskell-" <> package, "", "%VERSION%", version, "", "%DESC%", "Sync sorting fixture", ""]+ <> maybe [] (\timestamp -> ["%BUILDDATE%", timestamp, ""]) buildDate++syncSortDBs :: (Hackage.HackageDB, RawHackage.HackageDB, ExtraDB)+syncSortDBs = (Hackage.parseDB raw, raw, extra)+ where+ packages =+ [ ("alpha", "1.0-2", Just "100"),+ ("bravo", "1.0-10", Just "300"),+ ("charlie", "3:1.0-2.10", Just "200"),+ ("delta", "1.0-2.2", Just "200"),+ ("echo", "1.0-2", Nothing),+ ("foxtrot", "1.0", Just "invalid"),+ ("golf", "1.0-invalid", Just "0")+ ]+ raw = Map.fromList+ [ ( mkPackageName package,+ RawHackage.PackageData B8.empty $ Map.fromList+ [ ( parseVersion version,+ RawHackage.VersionData+ (B8.pack $ unlines $+ ["cabal-version: 1.12", "name: " <> package, "version: " <> version, "build-type: Simple"]+ <> (if version == "1.0" then [] else ["library", " build-depends: missing >=1"]))+ B8.empty+ )+ | version <- ["1.0", "1.1", "1.2"]+ ]+ )+ | (package, _, _) <- packages+ ]+ extra = Map.fromList+ [ (toArchLinuxName $ mkPackageName package, desc)+ | (package, version, buildDate) <- packages,+ let desc = case parseDescEntry $ syncDescEntry package version buildDate of+ Just parsed -> parsed+ Nothing -> error $ "invalid sync sorting fixture: " <> package+ ]+ runRdepCheck :: ExtraDB -> RawHackage.HackageDB -> Maybe Version -> PackageName -> IO (Either MyException RDepCheck.FailureCounts) runRdepCheck extra raw = runRdepCheckRevisions extra raw raw @@ -939,6 +1331,7 @@ { _name = package, _version = "1.0", _rawVersion = "1.0-7",+ _buildDate = Nothing, _desc = "Dependency check fixture", _url = Nothing, _provides = [],
test/PlanSpec.hs view
@@ -120,27 +120,30 @@ _ -> pure () describe "rebuild command" $ do- it "prints a copyable command after the commit message using Arch package bases" $ do+ it "combines the commit message and Arch package bases in a copyable full rebuild command" $ do result <- runPlan False [("zeta", Just "2.0"), ("Alpha", Just "2.0")] [("zeta", [], [("2.0", [])]), ("Alpha", [], [("2.0", [])])] let output = show $ Plan.prettyPlanResult result- output `shouldContain` "Commit message:\nAlpha 2.0, zeta 2.0\n\ngenrebuild -H haskell-alpha haskell-zeta"- last (lines output) `shouldBe` "genrebuild -H haskell-alpha haskell-zeta"+ output `shouldContain` "Rebuild command:\ndorebuild 'rebuild with Alpha 2.0, zeta 2.0' `genrebuild -H haskell-alpha haskell-zeta`"+ output `shouldNotContain` "Commit message:"+ last (lines output) `shouldBe` "dorebuild 'rebuild with Alpha 2.0, zeta 2.0' `genrebuild -H haskell-alpha haskell-zeta`" it "respects package name presets without adding a haskell prefix" $ do result <- runPlan False [("stack", Just "2.0"), ("elm-compiler", Just "2.0")] [("stack", [], [("2.0", [])]), ("elm-compiler", [], [("2.0", [])])]- last (lines $ show $ Plan.prettyPlanResult result) `shouldBe` "genrebuild -H elm-compiler stack"+ last (lines $ show $ Plan.prettyPlanResult result) `shouldBe` "dorebuild 'rebuild with elm-compiler 2.0, stack 2.0' `genrebuild -H elm-compiler stack`" it "includes requested packages whose versions are unchanged" $ do result <- runPlan False [("alpha", Just "2.0"), ("bravo", Just "1.0")] [("alpha", [], [("2.0", [])]), ("bravo", [], [])]- show (Plan.prettyPlanResult result) `shouldContain` "Commit message:\nalpha 2.0\n\ngenrebuild -H haskell-alpha haskell-bravo"+ last (lines $ show $ Plan.prettyPlanResult result) `shouldBe` "dorebuild 'rebuild with alpha 2.0' `genrebuild -H haskell-alpha haskell-bravo`" - it "omits the command when there is no commit message" $ do+ it "omits the command when no versions change" $ do result <- runPlan False [("alpha", Just "1.0")] [("alpha", [], [])] let output = show $ Plan.prettyPlanResult result output `shouldNotContain` "Commit message:"+ output `shouldNotContain` "Rebuild command:"+ output `shouldNotContain` "dorebuild" output `shouldNotContain` "genrebuild" describe "revision comparisons" $ do@@ -153,8 +156,8 @@ output `shouldContain` "latest revision: <3 (ok)" output `shouldContain` "revision 0: <2" output `shouldContain` "dep: alpha requires bravo <2"- output `shouldContain` "Commit message:\nalpha 2.0, bravo 2.0\n\ngenrebuild -H haskell-alpha haskell-bravo"- last (lines output) `shouldBe` "genrebuild -H haskell-alpha haskell-bravo"+ output `shouldContain` "Rebuild command:\ndorebuild 'rebuild with alpha 2.0, bravo 2.0' `genrebuild -H haskell-alpha haskell-bravo`"+ last (lines output) `shouldBe` "dorebuild 'rebuild with alpha 2.0, bravo 2.0' `genrebuild -H haskell-alpha haskell-bravo`" it "keeps latest candidate failures blocking even when revision 0 accepts the set" $ do let specs range = [("alpha", [], [("2.0", lib ["bravo " <> range])]), ("bravo", [], [("2.0", [])])]@@ -561,7 +564,7 @@ assertWorking result [("alpha", "2.0"), ("bravo", "2.0")] Plan.planRequested result `shouldBe` Map.keysSet (Map.singleton (name "alpha") ()) show (Plan.prettyPlanResult result) `shouldContain` "bravo 1.0 -> 2.0 (added by solver)"- last (lines $ show $ Plan.prettyPlanResult result) `shouldBe` "genrebuild -H haskell-alpha haskell-bravo"+ last (lines $ show $ Plan.prettyPlanResult result) `shouldBe` "dorebuild 'rebuild with alpha 2.0, bravo 2.0' `genrebuild -H haskell-alpha haskell-bravo`" it "automatically updates a blocking reverse dependency" $ do result <- runPlan True [("alpha", Just "2.0")]@@ -579,7 +582,7 @@ assertBlocked result "rdep: haskell-zblocker" Plan.planVersions result `shouldBe` Map.fromList [(name "alpha", version "2.0"), (name "consumer", version "2.0")] show (Plan.prettyPlanResult result) `shouldNotContain` "rdep: haskell-consumer"- last (lines $ show $ Plan.prettyPlanResult result) `shouldBe` "genrebuild -H haskell-alpha haskell-consumer"+ last (lines $ show $ Plan.prettyPlanResult result) `shouldBe` "dorebuild 'rebuild with alpha 2.0, consumer 2.0' `genrebuild -H haskell-alpha haskell-consumer`" it "resolves other blockers even when the first blocker has futile upgrades" $ do result <- runPlan True [("alpha", Just "2.0")]@@ -679,6 +682,56 @@ assertBlocked result "dep: alpha requires base >=2" Map.keys (Plan.planVersions result) `shouldBe` [name "alpha"] + forM_ ["rts", "system-cxx-std-lib"] $ \package -> do+ forM_ [False, True] $ \solve ->+ it ("resolves " <> package <> " without repository provides, solve=" <> show solve) $ do+ let (extra, raw) = toolchainFixture [("alpha", [], [("2.0", lib [package <> " >=1 && <2"])])]+ result <- requireResult =<< runDB solve [("alpha", Just "2.0")] extra raw+ assertWorking result [("alpha", "2.0")]++ it ("checks bounds for " <> package <> " without repository provides") $ do+ let (extra, raw) = toolchainFixture [("alpha", [], [("2.0", lib [package <> " >=2"])])]+ result <- requireResult =<< runDB True [("alpha", Just "2.0")] extra raw+ assertBlocked result ("dep: alpha requires " <> package <> " >=2")+ show (Plan.prettyPlanResult result) `shouldNotContain` "missing from the update set and repository"+ Map.keys (Plan.planVersions result) `shouldBe` [name "alpha"]++ it ("rejects independent updates of " <> package <> " without repository provides") $ do+ let (extra, raw) = fixture []+ result <- runDB True [(package, Just "2.0")] extra raw+ case result of+ Right (Left err) -> err `shouldContain` "cannot be updated independently"+ _ -> expectationFailure "expected a compiler package request to be rejected"++ it ("does not solve dependency failures by independently upgrading " <> package) $ do+ result <- runPlan True [("alpha", Just "2.0")]+ [("alpha", [], [("2.0", lib [package <> " >=2"])]), (package, [], [("2.0", [])])]+ assertBlocked result ("dep: alpha requires " <> package <> " >=2")+ Map.keys (Plan.planVersions result) `shouldBe` [name "alpha"]++ forM_+ [ "file-io", "ghc-byteorder", "ghc-experimental", "ghc-internal", "ghc-platform", "ghc-toolchain",+ "haddock-api", "haddock-library", "os-string", "semaphore-compat", "template-haskell-lift", "template-haskell-quasiquoter", "hsc2hs"+ ] $ \package -> do+ it ("rejects independent updates of " <> package <> " only when provided by GHC") $ do+ let (extra, raw) = toolchainFixture [(package, [], [("2.0", [])])]+ provided = Map.adjust (\desc -> desc {_provides = [PkgDependent (toArchLinuxName $ name package) (Just "1.0")]}) (ArchLinuxName "ghc") extra+ rejected <- runDB True [(package, Nothing)] provided raw+ case rejected of+ Right (Left err) -> err `shouldContain` "cannot be updated independently"+ _ -> expectationFailure "expected a provided package request to be rejected"+ standalone <- requireResult =<< runDB True [(package, Nothing)] extra raw+ assertWorking standalone [(package, "2.0")]++ it ("keeps compiler-provided " <> package <> " fixed when solving other updates") $ do+ let (extra, raw) = toolchainFixture [("alpha", [], [("2.0", lib [package <> " >=2"])]), (package, [], [("2.0", [])])]+ provided = Map.adjust (\desc -> desc {_provides = [PkgDependent (toArchLinuxName $ name package) (Just "1.0")]}) (ArchLinuxName "ghc") extra+ blocked <- requireResult =<< runDB True [("alpha", Just "2.0")] provided raw+ assertBlocked blocked ("dep: alpha requires " <> package <> " >=2")+ Map.keys (Plan.planVersions blocked) `shouldBe` [name "alpha"]+ standalone <- requireResult =<< runDB True [("alpha", Just "2.0")] extra raw+ assertWorking standalone [("alpha", "2.0"), (package, "2.0")]+ it "can update an unparseable reverse dependent to a verifiable release" $ do result <- runPlan True [("alpha", Just "2.0")] [ ("alpha", [], [("2.0", lib ["consumer >=1.1"])]),@@ -968,7 +1021,8 @@ it "parses upstream snapshots and excludes Windows-only libraries" $ do let metadata = B8.pack $ unlines [ "ghc-9.6.7:", " ghc: 9.6.7", " base: '2.0'", " ghc-prim: '1.0'",- " template-haskell: '1.0'", " Win32: '2.0'", "ghcjs-0.2:", " base: '1.0'"+ " template-haskell: '1.0'", " rts: 1.0.2", " system-cxx-std-lib: '1.0'",+ " Win32: '2.0'", "ghcjs-0.2:", " base: '1.0'" ] Toolchain.parseGHCReleases metadata `shouldBe` Right (Map.take 1 toolchainReleases) @@ -991,7 +1045,7 @@ output `shouldContain` "base 1.0 -> 2.0" output `shouldNotContain` "ghc-prim 1.0 -> 1.0" output `shouldNotContain` "template-haskell 1.0 -> 1.0"- output `shouldContain` "Commit message:\nghc 9.6.7\n\ngenrebuild -H ghc"+ last (lines output) `shouldBe` "dorebuild 'rebuild with ghc 9.6.7' `genrebuild -H ghc`" output `shouldNotContain` "--ignore" it "hides the bundled summary when all library versions are unchanged" $ do@@ -1010,6 +1064,11 @@ assertWorking result [("ghc", "9.6.7")] show (Plan.prettyPlanResult result) `shouldContain` "os-string not in repo -> 2.0" + it "resolves compiler placeholders absent from repository metadata during GHC updates" $ do+ result <- runToolchainPlan True [("ghc", Nothing)]+ [("consumer", [], [("1.0", lib ["rts ==1.0.2", "system-cxx-std-lib ==1.0"])])]+ assertWorking result [("ghc", "9.6.7")]+ it "advances GHC incrementally when the next bundle is incompatible" $ do result <- runToolchainPlan True [("ghc", Nothing)] [("consumer", [], [("1.0", lib ["base ==1.0 || >=3"])])]@@ -1191,11 +1250,11 @@ show (Plan.prettyPlanResult result) `shouldContain` "libiserv 1.0 -> not bundled" it "uses the old upstream bundle for baseline libraries missing from repository provides" $ do- let baseline = Map.fromList [(name package, version release) | (package, release) <- [("ghc", "9.6.6"), ("base", "1.0"), ("rts", "1.0")]]- releases = Map.insert (version "9.6.6") baseline $ Map.adjust (Map.insert (name "rts") (version "2.0")) (version "9.6.7") toolchainReleases- (extra, raw) = toolchainFixture [("consumer", [], [("1.0", lib ["rts <2"])])]+ let baseline = Map.fromList [(name package, version release) | (package, release) <- [("ghc", "9.6.6"), ("base", "1.0"), ("ghc-heap", "1.0")]]+ releases = Map.insert (version "9.6.6") baseline $ Map.adjust (Map.insert (name "ghc-heap") (version "2.0")) (version "9.6.7") toolchainReleases+ (extra, raw) = toolchainFixture [("consumer", [], [("1.0", lib ["ghc-heap <2"])])] result <- requireResult =<< runDBWithToolchains releases Nothing Map.empty False [("ghc", Nothing)] extra raw- assertBlocked result "rdep: haskell-consumer Depends requires rts <2"+ assertBlocked result "rdep: haskell-consumer Depends requires ghc-heap <2" length (Plan.planWarnings result) `shouldBe` 0 it "uses newly bundled library versions instead of standalone repository versions" $ do@@ -1256,7 +1315,7 @@ toolchainReleases :: Toolchain.GHCReleases toolchainReleases = Map.fromList- [ (version compiler, Map.fromList [(name package, version release) | (package, release) <- [("ghc", compiler), ("base", base), ("ghc-prim", "1.0"), ("template-haskell", "1.0")]])+ [ (version compiler, Map.fromList [(name package, version release) | (package, release) <- [("ghc", compiler), ("base", base), ("ghc-prim", "1.0"), ("template-haskell", "1.0"), ("rts", "1.0.2"), ("system-cxx-std-lib", "1.0")]]) | (compiler, base) <- [("9.6.7", "2.0"), ("9.8.1", "3.0"), ("9.8.2", "4.0")] ] @@ -1309,6 +1368,7 @@ { _name = toArchLinuxName $ name package, _version = "1.0", _rawVersion = "1.0-1",+ _buildDate = Nothing, _desc = "Planner fixture", _url = Nothing, _provides = [],@@ -1383,11 +1443,11 @@ Plan.planIsReady result `shouldBe` False show (Plan.prettyPlanResult result) `shouldContain` "Blocked update set" show (Plan.prettyPlanResult result) `shouldContain` message- show (Plan.prettyPlanResult result) `shouldContain` "Commit message:"+ show (Plan.prettyPlanResult result) `shouldContain` "Rebuild command:\ndorebuild 'rebuild with " assertUnchecked :: Plan.PlanResult -> String -> Expectation assertUnchecked result message = do Plan.planIsReady result `shouldBe` True show (Plan.prettyPlanResult result) `shouldContain` "Update plan ready (with unchecked packages)" show (Plan.prettyPlanResult result) `shouldContain` message- show (Plan.prettyPlanResult result) `shouldContain` "Commit message:"+ show (Plan.prettyPlanResult result) `shouldContain` "Rebuild command:\ndorebuild 'rebuild with "