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

pushed checkPresent exception handling out of Remote implementations

Browse source 
I tend to prefer moving toward explicit exception handling, not away from
it, but in this case, I think there are good reasons to let checkPresent
throw exceptions:

1. They can all be caught in one place (Remote.hasKey), and we know
   every possible exception is caught there now, which we didn't before.
2. It simplified the code of the Remotes. I think it makes sense for
   Remotes to be able to be implemented without needing to worry about
   catching exceptions inside them. (Mostly.)
3. Types.StoreRetrieve.Preparer can only work on things that return a
   Bool, which all the other relevant remote methods already did.
   I do not see a good way to generalize that type; my previous attempts
   failed miserably.
This commit is contained in:
Joey Hess 2014-08-06 13:45:19 -04:00
parent 781833b16f
commit b4cf22a388
24 changed files with 167 additions and 163 deletions
Download patch file Download diff file Expand all files Collapse all files

14
Remote/GCrypt.hs
View file

@ -46,7 +46,6 @@ import Utility.Tmp
import Logs.Remote
import Logs.Transfer
import Utility.Gpg
import Utility.FileMode
remote :: RemoteType
remote = RemoteType {
@ -109,8 +108,8 @@ gen' r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = \_ _ -> return False
, removeKey = remove this rsyncopts
, hasKey = checkPresent this rsyncopts
, hasKeyCheap = repoCheap r
, checkPresent = checkKey this rsyncopts
, checkPresentCheap = repoCheap r
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
@ -342,16 +341,15 @@ remove r rsyncopts k
removersync = Remote.Rsync.remove rsyncopts k
removeshell = Ssh.dropKey (repo r) k
checkPresent :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex (Either String Bool)
checkPresent r rsyncopts k
checkKey :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex Bool
checkKey r rsyncopts k
| not $ Git.repoIsUrl (repo r) =
guardUsable (repo r) (cantCheck $ repo r) $
liftIO $ catchDefaultIO (cantCheck $ repo r) $
Right <$> doesFileExist (gCryptLocation r k)
liftIO $ doesFileExist (gCryptLocation r k)
| Git.repoIsSsh (repo r) = shellOrRsync r checkshell checkrsync
| otherwise = unsupportedUrl
where
checkrsync = Remote.Rsync.checkPresent (repo r) rsyncopts k
checkrsync = Remote.Rsync.checkKey (repo r) rsyncopts k
checkshell = Ssh.inAnnex (repo r) k
{- Annexed objects are hashed using lower-case directories for max