avoid progress bar for url download with --quiet

This commit is contained in:
Joey Hess 2015-04-03 20:38:56 -04:00
parent b2ad3403c6
commit ff2eeaf054
2 changed files with 30 additions and 10 deletions

View file

@ -57,6 +57,7 @@ import Annex.Link
import Annex.Content.Direct import Annex.Content.Direct
import Annex.ReplaceFile import Annex.ReplaceFile
import Utility.LockFile import Utility.LockFile
import Messages.Progress
{- Checks if a given key's content is currently present. -} {- Checks if a given key's content is currently present. -}
inAnnex :: Key -> Annex Bool inAnnex :: Key -> Annex Bool
@ -555,12 +556,17 @@ saveState nocommit = doSideAction $ do
downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool
downloadUrl urls file = go =<< annexWebDownloadCommand <$> Annex.getGitConfig downloadUrl urls file = go =<< annexWebDownloadCommand <$> Annex.getGitConfig
where where
go Nothing = Url.withUrlOptions $ \uo -> go Nothing = do
anyM (\u -> Url.download u file uo) urls a <- ifM commandProgressDisabled
go (Just basecmd) = liftIO $ anyM (downloadcmd basecmd) urls ( return Url.downloadQuiet
, return Url.download
)
Url.withUrlOptions $ \uo ->
anyM (\u -> a u file uo) urls
go (Just basecmd) = anyM (downloadcmd basecmd) urls
downloadcmd basecmd url = downloadcmd basecmd url =
boolSystem "sh" [Param "-c", Param $ gencmd url basecmd] progressCommand stderr "sh" [Param "-c", Param $ gencmd url basecmd]
<&&> doesFileExist file <&&> liftIO (doesFileExist file)
gencmd url = massReplace gencmd url = massReplace
[ ("%file", shellEscape file) [ ("%file", shellEscape file)
, ("%url", shellEscape url) , ("%url", shellEscape url)

View file

@ -49,20 +49,34 @@ showProgressDots :: Annex ()
showProgressDots = handleMessage q $ showProgressDots = handleMessage q $
flushed $ putStr "." flushed $ putStr "."
{- Runs a command, that normally outputs progress to the specified handle.
-
- In quiet mode, normal output is suppressed. stderr is fed through the
- mkStderrEmitter. If the progress is output to stderr, then stderr is
- dropped, unless the command fails in which case the last line of output
- to stderr will be shown.
-}
progressCommand :: Handle -> FilePath -> [CommandParam] -> Annex Bool
progressCommand progresshandle cmd params = undefined
mkProgressHandler :: MeterUpdate -> Annex ProgressHandler mkProgressHandler :: MeterUpdate -> Annex ProgressHandler
mkProgressHandler meter = ProgressHandler mkProgressHandler meter = ProgressHandler
<$> quietmode <$> commandProgressDisabled
<*> (stderrhandler <$> mkStderrEmitter) <*> (stderrhandler <$> mkStderrEmitter)
<*> pure meter <*> pure meter
where where
quietmode = withOutputType $ \t -> return $ case t of
QuietOutput -> True
ProgressOutput -> True
_ -> False
stderrhandler emitter h = unlessM (hIsEOF h) $ do stderrhandler emitter h = unlessM (hIsEOF h) $ do
void $ emitter =<< hGetLine h void $ emitter =<< hGetLine h
stderrhandler emitter h stderrhandler emitter h
{- Should commands that normally output progress messages have that
- output disabled? -}
commandProgressDisabled :: Annex Bool
commandProgressDisabled = withOutputType $ \t -> return $ case t of
QuietOutput -> True
ProgressOutput -> True
_ -> False
{- Generates an IO action that can be used to emit stderr. {- Generates an IO action that can be used to emit stderr.
- -
- When a progress meter is displayed, this takes care to avoid - When a progress meter is displayed, this takes care to avoid