add a progress callback to storeKey, and threaded it all the way through
Transfer info files are updated when the callback is called, updating the number of bytes transferred. Left unused p variables at every place the callback should be used. Which is rather a lot..
This commit is contained in:
parent
3c81d70c1b
commit
aff09a1f33
14 changed files with 75 additions and 59 deletions
|
@ -25,7 +25,7 @@ seek = [withKeys start]
|
|||
start :: Key -> CommandStart
|
||||
start key = ifM (inAnnex key)
|
||||
( error "key is already present in annex"
|
||||
, fieldTransfer Download key $ do
|
||||
, fieldTransfer Download key $ \p -> do
|
||||
ifM (getViaTmp key $ liftIO . rsyncServerReceive)
|
||||
( do
|
||||
-- forcibly quit after receiving one key,
|
||||
|
|
|
@ -12,6 +12,7 @@ import Command
|
|||
import Annex.Content
|
||||
import Utility.Rsync
|
||||
import Logs.Transfer
|
||||
import Types.Remote
|
||||
import qualified Fields
|
||||
|
||||
def :: [Command]
|
||||
|
@ -23,7 +24,7 @@ seek = [withKeys start]
|
|||
|
||||
start :: Key -> CommandStart
|
||||
start key = ifM (inAnnex key)
|
||||
( fieldTransfer Upload key $ do
|
||||
( fieldTransfer Upload key $ \p -> do
|
||||
file <- inRepo $ gitAnnexLocation key
|
||||
liftIO $ rsyncServerSend file
|
||||
, do
|
||||
|
@ -31,10 +32,11 @@ start key = ifM (inAnnex key)
|
|||
liftIO exitFailure
|
||||
)
|
||||
|
||||
fieldTransfer :: Direction -> Key -> Annex Bool -> CommandStart
|
||||
fieldTransfer :: Direction -> Key -> (ProgressCallback -> Annex Bool) -> CommandStart
|
||||
fieldTransfer direction key a = do
|
||||
afile <- Fields.getField Fields.associatedFile
|
||||
ok <- maybe a (\u -> runTransfer (Transfer direction (toUUID u) key) afile a)
|
||||
ok <- maybe (a $ const noop)
|
||||
(\u -> runTransfer (Transfer direction (toUUID u) key) afile a)
|
||||
=<< Fields.getField Fields.remoteUUID
|
||||
if ok
|
||||
then liftIO exitSuccess
|
||||
|
|
|
@ -43,8 +43,8 @@ start to from file key =
|
|||
|
||||
toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
|
||||
toPerform remote key file = next $
|
||||
upload (uuid remote) key file $ do
|
||||
ok <- Remote.storeKey remote key file
|
||||
upload (uuid remote) key file $ \p -> do
|
||||
ok <- Remote.storeKey remote key file p
|
||||
when ok $
|
||||
Remote.logStatus remote key InfoPresent
|
||||
return ok
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue