Commit ff6c718b authored by Edward Z. Yang's avatar Edward Z. Yang

Switch InstallPlan over to using IPID-indexed PackageIndex.

While this doesn't let us get rid of Distribution.Client.PackageIndex,
it does make InstallPlan more flexible, so we can have the same
package name-package version in the install plan multiple times.
We do this by synthesizing fake installed package IDs to act
as placeholders prior to compilation.

There is some shindig with 'FakeMap' in PackageIndex, check out
the Note in that file for more details.

This reverts commit a5a0f8e1959003ee702c04a23375a60d48f03f90, with
a bugfix for linearizeInstallPlan.

Fixes #2123
parent 90993d34
......@@ -16,6 +16,7 @@ module Distribution.Simple.PackageIndex (
-- * Package index data type
InstalledPackageIndex,
PackageIndex,
FakeMap,
-- * Creating an index
fromList,
......@@ -59,6 +60,15 @@ module Distribution.Simple.PackageIndex (
dependencyCycles,
dependencyGraph,
moduleNameIndex,
-- ** Variants of special queries supporting fake map
fakeLookupInstalledPackageId,
brokenPackages',
dependencyClosure',
reverseDependencyClosure',
dependencyInconsistencies',
dependencyCycles',
dependencyGraph',
) where
import Control.Exception (assert)
......@@ -91,6 +101,40 @@ import Distribution.Version
( Version, withinRange )
import Distribution.Simple.Utils (lowercase, comparing, equating)
-- Note [FakeMap]
-----------------
-- We'd like to use the PackageIndex defined in this module for
-- cabal-install's InstallPlan. However, at the moment, this
-- data structure is indexed by InstalledPackageId, which we don't
-- know until after we've compiled a package (whereas InstallPlan
-- needs to store not-compiled packages in the index.) Eventually,
-- an InstalledPackageId will be calculatable prior to actually
-- building the package (making it something of a misnomer), but
-- at the moment, the "fake installed package ID map" is a workaround
-- to solve this problem while reusing PackageIndex. The basic idea
-- is that, since we don't know what an InstalledPackageId is
-- beforehand, we just fake up one based on the package ID (it only
-- needs to be unique for the particular install plan), and fill
-- it out with the actual generated InstalledPackageId after the
-- package is successfully compiled.
--
-- However, there is a problem: in the index there may be
-- references using the old package ID, which are now dangling if
-- we update the InstalledPackageId. We could map over the entire
-- index to update these pointers as well (a costly operation), but
-- instead, we've chosen to parametrize a variety of important functions
-- by a FakeMap, which records what a fake installed package ID was
-- actually resolved to post-compilation. If we do a lookup, we first
-- check and see if it's a fake ID in the FakeMap.
--
-- It's a bit grungy, but we expect this to only be temporary anyway.
-- (Another possible workaround would have been to *not* update
-- the installed package ID, but I decided this would be hard to
-- understand.)
-- | Map from fake installed package IDs to real ones. See Note [FakeMap]
type FakeMap = Map InstalledPackageId InstalledPackageId
-- | The collection of information about packages from one or more 'PackageDB's.
-- These packages generally should have an instance of 'PackageInstalled'
--
......@@ -203,7 +247,7 @@ fromList pkgs = mkPackageIndex pids pnames
--
merge :: PackageInstalled a => PackageIndex a -> PackageIndex a -> PackageIndex a
merge (PackageIndex pids1 pnames1) (PackageIndex pids2 pnames2) =
mkPackageIndex (Map.union pids1 pids2)
mkPackageIndex (Map.unionWith (\_ y -> y) pids1 pids2)
(Map.unionWith (Map.unionWith mergeBuckets) pnames1 pnames2)
where
-- Packages in the second list mask those in the first, however preferred
......@@ -444,10 +488,14 @@ searchByNameSubstring (PackageIndex _ pnames) searchterm =
-- other, directly or indirectly.
--
dependencyCycles :: PackageInstalled a => PackageIndex a -> [[a]]
dependencyCycles index =
dependencyCycles = dependencyCycles' Map.empty
-- | Variant of 'dependencyCycles' which accepts a 'FakeMap'. See Note [FakeMap].
dependencyCycles' :: PackageInstalled a => FakeMap -> PackageIndex a -> [[a]]
dependencyCycles' fakeMap index =
[ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ]
where
adjacencyList = [ (pkg, installedPackageId pkg, installedDepends pkg)
adjacencyList = [ (pkg, installedPackageId pkg, fakeInstalledDepends fakeMap pkg)
| pkg <- allPackages index ]
......@@ -456,13 +504,20 @@ dependencyCycles index =
-- Returns such packages along with the dependencies that they're missing.
--
brokenPackages :: PackageInstalled a => PackageIndex a -> [(a, [InstalledPackageId])]
brokenPackages index =
brokenPackages = brokenPackages' Map.empty
-- | Variant of 'brokenPackages' which accepts a 'FakeMap'. See Note [FakeMap].
brokenPackages' :: PackageInstalled a => FakeMap -> PackageIndex a -> [(a, [InstalledPackageId])]
brokenPackages' fakeMap index =
[ (pkg, missing)
| pkg <- allPackages index
, let missing = [ pkg' | pkg' <- installedDepends pkg
, isNothing (lookupInstalledPackageId index pkg') ]
, isNothing (fakeLookupInstalledPackageId fakeMap index pkg') ]
, not (null missing) ]
-- | Variant of 'lookupInstalledPackageId' which accepts a 'FakeMap'. See Note [FakeMap].
fakeLookupInstalledPackageId :: PackageInstalled a => FakeMap -> PackageIndex a -> InstalledPackageId -> Maybe a
fakeLookupInstalledPackageId fakeMap index pkg = lookupInstalledPackageId index (Map.findWithDefault pkg pkg fakeMap)
-- | Tries to take the transitive closure of the package dependencies.
--
......@@ -476,14 +531,22 @@ dependencyClosure :: PackageInstalled a => PackageIndex a
-> [InstalledPackageId]
-> Either (PackageIndex a)
[(a, [InstalledPackageId])]
dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of
dependencyClosure = dependencyClosure' Map.empty
-- | Variant of 'dependencyClosure' which accepts a 'FakeMap'. See Note [FakeMap].
dependencyClosure' :: PackageInstalled a => FakeMap
-> PackageIndex a
-> [InstalledPackageId]
-> Either (PackageIndex a)
[(a, [InstalledPackageId])]
dependencyClosure' fakeMap index pkgids0 = case closure mempty [] pkgids0 of
(completed, []) -> Left completed
(completed, _) -> Right (brokenPackages completed)
where
closure completed failed [] = (completed, failed)
closure completed failed (pkgid:pkgids) = case lookupInstalledPackageId index pkgid of
closure completed failed (pkgid:pkgids) = case fakeLookupInstalledPackageId fakeMap index pkgid of
Nothing -> closure completed (pkgid:failed) pkgids
Just pkg -> case lookupInstalledPackageId completed (installedPackageId 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
......@@ -496,14 +559,21 @@ dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of
reverseDependencyClosure :: PackageInstalled a => PackageIndex a
-> [InstalledPackageId]
-> [a]
reverseDependencyClosure index =
reverseDependencyClosure = reverseDependencyClosure' Map.empty
-- | Variant of 'reverseDependencyClosure' which accepts a 'FakeMap'. See Note [FakeMap].
reverseDependencyClosure' :: PackageInstalled a => FakeMap
-> PackageIndex a
-> [InstalledPackageId]
-> [a]
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"
......@@ -529,7 +599,15 @@ dependencyGraph :: PackageInstalled a => PackageIndex a
-> (Graph.Graph,
Graph.Vertex -> a,
InstalledPackageId -> Maybe Graph.Vertex)
dependencyGraph index = (graph, vertex_to_pkg, id_to_vertex)
dependencyGraph = dependencyGraph' Map.empty
-- | Variant of 'dependencyGraph' which accepts a 'FakeMap'. See Note [FakeMap].
dependencyGraph' :: PackageInstalled a => FakeMap
-> PackageIndex a
-> (Graph.Graph,
Graph.Vertex -> a,
InstalledPackageId -> Maybe Graph.Vertex)
dependencyGraph' fakeMap index = (graph, vertex_to_pkg, id_to_vertex)
where
graph = Array.listArray bounds
[ [ v | Just v <- map id_to_vertex (installedDepends pkg) ]
......@@ -538,7 +616,7 @@ dependencyGraph index = (graph, vertex_to_pkg, id_to_vertex)
pkgs = sortBy (comparing packageId) (allPackages index)
vertices = zip (map installedPackageId pkgs) [0..]
vertex_map = Map.fromList vertices
id_to_vertex pid = Map.lookup pid vertex_map
id_to_vertex pid = Map.lookup (Map.findWithDefault pid pid fakeMap) vertex_map
vertex_to_pkg vertex = pkgTable ! vertex
......@@ -558,7 +636,12 @@ dependencyGraph index = (graph, vertex_to_pkg, id_to_vertex)
--
dependencyInconsistencies :: PackageInstalled a => PackageIndex a
-> [(PackageName, [(PackageId, Version)])]
dependencyInconsistencies index =
dependencyInconsistencies = dependencyInconsistencies' Map.empty
-- | Variant of 'dependencyInconsistencies' which accepts a 'FakeMap'. See Note [FakeMap].
dependencyInconsistencies' :: PackageInstalled a => FakeMap -> PackageIndex a
-> [(PackageName, [(PackageId, Version)])]
dependencyInconsistencies' fakeMap index =
[ (name, [ (pid,packageVersion dep) | (dep,pids) <- uses, pid <- pids])
| (name, ipid_map) <- Map.toList inverseIndex
, let uses = Map.elems ipid_map
......@@ -572,18 +655,23 @@ dependencyInconsistencies index =
[ (packageName dep,
Map.fromList [(ipid,(dep,[packageId pkg]))])
| pkg <- allPackages index
, ipid <- installedDepends pkg
, Just dep <- [lookupInstalledPackageId index ipid]
, ipid <- fakeInstalledDepends fakeMap pkg
, Just dep <- [fakeLookupInstalledPackageId fakeMap index ipid]
]
reallyIsInconsistent :: PackageInstalled a => [a] -> Bool
reallyIsInconsistent [] = False
reallyIsInconsistent [_p] = False
reallyIsInconsistent [p1, p2] =
installedPackageId p1 `notElem` installedDepends p2
&& installedPackageId p2 `notElem` installedDepends p1
let pid1 = installedPackageId p1
pid2 = installedPackageId p2
in Map.findWithDefault pid1 pid1 fakeMap `notElem` fakeInstalledDepends fakeMap p2
&& Map.findWithDefault pid2 pid2 fakeMap `notElem` fakeInstalledDepends fakeMap p1
reallyIsInconsistent _ = True
-- | Variant of 'installedDepends' which accepts a 'FakeMap'. See Note [FakeMap].
fakeInstalledDepends :: PackageInstalled a => FakeMap -> a -> [InstalledPackageId]
fakeInstalledDepends fakeMap = map (\pid -> Map.findWithDefault pid pid fakeMap) . installedDepends
-- | A rough approximation of GHC's module finder, takes a 'InstalledPackageIndex' and
-- turns it into a map from module names to their source packages. It's used to
......
......@@ -554,7 +554,7 @@ mkInstallPlan :: Platform
-> CompilerId
-> [InstallPlan.PlanPackage] -> InstallPlan
mkInstallPlan platform comp pkgIndex =
case InstallPlan.new platform comp (PackageIndex.fromList pkgIndex) of
case InstallPlan.new platform comp (InstalledPackageIndex.fromList pkgIndex) of
Right plan -> plan
Left problems -> error $ unlines $
"internal error: could not construct a valid install plan."
......
......@@ -17,7 +17,7 @@ mkPlan :: Platform -> CompilerId ->
SI.InstalledPackageIndex -> CI.PackageIndex SourcePackage ->
[CP QPN] -> Either [PlanProblem] InstallPlan
mkPlan plat comp iidx sidx cps =
new plat comp (CI.fromList (map (convCP iidx sidx) cps))
new plat comp (SI.fromList (map (convCP iidx sidx) cps))
convCP :: SI.InstalledPackageIndex -> CI.PackageIndex SourcePackage ->
CP QPN -> PlanPackage
......
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.Install
......@@ -125,7 +126,7 @@ import Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Package
( PackageIdentifier(..), PackageId, packageName, packageVersion
, Package(..), PackageFixedDeps(..), PackageKey
, Dependency(..), thisPackageVersion, InstalledPackageId )
, Dependency(..), thisPackageVersion, InstalledPackageId, installedPackageId )
import qualified Distribution.PackageDescription as PackageDescription
import Distribution.PackageDescription
( PackageDescription, GenericPackageDescription(..), Flag(..)
......@@ -516,15 +517,18 @@ linearizeInstallPlan comp installedPkgIndex plan =
[] -> Nothing
(pkg:_) -> Just ((pkg, status), plan'')
where
pkgid = packageId pkg
pkgid = installedPackageId pkg
status = packageStatus comp installedPkgIndex pkg
plan'' = InstallPlan.completed pkgid
(BuildOk DocsNotTried TestsNotTried
(Just $ Installed.emptyInstalledPackageInfo
{ Installed.sourcePackageId = pkgid }))
{ Installed.sourcePackageId = packageId pkg
, Installed.installedPackageId = pkgid }))
(InstallPlan.processing [pkg] plan')
--FIXME: This is a bit of a hack,
-- pretending that each package is installed
-- It's doubly a hack because the installed package ID
-- didn't get updated...
data PackageStatus = NewPackage
| NewVersion [Version]
......@@ -1124,10 +1128,10 @@ executeInstallPlan verbosity comp jobCtl useLogFile plan0 installPkg =
updatePlan :: PackageIdentifier -> BuildResult -> InstallPlan -> InstallPlan
updatePlan pkgid (Right buildSuccess) =
InstallPlan.completed pkgid buildSuccess
InstallPlan.completed (Source.fakeInstalledPackageId pkgid) buildSuccess
updatePlan pkgid (Left buildFailure) =
InstallPlan.failed pkgid buildFailure depsFailure
InstallPlan.failed (Source.fakeInstalledPackageId pkgid) buildFailure depsFailure
where
depsFailure = DependentFailed pkgid
-- So this first pkgid failed for whatever reason (buildFailure).
......
......@@ -49,10 +49,11 @@ import Distribution.Client.Types
( SourcePackage(packageDescription), ConfiguredPackage(..)
, ReadyPackage(..), readyPackageToConfiguredPackage
, InstalledPackage, BuildFailure, BuildSuccess(..), enableStanzas
, InstalledPackage (..) )
, InstalledPackage(..), fakeInstalledPackageId )
import Distribution.Package
( PackageIdentifier(..), PackageName(..), Package(..), packageName
, PackageFixedDeps(..), Dependency(..) )
, PackageFixedDeps(..), Dependency(..), InstalledPackageId
, PackageInstalled(..) )
import Distribution.Version
( Version, withinRange )
import Distribution.PackageDescription
......@@ -62,9 +63,9 @@ import Distribution.Client.PackageUtils
( externalBuildDepends )
import Distribution.PackageDescription.Configuration
( finalizePackageDescription )
import Distribution.Client.PackageIndex
( PackageIndex )
import qualified Distribution.Client.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex
( PackageIndex, FakeMap )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Text
( display )
import Distribution.System
......@@ -85,6 +86,10 @@ import qualified Data.Graph as Graph
import Data.Graph (Graph)
import Control.Exception
( assert )
import Data.Maybe (catMaybes)
import qualified Data.Map as Map
type PlanIndex = PackageIndex PlanPackage
-- When cabal tries to install a number of packages, including all their
-- dependencies it has a non-trivial problem to solve.
......@@ -150,31 +155,57 @@ instance PackageFixedDeps PlanPackage where
depends (Installed pkg _) = depends pkg
depends (Failed pkg _) = depends pkg
instance PackageInstalled PlanPackage where
installedPackageId (PreExisting pkg) = installedPackageId pkg
installedPackageId (Configured pkg) = installedPackageId pkg
installedPackageId (Processing pkg) = installedPackageId pkg
-- NB: defer to the actual installed package info in this case
installedPackageId (Installed _ (BuildOk _ _ (Just ipkg))) = installedPackageId ipkg
installedPackageId (Installed pkg _) = installedPackageId pkg
installedPackageId (Failed pkg _) = installedPackageId pkg
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 :: PackageIndex PlanPackage,
planIndex :: PlanIndex,
planFakeMap :: FakeMap,
planGraph :: Graph,
planGraphRev :: Graph,
planPkgOf :: Graph.Vertex -> PlanPackage,
planVertexOf :: PackageIdentifier -> Graph.Vertex,
planVertexOf :: InstalledPackageId -> Graph.Vertex,
planPlatform :: Platform,
planCompiler :: CompilerId
}
invariant :: InstallPlan -> Bool
invariant plan =
valid (planPlatform plan) (planCompiler plan) (planIndex plan)
valid (planPlatform plan) (planCompiler plan) (planFakeMap plan) (planIndex plan)
internalError :: String -> a
internalError msg = error $ "InstallPlan: internal error: " ++ msg
-- | Build an installation plan from a valid set of resolved packages.
--
new :: Platform -> CompilerId -> PackageIndex PlanPackage
new :: Platform -> CompilerId -> PlanIndex
-> Either [PlanProblem] InstallPlan
new platform compiler index =
case problems platform compiler index of
-- NB: Need to pre-initialize the fake-map with pre-existing
-- packages
let isPreExisting (PreExisting _) = True
isPreExisting _ = False
fakeMap = Map.fromList
. map (\p -> (fakeInstalledPackageId (packageId p), installedPackageId p))
. filter isPreExisting
$ PackageIndex.allPackages index in
case problems platform compiler fakeMap index of
[] -> Right InstallPlan {
planIndex = index,
planFakeMap = fakeMap,
planGraph = graph,
planGraphRev = Graph.transposeG graph,
planPkgOf = vertexToPkgId,
......@@ -184,6 +215,8 @@ new platform compiler index =
}
where (graph, vertexToPkgId, pkgIdToVertex) =
PackageIndex.dependencyGraph index
-- NB: doesn't need to know planFakeMap because the
-- fakemap is empty at this point.
noSuchPkgId = internalError "package is not in the graph"
probs -> Left probs
......@@ -227,11 +260,13 @@ ready plan = assert check readyPackages
]
hasAllInstalledDeps :: ConfiguredPackage -> Maybe [Installed.InstalledPackageInfo]
hasAllInstalledDeps = mapM isInstalledDep . depends
hasAllInstalledDeps = mapM isInstalledDep . installedDepends
isInstalledDep :: PackageIdentifier -> Maybe Installed.InstalledPackageInfo
isInstalledDep :: InstalledPackageId -> Maybe Installed.InstalledPackageInfo
isInstalledDep pkgid =
case PackageIndex.lookupPackageId (planIndex plan) pkgid of
-- NB: Need to check if the ID has been updated in planFakeMap, in which case we
-- might be dealing with an old pointer
case PackageIndex.fakeLookupInstalledPackageId (planFakeMap plan) (planIndex plan) pkgid of
Just (Configured _) -> Nothing
Just (Processing _) -> Nothing
Just (Failed _ _) -> internalError depOnFailed
......@@ -261,15 +296,25 @@ processing pkgs plan = assert (invariant plan') plan'
-- * The package must exist in the graph and be in the processing state.
-- * The package must have had no uninstalled dependent packages.
--
completed :: PackageIdentifier
completed :: InstalledPackageId
-> BuildSuccess
-> InstallPlan -> InstallPlan
completed pkgid buildResult plan = assert (invariant plan') plan'
where
plan' = plan {
planIndex = PackageIndex.insert installed (planIndex plan)
-- NB: installation can change the IPID, so better
-- record it in the fake mapping...
planFakeMap = insert_fake_mapping buildResult
$ planFakeMap plan,
planIndex = PackageIndex.insert installed
. PackageIndex.deleteInstalledPackageId pkgid
$ planIndex plan
}
-- ...but be sure to use the *old* IPID for the lookup for the
-- preexisting record
installed = Installed (lookupProcessingPackage plan pkgid) buildResult
insert_fake_mapping (BuildOk _ _ (Just ipi)) = Map.insert pkgid (installedPackageId ipi)
insert_fake_mapping _ = id
-- | Marks a package in the graph as having failed. It also marks all the
-- packages that depended on it as having failed.
......@@ -277,13 +322,14 @@ completed pkgid buildResult plan = assert (invariant plan') plan'
-- * The package must exist in the graph and be in the processing
-- state.
--
failed :: PackageIdentifier -- ^ The id of the package that failed to install
failed :: InstalledPackageId -- ^ The id of the package that failed to install
-> BuildFailure -- ^ The build result to use for the failed package
-> BuildFailure -- ^ The build result to use for its dependencies
-> InstallPlan
-> InstallPlan
failed pkgid buildResult buildResult' plan = assert (invariant plan') plan'
where
-- NB: failures don't update IPIDs
plan' = plan {
planIndex = PackageIndex.merge (planIndex plan) failures
}
......@@ -297,7 +343,7 @@ failed pkgid buildResult buildResult' plan = assert (invariant plan') plan'
-- | Lookup the reachable packages in the reverse dependency graph.
--
packagesThatDependOn :: InstallPlan
-> PackageIdentifier -> [PlanPackage]
-> InstalledPackageId -> [PlanPackage]
packagesThatDependOn plan = map (planPkgOf plan)
. tail
. Graph.reachable (planGraphRev plan)
......@@ -306,9 +352,11 @@ packagesThatDependOn plan = map (planPkgOf plan)
-- | Lookup a package that we expect to be in the processing state.
--
lookupProcessingPackage :: InstallPlan
-> PackageIdentifier -> ReadyPackage
-> InstalledPackageId -> ReadyPackage
lookupProcessingPackage plan pkgid =
case PackageIndex.lookupPackageId (planIndex plan) pkgid of
-- NB: processing packages are guaranteed to not indirect through
-- planFakeMap
case PackageIndex.lookupInstalledPackageId (planIndex plan) pkgid of
Just (Processing pkg) -> pkg
_ -> internalError $ "not in processing state or no such pkg " ++ display pkgid
......@@ -330,8 +378,8 @@ checkConfiguredPackage pkg =
--
-- * if the result is @False@ use 'problems' to get a detailed list.
--
valid :: Platform -> CompilerId -> PackageIndex PlanPackage -> Bool
valid platform comp index = null (problems platform comp index)
valid :: Platform -> CompilerId -> FakeMap -> PlanIndex -> Bool
valid platform comp fakeMap index = null (problems platform comp fakeMap index)
data PlanProblem =
PackageInvalid ConfiguredPackage [PackageProblem]
......@@ -381,26 +429,26 @@ showPlanProblem (PackageStateInvalid pkg pkg') =
-- error messages. This is mainly intended for debugging purposes.
-- Use 'showPlanProblem' for a human readable explanation.
--
problems :: Platform -> CompilerId
-> PackageIndex PlanPackage -> [PlanProblem]
problems platform comp index =
problems :: Platform -> CompilerId -> FakeMap
-> PlanIndex -> [PlanProblem]
problems platform comp fakeMap index =
[ PackageInvalid pkg packageProblems
| Configured pkg <- PackageIndex.allPackages index
, let packageProblems = configuredPackageProblems platform comp pkg
, not (null packageProblems) ]
++ [ PackageMissingDeps pkg missingDeps
| (pkg, missingDeps) <- PackageIndex.brokenPackages index ]
++ [ PackageMissingDeps pkg (catMaybes (map (fmap packageId . PackageIndex.fakeLookupInstalledPackageId fakeMap index) missingDeps))
| (pkg, missingDeps) <- PackageIndex.brokenPackages' fakeMap index ]
++ [ PackageCycle cycleGroup
| cycleGroup <- PackageIndex.dependencyCycles index ]
| cycleGroup <- PackageIndex.dependencyCycles' fakeMap index ]
++ [ PackageInconsistency name inconsistencies
| (name, inconsistencies) <- PackageIndex.dependencyInconsistencies index ]
| (name, inconsistencies) <- PackageIndex.dependencyInconsistencies' fakeMap index ]
++ [ PackageStateInvalid pkg pkg'
| pkg <- PackageIndex.allPackages index
, Just pkg' <- map (PackageIndex.lookupPackageId index) (depends pkg)
, Just pkg' <- map (PackageIndex.fakeLookupInstalledPackageId fakeMap index) (installedDepends pkg)
, not (stateDependencyRelation pkg pkg') ]
-- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
......@@ -408,7 +456,7 @@ problems platform comp index =
-- * if the result is @False@ use 'PackageIndex.dependencyCycles' to find out
-- which packages are involved in dependency cycles.
--
acyclic :: PackageIndex PlanPackage -> Bool
acyclic :: PlanIndex -> Bool
acyclic = null . PackageIndex.dependencyCycles
-- | An installation plan is closed if for every package in the set, all of
......@@ -418,7 +466,7 @@ 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 :: PackageIndex PlanPackage -> Bool
closed :: PlanIndex -> Bool
closed = null . PackageIndex.brokenPackages
-- | An installation plan is consistent if all dependencies that target a
......@@ -437,7 +485,7 @@ closed = null . PackageIndex.brokenPackages
-- * if the result is @False@ use 'PackageIndex.dependencyInconsistencies' to
-- find out which packages are.
--
consistent :: PackageIndex PlanPackage -> Bool
consistent :: PlanIndex -> Bool
consistent = null . PackageIndex.dependencyInconsistencies
-- | The states of packages have that depend on each other must respect
......
......@@ -16,7 +16,8 @@ module Distribution.Client.Types where
import Distribution.Package
( PackageName, PackageId, Package(..), PackageFixedDeps(..)
, mkPackageKey, PackageKey )
, mkPackageKey, PackageKey, InstalledPackageId(..)
, PackageInstalled(..) )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo, packageKey )
import Distribution.PackageDescription
......@@ -30,6 +31,7 @@ import Distribution.Version
( VersionRange )
import Distribution.Simple.Compiler
( Compiler, packageKeySupported )
import Distribution.Text (display)
import Data.Map (Map)
import Network.URI (URI)
......@@ -73,6 +75,22 @@ instance Package InstalledPackage where
packageId (InstalledPackage pkg _) = packageId pkg
instance PackageFixedDeps InstalledPackage where
depends (InstalledPackage _ deps) = deps
instance PackageInstalled InstalledPackage where
installedPackageId (InstalledPackage pkg _) = installedPackageId pkg
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
-- 'InstalledPackageId' which can be properly computed before compilation
-- (of course, it's a bit of a misnomer since the packages are not actually
-- installed yet.) In any case, we'll synthesize temporary installed package
-- IDs to use as keys during install planning. These should never be written
-- out! Additionally, they need to be guaranteed unique within the install
-- plan.
fakeInstalledPackageId :: PackageId -> InstalledPackageId
fakeInstalledPackageId = InstalledPackageId . (".fake."++) . display
-- | A 'ConfiguredPackage' is a not-yet-installed package along with the
-- total configuration information. The configuration information is total in
......@@ -95,6 +113,10 @@ instance Package ConfiguredPackage where
instance PackageFixedDeps ConfiguredPackage where
depends (ConfiguredPackage _ _ _ deps) = deps
instance PackageInstalled ConfiguredPackage where