WIP on making --quiet silence progress, and infra for concurrent progress bars
This commit is contained in:
parent
c2c901a6e4
commit
20fb91a7ad
14 changed files with 194 additions and 93 deletions
|
@ -19,6 +19,7 @@ import Logs.Web
|
|||
import Types.UrlContents
|
||||
import Types.CleanupActions
|
||||
import Types.Key
|
||||
import Messages.Progress
|
||||
import Utility.Metered
|
||||
import Utility.Tmp
|
||||
import Backend.URL
|
||||
|
@ -291,11 +292,12 @@ runAria :: [CommandParam] -> Annex Bool
|
|||
runAria ps = liftIO . boolSystem "aria2c" =<< ariaParams ps
|
||||
|
||||
-- Parse aria output to find "(n%)" and update the progress meter
|
||||
-- with it. The output is also output to stdout.
|
||||
-- with it.
|
||||
ariaProgress :: Maybe Integer -> MeterUpdate -> [CommandParam] -> Annex Bool
|
||||
ariaProgress Nothing _ ps = runAria ps
|
||||
ariaProgress (Just sz) meter ps =
|
||||
liftIO . commandMeter (parseAriaProgress sz) meter "aria2c"
|
||||
ariaProgress (Just sz) meter ps = do
|
||||
h <- mkProgressHandler meter
|
||||
liftIO . commandMeter (parseAriaProgress sz) h "aria2c"
|
||||
=<< ariaParams ps
|
||||
|
||||
parseAriaProgress :: Integer -> ProgressParser
|
||||
|
|
|
@ -17,6 +17,7 @@ import CmdLine.GitAnnexShell.Fields (Field, fieldName)
|
|||
import qualified CmdLine.GitAnnexShell.Fields as Fields
|
||||
import Types.Key
|
||||
import Remote.Helper.Messages
|
||||
import Messages.Progress
|
||||
import Utility.Metered
|
||||
import Utility.Rsync
|
||||
import Types.Remote
|
||||
|
@ -100,9 +101,14 @@ dropKey r key = onRemote r (boolSystem, return False) "dropkey"
|
|||
[]
|
||||
|
||||
rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool
|
||||
rsyncHelper callback params = do
|
||||
rsyncHelper m params = do
|
||||
showOutput -- make way for progress bar
|
||||
ifM (liftIO $ (maybe rsync rsyncProgress callback) params)
|
||||
a <- case m of
|
||||
Nothing -> return $ rsync params
|
||||
Just meter -> do
|
||||
h <- mkProgressHandler meter
|
||||
return $ rsyncProgress h params
|
||||
ifM (liftIO a)
|
||||
( return True
|
||||
, do
|
||||
showLongNote "rsync failed -- run git annex again to resume file transfer"
|
||||
|
|
|
@ -31,6 +31,7 @@ import Remote.Rsync.RsyncUrl
|
|||
import Crypto
|
||||
import Utility.Rsync
|
||||
import Utility.CopyFile
|
||||
import Messages.Progress
|
||||
import Utility.Metered
|
||||
import Utility.PID
|
||||
import Annex.Perms
|
||||
|
@ -281,11 +282,15 @@ showResumable a = ifM a
|
|||
)
|
||||
|
||||
rsyncRemote :: Direction -> RsyncOpts -> Maybe MeterUpdate -> [CommandParam] -> Annex Bool
|
||||
rsyncRemote direction o callback params = do
|
||||
rsyncRemote direction o m params = do
|
||||
showOutput -- make way for progress bar
|
||||
liftIO $ (maybe rsync rsyncProgress callback) $
|
||||
opts ++ [Params "--progress"] ++ params
|
||||
case m of
|
||||
Nothing -> liftIO $ rsync ps
|
||||
Just meter -> do
|
||||
h <- mkProgressHandler meter
|
||||
liftIO $ rsyncProgress h ps
|
||||
where
|
||||
ps = opts ++ [Params "--progress"] ++ params
|
||||
opts
|
||||
| direction == Download = rsyncDownloadOptions o
|
||||
| otherwise = rsyncUploadOptions o
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue