[commit: ghc] wip/nfs-locking: Fix install rules by untracking copy files and use relative path (#396) (942ed27)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 01:24:59 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/942ed27a622576252ef7178040f0b1fdbf08ca1c/ghc
>---------------------------------------------------------------
commit 942ed27a622576252ef7178040f0b1fdbf08ca1c
Author: Zhen Zhang <izgzhen at gmail.com>
Date: Sat Aug 19 09:39:25 2017 +0800
Fix install rules by untracking copy files and use relative path (#396)
>---------------------------------------------------------------
942ed27a622576252ef7178040f0b1fdbf08ca1c
src/Hadrian/Oracles/DirectoryContents.hs | 10 +++++++++-
src/Rules/Install.hs | 8 +++++---
2 files changed, 14 insertions(+), 4 deletions(-)
diff --git a/src/Hadrian/Oracles/DirectoryContents.hs b/src/Hadrian/Oracles/DirectoryContents.hs
index 19a5192..f302af9 100644
--- a/src/Hadrian/Oracles/DirectoryContents.hs
+++ b/src/Hadrian/Oracles/DirectoryContents.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE TypeFamilies #-}
module Hadrian.Oracles.DirectoryContents (
- directoryContents, copyDirectoryContents, directoryContentsOracle,
+ directoryContents, copyDirectoryContents, directoryContentsOracle, copyDirectoryContentsUntracked,
Match (..), matches, matchAll
) where
@@ -45,6 +45,14 @@ copyDirectoryContents expr source target = do
let cp file = copyFile file $ target -/- makeRelative source file
mapM_ cp =<< directoryContents expr source
+-- | Copy the contents of the source directory that matches a given 'Match'
+-- expression into the target directory. The copied contents is untracked.
+copyDirectoryContentsUntracked :: Match -> FilePath -> FilePath -> Action ()
+copyDirectoryContentsUntracked expr source target = do
+ putProgressInfo =<< renderAction "Copy directory contents (untracked)" source target
+ let cp file = copyFileUntracked file $ target -/- makeRelative source file
+ mapM_ cp =<< directoryContents expr source
+
newtype DirectoryContents = DirectoryContents (Match, FilePath)
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
type instance RuleResult DirectoryContents = [FilePath]
diff --git a/src/Rules/Install.hs b/src/Rules/Install.hs
index 12135b4..2400933 100644
--- a/src/Rules/Install.hs
+++ b/src/Rules/Install.hs
@@ -186,7 +186,9 @@ installPackages = do
withLatestBuildStage pkg $ \stage -> do
let context = vanillaContext stage pkg
top <- topDirectory
- installDistDir <- (top -/-) <$> buildPath context
+ installDistDir <- buildPath context
+ let absInstallDistDir = top -/- installDistDir
+
need =<< packageTargets stage pkg
docDir <- installDocDir
ghclibDir <- installGhcLibDir
@@ -203,7 +205,7 @@ installPackages = do
need [cabalFile, pkgConf] -- TODO: check if need pkgConf
-- HACK (#318): copy stuff back to the place favored by ghc-cabal
- quietly $ copyDirectoryContents (Not excluded)
+ quietly $ copyDirectoryContentsUntracked (Not excluded)
installDistDir (installDistDir -/- "build")
whenM (isSpecified HsColour) $
@@ -212,7 +214,7 @@ installPackages = do
pref <- setting InstallPrefix
unit $ cmd ghcCabalInplace [ "copy"
, pkgPath pkg
- , installDistDir
+ , absInstallDistDir
, strip
, destDir
, pref
More information about the ghc-commits
mailing list