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 cd2b4e1bc2d..8c1b9a18af9 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 a0517bc167e..da9d841a6ad 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)