avoid calling the progress callback when the bytes sent have not changed

Does rsync stall and update its progress display? Dunno, but this was an
easy optimisation to throw in.

1 files changed, 8 insertions, 4 deletions

diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs
index 1b022c184..08caeb12b 100644
--- a/Utility/Rsync.hs
+++ b/Utility/Rsync.hs
@@ -54,10 +54,10 @@ rsync = boolSystem "rsync"
  -}
 rsyncProgress :: (Integer -> IO ()) -> [CommandParam] -> IO Bool
 rsyncProgress callback params = catchBoolIO $
-	withHandle StdoutHandle createProcessSuccess p (feedprogress [])
+	withHandle StdoutHandle createProcessSuccess p (feedprogress 0 [])
 	where
 		p = proc "rsync" (toCommand params)
-		feedprogress buf h = do
+		feedprogress prev buf h = do
 			s <- hGetSomeString h 80
 			if null s
 				then return True
@@ -65,8 +65,12 @@ rsyncProgress callback params = catchBoolIO $
 					putStr s
 					hFlush stdout
 					let (mbytes, buf') = parseRsyncProgress (buf++s)
-					maybe noop callback mbytes
-					feedprogress buf' h
+					case mbytes of
+						Nothing -> feedprogress prev buf' h
+						(Just bytes) -> do
+							when (bytes /= prev) $
+								callback bytes
+							feedprogress bytes buf' h
 
 {- Checks if an rsync url involves the remote shell (ssh or rsh).
  - Use of such urls with rsync requires additional shell