diff options
Diffstat (limited to 'Messages/Progress.hs')
| -rw-r--r-- | Messages/Progress.hs | 39 |
1 files changed, 27 insertions, 12 deletions
diff --git a/Messages/Progress.hs b/Messages/Progress.hs index e3df73ea4..c563ffa6f 100644 --- a/Messages/Progress.hs +++ b/Messages/Progress.hs @@ -15,9 +15,8 @@ import Types import Types.Messages import Types.Key -import Data.Progress.Meter -import Data.Progress.Tracker -import Data.Quantity +import System.Console.AsciiProgress +import Control.Concurrent {- Shows a progress meter while performing a transfer of a key. - The action is passed a callback to use to update the meter. -} @@ -32,17 +31,33 @@ metered combinemeterupdate key a = go (keySize key) 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) + go QuietOutput = nometer + go JSONOutput = nometer + go _ = do showOutput - r <- a $ \n -> liftIO $ do - setP progress $ fromBytesProcessed n - displayMeter stdout meter - maybe noop (\m -> m n) combinemeterupdate - liftIO $ clearMeter stdout meter + liftIO $ putStrLn "" + pg <- liftIO $ newProgressBar def + { pgWidth = 79 + , pgFormat = ":percent :bar ETA :eta" + , pgTotal = fromInteger size + } + r <- a $ liftIO . pupdate pg + + -- may not be actually complete if the action failed, + -- but this just clears the progress bar + liftIO $ complete pg + return r - go _ = a (const noop) + + pupdate pg n = do + let i = fromBytesProcessed n + sofar <- stCompleted <$> getProgressStats pg + when (i > sofar) $ + tickN pg (i - sofar) + threadDelay 100 + maybe noop (\m -> m n) combinemeterupdate + + nometer = a (const noop) {- Progress dots. -} showProgressDots :: Annex () |