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 <[email protected]> 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
