[commit: ghc] wip/nfs-locking: getDirectoryContent: Implement an AST for matching (5999957)

[git at git.haskell.org]

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

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

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

commit 59999579eb089d578b0bed928bfe338b8705cace
Author: Kai Harries <kai.harries at gmail.com>
Date:   Fri Jul 1 15:30:56 2016 +0200

    getDirectoryContent: Implement an AST for matching


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

59999579eb089d578b0bed928bfe338b8705cace
 src/Oracles/DirectoryContent.hs | 44 ++++++++++++++++++++++++-----------------
 src/Rules/Actions.hs            |  9 ++++-----
 2 files changed, 30 insertions(+), 23 deletions(-)

diff --git a/src/Oracles/DirectoryContent.hs b/src/Oracles/DirectoryContent.hs
index 6211222..45afa92 100644
--- a/src/Oracles/DirectoryContent.hs
+++ b/src/Oracles/DirectoryContent.hs
@@ -1,31 +1,39 @@
-{-# 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
diff --git a/src/Rules/Actions.hs b/src/Rules/Actions.hs
index c3680f9..7b4c46c 100644
--- a/src/Rules/Actions.hs
+++ b/src/Rules/Actions.hs
@@ -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