From daecdef95e52dfef2cb5c0f865bf00cf773dd8bc Mon Sep 17 00:00:00 2001
From: Edsko de Vries <edsko@well-typed.com>
Date: Wed, 4 Mar 2015 14:29:19 +0000
Subject: [PATCH] Avoid forgetting known installed package IDs
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Introduce ConfiguredId:
-- | A ConfiguredId is a package ID for a configured package.
--
-- Once we configure a source package we know it's InstalledPackageId (at
-- least, in principle, even if we have to fake it currently). It is still
-- however useful in lots of places to also know the source ID for the
-- package. We therefore bundle the two.
--
-- An already installed package of course is also "configured" (all it's
-- configuration parameters and dependencies have been specified).
--
-- TODO: I wonder if it would make sense to promote this datatype to Cabal
-- and use it consistently instead of InstalledPackageIds?
data ConfiguredId = ConfiguredId {
confSrcId :: PackageId
, confInstId :: InstalledPackageId
}
And use it for ConfiguredPackage. As the comment says, though, I wonder if we
should use this in more places.
One slightly tricky thing here is that the output of both solvers had to be
modified to keep installed package IDs where possible; in the modular solver
this was easy enough, as it does this properly, but in the top-down solver this
is a bit of a hack; however, I’ve documented the hack in detail inline in the
code.
NOTE: Although this change is currently mostly cosmetic, in the future, once we
drop the single instance restriction, it is very important that we don't
convert from installed package IDs to source IDs and then back to installed
package IDs, as this conversion will be lossy.
---
.../Client/BuildReports/Storage.hs | 2 +-
.../Modular/ConfiguredConversion.hs | 21 ++++++---
.../Distribution/Client/Dependency/TopDown.hs | 35 ++++++++++++++-
.../Client/Dependency/TopDown/Types.hs | 4 +-
.../Distribution/Client/InstallPlan.hs | 11 +++--
cabal-install/Distribution/Client/Types.hs | 44 +++++++++++++++----
6 files changed, 96 insertions(+), 21 deletions(-)
diff --git a/cabal-install/Distribution/Client/BuildReports/Storage.hs b/cabal-install/Distribution/Client/BuildReports/Storage.hs
index 10c7df7e3d..20a4cc5847 100644
--- a/cabal-install/Distribution/Client/BuildReports/Storage.hs
+++ b/cabal-install/Distribution/Client/BuildReports/Storage.hs
@@ -135,7 +135,7 @@ fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
InstallPlan.Failed (ConfiguredPackage srcPkg flags _ deps) result
-> Just $ ( BuildReport.new os arch comp
- (packageId srcPkg) flags deps
+ (packageId srcPkg) flags (map confSrcId deps)
(Left result)
, extractRepo srcPkg )
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs b/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs
index b99f90fce2..97d22a52d9 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs
@@ -25,16 +25,27 @@ convCP iidx sidx (CP qpi fa es ds) =
case convPI qpi of
Left pi -> PreExisting $ InstalledPackage
(fromJust $ SI.lookupInstalledPackageId iidx pi)
- (map convPI' ds)
+ (map confSrcId ds')
Right pi -> Configured $ ConfiguredPackage
(fromJust $ CI.lookupPackageId sidx pi)
fa
es
- (map convPI' ds)
+ ds'
+ where
+ ds' :: [ConfiguredId]
+ ds' = map convConfId ds
convPI :: PI QPN -> Either InstalledPackageId PackageId
convPI (PI _ (I _ (Inst pi))) = Left pi
-convPI qpi = Right $ convPI' qpi
+convPI qpi = Right $ confSrcId $ convConfId qpi
-convPI' :: PI QPN -> PackageId
-convPI' (PI (Q _ pn) (I v _)) = PackageIdentifier pn v
+convConfId :: PI QPN -> ConfiguredId
+convConfId (PI (Q _ pn) (I v loc)) = ConfiguredId {
+ confSrcId = sourceId
+ , confInstId = installedId
+ }
+ where
+ sourceId = PackageIdentifier pn v
+ installedId = case loc of
+ Inst pi -> pi
+ _otherwise -> fakeInstalledPackageId sourceId
diff --git a/cabal-install/Distribution/Client/Dependency/TopDown.hs b/cabal-install/Distribution/Client/Dependency/TopDown.hs
index a4a083473e..a6f75e6090 100644
--- a/cabal-install/Distribution/Client/Dependency/TopDown.hs
+++ b/cabal-install/Distribution/Client/Dependency/TopDown.hs
@@ -26,7 +26,7 @@ import Distribution.Client.InstallPlan
( PlanPackage(..) )
import Distribution.Client.Types
( SourcePackage(..), ConfiguredPackage(..), InstalledPackage(..)
- , enableStanzas )
+ , enableStanzas, ConfiguredId(..), fakeInstalledPackageId )
import Distribution.Client.Dependency.Types
( DependencyResolver, PackageConstraint(..)
, PackagePreferences(..), InstalledPreference(..)
@@ -562,7 +562,38 @@ finaliseSelectedPackages pref selected constraints =
finaliseSource mipkg (SemiConfiguredPackage pkg flags stanzas deps) =
InstallPlan.Configured (ConfiguredPackage pkg flags stanzas deps')
where
- deps' = map (packageId . pickRemaining mipkg) deps
+ deps' = map (confId . pickRemaining mipkg) deps
+
+ -- InstalledOrSource indicates that we either have a source package
+ -- available, or an installed one, or both. In the case that we have both
+ -- available, we don't yet know if we can pick the installed one (the
+ -- dependencies may not match up, for instance); this is verified in
+ -- `improvePlan`.
+ --
+ -- This means that at this point we cannot construct a valid installed
+ -- package ID yet for the dependencies. We therefore have two options:
+ --
+ -- * We could leave the installed package ID undefined here, and have a
+ -- separate pass over the output of the top-down solver, fixing all
+ -- dependencies so that if we depend on an already installed package we
+ -- use the proper installed package ID.
+ --
+ -- * We can _always_ use fake installed IDs, irrespective of whether we the
+ -- dependency is on an already installed package or not. This is okay
+ -- because (i) the top-down solver does not (and never will) support
+ -- multiple package instances, and (ii) we initialize the FakeMap with
+ -- fake IDs for already installed packages.
+ --
+ -- For now we use the second option; if however we change the implementation
+ -- of these fake IDs so that we do away with the FakeMap and update a
+ -- package reverse dependencies as we execute the install plan and discover
+ -- real package IDs, then this is no longer possible and we have to
+ -- implement the first option (see also Note [FakeMap] in Cabal).
+ confId :: InstalledOrSource InstalledPackageEx UnconfiguredPackage -> ConfiguredId
+ confId pkg = ConfiguredId {
+ confSrcId = packageId pkg
+ , confInstId = fakeInstalledPackageId (packageId pkg)
+ }
pickRemaining mipkg dep@(Dependency _name versionRange) =
case PackageIndex.lookupDependency remainingChoices dep of
diff --git a/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs b/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs
index 29632b67af..c6cc5baa73 100644
--- a/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs
+++ b/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs
@@ -14,7 +14,7 @@ module Distribution.Client.Dependency.TopDown.Types where
import Distribution.Client.Types
( SourcePackage(..), ReadyPackage(..), InstalledPackage(..)
- , OptionalStanza )
+ , OptionalStanza, ConfiguredId(..) )
import Distribution.Client.InstallPlan
( ConfiguredPackage(..), PlanPackage(..) )
@@ -113,7 +113,7 @@ instance PackageSourceDeps InstalledPackageEx where
sourceDeps (InstalledPackageEx _ _ deps) = deps
instance PackageSourceDeps ConfiguredPackage where
- sourceDeps (ConfiguredPackage _ _ _ deps) = deps
+ sourceDeps (ConfiguredPackage _ _ _ deps) = map confSrcId deps
instance PackageSourceDeps ReadyPackage where
sourceDeps (ReadyPackage _ _ _ deps) = map packageId deps
diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs
index da9d841a6a..84735ff41e 100644
--- a/cabal-install/Distribution/Client/InstallPlan.hs
+++ b/cabal-install/Distribution/Client/InstallPlan.hs
@@ -54,10 +54,12 @@ import Distribution.Client.Types
( SourcePackage(packageDescription), ConfiguredPackage(..)
, ReadyPackage(..), readyPackageToConfiguredPackage
, InstalledPackage, BuildFailure, BuildSuccess(..), enableStanzas
- , InstalledPackage(..), fakeInstalledPackageId )
+ , InstalledPackage(..), fakeInstalledPackageId
+ , ConfiguredId(..)
+ )
import Distribution.Package
( PackageIdentifier(..), PackageName(..), Package(..), packageName
- , Dependency(..), InstalledPackageId
+ , Dependency(..), PackageId, InstalledPackageId
, HasInstalledPackageId(..), PackageInstalled(..) )
import Distribution.Version
( Version, withinRange )
@@ -594,7 +596,7 @@ showPackageProblem (InvalidDep dep pkgid) =
configuredPackageProblems :: Platform -> CompilerInfo
-> ConfiguredPackage -> [PackageProblem]
configuredPackageProblems platform cinfo
- (ConfiguredPackage pkg specifiedFlags stanzas specifiedDeps) =
+ (ConfiguredPackage pkg specifiedFlags stanzas specifiedDeps') =
[ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ]
++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ]
++ [ ExtraFlag flag | OnlyInRight flag <- mergedFlags ]
@@ -605,6 +607,9 @@ configuredPackageProblems platform cinfo
++ [ InvalidDep dep pkgid | InBoth dep pkgid <- mergedDeps
, not (packageSatisfiesDependency pkgid dep) ]
where
+ specifiedDeps :: [PackageId]
+ specifiedDeps = map confSrcId specifiedDeps'
+
mergedFlags = mergeBy compare
(sort $ map flagName (genPackageFlags (packageDescription pkg)))
(sort $ map fst specifiedFlags)
diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs
index 10f0cca3f9..fb9a693c59 100644
--- a/cabal-install/Distribution/Client/Types.hs
+++ b/cabal-install/Distribution/Client/Types.hs
@@ -19,7 +19,7 @@ import Distribution.Package
, mkPackageKey, PackageKey, InstalledPackageId(..)
, HasInstalledPackageId(..), PackageInstalled(..) )
import Distribution.InstalledPackageInfo
- ( InstalledPackageInfo, packageKey )
+ ( InstalledPackageInfo )
import Distribution.PackageDescription
( Benchmark(..), GenericPackageDescription(..), FlagAssignment
, TestSuite(..) )
@@ -32,6 +32,7 @@ import Distribution.Version
import Distribution.Simple.Compiler
( Compiler, packageKeySupported )
import Distribution.Text (display)
+import qualified Distribution.InstalledPackageInfo as Info
import Data.Map (Map)
import Network.URI (URI)
@@ -102,17 +103,37 @@ data ConfiguredPackage = ConfiguredPackage
SourcePackage -- package info, including repo
FlagAssignment -- complete flag assignment for the package
[OptionalStanza] -- list of enabled optional stanzas for the package
- [PackageId] -- set of exact dependencies. These must be
- -- consistent with the 'buildDepends' in the
- -- 'PackageDescription' that you'd get by applying
- -- the flag assignment and optional stanzas.
+ [ConfiguredId] -- set of exact dependencies (installed or source).
+ -- These must be consistent with the 'buildDepends'
+ -- in the 'PackageDescription' that you'd get by
+ -- applying the flag assignment and optional stanzas.
deriving Show
+-- | A ConfiguredId is a package ID for a configured package.
+--
+-- Once we configure a source package we know it's InstalledPackageId
+-- (at least, in principle, even if we have to fake it currently). It is still
+-- however useful in lots of places to also know the source ID for the package.
+-- We therefore bundle the two.
+--
+-- An already installed package of course is also "configured" (all it's
+-- configuration parameters and dependencies have been specified).
+--
+-- TODO: I wonder if it would make sense to promote this datatype to Cabal
+-- and use it consistently instead of InstalledPackageIds?
+data ConfiguredId = ConfiguredId {
+ confSrcId :: PackageId
+ , confInstId :: InstalledPackageId
+ }
+
+instance Show ConfiguredId where
+ show = show . confSrcId
+
instance Package ConfiguredPackage where
packageId (ConfiguredPackage pkg _ _ _) = packageId pkg
instance PackageFixedDeps ConfiguredPackage where
- depends (ConfiguredPackage _ _ _ deps) = deps
+ depends (ConfiguredPackage _ _ _ deps) = map confSrcId deps
instance HasInstalledPackageId ConfiguredPackage where
installedPackageId = fakeInstalledPackageId . packageId
@@ -144,7 +165,7 @@ instance PackageInstalled ReadyPackage where
readyPackageKey :: Compiler -> ReadyPackage -> PackageKey
readyPackageKey comp (ReadyPackage pkg _ _ deps) =
mkPackageKey (packageKeySupported comp) (packageId pkg)
- (map packageKey deps) []
+ (map Info.packageKey deps) []
-- | Sometimes we need to convert a 'ReadyPackage' back to a
@@ -152,7 +173,14 @@ readyPackageKey comp (ReadyPackage pkg _ _ deps) =
-- Ready or Configured.
readyPackageToConfiguredPackage :: ReadyPackage -> ConfiguredPackage
readyPackageToConfiguredPackage (ReadyPackage srcpkg flags stanzas deps) =
- ConfiguredPackage srcpkg flags stanzas (map packageId deps)
+ ConfiguredPackage srcpkg flags stanzas (map aux deps)
+ where
+ aux :: InstalledPackageInfo -> ConfiguredId
+ aux info = ConfiguredId {
+ confSrcId = Info.sourcePackageId info
+ , confInstId = installedPackageId info
+ }
+
-- | A package description along with the location of the package sources.
--
--
GitLab