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

convert removeExportDirectory to throw exception

Browse source 
Part of ongoing transition to make remote methods
throw exceptions, rather than silently hide them.

This commit was sponsored by Ilya Shlyakhter on Patreon.
This commit is contained in:
Joey Hess 2020-05-15 14:32:45 -04:00
parent 0a9a3ed1c3
commit 037440ef36
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
9 changed files with 38 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

24
Remote/External.hs
View file

@ -331,18 +331,19 @@ removeExportM external k loc = either giveup return =<< go
Left $ "REMOVEEXPORT not implemented by external special remote"
_ -> Nothing
removeExportDirectoryM :: External -> ExportDirectory -> Annex Bool
removeExportDirectoryM external dir = safely $
handleRequest external req Nothing $ \resp -> case resp of
REMOVEEXPORTDIRECTORY_SUCCESS -> result True
REMOVEEXPORTDIRECTORY_FAILURE -> result False
UNSUPPORTED_REQUEST -> result True
_ -> Nothing
removeExportDirectoryM :: External -> ExportDirectory -> Annex ()
removeExportDirectoryM external dir = either giveup return =<< go
where
go = handleRequest external req Nothing $ \resp -> case resp of
REMOVEEXPORTDIRECTORY_SUCCESS -> result $ Right ()
REMOVEEXPORTDIRECTORY_FAILURE -> result $
Left "failed to remove directory"
UNSUPPORTED_REQUEST -> result $ Right ()
_ -> Nothing
req = REMOVEEXPORTDIRECTORY dir
renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
renameExportM external k src dest = safely' (Just False) $
renameExportM external k src dest = safely (Just False) $
handleRequestExport external src req k Nothing $ \resp -> case resp of
RENAMEEXPORT_SUCCESS k'
| k' == k -> result (Just True)
@ -353,11 +354,8 @@ renameExportM external k src dest = safely' (Just False) $
where
req sk = RENAMEEXPORT sk dest
safely :: Annex Bool -> Annex Bool
safely = safely' False
safely' :: a -> Annex a -> Annex a
safely' onerr a = go =<< tryNonAsync a
safely :: a -> Annex a -> Annex a
safely onerr a = go =<< tryNonAsync a
where
go (Right r) = return r
go (Left e) = do