summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--CHANGELOG2
-rw-r--r--CmdLine/GitAnnex/Options.hs9
-rw-r--r--Command/AddUrl.hs2
-rw-r--r--Command/Get.hs2
-rw-r--r--Command/MetaData.hs2
-rw-r--r--Messages.hs2
-rw-r--r--Messages/Internal.hs11
-rw-r--r--Messages/JSON.hs17
-rw-r--r--Messages/Progress.hs8
-rw-r--r--Types/Messages.hs2
-rw-r--r--doc/git-annex-addurl.mdwn4
-rw-r--r--doc/git-annex-get.mdwn6
12 files changed, 55 insertions, 12 deletions
diff --git a/CHANGELOG b/CHANGELOG
index 61831dfd3..eb48a476b 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -6,6 +6,8 @@ git-annex (6.20160908) UNRELEASED; urgency=medium
over ssh etc.
* Make --json and --quiet work when used with -J.
Previously, -J override the other options.
+ * addurl, get: Added --json-progress option, which adds progress
+ objects to the json output.
* Remove key:null from git-annex add --json output.
-- Joey Hess <id@joeyh.name> Thu, 08 Sep 2016 12:48:55 -0400
diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index 1c360de19..92724d03d 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -286,12 +286,19 @@ combiningOptions =
shortopt o h = globalFlag (Limit.addToken [o]) ( short o <> help h <> hidden )
jsonOption :: GlobalOption
-jsonOption = globalFlag (Annex.setOutput JSONOutput)
+jsonOption = globalFlag (Annex.setOutput (JSONOutput False))
( long "json" <> short 'j'
<> help "enable JSON output"
<> hidden
)
+jsonProgressOption :: GlobalOption
+jsonProgressOption = globalFlag (Annex.setOutput (JSONOutput True))
+ ( long "json-progress" <> short 'j'
+ <> help "include progress in JSON output"
+ <> hidden
+ )
+
-- Note that a command that adds this option should wrap its seek
-- action in `allowConcurrentOutput`.
jobsOption :: GlobalOption
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index be29cc228..3a6ee7560 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -31,7 +31,7 @@ import Annex.Quvi
import qualified Utility.Quvi as Quvi
cmd :: Command
-cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOption] $
+cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOption, jsonProgressOption] $
command "addurl" SectionCommon "add urls to annex"
(paramRepeating paramUrl) (seek <$$> optParser)
diff --git a/Command/Get.hs b/Command/Get.hs
index 70b877065..a0c7aff47 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -16,7 +16,7 @@ import Annex.Wanted
import qualified Command.Move
cmd :: Command
-cmd = withGlobalOptions (jobsOption : jsonOption : annexedMatchingOptions) $
+cmd = withGlobalOptions (jobsOption : jsonOption : jsonProgressOption : annexedMatchingOptions) $
command "get" SectionCommon
"make content of annexed files available"
paramPaths (seek <$$> optParser)
diff --git a/Command/MetaData.hs b/Command/MetaData.hs
index bf71f7b4f..6e64207c8 100644
--- a/Command/MetaData.hs
+++ b/Command/MetaData.hs
@@ -79,7 +79,7 @@ seek o = do
(seeker $ whenAnnexed $ start now o)
(forFiles o)
Batch -> withMessageState $ \s -> case outputType s of
- JSONOutput -> batchInput parseJSONInput $
+ JSONOutput _ -> batchInput parseJSONInput $
commandAction . startBatch now
_ -> error "--batch is currently only supported in --json mode"
diff --git a/Messages.hs b/Messages.hs
index 83f444a99..38b8ad890 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -213,7 +213,7 @@ commandProgressDisabled :: Annex Bool
commandProgressDisabled = withMessageState $ \s -> return $
case outputType s of
QuietOutput -> True
- JSONOutput -> True
+ JSONOutput _ -> True
NormalOutput -> concurrentOutputEnabled s
{- Use to show a message that is displayed implicitly, and so might be
diff --git a/Messages/Internal.hs b/Messages/Internal.hs
index 21d11d811..bf212b71b 100644
--- a/Messages/Internal.hs
+++ b/Messages/Internal.hs
@@ -26,20 +26,20 @@ outputMessage' endmessage json msg = withMessageState $ \s -> case outputType s
NormalOutput
| concurrentOutputEnabled s -> concurrentMessage s False msg q
| otherwise -> liftIO $ flushed $ putStr msg
- JSONOutput -> void $ outputJSON json endmessage s
+ JSONOutput _ -> void $ outputJSON json endmessage s
QuietOutput -> q
outputJSON :: IO () -> Bool -> MessageState -> Annex Bool
outputJSON json endmessage s = case outputType s of
- JSONOutput
- | concurrentOutputEnabled s -> do
+ JSONOutput withprogress
+ | withprogress || concurrentOutputEnabled s -> do
-- Buffer json fragments until end is reached.
if endmessage
then do
Annex.changeState $ \st ->
st { Annex.output = s { jsonBuffer = [] } }
liftIO $ flushed $ do
- sequence_ $ reverse $ jsonBuffer s
+ showJSONBuffer s
json
else Annex.changeState $ \st ->
st { Annex.output = s { jsonBuffer = json : jsonBuffer s } }
@@ -49,6 +49,9 @@ outputJSON json endmessage s = case outputType s of
return True
_ -> return False
+showJSONBuffer :: MessageState -> IO ()
+showJSONBuffer s = sequence_ $ reverse $ jsonBuffer s
+
outputError :: String -> Annex ()
outputError msg = withMessageState $ \s ->
if concurrentOutputEnabled s
diff --git a/Messages/JSON.hs b/Messages/JSON.hs
index 0cceda3f3..7b94aa220 100644
--- a/Messages/JSON.hs
+++ b/Messages/JSON.hs
@@ -13,6 +13,7 @@ module Messages.JSON (
note,
add,
complete,
+ progress,
DualDisp(..),
ObjectMap(..),
JSONActionItem(..),
@@ -30,6 +31,8 @@ import Prelude
import qualified Utility.JSONStream as Stream
import Types.Key
+import Utility.Metered
+import Utility.Percentage
start :: String -> Maybe FilePath -> Maybe Key -> IO ()
start command file key = B.hPut stdout $ Stream.start $ Stream.AesonObject o
@@ -53,6 +56,20 @@ add = B.hPut stdout . Stream.add
complete :: Stream.JSONChunk a -> IO ()
complete v = B.hPut stdout $ Stream.start v `B.append` Stream.end
+progress :: IO () -> Integer -> BytesProcessed -> IO ()
+progress jsonbuffer size bytesprocessed = do
+ B.hPut stdout $ Stream.start $ Stream.AesonObject o
+ putStr ",\"action\":"
+ jsonbuffer
+ B.hPut stdout $ Stream.end
+ B.hPut stdout $ Stream.end
+ where
+ n = fromBytesProcessed bytesprocessed :: Integer
+ Object o = object
+ [ "byte-progress" .= n
+ , "percent-progress" .= showPercentage 2 (percentage size n)
+ ]
+
-- A value that can be displayed either normally, or as JSON.
data DualDisp = DualDisp
{ dispNormal :: String
diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index fa11c1304..a48e7b07e 100644
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -16,6 +16,7 @@ import Utility.Metered
import Types
import Types.Messages
import Types.Key
+import qualified Messages.JSON as JSON
#ifdef WITH_CONCURRENTOUTPUT
import Messages.Concurrent
@@ -35,7 +36,6 @@ metered othermeter key a = case keySize key of
Just size -> withMessageState (go $ fromInteger size)
where
go _ (MessageState { outputType = QuietOutput }) = nometer
- go _ (MessageState { outputType = JSONOutput }) = nometer
go size (MessageState { outputType = NormalOutput, concurrentOutputEnabled = False }) = do
showOutput
(progress, meter) <- mkmeter size
@@ -57,6 +57,12 @@ metered othermeter key a = case keySize key of
#else
nometer
#endif
+ go _ (MessageState { outputType = JSONOutput False }) = nometer
+ go size (MessageState { outputType = JSONOutput True }) = do
+ buf <- withMessageState $ return . showJSONBuffer
+ m <- liftIO $ rateLimitMeterUpdate 0.1 (Just size) $
+ JSON.progress buf size
+ a (combinemeter m)
mkmeter size = do
progress <- liftIO $ newProgress "" size
diff --git a/Types/Messages.hs b/Types/Messages.hs
index 368054af1..a155cae2a 100644
--- a/Types/Messages.hs
+++ b/Types/Messages.hs
@@ -15,7 +15,7 @@ import Data.Default
import System.Console.Regions (ConsoleRegion)
#endif
-data OutputType = NormalOutput | QuietOutput | JSONOutput
+data OutputType = NormalOutput | QuietOutput | JSONOutput Bool
deriving (Show)
data SideActionBlock = NoBlock | StartBlock | InBlock
diff --git a/doc/git-annex-addurl.mdwn b/doc/git-annex-addurl.mdwn
index a08823312..aace42009 100644
--- a/doc/git-annex-addurl.mdwn
+++ b/doc/git-annex-addurl.mdwn
@@ -88,6 +88,10 @@ be used to get better filenames.
Enable JSON output. This is intended to be parsed by programs that use
git-annex. Each line of output is a JSON object.
+* `--json-progress`
+
+ Include progress objects in JSON output.
+
# CAVEATS
If annex.largefiles is configured, and does not match a file, `git annex
diff --git a/doc/git-annex-get.mdwn b/doc/git-annex-get.mdwn
index 73975a9bb..f30ee49e1 100644
--- a/doc/git-annex-get.mdwn
+++ b/doc/git-annex-get.mdwn
@@ -86,7 +86,7 @@ or transferring them from some kind of key-value store.
displayed. If the specified file's content is already present, or
it is not an annexed file, a blank line is output in response instead.
- Since the usual progress output while getting a file is verbose and not
+ Since the usual output while getting a file is verbose and not
machine-parseable, you may want to use --json in combination with
--batch.
@@ -95,6 +95,10 @@ or transferring them from some kind of key-value store.
Enable JSON output. This is intended to be parsed by programs that use
git-annex. Each line of output is a JSON object.
+* `--json-progress`
+
+ Include progress objects in JSON output.
+
# SEE ALSO
[[git-annex]](1)
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-31 03:13:12 +0000