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

make storeExport throw exceptions

Browse source
This commit is contained in:
Joey Hess 2020-05-15 12:17:15 -04:00
parent dc7dc1e179
commit 4814b444dd
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
11 changed files with 99 additions and 105 deletions
Download patch file Download diff file Expand all files Collapse all files

25
Remote/Helper/ExportImport.hs
View file

@ -36,15 +36,15 @@ instance HasExportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bo
instance HasExportUnsupported (ExportActions Annex) where
exportUnsupported = ExportActions
{ storeExport = \_ _ _ _ -> do
warning "store export is unsupported"
return False
{ storeExport = nope
, retrieveExport = \_ _ _ _ -> return False
, checkPresentExport = \_ _ -> return False
, removeExport = \_ _ -> return False
, removeExportDirectory = Just $ \_ -> return False
, renameExport = \_ _ _ -> return Nothing
}
where
nope = giveup "export not supported"
-- | Use for remotes that do not support imports.
class HasImportUnsupported a where
@ -57,11 +57,13 @@ instance HasImportUnsupported (ImportActions Annex) where
importUnsupported = ImportActions
{ listImportableContents = return Nothing
, retrieveExportWithContentIdentifier = \_ _ _ _ _ -> return Nothing
, storeExportWithContentIdentifier = \_ _ _ _ _ -> return (Left "import not supported")
, storeExportWithContentIdentifier = nope
, removeExportWithContentIdentifier = \_ _ _ -> return False
, removeExportDirectoryWhenEmpty = Just $ \_ -> return False
, checkPresentExportWithContentIdentifier = \_ _ _ -> return False
}
where
nope = giveup "import not supported"
exportIsSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool
exportIsSupported = \_ _ -> return True
@ -151,16 +153,11 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
oldks <- liftIO $ Export.getExportTreeKey exportdb loc
oldcids <- liftIO $ concat
<$> mapM (ContentIdentifier.getContentIdentifiers db rs) oldks
storeExportWithContentIdentifier (importActions r') f k loc oldcids p >>= \case
Left err -> do
warning err
return False
Right newcid -> do
withExclusiveLock gitAnnexContentIdentifierLock $ do
liftIO $ ContentIdentifier.recordContentIdentifier db rs newcid k
liftIO $ ContentIdentifier.flushDbQueue db
recordContentIdentifier rs newcid k
return True
newcid <- storeExportWithContentIdentifier (importActions r') f k loc oldcids p
withExclusiveLock gitAnnexContentIdentifierLock $ do
liftIO $ ContentIdentifier.recordContentIdentifier db rs newcid k
liftIO $ ContentIdentifier.flushDbQueue db
recordContentIdentifier rs newcid k
, removeExport = \k loc ->
removeExportWithContentIdentifier (importActions r') k loc
=<< keycids k