diff options
| -rw-r--r-- | Utility/Directory.hs | 6 | ||||
| -rw-r--r-- | Utility/Exception.hs | 7 |
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 |