[commit: Cabal] master: Take the the flag assignment into account in the resolver (8ff54e1)

[Ian Lynagh]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/8ff54e151a431e85e517d63800ad0f61dfb62bb7

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

commit 8ff54e151a431e85e517d63800ad0f61dfb62bb7
Author: Duncan Coutts <duncan at haskell.org>
Date:   Tue Jun 10 23:52:12 2008 +0000

    Take the the flag assignment into account in the resolver
    so it now actually works to say: $ cabal install foo -fbar

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

 cabal-install/Hackage/Dependency/TopDown.hs       |   41 +++++++++++++--------
 cabal-install/Hackage/Dependency/TopDown/Types.hs |    3 +-
 2 files changed, 27 insertions(+), 17 deletions(-)

diff --git a/cabal-install/Hackage/Dependency/TopDown.hs b/cabal-install/Hackage/Dependency/TopDown.hs
index e4912c6..701ea62 100644
--- a/cabal-install/Hackage/Dependency/TopDown.hs
+++ b/cabal-install/Hackage/Dependency/TopDown.hs
@@ -52,13 +52,14 @@ import Distribution.Text
 import Data.List
          ( foldl', maximumBy, minimumBy, deleteBy, nub, sort )
 import Data.Maybe
-         ( fromJust )
+         ( fromJust, fromMaybe )
 import Data.Monoid
          ( Monoid(mempty) )
 import Control.Monad
          ( guard )
 import qualified Data.Set as Set
 import Data.Set (Set)
+import qualified Data.Map as Map
 import qualified Data.Graph as Graph
 import qualified Data.Array as Array
 
@@ -101,9 +102,9 @@ explore pref (ChoiceNode _ choices) =
 
   where
     topSortNumber choice = case fst (head choice) of
-      InstalledOnly           (InstalledPackage  _ i _) -> i
-      AvailableOnly           (UnconfiguredPackage _ i) -> i
-      InstalledAndAvailable _ (UnconfiguredPackage _ i) -> i
+      InstalledOnly           (InstalledPackage    _ i _) -> i
+      AvailableOnly           (UnconfiguredPackage _ i _) -> i
+      InstalledAndAvailable _ (UnconfiguredPackage _ i _) -> i
 
     bestByPref pkgname = case pref pkgname of
       PreferLatest    -> comparing (\(p,_) ->                 packageId p)
@@ -217,8 +218,8 @@ topDownResolver' os arch comp installed available pref deps =
   where
     configure   = configurePackage os arch comp
     constraints = Constraints.empty
-                    (annotateInstalledPackages topSortNumber installed')
-                    (annotateAvailablePackages topSortNumber available')
+                    (annotateInstalledPackages      topSortNumber installed')
+                    (annotateAvailablePackages deps topSortNumber available')
     (installed', available') = selectNeededSubset installed available
                                                   initialPkgNames
     topSortNumber = topologicalSortNumbering installed' available'
@@ -247,11 +248,11 @@ configurePackage os arch comp available spkg = case spkg of
   InstalledAndAvailable ipkg apkg -> fmap (InstalledAndAvailable ipkg)
                                           (configure apkg)
   where
-  configure (UnconfiguredPackage apkg@(AvailablePackage _ p _) _) =
-    case finalizePackageDescription [] (Just available) os arch comp [] p of
-      Left missing       -> Left missing
-      Right (pkg, flags) -> Right $
-        SemiConfiguredPackage apkg flags (buildDepends pkg)
+  configure (UnconfiguredPackage apkg@(AvailablePackage _ p _) _ flags) =
+    case finalizePackageDescription flags (Just available) os arch comp [] p of
+      Left missing        -> Left missing
+      Right (pkg, flags') -> Right $
+        SemiConfiguredPackage apkg flags' (buildDepends pkg)
 
 -- | Annotate each installed packages with its set of transative dependencies
 -- and its topological sort number.
@@ -269,14 +270,22 @@ annotateInstalledPackages dfsNumber installed = PackageIndex.fromList
     (graph, toPkgid, toVertex) = PackageIndex.dependencyGraph installed
 
 
--- | Annotate each available packages with its topological sort number.
+-- | Annotate each available packages with its topological sort number and any
+-- user-supplied partial flag assignment.
 --
-annotateAvailablePackages :: (PackageName -> TopologicalSortNumber)
+annotateAvailablePackages :: [UnresolvedDependency]
+                          -> (PackageName -> TopologicalSortNumber)
                           -> PackageIndex AvailablePackage
                           -> PackageIndex UnconfiguredPackage
-annotateAvailablePackages dfsNumber available = PackageIndex.fromList
-  [ UnconfiguredPackage pkg (dfsNumber (packageName pkg))
-  | pkg <- PackageIndex.allPackages available ]
+annotateAvailablePackages deps dfsNumber available = PackageIndex.fromList
+  [ UnconfiguredPackage pkg (dfsNumber name) (flagsFor name)
+  | pkg <- PackageIndex.allPackages available
+  , let name = packageName pkg ]
+  where
+    flagsFor = fromMaybe [] . flip Map.lookup flagsMap
+    flagsMap = Map.fromList
+      [ (name, flags)
+      | UnresolvedDependency (Dependency name _) flags <- deps ]
 
 -- | One of the heuristics we use when guessing which path to take in the
 -- search space is an ordering on the choices we make. It's generally better
diff --git a/cabal-install/Hackage/Dependency/TopDown/Types.hs b/cabal-install/Hackage/Dependency/TopDown/Types.hs
index db52c85..ffb5a96 100644
--- a/cabal-install/Hackage/Dependency/TopDown/Types.hs
+++ b/cabal-install/Hackage/Dependency/TopDown/Types.hs
@@ -48,6 +48,7 @@ data UnconfiguredPackage
    = UnconfiguredPackage
        AvailablePackage
        !TopologicalSortNumber
+       FlagAssignment
 
 data SemiConfiguredPackage
    = SemiConfiguredPackage
@@ -60,7 +61,7 @@ instance Package InstalledPackage where
   packageId (InstalledPackage p _ _) = packageId p
 
 instance Package UnconfiguredPackage where
-  packageId (UnconfiguredPackage p _) = packageId p
+  packageId (UnconfiguredPackage p _ _) = packageId p
 
 instance Package SemiConfiguredPackage where
   packageId (SemiConfiguredPackage p _ _) = packageId p