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

update transfer info and notify when exporting

Browse source 
Same as is done for all other transfers of content, so the webapp will
display progress bars etc.

This commit was sponsored by Anthony DeRobertis on Patreon.
This commit is contained in:
Joey Hess 2017-09-20 12:56:17 -04:00
parent c2833c955d
commit 28eba8e9c6
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 12 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
Command/Export.hs
View file

@ -22,6 +22,7 @@ import Types.Remote
import Types.Export
import Annex.Export
import Annex.Content
import Annex.Transfer
import Annex.CatFile
import Annex.LockFile
import Logs.Location
@ -30,6 +31,7 @@ import Database.Export
import Messages.Progress
import Config
import Utility.Tmp
import Utility.Metered
import qualified Data.ByteString.Lazy as L
import qualified Data.Map as M
@ -202,21 +204,25 @@ startExport r ea db cvar ti = do
stopUnless (liftIO $ notElem loc <$> getExportedLocation db (asKey ek)) $ do
showStart ("export " ++ name r) f
liftIO $ modifyMVar_ cvar (pure . const True)
next $ performExport r ea db ek (Git.LsTree.sha ti) loc
next $ performExport r ea db ek af (Git.LsTree.sha ti) loc
where
loc = mkExportLocation f
f = getTopFilePath $ Git.LsTree.file ti
f = getTopFilePath (Git.LsTree.file ti)
af = AssociatedFile (Just f)
performExport :: Remote -> ExportActions Annex -> ExportHandle -> ExportKey -> Sha -> ExportLocation -> CommandPerform
performExport r ea db ek contentsha loc = do
performExport :: Remote -> ExportActions Annex -> ExportHandle -> ExportKey -> AssociatedFile -> Sha -> ExportLocation -> CommandPerform
performExport r ea db ek af contentsha loc = do
let storer = storeExport ea
sent <- case ek of
AnnexKey k -> ifM (inAnnex k)
( metered Nothing k $ \m -> do
let rollback = void $
performUnexport r ea db [ek] loc
sendAnnex k rollback
(\f -> storer f k loc m)
notifyTransfer Upload af $
upload (uuid r) k af noRetry $ \pm -> do
let m' = combineMeterUpdate pm m
sendAnnex k rollback
(\f -> storer f k loc m')
, do
showNote "not available"
return False