[commit: ghc] wip/nfs-locking: Cache computation of boot package constraints in a file. (8e9fe8d)

[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/8e9fe8d6f6ddbe681073baf1414403a14fe7c8f0/ghc

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

commit 8e9fe8d6f6ddbe681073baf1414403a14fe7c8f0
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sat Aug 1 18:23:49 2015 +0100

    Cache computation of boot package constraints in a file.


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

8e9fe8d6f6ddbe681073baf1414403a14fe7c8f0
 src/Base.hs              |  5 ++++-
 src/Main.hs              |  1 +
 src/Rules.hs             |  5 ++---
 src/Rules/Cabal.hs       | 29 +++++++++++++++++++++++++++++
 src/Rules/Package.hs     |  4 +---
 src/Settings/Args.hs     |  2 +-
 src/Settings/GhcCabal.hs | 17 +----------------
 7 files changed, 39 insertions(+), 24 deletions(-)

diff --git a/src/Base.hs b/src/Base.hs
index 7cf3a4e..5b022e8 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -1,5 +1,5 @@
 module Base (
-    shakeFilesPath, configPath,
+    shakeFilesPath, configPath, bootPackageConstraints,
     module Development.Shake,
     module Development.Shake.Util,
     module Development.Shake.Config,
@@ -18,3 +18,6 @@ shakeFilesPath = "_build/"
 
 configPath :: FilePath
 configPath = "shake/cfg/"
+
+bootPackageConstraints :: FilePath
+bootPackageConstraints = shakeFilesPath ++ "boot-package-constraints"
diff --git a/src/Main.hs b/src/Main.hs
index c7e076a..ffbd7c0 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -3,6 +3,7 @@ import Rules
 
 main = shakeArgs shakeOptions{shakeFiles = shakeFilesPath} $ do
     oracleRules     -- see module Rules.Oracles
+    cabalRules      -- see module Rules.Cabal
     packageRules    -- see module Rules
     configRules     -- see module Rules.Config
     generateTargets -- see module Rules
diff --git a/src/Rules.hs b/src/Rules.hs
index 6d153e1..002eda2 100644
--- a/src/Rules.hs
+++ b/src/Rules.hs
@@ -1,13 +1,12 @@
 module Rules (
-    generateTargets, packageRules, oracleRules,
-    module Rules.Config,
-    module Rules.Package,
+    oracleRules, cabalRules, configRules, packageRules, generateTargets
     ) where
 
 import Base
 import Util
 import Stage
 import Expression
+import Rules.Cabal
 import Rules.Config
 import Rules.Package
 import Rules.Oracles
diff --git a/src/Rules/Cabal.hs b/src/Rules/Cabal.hs
new file mode 100644
index 0000000..adcb57e
--- /dev/null
+++ b/src/Rules/Cabal.hs
@@ -0,0 +1,29 @@
+module Rules.Cabal (cabalRules) where
+
+import Base
+import Util
+import Stage
+import Package
+import Expression
+import Settings.Packages
+import Data.List
+import Data.Version
+import qualified Distribution.Package                  as D
+import qualified Distribution.PackageDescription       as D
+import qualified Distribution.Verbosity                as D
+import qualified Distribution.PackageDescription.Parse as D
+
+cabalRules :: Rules ()
+cabalRules =
+    -- Cache boot package constraints (to be used in cabalArgs)
+    bootPackageConstraints %> \file -> do
+        pkgs <- interpret (stageTarget Stage0) packages
+        constraints <- forM (sort pkgs) $ \pkg -> do
+            let cabal = pkgPath pkg -/- pkgCabal pkg
+            need [cabal]
+            descr <- liftIO $ D.readPackageDescription D.silent cabal
+            let identifier         = D.package . D.packageDescription $ descr
+                version            = showVersion . D.pkgVersion $ identifier
+                D.PackageName name = D.pkgName $ identifier
+            return $ name ++ " == " ++ version
+        writeFileChanged file . unlines $ constraints
diff --git a/src/Rules/Package.hs b/src/Rules/Package.hs
index a6365e8..ff64832 100644
--- a/src/Rules/Package.hs
+++ b/src/Rules/Package.hs
@@ -1,6 +1,4 @@
-module Rules.Package (
-    buildPackage
-    ) where
+module Rules.Package (buildPackage) where
 
 import Base
 import Expression
diff --git a/src/Settings/Args.hs b/src/Settings/Args.hs
index be6ac42..d698017 100644
--- a/src/Settings/Args.hs
+++ b/src/Settings/Args.hs
@@ -2,12 +2,12 @@ module Settings.Args (
     args
     ) where
 
+import Expression
 import Settings.User
 import Settings.GhcM
 import Settings.GccM
 import Settings.GhcPkg
 import Settings.GhcCabal
-import Expression
 
 args :: Args
 args = defaultArgs <> userArgs
diff --git a/src/Settings/GhcCabal.hs b/src/Settings/GhcCabal.hs
index 092f97a..315df12 100644
--- a/src/Settings/GhcCabal.hs
+++ b/src/Settings/GhcCabal.hs
@@ -15,12 +15,6 @@ import Oracles.Setting
 import Settings.User
 import Settings.Ways
 import Settings.Util
-import Settings.Packages
-import Data.Version
-import qualified Distribution.Package                  as D
-import qualified Distribution.PackageDescription       as D
-import qualified Distribution.Verbosity                as D
-import qualified Distribution.PackageDescription.Parse as D
 
 cabalArgs :: Args
 cabalArgs = builder GhcCabal ? do
@@ -95,18 +89,9 @@ bootPackageDbArgs = do
 dllArgs :: Args
 dllArgs = arg ""
 
--- TODO: speed up by caching the result in Shake database?
 packageConstraints :: Args
 packageConstraints = stage0 ? do
-    pkgs <- getPackages
-    constraints <- lift $ forM pkgs $ \pkg -> do
-        let cabal = pkgPath pkg -/- pkgCabal pkg
-        need [cabal]
-        description <- liftIO $ D.readPackageDescription D.silent cabal
-        let identifier         = D.package . D.packageDescription $ description
-            version            = showVersion . D.pkgVersion $ identifier
-            D.PackageName name = D.pkgName $ identifier
-        return $ name ++ " == " ++ version
+    constraints <- lift . readFileLines $ bootPackageConstraints
     append . concatMap (\c -> ["--constraint", c]) $ constraints
 
 -- TODO: should be in a different file