mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 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
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 Types.Export
import Annex.Export import Annex.Export
import Annex.Content import Annex.Content
import Annex.Transfer
import Annex.CatFile import Annex.CatFile
import Annex.LockFile import Annex.LockFile
import Logs.Location import Logs.Location
@ -30,6 +31,7 @@ import Database.Export
import Messages.Progress import Messages.Progress
import Config import Config
import Utility.Tmp import Utility.Tmp
import Utility.Metered
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.Map as M 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 stopUnless (liftIO $ notElem loc <$> getExportedLocation db (asKey ek)) $ do
showStart ("export " ++ name r) f showStart ("export " ++ name r) f
liftIO $ modifyMVar_ cvar (pure . const True) 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 where
loc = mkExportLocation f 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 :: Remote -> ExportActions Annex -> ExportHandle -> ExportKey -> AssociatedFile -> Sha -> ExportLocation -> CommandPerform
performExport r ea db ek contentsha loc = do performExport r ea db ek af contentsha loc = do
let storer = storeExport ea let storer = storeExport ea
sent <- case ek of sent <- case ek of
AnnexKey k -> ifM (inAnnex k) AnnexKey k -> ifM (inAnnex k)
( metered Nothing k $ \m -> do ( metered Nothing k $ \m -> do
let rollback = void $ let rollback = void $
performUnexport r ea db [ek] loc performUnexport r ea db [ek] loc
sendAnnex k rollback notifyTransfer Upload af $
(\f -> storer f k loc m) upload (uuid r) k af noRetry $ \pm -> do
let m' = combineMeterUpdate pm m
sendAnnex k rollback
(\f -> storer f k loc m')
, do , do
showNote "not available" showNote "not available"
return False return False