Commit 045c7c9a authored by Duncan Coutts's avatar Duncan Coutts

Refactor: split StoreDirLayout out of CabalDirLayout

So we have a spec of the layout of the store, independent of the
instance of the store within ~/.cabal/store. This will make new store
handling code cleaner by not entangling it with other global ~/.cabal
things.

We may also in future want to allow global and per-user stores, and we
certainly want the ability to specify a store location outside of
~/.cabal (though this could be done with the existing code too).
parent c1562d55
......@@ -6,12 +6,16 @@
-- and build artifacts.
--
module Distribution.Client.DistDirLayout (
-- 'DistDirLayout'
-- * 'DistDirLayout'
DistDirLayout(..),
DistDirParams(..),
defaultDistDirLayout,
ProjectRoot(..),
-- * 'StoreDirLayout'
StoreDirLayout(..),
defaultStoreDirLayout,
-- * 'CabalDirLayout'
CabalDirLayout(..),
defaultCabalDirLayout,
......@@ -23,12 +27,12 @@ import System.FilePath
import Distribution.Package
( PackageId, ComponentId, UnitId )
import Distribution.Compiler
import Distribution.Simple.Compiler (PackageDB(..), OptimisationLevel(..))
import Distribution.Simple.Compiler
( PackageDB(..), PackageDBStack, OptimisationLevel(..) )
import Distribution.Text
import Distribution.Types.ComponentName
import Distribution.System
import Distribution.Client.Types
( InstalledPackageId )
-- | Information which can be used to construct the path to
-- the build directory of a build. This is LESS fine-grained
......@@ -107,14 +111,28 @@ data DistDirLayout = DistDirLayout {
}
-- | The layout of a cabal nix-style store.
--
data StoreDirLayout = StoreDirLayout {
storeDirectory :: CompilerId -> FilePath,
storePackageDirectory :: CompilerId -> UnitId -> FilePath,
storePackageDBPath :: CompilerId -> FilePath,
storePackageDB :: CompilerId -> PackageDB,
storePackageDBStack :: CompilerId -> PackageDBStack
}
--TODO: move to another module, e.g. CabalDirLayout?
-- or perhaps rename this module to DirLayouts.
-- | The layout of the user-wide cabal directory, that is the @~/.cabal@ dir
-- on unix, and equivalents on other systems.
--
-- At the moment this is just a partial specification, but the idea is
-- eventually to cover it all.
--
data CabalDirLayout = CabalDirLayout {
cabalStoreDirectory :: CompilerId -> FilePath,
cabalStorePackageDirectory :: CompilerId -> InstalledPackageId
-> FilePath,
cabalStorePackageDBPath :: CompilerId -> FilePath,
cabalStorePackageDB :: CompilerId -> PackageDB,
cabalStoreDirLayout :: StoreDirLayout,
cabalLogsDirectory :: FilePath,
cabalWorldFile :: FilePath
......@@ -195,23 +213,32 @@ defaultDistDirLayout projectRoot mdistDirectory =
distPackageDB = SpecificPackageDB . distPackageDBPath
defaultStoreDirLayout :: FilePath -> StoreDirLayout
defaultStoreDirLayout storeRoot =
StoreDirLayout {..}
where
storeDirectory compid =
storeRoot </> display compid
storePackageDirectory compid ipkgid =
storeDirectory compid </> display ipkgid
storePackageDBPath compid =
storeDirectory compid </> "package.db"
storePackageDB compid =
SpecificPackageDB (storePackageDBPath compid)
storePackageDBStack compid =
[GlobalPackageDB, storePackageDB compid]
defaultCabalDirLayout :: FilePath -> CabalDirLayout
defaultCabalDirLayout cabalDir =
CabalDirLayout {..}
where
cabalStoreDirectory compid =
cabalDir </> "store" </> display compid
cabalStorePackageDirectory compid ipkgid =
cabalStoreDirectory compid </> display ipkgid
cabalStorePackageDBPath compid =
cabalStoreDirectory compid </> "package.db"
cabalStorePackageDB =
SpecificPackageDB . cabalStorePackageDBPath
cabalStoreDirLayout = defaultStoreDirLayout (cabalDir </> "store")
cabalLogsDirectory = cabalDir </> "logs"
......
......@@ -361,9 +361,8 @@ rebuildInstallPlan verbosity
distProjectRootDirectory,
distProjectCacheFile
}
cabalDirLayout@CabalDirLayout {
cabalStoreDirectory,
cabalStorePackageDB
CabalDirLayout {
cabalStoreDirLayout
} = \projectConfig localPackages ->
runRebuild distProjectRootDirectory $ do
progsearchpath <- liftIO $ getSystemSearchPath
......@@ -600,7 +599,7 @@ rebuildInstallPlan verbosity
verbosity
platform compiler progdb pkgConfigDB
distDirLayout
cabalDirLayout
cabalStoreDirLayout
solverPlan
localPackages
sourcePackageHashes
......@@ -647,11 +646,11 @@ rebuildInstallPlan verbosity
phaseImprovePlan elaboratedPlan elaboratedShared = do
liftIO $ debug verbosity "Improving the install plan..."
createDirectoryMonitored True storeDirectory
createDirectoryMonitored True (storeDirectory compid)
liftIO $ createPackageDBIfMissing verbosity
compiler progdb
storePackageDb
storePkgIdSet <- getInstalledStorePackages storeDirectory
(storePackageDB compid)
storePkgIdSet <- getInstalledStorePackages (storeDirectory compid)
let improvedPlan = improveInstallPlanWithInstalledPackages
storePkgIdSet
elaboratedPlan
......@@ -662,8 +661,8 @@ rebuildInstallPlan verbosity
-- matches up as expected, e.g. no dangling deps, files deleted.
return improvedPlan
where
storeDirectory = cabalStoreDirectory (compilerId compiler)
storePackageDb = cabalStorePackageDB (compilerId compiler)
StoreDirLayout{storeDirectory, storePackageDB} = cabalStoreDirLayout
compid = compilerId (pkgConfigCompiler elaboratedShared)
ElaboratedSharedConfig {
pkgConfigCompiler = compiler,
pkgConfigCompilerProgs = progdb
......@@ -1162,7 +1161,7 @@ planPackages verbosity comp platform solver SolverSettings{..}
elaborateInstallPlan
:: Verbosity -> Platform -> Compiler -> ProgramDb -> PkgConfigDb
-> DistDirLayout
-> CabalDirLayout
-> StoreDirLayout
-> SolverInstallPlan
-> [SourcePackage loc]
-> Map PackageId PackageSourceHash
......@@ -1173,7 +1172,7 @@ elaborateInstallPlan
-> LogProgress (ElaboratedInstallPlan, ElaboratedSharedConfig)
elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
DistDirLayout{..}
cabalDirLayout@CabalDirLayout{cabalStorePackageDB}
storeDirLayout@StoreDirLayout{storePackageDBStack}
solverPlan localPackages
sourcePackageHashes
defaultInstallDirs
......@@ -1468,7 +1467,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
| otherwise
-- use special simplified install dirs
= storePackageInstallDirs
cabalDirLayout
storeDirLayout
(compilerId compiler)
cid
......@@ -1602,7 +1601,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
| otherwise
-- use special simplified install dirs
= storePackageInstallDirs
cabalDirLayout
storeDirLayout
(compilerId compiler)
pkgInstalledId
......@@ -1780,8 +1779,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
inplacePackageDbs = storePackageDbs
++ [ distPackageDB (compilerId compiler) ]
storePackageDbs = [ GlobalPackageDB
, cabalStorePackageDB (compilerId compiler) ]
storePackageDbs = storePackageDBStack (compilerId compiler)
-- For this local build policy, every package that lives in a local source
-- dir (as opposed to a tarball), or depends on such a package, will be
......@@ -2933,15 +2931,15 @@ userInstallDirTemplates compiler = do
True -- user install
False -- unused
storePackageInstallDirs :: CabalDirLayout
storePackageInstallDirs :: StoreDirLayout
-> CompilerId
-> InstalledPackageId
-> InstallDirs.InstallDirs FilePath
storePackageInstallDirs CabalDirLayout{cabalStorePackageDirectory}
storePackageInstallDirs StoreDirLayout{storePackageDirectory}
compid ipkgid =
InstallDirs.InstallDirs {..}
where
prefix = cabalStorePackageDirectory compid ipkgid
prefix = storePackageDirectory compid (newSimpleUnitId ipkgid)
bindir = prefix </> "bin"
libdir = prefix </> "lib"
libsubdir = ""
......
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