Commit bd3b3283 authored by Edsko de Vries's avatar Edsko de Vries

Remove FakeMap completely from Cabal

It's now only used in cabal-install.
parent 0ff63413
......@@ -17,7 +17,6 @@ module Distribution.Simple.PackageIndex (
-- * Package index data type
InstalledPackageIndex,
PackageIndex,
FakeMap,
-- * Creating an index
fromList,
......@@ -61,15 +60,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)
......@@ -105,40 +95,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'
--
......@@ -492,14 +448,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 ]
......@@ -508,21 +460,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 :: HasInstalledPackageId 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.
--
-- If the transitive closure is complete then it returns that subset of the
......@@ -535,22 +479,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
......@@ -563,21 +499,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"
......@@ -603,15 +532,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) ]
......@@ -620,7 +541,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
......@@ -640,12 +561,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
......@@ -659,8 +575,8 @@ 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
......@@ -669,14 +585,10 @@ dependencyInconsistencies' fakeMap index =
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
in pid1 `notElem` installedDepends p2
&& pid2 `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
-- initialize the @build-deps@ field in @cabal init@.
......
......@@ -73,8 +73,10 @@ import Distribution.Client.PackageIndex
import Distribution.PackageDescription.Configuration
( finalizePackageDescription )
import Distribution.Simple.PackageIndex
( PackageIndex, FakeMap )
( PackageIndex )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Client.PlanIndex
( FakeMap )
import qualified Distribution.Client.PlanIndex as PlanIndex
import Distribution.Text
( display )
......@@ -299,7 +301,7 @@ ready plan = assert check readyPackages
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 PlanIndex.fakeLookupInstalledPackageId (planFakeMap plan) (planIndex plan) pkgid of
Just (Configured _) -> Nothing
Just (Processing _) -> Nothing
Just (Failed _ _) -> internalError depOnFailed
......@@ -471,7 +473,7 @@ problems platform cinfo fakeMap index =
, let packageProblems = configuredPackageProblems platform cinfo pkg
, not (null packageProblems) ]
++ [ PackageMissingDeps pkg (catMaybes (map (fmap packageId . PackageIndex.fakeLookupInstalledPackageId fakeMap index) missingDeps))
++ [ PackageMissingDeps pkg (catMaybes (map (fmap packageId . PlanIndex.fakeLookupInstalledPackageId fakeMap index) missingDeps))
| (pkg, missingDeps) <- PlanIndex.brokenPackages fakeMap index ]
++ [ PackageCycle cycleGroup
......@@ -482,7 +484,7 @@ problems platform cinfo fakeMap index =
++ [ PackageStateInvalid pkg pkg'
| pkg <- PackageIndex.allPackages index
, Just pkg' <- map (PackageIndex.fakeLookupInstalledPackageId fakeMap index) (depends pkg)
, Just pkg' <- map (PlanIndex.fakeLookupInstalledPackageId fakeMap index) (depends pkg)
, not (stateDependencyRelation pkg pkg') ]
-- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
......
......@@ -18,7 +18,6 @@ module Distribution.Client.PackageIndex (
-- * Fine-grained package dependencies
PackageFixedDeps(..),
fakeDepends,
-- * Creating an index
fromList,
......@@ -68,8 +67,8 @@ import Distribution.Version
( withinRange )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo_ )
import Distribution.Simple.Utils (lowercase, comparing)
import Distribution.Simple.PackageIndex (FakeMap)
import Distribution.Simple.Utils
( lowercase, comparing )
-- | Subclass of packages that have specific versioned dependencies.
--
......@@ -81,15 +80,6 @@ import Distribution.Simple.PackageIndex (FakeMap)
class Package pkg => PackageFixedDeps pkg where
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
......
......@@ -5,7 +5,12 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
module Distribution.Client.PlanIndex (
brokenPackages
-- * FakeMap and related operations
FakeMap
, fakeDepends
, fakeLookupInstalledPackageId
-- * Graph traversal functions
, brokenPackages
, dependencyClosure
, dependencyCycles
, dependencyGraph
......@@ -35,19 +40,63 @@ import Distribution.Package
)
import Distribution.Version
( Version )
import Distribution.Simple.Utils (comparing)
import Distribution.Simple.PackageIndex
( FakeMap )
import Distribution.Simple.Utils
( comparing )
import Distribution.Client.PackageIndex
( PackageFixedDeps(..), fakeDepends )
( PackageFixedDeps(..) )
import Distribution.Simple.PackageIndex
( PackageIndex, allPackages, insert
, fakeLookupInstalledPackageId
)
( PackageIndex, allPackages, insert, lookupInstalledPackageId )
import Distribution.Package
( HasInstalledPackageId(..), PackageId )
-- 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
-- | 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
--- | Variant of 'lookupInstalledPackageId' which accepts a 'FakeMap'. See Note [FakeMap].
fakeLookupInstalledPackageId :: HasInstalledPackageId a => FakeMap -> PackageIndex a -> InstalledPackageId -> Maybe a
fakeLookupInstalledPackageId fakeMap index pkg = lookupInstalledPackageId index (Map.findWithDefault pkg pkg fakeMap)
-- | All packages that have dependencies that are not in the index.
--
-- Returns such packages along with the dependencies that they're missing.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment