summaryrefslogtreecommitdiff
path: root/src/Utility/Exception.hs
diff options
context:
space:
mode:
authorJoey Hess2015-09-13 13:39:18 -0400
committerJoey Hess2015-09-13 13:39:31 -0400
commit4125916b67126a0cf17fe5b382a1f37cceec2760 (patch)
treef9128e91a5eef2819676ba14a247667c4fa1d8bd /src/Utility/Exception.hs
parentf256b24aa87409a599b388f0a7848aa9abecaa7f (diff)
merge from git-annex
Diffstat (limited to 'src/Utility/Exception.hs')
-rw-r--r--src/Utility/Exception.hs16
1 files changed, 14 insertions, 2 deletions
diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs
index a1f96615..13000e03 100644
--- a/src/Utility/Exception.hs
+++ b/src/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 -}
@@ -84,3 +87,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