Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6fb17420f8643bf15006868b1893c0ffa8b6e9d9 >--------------------------------------------------------------- commit 6fb17420f8643bf15006868b1893c0ffa8b6e9d9 Author: Duncan Coutts <[email protected]> Date: Mon Dec 15 22:17:28 2008 +0000 Take preferences into account in the bogus resolver >--------------------------------------------------------------- .../Distribution/Client/Dependency/Bogus.hs | 36 +++++++++++-------- 1 files changed, 21 insertions(+), 15 deletions(-) diff --git a/cabal-install/Distribution/Client/Dependency/Bogus.hs b/cabal-install/Distribution/Client/Dependency/Bogus.hs index 6fc5c0f..e25f4b2 100644 --- a/cabal-install/Distribution/Client/Dependency/Bogus.hs +++ b/cabal-install/Distribution/Client/Dependency/Bogus.hs @@ -19,7 +19,7 @@ import Distribution.Client.Types ( AvailablePackage(..), ConfiguredPackage(..) ) import Distribution.Client.Dependency.Types ( DependencyResolver, Progress(..) - , PackageConstraint(..) ) + , PackageConstraint(..), PackagePreferences(..) ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Package @@ -32,7 +32,7 @@ import Distribution.PackageDescription.Configuration import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PackageIndex (PackageIndex) import Distribution.Version - ( VersionRange(AnyVersion, IntersectVersionRanges) ) + ( VersionRange(AnyVersion, IntersectVersionRanges), withinRange ) import Distribution.Simple.Utils ( comparing ) import Distribution.Text @@ -52,12 +52,14 @@ import qualified Data.Map as Map -- We just pretend that everything is installed and hope for the best. -- bogusResolver :: DependencyResolver -bogusResolver (Platform arch os) comp _ available _ constraints targets = - resolveFromAvailable [] (combineConstraints constraints targets) +bogusResolver (Platform arch os) comp _ available + preferences constraints targets = + resolveFromAvailable [] + (combineConstraints preferences constraints targets) where resolveFromAvailable chosen [] = Done chosen - resolveFromAvailable chosen ((name, verConstraint, flags): deps) = - case latestAvailableSatisfying available name verConstraint of + resolveFromAvailable chosen ((name, verConstraint, flags, verPref): deps) = + case latestAvailableSatisfying available name verConstraint verPref of Nothing -> Fail ("Unresolved dependency: " ++ display dep) Just apkg@(AvailablePackage _ pkg _) -> case finalizePackageDescription flags none os arch comp [] pkg of @@ -95,14 +97,16 @@ fudgeChosenPackage (AvailablePackage pkgid pkg source) flags = where g (cnd, t, me) = (cnd, mapTreeConstrs f t, fmap (mapTreeConstrs f) me) -combineConstraints :: [PackageConstraint] +combineConstraints :: (PackageName -> PackagePreferences) + -> [PackageConstraint] -> [PackageName] - -> [(PackageName, VersionRange, FlagAssignment)] -combineConstraints constraints targets = - [ (name, ver, flags) + -> [(PackageName, VersionRange, FlagAssignment, VersionRange)] +combineConstraints preferences constraints targets = + [ (name, ver, flags, pref) | name <- targets , let ver = fromMaybe AnyVersion (Map.lookup name versionConstraints) - flags = fromMaybe [] (Map.lookup name flagsConstraints) ] + flags = fromMaybe [] (Map.lookup name flagsConstraints) + PackagePreferences pref _ = preferences name ] where versionConstraints = Map.fromListWith IntersectVersionRanges [ (name, versionRange) @@ -112,14 +116,16 @@ combineConstraints constraints targets = [ (name, flags) | PackageFlagsConstraint name flags <- constraints ] --- | Gets the latest available package satisfying a dependency. +-- | Gets the best available package satisfying a dependency. +-- latestAvailableSatisfying :: PackageIndex AvailablePackage - -> PackageName -> VersionRange + -> PackageName -> VersionRange -> VersionRange -> Maybe AvailablePackage -latestAvailableSatisfying index name versionConstraint = +latestAvailableSatisfying index name versionConstraint versionPreference = case PackageIndex.lookupDependency index dep of [] -> Nothing pkgs -> Just (maximumBy best pkgs) where dep = Dependency name versionConstraint - best = comparing packageVersion + best = comparing (\p -> (isPreferred p, packageVersion p)) + isPreferred p = packageVersion p `withinRange` versionPreference _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
