Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/ac1cb65985ac0a08f529d5cb5aa6f488e84b8ff9 >--------------------------------------------------------------- commit ac1cb65985ac0a08f529d5cb5aa6f488e84b8ff9 Author: Duncan Coutts <[email protected]> Date: Sat Oct 4 23:50:06 2008 +0000 Have Constraints.constrain report the excluded packages Each time we apply a constraint we can end up excluding some extra package. Report that list of packages because it is quite interesting information to get insight into what the resolver is actually doing. >--------------------------------------------------------------- .../Distribution/Client/Dependency/TopDown.hs | 39 +++++++++++--------- .../Client/Dependency/TopDown/Constraints.hs | 9 +++-- 2 files changed, 27 insertions(+), 21 deletions(-) diff --git a/cabal-install/Distribution/Client/Dependency/TopDown.hs b/cabal-install/Distribution/Client/Dependency/TopDown.hs index 7d2030b..bab47e3 100644 --- a/cabal-install/Distribution/Client/Dependency/TopDown.hs +++ b/cabal-install/Distribution/Client/Dependency/TopDown.hs @@ -146,10 +146,10 @@ searchSpace configure constraints selected next = newDeps = packageConstraints pkg' next' = Set.delete name $ foldl' (flip Set.insert) next newPkgs - in case constrainDeps pkg' newDeps constraints of - Left failure -> Failure failure - Right constraints' -> searchSpace configure - constraints' selected' next' + in case constrainDeps pkg' newDeps constraints [] of + Left failure -> Failure failure + Right (constraints', _) -> searchSpace configure + constraints' selected' next' packageConstraints :: SelectedPackage -> [TaggedDependency] packageConstraints = either installedConstraints availableConstraints @@ -165,16 +165,17 @@ packageConstraints = either installedConstraints availableConstraints [ TaggedDependency NoInstalledConstraint dep | dep <- deps ] constrainDeps :: SelectedPackage -> [TaggedDependency] -> Constraints - -> Either Failure Constraints -constrainDeps pkg [] cs = + -> [PackageIdentifier] + -> Either Failure (Constraints, [PackageIdentifier]) +constrainDeps pkg [] cs discard = case addPackageSelectConstraint (packageId pkg) cs of - Satisfiable cs' -> Right cs' - _ -> impossible -constrainDeps pkg (dep:deps) cs = + Satisfiable cs' discard' -> Right (cs', discard' ++ discard) + _ -> impossible +constrainDeps pkg (dep:deps) cs discard = case addPackageDependencyConstraint (packageId pkg) dep cs of - Satisfiable cs' -> constrainDeps pkg deps cs' - Unsatisfiable -> impossible - ConflictsWith conflicts -> + Satisfiable cs' discard' -> constrainDeps pkg deps cs' (discard' ++ discard) + Unsatisfiable -> impossible + ConflictsWith conflicts -> Left (DependencyConflict pkg dep conflicts) -- ------------------------------------------------------------ @@ -237,7 +238,7 @@ constrainTopLevelDeps :: [UnresolvedDependency] -> Constraints constrainTopLevelDeps [] cs = Done cs constrainTopLevelDeps (UnresolvedDependency dep _:deps) cs = case addTopLevelDependencyConstraint dep cs of - Satisfiable cs' -> constrainTopLevelDeps deps cs' + Satisfiable cs' _ -> constrainTopLevelDeps deps cs' Unsatisfiable -> Fail (TopLevelDependencyUnsatisfiable dep) ConflictsWith conflicts -> Fail (TopLevelDependencyConflict dep conflicts) @@ -440,7 +441,8 @@ improvePlan installed selected = foldl' improve selected -- ------------------------------------------------------------ addPackageSelectConstraint :: PackageIdentifier -> Constraints - -> Satisfiable Constraints ExclusionReason + -> Satisfiable Constraints + [PackageIdentifier] ExclusionReason addPackageSelectConstraint pkgid constraints = Constraints.constrain dep reason constraints where @@ -448,7 +450,8 @@ addPackageSelectConstraint pkgid constraints = reason = SelectedOther pkgid addPackageExcludeConstraint :: PackageIdentifier -> Constraints - -> Satisfiable Constraints ExclusionReason + -> Satisfiable Constraints + [PackageIdentifier] ExclusionReason addPackageExcludeConstraint pkgid constraints = Constraints.constrain dep reason constraints where @@ -457,14 +460,16 @@ addPackageExcludeConstraint pkgid constraints = reason = ExcludedByConfigureFail addPackageDependencyConstraint :: PackageIdentifier -> TaggedDependency -> Constraints - -> Satisfiable Constraints ExclusionReason + -> Satisfiable Constraints + [PackageIdentifier] ExclusionReason addPackageDependencyConstraint pkgid dep constraints = Constraints.constrain dep reason constraints where reason = ExcludedByPackageDependency pkgid dep addTopLevelDependencyConstraint :: Dependency -> Constraints - -> Satisfiable Constraints ExclusionReason + -> Satisfiable Constraints + [PackageIdentifier] ExclusionReason addTopLevelDependencyConstraint dep constraints = Constraints.constrain taggedDep reason constraints where diff --git a/cabal-install/Distribution/Client/Dependency/TopDown/Constraints.hs b/cabal-install/Distribution/Client/Dependency/TopDown/Constraints.hs index 8836fbb..ab034c0 100644 --- a/cabal-install/Distribution/Client/Dependency/TopDown/Constraints.hs +++ b/cabal-install/Distribution/Client/Dependency/TopDown/Constraints.hs @@ -126,8 +126,8 @@ choices :: (Package installed, Package available) -> PackageIndex (InstalledOrAvailable installed available) choices (Constraints available _) = available -data Satisfiable a reason - = Satisfiable a +data Satisfiable constraints discarded reason + = Satisfiable constraints discarded | Unsatisfiable | ConflictsWith [(PackageIdentifier, [reason])] @@ -135,7 +135,8 @@ constrain :: (Package installed, Package available) => TaggedDependency -> reason -> Constraints installed available reason - -> Satisfiable (Constraints installed available reason) reason + -> Satisfiable (Constraints installed available reason) + [PackageIdentifier] reason constrain (TaggedDependency installedConstraint (Dependency name versionRange)) reason constraints@(Constraints available excluded) @@ -146,7 +147,7 @@ constrain (TaggedDependency installedConstraint (Dependency name versionRange)) | otherwise = let constraints' = Constraints available' excluded' in assert (constraints `transitionsTo` constraints') $ - Satisfiable constraints' + Satisfiable constraints' (map packageId newExcluded) where -- This tells us if any packages would remain at all for this package name if _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
