summaryrefslogtreecommitdiff
path: root/Messages
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-04-04 15:58:38 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-04-04 15:58:38 -0400
commit136b9fa41d4e83b90714fc054aca92fa967315ae (patch)
tree0ec334333c6cc66e5086d9bef675859853b7800a /Messages
parent8815f95d1ad0413ca35e6873f4b7b272bac629db (diff)
WIP use ascii-progress
A bit flickery due to https://github.com/yamadapc/haskell-ascii-progress/issues/12 And, won't handle large files until ascii-progress is changed to use Integers.
Diffstat (limited to 'Messages')
-rw-r--r--Messages/Progress.hs39
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 ()