diff options
Diffstat (limited to 'Utility')
| -rw-r--r-- | Utility/Directory.hs | 8 | ||||
| -rw-r--r-- | Utility/Exception.hs | 39 | ||||
| -rw-r--r-- | Utility/Misc.hs | 21 | ||||
| -rw-r--r-- | Utility/TempFile.hs | 2 |
4 files changed, 44 insertions, 26 deletions
diff --git a/Utility/Directory.hs b/Utility/Directory.hs index b5fedb9c7..e7b7c442b 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -16,11 +16,12 @@ import Control.Monad.IfElse import Utility.SafeCommand import Utility.TempFile +import Utility.Exception {- Moves one filename to another. - First tries a rename, but falls back to moving across devices if needed. -} moveFile :: FilePath -> FilePath -> IO () -moveFile src dest = try (rename src dest) >>= onrename +moveFile src dest = tryIO (rename src dest) >>= onrename where onrename (Right _) = return () onrename (Left e) @@ -40,11 +41,10 @@ moveFile src dest = try (rename src dest) >>= onrename Param src, Param tmp] unless ok $ do -- delete any partial - _ <- try $ - removeFile tmp + _ <- tryIO $ removeFile tmp rethrow isdir f = do - r <- try (getFileStatus f) + r <- tryIO $ getFileStatus f case r of (Left _) -> return False (Right s) -> return $ isDirectory s diff --git a/Utility/Exception.hs b/Utility/Exception.hs new file mode 100644 index 000000000..7b6c9c999 --- /dev/null +++ b/Utility/Exception.hs @@ -0,0 +1,39 @@ +{- Simple IO exception handling + - + - Copyright 2011-2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.Exception where + +import Prelude hiding (catch) +import Control.Exception +import Control.Applicative + +{- Catches IO errors and returns a Bool -} +catchBoolIO :: IO Bool -> IO Bool +catchBoolIO a = catchDefaultIO a False + +{- Catches IO errors and returns a Maybe -} +catchMaybeIO :: IO a -> IO (Maybe a) +catchMaybeIO a = catchDefaultIO (Just <$> a) Nothing + +{- Catches IO errors and returns a default value. -} +catchDefaultIO :: IO a -> a -> IO a +catchDefaultIO a def = catchIO a (const $ return def) + +{- Catches IO errors and returns the error message. -} +catchMsgIO :: IO a -> IO (Either String a) +catchMsgIO a = dispatch <$> tryIO a + where + dispatch (Left e) = Left $ show e + dispatch (Right v) = Right v + +{- catch specialized for IO errors only -} +catchIO :: IO a -> (IOException -> IO a) -> IO a +catchIO = catch + +{- try specialized for IO errors only -} +tryIO :: IO a -> IO (Either IOException a) +tryIO = try diff --git a/Utility/Misc.hs b/Utility/Misc.hs index c9bfcb953..3ac5ca5c0 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -8,9 +8,7 @@ module Utility.Misc where import System.IO -import System.IO.Error (try) import Control.Monad -import Control.Applicative {- A version of hgetContents that is not lazy. Ensures file is - all read before it gets closed. -} @@ -37,22 +35,3 @@ separate c l = unbreak $ break c l {- Breaks out the first line. -} firstLine :: String-> String firstLine = takeWhile (/= '\n') - -{- Catches IO errors and returns a Bool -} -catchBoolIO :: IO Bool -> IO Bool -catchBoolIO a = catchDefaultIO a False - -{- Catches IO errors and returns a Maybe -} -catchMaybeIO :: IO a -> IO (Maybe a) -catchMaybeIO a = catchDefaultIO (Just <$> a) Nothing - -{- Catches IO errors and returns a default value. -} -catchDefaultIO :: IO a -> a -> IO a -catchDefaultIO a def = catch a (const $ return def) - -{- Catches IO errors and returns the error message. -} -catchMsgIO :: IO a -> IO (Either String a) -catchMsgIO a = dispatch <$> try a - where - dispatch (Left e) = Left $ show e - dispatch (Right v) = Right v diff --git a/Utility/TempFile.hs b/Utility/TempFile.hs index 469d52e8c..4dcbf1cca 100644 --- a/Utility/TempFile.hs +++ b/Utility/TempFile.hs @@ -12,7 +12,7 @@ import System.IO import System.Posix.Process hiding (executeFile) import System.Directory -import Utility.Misc +import Utility.Exception import Utility.Path {- Runs an action like writeFile, writing to a temp file first and |