Commit d9b059b3 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Minor revision

parent 7b00fa70
......@@ -31,7 +31,7 @@ executable hadrian
, Oracles.Config.Flag
, Oracles.Config.Setting
, Oracles.Dependencies
, Oracles.DirectoryContent
, Oracles.DirectoryContents
, Oracles.ModuleFiles
, Oracles.PackageData
, Oracles.Path
......
{-# 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
......
......@@ -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
......@@ -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 "//#*"
......
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 ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment