[commit: Cabal] master: Have Constraints.constrain report the excluded packages (ac1cb65)

[Ian Lynagh]

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 <duncan at haskell.org>
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