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.

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 ()