Create package database directories using oracles.

Fix #176.

shaking-up-ghc.cabal

@@ -31,6 +31,7 @@ executable ghc-shake
                        , Oracles.LookupInPath
                        , Oracles.ModuleFiles
                        , Oracles.PackageData
+                       , Oracles.PackageDb
                        , Oracles.PackageDeps
                        , Oracles.WindowsRoot
                        , Package

src/Oracles/PackageDb.hs

+module Oracles.PackageDb (packageDbOracle) where
+
+import qualified System.Directory as IO
+
+import Base
+import Builder
+import GHC
+import Rules.Actions
+import Settings.Builders.GhcCabal
+import Settings.Paths
+import Target
+
+packageDbOracle :: Rules ()
+packageDbOracle = do
+    _ <- addOracle $ \(PackageDbKey stage) -> do
+        let dir  = packageDbDirectory stage
+            file = dir -/- "package.cache"
+        unlessM (liftIO $ IO.doesFileExist file) $ do
+            let target  = PartialTarget stage ghcPkg
+            removeDirectoryIfExists dir
+            build $ fullTarget target (GhcPkg stage) [] [dir]
+            putSuccess $ "| Successfully initialised " ++ dir
+    return ()

src/Rules/Actions.hs

 {-# LANGUAGE RecordWildCards #-}
 module Rules.Actions (
-    build, buildWithResources, copyFile, createDirectory, removeDirectory, moveDirectory,
-    fixFile, runConfigure, runMake, applyPatch, renderLibrary, renderProgram,
-    runBuilder, makeExecutable,
+    build, buildWithResources, copyFile, createDirectory, removeDirectory,
+    moveDirectory, fixFile, runConfigure, runMake, applyPatch, renderLibrary,
+    renderProgram, runBuilder, makeExecutable
     ) where
 
 import qualified System.Directory as IO

src/Rules/Cabal.hs

@@ -42,20 +42,6 @@ cabalRules = do
                 return . unwords $ pkgNameString pkg : sort depNames
         writeFileChanged out . unlines $ pkgDeps
 
-    -- When the file exists, the packageConfiguration has been initialised
-    -- TODO: get rid of an extra file?
-
-    forM_ [Stage0, Stage1] $ \stage ->
-        packageConfigurationInitialised stage %> \out -> do
-            let target  = PartialTarget stage cabal
-                pkgConf = packageConfiguration stage
-            removeDirectoryIfExists pkgConf
-            -- TODO: can we get rid of this fake target?
-            build $ fullTarget target (GhcPkg stage) [] [pkgConf]
-            let message = "Successfully initialised " ++ pkgConf
-            writeFileChanged out message
-            putSuccess message
-
 collectDeps :: Maybe (CondTree v [Dependency] a) -> [Dependency]
 collectDeps Nothing = []
 collectDeps (Just (CondNode _ deps ifs)) = deps ++ concatMap f ifs

src/Rules/Oracles.hs

@@ -3,8 +3,10 @@ module Rules.Oracles (oracleRules) where
 import Base
 import Oracles
 import Oracles.ArgsHash
+import Oracles.PackageDb
 import Oracles.ModuleFiles
 
+-- TODO: replace comments with qualified imports
 oracleRules :: Rules ()
 oracleRules = do
     argsHashOracle     -- see Oracles.ArgsHash
@@ -13,5 +15,6 @@ oracleRules = do
     lookupInPathOracle -- see Oracles.LookupInPath
     moduleFilesOracle  -- see Oracles.ModuleFiles
     packageDataOracle  -- see Oracles.PackageData
+    packageDbOracle    -- see Oracles.PackageData
     packageDepsOracle  -- see Oracles.PackageDeps
     windowsRootOracle  -- see Oracles.WindowsRoot

src/Rules/Wrappers/GhcPkg.hs

@@ -11,8 +11,8 @@ ghcPkgWrapper program = do
     stage <- getStage
     -- Use the package configuration for the next stage in the wrapper.
     -- The wrapper is generated in StageN, but used in StageN+1.
-    let pkgConf = top -/- packageConfiguration (succ stage)
+    let packageDb = top -/- packageDbDirectory (succ stage)
     return $ unlines
         [ "#!/bin/bash"
         , "exec " ++ (top -/- program)
-          ++ " --global-package-db " ++ pkgConf ++ " ${1+\"$@\"}" ]
+          ++ " --global-package-db " ++ packageDb ++ " ${1+\"$@\"}" ]

src/Settings/Builders/GhcCabal.hs

+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
 module Settings.Builders.GhcCabal (
-    ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs,
-    bootPackageDbArgs, cppArgs, needDll0
+    ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs, bootPackageDbArgs,
+    PackageDbKey (..), cppArgs, needDll0
     ) where
 
 import Base
@@ -85,14 +86,20 @@ configureArgs = do
         , crossCompiling ? (conf "--host" $ argSetting TargetPlatformFull)
         , conf "--with-cc" $ argStagedBuilderPath Gcc ]
 
+newtype PackageDbKey = PackageDbKey Stage
+    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+
+initialisePackageDb :: Stage -> Action ()
+initialisePackageDb stage = askOracle $ PackageDbKey stage
+
 bootPackageDbArgs :: Args
 bootPackageDbArgs = do
     stage <- getStage
-    lift $ need [packageConfigurationInitialised stage]
+    lift $ initialisePackageDb stage
     stage0 ? do
         path   <- getTopDirectory
         prefix <- ifM builderGhc (return "-package-db ") (return "--package-db=")
-        arg $ prefix ++ path -/- packageConfiguration Stage0
+        arg $ prefix ++ path -/- packageDbDirectory Stage0
 
 packageConstraints :: Args
 packageConstraints = stage0 ? do

src/Settings/Builders/GhcPkg.hs

@@ -11,7 +11,7 @@ ghcPkgBuilderArgs :: Args
 ghcPkgBuilderArgs = stagedBuilder GhcPkg ? (initArgs <> updateArgs)
 
 initPredicate :: Predicate
-initPredicate = orM $ map (file . packageConfiguration) [Stage0 ..]
+initPredicate = orM $ map (file . packageDbDirectory) [Stage0 ..]
 
 initArgs :: Args
 initArgs = initPredicate ? do

src/Settings/Paths.hs

 module Settings.Paths (
     targetDirectory, targetPath, pkgDataFile, pkgHaddockFile, pkgLibraryFile,
-    pkgGhciLibraryFile, packageConfiguration, packageConfigurationInitialised,
-    gmpBuildPath, gmpLibNameCache
+    pkgGhciLibraryFile, gmpBuildPath, gmpLibNameCache, packageDbDirectory
     ) where
 
 import Base
@@ -38,16 +37,6 @@ pkgGhciLibraryFile :: Stage -> Package -> String -> FilePath
 pkgGhciLibraryFile stage pkg componentId =
     targetPath stage pkg -/- "build" -/- "HS" ++ componentId <.> "o"
 
--- TODO: move to buildRootPath, see #113
-packageConfiguration :: Stage -> FilePath
-packageConfiguration Stage0 = buildRootPath -/- "stage0/bootstrapping.conf"
-packageConfiguration _      = "inplace/lib/package.conf.d"
-
--- StageN, N > 0, share the same packageConfiguration (see above)
-packageConfigurationInitialised :: Stage -> FilePath
-packageConfigurationInitialised stage = packageConfiguration stage -/-
-    "package-configuration-initialised-" ++ stageString (min stage Stage1)
-
 -- This is the build directory for in-tree GMP library
 gmpBuildPath :: FilePath
 gmpBuildPath = buildRootPath -/- "stage0/gmp"
@@ -55,3 +44,9 @@ gmpBuildPath = buildRootPath -/- "stage0/gmp"
 -- GMP library names extracted from integer-gmp.buildinfo
 gmpLibNameCache :: FilePath
 gmpLibNameCache = gmpBuildPath -/- "gmp-lib-names"
+
+-- TODO: move to buildRootPath, see #113
+-- StageN, N > 0, share the same packageDbDirectory
+packageDbDirectory :: Stage -> FilePath
+packageDbDirectory Stage0 = buildRootPath -/- "stage0/bootstrapping.conf"
+packageDbDirectory _      = "inplace/lib/package.conf.d"