S3: Added progress display for uploading and downloading.

This commit is contained in:
Joey Hess 2012-11-18 22:49:07 -04:00
parent 7ade03bd5f
commit 7df1e71fe3
7 changed files with 46 additions and 41 deletions

View file

@ -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