Commit 7161e4ce authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Revert "Fix three bugs with fake-map implementation for PackageIndex."

This reverts commit f59bab10.

Revert "Switch InstallPlan over to using IPID-indexed PackageIndex."

This reverts commit 6465d174.
parent f59bab10
......@@ -16,7 +16,6 @@ module Distribution.Simple.PackageIndex (
-- * Package index data type
InstalledPackageIndex,
PackageIndex,
FakeMap,
-- * Creating an index
fromList,
......@@ -60,15 +59,6 @@ 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)
......@@ -101,40 +91,6 @@ 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'
--
......@@ -247,7 +203,7 @@ fromList pkgs = mkPackageIndex pids pnames
--
merge :: PackageInstalled a => PackageIndex a -> PackageIndex a -> PackageIndex a
merge (PackageIndex pids1 pnames1) (PackageIndex pids2 pnames2) =
mkPackageIndex (Map.unionWith (\_ y -> y) pids1 pids2)
mkPackageIndex (Map.union pids1 pids2)
(Map.unionWith (Map.unionWith mergeBuckets) pnames1 pnames2)
where
-- Packages in the second list mask those in the first, however preferred
......@@ -488,14 +444,10 @@ searchByNameSubstring (PackageIndex _ pnames) searchterm =
-- other, directly or indirectly.
--
dependencyCycles :: PackageInstalled a => PackageIndex a -> [[a]]
dependencyCycles = dependencyCycles' Map.empty
-- | Variant of 'dependencyCycles' which accepts a 'FakeMap'. See Note [FakeMap].
dependencyCycles' :: PackageInstalled a => FakeMap -> PackageIndex a -> [[a]]
dependencyCycles' fakeMap index =
dependencyCycles index =
[ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ]
where
adjacencyList = [ (pkg, installedPackageId pkg, fakeInstalledDepends fakeMap pkg)
adjacencyList = [ (pkg, installedPackageId pkg, installedDepends pkg)
| pkg <- allPackages index ]
......@@ -504,20 +456,13 @@ dependencyCycles' fakeMap index =
-- Returns such packages along with the dependencies that they're missing.
--
brokenPackages :: PackageInstalled a => PackageIndex a -> [(a, [InstalledPackageId])]
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 =
brokenPackages index =
[ (pkg, missing)
| pkg <- allPackages index
, let missing = [ pkg' | pkg' <- installedDepends pkg
, isNothing (fakeLookupInstalledPackageId fakeMap index pkg') ]
, isNothing (lookupInstalledPackageId 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.
--
......@@ -531,22 +476,14 @@ dependencyClosure :: PackageInstalled a => PackageIndex a
-> [InstalledPackageId]
-> Either (PackageIndex a)
[(a, [InstalledPackageId])]
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
dependencyClosure 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 fakeLookupInstalledPackageId fakeMap index pkgid of
closure completed failed (pkgid:pkgids) = case lookupInstalledPackageId index pkgid of
Nothing -> closure completed (pkgid:failed) pkgids
Just pkg -> case fakeLookupInstalledPackageId fakeMap completed (installedPackageId pkg) of
Just pkg -> case lookupInstalledPackageId completed (installedPackageId pkg) of
Just _ -> closure completed failed pkgids
Nothing -> closure completed' failed pkgids'
where completed' = insert pkg completed
......@@ -559,21 +496,14 @@ dependencyClosure' fakeMap index pkgids0 = case closure mempty [] pkgids0 of
reverseDependencyClosure :: PackageInstalled a => PackageIndex a
-> [InstalledPackageId]
-> [a]
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 =
reverseDependencyClosure index =
map vertexToPkg
. concatMap Tree.flatten
. Graph.dfs reverseDepGraph
. map (fromMaybe noSuchPkgId . pkgIdToVertex)
where
(depGraph, vertexToPkg, pkgIdToVertex) = dependencyGraph' fakeMap index
(depGraph, vertexToPkg, pkgIdToVertex) = dependencyGraph index
reverseDepGraph = Graph.transposeG depGraph
noSuchPkgId = error "reverseDependencyClosure: package is not in the graph"
......@@ -599,15 +529,7 @@ dependencyGraph :: PackageInstalled a => PackageIndex a
-> (Graph.Graph,
Graph.Vertex -> a,
InstalledPackageId -> Maybe Graph.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)
dependencyGraph index = (graph, vertex_to_pkg, id_to_vertex)
where
graph = Array.listArray bounds
[ [ v | Just v <- map id_to_vertex (installedDepends pkg) ]
......@@ -616,7 +538,7 @@ dependencyGraph' fakeMap 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 (Map.findWithDefault pid pid fakeMap) vertex_map
id_to_vertex pid = Map.lookup pid vertex_map
vertex_to_pkg vertex = pkgTable ! vertex
......@@ -636,12 +558,7 @@ dependencyGraph' fakeMap index = (graph, vertex_to_pkg, id_to_vertex)
--
dependencyInconsistencies :: PackageInstalled a => PackageIndex a
-> [(PackageName, [(PackageId, Version)])]
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 =
dependencyInconsistencies index =
[ (name, [ (pid,packageVersion dep) | (dep,pids) <- uses, pid <- pids])
| (name, ipid_map) <- Map.toList inverseIndex
, let uses = Map.elems ipid_map
......@@ -655,23 +572,18 @@ dependencyInconsistencies' fakeMap index =
[ (packageName dep,
Map.fromList [(ipid,(dep,[packageId pkg]))])
| pkg <- allPackages index
, ipid <- fakeInstalledDepends fakeMap pkg
, Just dep <- [fakeLookupInstalledPackageId fakeMap index ipid]
, ipid <- installedDepends pkg
, Just dep <- [lookupInstalledPackageId index ipid]
]
reallyIsInconsistent :: PackageInstalled a => [a] -> Bool
reallyIsInconsistent [] = False
reallyIsInconsistent [_p] = False
reallyIsInconsistent [p1, p2] =
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
installedPackageId p1 `notElem` installedDepends p2
&& installedPackageId p2 `notElem` installedDepends 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 (InstalledPackageIndex.fromList pkgIndex) of
case InstallPlan.new platform comp (PackageIndex.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 (SI.fromList (map (convCP iidx sidx) cps))
new plat comp (CI.fromList (map (convCP iidx sidx) cps))
convCP :: SI.InstalledPackageIndex -> CI.PackageIndex SourcePackage ->
CP QPN -> PlanPackage
......
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.Install
......@@ -126,7 +125,7 @@ import Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Package
( PackageIdentifier(..), PackageId, packageName, packageVersion
, Package(..), PackageFixedDeps(..), PackageKey
, Dependency(..), thisPackageVersion, InstalledPackageId, installedPackageId )
, Dependency(..), thisPackageVersion, InstalledPackageId )
import qualified Distribution.PackageDescription as PackageDescription
import Distribution.PackageDescription
( PackageDescription, GenericPackageDescription(..), Flag(..)
......@@ -517,15 +516,15 @@ linearizeInstallPlan comp installedPkgIndex plan =
[] -> Nothing
(pkg:_) -> Just ((pkg, status), plan'')
where
pkgid = installedPackageId pkg
pkgid = packageId pkg
status = packageStatus comp installedPkgIndex pkg
plan'' = InstallPlan.completed pkgid
(BuildOk DocsNotTried TestsNotTried Nothing)
(BuildOk DocsNotTried TestsNotTried
(Just $ Installed.emptyInstalledPackageInfo
{ Installed.sourcePackageId = 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]
......@@ -1125,10 +1124,10 @@ executeInstallPlan verbosity comp jobCtl useLogFile plan0 installPkg =
updatePlan :: PackageIdentifier -> BuildResult -> InstallPlan -> InstallPlan
updatePlan pkgid (Right buildSuccess) =
InstallPlan.completed (Source.fakeInstalledPackageId pkgid) buildSuccess
InstallPlan.completed pkgid buildSuccess
updatePlan pkgid (Left buildFailure) =
InstallPlan.failed (Source.fakeInstalledPackageId pkgid) buildFailure depsFailure
InstallPlan.failed pkgid buildFailure depsFailure
where
depsFailure = DependentFailed pkgid
-- So this first pkgid failed for whatever reason (buildFailure).
......
......@@ -49,11 +49,10 @@ import Distribution.Client.Types
( SourcePackage(packageDescription), ConfiguredPackage(..)
, ReadyPackage(..), readyPackageToConfiguredPackage
, InstalledPackage, BuildFailure, BuildSuccess(..), enableStanzas
, InstalledPackage(..), fakeInstalledPackageId )
, InstalledPackage (..) )
import Distribution.Package
( PackageIdentifier(..), PackageName(..), Package(..), packageName
, PackageFixedDeps(..), Dependency(..), InstalledPackageId
, PackageInstalled(..) )
, PackageFixedDeps(..), Dependency(..) )
import Distribution.Version
( Version, withinRange )
import Distribution.PackageDescription
......@@ -63,9 +62,9 @@ import Distribution.Client.PackageUtils
( externalBuildDepends )
import Distribution.PackageDescription.Configuration
( finalizePackageDescription )
import Distribution.Simple.PackageIndex
( PackageIndex, FakeMap )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Client.PackageIndex
( PackageIndex )
import qualified Distribution.Client.PackageIndex as PackageIndex
import Distribution.Text
( display )
import Distribution.System
......@@ -86,10 +85,6 @@ 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.
......@@ -155,57 +150,31 @@ 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 :: PlanIndex,
planFakeMap :: FakeMap,
planIndex :: PackageIndex PlanPackage,
planGraph :: Graph,
planGraphRev :: Graph,
planPkgOf :: Graph.Vertex -> PlanPackage,
planVertexOf :: InstalledPackageId -> Graph.Vertex,
planVertexOf :: PackageIdentifier -> Graph.Vertex,
planPlatform :: Platform,
planCompiler :: CompilerId
}
invariant :: InstallPlan -> Bool
invariant plan =
valid (planPlatform plan) (planCompiler plan) (planFakeMap plan) (planIndex plan)
valid (planPlatform plan) (planCompiler 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 -> PlanIndex
new :: Platform -> CompilerId -> PackageIndex PlanPackage
-> Either [PlanProblem] InstallPlan
new platform compiler index =
-- 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
case problems platform compiler index of
[] -> Right InstallPlan {
planIndex = index,
planFakeMap = fakeMap,
planGraph = graph,
planGraphRev = Graph.transposeG graph,
planPkgOf = vertexToPkgId,
......@@ -215,8 +184,6 @@ 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
......@@ -260,13 +227,11 @@ ready plan = assert check readyPackages
]
hasAllInstalledDeps :: ConfiguredPackage -> Maybe [Installed.InstalledPackageInfo]
hasAllInstalledDeps = mapM isInstalledDep . installedDepends
hasAllInstalledDeps = mapM isInstalledDep . depends
isInstalledDep :: InstalledPackageId -> Maybe Installed.InstalledPackageInfo
isInstalledDep :: PackageIdentifier -> Maybe Installed.InstalledPackageInfo
isInstalledDep pkgid =
-- 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
case PackageIndex.lookupPackageId (planIndex plan) pkgid of
Just (Configured _) -> Nothing
Just (Processing _) -> Nothing
Just (Failed _ _) -> internalError depOnFailed
......@@ -296,25 +261,15 @@ 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 :: InstalledPackageId
completed :: PackageIdentifier
-> BuildSuccess
-> InstallPlan -> InstallPlan
completed pkgid buildResult plan = assert (invariant plan') plan'
where
plan' = 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
planIndex = PackageIndex.insert installed (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.
......@@ -322,14 +277,13 @@ completed pkgid buildResult plan = assert (invariant plan') plan'
-- * The package must exist in the graph and be in the processing
-- state.
--
failed :: InstalledPackageId -- ^ The id of the package that failed to install
failed :: PackageIdentifier -- ^ 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
}
......@@ -343,7 +297,7 @@ failed pkgid buildResult buildResult' plan = assert (invariant plan') plan'
-- | Lookup the reachable packages in the reverse dependency graph.
--
packagesThatDependOn :: InstallPlan
-> InstalledPackageId -> [PlanPackage]
-> PackageIdentifier -> [PlanPackage]
packagesThatDependOn plan = map (planPkgOf plan)
. tail
. Graph.reachable (planGraphRev plan)
......@@ -352,11 +306,9 @@ packagesThatDependOn plan = map (planPkgOf plan)
-- | Lookup a package that we expect to be in the processing state.
--
lookupProcessingPackage :: InstallPlan
-> InstalledPackageId -> ReadyPackage
-> PackageIdentifier -> ReadyPackage
lookupProcessingPackage plan pkgid =
-- NB: processing packages are guaranteed to not indirect through
-- planFakeMap
case PackageIndex.lookupInstalledPackageId (planIndex plan) pkgid of
case PackageIndex.lookupPackageId (planIndex plan) pkgid of
Just (Processing pkg) -> pkg
_ -> internalError $ "not in processing state or no such pkg " ++ display pkgid
......@@ -378,8 +330,8 @@ checkConfiguredPackage pkg =
--
-- * if the result is @False@ use 'problems' to get a detailed list.
--
valid :: Platform -> CompilerId -> FakeMap -> PlanIndex -> Bool
valid platform comp fakeMap index = null (problems platform comp fakeMap index)
valid :: Platform -> CompilerId -> PackageIndex PlanPackage -> Bool
valid platform comp index = null (problems platform comp index)
data PlanProblem =
PackageInvalid ConfiguredPackage [PackageProblem]
......@@ -429,26 +381,26 @@ showPlanProblem (PackageStateInvalid pkg pkg') =
-- error messages. This is mainly intended for debugging purposes.
-- Use 'showPlanProblem' for a human readable explanation.
--
problems :: Platform -> CompilerId -> FakeMap
-> PlanIndex -> [PlanProblem]
problems platform comp fakeMap index =
problems :: Platform -> CompilerId
-> PackageIndex PlanPackage -> [PlanProblem]
problems platform comp index =
[ PackageInvalid pkg packageProblems
| Configured pkg <- PackageIndex.allPackages index
, let packageProblems = configuredPackageProblems platform comp pkg
, not (null packageProblems) ]
++ [ PackageMissingDeps pkg (catMaybes (map (fmap packageId . PackageIndex.fakeLookupInstalledPackageId fakeMap index) missingDeps))
| (pkg, missingDeps) <- PackageIndex.brokenPackages' fakeMap index ]
++ [ PackageMissingDeps pkg missingDeps
| (pkg, missingDeps) <- PackageIndex.brokenPackages index ]
++ [ PackageCycle cycleGroup
| cycleGroup <- PackageIndex.dependencyCycles' fakeMap index ]
| cycleGroup <- PackageIndex.dependencyCycles index ]
++ [ PackageInconsistency name inconsistencies
| (name, inconsistencies) <- PackageIndex.dependencyInconsistencies' fakeMap index ]
| (name, inconsistencies) <- PackageIndex.dependencyInconsistencies index ]
++ [ PackageStateInvalid pkg pkg'
| pkg <- PackageIndex.allPackages index
, Just pkg' <- map (PackageIndex.fakeLookupInstalledPackageId fakeMap index) (installedDepends pkg)
, Just pkg' <- map (PackageIndex.lookupPackageId index) (depends pkg)
, not (stateDependencyRelation pkg pkg') ]
-- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
......@@ -456,7 +408,7 @@ problems platform comp fakeMap index =
-- * if the result is @False@ use 'PackageIndex.dependencyCycles' to find out
-- which packages are involved in dependency cycles.
--
acyclic :: PlanIndex -> Bool
acyclic :: PackageIndex PlanPackage -> Bool
acyclic = null . PackageIndex.dependencyCycles
-- | An installation plan is closed if for every package in the set, all of
......@@ -466,7 +418,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 :: PlanIndex -> Bool
closed :: PackageIndex PlanPackage -> Bool
closed = null . PackageIndex.brokenPackages
-- | An installation plan is consistent if all dependencies that target a
......@@ -485,7 +437,7 @@ closed = null . PackageIndex.brokenPackages
-- * if the result is @False@ use 'PackageIndex.dependencyInconsistencies' to
-- find out which packages are.
--
consistent :: PlanIndex -> Bool
consistent :: PackageIndex PlanPackage -> Bool
consistent = null . PackageIndex.dependencyInconsistencies
-- | The states of packages have that depend on each other must respect
......
......@@ -16,8 +16,7 @@ module Distribution.Client.Types where
import Distribution.Package
( PackageName, PackageId, Package(..), PackageFixedDeps(..)
, mkPackageKey, PackageKey, InstalledPackageId(..)
, PackageInstalled(..) )
, mkPackageKey, PackageKey )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo, packageKey )
import Distribution.PackageDescription
......@@ -31,7 +30,6 @@ import Distribution.Version
( VersionRange )
import Distribution.Simple.Compiler
( Compiler, packageKeySupported )
import Distribution.Text (display)
import Data.Map (Map)
import Network.URI (URI)
......@@ -75,22 +73,6 @@ 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
......@@ -113,10 +95,6 @@ instance Package ConfiguredPackage where
instance PackageFixedDeps ConfiguredPackage where
depends (ConfiguredPackage _ _ _ deps) = deps