From e866b5e8c8c82d9ecd4dbf192ec1cf5aa8678399 Mon Sep 17 00:00:00 2001
From: Edsko de Vries <edsko@well-typed.com>
Date: Sat, 28 Feb 2015 17:40:21 +0000
Subject: [PATCH] Avoid package index conversion
Introduce
dependencyClosure :: InstallPlan
-> [PackageIdentifier]
-> Either (PackageIndex PlanPackage) [(PlanPackage, [InstalledPackageId])]
And use this in the definition of `pruneInstallPlan` in `freeze`, to avoid
first converting an install plan from a `Cabal.PackageIndex` to a
`CabalInstall.PackageIndex`.
This resolves the first of the two irregularities mentioned in the previous
commit.
---
cabal-install/Distribution/Client/Freeze.hs | 18 +++++++----------
.../Distribution/Client/InstallPlan.hs | 20 ++++++++++++++++++-
2 files changed, 26 insertions(+), 12 deletions(-)
diff --git a/cabal-install/Distribution/Client/Freeze.hs b/cabal-install/Distribution/Client/Freeze.hs
index cd2b4e1bc2..8c1b9a18af 100644
--- a/cabal-install/Distribution/Client/Freeze.hs
+++ b/cabal-install/Distribution/Client/Freeze.hs
@@ -34,12 +34,11 @@ import Distribution.Client.Sandbox.Types
( SandboxPackageInfo(..) )
import Distribution.Package
- ( Package, PackageIdentifier, packageId, packageName, packageVersion )
+ ( Package, packageId, packageName, packageVersion )
import Distribution.Simple.Compiler
( Compiler, compilerInfo, PackageDBStack )
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
-import qualified Distribution.Client.PackageIndex as PackageIndex
-import qualified Distribution.Client.PlanIndex as PlanIndex
+import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Program
( ProgramConfiguration )
import Distribution.Simple.Setup
@@ -141,9 +140,7 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
solver
resolverParams
- return $ either id
- (error "planPackages: installPlan contains broken packages")
- (pruneInstallPlan installPlan pkgSpecifiers)
+ return $ pruneInstallPlan installPlan pkgSpecifiers
where
resolverParams =
@@ -194,15 +191,14 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
-- which are no longer required from the install plan.
pruneInstallPlan :: InstallPlan.InstallPlan
-> [PackageSpecifier SourcePackage]
- -> Either [PlanPackage] [(PlanPackage, [PackageIdentifier])]
+ -> [PlanPackage]
pruneInstallPlan installPlan pkgSpecifiers =
mapLeft (removeSelf pkgIds . PackageIndex.allPackages) $
- PlanIndex.dependencyClosure pkgIdx pkgIds
+ InstallPlan.dependencyClosure installPlan pkgIds
where
- pkgIdx = PackageIndex.fromList $ InstallPlan.toList installPlan
pkgIds = [ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ]
- mapLeft f (Left v) = Left $ f v
- mapLeft _ (Right v) = Right v
+ mapLeft f (Left v) = f v
+ mapLeft _ (Right _) = error "planPackages: installPlan contains broken packages"
removeSelf [thisPkg] = filter (\pp -> packageId pp /= thisPkg)
removeSelf _ =
error $ "internal error: 'pruneInstallPlan' given "
diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs
index a0517bc167..da9d841a6a 100644
--- a/cabal-install/Distribution/Client/InstallPlan.hs
+++ b/cabal-install/Distribution/Client/InstallPlan.hs
@@ -44,7 +44,10 @@ module Distribution.Client.InstallPlan (
PackageProblem(..),
showPackageProblem,
problems,
- configuredPackageProblems
+ configuredPackageProblems,
+
+ -- ** Querying the install plan
+ dependencyClosure,
) where
import Distribution.Client.Types
@@ -628,3 +631,18 @@ configuredPackageProblems platform cinfo
(enableStanzas stanzas $ packageDescription pkg) of
Right (resolvedPkg, _) -> externalBuildDepends resolvedPkg
Left _ -> error "configuredPackageInvalidDeps internal error"
+
+-- | Compute the dependency closure of a _source_ package in a install plan
+--
+-- See `Distribution.Simple.dependencyClosure`
+dependencyClosure :: InstallPlan
+ -> [PackageIdentifier]
+ -> Either (PackageIndex PlanPackage) [(PlanPackage, [InstalledPackageId])]
+dependencyClosure installPlan pids =
+ PackageIndex.dependencyClosure'
+ (planFakeMap installPlan)
+ (planIndex installPlan)
+ (map (resolveFakeId . fakeInstalledPackageId) pids)
+ where
+ resolveFakeId :: InstalledPackageId -> InstalledPackageId
+ resolveFakeId ipid = Map.findWithDefault ipid ipid (planFakeMap installPlan)
--
GitLab