better nukefile
Fixed handling of case when file does not exist to work like it did before, and avoid an excess stat call.
This commit is contained in:
parent
b78813af3a
commit
822a8c0ff8
2 changed files with 11 additions and 2 deletions
|
@ -93,8 +93,10 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
|
||||||
- Note that an exception is thrown if the file exists but
|
- Note that an exception is thrown if the file exists but
|
||||||
- cannot be removed. -}
|
- cannot be removed. -}
|
||||||
nukeFile :: FilePath -> IO ()
|
nukeFile :: FilePath -> IO ()
|
||||||
|
nukeFile file = void $ tryWhenExists go
|
||||||
|
where
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
nukeFile = removeLink
|
go = removeLink file
|
||||||
#else
|
#else
|
||||||
nukeFile = removeFile
|
go = removeFile file
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -12,6 +12,8 @@ module Utility.Exception where
|
||||||
import Prelude hiding (catch)
|
import Prelude hiding (catch)
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
import Control.Monad
|
||||||
|
import System.IO.Error (isDoesNotExistError)
|
||||||
|
|
||||||
{- Catches IO errors and returns a Bool -}
|
{- Catches IO errors and returns a Bool -}
|
||||||
catchBoolIO :: IO Bool -> IO Bool
|
catchBoolIO :: IO Bool -> IO Bool
|
||||||
|
@ -49,3 +51,8 @@ catchNonAsync a onerr = a `catches`
|
||||||
|
|
||||||
tryNonAsync :: IO a -> IO (Either SomeException a)
|
tryNonAsync :: IO a -> IO (Either SomeException a)
|
||||||
tryNonAsync a = (Right <$> a) `catchNonAsync` (return . Left)
|
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
|
||||||
|
|
Loading…
Reference in a new issue