generalize catchHardwareFault to catchIOErrorType

3 files changed, 18 insertions, 18 deletions

diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs
index 78d527920..da29c4ae4 100644
--- a/Assistant/Threads/XMPPClient.hs
+++ b/Assistant/Threads/XMPPClient.hs
@@ -7,7 +7,7 @@
 
 module Assistant.Threads.XMPPClient where
 
-import Assistant.Common
+import Assistant.Common hiding (ProtocolError)
 import Assistant.XMPP
 import Assistant.XMPP.Client
 import Assistant.NetMessager
diff --git a/Backend/Hash.hs b/Backend/Hash.hs
index 7f61c4f3e..7967b1714 100644
--- a/Backend/Hash.hs
+++ b/Backend/Hash.hs
@@ -108,17 +108,16 @@ selectExtension f
 
 {- A key's checksum is checked during fsck. -}
 checkKeyChecksum :: Hash -> Key -> FilePath -> Annex Bool
-checkKeyChecksum hash key file = go `catchHardwareFault` hwfault
+checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do
+	fast <- Annex.getState Annex.fast
+	mstat <- liftIO $ catchMaybeIO $ getFileStatus file
+	case (mstat, fast) of
+		(Just stat, False) -> do
+			filesize <- liftIO $ getFileSize' file stat
+			showAction "checksum"
+			check <$> hashFile hash file filesize
+		_ -> return True
   where
-	go = do
-		fast <- Annex.getState Annex.fast
-		mstat <- liftIO $ catchMaybeIO $ getFileStatus file
-		case (mstat, fast) of
-			(Just stat, False) -> do
-				filesize <- liftIO $ getFileSize' file stat
-				showAction "checksum"
-				check <$> hashFile hash file filesize
-			_ -> return True
 	expected = keyHash key
 	check s
 		| s == expected = True
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
index 13000e033..8b110ae6d 100644
--- a/Utility/Exception.hs
+++ b/Utility/Exception.hs
@@ -20,7 +20,8 @@ module Utility.Exception (
 	catchNonAsync,
 	tryNonAsync,
 	tryWhenExists,
-	catchHardwareFault,
+	catchIOErrorType,
+	IOErrorType(..)
 ) where
 
 import Control.Monad.Catch as X hiding (Handler)
@@ -88,11 +89,11 @@ 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
+{- Catches only IO exceptions of a particular type.
+ - Ie, use HardwareFault to catch disk IO errors. -}
+catchIOErrorType :: MonadCatch m => IOErrorType -> (IOException -> m a) -> m a -> m a
+catchIOErrorType errtype onmatchingerr a = catchIO a onlymatching
   where
-	onlyhw e
-		| ioeGetErrorType e == HardwareFault = onhardwareerr e
+	onlymatching e
+		| ioeGetErrorType e == errtype = onmatchingerr e
 		| otherwise = throwM e