Commit 4e8c6ecc authored by Edward Z. Yang's avatar Edward Z. Yang

Make Distribution.Simple.PackageIndex polymorphic in package storage.

BC note: renamed type PackageIndex :: * to InstalledPackageIndex.

The intent is to have cabal-install use this package index in order to
track information about compilation in progress.  We introduce a new
PackageInstalled type-class to keep track of data types which have their
IDs and dependency graphs in InstalledPackageId.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 0af22fd3
......@@ -79,7 +79,6 @@ import Distribution.Package
, PackageId, InstalledPackageId(..)
, packageName, packageVersion, PackageKey(..) )
import qualified Distribution.Package as Package
( Package(..) )
import Distribution.ModuleName
( ModuleName )
import Distribution.ModuleExport
......@@ -136,6 +135,10 @@ data InstalledPackageInfo_ m
instance Package.Package (InstalledPackageInfo_ str) where
packageId = sourcePackageId
instance Package.PackageInstalled (InstalledPackageInfo_ str) where
installedPackageId = installedPackageId
installedDepends = depends
type InstalledPackageInfo = InstalledPackageInfo_ ModuleName
emptyInstalledPackageInfo :: InstalledPackageInfo_ m
......
......@@ -35,6 +35,7 @@ module Distribution.Package (
-- * Package classes
Package(..), packageName, packageVersion,
PackageFixedDeps(..),
PackageInstalled(..),
) where
import Distribution.Version
......@@ -288,3 +289,13 @@ instance Package PackageIdentifier where
--
class Package pkg => PackageFixedDeps pkg where
depends :: pkg -> [PackageIdentifier]
-- | Class of installed packages.
--
-- The primary data type which is an instance of this package is
-- 'InstalledPackageInfo', but when we are doing install plans in Cabal install
-- we may have other, installed package-like things which contain more metadata.
-- Installed packages have exact dependencies 'installedDepends'.
class Package pkg => PackageInstalled pkg where
installedPackageId :: pkg -> InstalledPackageId
installedDepends :: pkg -> [InstalledPackageId]
......@@ -60,7 +60,7 @@ import Distribution.InstalledPackageInfo as Installed
( InstalledPackageInfo, InstalledPackageInfo_(..)
, emptyInstalledPackageInfo )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (PackageIndex)
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.PackageDescription as PD
( PackageDescription(..), specVersion, GenericPackageDescription(..)
, Library(..), hasLibs, Executable(..), BuildInfo(..), allExtensions
......@@ -648,8 +648,8 @@ data FailedDependency = DependencyNotExists PackageName
| DependencyNoVersion Dependency
-- | Test for a package dependency and record the version we have installed.
selectDependency :: PackageIndex -- ^ Internally defined packages
-> PackageIndex -- ^ Installed packages
selectDependency :: InstalledPackageIndex -- ^ Internally defined packages
-> InstalledPackageIndex -- ^ Installed packages
-> Map PackageName InstalledPackageInfo
-- ^ Packages for which we have been given specific deps to use
-> Dependency
......@@ -711,7 +711,7 @@ reportFailedDependencies failed =
getInstalledPackages :: Verbosity -> Compiler
-> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
-> IO InstalledPackageIndex
getInstalledPackages verbosity comp packageDBs progconf = do
when (null packageDBs) $
die $ "No package databases have been specified. If you use "
......@@ -734,7 +734,7 @@ getInstalledPackages verbosity comp packageDBs progconf = do
-- | Like 'getInstalledPackages', but for a single package DB.
getPackageDBContents :: Verbosity -> Compiler
-> PackageDB -> ProgramConfiguration
-> IO PackageIndex
-> IO InstalledPackageIndex
getPackageDBContents verbosity comp packageDB progconf = do
info verbosity "Reading installed packages..."
case compilerFlavor comp of
......@@ -785,7 +785,7 @@ newPackageDepsBehaviour pkg =
-- pick.
combinedConstraints :: [Dependency] ->
[(PackageName, InstalledPackageId)] ->
PackageIndex ->
InstalledPackageIndex ->
Either String ([Dependency],
Map PackageName InstalledPackageInfo)
combinedConstraints constraints dependencies installedPackages = do
......
......@@ -57,7 +57,7 @@ import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo_(..) )
import Distribution.Simple.PackageIndex (PackageIndex)
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
......@@ -497,14 +497,14 @@ oldLanguageExtensions =
]
-- | Given a single package DB, return all installed packages.
getPackageDBContents :: Verbosity -> PackageDB -> ProgramConfiguration
-> IO PackageIndex
-> IO InstalledPackageIndex
getPackageDBContents verbosity packagedb conf = do
pkgss <- getInstalledPackages' verbosity [packagedb] conf
toPackageIndex verbosity pkgss conf
-- | Given a package DB stack, return all installed packages.
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
-> IO InstalledPackageIndex
getInstalledPackages verbosity packagedbs conf = do
checkPackageDbEnvVar
checkPackageDbStack packagedbs
......@@ -526,7 +526,7 @@ getInstalledPackages verbosity packagedbs conf = do
toPackageIndex :: Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramConfiguration
-> IO PackageIndex
-> IO InstalledPackageIndex
toPackageIndex verbosity pkgss conf = do
-- On Windows, various fields have $topdir/foo rather than full
-- paths. We need to substitute the right value in so that when
......
......@@ -14,7 +14,7 @@ module Distribution.Simple.GHC.IPI641 (
) where
import qualified Distribution.InstalledPackageInfo as Current
import qualified Distribution.Package as Current hiding (depends)
import qualified Distribution.Package as Current hiding (depends, installedPackageId)
import Distribution.Text (display)
import Distribution.Simple.GHC.IPI642
......
......@@ -19,7 +19,7 @@ module Distribution.Simple.GHC.IPI642 (
) where
import qualified Distribution.InstalledPackageInfo as Current
import qualified Distribution.Package as Current hiding (depends)
import qualified Distribution.Package as Current hiding (depends, installedPackageId)
import qualified Distribution.License as Current
import Distribution.Version (Version)
......
......@@ -117,7 +117,7 @@ getLanguages verbosity prog = do
-- Other compilers do some kind of a packagedb stack check here. Not sure
-- if we need something like that as well.
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
-> IO InstalledPackageIndex
getInstalledPackages verbosity packagedbs conf =
liftM (PackageIndex.fromList . concat) $ forM packagedbs $ \packagedb ->
do str <-
......
......@@ -38,7 +38,7 @@ import Distribution.Simple.Compiler
, Compiler(..), Flag, languageToFlags, extensionsToFlags
, PackageDB(..), PackageDBStack )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (PackageIndex)
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.Simple.Program
( Program(programFindVersion)
, ProgramConfiguration, userMaybeSpecifyPath
......@@ -180,7 +180,7 @@ hugsLanguageExtensions =
]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
-> IO InstalledPackageIndex
getInstalledPackages verbosity packagedbs conf = do
homedir <- getHomeDirectory
(hugsProg, _) <- requireProgram verbosity hugsProgram conf
......@@ -191,7 +191,7 @@ getInstalledPackages verbosity packagedbs conf = do
return $! mconcat indexes
where
getIndividualDBPackages :: FilePath -> IO PackageIndex
getIndividualDBPackages :: FilePath -> IO InstalledPackageIndex
getIndividualDBPackages dbdir = do
pkgdirs <- getPackageDbDirs dbdir
pkgs <- sequence [ getInstalledPackage pkgname pkgdir
......
......@@ -22,7 +22,7 @@ import Distribution.PackageDescription as PD
import Distribution.InstalledPackageInfo
( emptyInstalledPackageInfo, )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Simple.PackageIndex (PackageIndex)
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
......@@ -100,7 +100,7 @@ jhcLanguageExtensions =
]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
-> IO InstalledPackageIndex
getInstalledPackages verbosity _packageDBs conf = do
-- jhc --list-libraries lists all available libraries.
-- How shall I find out, whether they are global or local
......
......@@ -218,7 +218,7 @@ getExtensions verbosity lhcProg = do
| Just ext <- map readExtension (lines exts) ]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
-> IO InstalledPackageIndex
getInstalledPackages verbosity packagedbs conf = do
checkPackageDbStack packagedbs
pkgss <- getInstalledPackages' lhcPkg verbosity packagedbs conf
......
......@@ -69,7 +69,7 @@ import Distribution.Package
import Distribution.Simple.Compiler
( Compiler(..), PackageDBStack, OptimisationLevel )
import Distribution.Simple.PackageIndex
( PackageIndex )
( InstalledPackageIndex )
import Distribution.Simple.Setup
( ConfigFlags )
import Distribution.Text
......@@ -107,7 +107,7 @@ data LocalBuildInfo = LocalBuildInfo {
componentsConfigs :: [(ComponentName, ComponentLocalBuildInfo, [ComponentName])],
-- ^ All the components to build, ordered by topological sort, and with their dependencies
-- over the intrapackage dependency graph
installedPkgs :: PackageIndex,
installedPkgs :: InstalledPackageIndex,
-- ^ All the info about the installed packages that the
-- current package depends on (directly or indirectly).
pkgDescrFile :: Maybe FilePath,
......
......@@ -42,7 +42,7 @@ import Distribution.Simple.Compiler
, Flag, languageToFlags, extensionsToFlags
, PackageDB(..), PackageDBStack )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (PackageIndex)
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Language.Haskell.Extension
( Language(Haskell98), Extension(..), KnownExtension(..) )
import Distribution.Simple.Program
......@@ -140,7 +140,7 @@ nhcLanguageExtensions =
]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO PackageIndex
-> IO InstalledPackageIndex
getInstalledPackages verbosity packagedbs conf = do
homedir <- getHomeDirectory
(nhcProg, _) <- requireProgram verbosity nhcProgram conf
......@@ -151,7 +151,7 @@ getInstalledPackages verbosity packagedbs conf = do
return $! mconcat indexes
where
getIndividualDBPackages :: FilePath -> IO PackageIndex
getIndividualDBPackages :: FilePath -> IO InstalledPackageIndex
getIndividualDBPackages dbdir = do
pkgdirs <- getPackageDbDirs dbdir
pkgs <- sequence [ getInstalledPackage pkgname pkgdir
......
......@@ -12,6 +12,7 @@
--
module Distribution.Simple.PackageIndex (
-- * Package index data type
InstalledPackageIndex,
PackageIndex,
-- * Creating an index
......@@ -32,6 +33,7 @@ module Distribution.Simple.PackageIndex (
-- ** Precise lookups
lookupInstalledPackageId,
lookupSourcePackageId,
lookupPackageId,
lookupPackageName,
lookupDependency,
......@@ -75,11 +77,11 @@ import Distribution.Package
( PackageName(..), PackageId
, Package(..), packageName, packageVersion
, Dependency(Dependency)--, --PackageFixedDeps(..)
, InstalledPackageId(..) )
, InstalledPackageId(..), PackageInstalled(..) )
import Distribution.ModuleName
( ModuleName )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo, installedPackageId )
( InstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Version
( Version, withinRange )
......@@ -87,17 +89,17 @@ import Distribution.Simple.Utils (lowercase, comparing, equating)
import Distribution.ModuleExport
( ModuleExport(..) )
-- | The collection of information about packages from one or more 'PackageDB's.
-- These packages generally should have an instance of 'PackageInstalled'
--
-- Packages are uniquely identified in by their 'InstalledPackageId', they can
-- also be efficiently looked up by package name or by name and version.
--
data PackageIndex = PackageIndex
data PackageIndex a = PackageIndex
-- The primary index. Each InstalledPackageInfo record is uniquely identified
-- by its InstalledPackageId.
--
!(Map InstalledPackageId InstalledPackageInfo)
!(Map InstalledPackageId a)
-- This auxiliary index maps package names (case-sensitively) to all the
-- versions and instances of that package. This allows us to find all
......@@ -110,18 +112,22 @@ data PackageIndex = PackageIndex
--
-- FIXME: Clarify what "preference order" means. Check that this invariant is
-- preserved. See #1463 for discussion.
!(Map PackageName (Map Version [InstalledPackageInfo]))
!(Map PackageName (Map Version [a]))
deriving (Show, Read)
instance Monoid PackageIndex where
-- | The default package index which contains 'InstalledPackageInfo'. Normally
-- use this.
type InstalledPackageIndex = PackageIndex InstalledPackageInfo
instance PackageInstalled a => Monoid (PackageIndex a) where
mempty = PackageIndex Map.empty Map.empty
mappend = merge
--save one mappend with empty in the common case:
mconcat [] = mempty
mconcat xs = foldr1 mappend xs
invariant :: PackageIndex -> Bool
invariant :: PackageInstalled a => PackageIndex a -> Bool
invariant (PackageIndex pids pnames) =
map installedPackageId (Map.elems pids)
== sort
......@@ -142,9 +148,10 @@ invariant (PackageIndex pids pnames) =
-- * Internal helpers
--
mkPackageIndex :: Map InstalledPackageId InstalledPackageInfo
-> Map PackageName (Map Version [InstalledPackageInfo])
-> PackageIndex
mkPackageIndex :: PackageInstalled a
=> Map InstalledPackageId a
-> Map PackageName (Map Version [a])
-> PackageIndex a
mkPackageIndex pids pnames = assert (invariant index) index
where index = PackageIndex pids pnames
......@@ -158,7 +165,7 @@ mkPackageIndex pids pnames = assert (invariant index) index
-- If there are duplicates by 'InstalledPackageId' then later ones mask earlier
-- ones.
--
fromList :: [InstalledPackageInfo] -> PackageIndex
fromList :: PackageInstalled a => [a] -> PackageIndex a
fromList pkgs = mkPackageIndex pids pnames
where
pids = Map.fromList [ (installedPackageId pkg, pkg) | pkg <- pkgs ]
......@@ -190,7 +197,7 @@ fromList pkgs = mkPackageIndex pids pnames
-- result when we do a lookup by source 'PackageId'. This is the mechanism we
-- use to prefer user packages over global packages.
--
merge :: PackageIndex -> PackageIndex -> PackageIndex
merge :: PackageInstalled a => PackageIndex a -> PackageIndex a -> PackageIndex a
merge (PackageIndex pids1 pnames1) (PackageIndex pids2 pnames2) =
mkPackageIndex (Map.union pids1 pids2)
(Map.unionWith (Map.unionWith mergeBuckets) pnames1 pnames2)
......@@ -206,7 +213,7 @@ merge (PackageIndex pids1 pnames1) (PackageIndex pids2 pnames2) =
-- This is equivalent to (but slightly quicker than) using 'mappend' or
-- 'merge' with a singleton index.
--
insert :: InstalledPackageInfo -> PackageIndex -> PackageIndex
insert :: PackageInstalled a => a -> PackageIndex a -> PackageIndex a
insert pkg (PackageIndex pids pnames) =
mkPackageIndex pids' pnames'
......@@ -228,7 +235,7 @@ insert pkg (PackageIndex pids pnames) =
-- | Removes a single installed package from the index.
--
deleteInstalledPackageId :: InstalledPackageId -> PackageIndex -> PackageIndex
deleteInstalledPackageId :: PackageInstalled a => InstalledPackageId -> PackageIndex a -> PackageIndex a
deleteInstalledPackageId ipkgid original@(PackageIndex pids pnames) =
case Map.updateLookupWithKey (\_ _ -> Nothing) ipkgid pids of
(Nothing, _) -> original
......@@ -250,7 +257,7 @@ deleteInstalledPackageId ipkgid original@(PackageIndex pids pnames) =
-- | Removes all packages with this source 'PackageId' from the index.
--
deleteSourcePackageId :: PackageId -> PackageIndex -> PackageIndex
deleteSourcePackageId :: PackageInstalled a => PackageId -> PackageIndex a -> PackageIndex a
deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
case Map.lookup (packageName pkgid) pnames of
Nothing -> original
......@@ -270,7 +277,7 @@ deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
-- | Removes all packages with this (case-sensitive) name from the index.
--
deletePackageName :: PackageName -> PackageIndex -> PackageIndex
deletePackageName :: PackageInstalled a => PackageName -> PackageIndex a -> PackageIndex a
deletePackageName name original@(PackageIndex pids pnames) =
case Map.lookup name pnames of
Nothing -> original
......@@ -293,14 +300,14 @@ deleteDependency (Dependency name verstionRange) =
-- | Get all the packages from the index.
--
allPackages :: PackageIndex -> [InstalledPackageInfo]
allPackages :: PackageIndex a -> [a]
allPackages (PackageIndex pids _) = Map.elems pids
-- | Get all the packages from the index.
--
-- They are grouped by package name (case-sensitively).
--
allPackagesByName :: PackageIndex -> [(PackageName, [InstalledPackageInfo])]
allPackagesByName :: PackageIndex a -> [(PackageName, [a])]
allPackagesByName (PackageIndex _ pnames) =
[ (pkgname, concat (Map.elems pvers))
| (pkgname, pvers) <- Map.toList pnames ]
......@@ -309,7 +316,7 @@ allPackagesByName (PackageIndex _ pnames) =
--
-- They are grouped by source package id (package name and version).
--
allPackagesBySourcePackageId :: PackageIndex -> [(PackageId, [InstalledPackageInfo])]
allPackagesBySourcePackageId :: PackageInstalled a => PackageIndex a -> [(PackageId, [a])]
allPackagesBySourcePackageId (PackageIndex _ pnames) =
[ (packageId ipkg, ipkgs)
| pvers <- Map.elems pnames
......@@ -324,8 +331,8 @@ allPackagesBySourcePackageId (PackageIndex _ pnames) =
-- Since multiple package DBs mask each other by 'InstalledPackageId',
-- then we get back at most one package.
--
lookupInstalledPackageId :: PackageIndex -> InstalledPackageId
-> Maybe InstalledPackageInfo
lookupInstalledPackageId :: PackageInstalled a => PackageIndex a -> InstalledPackageId
-> Maybe a
lookupInstalledPackageId (PackageIndex pids _) pid = Map.lookup pid pids
......@@ -335,7 +342,7 @@ lookupInstalledPackageId (PackageIndex pids _) pid = Map.lookup pid pids
-- but different 'InstalledPackageId'. They are returned in order of
-- preference, with the most preferred first.
--
lookupSourcePackageId :: PackageIndex -> PackageId -> [InstalledPackageInfo]
lookupSourcePackageId :: PackageInstalled a => PackageIndex a -> PackageId -> [a]
lookupSourcePackageId (PackageIndex _ pnames) pkgid =
case Map.lookup (packageName pkgid) pnames of
Nothing -> []
......@@ -343,11 +350,18 @@ lookupSourcePackageId (PackageIndex _ pnames) pkgid =
Nothing -> []
Just pkgs -> pkgs -- in preference order
-- | Convenient alias of 'lookupSourcePackageId', but assuming only
-- one package per package ID.
lookupPackageId :: PackageInstalled a => PackageIndex a -> PackageId -> Maybe a
lookupPackageId index pkgid = case lookupSourcePackageId index pkgid of
[] -> Nothing
[pkg] -> Just pkg
_ -> error "Distribution.Simple.PackageIndex: multiple matches found"
-- | Does a lookup by source package name.
--
lookupPackageName :: PackageIndex -> PackageName
-> [(Version, [InstalledPackageInfo])]
lookupPackageName :: PackageInstalled a => PackageIndex a -> PackageName
-> [(Version, [a])]
lookupPackageName (PackageIndex _ pnames) name =
case Map.lookup name pnames of
Nothing -> []
......@@ -359,8 +373,8 @@ lookupPackageName (PackageIndex _ pnames) name =
-- We get back any number of versions of the specified package name, all
-- satisfying the version range constraint.
--
lookupDependency :: PackageIndex -> Dependency
-> [(Version, [InstalledPackageInfo])]
lookupDependency :: PackageInstalled a => PackageIndex a -> Dependency
-> [(Version, [a])]
lookupDependency (PackageIndex _ pnames) (Dependency name versionRange) =
case Map.lookup name pnames of
Nothing -> []
......@@ -384,7 +398,7 @@ lookupDependency (PackageIndex _ pnames) (Dependency name versionRange) =
-- packages. The list of ambiguous results is split by exact package name. So
-- it is a non-empty list of non-empty lists.
--
searchByName :: PackageIndex -> String -> SearchResult [InstalledPackageInfo]
searchByName :: PackageInstalled a => PackageIndex a -> String -> SearchResult [a]
searchByName (PackageIndex _ pnames) name =
case [ pkgs | pkgs@(PackageName name',_) <- Map.toList pnames
, lowercase name' == lname ] of
......@@ -401,7 +415,7 @@ data SearchResult a = None | Unambiguous a | Ambiguous [a]
--
-- That is, all packages that contain the given string in their name.
--
searchByNameSubstring :: PackageIndex -> String -> [InstalledPackageInfo]
searchByNameSubstring :: PackageInstalled a => PackageIndex a -> String -> [a]
searchByNameSubstring (PackageIndex _ pnames) searchterm =
[ pkg
| (PackageName name, pvers) <- Map.toList pnames
......@@ -425,11 +439,11 @@ searchByNameSubstring (PackageIndex _ pnames) searchterm =
-- list of groups of packages where within each group they all depend on each
-- other, directly or indirectly.
--
dependencyCycles :: PackageIndex -> [[InstalledPackageInfo]]
dependencyCycles :: PackageInstalled a => PackageIndex a -> [[a]]
dependencyCycles index =
[ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ]
where
adjacencyList = [ (pkg, installedPackageId pkg, IPI.depends pkg)
adjacencyList = [ (pkg, installedPackageId pkg, installedDepends pkg)
| pkg <- allPackages index ]
......@@ -437,11 +451,11 @@ dependencyCycles index =
--
-- Returns such packages along with the dependencies that they're missing.
--
brokenPackages :: PackageIndex -> [(InstalledPackageInfo, [InstalledPackageId])]
brokenPackages :: PackageInstalled a => PackageIndex a -> [(a, [InstalledPackageId])]
brokenPackages index =
[ (pkg, missing)
| pkg <- allPackages index
, let missing = [ pkg' | pkg' <- IPI.depends pkg
, let missing = [ pkg' | pkg' <- installedDepends pkg
, isNothing (lookupInstalledPackageId index pkg') ]
, not (null missing) ]
......@@ -454,10 +468,10 @@ brokenPackages index =
-- * Note that if the result is @Right []@ it is because at least one of
-- the original given 'PackageId's do not occur in the index.
--
dependencyClosure :: PackageIndex
dependencyClosure :: PackageInstalled a => PackageIndex a
-> [InstalledPackageId]
-> Either PackageIndex
[(InstalledPackageInfo, [InstalledPackageId])]
-> Either (PackageIndex a)
[(a, [InstalledPackageId])]
dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of
(completed, []) -> Left completed
(completed, _) -> Right (brokenPackages completed)
......@@ -469,15 +483,15 @@ dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of
Just _ -> closure completed failed pkgids
Nothing -> closure completed' failed pkgids'
where completed' = insert pkg completed
pkgids' = IPI.depends pkg ++ pkgids
pkgids' = installedDepends pkg ++ pkgids
-- | Takes the transitive closure of the packages reverse dependencies.
--
-- * The given 'PackageId's must be in the index.
--
reverseDependencyClosure :: PackageIndex
reverseDependencyClosure :: PackageInstalled a => PackageIndex a
-> [InstalledPackageId]
-> [InstalledPackageInfo]
-> [a]
reverseDependencyClosure index =
map vertexToPkg
. concatMap Tree.flatten
......@@ -489,13 +503,13 @@ reverseDependencyClosure index =
reverseDepGraph = Graph.transposeG depGraph
noSuchPkgId = error "reverseDependencyClosure: package is not in the graph"
topologicalOrder :: PackageIndex -> [InstalledPackageInfo]
topologicalOrder :: PackageInstalled a => PackageIndex a -> [a]
topologicalOrder index = map toPkgId
. Graph.topSort
$ graph
where (graph, toPkgId, _) = dependencyGraph index
reverseTopologicalOrder :: PackageIndex -> [InstalledPackageInfo]
reverseTopologicalOrder :: PackageInstalled a => PackageIndex a -> [a]
reverseTopologicalOrder index = map toPkgId
. Graph.topSort
. Graph.transposeG
......@@ -507,14 +521,14 @@ reverseTopologicalOrder index = map toPkgId
-- Dependencies on other packages that are not in the index are discarded.
-- You can check if there are any such dependencies with 'brokenPackages'.
--
dependencyGraph :: PackageIndex
dependencyGraph :: PackageInstalled a => PackageIndex a
-> (Graph.Graph,
Graph.Vertex -> InstalledPackageInfo,
Graph.Vertex -> a,
InstalledPackageId -> Maybe Graph.Vertex)
dependencyGraph index = (graph, vertex_to_pkg, id_to_vertex)
where
graph = Array.listArray bounds
[ [ v | Just v <- map id_to_vertex (IPI.depends pkg) ]
[ [ v | Just v <- map id_to_vertex (installedDepends pkg) ]
| pkg <- pkgs ]
pkgs = sortBy (comparing packageId) (allPackages index)
......@@ -538,7 +552,7 @@ dependencyGraph index = (graph, vertex_to_pkg, id_to_vertex)
-- depend on it and the versions they require. These are guaranteed to be
-- distinct.
--
dependencyInconsistencies :: PackageIndex
dependencyInconsistencies :: PackageInstalled a => PackageIndex a
-> [(PackageName, [(PackageId, Version)])]
dependencyInconsistencies index =
[ (name, [ (pid,packageVersion dep) | (dep,pids) <- uses, pid <- pids])
......@@ -550,30 +564,27 @@ dependencyInconsistencies index =
-- for each package with that name,
-- the InstalledPackageInfo and the package Ids of packages
-- that depend on it.
inverseIndex :: Map PackageName
(Map InstalledPackageId
(InstalledPackageInfo, [PackageId]))
inverseIndex = Map.fromListWith (Map.unionWith (\(a,b) (_,b') -> (a,b++b')))
[ (packageName dep,
Map.fromList [(ipid,(dep,[packageId pkg]))])
| pkg <- allPackages index
, ipid <- IPI.depends pkg
, ipid <- installedDepends pkg
, Just dep <- [lookupInstalledPackageId index ipid]
]