From ea22d11fc870eeeeb1fe7ccbec216e2af7c141bf Mon Sep 17 00:00:00 2001
From: Edsko de Vries <edsko@well-typed.com>
Date: Tue, 3 Mar 2015 14:23:37 +0000
Subject: [PATCH] Change PackageFixedDeps to use installed IDs
Take advantage in cabal-install of the new
HasInstalledPackageId/PackagedInstall split in Cabal. The graph traversal
functions in cabal-install, previously redundant, are now back in use. Their
types match the ones in Cabal, with only the difference in the PackageInstalled
(Cabal) versus PackageFixedDeps (cabal-install) type class.
The only PackageInstalled instance left in Cabal is for InstalledPackage, which
is a thin wrapper around InstalledPackageInfo; with these refactorings in
place, InstalledPackage is there only to support the TopDown solver. The fact
that we won't have PackageInstalled instances anymore for PlanPackage and co
means that we are forced to call the correct graph traversal functions (from
cabal-install, rather than from Cabal).
---
cabal-install/Distribution/Client/Install.hs | 20 +-
.../Distribution/Client/InstallPlan.hs | 37 ++-
.../Distribution/Client/PackageIndex.hs | 22 +-
.../Distribution/Client/PlanIndex.hs | 223 ++++++++++--------
cabal-install/Distribution/Client/Types.hs | 27 +--
5 files changed, 178 insertions(+), 151 deletions(-)
diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
index cfebe26e54..bdc8cd7495 100644
--- a/cabal-install/Distribution/Client/Install.hs
+++ b/cabal-install/Distribution/Client/Install.hs
@@ -33,7 +33,7 @@ import Data.List
( isPrefixOf, unfoldr, nub, sort, (\\) )
import qualified Data.Set as S
import Data.Maybe
- ( isJust, fromMaybe, mapMaybe, maybeToList )
+ ( isJust, fromMaybe, mapMaybe, catMaybes )
import Control.Exception as Exception
( Exception(toException), bracket, catches
, Handler(Handler), handleJust, IOException, SomeException )
@@ -564,14 +564,16 @@ packageStatus _comp installedPkgIndex cpkg =
changes pkg pkg' =
filter changed
$ mergeBy (comparing packageName)
- -- get dependencies of installed package (convert to source pkg ids via
- -- index)
- (nub . sort . concatMap
- (maybeToList . fmap Installed.sourcePackageId .
- PackageIndex.lookupInstalledPackageId installedPkgIndex) .
- Installed.depends $ pkg)
- -- get dependencies of configured package
- (nub . sort . depends $ pkg')
+ (resolveInstalledIds $ Installed.depends pkg)
+ (resolveInstalledIds $ depends $ pkg')
+
+ resolveInstalledIds :: [InstalledPackageId] -> [PackageIdentifier]
+ resolveInstalledIds =
+ nub
+ . sort
+ . map Installed.sourcePackageId
+ . catMaybes
+ . map (PackageIndex.lookupInstalledPackageId installedPkgIndex)
changed (InBoth pkgid pkgid') = pkgid /= pkgid'
changed _ = True
diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs
index 84735ff41e..0505fbeaea 100644
--- a/cabal-install/Distribution/Client/InstallPlan.hs
+++ b/cabal-install/Distribution/Client/InstallPlan.hs
@@ -60,7 +60,7 @@ import Distribution.Client.Types
import Distribution.Package
( PackageIdentifier(..), PackageName(..), Package(..), packageName
, Dependency(..), PackageId, InstalledPackageId
- , HasInstalledPackageId(..), PackageInstalled(..) )
+ , HasInstalledPackageId(..) )
import Distribution.Version
( Version, withinRange )
import Distribution.PackageDescription
@@ -75,6 +75,7 @@ import Distribution.PackageDescription.Configuration
import Distribution.Simple.PackageIndex
( PackageIndex, FakeMap )
import qualified Distribution.Simple.PackageIndex as PackageIndex
+import qualified Distribution.Client.PlanIndex as PlanIndex
import Distribution.Text
( display )
import Distribution.System
@@ -173,14 +174,6 @@ instance HasInstalledPackageId PlanPackage where
installedPackageId (Installed pkg _) = installedPackageId pkg
installedPackageId (Failed pkg _) = installedPackageId pkg
-instance PackageInstalled PlanPackage where
- installedDepends (PreExisting pkg) = installedDepends pkg
- installedDepends (Configured pkg) = installedDepends pkg
- installedDepends (Processing pkg) = installedDepends pkg
- installedDepends (Installed _ (BuildOk _ _ (Just ipkg))) = installedDepends ipkg
- installedDepends (Installed pkg _) = installedDepends pkg
- installedDepends (Failed pkg _) = installedDepends pkg
-
data InstallPlan = InstallPlan {
planIndex :: PlanIndex,
planFakeMap :: FakeMap,
@@ -245,7 +238,7 @@ new platform cinfo index =
planCompiler = cinfo
}
where (graph, vertexToPkgId, pkgIdToVertex) =
- PackageIndex.dependencyGraph index
+ PlanIndex.dependencyGraph fakeMap index
-- NB: doesn't need to know planFakeMap because the
-- fakemap is empty at this point.
noSuchPkgId = internalError "package is not in the graph"
@@ -291,7 +284,7 @@ ready plan = assert check readyPackages
]
hasAllInstalledDeps :: ConfiguredPackage -> Maybe [Installed.InstalledPackageInfo]
- hasAllInstalledDeps = mapM isInstalledDep . installedDepends
+ hasAllInstalledDeps = mapM isInstalledDep . depends
isInstalledDep :: InstalledPackageId -> Maybe Installed.InstalledPackageInfo
isInstalledDep pkgid =
@@ -470,17 +463,17 @@ problems platform cinfo fakeMap index =
, not (null packageProblems) ]
++ [ PackageMissingDeps pkg (catMaybes (map (fmap packageId . PackageIndex.fakeLookupInstalledPackageId fakeMap index) missingDeps))
- | (pkg, missingDeps) <- PackageIndex.brokenPackages' fakeMap index ]
+ | (pkg, missingDeps) <- PlanIndex.brokenPackages fakeMap index ]
++ [ PackageCycle cycleGroup
- | cycleGroup <- PackageIndex.dependencyCycles' fakeMap index ]
+ | cycleGroup <- PlanIndex.dependencyCycles fakeMap index ]
++ [ PackageInconsistency name inconsistencies
- | (name, inconsistencies) <- PackageIndex.dependencyInconsistencies' fakeMap index ]
+ | (name, inconsistencies) <- PlanIndex.dependencyInconsistencies fakeMap index ]
++ [ PackageStateInvalid pkg pkg'
| pkg <- PackageIndex.allPackages index
- , Just pkg' <- map (PackageIndex.fakeLookupInstalledPackageId fakeMap index) (installedDepends pkg)
+ , Just pkg' <- map (PackageIndex.fakeLookupInstalledPackageId fakeMap index) (depends pkg)
, not (stateDependencyRelation pkg pkg') ]
-- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
@@ -488,8 +481,8 @@ problems platform cinfo fakeMap index =
-- * if the result is @False@ use 'PackageIndex.dependencyCycles' to find out
-- which packages are involved in dependency cycles.
--
-acyclic :: PlanIndex -> Bool
-acyclic = null . PackageIndex.dependencyCycles
+acyclic :: FakeMap -> PlanIndex -> Bool
+acyclic fakeMap = null . PlanIndex.dependencyCycles fakeMap
-- | An installation plan is closed if for every package in the set, all of
-- its dependencies are also in the set. That is, the set is closed under the
@@ -498,8 +491,8 @@ acyclic = null . PackageIndex.dependencyCycles
-- * if the result is @False@ use 'PackageIndex.brokenPackages' to find out
-- which packages depend on packages not in the index.
--
-closed :: PlanIndex -> Bool
-closed = null . PackageIndex.brokenPackages
+closed :: FakeMap -> PlanIndex -> Bool
+closed fakeMap = null . PlanIndex.brokenPackages fakeMap
-- | An installation plan is consistent if all dependencies that target a
-- single package name, target the same version.
@@ -517,8 +510,8 @@ closed = null . PackageIndex.brokenPackages
-- * if the result is @False@ use 'PackageIndex.dependencyInconsistencies' to
-- find out which packages are.
--
-consistent :: PlanIndex -> Bool
-consistent = null . PackageIndex.dependencyInconsistencies
+consistent :: FakeMap -> PlanIndex -> Bool
+consistent fakeMap = null . PlanIndex.dependencyInconsistencies fakeMap
-- | The states of packages have that depend on each other must respect
-- this relation. That is for very case where package @a@ depends on
@@ -644,7 +637,7 @@ dependencyClosure :: InstallPlan
-> [PackageIdentifier]
-> Either (PackageIndex PlanPackage) [(PlanPackage, [InstalledPackageId])]
dependencyClosure installPlan pids =
- PackageIndex.dependencyClosure'
+ PlanIndex.dependencyClosure
(planFakeMap installPlan)
(planIndex installPlan)
(map (resolveFakeId . fakeInstalledPackageId) pids)
diff --git a/cabal-install/Distribution/Client/PackageIndex.hs b/cabal-install/Distribution/Client/PackageIndex.hs
index 39122a6a43..49d249f64e 100644
--- a/cabal-install/Distribution/Client/PackageIndex.hs
+++ b/cabal-install/Distribution/Client/PackageIndex.hs
@@ -15,7 +15,10 @@
module Distribution.Client.PackageIndex (
-- * Package index data type
PackageIndex,
+
+ -- * Fine-grained package dependencies
PackageFixedDeps(..),
+ fakeDepends,
-- * Creating an index
fromList,
@@ -59,10 +62,14 @@ import Data.Maybe (isJust, fromMaybe)
import Distribution.Package
( PackageName(..), PackageIdentifier(..)
, Package(..), packageName, packageVersion
- , Dependency(Dependency) )
+ , Dependency(Dependency)
+ , InstalledPackageId, installedDepends )
import Distribution.Version
( withinRange )
+import Distribution.InstalledPackageInfo
+ ( InstalledPackageInfo_ )
import Distribution.Simple.Utils (lowercase, comparing)
+import Distribution.Simple.PackageIndex (FakeMap)
-- | Subclass of packages that have specific versioned dependencies.
--
@@ -72,8 +79,19 @@ import Distribution.Simple.Utils (lowercase, comparing)
-- dependency graphs) only make sense on this subclass of package types.
--
class Package pkg => PackageFixedDeps pkg where
- depends :: pkg -> [PackageIdentifier]
+ depends :: pkg -> [InstalledPackageId]
+
+-- | Variant of `depends` which accepts a `FakeMap`
+--
+-- Analogous to `fakeInstalledDepends`. See Note [FakeMap].
+fakeDepends :: PackageFixedDeps pkg => FakeMap -> pkg -> [InstalledPackageId]
+fakeDepends fakeMap = map resolveFakeId . depends
+ where
+ resolveFakeId :: InstalledPackageId -> InstalledPackageId
+ resolveFakeId ipid = Map.findWithDefault ipid ipid fakeMap
+instance PackageFixedDeps (InstalledPackageInfo_ str) where
+ depends info = installedDepends info
-- | The collection of information about packages from one or more 'PackageDB's.
--
diff --git a/cabal-install/Distribution/Client/PlanIndex.hs b/cabal-install/Distribution/Client/PlanIndex.hs
index d50affdc98..97ea279d87 100644
--- a/cabal-install/Distribution/Client/PlanIndex.hs
+++ b/cabal-install/Distribution/Client/PlanIndex.hs
@@ -1,3 +1,8 @@
+-- | These graph traversal functions mirror the ones in Cabal, but work with
+-- the more complete (and fine-grained) set of dependencies provided by
+-- PackageFixedDeps rather than only the library dependencies provided by
+-- PackageInstalled.
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
module Distribution.Client.PlanIndex (
brokenPackages
@@ -16,38 +21,46 @@ import qualified Data.Tree as Tree
import qualified Data.Graph as Graph
import qualified Data.Array as Array
import Data.Array ((!))
-import Data.List (groupBy, sortBy, nub)
-import Data.Maybe (isNothing, fromMaybe, catMaybes)
+import Data.List (sortBy)
+import Data.Map (Map)
+import Data.Maybe (isNothing, fromMaybe)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid(..))
#endif
import Distribution.Package
- ( PackageName(..), PackageIdentifier(..)
+ ( PackageName(..), PackageIdentifier(..), InstalledPackageId(..)
, Package(..), packageName, packageVersion
)
import Distribution.Version
( Version )
-import Distribution.Simple.Utils (equating, comparing)
+import Distribution.Simple.Utils (comparing)
+import Distribution.Simple.PackageIndex
+ ( FakeMap )
import Distribution.Client.PackageIndex
- ( PackageFixedDeps(..) )
-import Distribution.Client.PackageIndex
- ( PackageIndex, lookupPackageId, allPackages, insert )
+ ( PackageFixedDeps(..), fakeDepends )
+import Distribution.Simple.PackageIndex
+ ( PackageIndex, allPackages, insert
+ , fakeLookupInstalledPackageId
+ )
+import Distribution.Package
+ ( HasInstalledPackageId(..), PackageId )
-- | All packages that have dependencies that are not in the index.
--
-- Returns such packages along with the dependencies that they're missing.
--
-brokenPackages :: PackageFixedDeps pkg
- => PackageIndex pkg
- -> [(pkg, [PackageIdentifier])]
-brokenPackages index =
+brokenPackages :: (HasInstalledPackageId pkg, PackageFixedDeps pkg)
+ => FakeMap
+ -> PackageIndex pkg
+ -> [(pkg, [InstalledPackageId])]
+brokenPackages fakeMap index =
[ (pkg, missing)
| pkg <- allPackages index
, let missing = [ pkg' | pkg' <- depends pkg
- , isNothing (lookupPackageId index pkg') ]
+ , isNothing (fakeLookupInstalledPackageId fakeMap index pkg') ]
, not (null missing) ]
-- | Given a package index where we assume we want to use all the packages
@@ -60,41 +73,49 @@ brokenPackages index =
-- depend on it and the versions they require. These are guaranteed to be
-- distinct.
--
-dependencyInconsistencies :: PackageFixedDeps pkg
- => PackageIndex pkg
+dependencyInconsistencies :: forall pkg. (PackageFixedDeps pkg, HasInstalledPackageId pkg)
+ => FakeMap
+ -> PackageIndex pkg
-> [(PackageName, [(PackageIdentifier, Version)])]
-dependencyInconsistencies index =
- [ (name, inconsistencies)
- | (name, uses) <- Map.toList inverseIndex
- , let inconsistencies = duplicatesBy uses
- versions = map snd inconsistencies
- , reallyIsInconsistent name (nub versions) ]
-
- where inverseIndex = Map.fromListWith (++)
- [ (packageName dep, [(packageId pkg, packageVersion dep)])
- | pkg <- allPackages index
- , dep <- depends pkg ]
-
- duplicatesBy = (\groups -> if length groups == 1
- then []
- else concat groups)
- . groupBy (equating snd)
- . sortBy (comparing snd)
-
- reallyIsInconsistent :: PackageName -> [Version] -> Bool
- reallyIsInconsistent _ [] = False
- reallyIsInconsistent name [v1, v2] =
- case (mpkg1, mpkg2) of
- (Just pkg1, Just pkg2) -> pkgid1 `notElem` depends pkg2
- && pkgid2 `notElem` depends pkg1
- _ -> True
- where
- pkgid1 = PackageIdentifier name v1
- pkgid2 = PackageIdentifier name v2
- mpkg1 = lookupPackageId index pkgid1
- mpkg2 = lookupPackageId index pkgid2
-
- reallyIsInconsistent _ _ = True
+dependencyInconsistencies fakeMap index =
+ [ (name, [ (pid,packageVersion dep) | (dep,pids) <- uses, pid <- pids])
+ | (name, ipid_map) <- Map.toList inverseIndex
+ , let uses = Map.elems ipid_map
+ , reallyIsInconsistent (map fst uses)
+ ]
+ where
+ -- For each package name (of a dependency, somewhere)
+ -- and each installed ID of that that package
+ -- the associated package instance
+ -- and a list of reverse dependencies (as source IDs)
+ inverseIndex :: Map PackageName (Map InstalledPackageId (pkg, [PackageId]))
+ inverseIndex = Map.fromListWith (Map.unionWith (\(a,b) (_,b') -> (a,b++b')))
+ [ (packageName dep, Map.fromList [(ipid,(dep,[packageId pkg]))])
+ | -- For each package @pkg@
+ pkg <- allPackages index
+ -- Find out which @ipid@ @pkg@ depends on
+ , ipid <- fakeDepends fakeMap pkg
+ -- And look up those @ipid@ (i.e., @ipid@ is the ID of @dep@)
+ , Just dep <- [fakeLookupInstalledPackageId fakeMap index ipid]
+ ]
+
+ -- If, in a single install plan, we depend on more than one version of a
+ -- package, then this is ONLY okay in the (rather special) case that we
+ -- depend on precisely two versions of that package, and one of them
+ -- depends on the other. This is necessary for example for the base where
+ -- we have base-3 depending on base-4.
+ reallyIsInconsistent :: [pkg] -> Bool
+ reallyIsInconsistent [] = False
+ reallyIsInconsistent [_p] = False
+ reallyIsInconsistent [p1, p2] =
+ let pid1 = installedPackageId p1
+ pid2 = installedPackageId p2
+ in Map.findWithDefault pid1 pid1 fakeMap `notElem` fakeDepends fakeMap p2
+ && Map.findWithDefault pid2 pid2 fakeMap `notElem` fakeDepends fakeMap p1
+ reallyIsInconsistent _ = True
+
+
+
-- | Find if there are any cycles in the dependency graph. If there are no
-- cycles the result is @[]@.
@@ -103,15 +124,17 @@ dependencyInconsistencies index =
-- list of groups of packages where within each group they all depend on each
-- other, directly or indirectly.
--
-dependencyCycles :: PackageFixedDeps pkg
- => PackageIndex pkg
+dependencyCycles :: (PackageFixedDeps pkg, HasInstalledPackageId pkg)
+ => FakeMap
+ -> PackageIndex pkg
-> [[pkg]]
-dependencyCycles index =
+dependencyCycles fakeMap index =
[ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ]
where
- adjacencyList = [ (pkg, packageId pkg, depends pkg)
+ adjacencyList = [ (pkg, installedPackageId pkg, fakeDepends fakeMap pkg)
| pkg <- allPackages index ]
+
-- | Tries to take the transitive closure of the package dependencies.
--
-- If the transitive closure is complete then it returns that subset of the
@@ -120,86 +143,92 @@ dependencyCycles index =
-- * Note that if the result is @Right []@ it is because at least one of
-- the original given 'PackageIdentifier's do not occur in the index.
--
-dependencyClosure :: PackageFixedDeps pkg
- => PackageIndex pkg
- -> [PackageIdentifier]
+dependencyClosure :: (PackageFixedDeps pkg, HasInstalledPackageId pkg)
+ => FakeMap
+ -> PackageIndex pkg
+ -> [InstalledPackageId]
-> Either (PackageIndex pkg)
- [(pkg, [PackageIdentifier])]
-dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of
+ [(pkg, [InstalledPackageId])]
+dependencyClosure fakeMap index pkgids0 = case closure mempty [] pkgids0 of
(completed, []) -> Left completed
- (completed, _) -> Right (brokenPackages completed)
- where
+ (completed, _) -> Right (brokenPackages fakeMap completed)
+ where
closure completed failed [] = (completed, failed)
- closure completed failed (pkgid:pkgids) = case lookupPackageId index pkgid of
+ closure completed failed (pkgid:pkgids) = case fakeLookupInstalledPackageId fakeMap index pkgid of
Nothing -> closure completed (pkgid:failed) pkgids
- Just pkg -> case lookupPackageId completed (packageId pkg) of
+ Just pkg -> case fakeLookupInstalledPackageId fakeMap completed (installedPackageId pkg) of
Just _ -> closure completed failed pkgids
Nothing -> closure completed' failed pkgids'
where completed' = insert pkg completed
pkgids' = depends pkg ++ pkgids
-topologicalOrder :: PackageFixedDeps pkg => PackageIndex pkg -> [pkg]
-topologicalOrder index = map toPkgId
- . Graph.topSort
- $ graph
- where (graph, toPkgId, _) = dependencyGraph index
-reverseTopologicalOrder :: PackageFixedDeps pkg => PackageIndex pkg -> [pkg]
-reverseTopologicalOrder index = map toPkgId
- . Graph.topSort
- . Graph.transposeG
- $ graph
- where (graph, toPkgId, _) = dependencyGraph index
+
+topologicalOrder :: (PackageFixedDeps pkg, HasInstalledPackageId pkg)
+ => FakeMap -> PackageIndex pkg -> [pkg]
+topologicalOrder fakeMap index = map toPkgId
+ . Graph.topSort
+ $ graph
+ where (graph, toPkgId, _) = dependencyGraph fakeMap index
+
+
+reverseTopologicalOrder :: (PackageFixedDeps pkg, HasInstalledPackageId pkg)
+ => FakeMap -> PackageIndex pkg -> [pkg]
+reverseTopologicalOrder fakeMap index = map toPkgId
+ . Graph.topSort
+ . Graph.transposeG
+ $ graph
+ where (graph, toPkgId, _) = dependencyGraph fakeMap index
+
-- | Takes the transitive closure of the packages reverse dependencies.
--
-- * The given 'PackageIdentifier's must be in the index.
--
-reverseDependencyClosure :: PackageFixedDeps pkg
- => PackageIndex pkg
- -> [PackageIdentifier]
+reverseDependencyClosure :: (PackageFixedDeps pkg, HasInstalledPackageId pkg)
+ => FakeMap
+ -> PackageIndex pkg
+ -> [InstalledPackageId]
-> [pkg]
-reverseDependencyClosure index =
+reverseDependencyClosure fakeMap index =
map vertexToPkg
. concatMap Tree.flatten
. Graph.dfs reverseDepGraph
. map (fromMaybe noSuchPkgId . pkgIdToVertex)
where
- (depGraph, vertexToPkg, pkgIdToVertex) = dependencyGraph index
+ (depGraph, vertexToPkg, pkgIdToVertex) = dependencyGraph fakeMap index
reverseDepGraph = Graph.transposeG depGraph
noSuchPkgId = error "reverseDependencyClosure: package is not in the graph"
-
-- | Builds a graph of the package dependencies.
--
-- Dependencies on other packages that are not in the index are discarded.
-- You can check if there are any such dependencies with 'brokenPackages'.
--
-dependencyGraph :: PackageFixedDeps pkg
- => PackageIndex pkg
+dependencyGraph :: (PackageFixedDeps pkg, HasInstalledPackageId pkg)
+ => FakeMap
+ -> PackageIndex pkg
-> (Graph.Graph,
Graph.Vertex -> pkg,
- PackageIdentifier -> Maybe Graph.Vertex)
-dependencyGraph index = (graph, vertexToPkg, pkgIdToVertex)
+ InstalledPackageId -> Maybe Graph.Vertex)
+dependencyGraph fakeMap index = (graph, vertexToPkg, idToVertex)
where
- graph = Array.listArray bounds $
- map (catMaybes . map pkgIdToVertex . depends) pkgs
+ graph = Array.listArray bounds
+ [ [ v | Just v <- map idToVertex (depends pkg) ]
+ | pkg <- pkgs ]
+
+ pkgs = sortBy (comparing packageId) (allPackages index)
+ pkgTable = Array.listArray bounds pkgs
+ bounds = (0, topBound)
+ topBound = length pkgs - 1
vertexToPkg vertex = pkgTable ! vertex
- pkgIdToVertex = binarySearch 0 topBound
-
- pkgTable = Array.listArray bounds pkgs
- pkgIdTable = Array.listArray bounds (map packageId pkgs)
- pkgs = sortBy (comparing packageId) (allPackages index)
- topBound = length pkgs - 1
- bounds = (0, topBound)
-
- binarySearch a b key
- | a > b = Nothing
- | otherwise = case compare key (pkgIdTable ! mid) of
- LT -> binarySearch a (mid-1) key
- EQ -> Just mid
- GT -> binarySearch (mid+1) b key
- where mid = (a + b) `div` 2
+
+ -- Old implementation used to use an array for vertices as well, with a
+ -- binary search algorithm. Not sure why this changed, but sticking with
+ -- this linear search for now.
+ vertices = zip (map installedPackageId pkgs) [0..]
+ vertexMap = Map.fromList vertices
+ idToVertex pid = Map.lookup (Map.findWithDefault pid pid fakeMap) vertexMap
diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs
index fb9a693c59..9e0a979303 100644
--- a/cabal-install/Distribution/Client/Types.hs
+++ b/cabal-install/Distribution/Client/Types.hs
@@ -54,20 +54,8 @@ data SourcePackageDb = SourcePackageDb {
-- * Various kinds of information about packages
-- ------------------------------------------------------------
--- | TODO: This is a hack to help us transition from Cabal-1.6 to 1.8.
--- What is new in 1.8 is that installed packages and dependencies between
--- installed packages are now identified by an opaque InstalledPackageId
--- rather than a source PackageId.
---
--- We should use simply an 'InstalledPackageInfo' here but to ease the
--- transition we are temporarily using this variant where we pretend that
--- installed packages still specify their deps in terms of PackageIds.
---
--- Crucially this means that 'InstalledPackage' can be an instance of
--- 'PackageFixedDeps' where as 'InstalledPackageInfo' is no longer an instance
--- of that class. This means we can make 'PackageIndex'es of InstalledPackage
--- where as the InstalledPackageInfo now has its own monomorphic index type.
---
+-- | InstalledPackage caches its dependencies as source package IDs.
+-- This is for the benefit of the top-down solver only.
data InstalledPackage = InstalledPackage
InstalledPackageInfo
[PackageId]
@@ -75,7 +63,7 @@ data InstalledPackage = InstalledPackage
instance Package InstalledPackage where
packageId (InstalledPackage pkg _) = packageId pkg
instance PackageFixedDeps InstalledPackage where
- depends (InstalledPackage _ deps) = deps
+ depends (InstalledPackage pkg _) = depends pkg
instance HasInstalledPackageId InstalledPackage where
installedPackageId (InstalledPackage pkg _) = installedPackageId pkg
instance PackageInstalled InstalledPackage where
@@ -133,12 +121,10 @@ instance Package ConfiguredPackage where
packageId (ConfiguredPackage pkg _ _ _) = packageId pkg
instance PackageFixedDeps ConfiguredPackage where
- depends (ConfiguredPackage _ _ _ deps) = map confSrcId deps
+ depends (ConfiguredPackage _ _ _ deps) = map confInstId deps
instance HasInstalledPackageId ConfiguredPackage where
installedPackageId = fakeInstalledPackageId . packageId
-instance PackageInstalled ConfiguredPackage where
- installedDepends = map fakeInstalledPackageId . depends
-- | Like 'ConfiguredPackage', but with all dependencies guaranteed to be
-- installed already, hence itself ready to be installed.
@@ -153,12 +139,11 @@ instance Package ReadyPackage where
packageId (ReadyPackage pkg _ _ _) = packageId pkg
instance PackageFixedDeps ReadyPackage where
- depends (ReadyPackage _ _ _ deps) = map packageId deps
+ depends (ReadyPackage _ _ _ deps) = map installedPackageId deps
instance HasInstalledPackageId ReadyPackage where
installedPackageId = fakeInstalledPackageId . packageId
-instance PackageInstalled ReadyPackage where
- installedDepends (ReadyPackage _ _ _ ipis) = map installedPackageId ipis
+
-- | Extracts a package key from ReadyPackage, a common operation needed
-- to calculate build paths.
--
GitLab