[commit: ghc] wip/nfs-locking: Add actions copyDirectoryContent and runBuilderWith (e592fb1)

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

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

commit e592fb1f438317d4be4893bf9b07b098ffb28085
Author: Kai Harries <kai.harries at gmail.com>
Date:   Fri Jun 17 17:23:54 2016 +0200

    Add actions copyDirectoryContent and runBuilderWith
    
    These new functions will be helpful when implementing the 'sdist' and
    'install' rules.


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

e592fb1f438317d4be4893bf9b07b098ffb28085
 src/Rules/Actions.hs | 26 ++++++++++++++++++++++----
 1 file changed, 22 insertions(+), 4 deletions(-)

diff --git a/src/Rules/Actions.hs b/src/Rules/Actions.hs
index 6b6c352..8fbe6c0 100644
--- a/src/Rules/Actions.hs
+++ b/src/Rules/Actions.hs
@@ -1,12 +1,14 @@
 module Rules.Actions (
     build, buildWithCmdOptions, buildWithResources, copyFile, fixFile, moveFile,
-    removeFile, copyDirectory, createDirectory, moveDirectory, removeDirectory,
-    applyPatch, runBuilder, makeExecutable, renderProgram, renderLibrary
+    removeFile, copyDirectory, copyDirectoryContent, createDirectory,
+    moveDirectory, removeDirectory, applyPatch, runBuilder, runBuilderWith,
+    makeExecutable, renderProgram, renderLibrary
     ) where
 
 import qualified System.Directory       as IO
 import qualified System.IO              as IO
 import qualified Control.Exception.Base as IO
+import qualified System.Directory.Extra as X
 
 import Base
 import CmdLineFlag
@@ -126,6 +128,18 @@ copyDirectory source target = do
     putProgressInfo $ renderAction "Copy directory" source target
     quietly $ cmd cmdEcho ["cp", "-r", source, target]
 
+-- | Copy the content of the source directory into the target directory. Only
+-- the files and directories for which the predicate returns True are copied.
+copyDirectoryContent :: (FilePath -> IO Bool) -> FilePath -> FilePath -> Action ()
+copyDirectoryContent test source target = do
+    putProgressInfo $ renderAction "Copy directory" source target
+    liftIO $ X.listFilesInside test' source >>= mapM_ cp
+  where
+    target' a = target -/- fromJust (stripPrefix source a)
+    test' a = ifM (test a) (mkdir a >> return True) (return False)
+    mkdir a = IO.createDirectoryIfMissing True $ target' a
+    cp a = whenM (test a) $ IO.copyFile a $ target' a
+
 -- | Move a directory. The contents of the source directory is untracked.
 moveDirectory :: FilePath -> FilePath -> Action ()
 moveDirectory source target = do
@@ -152,12 +166,16 @@ applyPatch dir patch = do
     quietly $ cmd Shell cmdEcho [Cwd dir] [path, "-p0 <", patch]
 
 runBuilder :: Builder -> [String] -> Action ()
-runBuilder builder args = do
+runBuilder =
+    runBuilderWith []
+
+runBuilderWith :: [CmdOption] -> Builder -> [String] -> Action ()
+runBuilderWith options builder args = do
     needBuilder builder
     path <- builderPath builder
     let note = if null args then "" else " (" ++ intercalate ", " args ++ ")"
     putBuild $ "| Run " ++ show builder ++ note
-    quietly $ cmd [path] args
+    quietly $ cmd options [path] args
 
 makeExecutable :: FilePath -> Action ()
 makeExecutable file = do