Commit c6f2d793 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Convert from PackageIndex to PackageSet

Turns out the feature to do case-insensitive lookups was only
needed in cabal-install (and only in one little part) and
elsewhere it causes problems. So use PackageSet instead.
parent ef4acd0a
......@@ -64,8 +64,8 @@ import Distribution.PackageDescription
, Library(..), Executable(..), BuildInfo(..)
, Flag(..), FlagName(..), FlagAssignment
, CondTree(..), ConfVar(..), Condition(..) )
import Distribution.Simple.PackageIndex (PackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageSet (PackageSet)
import qualified Distribution.Simple.PackageSet as PackageSet
import Distribution.Version
( VersionRange(..), withinRange )
import Distribution.Compiler
......@@ -434,7 +434,7 @@ instance Monoid PDTagged where
finalizePackageDescription ::
Package pkg
=> FlagAssignment -- ^ Explicitly specified flag assignments
-> Maybe (PackageIndex pkg) -- ^ Available dependencies. Pass 'Nothing' if
-> Maybe (PackageSet pkg) -- ^ Available dependencies. Pass 'Nothing' if
-- this is unknown.
-> OS -- ^ OS-name
-> Arch -- ^ Arch-name
......@@ -487,15 +487,15 @@ finalizePackageDescription userflags mpkgs os arch impl constraints
-- if we don't know which packages are present, we just accept any
-- dependency
satisfyDep = maybe (const True)
(\pkgs -> not . null . PackageIndex.lookupDependency pkgs)
(\pkgs -> not . null . PackageSet.lookupDependency pkgs)
mpkgs
{-
let tst_p = (CondNode [1::Int] [Distribution.Package.Dependency "a" AnyVersion] [])
let tst_p2 = (CondNode [1::Int] [Distribution.Package.Dependency "a" (EarlierVersion (Version [1,0] [])), Distribution.Package.Dependency "a" (LaterVersion (Version [2,0] []))] [])
let p_index = Distribution.Simple.PackageIndex.fromList [Distribution.Package.PackageIdentifier "a" (Version [0,5] []), Distribution.Package.PackageIdentifier "a" (Version [2,5] [])]
let look = not . null . Distribution.Simple.PackageIndex.lookupDependency p_index
let p_index = Distribution.Simple.PackageSet.fromList [Distribution.Package.PackageIdentifier "a" (Version [0,5] []), Distribution.Package.PackageIdentifier "a" (Version [2,5] [])]
let look = not . null . Distribution.Simple.PackageSet.lookupDependency p_index
let looks ds = mconcat $ map (\d -> if look d then DepOk else MissingDeps [d]) ds
resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribution.Compiler.GHC,Version [6,8,2] []) [tst_p] looks ===> Right ...
resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribution.Compiler.GHC,Version [6,8,2] []) [tst_p2] looks ===> Left ...
......
......@@ -75,8 +75,8 @@ import Distribution.InstalledPackageInfo
( InstalledPackageInfo, emptyInstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo_(package,depends) )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (PackageIndex)
import qualified Distribution.Simple.PackageSet as PackageSet
import Distribution.Simple.PackageSet (PackageSet)
import Distribution.PackageDescription as PD
( PackageDescription(..), GenericPackageDescription(..)
, Library(..), hasLibs, Executable(..), BuildInfo(..)
......@@ -294,14 +294,14 @@ configure (pkg_descr0, pbi) cfg
flavor = compilerFlavor comp
-- FIXME: currently only GHC has hc-pkg
maybePackageIndex <- getInstalledPackages (lessVerbose verbosity) comp
maybePackageSet <- getInstalledPackages (lessVerbose verbosity) comp
packageDb programsConfig'
(pkg_descr0', flags) <- case pkg_descr0 of
Left ppd ->
case finalizePackageDescription
(configConfigurationsFlags cfg)
maybePackageIndex
maybePackageSet
Distribution.System.buildOS
Distribution.System.buildArch
(compilerId comp)
......@@ -327,7 +327,7 @@ configure (pkg_descr0, pbi) cfg
(either Just (\_->Nothing) pkg_descr0) --TODO: make the Either go away
(updatePackageDescription pbi pkg_descr)
let packageIndex = fromMaybe bogusPackageIndex maybePackageIndex
let packageSet = fromMaybe bogusPackageSet maybePackageSet
-- FIXME: For Hugs, nhc98 and other compilers we do not know what
-- packages are already installed, so we just make some up, pretend
-- that they do exist and just hope for the best. We make them up
......@@ -335,19 +335,19 @@ configure (pkg_descr0, pbi) cfg
-- happens to depend on. See 'inventBogusPackageId' below.
-- Let's hope they really are installed... :-)
bogusDependencies = map inventBogusPackageId (buildDepends pkg_descr)
bogusPackageIndex = PackageIndex.fromList
bogusPackageSet = PackageSet.fromList
[ emptyInstalledPackageInfo {
InstalledPackageInfo.package = bogusPackageId
-- note that these bogus packages have no other dependencies
}
| bogusPackageId <- bogusDependencies ]
dep_pkgs <- case flavor of
GHC -> mapM (configDependency verbosity packageIndex) (buildDepends pkg_descr)
JHC -> mapM (configDependency verbosity packageIndex) (buildDepends pkg_descr)
GHC -> mapM (configDependency verbosity packageSet) (buildDepends pkg_descr)
JHC -> mapM (configDependency verbosity packageSet) (buildDepends pkg_descr)
_ -> return bogusDependencies
packageDependsIndex <-
case PackageIndex.dependencyClosure packageIndex dep_pkgs of
case PackageSet.dependencyClosure packageSet dep_pkgs of
Left packageDependsIndex -> return packageDependsIndex
Right broken ->
die $ "The following installed packages are broken because other"
......@@ -363,8 +363,8 @@ configure (pkg_descr0, pbi) cfg
InstalledPackageInfo.package = packageId pkg_descr,
InstalledPackageInfo.depends = dep_pkgs
}
case PackageIndex.dependencyInconsistencies
. PackageIndex.insert pseudoTopPkg
case PackageSet.dependencyInconsistencies
. PackageSet.insert pseudoTopPkg
$ packageDependsIndex of
[] -> return ()
inconsistencies ->
......@@ -500,9 +500,9 @@ hackageUrl :: String
hackageUrl = "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/"
-- | Test for a package dependency and record the version we have installed.
configDependency :: Verbosity -> PackageIndex InstalledPackageInfo -> Dependency -> IO PackageIdentifier
configDependency :: Verbosity -> PackageSet InstalledPackageInfo -> Dependency -> IO PackageIdentifier
configDependency verbosity index dep@(Dependency pkgname _) =
case PackageIndex.lookupDependency index dep of
case PackageSet.lookupDependency index dep of
[] -> die $ "cannot satisfy dependency "
++ display dep ++ "\n"
++ "Perhaps you need to download and install it from\n"
......@@ -513,7 +513,7 @@ configDependency verbosity index dep@(Dependency pkgname _) =
return pkgid
getInstalledPackages :: Verbosity -> Compiler -> PackageDB -> ProgramConfiguration
-> IO (Maybe (PackageIndex InstalledPackageInfo))
-> IO (Maybe (PackageSet InstalledPackageInfo))
getInstalledPackages verbosity comp packageDb progconf = do
info verbosity "Reading installed packages..."
case compilerFlavor comp of
......
......@@ -82,8 +82,8 @@ import Distribution.PackageDescription
import Distribution.InstalledPackageInfo
( InstalledPackageInfo
, parseInstalledPackageInfo )
import Distribution.Simple.PackageIndex (PackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageSet (PackageSet)
import qualified Distribution.Simple.PackageSet as PackageSet
import Distribution.ParseUtils ( ParseResult(..) )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), InstallDirs(..) )
......@@ -291,13 +291,13 @@ oldLanguageExtensions =
fglasgowExts = "-fglasgow-exts"
getInstalledPackages :: Verbosity -> PackageDB -> ProgramConfiguration
-> IO (PackageIndex InstalledPackageInfo)
-> IO (PackageSet InstalledPackageInfo)
getInstalledPackages verbosity packagedb conf = do
let packagedbs = case packagedb of
GlobalPackageDB -> [GlobalPackageDB]
_ -> [GlobalPackageDB, packagedb]
pkgss <- getInstalledPackages' verbosity packagedbs conf
return $ mconcat [ PackageIndex.fromList pkgs
return $ mconcat [ PackageSet.fromList pkgs
| (_, pkgs) <- pkgss ]
-- | Get the packages from specific PackageDBs, not cumulative.
......
......@@ -77,7 +77,7 @@ import Distribution.Simple.InstallDirs (InstallDirs(..), PathTemplate,
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
import Distribution.Simple.BuildPaths ( haddockPref, haddockName,
hscolourPref, autogenModulesDir )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import qualified Distribution.Simple.PackageSet as PackageSet
( lookupPackageId )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo_(..) )
......@@ -330,7 +330,7 @@ haddockPackageFlags lbi htmlTemplate = do
where
interfaceAndHtmlPath :: PackageIdentifier -> Maybe (FilePath, FilePath)
interfaceAndHtmlPath pkgId = do
pkg <- PackageIndex.lookupPackageId (installedPkgs lbi) pkgId
pkg <- PackageSet.lookupPackageId (installedPkgs lbi) pkgId
interface <- listToMaybe (InstalledPackageInfo.haddockInterfaces pkg)
html <- case htmlTemplate of
Nothing -> listToMaybe (InstalledPackageInfo.haddockHTMLs pkg)
......
......@@ -53,8 +53,8 @@ import Distribution.InstalledPackageInfo
( InstalledPackageInfo, emptyInstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo_(package) )
import Distribution.Simple.PackageIndex (PackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageSet (PackageSet)
import qualified Distribution.Simple.PackageSet as PackageSet
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..) )
import Distribution.Simple.BuildPaths
......@@ -112,11 +112,11 @@ jhcLanguageExtensions =
]
getInstalledPackages :: Verbosity -> PackageDB -> ProgramConfiguration
-> IO (PackageIndex InstalledPackageInfo)
-> IO (PackageSet InstalledPackageInfo)
getInstalledPackages verbosity _packagedb conf = do
str <- rawSystemProgramStdoutConf verbosity jhcProgram conf ["--list-libraries"]
case pCheck (readP_to_S (many (skipSpaces >> parse)) str) of
[ps] -> return $ PackageIndex.fromList
[ps] -> return $ PackageSet.fromList
[ emptyInstalledPackageInfo {
InstalledPackageInfo.package = p
}
......
......@@ -63,7 +63,7 @@ import Distribution.PackageDescription (PackageDescription(..))
import Distribution.Package (PackageIdentifier, Package(..))
import Distribution.Simple.Compiler
( Compiler(..), PackageDB, OptimisationLevel )
import Distribution.Simple.PackageIndex (PackageIndex)
import Distribution.Simple.PackageSet (PackageSet)
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
-- |Data cached after configuration step. See also
......@@ -85,7 +85,7 @@ data LocalBuildInfo = LocalBuildInfo {
-- that must be satisfied in terms of version ranges. This
-- field fixes those dependencies to the specific versions
-- available on this machine for this compiler.
installedPkgs :: PackageIndex InstalledPackageInfo,
installedPkgs :: PackageSet InstalledPackageInfo,
-- ^ All the info about all installed packages.
pkgDescrFile :: Maybe FilePath,
-- ^ the filename containing the .cabal file, if available
......
......@@ -45,34 +45,20 @@ module Distribution.Simple.PackageIndex (
-- ** Bulk queries
allPackages,
allPackagesByName,
-- ** Special queries
brokenPackages,
dependencyClosure,
reverseDependencyClosure,
dependencyInconsistencies,
dependencyCycles,
dependencyGraph,
) where
import Prelude hiding (lookup)
import Control.Exception (assert)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Tree as Tree
import qualified Data.Graph as Graph
import qualified Data.Array as Array
import Data.Array ((!))
import Data.List (groupBy, sortBy, find)
import Data.Monoid (Monoid(..))
import Data.Maybe (isNothing, fromMaybe)
import Distribution.Package
( PackageName(PackageName), PackageIdentifier, Package(..)
, packageName, packageVersion
, Dependency(Dependency), PackageFixedDeps(..) )
, packageName, packageVersion, Dependency(Dependency) )
import Distribution.Version
( Version, withinRange )
( withinRange )
import Distribution.Simple.Utils (lowercase, equating, comparing, isInfixOf)
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 606)
......@@ -338,139 +324,3 @@ lookupDependency index (Dependency name versionRange) =
[ pkg | pkg <- lookup index (packageNameKey name)
, packageName pkg == name
, packageVersion pkg `withinRange` versionRange ]
-- | All packages that have dependencies that are not in the index.
--
-- Returns such packages along with the dependencies that they're missing.
--
brokenPackages :: PackageFixedDeps pkg
=> PackageIndex pkg
-> [(pkg, [PackageIdentifier])]
brokenPackages index =
[ (pkg, missing)
| pkg <- allPackages index
, let missing = [ pkg' | pkg' <- depends pkg
, isNothing (lookupPackageId index pkg') ]
, not (null missing) ]
-- | Tries to take the transative closure of the package dependencies.
--
-- If the transative closure is complete then it returns that subset of the
-- index. Otherwise it returns the broken packages as in 'brokenPackages'.
--
-- * Note that if the result is @Right []@ it is because at least one of
-- the original given 'PackageIdentifier's do not occur in the index.
--
dependencyClosure :: PackageFixedDeps pkg
=> PackageIndex pkg
-> [PackageIdentifier]
-> Either (PackageIndex pkg)
[(pkg, [PackageIdentifier])]
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 lookupPackageId index pkgid of
Nothing -> closure completed (pkgid:failed) pkgids
Just pkg -> case lookupPackageId completed (packageId pkg) of
Just _ -> closure completed failed pkgids
Nothing -> closure completed' failed pkgids'
where completed' = insert pkg completed
pkgids' = depends pkg ++ pkgids
-- | Takes the transative closure of the packages reverse dependencies.
--
-- * The given 'PackageIdentifier's must be in the index.
--
reverseDependencyClosure :: PackageFixedDeps pkg
=> PackageIndex pkg
-> [PackageIdentifier]
-> [PackageIdentifier]
reverseDependencyClosure index =
map vertexToPkgId
. concatMap Tree.flatten
. Graph.dfs reverseDepGraph
. map (fromMaybe noSuchPkgId . pkgIdToVertex)
where
(depGraph, vertexToPkgId, pkgIdToVertex) = dependencyGraph index
reverseDepGraph = Graph.transposeG depGraph
noSuchPkgId = error "reverseDependencyClosure: package is not in the graph"
-- | Given a package index where we assume we want to use all the packages
-- (use 'dependencyClosure' if you need to get such a index subset) find out
-- if the dependencies within it use consistent versions of each package.
-- Return all cases where multiple packages depend on different versions of
-- some other package.
--
-- Each element in the result is a package name along with the packages that
-- depend on it and the versions they require. These are guaranteed to be
-- distinct.
--
dependencyInconsistencies :: PackageFixedDeps pkg
=> PackageIndex pkg
-> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies index =
[ (name, inconsistencies)
| (name, uses) <- Map.toList inverseIndex
, let inconsistencies = duplicatesBy uses
, not (null inconsistencies) ]
where inverseIndex = Map.fromListWith (++)
[ (packageName dep, [(packageId pkg, packageVersion dep)])
| pkg <- allPackages index
, dep <- depends pkg ]
duplicatesBy = (\groups -> if length groups == 1
then []
else concat groups)
. groupBy (equating snd)
. sortBy (comparing snd)
-- | Find if there are any cycles in the dependency graph. If there are no
-- cycles the result is @[]@.
--
-- This actually computes the strongly connected components. So it gives us a
-- list of groups of packages where within each group they all depend on each
-- other, directly or indirectly.
--
dependencyCycles :: PackageFixedDeps pkg
=> PackageIndex pkg
-> [[pkg]]
dependencyCycles index =
[ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ]
where
adjacencyList = [ (pkg, packageId pkg, depends pkg)
| pkg <- allPackages index ]
-- | Builds a graph of the package dependencies.
--
-- Dependencies on other packages that are in the index are discarded.
-- You can check if there are any such dependencies with 'brokenPackages'.
--
dependencyGraph :: PackageFixedDeps pkg
=> PackageIndex pkg
-> (Graph.Graph,
Graph.Vertex -> PackageIdentifier,
PackageIdentifier -> Maybe Graph.Vertex)
dependencyGraph index = (graph, vertexToPkgId, pkgIdToVertex)
where
graph = Array.listArray bounds
[ [ v | Just v <- map pkgIdToVertex (depends pkg) ]
| pkg <- pkgs ]
vertexToPkgId vertex = pkgIdTable ! vertex
pkgIdToVertex = binarySearch 0 topBound
pkgIdTable = Array.listArray bounds (map packageId pkgs)
pkgs = sortBy (comparing packageId) (allPackages index)
topBound = length pkgs - 1
bounds = (0, topBound)
binarySearch a b key
| a > b = Nothing
| otherwise = case compare key (pkgIdTable ! mid) of
LT -> binarySearch a (mid-1) key
EQ -> Just mid
GT -> binarySearch (mid+1) b key
where mid = (a + b) `div` 2
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