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

Simplify

See #265
parent 038dfb43
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric #-}
module Oracles.DirectoryContent (
getDirectoryContent, directoryContentOracle, Match(..)
directoryContent, directoryContentOracle, Match (..)
) where
import Base
import GHC.Generics
import System.Directory.Extra
import GHC.Generics
import Base
newtype DirectoryContent = DirectoryContent (Match, FilePath)
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
data Match = Test FilePattern | Not (Match) | And [Match] | Or [Match]
data Match = Test FilePattern | Not Match | And [Match] | Or [Match]
deriving (Generic, Eq, Show, Typeable)
instance Binary Match
instance Hashable Match
instance NFData Match
matches :: Match -> FilePath -> Bool
matches (Test m) f = m ?== f
matches (Not m) f = not $ matches m f
matches (And []) _ = True
matches (And (m:ms)) f | matches m f = matches (And ms) f
| otherwise = False
matches (Or []) _ = False
matches (Or (m:ms)) f | matches m f = True
| otherwise = matches (Or ms) f
matches (Test p) f = p ?== f
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.
getDirectoryContent :: Match -> FilePath -> Action [FilePath]
getDirectoryContent expr dir =
askOracle $ DirectoryContent (expr, dir)
directoryContent :: Match -> FilePath -> Action [FilePath]
directoryContent expr dir = askOracle $ DirectoryContent (expr, dir)
directoryContentOracle :: Rules ()
directoryContentOracle = void $ addOracle oracle
where
oracle :: DirectoryContent -> Action [FilePath]
oracle (DirectoryContent (expr, dir)) =
liftIO $ filter (matches expr) <$> listFilesInside (return . matches expr) dir
directoryContentOracle = void $
addOracle $ \(DirectoryContent (expr, dir)) -> liftIO $
filter (matches expr) <$> listFilesInside (return . matches expr) dir
instance Binary Match
instance Hashable Match
instance NFData Match
......@@ -45,8 +45,7 @@ customBuild rs opts target@Target {..} = do
argList <- interpret target getArgs
verbose <- interpret target verboseCommands
let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly
-- The line below forces the rule to be rerun if the args hash has changed.
checkArgsHash target
checkArgsHash target -- Rerun the rule if the hash of argList has changed.
withResources rs $ do
putInfo target
quietlyUnlessVerbose $ case builder of
......@@ -133,12 +132,12 @@ copyDirectory source target = do
copyDirectoryContent :: Match -> FilePath -> FilePath -> Action ()
copyDirectoryContent expr source target = do
putProgressInfo $ renderAction "Copy directory content" source target
getDirectoryContent expr source >>= mapM_ cp
mapM_ cp =<< directoryContent expr source
where
cp a = do
createDirectory $ dropFileName $ target' a
copyFile a $ target' a
target' a = target -/- fromJust (stripPrefix source a)
cp file = do
let newFile = target -/- drop (length source) file
createDirectory $ dropFileName newFile -- TODO: Why do it for each file?
copyFile file newFile
-- | 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