Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/3143edfa4b3aa8eb131058da02fd3096b2153705 >--------------------------------------------------------------- commit 3143edfa4b3aa8eb131058da02fd3096b2153705 Author: Duncan Coutts <[email protected]> Date: Fri Dec 19 21:59:22 2008 +0000 Use a more precise package substitution test in improvePlan This is where we take a valid plan and we "improve" it by swapping installed packages for available packages wherever possible. This change is to the condition we use in deciding if it is safe to use the installed package in place of a reinstall. Previously we checked that the dependencies of the installed version were exactly the same as the dependencies we were planning to reinstall with. That was valid but rather conservative. It caused problems in some situations where the installed package did not exactly match the available package (eg when using development versions of a package or of ghc). What we do now is test if the extra constraints implied by selecting the installed version are consistent with the existing set of constraints. This involves threading the constraint set around. In theory this should even cope with adding additional packages to the plan as a result of selecting an installed package. >--------------------------------------------------------------- .../Distribution/Client/Dependency/TopDown.hs | 66 ++++++++++++++------ 1 files changed, 47 insertions(+), 19 deletions(-) diff --git a/cabal-install/Distribution/Client/Dependency/TopDown.hs b/cabal-install/Distribution/Client/Dependency/TopDown.hs index 84e0bd3..33353e6 100644 --- a/cabal-install/Distribution/Client/Dependency/TopDown.hs +++ b/cabal-install/Distribution/Client/Dependency/TopDown.hs @@ -54,7 +54,7 @@ import Distribution.Text import Data.List ( foldl', maximumBy, minimumBy, nub, sort, groupBy ) import Data.Maybe - ( fromJust, fromMaybe ) + ( fromJust, fromMaybe, catMaybes ) import Data.Monoid ( Monoid(mempty) ) import Control.Monad @@ -254,10 +254,11 @@ topDownResolver' platform comp installed available initialPkgNames = Set.fromList targets - finalise selected = PackageIndex.allPackages - . improvePlan installed' - . PackageIndex.fromList - . finaliseSelectedPackages preferences selected + finalise selected' constraints' = + PackageIndex.allPackages + . fst . improvePlan installed' constraints' + . PackageIndex.fromList + $ finaliseSelectedPackages preferences selected' constraints' addTopLevelConstraints :: [PackageConstraint] -> Constraints -> Progress a Failure Constraints @@ -462,35 +463,62 @@ finaliseSelectedPackages pref selected constraints = -- | Improve an existing installation plan by, where possible, swapping -- packages we plan to install with ones that are already installed. +-- This may add additional constraints due to the dependencies of installed +-- packages on other installed packages. -- improvePlan :: PackageIndex InstalledPackageInfo + -> Constraints -> PackageIndex PlanPackage - -> PackageIndex PlanPackage -improvePlan installed selected = foldl' improve selected - $ reverseTopologicalOrder selected + -> (PackageIndex PlanPackage, Constraints) +improvePlan installed constraints0 selected0 = + foldl' improve (selected0, constraints0) (reverseTopologicalOrder selected0) where - improve selected' = maybe selected' (flip PackageIndex.insert selected') - . improvePkg selected' + improve (selected, constraints) = fromMaybe (selected, constraints) + . improvePkg selected constraints -- The idea is to improve the plan by swapping a configured package for -- an equivalent installed one. For a particular package the condition is -- that the package be in a configured state, that a the same version be -- already installed with the exact same dependencies and all the packages -- in the plan that it depends on are in the installed state - improvePkg selected' pkgid = do - Configured pkg <- PackageIndex.lookupPackageId selected' pkgid + improvePkg selected constraints pkgid = do + Configured pkg <- PackageIndex.lookupPackageId selected pkgid ipkg <- PackageIndex.lookupPackageId installed pkgid - guard $ sort (depends pkg) == nub (sort (depends ipkg)) - guard $ all (isInstalled selected') (depends pkg) - return (PreExisting ipkg) + guard $ all (isInstalled selected) (depends pkg) + tryInstalled selected constraints [ipkg] - isInstalled selected' pkgid = - case PackageIndex.lookupPackageId selected' pkgid of + isInstalled selected pkgid = + case PackageIndex.lookupPackageId selected pkgid of Just (PreExisting _) -> True _ -> False - reverseTopologicalOrder :: PackageFixedDeps pkg => PackageIndex pkg - -> [PackageIdentifier] + tryInstalled :: PackageIndex PlanPackage -> Constraints + -> [InstalledPackageInfo] + -> Maybe (PackageIndex PlanPackage, Constraints) + tryInstalled selected constraints [] = Just (selected, constraints) + tryInstalled selected constraints (pkg:pkgs) = + case constraintsOk (packageId pkg) (depends pkg) constraints of + Nothing -> Nothing + Just constraints' -> tryInstalled selected' constraints' pkgs' + where + selected' = PackageIndex.insert (PreExisting pkg) selected + pkgs' = catMaybes (map notSelected (depends pkg)) ++ pkgs + notSelected pkgid = + case (PackageIndex.lookupPackageId installed pkgid + ,PackageIndex.lookupPackageId selected pkgid) of + (Just pkg', Nothing) -> Just pkg' + _ -> Nothing + + constraintsOk _ [] constraints = Just constraints + constraintsOk pkgid (pkgid':pkgids) constraints = + case addPackageDependencyConstraint pkgid dep constraints of + Satisfiable constraints' _ -> constraintsOk pkgid pkgids constraints' + _ -> Nothing + where + dep = TaggedDependency InstalledConstraint (thisPackageVersion pkgid') + + reverseTopologicalOrder :: PackageFixedDeps pkg + => PackageIndex pkg -> [PackageIdentifier] reverseTopologicalOrder index = map (packageId . toPkg) . Graph.topSort . Graph.transposeG _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
