summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-05-27 16:36:54 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-05-27 16:36:54 -0400
commitfbd5182829d570231f911cb5ac7919d6333ccddc (patch)
treeebe4f67c1f86552a2c1d552ef1228047e29f4b4e /Utility
parent7f2181dda5e5acd6b209a58b534d1d8b128c79fe (diff)
implment catchHardwareFault
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Exception.hs16
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