reinject: Support --json and --json-error-messages

Also fix support for operating on multiple pairs of files and keys.

Moved notAnnexed to inside starting, so error message will get into the json.

Cannot include the key in the starting as it's not known yet, so instead
add it to the json later.

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

CHANGELOG

@@ -39,12 +39,13 @@ git-annex (10.20230408) UNRELEASED; urgency=medium
     broken.
   * Support --json and --json-error-messages in more commands
     (addunused, dead, describe, dropunused, expire, fix, init, log, migrate,
-    reinit, rekey, rmurl, semitrust, setpresentkey, trust, unannex, undo,
-    untrust, unused)
+    reinit, reinject, rekey, rmurl, semitrust, setpresentkey, trust, unannex,
+    undo, untrust, unused)
   * 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: Displays the names of the files that it adds.
+  * reinject: Fix support for operating on multiple pairs of files and keys.
 
  -- Joey Hess <id@joeyh.name>  Sat, 08 Apr 2023 13:57:18 -0400
 

Command/Reinject.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2011-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -18,9 +18,11 @@ import Utility.Metered
 import Annex.WorkTree
 import qualified Git
 import qualified Annex
+import Utility.Aeson
+import Messages.JSON (AddJSONActionItemField(..))
 
 cmd :: Command
-cmd = withAnnexOptions [backendOption] $
+cmd = withAnnexOptions [backendOption, jsonOptions] $
 	command "reinject" SectionUtility 
 		"inject content of file back into annex"
 		(paramRepeating (paramPair "SRC" "DEST"))
@@ -43,50 +45,45 @@ optParser desc = ReinjectOptions
 seek :: ReinjectOptions -> CommandSeek
 seek os
 	| knownOpt os = withStrings (commandAction . startKnown) (params os)
-	| otherwise = withWords (commandAction . startSrcDest) (params os)
+	| otherwise = withPairs (commandAction . startSrcDest) (params os)
 
-startSrcDest :: [FilePath] -> CommandStart
-startSrcDest ps@(src:dest:[])
+startSrcDest :: (SeekInput, (String, String)) -> CommandStart
+startSrcDest (si, (src, dest))
 	| src == dest = stop
-	| otherwise = notAnnexed src' $
+	| otherwise = starting "reinject" ai si $ notAnnexed src' $
 		lookupKey (toRawFilePath dest) >>= \case
-			Just k -> go k
+			Just key -> ifM (verifyKeyContent key src')
+				( perform src' key
+				, do
+					qp <- coreQuotePath <$> Annex.getGitConfig
+					giveup $ decodeBS $ quote qp $ QuotedPath src'
+						<> " does not have expected content of "
+						<> QuotedPath (toRawFilePath dest)
+				)
 			Nothing -> do
 				qp <- coreQuotePath <$> Annex.getGitConfig
 				giveup $ decodeBS $ quote qp $ QuotedPath src'
 					<> " is not an annexed file"
   where
 	src' = toRawFilePath src
-	go key = starting "reinject" ai si $
-		ifM (verifyKeyContent key src')
-			( perform src' key
-			, do
-				qp <- coreQuotePath <$> Annex.getGitConfig
-				giveup $ decodeBS $ quote qp $ QuotedPath src'
-					<> " does not have expected content of "
-					<> QuotedPath (toRawFilePath dest)
-			)
 	ai = ActionItemOther (Just (QuotedPath src'))
-	si = SeekInput ps
-startSrcDest _ = giveup "specify a src file and a dest file"
 
 startKnown :: FilePath -> CommandStart
-startKnown src = notAnnexed src' $
-	starting "reinject" ai si $ do
-		(key, _) <- genKey ks nullMeterUpdate =<< defaultBackend
-		ifM (isKnownKey key)
-			( perform src' key
-			, do
-				warning "Not known content; skipping"
-				next $ return True
-			)
+startKnown src = starting "reinject" ai si $ notAnnexed src' $ do
+	(key, _) <- genKey ks nullMeterUpdate =<< defaultBackend
+	ifM (isKnownKey key)
+		( perform src' key
+		, do
+			warning "Not known content; skipping"
+			next $ return True
+		)
   where
 	src' = toRawFilePath src
 	ks = KeySource src' src' Nothing
 	ai = ActionItemOther (Just (QuotedPath src'))
 	si = SeekInput [src]
 
-notAnnexed :: RawFilePath -> CommandStart -> CommandStart
+notAnnexed :: RawFilePath -> CommandPerform -> CommandPerform
 notAnnexed src a = 
 	ifM (fromRepo Git.repoIsLocalBare)
 		( a
@@ -100,10 +97,14 @@ notAnnexed src a =
 		)
 
 perform :: RawFilePath -> Key -> CommandPerform
-perform src key = ifM move
-	( next $ cleanup key
-	, giveup "failed"
-	)
+perform src key = do
+	case toJSON' (AddJSONActionItemField "key" (serializeKey key)) of
+		Object o -> maybeShowJSON $ AesonObject o
+		_ -> noop
+	ifM move
+		( next $ cleanup key
+		, giveup "failed"
+		)
   where
 	move = checkDiskSpaceToGet key False $
 		moveAnnex key (AssociatedFile Nothing) src

doc/git-annex-reinject.mdwn

@@ -54,6 +54,16 @@ needing to specify the dest file.
   Specify the key-value backend to use when checking if a file is known
   with the `--known` option.
 
+* `--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

@@ -34,6 +34,7 @@ These commands have been updated to support --json:
 * git-annex-unused
 * git-annex-init
 * git-annex-reinit
+* git-annex-reinject
 
 Provisional list of commands that don't support --json and maybe should:
 
@@ -43,7 +44,6 @@ Provisional list of commands that don't support --json and maybe should:
 * git-annex-enableremote
 * git-annex-initremote
 * git-annex-merge
-* git-annex-reinject
 * git-annex-renameremote
 * git-annex-sync
 * git-annex-upgrade