From 7e592e1d6ed5e0b25b37215da7558c6324688d6f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 22 Nov 2013 11:16:03 -0400 Subject: 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 --- Utility/Exception.hs | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 59 insertions(+) create mode 100644 Utility/Exception.hs (limited to 'Utility/Exception.hs') 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 + - + - 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 -- cgit v1.2.3