diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2015-05-27 16:36:54 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2015-05-27 16:36:54 -0400 |
| commit | fbd5182829d570231f911cb5ac7919d6333ccddc (patch) | |
| tree | ebe4f67c1f86552a2c1d552ef1228047e29f4b4e /Utility/Exception.hs | |
| parent | 7f2181dda5e5acd6b209a58b534d1d8b128c79fe (diff) | |
implment catchHardwareFault
Diffstat (limited to 'Utility/Exception.hs')
| -rw-r--r-- | Utility/Exception.hs | 16 |
1 files changed, 14 insertions, 2 deletions
diff --git a/Utility/Exception.hs b/Utility/Exception.hs index 9d4236c47..30bcc9245 100644 --- a/Utility/Exception.hs +++ b/Utility/Exception.hs @@ -1,6 +1,6 @@ {- Simple IO exception handling (and some more) - - - Copyright 2011-2014 Joey Hess <id@joeyh.name> + - Copyright 2011-2015 Joey Hess <id@joeyh.name> - - License: BSD-2-clause -} @@ -20,6 +20,7 @@ module Utility.Exception ( catchNonAsync, tryNonAsync, tryWhenExists, + catchHardwareFault, ) where import Control.Monad.Catch as X hiding (Handler) @@ -27,7 +28,9 @@ import qualified Control.Monad.Catch as M import Control.Exception (IOException, AsyncException) import Control.Monad import Control.Monad.IO.Class (liftIO, MonadIO) -import System.IO.Error (isDoesNotExistError) +import System.IO.Error (isDoesNotExistError, ioeGetErrorType) +import GHC.IO.Exception (IOErrorType(..)) + import Utility.Data {- Catches IO errors and returns a Bool -} @@ -87,3 +90,12 @@ tryWhenExists :: MonadCatch m => m a -> m (Maybe a) tryWhenExists a = do v <- tryJust (guard . isDoesNotExistError) a return (eitherToMaybe v) + +{- Catches only exceptions caused by hardware faults. + - Ie, disk IO error. -} +catchHardwareFault :: MonadCatch m => m a -> (IOException -> m a) -> m a +catchHardwareFault a onhardwareerr = catchIO a onlyhw + where + onlyhw e + | ioeGetErrorType e == HardwareFault = onhardwareerr e + | otherwise = throwM e |