diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PackageIndex.hs b/cabal-install-solver/src/Distribution/Solver/Types/PackageIndex.hs index 6106f61c3b3..59e55816cb0 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 035adde98e0..a12a4ee2158 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -378,7 +378,21 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do -> PackageIndex UnresolvedSourcePackage addIndex acc (RepoData _ _ _ _, CombineStrategySkip) = acc addIndex acc (RepoData _ _ idx _, CombineStrategyMerge) = PackageIndex.merge acc idx - addIndex acc (RepoData _ _ idx _, CombineStrategyOverride) = PackageIndex.override acc idx + addIndex acc (RepoData _ _ idx prefs, CombineStrategyOverride) = + PackageIndex.overrideOrMerge strategy acc idx + where + strategy pkgname + -- We only want to merge a package when no version in idx is marked + -- as preferred/when all versions are deprecated. + | Just pkgPrefs <- Map.lookup pkgname prefsByPkg + , null $ PackageIndex.lookupDependency idx pkgname pkgPrefs = + PackageIndex.Merge + | otherwise = PackageIndex.Override + + prefsByPkg = + Map.fromListWith + intersectVersionRanges + [(name, range) | Dependency name range _ <- prefs] let pkgs :: PackageIndex UnresolvedSourcePackage pkgs = foldl' addIndex mempty pkgss'