[commit: ghc] wip/nfs-locking: Simplify (f52e582)

[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/f52e582d9cc21ad369411dc7bc832332e97ff224/ghc

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

commit f52e582d9cc21ad369411dc7bc832332e97ff224
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sun Oct 23 00:41:23 2016 +0100

    Simplify
    
    See #265


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

f52e582d9cc21ad369411dc7bc832332e97ff224
 src/Oracles/DirectoryContent.hs | 41 ++++++++++++++++++-----------------------
 src/Rules/Actions.hs            | 13 ++++++-------
 2 files changed, 24 insertions(+), 30 deletions(-)

diff --git a/src/Oracles/DirectoryContent.hs b/src/Oracles/DirectoryContent.hs
index 45afa92..3139c6c 100644
--- a/src/Oracles/DirectoryContent.hs
+++ b/src/Oracles/DirectoryContent.hs
@@ -1,39 +1,34 @@
 {-# 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
diff --git a/src/Rules/Actions.hs b/src/Rules/Actions.hs
index e30bc01..cccda24 100644
--- a/src/Rules/Actions.hs
+++ b/src/Rules/Actions.hs
@@ -45,8 +45,7 @@ customBuild rs opts target at 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 ()