Commit 351c1306 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Create inplace database upon configuration.



This will help us when we implement 'build --assume-deps-up-to-date":
after configuration, we will assume that there is some (consistent)
inplace database.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent ddf84bbd
...@@ -458,18 +458,6 @@ benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f } ...@@ -458,18 +458,6 @@ benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f }
} }
benchmarkExeV10asExe Benchmark{} _ = error "benchmarkExeV10asExe: wrong kind" benchmarkExeV10asExe Benchmark{} _ = error "benchmarkExeV10asExe: wrong kind"
-- | Initialize a new package db file for libraries defined
-- internally to the package.
createInternalPackageDB :: Verbosity -> LocalBuildInfo -> FilePath
-> IO PackageDB
createInternalPackageDB verbosity lbi distPref = do
existsAlready <- doesPackageDBExist dbPath
when existsAlready $ deletePackageDB dbPath
createPackageDB verbosity (compiler lbi) (withPrograms lbi) False dbPath
return (SpecificPackageDB dbPath)
where
dbPath = internalPackageDBPath lbi distPref
addInternalBuildTools :: PackageDescription -> LocalBuildInfo -> BuildInfo addInternalBuildTools :: PackageDescription -> LocalBuildInfo -> BuildInfo
-> ProgramDb -> ProgramDb -> ProgramDb -> ProgramDb
addInternalBuildTools pkg lbi bi progs = addInternalBuildTools pkg lbi bi progs =
......
...@@ -73,6 +73,7 @@ import Distribution.Simple.Setup as Setup ...@@ -73,6 +73,7 @@ import Distribution.Simple.Setup as Setup
import qualified Distribution.Simple.InstallDirs as InstallDirs import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.LocalBuildInfo import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils import Distribution.Simple.Utils
import Distribution.Simple.Register (createInternalPackageDB)
import Distribution.System import Distribution.System
import Distribution.Version import Distribution.Version
import Distribution.Verbosity import Distribution.Verbosity
...@@ -332,10 +333,12 @@ configure (pkg_descr0', pbi) cfg = do ...@@ -332,10 +333,12 @@ configure (pkg_descr0', pbi) cfg = do
checkExactConfiguration pkg_descr0 cfg checkExactConfiguration pkg_descr0 cfg
-- Where to build the package -- Where to build the package
let buildDir :: FilePath -- e.g. dist/build let distPref :: FilePath -- e.g. dist
distPref = fromFlag (configDistPref cfg)
buildDir :: FilePath -- e.g. dist/build
-- fromFlag OK due to Distribution.Simple calling -- fromFlag OK due to Distribution.Simple calling
-- findDistPrefOrDefault to fill it in -- findDistPrefOrDefault to fill it in
buildDir = fromFlag (configDistPref cfg) </> "build" buildDir = distPref </> "build"
createDirectoryIfMissingVerbose (lessVerbose verbosity) True buildDir createDirectoryIfMissingVerbose (lessVerbose verbosity) True buildDir
-- What package database(s) to use -- What package database(s) to use
...@@ -697,6 +700,9 @@ configure (pkg_descr0', pbi) cfg = do ...@@ -697,6 +700,9 @@ configure (pkg_descr0', pbi) cfg = do
relocatable = reloc relocatable = reloc
} }
-- Create the internal package database
_ <- createInternalPackageDB verbosity lbi distPref
when reloc (checkRelocatable verbosity pkg_descr lbi) when reloc (checkRelocatable verbosity pkg_descr lbi)
-- TODO: This is not entirely correct, because the dirs may vary -- TODO: This is not entirely correct, because the dirs may vary
......
...@@ -29,6 +29,7 @@ module Distribution.Simple.Register ( ...@@ -29,6 +29,7 @@ module Distribution.Simple.Register (
unregister, unregister,
internalPackageDBPath, internalPackageDBPath,
createInternalPackageDB,
initPackageDB, initPackageDB,
doesPackageDBExist, doesPackageDBExist,
...@@ -516,3 +517,15 @@ internalPackageDBPath lbi distPref = ...@@ -516,3 +517,15 @@ internalPackageDBPath lbi distPref =
case compilerFlavor (compiler lbi) of case compilerFlavor (compiler lbi) of
UHC -> UHC.inplacePackageDbPath lbi UHC -> UHC.inplacePackageDbPath lbi
_ -> distPref </> "package.conf.inplace" _ -> distPref </> "package.conf.inplace"
-- | Initialize a new package db file for libraries defined
-- internally to the package.
createInternalPackageDB :: Verbosity -> LocalBuildInfo -> FilePath
-> IO PackageDB
createInternalPackageDB verbosity lbi distPref = do
existsAlready <- doesPackageDBExist dbPath
when existsAlready $ deletePackageDB dbPath
createPackageDB verbosity (compiler lbi) (withPrograms lbi) False dbPath
return (SpecificPackageDB dbPath)
where
dbPath = internalPackageDBPath lbi distPref
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