Commit d18ef1fa authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Remove code related to the dep resolver that is now redundant

parent d6584947
......@@ -15,21 +15,15 @@
module Distribution.Client.Dependency (
-- * The main package dependency resolver
resolveDependencies,
resolveDependenciesWithProgress,
Progress(..),
foldProgress,
-- * Alternate, simple resolver that does not do dependencies recursively
resolveWithoutDependencies,
resolveAvailablePackages,
dependencyConstraints,
dependencyTargets,
-- * Constructing resolver policies
DepResolverParams(..),
PackageConstraint(..),
PackagesPreference(..),
PackagesPreferenceDefault(..),
PackagePreference(..),
InstalledPreference(..),
......@@ -51,9 +45,6 @@ module Distribution.Client.Dependency (
addAvailablePackages,
hideInstalledPackagesSpecific,
hideInstalledPackagesAllVersions,
-- deprecated
upgradableDependencies,
) where
import Distribution.Client.Dependency.TopDown (topDownResolver)
......@@ -63,24 +54,22 @@ import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.Types
( AvailablePackageDb(AvailablePackageDb)
, UnresolvedDependency(..), AvailablePackage(..), InstalledPackage )
, AvailablePackage(..), InstalledPackage )
import Distribution.Client.Dependency.Types
( DependencyResolver, PackageConstraint(..)
, PackagePreferences(..), InstalledPreference(..)
, Progress(..), foldProgress )
import Distribution.Client.Targets
import Distribution.Package
( PackageIdentifier(..), PackageId, PackageName(..), packageVersion, packageName
, Dependency(Dependency), Package(..) )
( PackageName(..), PackageId, Package(..), packageVersion
, Dependency(Dependency))
import Distribution.Version
( VersionRange, anyVersion, orLaterVersion
, isAnyVersion, withinRange, simplifyVersionRange )
( VersionRange, anyVersion, 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 )
......@@ -108,25 +97,6 @@ data DepResolverParams = DepResolverParams {
depResolverAvailable :: PackageIndex AvailablePackage
}
-- | Global policy for the versions of all packages.
--
data PackagesPreference = PackagesPreference
PackagesPreferenceDefault
[PackagePreference]
dependencyConstraints :: [UnresolvedDependency] -> [PackageConstraint]
dependencyConstraints deps =
[ PackageVersionConstraint name versionRange
| UnresolvedDependency (Dependency name versionRange) _ <- deps
, not (isAnyVersion versionRange) ]
++ [ PackageFlagsConstraint name flags
| UnresolvedDependency (Dependency name _) flags <- deps
, not (null flags) ]
dependencyTargets :: [UnresolvedDependency] -> [PackageName]
dependencyTargets deps =
[ name | UnresolvedDependency (Dependency name _) _ <- deps ]
-- | Global policy for all packages to say if we prefer package versions that
-- are already installed locally or if we just prefer the latest available.
......@@ -307,24 +277,6 @@ standardInstallPolicy
defaultResolver :: DependencyResolver
defaultResolver = topDownResolver
resolveDependenciesWithProgress :: Platform
-> CompilerId
-> PackageIndex InstalledPackage
-> PackageIndex AvailablePackage
-> PackagesPreference
-> [PackageConstraint]
-> [PackageName]
-> Progress String String InstallPlan
resolveDependenciesWithProgress platform comp installed available
(PackagesPreference defpref prefs)
constraints targets =
resolveDependencies
platform comp
(DepResolverParams
targets constraints
prefs defpref
installed available)
-- | Run the dependency solver.
--
-- Since this is potentially an expensive operation, the result is wrapped in a
......@@ -422,19 +374,6 @@ interpretPackagesPreference selected defaultPref prefs =
-- 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
(PackagesPreference defpref prefs) constraints targets =
resolveWithoutDependencies
(DepResolverParams targets constraints prefs defpref installed available)
resolveWithoutDependencies :: DepResolverParams
-> Either [ResolveNoDepsError] [AvailablePackage]
resolveWithoutDependencies (DepResolverParams targets constraints
......@@ -500,26 +439,3 @@ 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.
--
upgradableDependencies :: PackageIndex InstalledPackage
-> PackageIndex AvailablePackage
-> [Dependency]
upgradableDependencies installed available =
[ Dependency name (orLaterVersion latestVersion)
-- This is really quick (linear time). The trick is that we're doing a
-- merge join of two tables. We can do it as a merge because they're in
-- a comparable order because we're getting them from the package indexs.
| InBoth latestInstalled allAvailable
<- mergeBy (\a (b:_) -> packageName a `compare` packageName b)
[ maximumBy (comparing packageVersion) pkgs
| pkgs <- PackageIndex.allPackagesByName installed ]
(PackageIndex.allPackagesByName available)
, let (PackageIdentifier name latestVersion) = packageId latestInstalled
, any (\p -> packageVersion p > latestVersion) allAvailable ]
......@@ -16,9 +16,6 @@ module Distribution.Client.IndexUtils (
readPackageIndexFile,
parseRepoIndex,
disambiguatePackageName,
disambiguateDependencies
) where
import qualified Distribution.Client.Tar as Tar
......@@ -46,12 +43,13 @@ import Distribution.ParseUtils
import Distribution.Version
( Version(Version), intersectVersionRanges )
import Distribution.Text
( display, simpleParse )
( simpleParse )
import Distribution.Verbosity (Verbosity)
import Distribution.Simple.Utils (die, warn, info, intercalate, fromUTF8)
import Distribution.Simple.Utils
( warn, info, fromUTF8 )
import Data.Maybe (catMaybes, fromMaybe)
import Data.List (isPrefixOf, find)
import Data.List (isPrefixOf)
import Data.Monoid (Monoid(..))
import qualified Data.Map as Map
import Control.Monad (MonadPlus(mplus), when)
......@@ -256,51 +254,3 @@ foldlTarball f z = either Left (Right . foldl f z) . check [] . Tar.read
check _ (Tar.Fail err) = Left err
check ok Tar.Done = Right ok
check ok (Tar.Next e es) = check (e:ok) es
-- | Disambiguate a set of packages using 'disambiguatePackage' and report any
-- ambiguities to the user.
--
disambiguateDependencies :: PackageIndex AvailablePackage
-> [UnresolvedDependency]
-> IO [UnresolvedDependency]
disambiguateDependencies index deps = do
let names = [ (name, disambiguatePackageName index name)
| UnresolvedDependency (Dependency name _) _ <- deps ]
in case [ (name, matches) | (name, Right matches) <- names ] of
[] -> return
[ UnresolvedDependency (Dependency name vrange) flags
| (UnresolvedDependency (Dependency _ vrange) flags,
(_, Left name)) <- zip deps names ]
ambigious -> die $ unlines
[ if null matches
then "There is no package named " ++ display name ++ ". "
++ "Perhaps you need to run 'cabal update' first?"
else "The package name " ++ display name ++ "is ambigious. "
++ "It could be: " ++ intercalate ", " (map display matches)
| (name, matches) <- ambigious ]
-- | Given an index of known packages and a package name, figure out which one it
-- might be referring to. If there is an exact case-sensitive match then that's
-- ok. If it matches just one package case-insensitively then that's also ok.
-- The only problem is if it matches multiple packages case-insensitively, in
-- that case it is ambigious.
--
disambiguatePackageName :: PackageIndex AvailablePackage
-> PackageName
-> Either PackageName [PackageName]
disambiguatePackageName index pkgname@(PackageName name) =
case checkAmbiguity pkgname (map fst $ PackageIndex.searchByName index name) of
None -> Right []
Unambiguous name' -> Left name'
Ambiguous names' -> Right names'
checkAmbiguity :: PackageName -> [PackageName] -> MaybeAmbigious PackageName
checkAmbiguity name names =
case names of
[] -> None
[name'] -> Unambiguous name'
_ -> case find (name==) names of
Just name' -> Unambiguous name'
Nothing -> Ambiguous names
data MaybeAmbigious a = None | Unambiguous a | Ambiguous [a]
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment