[commit: ghc] wip/nfs-locking: Minor revision (d9b059b)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 01:13:45 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