Commit 5584569c 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
store. Note that we still have to create the package db in the store.

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 f3fc6504
......@@ -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
......@@ -606,22 +605,23 @@ rebuildInstallPlan verbosity
liftIO $ debug verbosity "Improving the install plan..."
recreateDirectory verbosity True storeDirectory
storePkgIndex <- getPackageDBContents verbosity
compiler progdb platform
storePackageDb
storeExeIndex <- getExecutableDBContents storeDirectory
liftIO $ createPackageDBIfMissing verbosity
compiler progdb
storePackageDb
storePkgIdSet <- getInstalledStorePackages storeDirectory
let improvedPlan = improveInstallPlanWithInstalledPackages
storePkgIndex
storeExeIndex
storePkgIdSet
elaboratedPlan
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
where
storeDirectory = cabalStoreDirectory (compilerId compiler)
storePackageDb = cabalStorePackageDB (compilerId compiler)
ElaboratedSharedConfig {
pkgConfigPlatform = platform,
pkgConfigCompiler = compiler,
pkgConfigCompilerProgs = progdb
} = elaboratedShared
......@@ -658,6 +658,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
......@@ -671,20 +673,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
getExecutableDBContents
:: FilePath -- store directory
-> Rebuild (Set ComponentId)
getExecutableDBContents storeDirectory = do
monitorFiles [monitorFileGlob (FilePathGlob (FilePathRoot storeDirectory) (GlobFile [WildCard]))]
paths <- liftIO $ getDirectoryContents storeDirectory
return (Set.fromList (map ComponentId (filter valid paths)))
-- | 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 [ SimpleUnitId (ComponentId path)
| path <- paths, valid path ]
where
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
......@@ -730,6 +733,11 @@ getPkgConfigDb verbosity progdb = do
liftIO $ readPkgConfigDb verbosity progdb
getDirectoryContentsMonitored :: FilePath -> Rebuild [FilePath]
getDirectoryContentsMonitored dir = do
monitorFiles [monitorDirectory dir]
liftIO $ getDirectoryContents dir
recreateDirectory :: Verbosity -> Bool -> FilePath -> Rebuild ()
recreateDirectory verbosity createParents dir = do
liftIO $ createDirectoryIfMissingVerbose verbosity createParents dir
......@@ -2712,11 +2720,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
......@@ -2731,14 +2738,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
......
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