diff options
author | Joey Hess <joey@kitenet.net> | 2012-11-18 22:20:43 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-11-18 22:20:43 -0400 |
commit | 2197d254e8b340b4a84f1d273c785d2d729b9b83 (patch) | |
tree | eda957dafab5805e7373c18a8f37b9620e71e836 /Messages.hs | |
parent | 3d6fb239dd88ec7f105b8066b5c5476bb9c2aeec (diff) |
S3: upload progress display
Diffstat (limited to 'Messages.hs')
-rw-r--r-- | Messages.hs | 15 |
1 files changed, 12 insertions, 3 deletions
diff --git a/Messages.hs b/Messages.hs index 055b561dd..bb91653da 100644 --- a/Messages.hs +++ b/Messages.hs @@ -11,6 +11,7 @@ module Messages ( showAction, showProgress, metered, + meteredBytes, showSideAction, doSideAction, doQuietSideAction, @@ -63,9 +64,17 @@ showProgress = handle q $ {- 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 = withOutputType $ go (keySize key) +metered combinemeterupdate key a = go (keySize key) where - go (Just size) NormalOutput = do + go (Just size) = meteredBytes combinemeterupdate size a + go _ = a (const noop) + +{- Shows a progress meter while performing an action on a given number + - of bytes. -} +meteredBytes :: (Maybe MeterUpdate) -> Integer -> (MeterUpdate -> Annex a) -> Annex a +meteredBytes combinemeterupdate size a = withOutputType go + where + go NormalOutput = do progress <- liftIO $ newProgress "" size meter <- liftIO $ newMeter progress "B" 25 (renderNums binaryOpts 1) showOutput @@ -76,7 +85,7 @@ metered combinemeterupdate key a = withOutputType $ go (keySize key) maybe noop (\m -> m n) combinemeterupdate liftIO $ clearMeter stdout meter return r - go _ _ = a (const noop) + go _ = a (const noop) showSideAction :: String -> Annex () showSideAction m = Annex.getState Annex.output >>= go |