Drop removeDirectoryIfExists.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Thu, 5 May 2016 02:52:19 +0000 (03:52 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Thu, 5 May 2016 02:52:19 +0000 (03:52 +0100)
See #163.

src/Base.hs
src/Oracles/PackageDb.hs
src/Rules/Actions.hs
src/Rules/Clean.hs
src/Rules/Gmp.hs

index 625dfd8..ccadd22 100644 (file)
@@ -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:
index b644989..760f2a7 100644 (file)
@@ -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
index 32d2544..25bf72e 100644 (file)
@@ -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 ()
index ca5c062..f615e54 100644 (file)
@@ -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. "
index d98bc3b..9cec3a3 100644 (file)
@@ -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