[commit: ghc] wip/nfs-locking: Minor revision (d9b059b)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 00:27:35 UTC 2017


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

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

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

commit d9b059b3471b2a897b4b0fe8370a6340011310b6
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Mon Oct 31 18:25:18 2016 +0000

    Minor revision


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

d9b059b3471b2a897b4b0fe8370a6340011310b6
 hadrian.cabal                                      |  2 +-
 .../{DirectoryContent.hs => DirectoryContents.hs}  | 19 +++++++++--------
 src/Rules/Oracles.hs                               |  4 ++--
 src/Rules/SourceDist.hs                            |  4 ++--
 src/Util.hs                                        | 24 ++++++++++------------
 5 files changed, 26 insertions(+), 27 deletions(-)

diff --git a/hadrian.cabal b/hadrian.cabal
index b20b17d..0663643 100644
--- a/hadrian.cabal
+++ b/hadrian.cabal
@@ -31,7 +31,7 @@ executable hadrian
                        , Oracles.Config.Flag
                        , Oracles.Config.Setting
                        , Oracles.Dependencies
-                       , Oracles.DirectoryContent
+                       , Oracles.DirectoryContents
                        , Oracles.ModuleFiles
                        , Oracles.PackageData
                        , Oracles.Path
diff --git a/src/Oracles/DirectoryContent.hs b/src/Oracles/DirectoryContents.hs
similarity index 53%
rename from src/Oracles/DirectoryContent.hs
rename to src/Oracles/DirectoryContents.hs
index 3139c6c..6dd3439 100644
--- a/src/Oracles/DirectoryContent.hs
+++ b/src/Oracles/DirectoryContents.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric #-}
-module Oracles.DirectoryContent (
-    directoryContent, directoryContentOracle, Match (..)
+module Oracles.DirectoryContents (
+    directoryContents, directoryContentsOracle, Match (..)
     ) where
 
 import System.Directory.Extra
@@ -8,7 +8,7 @@ import GHC.Generics
 
 import Base
 
-newtype DirectoryContent = DirectoryContent (Match, FilePath)
+newtype DirectoryContents = DirectoryContents (Match, FilePath)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 
 data Match = Test FilePattern | Not Match | And [Match] | Or [Match]
@@ -20,13 +20,14 @@ matches (Not  m) f = not $ matches m f
 matches (And ms) f = all (`matches` f) ms
 matches (Or  ms) f = any (`matches` f) ms
 
--- | Get the directory content recursively.
-directoryContent :: Match -> FilePath -> Action [FilePath]
-directoryContent expr dir = askOracle $ DirectoryContent (expr, dir)
+-- | Given a 'Match' expression and a directory, recursively traverse it and all
+-- its subdirectories to find and return all matching contents.
+directoryContents :: Match -> FilePath -> Action [FilePath]
+directoryContents expr dir = askOracle $ DirectoryContents (expr, dir)
 
-directoryContentOracle :: Rules ()
-directoryContentOracle = void $
-    addOracle $ \(DirectoryContent (expr, dir)) -> liftIO $
+directoryContentsOracle :: Rules ()
+directoryContentsOracle = void $
+    addOracle $ \(DirectoryContents (expr, dir)) -> liftIO $
         filter (matches expr) <$> listFilesInside (return . matches expr) dir
 
 instance Binary Match
diff --git a/src/Rules/Oracles.hs b/src/Rules/Oracles.hs
index 6c5ace4..8f53369 100644
--- a/src/Rules/Oracles.hs
+++ b/src/Rules/Oracles.hs
@@ -4,7 +4,7 @@ import Base
 import qualified Oracles.ArgsHash
 import qualified Oracles.Config
 import qualified Oracles.Dependencies
-import qualified Oracles.DirectoryContent
+import qualified Oracles.DirectoryContents
 import qualified Oracles.ModuleFiles
 import qualified Oracles.PackageData
 import qualified Oracles.Path
@@ -14,7 +14,7 @@ oracleRules = do
     Oracles.ArgsHash.argsHashOracle
     Oracles.Config.configOracle
     Oracles.Dependencies.dependenciesOracles
-    Oracles.DirectoryContent.directoryContentOracle
+    Oracles.DirectoryContents.directoryContentsOracle
     Oracles.ModuleFiles.moduleFilesOracle
     Oracles.PackageData.packageDataOracle
     Oracles.Path.pathOracle
diff --git a/src/Rules/SourceDist.hs b/src/Rules/SourceDist.hs
index 9c49878..d51fe75 100644
--- a/src/Rules/SourceDist.hs
+++ b/src/Rules/SourceDist.hs
@@ -3,7 +3,7 @@ module Rules.SourceDist (sourceDistRules) where
 import Base
 import Builder
 import Oracles.Config.Setting
-import Oracles.DirectoryContent
+import Oracles.DirectoryContents
 import UserSettings
 import Util
 
@@ -32,7 +32,7 @@ prepareTree dest = do
     mapM_ cpFile srcFiles
   where
     cpFile a = copyFile a (dest </> a)
-    cpDir  a = copyDirectoryContent (Not excluded) a (dest </> takeFileName a)
+    cpDir  a = copyDirectoryContents (Not excluded) a (dest </> takeFileName a)
     excluded = Or
       [ Test "//.*"
       , Test "//#*"
diff --git a/src/Util.hs b/src/Util.hs
index dbafd85..f2e6516 100644
--- a/src/Util.hs
+++ b/src/Util.hs
@@ -1,6 +1,6 @@
 module Util (
     build, buildWithCmdOptions, buildWithResources, copyFile, fixFile, moveFile,
-    removeFile, copyDirectory, copyDirectoryContent, createDirectory,
+    removeFile, copyDirectory, copyDirectoryContents, createDirectory,
     moveDirectory, removeDirectory, applyPatch, runBuilder, runBuilderWith,
     makeExecutable, renderProgram, renderLibrary, Match(..), builderEnvironment,
     needBuilder
@@ -16,7 +16,7 @@ import Context
 import Expression
 import GHC
 import Oracles.ArgsHash
-import Oracles.DirectoryContent
+import Oracles.DirectoryContents
 import Oracles.Path
 import Settings
 import Settings.Builders.Ar
@@ -96,6 +96,8 @@ captureStdout target path argList = do
 copyFile :: FilePath -> FilePath -> Action ()
 copyFile source target = do
     need [source] -- Guarantee source is built before printing progress info.
+    let dir = takeDirectory target
+    unlessM (liftIO $ IO.doesDirectoryExist dir) $ createDirectory dir
     putProgressInfo $ renderAction "Copy file" source target
     copyFileChanged source target
 
@@ -129,17 +131,13 @@ 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.
--- The copied content is tracked.
-copyDirectoryContent :: Match -> FilePath -> FilePath -> Action ()
-copyDirectoryContent expr source target = do
-    putProgressInfo $ renderAction "Copy directory content" source target
-    mapM_ cp =<< directoryContent expr source
-  where
-    cp file = do
-        let newFile = target -/- drop (length source) file
-        createDirectory $ dropFileName newFile -- TODO: Why do it for each file?
-        copyFile file newFile
+-- | Copy the contents of the source directory that matches a given 'Match'
+-- expression into the target directory. The copied contents is tracked.
+copyDirectoryContents :: Match -> FilePath -> FilePath -> Action ()
+copyDirectoryContents expr source target = do
+    putProgressInfo $ renderAction "Copy directory contents" source target
+    let cp file = copyFile file $ target -/- makeRelative source file
+    mapM_ cp =<< directoryContents expr source
 
 -- | Move a directory. The contents of the source directory is untracked.
 moveDirectory :: FilePath -> FilePath -> Action ()



More information about the ghc-commits mailing list