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

Simplify plan improvement, avoid reading store ghc-pkg db

Install plan improvement is the process of replacing configured source
packages with installed instances from the store. Originally we did this
by reading the ghc-pkg db to get the InstalledPackageInfo for all the
packages in the store. We had to do that because when we replaced
configured source packages by installed instances we used the
PreExisting constructor which requires an InstalledPackageInfo, which we
get from the installed package db. But now that we no longer use
PreExisting for packages from the store we also no longer need the
InstalledPackageInfo. All we need is a set of UnitIds. Also, once
support for depending on executables was added then we needed a way to
do plan improvement for executable packages/components. We did this by
the simple approach of grabbing the dir listing for the store and using
that as a set of UnitIds.

So this patch extends the approach we use for executables and uses it
for all packages. This means we no longer load the package db for the

Note that still need to create the package db in the store. Previously
we would create it when getting the package db contents, but we don't
do that any more, but we still need to make sure the db exists.

This also relates to the locking protocol in the store. The goal for the
store is to be able to access and update it concurrently. The locking
protocol will include checking membership by checking if the directory
entry for the package is present. So this patch gets us to the right
point for the reading side, leaving the writing side to do.
parent 81691044
......@@ -91,7 +91,6 @@ import qualified Distribution.PackageDescription as Cabal
import qualified Distribution.PackageDescription as PD
import qualified Distribution.PackageDescription.Configuration as PD
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Compiler hiding (Flag)
import qualified Distribution.Simple.GHC as GHC --TODO: [code cleanup] eliminate
import qualified Distribution.Simple.GHCJS as GHCJS --TODO: [code cleanup] eliminate
......@@ -605,22 +604,23 @@ rebuildInstallPlan verbosity
liftIO $ debug verbosity "Improving the install plan..."
createDirectoryMonitored True storeDirectory
storePkgIndex <- getPackageDBContents verbosity
compiler progdb platform
storeExeIndex <- getExecutableDBContents storeDirectory
liftIO $ createPackageDBIfMissing verbosity
compiler progdb
storePkgIdSet <- getInstalledStorePackages storeDirectory
let improvedPlan = improveInstallPlanWithInstalledPackages
liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan improvedPlan)
-- TODO: [nice to have] having checked which packages from the store
-- we're using, it may be sensible to sanity check those packages
-- by loading up the compiler package db and checking everything
-- matches up as expected, e.g. no dangling deps, files deleted.
return improvedPlan
storeDirectory = cabalStoreDirectory (compilerId compiler)
storePackageDb = cabalStorePackageDB (compilerId compiler)
ElaboratedSharedConfig {
pkgConfigPlatform = platform,
pkgConfigCompiler = compiler,
pkgConfigCompilerProgs = progdb
} = elaboratedShared
......@@ -657,6 +657,8 @@ getInstalledPackages verbosity compiler progdb platform packagedbs = do
verbosity compiler
packagedbs progdb
--TODO: [nice to have] use this but for sanity / consistency checking
getPackageDBContents :: Verbosity
-> Compiler -> ProgramDb -> Platform
-> PackageDB
......@@ -670,19 +672,21 @@ getPackageDBContents verbosity compiler progdb platform packagedb = do
createPackageDBIfMissing verbosity compiler progdb packagedb
Cabal.getPackageDBContents verbosity compiler
packagedb progdb
-- | Return the list of all already installed executables
:: FilePath -- store directory
-> Rebuild (Set ComponentId)
getExecutableDBContents storeDirectory = do
-- | Return the 'UnitId's of all packages\/components already installed in the
-- store.
getInstalledStorePackages :: FilePath -- ^ store directory
-> Rebuild (Set UnitId)
getInstalledStorePackages storeDirectory = do
paths <- getDirectoryContentsMonitored storeDirectory
return (Set.fromList (map ComponentId (filter valid paths)))
return $ Set.fromList [ SimpleUnitId (ComponentId path)
| path <- paths, valid path ]
valid "." = False
valid ".." = False
valid ('.':_) = False
valid "package.db" = False
valid _ = True
valid _ = True
getSourcePackages :: Verbosity -> (forall a. (RepoContext -> IO a) -> IO a)
-> Rebuild SourcePackageDb
......@@ -2698,11 +2702,10 @@ packageHashConfigInputs
-- 'ElaboratedInstallPlan', replace configured source packages by installed
-- packages from the store whenever they exist.
improveInstallPlanWithInstalledPackages :: InstalledPackageIndex
-> Set ComponentId
improveInstallPlanWithInstalledPackages :: Set UnitId
-> ElaboratedInstallPlan
-> ElaboratedInstallPlan
improveInstallPlanWithInstalledPackages installedPkgIndex installedExes installPlan =
improveInstallPlanWithInstalledPackages installedPkgIdSet installPlan =
replaceWithInstalled installPlan
[ installedUnitId pkg
| InstallPlan.Configured pkg
......@@ -2717,14 +2720,7 @@ improveInstallPlanWithInstalledPackages installedPkgIndex installedExes installP
-- since overwriting is never safe.
canPackageBeImproved pkg =
case PackageIndex.lookupUnitId
installedPkgIndex (installedUnitId pkg) of
Just _ -> True
Nothing | SimpleUnitId cid <- installedUnitId pkg
, cid `Set.member` installedExes
-- Same hack as replacewithPrePreExisting
-> True
| otherwise -> False
installedUnitId pkg `Set.member` installedPkgIdSet
replaceWithInstalled :: ElaboratedInstallPlan -> [UnitId]
-> ElaboratedInstallPlan
Supports Markdown
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