From 2379e8c1f47e6b9d1858a5c37b551380904c8c29 Mon Sep 17 00:00:00 2001 From: amesgen Date: Thu, 23 Apr 2026 12:39:29 +1000 Subject: [PATCH] active-repositories: Don't override fully-deprecated packages When active-repositories includes a repo with :override, and that repo's preferred-versions marks all its versions of a package as deprecated, the index-combining step previously still applied full override semantics, hiding all versions of that package from earlier repos. Fix by consulting preferred-versions when combining indexes: if lookupDependency finds no preferred version for a package in the override repo, fall back to merge semantics so earlier-repo versions remain visible. Two changes: - PackageIndex: add overrideOrMerge, a per-package Override/Merge strategy - IndexUtils: add deprecationAwareStrategy, wired into getSourcePackagesAtIndexState Fixes https://github.com/haskell/cabal/issues/8502 This code was originally authored by Alexander Esgen and sumbitted in a PR over 2 years ago. Erik manually rebased that code onto master and used Claude to add tests and do some very minor refactoring to Alexander's code to make it more testable. Co-Authored-By: Erik de Castro Lopo Co-Authored-By: Claude Sonnet 4.6 --- .../Distribution/Solver/Types/PackageIndex.hs | 24 +++ .../src/Distribution/Client/IndexUtils.hs | 43 +++- .../Distribution/Client/IndexUtils.hs | 185 ++++++++++++++++++ changelog.d/pr-11760 | 17 ++ doc/cabal-project-description-file.rst | 7 + 5 files changed, 275 insertions(+), 1 deletion(-) create mode 100644 changelog.d/pr-11760 diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PackageIndex.hs b/cabal-install-solver/src/Distribution/Solver/Types/PackageIndex.hs index 294758c4d9c..c11e7662eae 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/PackageIndex.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/PackageIndex.hs @@ -22,6 +22,8 @@ module Distribution.Solver.Types.PackageIndex ( -- * Updates merge, override, + OverrideOrMerge(..), + overrideOrMerge, insert, deletePackageName, deletePackageId, @@ -181,6 +183,28 @@ override i1@(PackageIndex m1) i2@(PackageIndex m2) = expensiveAssert (invariant i1 && invariant i2) $ mkPackageIndex (Map.unionWith (\_l r -> r) m1 m2) +data OverrideOrMerge = Override | Merge + deriving (Eq, Show) + +-- | Combined override-or-merge of two indexes. +-- +-- For any package, either 'override' or 'merge' the packages from the second +-- index into the first based on the supplied predicate. +-- +overrideOrMerge :: + Package pkg + => (PackageName -> OverrideOrMerge) + -> PackageIndex pkg + -> PackageIndex pkg + -> PackageIndex pkg +overrideOrMerge strategy i1@(PackageIndex m1) i2@(PackageIndex m2) = + expensiveAssert (invariant i1 && invariant i2) $ + mkPackageIndex (Map.unionWithKey overridePkg m1 m2) + where + overridePkg name l r = case strategy name of + Override -> r + Merge -> mergeBuckets l r + -- | Inserts a single package into the index. -- -- This is equivalent to (but slightly quicker than) using 'mappend' or diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index d5539b41edd..13ad9a8fd27 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -30,6 +30,8 @@ module Distribution.Client.IndexUtils , ActiveRepos , filterSkippedActiveRepos , applyStrategy + , addIndex + , deprecationAwareStrategy , Index (..) , RepoIndexState (..) , PackageEntry (..) @@ -374,7 +376,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do ] let pkgs :: PackageIndex UnresolvedSourcePackage - pkgs = foldl' (\acc (rd, s) -> applyStrategy acc (rdIndex rd, s)) mempty pkgss' + pkgs = foldl' (\acc (rd, s) -> addIndex acc (rdIndex rd, rdPreferences rd, s)) mempty pkgss' -- Note: preferences combined without using CombineStrategy let prefs :: Map PackageName VersionRange @@ -419,6 +421,45 @@ applyStrategy acc (_, CombineStrategySkip) = acc applyStrategy acc (idx, CombineStrategyMerge) = PackageIndex.merge acc idx applyStrategy acc (idx, CombineStrategyOverride) = PackageIndex.override acc idx +-- | Fold one package index and its preferred-versions into an accumulator +-- according to a 'CombineStrategy'. +-- +-- Like 'applyStrategy', but for 'CombineStrategyOverride' consults the +-- repo's @preferred-versions@ via 'deprecationAwareStrategy': if all +-- versions of a package are deprecated in the override repo, merge +-- semantics are used for that package instead of override semantics. +addIndex + :: Package pkg + => PackageIndex pkg + -> (PackageIndex pkg, [Dependency], CombineStrategy) + -> PackageIndex pkg +addIndex acc (idx, prefs, CombineStrategyOverride) = + PackageIndex.overrideOrMerge (deprecationAwareStrategy idx prefsByPkg) acc idx + where + prefsByPkg = + Map.fromListWith + intersectVersionRanges + [(name, range) | Dependency name range _ <- prefs] +addIndex acc (idx, _, s) = applyStrategy acc (idx, s) + +-- | Per-package override-or-merge decision for a 'CombineStrategyOverride' repo. +-- +-- Returns 'PackageIndex.Merge' when every version of the package in the +-- override index is deprecated (i.e. excluded by the repo's +-- @preferred-versions@), so that versions from earlier repos remain visible. +-- Returns 'PackageIndex.Override' otherwise. +deprecationAwareStrategy + :: Package pkg + => PackageIndex pkg + -> Map PackageName VersionRange + -> PackageName + -> PackageIndex.OverrideOrMerge +deprecationAwareStrategy idx prefsByPkg pkgname + | Just pkgPrefs <- Map.lookup pkgname prefsByPkg + , null $ PackageIndex.lookupDependency idx pkgname pkgPrefs = + PackageIndex.Merge + | otherwise = PackageIndex.Override + -- | Read a repository index from disk, from the local file specified by -- the 'Repo'. -- diff --git a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils.hs b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils.hs index a4a69870588..212e2187d4c 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils.hs @@ -5,11 +5,13 @@ import Distribution.Client.IndexUtils.ActiveRepos import qualified Distribution.Compat.NonEmptySet as NES import Distribution.Package import Distribution.Simple.Utils (toUTF8LBS) +import Distribution.Solver.Types.PackageIndex (OverrideOrMerge (..)) import qualified Distribution.Solver.Types.PackageIndex as PackageIndex import Distribution.Types.LibraryName import Distribution.Version import qualified Data.List as List +import qualified Data.Map.Strict as Map import Test.Tasty import Test.Tasty.HUnit @@ -18,6 +20,9 @@ tests :: [TestTree] tests = [ simpleVersionsParserTests , indexCombiningTests + , overrideOrMergeTests + , deprecationAwareStrategyTests + , addIndexTests ] -- --------------------------------------------------------------------------- @@ -193,3 +198,183 @@ repoBar1 = PackageIndex.fromList [bar1] repoFoo12, repoFoo1bar1 :: PackageIndex.PackageIndex PackageIdentifier repoFoo12 = PackageIndex.fromList [foo1, foo2] repoFoo1bar1 = PackageIndex.fromList [foo1, bar1] + +-- --------------------------------------------------------------------------- +-- overrideOrMerge tests +-- +-- These test PackageIndex.overrideOrMerge directly, which is the building +-- block for conditionally falling back to merge when all versions of a +-- package in the override repo are deprecated (issue #8502). +-- --------------------------------------------------------------------------- + +overrideOrMergeTests :: TestTree +overrideOrMergeTests = + testGroup + "overrideOrMerge" + [ testCase "all-Override strategy matches plain override" $ + -- When strategy always returns Override, result equals PackageIndex.override + let result = PackageIndex.overrideOrMerge (const Override) repoFoo12 repoFoo2 + expected = PackageIndex.override repoFoo12 repoFoo2 + in allPkgs result @?= allPkgs expected + , testCase "all-Merge strategy matches plain merge" $ + -- When strategy always returns Merge, result equals PackageIndex.merge + let result = PackageIndex.overrideOrMerge (const Merge) repoFoo12 repoFoo2 + expected = PackageIndex.merge repoFoo12 repoFoo2 + in allPkgs result @?= allPkgs expected + , testCase "Override: second index wins entire package bucket" $ + -- repoFoo12 has foo-1.0 and foo-2.0; repoFoo2 has only foo-2.0. + -- Override means repoFoo2 wins the 'foo' bucket, so foo-1.0 is hidden. + allPkgs (PackageIndex.overrideOrMerge (const Override) repoFoo12 repoFoo2) + @?= [foo2] + , testCase "Merge: both buckets combined, duplicates removed" $ + -- repoFoo12 has foo-1.0 and foo-2.0; repoFoo2 has only foo-2.0. + -- Merge keeps foo-1.0 and foo-2.0 (foo-2.0 deduplicated). + allPkgs (PackageIndex.overrideOrMerge (const Merge) repoFoo12 repoFoo2) + @?= List.sort [foo1, foo2] + , testCase "mixed strategy: Override for foo, Merge for bar" $ + -- repoFoo1bar1 has foo-1.0 and bar-1.0; second index has foo-2.0 and bar-1.0. + -- foo is overridden (foo-1.0 hidden), bar is merged (bar-1.0 deduplicated). + let i2 = PackageIndex.fromList [foo2, bar1] + strategy name + | name == mkPackageName "foo" = Override + | otherwise = Merge + in allPkgs (PackageIndex.overrideOrMerge strategy repoFoo1bar1 i2) + @?= List.sort [foo2, bar1] + , testCase "deprecated fallback: Merge when override repo has only deprecated versions" $ + -- Simulates the issue-8502 scenario: repo-a has foo-1.0; repo-b (override) + -- has foo-2.0 but all its versions are deprecated. The caller detects this + -- and passes Merge for 'foo', so foo-1.0 remains visible alongside foo-2.0. + let repoA = PackageIndex.fromList [foo1] + repoB = PackageIndex.fromList [foo2] -- pretend all deprecated + strategy name + | name == mkPackageName "foo" = Merge -- fall back because all deprecated + | otherwise = Override + in allPkgs (PackageIndex.overrideOrMerge strategy repoA repoB) + @?= List.sort [foo1, foo2] + , testCase "package absent from second index: first index versions kept" $ + -- bar is only in repoFoo1bar1, not in repoFoo2; it survives regardless of strategy. + allPkgs (PackageIndex.overrideOrMerge (const Override) repoFoo1bar1 repoFoo2) + @?= List.sort [foo2, bar1] + , testCase "package absent from first index: second index versions appear" $ + allPkgs (PackageIndex.overrideOrMerge (const Override) repoFoo1 repoBar1) + @?= List.sort [foo1, bar1] + , testCase "empty first index: second index fully visible" $ + allPkgs (PackageIndex.overrideOrMerge (const Override) mempty repoFoo12) + @?= List.sort [foo1, foo2] + , testCase "empty second index: first index unchanged" $ + allPkgs (PackageIndex.overrideOrMerge (const Override) repoFoo12 mempty) + @?= List.sort [foo1, foo2] + ] + +allPkgs :: PackageIndex.PackageIndex PackageIdentifier -> [PackageIdentifier] +allPkgs = List.sort . PackageIndex.allPackages + +-- --------------------------------------------------------------------------- +-- deprecationAwareStrategy tests +-- +-- Tests for the per-package Override/Merge decision used when applying a +-- CombineStrategyOverride repo. The three cases are: +-- 1. Package absent from preferred-versions -> Override +-- 2. Package present, some versions preferred -> Override +-- 3. Package present, no versions preferred -> Merge (all deprecated) +-- --------------------------------------------------------------------------- + +deprecationAwareStrategyTests :: TestTree +deprecationAwareStrategyTests = + testGroup + "deprecationAwareStrategy" + [ testCase "package absent from preferred-versions gives Override" $ + -- No entry for 'foo' in prefs, so the repo is not restricting it. + strat repoFoo1 Map.empty fooName @?= Override + , testCase "package present with matching versions gives Override" $ + -- foo-1.0 is in the index and satisfies ">= 1.0", so not all deprecated. + strat repoFoo1 (prefs fooName (orLaterVersion v1)) fooName @?= Override + , testCase "package present but no versions match gives Merge" $ + -- foo-1.0 is in the index but the pref ">= 2.0" excludes it: all deprecated. + strat repoFoo1 (prefs fooName (orLaterVersion v2)) fooName @?= Merge + , testCase "unrelated package in prefs does not affect result" $ + -- Prefs only mention 'bar'; 'foo' has no pref entry, so Override. + strat repoFoo1 (prefs barName (orLaterVersion v1)) fooName @?= Override + , testCase "package absent from index but in prefs gives Merge" $ + -- The pref entry exists but the index is empty, so lookupDependency + -- returns [], meaning no preferred version exists. + strat mempty (prefs fooName (orLaterVersion v2)) fooName @?= Merge + , testCase "multiple packages decided independently" $ + -- foo is deprecated (pref excludes foo-1.0), bar is not (bar-1.0 satisfies >= 1.0). + let p = + Map.unionWith + intersectVersionRanges + (prefs fooName (orLaterVersion v2)) + (prefs barName (orLaterVersion v1)) + in do + strat repoFoo1bar1 p fooName @?= Merge + strat repoFoo1bar1 p barName @?= Override + ] + where + strat = deprecationAwareStrategy + fooName = mkPackageName "foo" + barName = mkPackageName "bar" + v1 = mkVersion [1, 0] + v2 = mkVersion [2, 0] + prefs name vr = Map.singleton name vr + +-- --------------------------------------------------------------------------- +-- addIndex tests +-- +-- Tests for the top-level addIndex, which is the function used by +-- getSourcePackagesAtIndexState to fold each repository's index into the +-- accumulator. Unlike applyStrategy, addIndex consults preferred-versions +-- for CombineStrategyOverride, falling back to merge when all versions of a +-- package are deprecated. A regression to plain override would cause the +-- "all deprecated" test to fail. +-- --------------------------------------------------------------------------- + +addIndexTests :: TestTree +addIndexTests = + testGroup + "addIndex" + [ testCase "Skip: index not added" $ + run [(repoFoo1, [], CombineStrategySkip)] + @?= [] + , testCase "Merge: index added" $ + run [(repoFoo1, [], CombineStrategyMerge)] + @?= [foo1] + , testCase "Override with no prefs: behaves like plain override" $ + run + [ (repoFoo12, [], CombineStrategyMerge) + , (repoFoo2, [], CombineStrategyOverride) + ] + @?= [foo2] + , testCase "Override with prefs matching some versions: still overrides" $ + -- foo-2.0 satisfies ">= 2.0", so not all deprecated; override applies. + run + [ (repoFoo12, [], CombineStrategyMerge) + , (repoFoo2, [dep fooName (orLaterVersion v2)], CombineStrategyOverride) + ] + @?= [foo2] + , testCase "Override with all versions deprecated: falls back to merge" $ + -- foo-2.0 does not satisfy ">= 3.0", so all versions deprecated; + -- override falls back to merge, keeping foo-1.0 from the first repo. + run + [ (repoFoo1, [], CombineStrategyMerge) + , (repoFoo2, [dep fooName (orLaterVersion v3)], CombineStrategyOverride) + ] + @?= List.sort [foo1, foo2] + , testCase "Override: only the deprecated package falls back, others still override" $ + -- foo is all-deprecated in override repo → merge; bar has no prefs → override. + run + [ (repoFoo1bar1, [], CombineStrategyMerge) + , + ( PackageIndex.fromList [foo2, bar1] + , [dep fooName (orLaterVersion v3)] + , CombineStrategyOverride + ) + ] + @?= List.sort [foo1, foo2, bar1] + ] + where + run = allPkgs . List.foldl' (\acc (idx, ps, s) -> addIndex acc (idx, ps, s)) mempty + fooName = mkPackageName "foo" + v2 = mkVersion [2, 0] + v3 = mkVersion [3, 0] + dep name vr = Dependency name vr (NES.singleton LMainLibName) diff --git a/changelog.d/pr-11760 b/changelog.d/pr-11760 new file mode 100644 index 00000000000..6fb871d650c --- /dev/null +++ b/changelog.d/pr-11760 @@ -0,0 +1,17 @@ +--- +synopsis: "active-repositories: don't override fully-deprecated packages" +packages: [cabal-install, cabal-install-solver] +prs: 11760 +--- + +When `active-repositories` includes a repo with `:override`, and that +repo's `preferred-versions` marks all its versions of a package as +deprecated, the index-combining step previously still applied full +override semantics, hiding all versions of that package from earlier +repos. + +Fix by consulting `preferred-versions` when combining indexes: if no +version of the package in the override repo is preferred, fall back to +merge semantics so earlier-repo versions remain visible. + +Fixes https://github.com/haskell/cabal/issues/8502 diff --git a/doc/cabal-project-description-file.rst b/doc/cabal-project-description-file.rst index fc7d9a3eb87..e4bd6264480 100644 --- a/doc/cabal-project-description-file.rst +++ b/doc/cabal-project-description-file.rst @@ -782,6 +782,13 @@ The following settings control the behavior of the dependency solver: present in my-repository only in version 2.0, and the :override forbids searching for other versions of X further up the list. + There is one exception: if all versions of a package in the overriding + repository are deprecated (i.e. excluded by that repository's + ``preferred-versions``), :override falls back to merge semantics for that + package, so versions from earlier repositories remain visible. This avoids + a situation where a fully-deprecated override inadvertently hides all + usable versions of a package. + :override has no effect for package names that aren't present in the overriding repository.