IO exception rework

ghc 7.4 comaplains about use of System.IO.Error to catch exceptions.
Ok, use Control.Exception, with variants specialized to only catch IO
exceptions.
This commit is contained in:
Joey Hess 2012-02-03 16:47:24 -04:00
parent 05f89123e0
commit 146c36ca54
14 changed files with 56 additions and 44 deletions

View file

@ -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

39
Utility/Exception.hs Normal file
View file

@ -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

View file

@ -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

View file

@ -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