Commit 0be5efeb authored by Duncan Coutts's avatar Duncan Coutts Committed by Mikhail Glushenkov
Browse files

Localise the InstalledPackage wrapper type to the old TopDown solver

No longer needed anywhere else.
parent 3f3410bd
......@@ -19,10 +19,8 @@ import Distribution.Client.Dependency.TopDown.Types
import qualified Distribution.Client.Dependency.TopDown.Constraints as Constraints
import Distribution.Client.Dependency.TopDown.Constraints
( Satisfiable(..) )
import Distribution.Client.IndexUtils
( convert )
import Distribution.Client.Types
( SourcePackage(..), ConfiguredPackage(..), InstalledPackage(..)
( SourcePackage(..), ConfiguredPackage(..)
, enableStanzas, ConfiguredId(..), fakeInstalledPackageId )
import Distribution.Client.Dependency.Types
( DependencyResolver, ResolverPackage(..), PackageConstraint(..)
......@@ -30,15 +28,19 @@ import Distribution.Client.Dependency.Types
, Progress(..), foldProgress )
import qualified Distribution.Client.PackageIndex as PackageIndex
import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Client.ComponentDeps
( ComponentDeps )
import qualified Distribution.Client.ComponentDeps as CD
import Distribution.Client.PackageIndex
( PackageIndex )
import Distribution.Package
( PackageName(..), PackageId, Package(..), packageVersion, packageName
, Dependency(Dependency), thisPackageVersion
, simplifyDependency )
( PackageName(..), PackageId, PackageIdentifier(..)
, InstalledPackageId(..)
, Package(..), packageVersion, packageName
, Dependency(Dependency), thisPackageVersion, simplifyDependency )
import Distribution.PackageDescription
( PackageDescription(buildDepends) )
import Distribution.Client.PackageUtils
......@@ -46,7 +48,7 @@ import Distribution.Client.PackageUtils
import Distribution.PackageDescription.Configuration
( finalizePackageDescription, flattenPackageDescription )
import Distribution.Version
( VersionRange, withinRange, simplifyVersionRange
( Version(..), VersionRange, withinRange, simplifyVersionRange
, UpperBound(..), asVersionIntervals )
import Distribution.Compiler
( CompilerInfo )
......@@ -248,9 +250,12 @@ search configure pref constraints =
topDownResolver :: DependencyResolver
topDownResolver platform cinfo installedPkgIndex sourcePkgIndex
preferences constraints targets =
mapMessages (topDownResolver' platform cinfo
(convert installedPkgIndex) sourcePkgIndex
preferences constraints targets)
mapMessages $ topDownResolver'
platform cinfo
(convertInstalledPackageIndex installedPkgIndex)
sourcePkgIndex
preferences constraints
targets
where
mapMessages :: Progress Log Failure a -> Progress String String a
mapMessages = foldProgress (Step . showLog) (Fail . showFailure) Done
......@@ -540,6 +545,43 @@ selectNeededSubset installedPkgIndex sourcePkgIndex = select mempty mempty
null (PackageIndex.lookupPackageName installedPkgIndex' name)
&& null (PackageIndex.lookupPackageName sourcePkgIndex' name)
-- | The old top down solver assumes that installed packages are indexed by
-- their source package id. But these days they're actually indexed by an
-- installed package id and there can be many installed packages with the same
-- source package id. This function tries to do a convertion, but it can only
-- be partial.
--
convertInstalledPackageIndex :: InstalledPackageIndex
-> PackageIndex InstalledPackage
convertInstalledPackageIndex index' = PackageIndex.fromList
-- There can be multiple installed instances of each package version,
-- like when the same package is installed in the global & user DBs.
-- InstalledPackageIndex.allPackagesBySourcePackageId gives us the
-- installed packages with the most preferred instances first, so by
-- picking the first we should get the user one. This is almost but not
-- quite the same as what ghc does.
[ InstalledPackage ipkg (sourceDepsOf index' ipkg)
| (_,ipkg:_) <- InstalledPackageIndex.allPackagesBySourcePackageId index' ]
where
-- The InstalledPackageInfo only lists dependencies by the
-- InstalledPackageId, which means we do not directly know the corresponding
-- source dependency. The only way to find out is to lookup the
-- InstalledPackageId to get the InstalledPackageInfo and look at its
-- source PackageId. But if the package is broken because it depends on
-- other packages that do not exist then we have a problem we cannot find
-- the original source package id. Instead we make up a bogus package id.
-- This should have the same effect since it should be a dependency on a
-- nonexistent package.
sourceDepsOf index ipkg =
[ maybe (brokenPackageId depid) packageId mdep
| let depids = InstalledPackageInfo.depends ipkg
getpkg = InstalledPackageIndex.lookupInstalledPackageId index
, (depid, mdep) <- zip depids (map getpkg depids) ]
brokenPackageId (InstalledPackageId str) =
PackageIdentifier (PackageName (str ++ "-broken")) (Version [] [])
-- ------------------------------------------------------------
-- * Post processing the solution
-- ------------------------------------------------------------
......
......@@ -14,13 +14,15 @@
module Distribution.Client.Dependency.TopDown.Types where
import Distribution.Client.Types
( InstalledPackage(..), SourcePackage(..), ReadyPackage(..)
( SourcePackage(..), ReadyPackage(..)
, ConfiguredPackage(..)
, OptionalStanza, ConfiguredId(..) )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import qualified Distribution.Client.ComponentDeps as CD
import Distribution.Package
( PackageIdentifier, Dependency
( PackageId, PackageIdentifier, Dependency
, Package(packageId) )
import Distribution.PackageDescription
( FlagAssignment )
......@@ -47,6 +49,12 @@ data FinalSelectedPackage
type TopologicalSortNumber = Int
-- | InstalledPackage caches its dependencies as source package IDs.
data InstalledPackage
= InstalledPackage
InstalledPackageInfo
[PackageId]
data InstalledPackageEx
= InstalledPackageEx
InstalledPackage
......@@ -68,6 +76,9 @@ data SemiConfiguredPackage
[Dependency] -- dependencies we end up with when we apply
-- the flag assignment
instance Package InstalledPackage where
packageId (InstalledPackage pkg _) = packageId pkg
instance Package InstalledPackageEx where
packageId (InstalledPackageEx p _ _) = packageId p
......
......@@ -16,7 +16,6 @@ module Distribution.Client.IndexUtils (
getInstalledPackages,
getSourcePackages,
getSourcePackagesStrict,
convert,
readPackageIndexFile,
parsePackageIndex,
......@@ -33,12 +32,10 @@ import Distribution.Client.Types
import Distribution.Package
( PackageId, PackageIdentifier(..), PackageName(..)
, Package(..), packageVersion, packageName
, Dependency(Dependency), InstalledPackageId(..) )
, Dependency(Dependency) )
import Distribution.Client.PackageIndex (PackageIndex)
import qualified Distribution.Client.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import qualified Distribution.PackageDescription.Parse as PackageDesc.Parse
import Distribution.PackageDescription
( GenericPackageDescription )
......@@ -97,35 +94,6 @@ getInstalledPackages verbosity comp packageDbs conf =
--FIXME: make getInstalledPackages use sensible verbosity in the first place
verbosity' = lessVerbose verbosity
convert :: InstalledPackageIndex -> PackageIndex InstalledPackage
convert index' = PackageIndex.fromList
-- There can be multiple installed instances of each package version,
-- like when the same package is installed in the global & user DBs.
-- InstalledPackageIndex.allPackagesBySourcePackageId gives us the
-- installed packages with the most preferred instances first, so by
-- picking the first we should get the user one. This is almost but not
-- quite the same as what ghc does.
[ InstalledPackage ipkg (sourceDeps index' ipkg)
| (_,ipkg:_) <- InstalledPackageIndex.allPackagesBySourcePackageId index' ]
where
-- The InstalledPackageInfo only lists dependencies by the
-- InstalledPackageId, which means we do not directly know the corresponding
-- source dependency. The only way to find out is to lookup the
-- InstalledPackageId to get the InstalledPackageInfo and look at its
-- source PackageId. But if the package is broken because it depends on
-- other packages that do not exist then we have a problem we cannot find
-- the original source package id. Instead we make up a bogus package id.
-- This should have the same effect since it should be a dependency on a
-- nonexistent package.
sourceDeps index ipkg =
[ maybe (brokenPackageId depid) packageId mdep
| let depids = InstalledPackageInfo.depends ipkg
getpkg = InstalledPackageIndex.lookupInstalledPackageId index
, (depid, mdep) <- zip depids (map getpkg depids) ]
brokenPackageId (InstalledPackageId str) =
PackageIdentifier (PackageName (str ++ "-broken")) (Version [] [])
------------------------------------------------------------------------
-- Reading the source package index
--
......
......@@ -72,22 +72,6 @@ instance PackageFixedDeps (InstalledPackageInfo_ str) where
depends = CD.fromInstalled . installedDepends
-- | InstalledPackage caches its dependencies as source package IDs.
-- This is for the benefit of the top-down solver only.
data InstalledPackage = InstalledPackage
InstalledPackageInfo
[PackageId]
instance Package InstalledPackage where
packageId (InstalledPackage pkg _) = packageId pkg
instance PackageFixedDeps InstalledPackage where
depends (InstalledPackage pkg _) = depends pkg
instance HasInstalledPackageId InstalledPackage where
installedPackageId (InstalledPackage pkg _) = installedPackageId pkg
instance PackageInstalled InstalledPackage where
installedDepends (InstalledPackage pkg _) = installedDepends pkg
-- | In order to reuse the implementation of PackageIndex which relies on
-- 'InstalledPackageId', we need to be able to synthesize these IDs prior
-- to installation. Eventually, we'll move to a representation of
......
Markdown is supported
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