[commit: ghc] wip/nfs-locking: Add Oracle 'DirectoryContent' (21f3e05)

[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/21f3e0562f3d4685e384f2ba374898dc6868ce0e/ghc

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

commit 21f3e0562f3d4685e384f2ba374898dc6868ce0e
Author: Kai Harries <kai.harries at gmail.com>
Date:   Tue Jun 28 09:39:55 2016 +0200

    Add Oracle 'DirectoryContent'


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

21f3e0562f3d4685e384f2ba374898dc6868ce0e
 hadrian.cabal                   |  1 +
 src/Oracles/DirectoryContent.hs | 31 +++++++++++++++++++++++++++++++
 src/Rules/Oracles.hs            |  2 ++
 3 files changed, 34 insertions(+)

diff --git a/hadrian.cabal b/hadrian.cabal
index 5ffcb65..df2a4a5 100644
--- a/hadrian.cabal
+++ b/hadrian.cabal
@@ -30,6 +30,7 @@ executable hadrian
                        , Oracles.Config.Flag
                        , Oracles.Config.Setting
                        , Oracles.Dependencies
+                       , Oracles.DirectoryContent
                        , Oracles.LookupInPath
                        , Oracles.ModuleFiles
                        , Oracles.PackageData
diff --git a/src/Oracles/DirectoryContent.hs b/src/Oracles/DirectoryContent.hs
new file mode 100644
index 0000000..6211222
--- /dev/null
+++ b/src/Oracles/DirectoryContent.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Oracles.DirectoryContent (
+    getDirectoryContent, directoryContentOracle, Exclude(..), ExcludeNot(..)
+    ) where
+
+import Base
+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]
+    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)
+
+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
diff --git a/src/Rules/Oracles.hs b/src/Rules/Oracles.hs
index 7beb67f..10767b5 100644
--- a/src/Rules/Oracles.hs
+++ b/src/Rules/Oracles.hs
@@ -4,6 +4,7 @@ import Base
 import qualified Oracles.ArgsHash
 import qualified Oracles.Config
 import qualified Oracles.Dependencies
+import qualified Oracles.DirectoryContent
 import qualified Oracles.LookupInPath
 import qualified Oracles.ModuleFiles
 import qualified Oracles.PackageData
@@ -15,6 +16,7 @@ oracleRules = do
     Oracles.ArgsHash.argsHashOracle
     Oracles.Config.configOracle
     Oracles.Dependencies.dependenciesOracles
+    Oracles.DirectoryContent.directoryContentOracle
     Oracles.LookupInPath.lookupInPathOracle
     Oracles.ModuleFiles.moduleFilesOracle
     Oracles.PackageData.packageDataOracle