[commit: ghc] wip/nfs-locking: Simplify package database directory tracking (3e37d73)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/3e37d7350458218964134a981125a19f095de63a/ghc

>---------------------------------------------------------------

commit 3e37d7350458218964134a981125a19f095de63a
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Tue Oct 18 23:03:50 2016 +0100

    Simplify package database directory tracking


>---------------------------------------------------------------

3e37d7350458218964134a981125a19f095de63a
 hadrian.cabal                     |  1 -
 src/Oracles/PackageDatabase.hs    | 23 -----------------------
 src/Rules/Oracles.hs              |  2 --
 src/Rules/Register.hs             | 22 +++++++++++++++-------
 src/Settings/Builders/GhcCabal.hs | 11 ++---------
 src/Settings/Paths.hs             |  6 +++++-
 6 files changed, 22 insertions(+), 43 deletions(-)

diff --git a/hadrian.cabal b/hadrian.cabal
index 3e34b16..6039b01 100644
--- a/hadrian.cabal
+++ b/hadrian.cabal
@@ -35,7 +35,6 @@ executable hadrian
                        , Oracles.LookupInPath
                        , Oracles.ModuleFiles
                        , Oracles.PackageData
-                       , Oracles.PackageDatabase
                        , Oracles.WindowsPath
                        , Package
                        , Predicate
diff --git a/src/Oracles/PackageDatabase.hs b/src/Oracles/PackageDatabase.hs
deleted file mode 100644
index efaf9ca..0000000
--- a/src/Oracles/PackageDatabase.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-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
diff --git a/src/Rules/Oracles.hs b/src/Rules/Oracles.hs
index 10767b5..af03b17 100644
--- a/src/Rules/Oracles.hs
+++ b/src/Rules/Oracles.hs
@@ -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
diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs
index 272e27b..d4799e3 100644
--- a/src/Rules/Register.hs
+++ b/src/Rules/Register.hs
@@ -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 at Context {..} = do
-    let path    = buildPath context
-        oldPath = pkgPath package -/- contextDirectory context -- TODO: remove, #113
-        pkgConf = packageDbDirectory stage -/- pkgNameString package
+registerPackage rs context at 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 at 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
diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs
index fffb2c0..5569ba0 100644
--- a/src/Settings/Builders/GhcCabal.hs
+++ b/src/Settings/Builders/GhcCabal.hs
@@ -1,7 +1,6 @@
 {-# 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=")
diff --git a/src/Settings/Paths.hs b/src/Settings/Paths.hs
index ad200f8..6382fcc 100644
--- a/src/Settings/Paths.hs
+++ b/src/Settings/Paths.hs
@@ -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 at Context {..} = do