diff options
53 files changed, 265 insertions, 88 deletions
@@ -275,7 +275,8 @@ addCleanup k a = changeState $ \s -> {- Sets the type of output to emit. -} setOutput :: OutputType -> Annex () setOutput o = changeState $ \s -> - s { output = (output s) { outputType = o } } + let m = output s + in s { output = m { outputType = adjustOutputType (outputType m) o } } {- Checks if a flag was set. -} getFlag :: String -> Annex Bool @@ -17,6 +17,11 @@ git-annex (6.20180113) UNRELEASED; urgency=medium hopefully hackage finally recognises that OS. * Split Test.hs and avoid optimising it much, to need less memory to compile. + * Fix behavior of --json-progress followed by --json, in which + the latter option disabled the former. + * Added --json-error-messages option, which makes messages + that would normally be output to standard error be included in + the json output. -- Joey Hess <id@joeyh.name> Wed, 24 Jan 2018 20:42:55 -0400 diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs index d762f6a00..143bb6498 100644 --- a/CmdLine/GitAnnex/Options.hs +++ b/CmdLine/GitAnnex/Options.hs @@ -191,7 +191,7 @@ annexedMatchingOptions = concat [ nonWorkTreeMatchingOptions' , fileMatchingOptions' , combiningOptions - , [timeLimitOption] + , timeLimitOption ] -- Matching options that don't need to examine work tree files. @@ -294,29 +294,51 @@ combiningOptions = longopt o h = globalFlag (Limit.addToken o) ( long o <> help h <> hidden ) shortopt o h = globalFlag (Limit.addToken [o]) ( short o <> help h <> hidden ) -jsonOption :: GlobalOption -jsonOption = globalFlag (Annex.setOutput (JSONOutput False)) - ( long "json" <> short 'j' - <> help "enable JSON output" - <> hidden - ) +jsonOptions :: [GlobalOption] +jsonOptions = + [ globalFlag (Annex.setOutput (JSONOutput stdjsonoptions)) + ( long "json" <> short 'j' + <> help "enable JSON output" + <> hidden + ) + , globalFlag (Annex.setOutput (JSONOutput jsonerrormessagesoptions)) + ( long "json-error-messages" + <> help "include error messages in JSON" + <> hidden + ) + ] + where + stdjsonoptions = JSONOptions + { jsonProgress = False + , jsonErrorMessages = False + } + jsonerrormessagesoptions = stdjsonoptions { jsonErrorMessages = True } -jsonProgressOption :: GlobalOption -jsonProgressOption = globalFlag (Annex.setOutput (JSONOutput True)) - ( long "json-progress" - <> help "include progress in JSON output" - <> hidden - ) +jsonProgressOption :: [GlobalOption] +jsonProgressOption = + [ globalFlag (Annex.setOutput (JSONOutput jsonoptions)) + ( long "json-progress" + <> help "include progress in JSON output" + <> hidden + ) + ] + where + jsonoptions = JSONOptions + { jsonProgress = True + , jsonErrorMessages = False + } -- Note that a command that adds this option should wrap its seek -- action in `allowConcurrentOutput`. -jobsOption :: GlobalOption -jobsOption = globalSetter set $ - option auto - ( long "jobs" <> short 'J' <> metavar paramNumber - <> help "enable concurrent jobs" - <> hidden - ) +jobsOption :: [GlobalOption] +jobsOption = + [ globalSetter set $ + option auto + ( long "jobs" <> short 'J' <> metavar paramNumber + <> help "enable concurrent jobs" + <> hidden + ) + ] where set n = do Annex.changeState $ \s -> s { Annex.concurrency = Concurrent n } @@ -324,12 +346,14 @@ jobsOption = globalSetter set $ when (n > c) $ liftIO $ setNumCapabilities n -timeLimitOption :: GlobalOption -timeLimitOption = globalSetter Limit.addTimeLimit $ strOption - ( long "time-limit" <> short 'T' <> metavar paramTime - <> help "stop after the specified amount of time" - <> hidden - ) +timeLimitOption :: [GlobalOption] +timeLimitOption = + [ globalSetter Limit.addTimeLimit $ strOption + ( long "time-limit" <> short 'T' <> metavar paramTime + <> help "stop after the specified amount of time" + <> hidden + ) + ] data DaemonOptions = DaemonOptions { foregroundDaemonOption :: Bool diff --git a/Command.hs b/Command.hs index d1d539f45..b886e4fe2 100644 --- a/Command.hs +++ b/Command.hs @@ -79,9 +79,9 @@ allowMessages = do noRepo :: (String -> Parser (IO ())) -> Command -> Command noRepo a c = c { cmdnorepo = Just (a (cmdparamdesc c)) } -{- Adds global options to a command's. -} -withGlobalOptions :: [GlobalOption] -> Command -> Command -withGlobalOptions os c = c { cmdglobaloptions = cmdglobaloptions c ++ os } +{- Adds global options to a command. -} +withGlobalOptions :: [[GlobalOption]] -> Command -> Command +withGlobalOptions os c = c { cmdglobaloptions = cmdglobaloptions c ++ concat os } {- For start and perform stages to indicate what step to run next. -} next :: a -> Annex (Maybe a) diff --git a/Command/Add.hs b/Command/Add.hs index 638da101e..10148ad50 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -22,9 +22,10 @@ import Annex.Version import Git.FilePath cmd :: Command -cmd = notBareRepo $ withGlobalOptions (jobsOption : jsonOption : fileMatchingOptions) $ - command "add" SectionCommon "add files to annex" - paramPaths (seek <$$> optParser) +cmd = notBareRepo $ + withGlobalOptions [jobsOption, jsonOptions, fileMatchingOptions] $ + command "add" SectionCommon "add files to annex" + paramPaths (seek <$$> optParser) data AddOptions = AddOptions { addThese :: CmdParams diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 995848ed2..dfdbf5b5a 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -34,7 +34,7 @@ import Utility.Path.Max import qualified Annex.Transfer as Transfer cmd :: Command -cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOption, jsonProgressOption] $ +cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption] $ command "addurl" SectionCommon "add urls to annex" (paramRepeating paramUrl) (seek <$$> optParser) diff --git a/Command/Copy.hs b/Command/Copy.hs index b3b860fef..85a556a14 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -14,7 +14,7 @@ import Annex.Wanted import Annex.NumCopies cmd :: Command -cmd = withGlobalOptions (jobsOption : jsonOption : jsonProgressOption : annexedMatchingOptions) $ +cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $ command "copy" SectionCommon "copy content of files to/from another repository" paramPaths (seek <--< optParser) diff --git a/Command/Drop.hs b/Command/Drop.hs index 275714a65..09385dddb 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -23,7 +23,7 @@ import System.Log.Logger (debugM) import qualified Data.Set as S cmd :: Command -cmd = withGlobalOptions (jobsOption : jsonOption : annexedMatchingOptions) $ +cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $ command "drop" SectionCommon "remove content of files from repository" paramPaths (seek <$$> optParser) diff --git a/Command/DropKey.hs b/Command/DropKey.hs index f3f2333dd..7acd3d0fa 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -13,7 +13,7 @@ import Logs.Location import Annex.Content cmd :: Command -cmd = noCommit $ withGlobalOptions [jsonOption] $ +cmd = noCommit $ withGlobalOptions [jsonOptions] $ command "dropkey" SectionPlumbing "drops annexed content for specified keys" (paramRepeating paramKey) diff --git a/Command/ExamineKey.hs b/Command/ExamineKey.hs index 24d6942fe..2c79c1a65 100644 --- a/Command/ExamineKey.hs +++ b/Command/ExamineKey.hs @@ -13,7 +13,7 @@ import Command.Find (parseFormatOption, showFormatted, keyVars) cmd :: Command cmd = noCommit $ noMessages $ dontCheck repoExists $ - withGlobalOptions [jsonOption] $ + withGlobalOptions [jsonOptions] $ command "examinekey" SectionPlumbing "prints information from a key" (paramRepeating paramKey) diff --git a/Command/Find.hs b/Command/Find.hs index 03ac72f96..10eff3527 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -18,12 +18,12 @@ import qualified Utility.Format import Utility.DataUnits cmd :: Command -cmd = withGlobalOptions annexedMatchingOptions $ mkCommand $ +cmd = withGlobalOptions [annexedMatchingOptions] $ mkCommand $ command "find" SectionQuery "lists available files" paramPaths (seek <$$> optParser) mkCommand :: Command -> Command -mkCommand = noCommit . noMessages . withGlobalOptions [jsonOption] +mkCommand = noCommit . noMessages . withGlobalOptions [jsonOptions] data FindOptions = FindOptions { findThese :: CmdParams diff --git a/Command/FindRef.hs b/Command/FindRef.hs index 93315bcef..5cf6838d7 100644 --- a/Command/FindRef.hs +++ b/Command/FindRef.hs @@ -12,7 +12,7 @@ import qualified Command.Find as Find import qualified Git cmd :: Command -cmd = withGlobalOptions nonWorkTreeMatchingOptions $ Find.mkCommand $ +cmd = withGlobalOptions [nonWorkTreeMatchingOptions] $ Find.mkCommand $ command "findref" SectionPlumbing "lists files in a git ref" paramRef (seek <$$> Find.optParser) diff --git a/Command/Fix.hs b/Command/Fix.hs index 4e8471bcb..278457bf1 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -23,7 +23,7 @@ import Utility.Touch #endif cmd :: Command -cmd = notDirect $ noCommit $ withGlobalOptions annexedMatchingOptions $ +cmd = notDirect $ noCommit $ withGlobalOptions [annexedMatchingOptions] $ command "fix" SectionMaintenance "fix up links to annexed content" paramPaths (withParams seek) diff --git a/Command/Fsck.hs b/Command/Fsck.hs index a536361a8..0f19a8bf2 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -45,7 +45,7 @@ import qualified Data.Set as S import qualified Data.Map as M cmd :: Command -cmd = withGlobalOptions (jobsOption : jsonOption : annexedMatchingOptions) $ +cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $ command "fsck" SectionMaintenance "find and fix problems" paramPaths (seek <$$> optParser) diff --git a/Command/Get.hs b/Command/Get.hs index a74ca253f..a35246c37 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 : jsonProgressOption : annexedMatchingOptions) $ +cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $ command "get" SectionCommon "make content of annexed files available" paramPaths (seek <$$> optParser) diff --git a/Command/Import.hs b/Command/Import.hs index 6d872b1cb..49bf4b5c8 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -24,10 +24,11 @@ import Utility.InodeCache import Logs.Location cmd :: Command -cmd = withGlobalOptions (jobsOption : jsonOption : fileMatchingOptions) $ notBareRepo $ - command "import" SectionCommon - "move and add files from outside git working copy" - paramPaths (seek <$$> optParser) +cmd = notBareRepo $ + withGlobalOptions [jobsOption, jsonOptions, fileMatchingOptions] $ + command "import" SectionCommon + "move and add files from outside git working copy" + paramPaths (seek <$$> optParser) data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates | SkipDuplicates | ReinjectDuplicates deriving (Eq) diff --git a/Command/Info.hs b/Command/Info.hs index 0867bf8ea..394e27605 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -84,7 +84,7 @@ emptyStatInfo = StatInfo Nothing Nothing M.empty Nothing type StatState = StateT StatInfo Annex cmd :: Command -cmd = noCommit $ withGlobalOptions (jsonOption : annexedMatchingOptions) $ +cmd = noCommit $ withGlobalOptions [jsonOptions, annexedMatchingOptions] $ command "info" SectionQuery "shows information about the specified item or the repository as a whole" (paramRepeating paramItem) (seek <$$> optParser) diff --git a/Command/List.hs b/Command/List.hs index e949c2ff0..ccf6962a9 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -22,7 +22,7 @@ import Git.Types (RemoteName) import Utility.Tuple cmd :: Command -cmd = noCommit $ withGlobalOptions annexedMatchingOptions $ +cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $ command "list" SectionQuery "show which remotes contain files" paramPaths (seek <$$> optParser) diff --git a/Command/Lock.hs b/Command/Lock.hs index e3e3e0fe7..d341739db 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -23,7 +23,7 @@ import Logs.Location import Git.FilePath cmd :: Command -cmd = notDirect $ withGlobalOptions (jsonOption : annexedMatchingOptions) $ +cmd = notDirect $ withGlobalOptions [jsonOptions, annexedMatchingOptions] $ command "lock" SectionCommon "undo unlock command" paramPaths (withParams seek) diff --git a/Command/Log.hs b/Command/Log.hs index 7265ef6ba..1cc86c6b1 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -40,7 +40,7 @@ data LogChange = Added | Removed type Outputter = LogChange -> POSIXTime -> [UUID] -> Annex () cmd :: Command -cmd = withGlobalOptions annexedMatchingOptions $ +cmd = withGlobalOptions [annexedMatchingOptions] $ command "log" SectionQuery "shows location log" paramPaths (seek <$$> optParser) diff --git a/Command/MetaData.hs b/Command/MetaData.hs index 9fba1097a..ef3f1da9a 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -23,7 +23,7 @@ import Data.Aeson import Control.Concurrent cmd :: Command -cmd = withGlobalOptions ([jsonOption] ++ annexedMatchingOptions) $ +cmd = withGlobalOptions [jsonOptions, annexedMatchingOptions] $ command "metadata" SectionMetaData "sets or gets metadata of a file" paramPaths (seek <$$> optParser) diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 582839117..1f0a62bcb 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -20,7 +20,7 @@ import Logs.Web import qualified Remote cmd :: Command -cmd = notDirect $ withGlobalOptions annexedMatchingOptions $ +cmd = notDirect $ withGlobalOptions [annexedMatchingOptions] $ command "migrate" SectionUtility "switch data to different backend" paramPaths (withParams seek) diff --git a/Command/Mirror.hs b/Command/Mirror.hs index 941e397a4..a7d44d8ef 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -17,7 +17,7 @@ import Annex.NumCopies import Types.Transfer cmd :: Command -cmd = withGlobalOptions (jobsOption : jsonOption : jsonProgressOption : annexedMatchingOptions) $ +cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $ command "mirror" SectionCommon "mirror content of files to/from another repository" paramPaths (seek <--< optParser) diff --git a/Command/Move.hs b/Command/Move.hs index 63b5fb8b0..2f796cd93 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -20,7 +20,7 @@ import Annex.NumCopies import System.Log.Logger (debugM) cmd :: Command -cmd = withGlobalOptions (jobsOption : jsonOption : jsonProgressOption : annexedMatchingOptions) $ +cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $ command "move" SectionCommon "move content of files to/from another repository" paramPaths (seek <--< optParser) diff --git a/Command/Status.hs b/Command/Status.hs index 07024f3c8..06d982453 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -17,7 +17,7 @@ import Git.FilePath cmd :: Command cmd = notBareRepo $ noCommit $ noMessages $ - withGlobalOptions [jsonOption] $ + withGlobalOptions [jsonOptions] $ command "status" SectionCommon "show the working tree status" paramPaths (seek <$$> optParser) diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 7c693a088..bcf659ab7 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -24,7 +24,7 @@ import qualified Database.Keys import Git.FilePath cmd :: Command -cmd = withGlobalOptions annexedMatchingOptions $ +cmd = withGlobalOptions [annexedMatchingOptions] $ command "unannex" SectionUtility "undo accidental add command" paramPaths (withParams seek) diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 44e3f1bf3..221c9f0ad 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -26,8 +26,9 @@ editcmd :: Command editcmd = mkcmd "edit" "same as unlock" mkcmd :: String -> String -> Command -mkcmd n d = notDirect $ withGlobalOptions (jsonOption : annexedMatchingOptions) $ - command n SectionCommon d paramPaths (withParams seek) +mkcmd n d = notDirect $ + withGlobalOptions [jsonOptions, annexedMatchingOptions] $ + command n SectionCommon d paramPaths (withParams seek) seek :: CmdParams -> CommandSeek seek ps = withFilesInGit (whenAnnexed start) =<< workTreeItems ps diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 295d11994..fddb2b5c6 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -17,7 +17,7 @@ import Annex.UUID import qualified Data.Map as M cmd :: Command -cmd = noCommit $ withGlobalOptions (jsonOption : annexedMatchingOptions) $ +cmd = noCommit $ withGlobalOptions [jsonOptions, annexedMatchingOptions] $ command "whereis" SectionQuery "lists repositories that have file content" paramPaths (seek <$$> optParser) diff --git a/Messages/Internal.hs b/Messages/Internal.hs index 3972503dc..42ad14d51 100644 --- a/Messages/Internal.hs +++ b/Messages/Internal.hs @@ -1,6 +1,6 @@ {- git-annex output messages, including concurrent output to display regions - - - Copyright 2010-2016 Joey Hess <id@joeyh.name> + - Copyright 2010-2018 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -11,7 +11,8 @@ import Common import Annex import Types.Messages import Messages.Concurrent -import Messages.JSON +import qualified Messages.JSON as JSON +import Messages.JSON (JSONBuilder) withMessageState :: (MessageState -> Annex a) -> Annex a withMessageState a = Annex.getState Annex.output >>= a @@ -30,11 +31,11 @@ outputMessage' jsonoutputter jsonbuilder msg = withMessageState $ \s -> case out -- Buffer changes to JSON until end is reached and then emit it. bufferJSON :: JSONBuilder -> MessageState -> Annex Bool bufferJSON jsonbuilder s = case outputType s of - JSONOutput _ + JSONOutput jsonoptions | endjson -> do Annex.changeState $ \st -> st { Annex.output = s { jsonBuffer = Nothing } } - maybe noop (liftIO . flushed . emit) json + maybe noop (liftIO . flushed . JSON.emit . JSON.finalize jsonoptions) json return True | otherwise -> do Annex.changeState $ \st -> @@ -53,16 +54,20 @@ bufferJSON jsonbuilder s = case outputType s of outputJSON :: JSONBuilder -> MessageState -> Annex Bool outputJSON jsonbuilder s = case outputType s of JSONOutput _ -> do - maybe noop (liftIO . flushed . emit) + maybe noop (liftIO . flushed . JSON.emit) (fst <$> jsonbuilder Nothing) return True _ -> return False outputError :: String -> Annex () -outputError msg = withMessageState $ \s -> - if concurrentOutputEnabled s - then concurrentMessage s True msg go - else go +outputError msg = withMessageState $ \s -> case (outputType s, jsonBuffer s) of + (JSONOutput jsonoptions, Just jb) | jsonErrorMessages jsonoptions -> + let jb' = Just (JSON.addErrorMessage (lines msg) jb) + in Annex.changeState $ \st -> + st { Annex.output = s { jsonBuffer = jb' } } + _ + | concurrentOutputEnabled s -> concurrentMessage s True msg go + | otherwise -> go where go = liftIO $ do hFlush stdout diff --git a/Messages/JSON.hs b/Messages/JSON.hs index 9b9ca67cf..897eb8cbf 100644 --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -1,6 +1,6 @@ {- git-annex command-line JSON output and input - - - Copyright 2011-2016 Joey Hess <id@joeyh.name> + - Copyright 2011-2018 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -14,6 +14,8 @@ module Messages.JSON ( none, start, end, + finalize, + addErrorMessage, note, info, add, @@ -28,6 +30,7 @@ import Data.Aeson import Control.Applicative import qualified Data.Map as M import qualified Data.Text as T +import qualified Data.Vector as V import qualified Data.ByteString.Lazy as B import qualified Data.HashMap.Strict as HM import System.IO @@ -37,6 +40,7 @@ import Data.Maybe import Data.Monoid import Prelude +import Types.Messages import Key import Utility.Metered import Utility.Percentage @@ -74,6 +78,21 @@ end :: Bool -> JSONBuilder end b (Just (o, _)) = Just (HM.insert "success" (toJSON b) o, True) end _ Nothing = Nothing +finalize :: JSONOptions -> Object -> Object +finalize jsonoptions o + -- Always include error-messages field, even if empty, + -- to make the json be self-documenting. + | jsonErrorMessages jsonoptions = addErrorMessage [] o + | otherwise = o + +addErrorMessage :: [String] -> Object -> Object +addErrorMessage msg o = + HM.insertWith combinearray "error-messages" v o + where + combinearray (Array new) (Array old) = Array (old <> new) + combinearray new _old = new + v = Array $ V.fromList $ map (String . T.pack) msg + note :: String -> JSONBuilder note _ Nothing = Nothing note s (Just (o, e)) = Just (HM.insertWith combinelines "note" (toJSON s) o, e) diff --git a/Messages/Progress.hs b/Messages/Progress.hs index 61486d78d..cb924eeac 100644 --- a/Messages/Progress.hs +++ b/Messages/Progress.hs @@ -55,12 +55,13 @@ metered othermeter key getsrcfile a = withMessageState $ \st -> #else nometer #endif - go _ (MessageState { outputType = JSONOutput False }) = nometer - go msize (MessageState { outputType = JSONOutput True }) = do - buf <- withMessageState $ return . jsonBuffer - m <- liftIO $ rateLimitMeterUpdate 0.1 msize $ - JSON.progress buf msize - a (combinemeter m) + go msize (MessageState { outputType = JSONOutput jsonoptions }) + | jsonProgress jsonoptions = do + buf <- withMessageState $ return . jsonBuffer + m <- liftIO $ rateLimitMeterUpdate 0.1 msize $ + JSON.progress buf msize + a (combinemeter m) + | otherwise = nometer nometer = a $ combinemeter (const noop) @@ -96,7 +97,7 @@ meteredFile file combinemeterupdate key a = needOutputMeter :: MessageState -> Bool needOutputMeter s = case outputType s of - JSONOutput True -> True + JSONOutput jsonoptions -> jsonProgress jsonoptions NormalOutput | concurrentOutputEnabled s -> True _ -> False diff --git a/Types/Messages.hs b/Types/Messages.hs index 551531349..d45174bb7 100644 --- a/Types/Messages.hs +++ b/Types/Messages.hs @@ -1,6 +1,6 @@ {- git-annex Messages data types - - - Copyright 2012-2017 Joey Hess <id@joeyh.name> + - Copyright 2012-2018 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -16,9 +16,22 @@ import Control.Concurrent import System.Console.Regions (ConsoleRegion) #endif -data OutputType = NormalOutput | QuietOutput | JSONOutput Bool +data OutputType = NormalOutput | QuietOutput | JSONOutput JSONOptions deriving (Show) +data JSONOptions = JSONOptions + { jsonProgress :: Bool + , jsonErrorMessages :: Bool + } + deriving (Show) + +adjustOutputType :: OutputType -> OutputType -> OutputType +adjustOutputType (JSONOutput old) (JSONOutput new) = JSONOutput $ JSONOptions + { jsonProgress = jsonProgress old || jsonProgress new + , jsonErrorMessages = jsonErrorMessages old || jsonErrorMessages new + } +adjustOutputType _old new = new + data SideActionBlock = NoBlock | StartBlock | InBlock deriving (Eq) diff --git a/debian/control b/debian/control index ee90a1149..e9fafef6a 100644 --- a/debian/control +++ b/debian/control @@ -77,6 +77,7 @@ Build-Depends: libghc-mountpoints-dev, libghc-magic-dev, libghc-socks-dev, + libghc-vector-dev, lsof [linux-any], ikiwiki, libimage-magick-perl, diff --git a/doc/git-annex-add.mdwn b/doc/git-annex-add.mdwn index 2ebbbac06..ff7bc4004 100644 --- a/doc/git-annex-add.mdwn +++ b/doc/git-annex-add.mdwn @@ -66,6 +66,11 @@ annexed content, and other symlinks. Enable JSON output. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + * `--batch` Enables batch mode, in which a file to add is read in a line from stdin, diff --git a/doc/git-annex-addurl.mdwn b/doc/git-annex-addurl.mdwn index a43976b56..4748073ed 100644 --- a/doc/git-annex-addurl.mdwn +++ b/doc/git-annex-addurl.mdwn @@ -97,6 +97,11 @@ be used to get better filenames. Include progress objects in JSON output. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # CAVEATS If annex.largefiles is configured, and does not match a file, `git annex diff --git a/doc/git-annex-copy.mdwn b/doc/git-annex-copy.mdwn index c15a29f72..e817fd618 100644 --- a/doc/git-annex-copy.mdwn +++ b/doc/git-annex-copy.mdwn @@ -97,6 +97,11 @@ Copies the content of files from or to another remote. Include progress objects in JSON output. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # SEE ALSO [[git-annex]](1) diff --git a/doc/git-annex-drop.mdwn b/doc/git-annex-drop.mdwn index 7b052bee0..0c07e150d 100644 --- a/doc/git-annex-drop.mdwn +++ b/doc/git-annex-drop.mdwn @@ -87,6 +87,11 @@ safe to do so. Enable JSON output. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # SEE ALSO [[git-annex]](1) diff --git a/doc/git-annex-dropkey.mdwn b/doc/git-annex-dropkey.mdwn index 0107ab538..681640737 100644 --- a/doc/git-annex-dropkey.mdwn +++ b/doc/git-annex-dropkey.mdwn @@ -29,6 +29,11 @@ exist; using it can easily result in data loss. Enable JSON output. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # SEE ALSO [[git-annex]](1) diff --git a/doc/git-annex-examinekey.mdwn b/doc/git-annex-examinekey.mdwn index 49bc95711..83baa5667 100644 --- a/doc/git-annex-examinekey.mdwn +++ b/doc/git-annex-examinekey.mdwn @@ -33,6 +33,11 @@ that can be determined purely by looking at the key. Enable JSON output. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + * `--batch` Enable batch mode, in which a line containing a key is read from stdin, diff --git a/doc/git-annex-find.mdwn b/doc/git-annex-find.mdwn index 9c578c245..dafb0e7b3 100644 --- a/doc/git-annex-find.mdwn +++ b/doc/git-annex-find.mdwn @@ -54,6 +54,11 @@ finds files in the current directory and its subdirectories. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + * `--batch` Enables batch mode, in which a file is read in a line from stdin, diff --git a/doc/git-annex-fsck.mdwn b/doc/git-annex-fsck.mdwn index a320bb8a3..a9392935f 100644 --- a/doc/git-annex-fsck.mdwn +++ b/doc/git-annex-fsck.mdwn @@ -98,6 +98,11 @@ With parameters, only the specified files are checked. Enable JSON output. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # OPTIONS # SEE ALSO diff --git a/doc/git-annex-get.mdwn b/doc/git-annex-get.mdwn index b7f2f74b2..2f3981165 100644 --- a/doc/git-annex-get.mdwn +++ b/doc/git-annex-get.mdwn @@ -106,6 +106,11 @@ or transferring them from some kind of key-value store. Include progress objects in JSON output. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # SEE ALSO [[git-annex]](1) diff --git a/doc/git-annex-import.mdwn b/doc/git-annex-import.mdwn index 3684505b6..c1bcbd2b9 100644 --- a/doc/git-annex-import.mdwn +++ b/doc/git-annex-import.mdwn @@ -81,6 +81,11 @@ Several options can be used to adjust handling of duplicate files. Enable JSON output. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # CAVEATS Note that using `--deduplicate` or `--clean-duplicates` with the WORM diff --git a/doc/git-annex-info.mdwn b/doc/git-annex-info.mdwn index 896522944..311edc4d9 100644 --- a/doc/git-annex-info.mdwn +++ b/doc/git-annex-info.mdwn @@ -26,6 +26,11 @@ for the repository as a whole. Enable JSON output. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + * `--bytes` Show file sizes in bytes, disabling the default nicer units. diff --git a/doc/git-annex-lock.mdwn b/doc/git-annex-lock.mdwn index cf4910b95..c13654dbe 100644 --- a/doc/git-annex-lock.mdwn +++ b/doc/git-annex-lock.mdwn @@ -23,6 +23,11 @@ the files any longer, or have made modifications you want to discard. Enable JSON output. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # SEE ALSO [[git-annex]](1) diff --git a/doc/git-annex-metadata.mdwn b/doc/git-annex-metadata.mdwn index fa1a884b3..7786d999b 100644 --- a/doc/git-annex-metadata.mdwn +++ b/doc/git-annex-metadata.mdwn @@ -112,6 +112,11 @@ automatically. {"command":"metadata","file":"foo","key":"...","author":["bar"],...,"note":"...","success":true} +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + * `--batch` Enables batch mode, which can be used to both get, store, and unset diff --git a/doc/git-annex-mirror.mdwn b/doc/git-annex-mirror.mdwn index b7644a75d..d665a6e77 100644 --- a/doc/git-annex-mirror.mdwn +++ b/doc/git-annex-mirror.mdwn @@ -75,6 +75,11 @@ contents. Use [[git-annex-sync]](1) for that. Include progress objects in JSON output. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # SEE ALSO [[git-annex]](1) diff --git a/doc/git-annex-move.mdwn b/doc/git-annex-move.mdwn index 4e42e934f..ce932b198 100644 --- a/doc/git-annex-move.mdwn +++ b/doc/git-annex-move.mdwn @@ -92,6 +92,11 @@ Moves the content of files from or to another remote. Include progress objects in JSON output. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # SEE ALSO [[git-annex]](1) diff --git a/doc/git-annex-status.mdwn b/doc/git-annex-status.mdwn index 3a897dc24..f322606e8 100644 --- a/doc/git-annex-status.mdwn +++ b/doc/git-annex-status.mdwn @@ -18,15 +18,20 @@ Particularly useful in direct mode. # OPTIONS +* `--ignore-submodules=when` + + This option is passed on to git status, see its man page for + details. + * `--json` Enable JSON output. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. -* `--ignore-submodules=when` +* `--json-error-messages` - This option is passed on to git status, see its man page for - details. + Messages that would normally be output to standard error are included in + the json instead. # SEE ALSO diff --git a/doc/git-annex-unlock.mdwn b/doc/git-annex-unlock.mdwn index 28defa4f7..b5dcc7e5e 100644 --- a/doc/git-annex-unlock.mdwn +++ b/doc/git-annex-unlock.mdwn @@ -42,6 +42,11 @@ file to be lost from the local repository. So, enable annex.thin with care. Enable JSON output. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # SEE ALSO [[git-annex]](1) diff --git a/doc/git-annex-whereis.mdwn b/doc/git-annex-whereis.mdwn index b95033cbd..8ce8c6df1 100644 --- a/doc/git-annex-whereis.mdwn +++ b/doc/git-annex-whereis.mdwn @@ -43,11 +43,6 @@ For example: Show whereis information for files found by last run of git-annex unused. -* `--json` - - Enable JSON output. This is intended to be parsed by programs that use - git-annex. Each line of output is a JSON object. - * `--batch` Enables batch mode, in which a file is read in a line from stdin, @@ -56,6 +51,16 @@ For example: Note that if the file is not an annexed file, an empty line will be output instead. +* `--json` + + Enable JSON output. This is intended to be parsed by programs that use + git-annex. Each line of output is a JSON object. + +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + # SEE ALSO [[git-annex]](1) diff --git a/doc/todo/include_msg_with_possible_reason_why_command___40__e.g._add__41___failed_into_--json_output/comment_7_246e35f32f77af3b2924577b1bf45001._comment b/doc/todo/include_msg_with_possible_reason_why_command___40__e.g._add__41___failed_into_--json_output/comment_7_246e35f32f77af3b2924577b1bf45001._comment new file mode 100644 index 000000000..7bbe0e00c --- /dev/null +++ b/doc/todo/include_msg_with_possible_reason_why_command___40__e.g._add__41___failed_into_--json_output/comment_7_246e35f32f77af3b2924577b1bf45001._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 7""" + date="2018-02-19T19:49:11Z" + content=""" +Basic --json-error-messages implemented after 4 hours work. + +Still needing to be done: + +* A few commands like `git annex info` have a custom json outputter, + and may not output the error-messages field by default, or may not make + sense to support the option. +* Flush json buffer after fatal error. +"""]] diff --git a/git-annex.cabal b/git-annex.cabal index b02ea2e14..68bd9f01f 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -350,6 +350,7 @@ Executable git-annex persistent, persistent-template, aeson, + vector, tagsoup, unordered-containers, feed (>= 0.3.9), |