diff options
author | Joey Hess <joeyh@debian.org> | 2013-11-22 11:16:03 -0400 |
---|---|---|
committer | Joey Hess <joeyh@debian.org> | 2013-11-22 11:16:03 -0400 |
commit | 7e592e1d6ed5e0b25b37215da7558c6324688d6f (patch) | |
tree | 75a86ff02e9311bcff817f2dcfe9b0a6ca1b5708 /Utility/Exception.hs | |
download | git-repair-7e592e1d6ed5e0b25b37215da7558c6324688d6f.tar.gz |
git-repair (1.20131122) unstable; urgency=low
* Added test mode, which can be used to randomly corrupt test
repositories, in reproducible ways, which allows easy
corruption-driven-development.
* Improve repair code in the case where the index file is corrupt,
and this hides other problems.
* Write a dummy .git/HEAD if the file is missing or corrupt, as
git otherwise will not treat the repository as a git repo.
* Improve fsck code to find badly corrupted objects that crash git fsck
before it can complain about them.
* Fixed crashes on bad file encodings.
* Can now run 10000 tests (git-repair --test -n 10000 --force)
with 0 failures.
# imported from the archive
Diffstat (limited to 'Utility/Exception.hs')
-rw-r--r-- | Utility/Exception.hs | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/Utility/Exception.hs b/Utility/Exception.hs new file mode 100644 index 0000000..cf2c615 --- /dev/null +++ b/Utility/Exception.hs @@ -0,0 +1,59 @@ +{- Simple IO exception handling (and some more) + - + - Copyright 2011-2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE ScopedTypeVariables #-} + +module Utility.Exception where + +import Control.Exception +import qualified Control.Exception as E +import Control.Applicative +import Control.Monad +import System.IO.Error (isDoesNotExistError) +import Utility.Data + +{- Catches IO errors and returns a Bool -} +catchBoolIO :: IO Bool -> IO Bool +catchBoolIO a = catchDefaultIO False a + +{- Catches IO errors and returns a Maybe -} +catchMaybeIO :: IO a -> IO (Maybe a) +catchMaybeIO a = catchDefaultIO Nothing $ Just <$> a + +{- Catches IO errors and returns a default value. -} +catchDefaultIO :: a -> IO a -> IO a +catchDefaultIO def a = catchIO a (const $ return def) + +{- Catches IO errors and returns the error message. -} +catchMsgIO :: IO a -> IO (Either String a) +catchMsgIO a = either (Left . show) Right <$> tryIO a + +{- catch specialized for IO errors only -} +catchIO :: IO a -> (IOException -> IO a) -> IO a +catchIO = E.catch + +{- try specialized for IO errors only -} +tryIO :: IO a -> IO (Either IOException a) +tryIO = try + +{- Catches all exceptions except for async exceptions. + - This is often better to use than catching them all, so that + - ThreadKilled and UserInterrupt get through. + -} +catchNonAsync :: IO a -> (SomeException -> IO a) -> IO a +catchNonAsync a onerr = a `catches` + [ Handler (\ (e :: AsyncException) -> throw e) + , Handler (\ (e :: SomeException) -> onerr e) + ] + +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 = eitherToMaybe <$> + tryJust (guard . isDoesNotExistError) a |