Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/3056bfadb96fa2e400abab49da4eec20f91793f5 >--------------------------------------------------------------- commit 3056bfadb96fa2e400abab49da4eec20f91793f5 Author: Duncan Coutts <[email protected]> Date: Tue May 18 12:53:57 2010 +0000 Add a simplistic resolver for available packages that ignores dependencies Suitable for cabal fetch/unpack but not for installation. >--------------------------------------------------------------- cabal-install/Distribution/Client/Dependency.hs | 102 ++++++++++++++++++++++- 1 files changed, 99 insertions(+), 3 deletions(-) diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index b0dad9c..9a30450 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -17,6 +17,8 @@ module Distribution.Client.Dependency ( resolveDependencies, resolveDependenciesWithProgress, + resolveAvailablePackages, + dependencyConstraints, dependencyTargets, @@ -40,18 +42,21 @@ import Distribution.Client.Dependency.Types , Progress(..), foldProgress ) import Distribution.Package ( PackageIdentifier(..), PackageName(..), packageVersion, packageName - , Dependency(..), Package(..), PackageFixedDeps(..) ) + , Dependency(Dependency), Package(..), PackageFixedDeps(..) ) import Distribution.Version - ( VersionRange, anyVersion, orLaterVersion, isAnyVersion ) + ( VersionRange, anyVersion, orLaterVersion + , isAnyVersion, withinRange, simplifyVersionRange ) import Distribution.Compiler ( CompilerId(..) ) import Distribution.System ( Platform ) import Distribution.Simple.Utils (comparing) import Distribution.Client.Utils (mergeBy, MergeResult(..)) +import Distribution.Text + ( display ) import Data.List (maximumBy) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import qualified Data.Map as Map import qualified Data.Set as Set import Data.Set (Set) @@ -202,6 +207,97 @@ interpretPackagesPreference selected (PackagesPreference defaultPref prefs) = if pkgname `Set.member` selected then PreferLatest else PreferInstalled +-- ------------------------------------------------------------ +-- * Simple resolver that ignores dependencies +-- ------------------------------------------------------------ + +-- | A simplistic method of resolving a list of target package names to +-- available packages. +-- +-- Specifically, it does not consider package dependencies at all. Unlike +-- 'resolveDependencies', no attempt is made to ensure that the selected +-- packages have dependencies that are satisfiable or consistent with +-- each other. +-- +-- It is suitable for tasks such as selecting packages to download for user +-- inspection. It is not suitable for selecting packages to install. +-- +-- Note: if no installed package index is available, it is ok to pass 'mempty'. +-- It simply means preferences for installed packages will be ignored. +-- +resolveAvailablePackages + :: PackageIndex InstalledPackage + -> PackageIndex AvailablePackage + -> PackagesPreference + -> [PackageConstraint] + -> [PackageName] + -> Either [ResolveNoDepsError] [AvailablePackage] +resolveAvailablePackages installed available preferences constraints targets = + collectEithers (map selectPackage targets) + where + selectPackage :: PackageName -> Either ResolveNoDepsError AvailablePackage + selectPackage pkgname + | null choices = Left $! ResolveUnsatisfiable pkgname requiredVersions + | otherwise = Right $! maximumBy bestByPrefs choices + + where + -- Constraints + requiredVersions = packageConstraints pkgname + pkgDependency = Dependency pkgname requiredVersions + choices = PackageIndex.lookupDependency available pkgDependency + + -- Preferences + PackagePreferences preferredVersions preferInstalled + = packagePreferences pkgname + + bestByPrefs = comparing $ \pkg -> + (installPref pkg, versionPref pkg, packageVersion pkg) + installPref = case preferInstalled of + PreferLatest -> const False + PreferInstalled -> isJust . PackageIndex.lookupPackageId installed + . packageId + versionPref pkg = packageVersion pkg `withinRange` preferredVersions + + packageConstraints :: PackageName -> VersionRange + packageConstraints pkgname = + Map.findWithDefault anyVersion pkgname packageVersionConstraintMap + packageVersionConstraintMap = + Map.fromList [ (name, range) + | PackageVersionConstraint name range <- constraints ] + + packagePreferences :: PackageName -> PackagePreferences + packagePreferences = interpretPackagesPreference (Set.fromList targets) preferences + + +collectEithers :: [Either a b] -> Either [a] [b] +collectEithers = collect . partitionEithers + where + collect ([], xs) = Right xs + collect (errs,_) = Left errs + partitionEithers :: [Either a b] -> ([a],[b]) + partitionEithers = foldr (either left right) ([],[]) + where + left a (l, r) = (a:l, r) + right a (l, r) = (l, a:r) + +-- | Errors for 'resolveWithoutDependencies'. +-- +data ResolveNoDepsError = + + -- | A package name which cannot be resolved to a specific package. + -- Also gives the constraint on the version and whether there was + -- a constraint on the package being installed. + ResolveUnsatisfiable PackageName VersionRange + +instance Show ResolveNoDepsError where + show (ResolveUnsatisfiable name ver) = + "There is no available version of " ++ display name + ++ " that satisfies " ++ display (simplifyVersionRange ver) + +-- ------------------------------------------------------------ +-- * Finding upgradable packages +-- ------------------------------------------------------------ + -- | Given the list of installed packages and available packages, figure -- out which packages can be upgraded. -- _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
