[commit: ghc] wip/nfs-locking: Refactor Settings.Paths, add pkgConfFile. (c1364e5)

[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/c1364e54b2178d83410dfa12ff468423e51728fa/ghc

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

commit c1364e54b2178d83410dfa12ff468423e51728fa
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Wed Feb 3 00:38:41 2016 +0000

    Refactor Settings.Paths, add pkgConfFile.
    
    See #200.


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

c1364e54b2178d83410dfa12ff468423e51728fa
 src/Rules.hs          |  8 +++-----
 src/Rules/Program.hs  |  9 ++++-----
 src/Settings/Paths.hs | 33 ++++++++++++++++++++++++---------
 3 files changed, 31 insertions(+), 19 deletions(-)

diff --git a/src/Rules.hs b/src/Rules.hs
index b22e028..1d92baf 100644
--- a/src/Rules.hs
+++ b/src/Rules.hs
@@ -4,7 +4,6 @@ import Base
 import Data.Foldable
 import Expression
 import GHC
-import Oracles.PackageData
 import qualified Rules.Generate
 import Rules.Package
 import Rules.Resources
@@ -22,8 +21,8 @@ topLevelTargets = do
     -- TODO: do we want libffiLibrary to be a top-level target?
 
     action $ do -- TODO: Add support for all rtsWays
-        rtsLib    <- pkgLibraryFile Stage1 rts "rts" vanilla
-        rtsThrLib <- pkgLibraryFile Stage1 rts "rts" threaded
+        rtsLib    <- pkgLibraryFile Stage1 rts vanilla
+        rtsThrLib <- pkgLibraryFile Stage1 rts threaded
         need [ rtsLib, rtsThrLib ]
 
     for_ allStages $ \stage ->
@@ -34,8 +33,7 @@ topLevelTargets = do
                 if isLibrary pkg
                 then do -- build a library
                     ways    <- interpretPartial target getLibraryWays
-                    compId  <- interpretPartial target $ getPkgData ComponentId
-                    libs    <- traverse (pkgLibraryFile stage pkg compId) ways
+                    libs    <- traverse (pkgLibraryFile stage pkg) ways
                     haddock <- interpretPartial target buildHaddock
                     need $ libs ++ [ pkgHaddockFile pkg | haddock && stage == Stage1 ]
                 else do -- otherwise build a program
diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs
index d472e88..9a5b501 100644
--- a/src/Rules/Program.hs
+++ b/src/Rules/Program.hs
@@ -86,14 +86,13 @@ buildBinary target @ (PartialTarget stage pkg) bin = do
     let deps = matchPackageNames (sort pkgs) (map PackageName $ sort depNames)
         ghci = ghciFlag == "YES" && stage == Stage1
     libs <- fmap concat . forM deps $ \dep -> do
-        let depTarget = PartialTarget libStage dep
-        compId <- interpretPartial depTarget $ getPkgData ComponentId
         libFiles <- fmap concat . forM ways $ \way -> do
-            libFile  <- pkgLibraryFile libStage dep compId           way
-            lib0File <- pkgLibraryFile libStage dep (compId ++ "-0") way
+            libFile  <- pkgLibraryFile  libStage dep way
+            lib0File <- pkgLibraryFile0 libStage dep way
             dll0     <- needDll0 libStage dep
             return $ libFile : [ lib0File | dll0 ]
-        return $ libFiles ++ [ pkgGhciLibraryFile libStage dep compId | ghci ]
+        ghciLib <- pkgGhciLibraryFile libStage dep
+        return $ libFiles ++ [ ghciLib | ghci ]
     let binDeps = if pkg == ghcCabal && stage == Stage0
                   then [ pkgPath pkg -/- src <.> "hs" | src <- hSrcs ]
                   else objs
diff --git a/src/Settings/Paths.hs b/src/Settings/Paths.hs
index a152f9a..20f4721 100644
--- a/src/Settings/Paths.hs
+++ b/src/Settings/Paths.hs
@@ -1,11 +1,13 @@
 module Settings.Paths (
     targetDirectory, targetPath, pkgDataFile, pkgHaddockFile, pkgLibraryFile,
-    pkgGhciLibraryFile, gmpBuildPath, gmpLibNameCache, packageDbDirectory
+    pkgLibraryFile0, pkgGhciLibraryFile, gmpBuildPath, gmpLibNameCache,
+    packageDbDirectory, pkgConfFile
     ) where
 
 import Base
 import Expression
 import GHC
+import Oracles.PackageData
 import Settings.User
 
 -- Path to the target directory from GHC source root
@@ -24,18 +26,26 @@ pkgHaddockFile pkg =
 
 -- Relative path to a package library file, e.g.:
 -- "libraries/array/stage2/build/libHSarray-0.5.1.0.a"
--- TODO: remove code duplication for computing buildPath
-pkgLibraryFile :: Stage -> Package -> String -> Way -> Action FilePath
-pkgLibraryFile stage pkg componentId way = do
+pkgLibraryFile :: Stage -> Package -> Way -> Action FilePath
+pkgLibraryFile stage pkg way = do
     extension <- libsuf way
-    let buildPath = targetPath stage pkg -/- "build"
-    return $ buildPath -/- "libHS" ++ componentId ++ extension
+    pkgFile stage pkg "build/libHS" extension
+
+pkgLibraryFile0 :: Stage -> Package -> Way -> Action FilePath
+pkgLibraryFile0 stage pkg way = do
+    extension <- libsuf way
+    pkgFile stage pkg "build/libHS" ("-0" ++ extension)
 
 -- Relative path to a package ghci library file, e.g.:
 -- "libraries/array/dist-install/build/HSarray-0.5.1.0.o"
-pkgGhciLibraryFile :: Stage -> Package -> String -> FilePath
-pkgGhciLibraryFile stage pkg componentId =
-    targetPath stage pkg -/- "build" -/- "HS" ++ componentId <.> "o"
+pkgGhciLibraryFile :: Stage -> Package -> Action FilePath
+pkgGhciLibraryFile stage pkg = pkgFile stage pkg "build/HS" ".o"
+
+pkgFile :: Stage -> Package -> String -> String -> Action FilePath
+pkgFile stage pkg prefix suffix = do
+    let path = targetPath stage pkg
+    componentId <- pkgData $ ComponentId path
+    return $ path -/- prefix ++ componentId ++ suffix
 
 -- This is the build directory for in-tree GMP library
 gmpBuildPath :: FilePath
@@ -50,3 +60,8 @@ gmpLibNameCache = gmpBuildPath -/- "gmp-lib-names"
 packageDbDirectory :: Stage -> FilePath
 packageDbDirectory Stage0 = buildRootPath -/- "stage0/bootstrapping.conf"
 packageDbDirectory _      = "inplace/lib/package.conf.d"
+
+pkgConfFile :: Stage -> Package -> Action FilePath
+pkgConfFile stage pkg = do
+    componentId <- pkgData . ComponentId $ targetPath stage pkg
+    return $ packageDbDirectory stage -/- componentId <.> "conf"