better nukefile

Fixed handling of case when file does not exist to work like it did before,
and avoid an excess stat call.

2 files changed, 11 insertions, 2 deletions

diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index 0a7690b44..13e6168cb 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -93,8 +93,10 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
  - Note that an exception is thrown if the file exists but
  - cannot be removed. -}
 nukeFile :: FilePath -> IO ()
+nukeFile file = void $ tryWhenExists go
+  where
 #ifndef mingw32_HOST_OS
-nukeFile = removeLink
+	go = removeLink file
 #else
-nukeFile = removeFile
+	go = removeFile file
 #endif
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
index 45f2aecec..bc928e18e 100644
--- a/Utility/Exception.hs
+++ b/Utility/Exception.hs
@@ -12,6 +12,8 @@ module Utility.Exception where
 import Prelude hiding (catch)
 import Control.Exception
 import Control.Applicative
+import Control.Monad
+import System.IO.Error (isDoesNotExistError)
 
 {- Catches IO errors and returns a Bool -}
 catchBoolIO :: IO Bool -> IO Bool
@@ -49,3 +51,8 @@ catchNonAsync a onerr = a `catches`
 
 tryNonAsync :: IO a -> IO (Either SomeException a)
 tryNonAsync a = (Right <$> a) `catchNonAsync` (return . Left)
+
+{- Catches only DoesNotExist exceptions, and lets all others through. -}
+tryWhenExists :: IO a -> IO (Maybe a)
+tryWhenExists a = either (const Nothing) Just <$>
+	tryJust (guard . isDoesNotExistError) a