S3: Added progress display for uploading and downloading.

1 files changed, 17 insertions, 2 deletions

diff --git a/Meters.hs b/Meters.hs
index 0ea5d3af6..378e570a2 100644
--- a/Meters.hs
+++ b/Meters.hs
@@ -12,6 +12,7 @@ import Types.Meters
 import Utility.Observed
 
 import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString as S
 
 {- Sends the content of a file to an action, updating the meter as it's
  - consumed. -}
@@ -21,5 +22,19 @@ withMeteredFile f meterupdate a = withBinaryFile f ReadMode $ \h ->
 
 {- Sends the content of a file to a Handle, updating the meter as it's
  - written. -}
-sendMeteredFile :: FilePath -> MeterUpdate -> Handle -> IO ()
-sendMeteredFile f meterupdate h = withMeteredFile f meterupdate $ L.hPut h
+streamMeteredFile :: FilePath -> MeterUpdate -> Handle -> IO ()
+streamMeteredFile f meterupdate h = withMeteredFile f meterupdate $ L.hPut h
+
+{- Writes a ByteString to a Handle, updating a meter as it's written. -}
+meteredWrite :: MeterUpdate -> Handle -> L.ByteString -> IO ()
+meteredWrite meterupdate h = go . L.toChunks 
+  where
+	go [] = return ()
+	go (c:cs) = do
+		S.hPut h c
+		meterupdate $ toInteger $ S.length c
+		go cs
+
+meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO ()
+meteredWriteFile meterupdate f b = withBinaryFile f WriteMode $ \h ->
+	meteredWrite meterupdate h b