Skip to content

GitLab

Commit 8cf73788 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Merge pull request #2142 from ezyang/ezyang-edge 

Switch InstallPlan over to using IPID-indexed PackageIndex.
parents 7207e68f 4856af6f
Hide whitespace changes
Inline Side-by-side
Cabal/Distribution/Simple/PackageIndex.hs
View file @ 8cf73788
......@@ -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
......
cabal-install/Distribution/Client/Dependency.hs
View file @ 8cf73788
......@@ -554,12 +554,15 @@ mkInstallPlan :: Platform
-> CompilerId
-> [InstallPlan.PlanPackage] -> InstallPlan
mkInstallPlan platform comp pkgIndex =
case InstallPlan.new platform comp (PackageIndex.fromList pkgIndex) of
let index = InstalledPackageIndex.fromList pkgIndex in
case InstallPlan.new platform comp index of
Right plan -> plan
Left problems -> error $ unlines $
"internal error: could not construct a valid install plan."
: "The proposed (invalid) plan contained the following problems:"
: map InstallPlan.showPlanProblem problems
++ "Proposed plan:"
: [InstallPlan.showPlanIndex index]
-- | Give an interpretation to the global 'PackagesPreference' as
......
cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs
View file @ 8cf73788
......@@ -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
......
cabal-install/Distribution/Client/Install.hs
View file @ 8cf73788
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.Install
......@@ -126,7 +127,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(..)
......@@ -517,15 +518,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]
......@@ -1126,10 +1130,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).
......
cabal-install/Distribution/Client/InstallPlan.hs
View file @ 8cf73788
......@@ -24,6 +24,8 @@ module Distribution.Client.InstallPlan (
completed,
failed,
remove,
showPlanIndex,
showInstallPlan,
-- ** Query functions
planPlatform,
......@@ -49,10 +51,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 +65,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 +88,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 +157,78 @@ 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
showPlanIndex :: PlanIndex -> String
showPlanIndex index =
intercalate "\n" (map showPlanPackage (PackageIndex.allPackages index))
where showPlanPackage p =
showPlanPackageTag p ++ " "
++ display (packageId p) ++ " ("
++ display (installedPackageId p) ++ ")"
showInstallPlan :: InstallPlan -> String
showInstallPlan plan =
showPlanIndex (planIndex plan) ++ "\n" ++
"fake map:\n " ++ intercalate "\n " (map showKV (Map.toList (planFakeMap plan)))
where showKV (k,v) = display k ++ " -> " ++ display v
showPlanPackageTag :: PlanPackage -> String
showPlanPackageTag (PreExisting _) = "PreExisting"
showPlanPackageTag (Configured _) = "Configured"
showPlanPackageTag (Processing _) = "Processing"
showPlanPackageTag (Installed _ _) = "Installed"
showPlanPackageTag (Failed _ _) = "Failed"
-- | 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 +238,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 +283,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 +319,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 +345,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 +366,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 +375,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 +401,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 +452,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 +479,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 +489,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 +508,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
......
cabal-install/Distribution/Client/Types.hs
View file @ 8cf73788
......@@ -16,7 +16,8 @@ module Distribution.Client.Types where
import Distribution.Package
( PackageName, PackageId, Package(..), PackageFixedDeps(..)
, mkPackageKey, PackageKey )
,