expire, trust et al, dead, describe: Support --json and --json-error-messages

For expire, the normal output is unchanged, but the --json output includes the uuid
in machine parseable form. Which could be very useful for this somewhat obscure
command. That needed ActionItemUUID to be implemented, which seemed like a lot
of work, but then ---

I had been going to skip implementing them for trust, untrust, dead, semitrust,
and describe, but putting the uuid in the json is useful information, it tells
what uuid git-annex picked given the input. It was not hard to support
these once ActionItemUUID was implemented.

Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project

CHANGELOG

@@ -38,12 +38,12 @@ git-annex (10.20230408) UNRELEASED; urgency=medium
   * initremote: Avoid creating a remote that is not encrypted when gpg is
     broken.
   * Support --json and --json-error-messages in more commands
-    (addunused, dropunused, fix, log, migrate, rekey, rmurl, 
+    (addunused, dead, describe, dropunused, expire, fix, log, migrate,
-    setpresentkey, unannex, undo)
+    rekey, rmurl, semitrust, setpresentkey, trust, unannex, undo, untrust)
   * log: When --raw-date is used, display only seconds from the epoch, as
     documented, omitting a trailing "s" that was included in the output
     before.
-  * addunused: Display the names of the files that it adds.
+  * addunused: Displays the names of the files that it adds.
 
  -- Joey Hess <id@joeyh.name>  Sat, 08 Apr 2023 13:57:18 -0400
 

Command/Dead.hs

@@ -15,7 +15,8 @@ import Remote (keyLocations)
 import Git.Types
 
 cmd :: Command
-cmd = command "dead" SectionSetup "hide a lost repository or key"
+cmd = withAnnexOptions [jsonOptions] $
+	command "dead" SectionSetup "hide a lost repository or key"
 		(paramRepeating paramRepository) (seek <$$> optParser)
 
 data DeadOptions = DeadRemotes [RemoteName] | DeadKeys [Key]

Command/Describe.hs

@@ -23,10 +23,10 @@ seek = withWords (commandAction . start)
 start :: [String] -> CommandStart
 start (name:description) | not (null description) = do
 	u <- Remote.nameToUUID name
+	let ai = ActionItemUUID u (UnquotedString name)
 	starting "describe" ai si $
 		perform u $ unwords description
   where
-	ai = ActionItemOther (Just (UnquotedString name))
 	si = SeekInput [name]
 start _ = giveup "Specify a repository and a description."	
 

Command/Expire.hs

@@ -22,7 +22,8 @@ import Data.Time.Clock.POSIX
 import qualified Data.Map as M
 
 cmd :: Command
-cmd = command "expire" SectionMaintenance
+cmd = withAnnexOptions [jsonOptions] $
+	command "expire" SectionMaintenance
 		"expire inactive repositories"
 		paramExpire (seek <$$> optParser)
 
@@ -79,7 +80,7 @@ start (Expire expire) noact actlog descs u =
 			return $ "last active: " ++ fromDuration d ++ " ago"
 		_  -> return "no activity"
 	desc = fromUUID u ++ " " ++ fromUUIDDesc (fromMaybe mempty (M.lookup u descs))
-	ai = ActionItemOther (Just (UnquotedString desc))
+	ai = ActionItemUUID u (UnquotedString desc)
 	si = SeekInput []
 	notexpired ent = case ent of
 		Unknown -> False

Command/Semitrust.hs

@@ -12,7 +12,8 @@ import Types.TrustLevel
 import Command.Trust (trustCommand)
 
 cmd :: Command
-cmd = command "semitrust" SectionSetup 
+cmd = withAnnexOptions [jsonOptions] $
+	command "semitrust" SectionSetup 
 		"return repository to default trust level"
 		(paramRepeating paramRepository) (withParams seek)
 

Command/Trust.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2010-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -17,7 +17,8 @@ import Logs.Group
 import qualified Data.Set as S
 
 cmd :: Command
-cmd = command "trust" SectionSetup "trust a repository"
+cmd = withAnnexOptions [jsonOptions] $
+	command "trust" SectionSetup "trust a repository"
 		(paramRepeating paramRepository) (withParams seek)
 
 seek :: CmdParams -> CommandSeek
@@ -30,7 +31,7 @@ trustCommand c level ps = withStrings (commandAction . start) ps
 	start name = do
 		u <- Remote.nameToUUID name
 		let si = SeekInput [name]
-		starting c (ActionItemOther (Just (UnquotedString name))) si (perform name u)
+		starting c (ActionItemUUID u (UnquotedString name)) si (perform name u)
 	perform name uuid = do
 		when (level >= Trusted) $
 			unlessM (Annex.getRead Annex.force) $

Command/Untrust.hs

@@ -12,7 +12,8 @@ import Types.TrustLevel
 import Command.Trust (trustCommand)
 
 cmd :: Command
-cmd = command "untrust" SectionSetup "do not trust a repository"
+cmd = withAnnexOptions [jsonOptions] $
+	command "untrust" SectionSetup "do not trust a repository"
 		(paramRepeating paramRepository) (withParams seek)
 
 seek :: CmdParams -> CommandSeek

Messages.hs

@@ -78,15 +78,11 @@ import qualified Messages.JSON as JSON
 import qualified Annex
 
 showStartMessage :: StartMessage -> Annex ()
-showStartMessage (StartMessage command ai si) = case ai of
+showStartMessage (StartMessage command ai si) =
-	ActionItemAssociatedFile _ _ -> showStartActionItem command ai si
+	outputMessage json id $
-	ActionItemKey _ -> showStartActionItem command ai si
+		UnquotedString command <> " " <> actionItemDesc ai <> " "
-	ActionItemBranchFilePath _ _ -> showStartActionItem command ai si
+  where
-	ActionItemFailedTransfer _ _ -> showStartActionItem command ai si
+	json = JSON.startActionItem command ai si
-	ActionItemTreeFile _ -> showStartActionItem command ai si
-	ActionItemOther Nothing -> showStartNothing command si
-	ActionItemOther _ -> showStartActionItem command ai si
-	OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si)
 showStartMessage (StartUsualMessages command ai si) = do
 	outputType <$> Annex.getState Annex.output >>= \case
 		QuietOutput -> Annex.setOutput NormalOutput
@@ -98,18 +94,6 @@ showStartMessage (CustomOutput _) =
 		NormalOutput -> Annex.setOutput QuietOutput
 		_ -> noop
 
-showStartActionItem :: String -> ActionItem -> SeekInput -> Annex ()
-showStartActionItem command ai si = outputMessage json id $
-	UnquotedString command <> " " <> actionItemDesc ai <> " "
-  where
-	json = JSON.start command (actionItemFile ai) (actionItemKey ai) si
-
-showStartNothing :: String -> SeekInput -> Annex ()
-showStartNothing command si = outputMessage json id $ UnquotedString $
-	command ++ " "
-  where
-	json = JSON.start command Nothing Nothing si
-
 -- Only show end result if the StartMessage is one that gets displayed.
 showEndMessage :: StartMessage -> Bool -> Annex ()
 showEndMessage (StartMessage _ _ _) = showEndResult

Messages/JSON.hs

@@ -1,6 +1,6 @@
 {- git-annex command-line JSON output and input
  -
- - Copyright 2011-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -15,6 +15,7 @@ module Messages.JSON (
 	encode,
 	none,
 	start,
+	startActionItem,
 	end,
 	finalize,
 	addErrorMessage,
@@ -47,6 +48,8 @@ import Data.Monoid
 import Prelude
 
 import Types.Command (SeekInput(..))
+import Types.ActionItem
+import Types.UUID
 import Key
 import Utility.Metered
 import Utility.Percentage
@@ -86,6 +89,21 @@ start command file key si _ = case j of
 		{ itemCommand = Just command
 		, itemKey = key
 		, itemFile = fromRawFilePath <$> file
+		, itemUUID = Nothing
+		, itemFields = Nothing :: Maybe Bool
+		, itemSeekInput = si
+		}
+
+startActionItem :: String -> ActionItem -> SeekInput -> JSONBuilder
+startActionItem command ai si _ = case j of
+	Object o -> Just (o, False)
+	_ -> Nothing
+  where
+	j = toJSON' $ JSONActionItem
+		{ itemCommand = Just command
+		, itemKey = actionItemKey ai
+		, itemFile = fromRawFilePath <$> actionItemFile ai
+		, itemUUID = actionItemUUID ai
 		, itemFields = Nothing :: Maybe Bool
 		, itemSeekInput = si
 		}
@@ -193,6 +211,7 @@ data JSONActionItem a = JSONActionItem
 	{ itemCommand :: Maybe String
 	, itemKey :: Maybe Key
 	, itemFile :: Maybe FilePath
+	, itemUUID :: Maybe UUID
 	, itemFields :: Maybe a
 	, itemSeekInput :: SeekInput
 	}
@@ -208,6 +227,9 @@ instance ToJSON' a => ToJSON' (JSONActionItem a) where
 		, case itemFields i of
 			Just f -> Just $ "fields" .= toJSON' f
 			Nothing -> Nothing
+		, case itemUUID i of
+			Just u -> Just $ "uuid" .= toJSON' u
+			Nothing -> Nothing
 		, Just $ "input" .= fromSeekInput (itemSeekInput i)
 		]
 
@@ -216,6 +238,7 @@ instance FromJSON a => FromJSON (JSONActionItem a) where
 		<$> (v .:? "command")
 		<*> (maybe (return Nothing) parseJSON =<< (v .:? "key"))
 		<*> (v .:? "file")
+		<*> (v .:? "uuid")
 		<*> (v .:? "fields")
 		<*> pure (SeekInput [])
 	parseJSON _ = mempty

Types/ActionItem.hs

@@ -14,6 +14,7 @@ module Types.ActionItem (
 
 import Key
 import Types.Transfer
+import Types.UUID
 import Git.FilePath
 import Git.Quote (StringContainingQuotedPath(..))
 import Utility.FileSystemEncoding
@@ -24,10 +25,12 @@ data ActionItem
 	| ActionItemBranchFilePath BranchFilePath Key
 	| ActionItemFailedTransfer Transfer TransferInfo
 	| ActionItemTreeFile RawFilePath
+	| ActionItemUUID UUID StringContainingQuotedPath
+	-- ^ UUID with a description or name of the repository
 	| ActionItemOther (Maybe StringContainingQuotedPath)
-	-- Use to avoid more than one thread concurrently processing the
-	-- same Key.
 	| OnlyActionOn Key ActionItem
+	-- ^ Use to avoid more than one thread concurrently processing the
+	-- same Key.
 	deriving (Show, Eq)
 
 class MkActionItem t where
@@ -69,6 +72,7 @@ actionItemDesc (ActionItemBranchFilePath bfp _) =
 actionItemDesc (ActionItemFailedTransfer t i) = actionItemDesc $
 	ActionItemAssociatedFile (associatedFile i) (transferKey t)
 actionItemDesc (ActionItemTreeFile f) = QuotedPath f
+actionItemDesc (ActionItemUUID _ desc) = desc
 actionItemDesc (ActionItemOther Nothing) = mempty
 actionItemDesc (ActionItemOther (Just v)) = v
 actionItemDesc (OnlyActionOn _ ai) = actionItemDesc ai
@@ -79,15 +83,21 @@ actionItemKey (ActionItemKey k) = Just k
 actionItemKey (ActionItemBranchFilePath _ k) = Just k
 actionItemKey (ActionItemFailedTransfer t _) = Just (transferKey t)
 actionItemKey (ActionItemTreeFile _) = Nothing
+actionItemKey (ActionItemUUID _ _) = Nothing
 actionItemKey (ActionItemOther _) = Nothing
 actionItemKey (OnlyActionOn _ ai) = actionItemKey ai
 
 actionItemFile :: ActionItem -> Maybe RawFilePath
 actionItemFile (ActionItemAssociatedFile (AssociatedFile af) _) = af
 actionItemFile (ActionItemTreeFile f) = Just f
+actionItemFile (ActionItemUUID _ _) = Nothing
 actionItemFile (OnlyActionOn _ ai) = actionItemFile ai
 actionItemFile _ = Nothing
 
+actionItemUUID :: ActionItem -> Maybe UUID
+actionItemUUID (ActionItemUUID uuid _) = Just uuid
+actionItemUUID _ = Nothing
+
 actionItemTransferDirection :: ActionItem -> Maybe Direction
 actionItemTransferDirection (ActionItemFailedTransfer t _) = Just $
 	transferDirection t

Types/UUID.hs

@@ -1,6 +1,6 @@
 {- git-annex UUID type
  -
- - Copyright 2011-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -10,6 +10,7 @@
 module Types.UUID where
 
 import qualified Data.ByteString as B
+import qualified Data.Text as T
 import qualified Data.Map as M
 import qualified Data.UUID as U
 import Data.Maybe
@@ -20,6 +21,7 @@ import qualified Data.Semigroup as Sem
 import Git.Types (ConfigValue(..))
 import Utility.FileSystemEncoding
 import Utility.QuickCheck
+import Utility.Aeson
 import qualified Utility.SimpleProtocol as Proto
 
 -- A UUID is either an arbitrary opaque string, or UUID info may be missing.
@@ -65,6 +67,18 @@ instance ToUUID ConfigValue where
 instance ToUUID U.UUID where
 	toUUID = toUUID . U.toASCIIBytes
 
+instance ToJSON' UUID where
+	toJSON' (UUID u) = toJSON' u
+	toJSON' NoUUID = toJSON' ""
+
+instance FromJSON UUID where
+	parseJSON (String t)
+		| isUUID s = pure (toUUID s)
+		| otherwise = mempty
+	  where
+		s = T.unpack t
+	parseJSON _ = mempty
+
 buildUUID :: UUID -> Builder
 buildUUID (UUID b) = byteString b
 buildUUID NoUUID = mempty

doc/git-annex-dead.mdwn

@@ -4,7 +4,7 @@ git-annex dead - hide a lost repository or key
 
 # SYNOPSIS
 
-git annex dead `[repository ...] [--key somekey]`
+git annex dead `[repository ...] [--key somekey ...]`
 
 # DESCRIPTION
 
@@ -28,6 +28,16 @@ by using eg, `git-annex reinject`.)
 
   Use to specify a key that is dead.
 
+* `--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.
+
 * Also the [[git-annex-common-options]](1) can be used.
 
 # SEE ALSO

doc/git-annex-describe.mdwn

@@ -20,7 +20,17 @@ no git remote corresponding to it.
 
 # OPTIONS
 
-* The [[git-annex-common-options]](1) can be used.
+* `--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.
+
+* Also the [[git-annex-common-options]](1) can be used.
 
 # SEE ALSO
 

doc/git-annex-expire.mdwn

@@ -48,6 +48,16 @@ expired.
   The first version of git-annex that recorded fsck activity was
   5.20150405.
 
+* `--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.
+
 * Also the [[git-annex-common-options]](1) can be used.
 
 # SEE ALSO

doc/git-annex-semitrust.mdwn

@@ -15,7 +15,17 @@ description, or their UUID. For the current repository, use "here".
 
 # OPTIONS
 
-* The [[git-annex-common-options]](1) can be used.
+* `--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.
+
+* Also the [[git-annex-common-options]](1) can be used.
 
 # SEE ALSO
 

doc/git-annex-trust.mdwn

@@ -23,7 +23,17 @@ the content has been lost.
 
 # OPTIONS
 
-* The [[git-annex-common-options]](1) can be used.
+* `--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.
+
+* Also the [[git-annex-common-options]](1) can be used.
 
 # SEE ALSO
 

doc/git-annex-untrust.mdwn

@@ -16,7 +16,17 @@ description, or their UUID. To untrust the current repository, use "here".
 
 # OPTIONS
 
-* The [[git-annex-common-options]](1) can be used.
+* `--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.
+
+* Also the [[git-annex-common-options]](1) can be used.
 
 # SEE ALSO
 

doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn

@@ -25,16 +25,18 @@ These commands have been updated to support --json:
 * git-annex-migrate
 * git-annex-addunused
 * git-annex-dropunused
+* git-annex-expire
+* git-annex-trust
+* git-annex-semitrust
+* git-annex-untrust
+* git-annex-dead
 
 Provisional list of commands that don't support --json and maybe should:
 
 (Feel free to reorder things to the top)
 
-* git-annex-adjust
 * git-annex-configremote
-* git-annex-dead
 * git-annex-enableremote
-* git-annex-expire
 * git-annex-importfeed
 * git-annex-init
 * git-annex-initremote
@@ -46,11 +48,6 @@ Provisional list of commands that don't support --json and maybe should:
 * git-annex-sync
 * git-annex-unused
 * git-annex-upgrade
-* git-annex-vadd
-* git-annex-vcycle
-* git-annex-vfilter
-* git-annex-view
-* git-annex-vpop
 
 These commands could support json, but I punted:
 
@@ -99,10 +96,6 @@ These commands have been reviewed and should not support json:
 * git-annex-mincopies, git-annex-numcopies (like git-annex-config)
 * git-annex-group (like git-annex-config)
 * git-annex-ungroup (no point if group doesn't)
-* git-annex-semitrust, git-annex-trust, git-annex-untrust, git-annex-describe, 
-  git-annex forget
-  (really nothing useful in output, besides an indication that the command
-  worked)
 * git-annex-filter-branch (output is already machine parseable)
 * git-annex-remotedaemon (plumbing, speaks its own protocol)
 * git-annex-repair (seems unlikely to be useful to integrate with
@@ -112,3 +105,7 @@ These commands have been reviewed and should not support json:
   seems unlikely to be useful to jsonize)
 * git-annex-multicast (runs uftp and displays its output)
 * git-annex-whereused (output is already machine parseable)
+* git-annex forget (output does not contain anything useful to a program)
+* git-annex-adjust, git-annex-vadd, git-annex-vcycle, git-annex-vfilter, git-annex-view, git-annex-vpop
+  (no output that would be useful to a program using these. They enter a
+  new branch and git branch will tell what it is.)