summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-05-21 13:03:46 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-05-21 13:03:46 -0400
commit75002b45b04961beca948dda19b9ab6439953001 (patch)
tree60a51d478464babced2b4471b18dbe846e8ac604 /Utility
parent75638200a08e25333530946597e30b8ae74743c4 (diff)
better nukefile
Fixed handling of case when file does not exist to work like it did before, and avoid an excess stat call.
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Directory.hs6
-rw-r--r--Utility/Exception.hs7
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