[commit: Cabal] master: Rearrange and tidy bits of the topdown resolver (6a5c355)

[Paolo Capriotti]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/6a5c355600555c29d30ffb07c58b47c1bc82b238

>---------------------------------------------------------------

commit 6a5c355600555c29d30ffb07c58b47c1bc82b238
Author: Duncan Coutts <duncan at haskell.org>
Date:   Fri May 30 17:03:06 2008 +0000

    Rearrange and tidy bits of the topdown resolver

>---------------------------------------------------------------

 cabal-install/Hackage/Dependency/TopDown.hs |   49 ++++++++++++++++----------
 1 files changed, 30 insertions(+), 19 deletions(-)

diff --git a/cabal-install/Hackage/Dependency/TopDown.hs b/cabal-install/Hackage/Dependency/TopDown.hs
index 0deab70..e5517e8 100644
--- a/cabal-install/Hackage/Dependency/TopDown.hs
+++ b/cabal-install/Hackage/Dependency/TopDown.hs
@@ -115,17 +115,18 @@ searchSpace configure constraints selected next =
       Left missing -> Failure $ ConfigureFailed pkg
                         [ (dep, Constraints.conflicting constraints dep)
                         | dep <- missing ]
-      Right pkg' -> case constrainDeps pkg' (packageConstraints pkg') constraints of
-        Left failure       -> Failure failure
-        Right constraints' -> searchSpace configure constraints'' selected' next'
-          where
-            selected' = PackageIndex.insert pkg' selected
-            next'     = Set.delete name $ foldr Set.insert next new
-            new       = [ name'
+      Right pkg' ->
+        let selected' = PackageIndex.insert pkg' selected
+            newPkgs   = [ name'
                         | dep <- packageConstraints pkg'
                         , let (Dependency name' _) = untagDependency dep
                         , null (PackageIndex.lookupPackageName selected' name') ]
-            Satisfiable constraints'' = addPackageSelectConstraint (packageId pkg) constraints'
+            newDeps   = packageConstraints pkg'
+            next'     = Set.delete name $ foldr Set.insert next newPkgs
+         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
@@ -142,7 +143,10 @@ packageConstraints = either installedConstraints availableConstraints
 
 constrainDeps :: SelectedPackage -> [TaggedDependency] -> Constraints
               -> Either Failure Constraints
-constrainDeps _   []         cs = Right cs
+constrainDeps pkg []         cs =
+  case addPackageSelectConstraint (packageId pkg) cs of
+    Satisfiable cs' -> Right cs'
+    _               -> impossible
 constrainDeps pkg (dep:deps) cs =
   case addPackageDependencyConstraint (packageId pkg) dep cs of
     Satisfiable cs' -> constrainDeps pkg deps cs'
@@ -189,15 +193,8 @@ topDownResolver' os arch comp installed available deps =
 
   where
     --TODO add actual constraints using addTopLevelDependencyConstraint
-    constraints = Constraints.empty installed' available
-
-    installed' = PackageIndex.fromList
-                   [ InstalledPackage pkg (transitiveDepends pkg)
-                   | pkg <- PackageIndex.allPackages installed ]   
-    transitiveDepends :: InstalledPackageInfo -> [PackageIdentifier]
-    transitiveDepends = map toPkgid . tail . Graph.reachable graph
-                      . fromJust . toVertex . packageId
-    (graph, toPkgid, toVertex) = PackageIndex.dependencyGraph installed
+    constraints = Constraints.empty (annotateInstalledPackages installed)
+                                    available
 
     initialDeps     = [ dep  | UnresolvedDependency dep _ <- deps ]
     initialPkgNames = Set.fromList [ name | Dependency name _ <- initialDeps ]
@@ -215,6 +212,20 @@ configurePackage os arch comp available spkg = case spkg of
       Right (pkg, flags) -> Right $
         SemiConfiguredPackage apkg flags (buildDepends pkg)
 
+-- | Annotate each installed packages with its set of transative dependencies.
+--
+annotateInstalledPackages :: PackageIndex InstalledPackageInfo
+                          -> PackageIndex InstalledPackage
+annotateInstalledPackages installed =
+  PackageIndex.fromList
+    [ InstalledPackage pkg (transitiveDepends pkg)
+    | pkg <- PackageIndex.allPackages installed ]
+  where
+    transitiveDepends :: InstalledPackageInfo -> [PackageIdentifier]
+    transitiveDepends = map toPkgid . tail . Graph.reachable graph
+                      . fromJust . toVertex . packageId
+    (graph, toPkgid, toVertex) = PackageIndex.dependencyGraph installed
+
 finaliseSelectedPackages :: SelectedPackages
                          -> Constraints
                          -> [InstallPlan.PlanPackage a]
@@ -246,7 +257,7 @@ finaliseSelectedPackages selected constraints =
 -- ------------------------------------------------------------
 
 addPackageSelectConstraint :: PackageIdentifier -> Constraints
-                    -> Satisfiable Constraints ExclusionReason
+                           -> Satisfiable Constraints ExclusionReason
 addPackageSelectConstraint pkgid constraints =
   Constraints.constrain dep reason constraints
   where