Commit 59999579 authored by kaiha's avatar kaiha
Browse files

getDirectoryContent: Implement an AST for matching

parent 5439f0ee
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric #-}
module Oracles.DirectoryContent (
getDirectoryContent, directoryContentOracle, Exclude(..), ExcludeNot(..)
getDirectoryContent, directoryContentOracle, Match(..)
) where
import Base
import GHC.Generics
import System.Directory.Extra
newtype DirectoryContent = DirectoryContent (Exclude, ExcludeNot, FilePath)
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
newtype Exclude = Exclude [FilePattern]
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
newtype ExcludeNot = ExcludeNot [FilePattern]
newtype DirectoryContent = DirectoryContent (Match, FilePath)
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-- | Get the directory content. 'Exclude' and 'ExcludeNot' are a list of file
-- patterns matched with '?=='.
getDirectoryContent :: Exclude -> ExcludeNot -> FilePath -> Action [FilePath]
getDirectoryContent exclude excludeNot dir =
askOracle $ DirectoryContent (exclude, excludeNot, dir)
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
-- | Get the directory content recursively.
getDirectoryContent :: Match -> FilePath -> Action [FilePath]
getDirectoryContent expr dir =
askOracle $ DirectoryContent (expr, dir)
directoryContentOracle :: Rules ()
directoryContentOracle = void $ addOracle oracle
where
oracle :: DirectoryContent -> Action [FilePath]
oracle (DirectoryContent (Exclude exclude, ExcludeNot excludeNot, dir)) =
liftIO $ filter test <$> listFilesInside (return . test) dir
where
test a = include' a || not (exclude' a)
exclude' a = any (?== a) exclude
include' a = any (?== a) excludeNot
oracle (DirectoryContent (expr, dir)) =
liftIO $ filter (matches expr) <$> listFilesInside (return . matches expr) dir
......@@ -2,7 +2,7 @@ module Rules.Actions (
build, buildWithCmdOptions, buildWithResources, copyFile, fixFile, moveFile,
removeFile, copyDirectory, copyDirectoryContent, createDirectory,
moveDirectory, removeDirectory, applyPatch, runBuilder, runBuilderWith,
makeExecutable, renderProgram, renderLibrary, Exclude(..), ExcludeNot(..)
makeExecutable, renderProgram, renderLibrary, Match(..)
) where
import qualified System.Directory.Extra as IO
......@@ -129,12 +129,11 @@ copyDirectory source target = do
quietly $ cmd cmdEcho ["cp", "-r", source, target]
-- | Copy the content of the source directory into the target directory.
-- 'Exclude' and 'ExcludeNot' are a list of file patterns matched with '?=='.
-- The copied content is tracked.
copyDirectoryContent :: Exclude -> ExcludeNot -> FilePath -> FilePath -> Action ()
copyDirectoryContent exclude excludeNot source target = do
copyDirectoryContent :: Match -> FilePath -> FilePath -> Action ()
copyDirectoryContent expr source target = do
putProgressInfo $ renderAction "Copy directory content" source target
getDirectoryContent exclude excludeNot source >>= mapM_ cp
getDirectoryContent expr source >>= mapM_ cp
where
cp a = do
createDirectory $ dropFileName $ target' a
......
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