diff options
| -rw-r--r-- | Messages/Progress.hs | 39 | ||||
| -rw-r--r-- | git-annex.cabal | 3 |
2 files changed, 29 insertions, 13 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 () diff --git a/git-annex.cabal b/git-annex.cabal index ff9f09c35..b0d73e7bf 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -112,7 +112,8 @@ Executable git-annex data-default, case-insensitive, http-conduit, http-types, cryptohash (>= 0.10.0), esqueleto, persistent-sqlite, persistent, persistent-template, - monad-logger, resourcet + monad-logger, resourcet, + ascii-progress CC-Options: -Wall GHC-Options: -Wall Extensions: PackageImports |