From 99e62f2bb88ba907053305391eefb53369628045 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 20 Sep 2012 17:30:38 -0400
Subject: 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.
---
 Utility/Rsync.hs | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

(limited to 'Utility')

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
-- 
cgit v1.2.3