diff options
| -rw-r--r-- | CHANGELOG | 9 | ||||
| -rw-r--r-- | Messages/Progress.hs | 14 | ||||
| -rw-r--r-- | Utility/Metered.hs | 25 |
3 files changed, 42 insertions, 6 deletions
@@ -1,3 +1,12 @@ +git-annex (6.20160908) UNRELEASED; urgency=medium + + * Rate limit console progress display updates to 10 per second. + Was updating as frequently as changes were reported, up to hundreds of + times per second, which used unncessary bandwidth when running git-annex + over ssh etc. + + -- Joey Hess <id@joeyh.name> Thu, 08 Sep 2016 12:48:55 -0400 + git-annex (6.20160907) unstable; urgency=medium * Windows: Handle shebang in external special remote program. diff --git a/Messages/Progress.hs b/Messages/Progress.hs index c0a88be94..2cef9a759 100644 --- a/Messages/Progress.hs +++ b/Messages/Progress.hs @@ -30,7 +30,7 @@ import Data.Quantity {- Shows a progress meter while performing a transfer of a key. - The action is passed a callback to use to update the meter. -} metered :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a -metered combinemeterupdate key a = case keySize key of +metered othermeter key a = case keySize key of Nothing -> nometer Just size -> withOutputType (go $ fromInteger size) where @@ -39,21 +39,21 @@ metered combinemeterupdate key a = case keySize key of go size NormalOutput = do showOutput (progress, meter) <- mkmeter size - r <- a $ \n -> liftIO $ do + m <- liftIO $ rateLimitMeterUpdate 0.1 (Just size) $ \n -> do setP progress $ fromBytesProcessed n displayMeter stdout meter - maybe noop (\m -> m n) combinemeterupdate + r <- a (combinemeter m) liftIO $ clearMeter stdout meter return r #if WITH_CONCURRENTOUTPUT go size o@(ConcurrentOutput {}) | concurrentOutputEnabled o = withProgressRegion $ \r -> do (progress, meter) <- mkmeter size - a $ \n -> liftIO $ do + m <- liftIO $ rateLimitMeterUpdate 0.1 (Just size) $ \n -> do setP progress $ fromBytesProcessed n s <- renderMeter meter Regions.setConsoleRegion r ("\n" ++ s) - maybe noop (\m -> m n) combinemeterupdate + a (combinemeter m) #else go _size _o #endif @@ -66,6 +66,10 @@ metered combinemeterupdate key a = case keySize key of nometer = a (const noop) + combinemeter m = case othermeter of + Nothing -> m + Just om -> combineMeterUpdate m om + {- Use when the progress meter is only desired for concurrent - output; as when a command's own progress output is preferred. -} concurrentMetered :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a diff --git a/Utility/Metered.hs b/Utility/Metered.hs index da83fd8cd..440aa3f07 100644 --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -1,6 +1,6 @@ {- Metered IO and actions - - - Copyright 2012-2105 Joey Hess <id@joeyh.name> + - Copyright 2012-2106 Joey Hess <id@joeyh.name> - - License: BSD-2-clause -} @@ -21,6 +21,8 @@ import Data.Bits.Utils import Control.Concurrent import Control.Concurrent.Async import Control.Monad.IO.Class (MonadIO) +import Data.Time.Clock +import Data.Time.Clock.POSIX {- An action that can be run repeatedly, updating it on the bytes processed. - @@ -259,3 +261,24 @@ outputFilter cmd params environ outfilter errfilter = catchBoolIO $ do where p = (proc cmd (toCommand params)) { env = environ } + +-- | Limit a meter to only update once per unit of time. +-- +-- It's nice to display the final update to 100%, even if it comes soon +-- after a previous update. To make that happen, a total size has to be +-- provided. +rateLimitMeterUpdate :: NominalDiffTime -> Maybe Integer -> MeterUpdate -> IO MeterUpdate +rateLimitMeterUpdate delta totalsize meterupdate = do + lastupdate <- newMVar (toEnum 0 :: POSIXTime) + return $ mu lastupdate + where + mu lastupdate n@(BytesProcessed i) = case totalsize of + Just t | i >= t -> meterupdate n + _ -> do + now <- getPOSIXTime + prev <- takeMVar lastupdate + if now - prev >= delta + then do + putMVar lastupdate now + meterupdate n + else putMVar lastupdate prev |