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.
This commit is contained in:
parent
30aa902174
commit
a06f9ff329
2 changed files with 29 additions and 13 deletions
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue