[commit: ghc] wip/nfs-locking: Initialise inplace/lib/package.conf.d, fix #66. (84704cf)

git at git.haskell.org git at git.haskell.org
Thu Oct 26 23:50:51 UTC 2017


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

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

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

commit 84704cf2cf9324a09153b65f667581d03671e6ed
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Thu Dec 31 13:53:29 2015 +0000

    Initialise inplace/lib/package.conf.d, fix #66.


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

84704cf2cf9324a09153b65f667581d03671e6ed
 src/Base.hs                       | 15 ++++++++++-----
 src/Rules/Cabal.hs                | 20 +++++++++++---------
 src/Rules/Wrappers/GhcPkg.hs      |  5 +++--
 src/Settings/Builders/GhcCabal.hs | 12 +++++++-----
 src/Settings/Builders/GhcPkg.hs   |  7 +++++--
 src/Stage.hs                      |  2 +-
 6 files changed, 37 insertions(+), 24 deletions(-)

diff --git a/src/Base.hs b/src/Base.hs
index 25a69df..a127299 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -16,7 +16,7 @@ module Base (
     -- * Paths
     shakeFilesPath, configPath, sourcePath, programInplacePath,
     bootPackageConstraints, packageDependencies,
-    bootstrappingConf, bootstrappingConfInitialised,
+    packageConfiguration, packageConfigurationInitialised,
 
     -- * Output
     putColoured, putOracle, putBuild, putSuccess, putError, renderBox,
@@ -41,6 +41,9 @@ import System.Console.ANSI
 import qualified System.Directory as IO
 import System.IO
 
+-- TODO: reexport Stage, etc.?
+import Stage
+
 -- Build system files and paths
 shakePath :: FilePath
 shakePath = "shake-build"
@@ -65,11 +68,13 @@ bootPackageConstraints = shakeFilesPath -/- "boot-package-constraints"
 packageDependencies :: FilePath
 packageDependencies = shakeFilesPath -/- "package-dependencies"
 
-bootstrappingConf :: FilePath
-bootstrappingConf = "libraries/bootstrapping.conf"
+packageConfiguration :: Stage -> FilePath
+packageConfiguration Stage0 = "libraries/bootstrapping.conf"
+packageConfiguration _      = "inplace/lib/package.conf.d"
 
-bootstrappingConfInitialised :: FilePath
-bootstrappingConfInitialised = shakeFilesPath -/- "bootstrapping-conf-initialised"
+packageConfigurationInitialised :: Stage -> FilePath
+packageConfigurationInitialised stage =
+    shakeFilesPath -/- "package-configuration-initialised-" ++ stageString stage
 
 -- Utility functions
 -- | Find and replace all occurrences of a value in a list
diff --git a/src/Rules/Cabal.hs b/src/Rules/Cabal.hs
index 9239e67..ab7622c 100644
--- a/src/Rules/Cabal.hs
+++ b/src/Rules/Cabal.hs
@@ -39,17 +39,19 @@ cabalRules = do
             return . unwords $ pkgNameString pkg : sort depNames
         writeFileChanged out . unlines $ pkgDeps
 
-    -- When the file exists, the bootstrappingConf has been initialised
+    -- When the file exists, the packageConfiguration has been initialised
     -- TODO: get rid of an extra file?
-    bootstrappingConfInitialised %> \out -> do
-        removeDirectoryIfExists bootstrappingConf
-        -- TODO: can we get rid of this fake target?
-        let target = PartialTarget Stage0 cabal
-        build $ fullTarget target (GhcPkg Stage0) [] [bootstrappingConf]
-        let message = "Successfully initialised " ++ bootstrappingConf
-        writeFileChanged out message
-        putSuccess message
 
+    forM_ [Stage0 ..] $ \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 = []
diff --git a/src/Rules/Wrappers/GhcPkg.hs b/src/Rules/Wrappers/GhcPkg.hs
index 7edc43c..3f70617 100644
--- a/src/Rules/Wrappers/GhcPkg.hs
+++ b/src/Rules/Wrappers/GhcPkg.hs
@@ -12,8 +12,9 @@ import Oracles
 ghcPkgWrapper :: FilePath -> Expr String
 ghcPkgWrapper program = do
     lift $ need [sourcePath -/- "Rules/Wrappers/GhcPkg.hs"]
-    top <- getSetting GhcSourcePath
-    let pkgConf = top -/- "inplace" -/- "lib" -/- "package.conf.d"
+    top   <- getSetting GhcSourcePath
+    stage <- getStage
+    let pkgConf = top -/- packageConfiguration stage
     return $ unlines
         [ "#!/bin/bash"
         , "exec " ++ (top -/- program)
diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs
index 597f591..06b2a63 100644
--- a/src/Settings/Builders/GhcCabal.hs
+++ b/src/Settings/Builders/GhcCabal.hs
@@ -85,11 +85,13 @@ configureArgs = do
         , conf "--with-cc" $ argStagedBuilderPath Gcc ]
 
 bootPackageDbArgs :: Args
-bootPackageDbArgs = stage0 ? do
-    path <- getSetting GhcSourcePath
-    lift $ need [bootstrappingConfInitialised]
-    prefix <- ifM builderGhc (return "-package-db ") (return "--package-db=")
-    arg $ prefix ++ path -/- bootstrappingConf
+bootPackageDbArgs = do
+    stage <- getStage
+    lift $ need [packageConfigurationInitialised stage]
+    stage0 ? do
+        path <- getSetting GhcSourcePath
+        prefix <- ifM builderGhc (return "-package-db ") (return "--package-db=")
+        arg $ prefix ++ path -/- packageConfiguration Stage0
 
 packageConstraints :: Args
 packageConstraints = stage0 ? do
diff --git a/src/Settings/Builders/GhcPkg.hs b/src/Settings/Builders/GhcPkg.hs
index e79a360..c8e25ff 100644
--- a/src/Settings/Builders/GhcPkg.hs
+++ b/src/Settings/Builders/GhcPkg.hs
@@ -10,13 +10,16 @@ import Settings.Builders.GhcCabal
 ghcPkgArgs :: Args
 ghcPkgArgs = stagedBuilder GhcPkg ? (initArgs <> updateArgs)
 
+initPredicate :: Predicate
+initPredicate = orM $ map (file . packageConfiguration) [Stage0 ..]
+
 initArgs :: Args
-initArgs = file bootstrappingConf ? do
+initArgs = initPredicate ? do
     mconcat [ arg "init"
             , arg =<< getOutput ]
 
 updateArgs :: Args
-updateArgs = notM (file bootstrappingConf) ? do
+updateArgs = notM initPredicate ? do
     path <- getTargetPath
     mconcat [ arg "update"
             , arg "--force"
diff --git a/src/Stage.hs b/src/Stage.hs
index 70fe6ba..144aa29 100644
--- a/src/Stage.hs
+++ b/src/Stage.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 module Stage (Stage (..), stageString) where
 
-import Base
+import Development.Shake.Classes
 import GHC.Generics (Generic)
 
 -- TODO: explain stages



More information about the ghc-commits mailing list