Commit 3e37d735 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Simplify package database directory tracking

parent 2d60196c
......@@ -35,7 +35,6 @@ executable hadrian
, Oracles.LookupInPath
, Oracles.ModuleFiles
, Oracles.PackageData
, Oracles.PackageDatabase
, Oracles.WindowsPath
, Package
, Predicate
......
module Oracles.PackageDatabase (packageDatabaseOracle) where
import qualified System.Directory as IO
import Base
import Context
import Builder
import GHC
import Rules.Actions
import Settings.Builders.GhcCabal
import Settings.Paths
import Target
import UserSettings
packageDatabaseOracle :: Rules ()
packageDatabaseOracle = void $
addOracle $ \(PackageDatabaseKey stage) -> do
let dir = packageDbDirectory stage
file = dir -/- "package.cache"
unlessM (liftIO $ IO.doesFileExist file) $ do
removeDirectory dir
build $ Target (vanillaContext stage ghcPkg) (GhcPkg stage) [] [dir]
putSuccess $ "| Successfully initialised " ++ dir
......@@ -8,7 +8,6 @@ import qualified Oracles.DirectoryContent
import qualified Oracles.LookupInPath
import qualified Oracles.ModuleFiles
import qualified Oracles.PackageData
import qualified Oracles.PackageDatabase
import qualified Oracles.WindowsPath
oracleRules :: Rules ()
......@@ -20,5 +19,4 @@ oracleRules = do
Oracles.LookupInPath.lookupInPathOracle
Oracles.ModuleFiles.moduleFilesOracle
Oracles.PackageData.packageDataOracle
Oracles.PackageDatabase.packageDatabaseOracle
Oracles.WindowsPath.windowsPathOracle
......@@ -9,20 +9,22 @@ import Rules.Libffi
import Settings.Packages.Rts
import Settings.Paths
import Target
import UserSettings
-- | Build package-data.mk by processing the .cabal file with ghc-cabal utility.
-- | Build rules for registering packages and initialising package databases
-- by running the @ghc-pkg@ utility.
registerPackage :: [(Resource, Int)] -> Context -> Rules ()
registerPackage rs context@Context {..} = do
let path = buildPath context
oldPath = pkgPath package -/- contextDirectory context -- TODO: remove, #113
pkgConf = packageDbDirectory stage -/- pkgNameString package
registerPackage rs context@Context {..} = when (stage <= Stage1) $ do
let dir = packageDbDirectory stage
when (stage <= Stage1) $ matchVersionedFilePath pkgConf "conf" ?> \conf -> do
matchVersionedFilePath (dir -/- pkgNameString package) "conf" ?> \conf -> do
-- This produces inplace-pkg-config. TODO: Add explicit tracking.
need [pkgDataFile context]
-- Post-process inplace-pkg-config. TODO: remove, see #113, #148.
let pkgConfig = oldPath -/- "inplace-pkg-config"
let path = buildPath context
oldPath = pkgPath package -/- contextDirectory context
pkgConfig = oldPath -/- "inplace-pkg-config"
oldBuildPath = oldPath -/- "build"
fixPkgConf = unlines
. map
......@@ -52,3 +54,9 @@ registerPackage rs context@Context {..} = do
. lines
fixFile rtsConf fixRtsConf
when (package == ghc) $ packageDbStamp stage %> \stamp -> do
removeDirectory dir
buildWithResources rs $ Target (vanillaContext stage ghc) (GhcPkg stage) [] [dir]
writeFileLines stamp []
putSuccess $ "| Successfully initialised " ++ dir
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Settings.Builders.GhcCabal (
ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs, bootPackageDatabaseArgs,
PackageDatabaseKey (..), buildDll0
ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs, bootPackageDatabaseArgs, buildDll0
) where
import Base
......@@ -87,16 +86,10 @@ configureArgs = do
, crossCompiling ? (conf "--host" $ argSetting TargetPlatformFull)
, conf "--with-cc" $ argStagedBuilderPath (Cc CompileC) ]
newtype PackageDatabaseKey = PackageDatabaseKey Stage
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
initialisePackageDatabase :: Stage -> Action ()
initialisePackageDatabase = askOracle . PackageDatabaseKey
bootPackageDatabaseArgs :: Args
bootPackageDatabaseArgs = do
stage <- getStage
lift $ initialisePackageDatabase stage
lift $ need [packageDbStamp stage]
stage0 ? do
path <- getTopDirectory
prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=")
......
......@@ -2,7 +2,7 @@ module Settings.Paths (
contextDirectory, buildPath, pkgDataFile, pkgHaddockFile, pkgLibraryFile,
pkgLibraryFile0, pkgGhciLibraryFile, gmpBuildPath, gmpObjects, gmpLibraryH,
gmpBuildInfoPath, generatedPath, libffiBuildPath, shakeFilesPath, pkgConfFile,
packageDbDirectory, bootPackageConstraints, packageDependencies
packageDbDirectory, packageDbStamp, bootPackageConstraints, packageDependencies
) where
import Base
......@@ -92,6 +92,10 @@ packageDbDirectory :: Stage -> FilePath
packageDbDirectory Stage0 = buildRootPath -/- "stage0/bootstrapping.conf"
packageDbDirectory _ = "inplace/lib/package.conf.d"
-- | We use a stamp file to track the existence of a package database.
packageDbStamp :: Stage -> FilePath
packageDbStamp stage = packageDbDirectory stage -/- ".stamp"
-- | Path to the configuration file of a given 'Context'.
pkgConfFile :: Context -> Action FilePath
pkgConfFile context@Context {..} = do
......
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