refactor

Utility/Metered.hs

@@ -143,3 +143,36 @@ defaultChunkSize = 32 * k - chunkOverhead
   where
 	k = 1024
 	chunkOverhead = 2 * sizeOf (undefined :: Int) -- GHC specific
+
+{- Parses the String looking for a command's progress output, and returns
+ - Maybe the number of bytes rsynced so far, and any any remainder of the
+ - string that could be an incomplete progress output. That remainder
+ - should be prepended to future output, and fed back in. This interface
+ - allows the command's output to be read in any desired size chunk, or
+ - even one character at a time.
+ -}
+type ProgressParser = String -> (Maybe BytesProcessed, String)
+
+{- Runs a command and runs a ProgressParser on its output, in order
+ - to update the meter. The command's output is also sent to stdout. -}
+commandMeter :: ProgressParser -> MeterUpdate -> FilePath -> [CommandParam] -> IO Bool
+commandMeter progressparser meterupdate cmd params = liftIO $ catchBoolIO $
+	withHandle StdoutHandle createProcessSuccess p $
+		feedprogress zeroBytesProcessed []
+  where
+	p = proc cmd (toCommand params)
+
+	feedprogress prev buf h = do
+		s <- hGetSomeString h 80
+		if null s
+			then return True
+			else do
+				putStr s
+				hFlush stdout
+				let (mbytes, buf') = progressparser (buf++s)
+				case mbytes of
+					Nothing -> feedprogress prev buf' h
+					(Just bytes) -> do
+						when (bytes /= prev) $
+							meterupdate bytes
+						feedprogress bytes buf' h

Utility/Rsync.hs

@@ -60,31 +60,6 @@ rsyncParamsFixup = map fixup
 	fixup (File f) = File (toCygPath f)
 	fixup p = p
 
-{- Runs rsync, but intercepts its progress output and updates a meter.
- - The progress output is also output to stdout. 
- -
- - The params must enable rsync's --progress mode for this to work.
- -}
-rsyncProgress :: MeterUpdate -> [CommandParam] -> IO Bool
-rsyncProgress meterupdate params = catchBoolIO $ 
-	withHandle StdoutHandle createProcessSuccess p (feedprogress 0 [])
-  where
-	p = proc "rsync" (toCommand $ rsyncParamsFixup params)
-	feedprogress prev buf h = do
-		s <- hGetSomeString h 80
-		if null s
-			then return True
-			else do
-				putStr s
-				hFlush stdout
-				let (mbytes, buf') = parseRsyncProgress (buf++s)
-				case mbytes of
-					Nothing -> feedprogress prev buf' h
-					(Just bytes) -> do
-						when (bytes /= prev) $
-							meterupdate $ toBytesProcessed 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
  - escaping. -}
@@ -106,14 +81,15 @@ rsyncUrlIsPath s
 	| rsyncUrlIsShell s = False
 	| otherwise = ':' `notElem` s
 
-{- Parses the String looking for rsync progress output, and returns
- - Maybe the number of bytes rsynced so far, and any any remainder of the
- - string that could be an incomplete progress output. That remainder
- - should be prepended to future output, and fed back in. This interface
- - allows the output to be read in any desired size chunk, or even one
- - character at a time.
+{- Runs rsync, but intercepts its progress output and updates a meter.
+ - The progress output is also output to stdout. 
  -
- - Strategy: Look for chunks prefixed with \r (rsync writes a \r before
+ - The params must enable rsync's --progress mode for this to work.
+ -}
+rsyncProgress :: MeterUpdate -> [CommandParam] -> IO Bool
+rsyncProgress meterupdate = commandMeter parseRsyncProgress meterupdate "rsync"
+
+{- Strategy: Look for chunks prefixed with \r (rsync writes a \r before
  - the first progress output, and each thereafter). The first number
  - after the \r is the number of bytes processed. After the number,
  - there must appear some whitespace, or we didn't get the whole number,
@@ -122,20 +98,23 @@ rsyncUrlIsPath s
  - In some locales, the number will have one or more commas in the middle
  - of it.
  -}
-parseRsyncProgress :: String -> (Maybe Integer, String)
+parseRsyncProgress :: ProgressParser
 parseRsyncProgress = go [] . reverse . progresschunks
   where
 	go remainder [] = (Nothing, remainder)
 	go remainder (x:xs) = case parsebytes (findbytesstart x) of
 		Nothing -> go (delim:x++remainder) xs
-		Just b -> (Just b, remainder)
+		Just b -> (Just (toBytesProcessed b), remainder)
 
 	delim = '\r'
+
 	{- Find chunks that each start with delim.
 	 - The first chunk doesn't start with it
 	 - (it's empty when delim is at the start of the string). -}
 	progresschunks = drop 1 . split [delim]
 	findbytesstart s = dropWhile isSpace s
+
+	parsebytes :: String -> Maybe Integer
 	parsebytes s = case break isSpace s of
 		([], _) -> Nothing
 		(_, []) -> Nothing