mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

generalize catchHardwareFault to catchIOErrorType

Browse source
This commit is contained in:
Joey Hess 2015-12-06 16:26:38 -04:00
parent 99fa2b5716
commit a0fcb8ec93
Failed to extract signature
4 changed files with 19 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Assistant/Threads/XMPPClient.hs
View file

@ -7,7 +7,7 @@
module Assistant.Threads.XMPPClient where module Assistant.Threads.XMPPClient where
import Assistant.Common import Assistant.Common hiding (ProtocolError)
import Assistant.XMPP import Assistant.XMPP
import Assistant.XMPP.Client import Assistant.XMPP.Client
import Assistant.NetMessager import Assistant.NetMessager

2
Assistant/WebApp/Common.hs
View file

@ -13,5 +13,5 @@ import Assistant.WebApp.Page as X
import Assistant.WebApp.Form as X import Assistant.WebApp.Form as X
import Assistant.WebApp.Types as X import Assistant.WebApp.Types as X
import Assistant.WebApp.RepoId as X import Assistant.WebApp.RepoId as X
import Utility.Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option) import Utility.Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option, PermissionDenied)
import Data.Text as X (Text) import Data.Text as X (Text)

5
Backend/Hash.hs
View file

@ -108,9 +108,7 @@ selectExtension f
{- A key's checksum is checked during fsck. -} {- A key's checksum is checked during fsck. -}
checkKeyChecksum :: Hash -> Key -> FilePath -> Annex Bool checkKeyChecksum :: Hash -> Key -> FilePath -> Annex Bool
checkKeyChecksum hash key file = go `catchHardwareFault` hwfault checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do
where
go = do
fast <- Annex.getState Annex.fast fast <- Annex.getState Annex.fast
mstat <- liftIO $ catchMaybeIO $ getFileStatus file mstat <- liftIO $ catchMaybeIO $ getFileStatus file
case (mstat, fast) of case (mstat, fast) of
@ -119,6 +117,7 @@ checkKeyChecksum hash key file = go `catchHardwareFault` hwfault
showAction "checksum" showAction "checksum"
check <$> hashFile hash file filesize check <$> hashFile hash file filesize
_ -> return True _ -> return True
where
expected = keyHash key expected = keyHash key
check s check s
| s == expected = True | s == expected = True

15
Utility/Exception.hs
View file

@ -20,7 +20,8 @@ module Utility.Exception (
catchNonAsync, catchNonAsync,
tryNonAsync, tryNonAsync,
tryWhenExists, tryWhenExists,
catchHardwareFault, catchIOErrorType,
IOErrorType(..)
) where ) where
import Control.Monad.Catch as X hiding (Handler) import Control.Monad.Catch as X hiding (Handler)
@ -88,11 +89,11 @@ tryWhenExists a = do
v <- tryJust (guard . isDoesNotExistError) a v <- tryJust (guard . isDoesNotExistError) a
return (eitherToMaybe v) return (eitherToMaybe v)
{- Catches only exceptions caused by hardware faults. {- Catches only IO exceptions of a particular type.
- Ie, disk IO error. -} - Ie, use HardwareFault to catch disk IO errors. -}
catchHardwareFault :: MonadCatch m => m a -> (IOException -> m a) -> m a catchIOErrorType :: MonadCatch m => IOErrorType -> (IOException -> m a) -> m a -> m a
catchHardwareFault a onhardwareerr = catchIO a onlyhw catchIOErrorType errtype onmatchingerr a = catchIO a onlymatching
where where
onlyhw e onlymatching e
| ioeGetErrorType e == HardwareFault = onhardwareerr e | ioeGetErrorType e == errtype = onmatchingerr e
| otherwise = throwM e | otherwise = throwM e