From 0be5efeb3ad37175cbbf1d51602489af1ecb9269 Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@community.haskell.org>
Date: Wed, 22 Jul 2015 14:28:08 +0100
Subject: [PATCH] Localise the InstalledPackage wrapper type to the old TopDown
solver
No longer needed anywhere else.
---
.../Distribution/Client/Dependency/TopDown.hs | 62 ++++++++++++++++---
.../Client/Dependency/TopDown/Types.hs | 15 ++++-
.../Distribution/Client/IndexUtils.hs | 34 +---------
cabal-install/Distribution/Client/Types.hs | 16 -----
4 files changed, 66 insertions(+), 61 deletions(-)
diff --git a/cabal-install/Distribution/Client/Dependency/TopDown.hs b/cabal-install/Distribution/Client/Dependency/TopDown.hs
index c919055527..32a53b130a 100644
--- a/cabal-install/Distribution/Client/Dependency/TopDown.hs
+++ b/cabal-install/Distribution/Client/Dependency/TopDown.hs
@@ -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
-- ------------------------------------------------------------
diff --git a/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs b/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs
index 9cdebecba3..01e2be67e7 100644
--- a/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs
+++ b/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs
@@ -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
diff --git a/cabal-install/Distribution/Client/IndexUtils.hs b/cabal-install/Distribution/Client/IndexUtils.hs
index 7859b547fc..d962bcaada 100644
--- a/cabal-install/Distribution/Client/IndexUtils.hs
+++ b/cabal-install/Distribution/Client/IndexUtils.hs
@@ -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
--
diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs
index da840c4ca6..2d67b1be33 100644
--- a/cabal-install/Distribution/Client/Types.hs
+++ b/cabal-install/Distribution/Client/Types.hs
@@ -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
--
GitLab