[commit: ghc] wip/nfs-locking: Drop removeDirectoryIfExists. (ad53022)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 00:28:58 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