Commit 15f70a85 authored by Duncan Coutts's avatar Duncan Coutts

Rewrite the PackageIndex again

It's a unified index again, rather than one for looking up by an
InstalledPackageId and one for the source PackageId. The new one
lets you look up by either. It also maintains the order of
preference of different installed packages that share the same
source PackageId. In configure we just pick the first preference.
parent 6aa797b5
......@@ -391,13 +391,14 @@ configure (pkg_descr0, pbi) cfg
--TODO: sort out this need to keep converting package id types.
let installedPackageIndex =
PackageIndex.listToInstalledPackageIndex $
PackageIndex.fromList $
PackageIndex.allPackages packageSet
getInstalledPkg pkgid =
case PackageIndex.lookupPackageId packageSet pkgid of
Nothing -> error ("getInstalledPkgId: " ++ display pkgid)
Just ipi -> ipi
case PackageIndex.lookupSourcePackageId packageSet pkgid of
[ipi] -> ipi
_ -> error ("getInstalledPkgId: " ++ display pkgid)
allDepIPIs :: [InstalledPackageInfo]
allDepIPIs = map getInstalledPkg allPkgDeps
......@@ -425,7 +426,7 @@ configure (pkg_descr0, pbi) cfg
Installed.depends = map Installed.installedPackageId allDepIPIs
}
case PackageIndex.dependencyInconsistencies
. PackageIndex.addToInstalledPackageIndex pseudoTopPkg
. PackageIndex.insert pseudoTopPkg
$ packageDependsIndex of
[] -> return ()
inconsistencies ->
......@@ -581,8 +582,8 @@ 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 -- ^ Internally defined packages
-> PackageIndex InstalledPackageInfo -- ^ Installed packages
-> PackageIndex -- ^ Internally defined packages
-> PackageIndex -- ^ Installed packages
-> Dependency
-> IO PackageIdentifier
configDependency verbosity internalIndex installedIndex dep@(Dependency pkgname _) =
......@@ -607,7 +608,8 @@ configDependency verbosity internalIndex installedIndex dep@(Dependency pkgname
++ display (simplifyDependency dep) ++ "\n"
++ "Perhaps you need to download and install it from\n"
++ hackageUrl ++ display pkgname ++ "?"
pkgs -> do let pkgid = maximumBy (comparing packageVersion) (map packageId pkgs)
pkgs -> do let pkgid = packageId $ maximumBy (comparing packageVersion)
(concatMap snd pkgs)
info verbosity $ "Dependency "
++ display (simplifyDependency dep)
++ ": using " ++ display pkgid
......@@ -621,7 +623,7 @@ configDependency verbosity internalIndex installedIndex dep@(Dependency pkgname
getInstalledPackages :: Verbosity -> Compiler
-> PackageDBStack -> ProgramConfiguration
-> IO (Maybe (PackageIndex InstalledPackageInfo))
-> IO (Maybe PackageIndex)
getInstalledPackages verbosity comp packageDBs progconf = do
info verbosity "Reading installed packages..."
case compilerFlavor comp of
......
......@@ -344,7 +344,7 @@ oldLanguageExtensions =
fglasgowExts = "-fglasgow-exts"
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO (PackageIndex InstalledPackageInfo)
-> IO PackageIndex
getInstalledPackages verbosity packagedbs conf = do
pkgss <- getInstalledPackages' verbosity packagedbs conf
checkPackageDbStack packagedbs
......@@ -358,7 +358,7 @@ getInstalledPackages verbosity packagedbs conf = do
pkgs' = map (substTopDir topDir) pkgs
pi1 = PackageIndex.fromList pkgs'
rtsPackages = lookupPackageName pi1 (PackageName "rts")
rtsPackages' = map removeMingwIncludeDir rtsPackages
rtsPackages' = map removeMingwIncludeDir (concatMap snd rtsPackages)
pi2 = pi1 `merge` fromList rtsPackages'
return pi2
......
......@@ -420,7 +420,7 @@ haddockPackageFlags lbi htmlTemplate = do
if exists
then return (Right (interface, html))
else return (Left (packageId ipkg))
| ipkg <- PackageIndex.allInstalledPackages transitiveDeps ]
| ipkg <- PackageIndex.allPackages transitiveDeps ]
let missing = [ pkgid | Left pkgid <- interfaces ]
warning = "The documentation for the following packages are not "
......
......@@ -50,7 +50,7 @@ import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..), Executable(..)
, Library(..), libModules, hcOptions )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo, emptyInstalledPackageInfo )
( emptyInstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo_(sourcePackageId) )
import Distribution.Simple.PackageIndex (PackageIndex)
......@@ -114,7 +114,7 @@ jhcLanguageExtensions =
]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO (PackageIndex InstalledPackageInfo)
-> IO PackageIndex
getInstalledPackages verbosity packageDBs conf = do
case packageDBs of
[GlobalPackageDB] -> return ()
......
......@@ -231,7 +231,7 @@ getLanguageExtensions verbosity lhcProg = do
| Just ext <- map readExtension (lines exts) ]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO (PackageIndex InstalledPackageInfo)
-> IO PackageIndex
getInstalledPackages verbosity packagedbs conf = do
pkgss <- getInstalledPackages' verbosity packagedbs conf
checkPackageDbStack packagedbs
......@@ -245,7 +245,7 @@ getInstalledPackages verbosity packagedbs conf = do
pkgs' = map (substTopDir topDir) pkgs
pi1 = PackageIndex.fromList pkgs'
rtsPackages = lookupPackageName pi1 (PackageName "rts")
rtsPackages' = map removeMingwIncludeDir rtsPackages
rtsPackages' = map removeMingwIncludeDir (concatMap snd rtsPackages)
pi2 = pi1 `merge` fromList rtsPackages'
return pi2
......
......@@ -73,7 +73,7 @@ import Distribution.Package
import Distribution.Simple.Compiler
( Compiler(..), PackageDBStack, OptimisationLevel )
import Distribution.Simple.PackageIndex
( InstalledPackageIndex, lookupInstalledPackage )
( PackageIndex, lookupInstalledPackageId )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import Distribution.Simple.Utils
......@@ -95,7 +95,7 @@ data LocalBuildInfo = LocalBuildInfo {
-- ^ Where to put the result of the Hugs build.
libraryConfig :: Maybe ComponentLocalBuildInfo,
executableConfigs :: [(String, ComponentLocalBuildInfo)],
installedPkgs :: InstalledPackageIndex,
installedPkgs :: PackageIndex,
-- ^ All the info about all installed packages.
pkgDescrFile :: Maybe FilePath,
-- ^ the filename containing the .cabal file, if available
......@@ -138,7 +138,7 @@ componentPackageDeps lbi =
getLocalPackageInfo :: LocalBuildInfo -> InstalledPackageId
-> InstalledPackageInfo
getLocalPackageInfo lbi ipid@(InstalledPackageId s) =
case lookupInstalledPackage (installedPkgs lbi) ipid of
case lookupInstalledPackageId (installedPkgs lbi) ipid of
Nothing -> error ("getLocalPackageInfo: unknown InstalledPackageId: " ++ s)
Just ipi -> ipi
......
This diff is collapsed.
......@@ -411,9 +411,10 @@ ppHsc2hs bi lbi = standardPP lbi hsc2hsProgram $
-- OS X (it's ld is a tad stricter than gnu ld). Thus we remove the
-- ldOptions for GHC's rts package:
hackRtsPackage index =
case PackageIndex.lookupInstalledPackageByName index (PackageName "rts") of
[rts] -> PackageIndex.addToInstalledPackageIndex rts { Installed.ldOptions = [] } index
_ -> error "No (or multiple) ghc rts package is registered!!"
case PackageIndex.lookupPackageName index (PackageName "rts") of
[(_, [rts])]
-> PackageIndex.insert rts { Installed.ldOptions = [] } index
_ -> error "No (or multiple) ghc rts package is registered!!"
ppC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
......
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