Display progress meter in -J mode when copying from a local git repo, to a local...

Had everything available, just didn't combine the progress meter with the
other places progress is sent to update it. (And to a remote repo already
did show progress.)

Most special remotes should already display progress meters with -J,
same as without it. One exception to this is the web, since it relies on
wget/curl progress display without -J. Still todo..

diff --git a/Remote/Git.hs b/Remote/Git.hs
index c8ef1aee036c890e9501205196b1e7dacb51ccad..46b571a2ef87ad5197b6dfb2353248ecdf996701 100644 (file)
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -440,10 +440,10 @@ copyFromRemote' r key file dest meterupdate
                                        copier <- mkCopier hardlink params
                                        runTransfer (Transfer Download u key)
                                                file noRetry noObserver 
-                                               (\p -> copier object dest p checksuccess)
-       | Git.repoIsSsh (repo r) = unVerified $ feedprogressback $ \feeder -> do
+                                               (\p -> copier object dest (combineMeterUpdate p meterupdate) checksuccess)
+       | Git.repoIsSsh (repo r) = unVerified $ feedprogressback $ \p -> do
                direct <- isDirect
-               Ssh.rsyncHelper (Just feeder) 
+               Ssh.rsyncHelper (Just (combineMeterUpdate meterupdate p))
                        =<< Ssh.rsyncParamsRemote direct r Download key dest file
        | Git.repoIsHttp (repo r) = unVerified $ Annex.Content.downloadUrl (keyUrls r key) dest
        | otherwise = error "copying from non-ssh, non-http remote not supported"
@@ -533,17 +533,19 @@ copyFromRemoteCheap _ _ _ _ = return False
 
 {- Tries to copy a key's content to a remote's annex. -}
 copyToRemote :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-copyToRemote r key file p = concurrentMetered (Just p) key file $ copyToRemote' r key file
+copyToRemote r key file meterupdate = 
+       concurrentMetered (Just meterupdate) key file $
+               copyToRemote' r key file
 
 copyToRemote' :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-copyToRemote' r key file p
+copyToRemote' r key file meterupdate
        | not $ Git.repoIsUrl (repo r) =
                guardUsable (repo r) (return False) $ commitOnCleanup r $
                        copylocal =<< Annex.Content.prepSendAnnex key
        | Git.repoIsSsh (repo r) = commitOnCleanup r $
                Annex.Content.sendAnnex key noop $ \object -> do
                        direct <- isDirect
-                       Ssh.rsyncHelper (Just p)
+                       Ssh.rsyncHelper (Just meterupdate)
                                =<< Ssh.rsyncParamsRemote direct r Upload key object file
        | otherwise = error "copying to non-ssh repo not supported"
   where
@@ -563,10 +565,11 @@ copyToRemote' r key file p
                                ensureInitialized
                                copier <- mkCopier hardlink params
                                let verify = Annex.Content.RemoteVerify r
-                               runTransfer (Transfer Download u key) file noRetry noObserver $ const $
-                                       Annex.Content.saveState True `after`
+                               runTransfer (Transfer Download u key) file noRetry noObserver $ \p ->
+                                       let p' = combineMeterUpdate meterupdate p
+                                       in Annex.Content.saveState True `after`
                                                Annex.Content.getViaTmp verify key
-                                                       (\dest -> copier object dest p (liftIO checksuccessio))
+                                                       (\dest -> copier object dest p' (liftIO checksuccessio))
                        )
 
 fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)

diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index c34e931a431b3de9666bbb375a47f8fc985085ee..60dcf7c74cca4afaa3fa87cf39b74982d18b87dc 100644 (file)
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -29,6 +29,9 @@ type MeterUpdate = (BytesProcessed -> IO ())
 nullMeterUpdate :: MeterUpdate
 nullMeterUpdate _ = return ()
 
+combineMeterUpdate :: MeterUpdate -> MeterUpdate -> MeterUpdate
+combineMeterUpdate a b = \n -> a n >> b n
+
 {- Total number of bytes processed so far. -}
 newtype BytesProcessed = BytesProcessed Integer
        deriving (Eq, Ord, Show)

diff --git a/debian/changelog b/debian/changelog
index 79598575dcdc69858785b43df5d06c0233f428d9..53a20717ca54b87bae3289b0af714c9ec84a5d4f 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,6 +1,8 @@
 git-annex (5.20151117) UNRELEASED; urgency=medium
 
   * Build with -j1 again to get reproducible build.
+  * Display progress meter in -J mode when copying from a local git repo,
+    to a local git repo, and from a remote git repo.
 
  -- Joey Hess <id@joeyh.name>  Mon, 16 Nov 2015 16:49:34 -0400