[commit: ghc] wip/nfs-locking: Drop removeDirectoryIfExists. (ad53022)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 00:11:21 UTC 2017


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

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

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

commit ad53022e5f3da17d8b744b922c32756dba6408d2
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Thu May 5 03:52:19 2016 +0100

    Drop removeDirectoryIfExists.
    
    See #163.


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

ad53022e5f3da17d8b744b922c32756dba6408d2
 src/Base.hs              |  7 +------
 src/Oracles/PackageDb.hs |  2 +-
 src/Rules/Actions.hs     |  3 ++-
 src/Rules/Clean.hs       | 16 ++++++----------
 src/Rules/Gmp.hs         |  2 +-
 5 files changed, 11 insertions(+), 19 deletions(-)

diff --git a/src/Base.hs b/src/Base.hs
index 625dfd8..ccadd22 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -23,7 +23,7 @@ module Base (
     -- * Miscellaneous utilities
     minusOrd, intersectOrd, lookupAll, replaceEq, quote, replaceSeparators,
     decodeModule, encodeModule, unifyPath, (-/-), versionToInt,
-    removeFileIfExists, removeDirectoryIfExists, matchVersionedFilePath
+    removeFileIfExists, matchVersionedFilePath
     ) where
 
 import Control.Applicative
@@ -176,11 +176,6 @@ lookupAll (x:xs) (y:ys) = case compare x (fst y) of
 removeFileIfExists :: FilePath -> Action ()
 removeFileIfExists f = liftIO . whenM (IO.doesFileExist f) $ IO.removeFile f
 
--- | Remove a directory that doesn't necessarily exist
-removeDirectoryIfExists :: FilePath -> Action ()
-removeDirectoryIfExists d =
-    liftIO . whenM (IO.doesDirectoryExist d) $ IO.removeDirectoryRecursive d
-
 -- | Given a @prefix@ and a @suffix@ check whether a @filePath@ matches the
 -- template @prefix ++ version ++ suffix@ where @version@ is an arbitrary string
 -- comprising digits (@0-9@), dashes (@-@), and dots (@.@). Examples:
diff --git a/src/Oracles/PackageDb.hs b/src/Oracles/PackageDb.hs
index b644989..760f2a7 100644
--- a/src/Oracles/PackageDb.hs
+++ b/src/Oracles/PackageDb.hs
@@ -17,6 +17,6 @@ packageDbOracle = void $
         let dir  = packageDbDirectory stage
             file = dir -/- "package.cache"
         unlessM (liftIO $ IO.doesFileExist file) $ do
-            removeDirectoryIfExists dir
+            removeDirectory dir
             build $ Target (vanillaContext stage ghcPkg) (GhcPkg stage) [] [dir]
             putSuccess $ "| Successfully initialised " ++ dir
diff --git a/src/Rules/Actions.hs b/src/Rules/Actions.hs
index 32d2544..25bf72e 100644
--- a/src/Rules/Actions.hs
+++ b/src/Rules/Actions.hs
@@ -99,10 +99,11 @@ createDirectory dir = do
     putBuild $ "| Create directory " ++ dir
     liftIO $ IO.createDirectoryIfMissing True dir
 
+-- | Remove a directory that doesn't necessarily exist.
 removeDirectory :: FilePath -> Action ()
 removeDirectory dir = do
     putBuild $ "| Remove directory " ++ dir
-    removeDirectoryIfExists dir
+    liftIO . whenM (IO.doesDirectoryExist dir) $ IO.removeDirectoryRecursive dir
 
 -- Note, the source directory is untracked
 copyDirectory :: FilePath -> FilePath -> Action ()
diff --git a/src/Rules/Clean.hs b/src/Rules/Clean.hs
index ca5c062..f615e54 100644
--- a/src/Rules/Clean.hs
+++ b/src/Rules/Clean.hs
@@ -3,24 +3,20 @@ module Rules.Clean (cleanRules) where
 import Base
 import Context
 import Package
+import Rules.Actions
 import Rules.Generate
 import Settings.Packages
 import Settings.Paths
 import Settings.User
 import Stage
 
-clean :: FilePath -> Action ()
-clean dir = do
-    putBuild $ "| Remove files in " ++ dir ++ "..."
-    removeDirectoryIfExists dir
-
 cleanRules :: Rules ()
 cleanRules = do
     "clean" ~> do
-        forM_ [Stage0 ..] $ \stage -> clean (buildRootPath -/- stageString stage)
-        clean programInplacePath
-        clean "inplace/lib"
-        clean derivedConstantsPath
+        forM_ [Stage0 ..] $ removeDirectory . (buildRootPath -/-) . stageString
+        removeDirectory programInplacePath
+        removeDirectory "inplace/lib"
+        removeDirectory derivedConstantsPath
         forM_ includesDependencies $ \file -> do
             putBuild $ "| Remove " ++ file
             removeFileIfExists file
@@ -28,7 +24,7 @@ cleanRules = do
         forM_ knownPackages $ \pkg ->
             forM_ [Stage0 ..] $ \stage -> do
                 let dir = pkgPath pkg -/- contextDirectory (vanillaContext stage pkg)
-                removeDirectoryIfExists dir
+                quietly $ removeDirectory dir
         putBuild $ "| Remove Hadrian files..."
         removeFilesAfter buildRootPath ["//*"]
         putSuccess $ "| Done. "
diff --git a/src/Rules/Gmp.hs b/src/Rules/Gmp.hs
index d98bc3b..9cec3a3 100644
--- a/src/Rules/Gmp.hs
+++ b/src/Rules/Gmp.hs
@@ -52,7 +52,7 @@ gmpRules = do
     -- TODO: split into multiple rules
     gmpLibraryH %> \_ -> do
         when trackBuildSystem $ need [sourcePath -/- "Rules/Gmp.hs"]
-        removeDirectoryIfExists gmpBuildPath
+        removeDirectory gmpBuildPath
 
         -- We don't use system GMP on Windows. TODO: fix?
         windows  <- windowsHost



More information about the ghc-commits mailing list