extend transferrer protocol to send progress bar total size updates

New protocol is not back-compat with old one, but it's never been
released so that's ok.
This commit is contained in:
Joey Hess 2020-12-11 12:39:00 -04:00
parent 94b323a8e8
commit 095cdc7e83
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 44 additions and 22 deletions

View file

@ -25,6 +25,7 @@ import Messages.Internal
import qualified System.Console.Regions as Regions
import qualified System.Console.Concurrent as Console
import Control.Monad.IO.Class (MonadIO)
import Data.IORef
{- Class of things from which a size can be gotten to display a progress
- meter. -}
@ -115,8 +116,16 @@ metered' st othermeter msize showoutput a = go st
a meter (combinemeter m)
| otherwise = nometer
go (MessageState { outputType = SerializedOutput h _ }) = do
liftIO $ outputSerialized h $ StartProgressMeter msize
meter <- liftIO $ mkMeter msize $ \_ _ _old new ->
liftIO $ outputSerialized h $ BeginProgressMeter msize
szv <- liftIO $ newIORef msize
meter <- liftIO $ mkMeter msize $ \_ msize' _old new -> do
case msize' of
Just sz | msize' /= msize -> do
psz <- readIORef szv
when (msize' /= psz) $ do
writeIORef szv msize'
outputSerialized h $ UpdateProgressMeterTotalSize sz
_ -> noop
outputSerialized h $ UpdateProgressMeter $
meterBytesProcessed new
m <- liftIO $ rateLimitMeterUpdate minratelimit meter $