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

diff --git a/CHANGELOG b/CHANGELOG
index c753ded9e7d3e4ec0b813a73791a9f287fc5f644..2d691b120926f6fd3e83938de53635cc1ae61ad6 100644 (file)
--- a/CHANGELOG
+++ b/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
 

diff --git a/Command/Reinject.hs b/Command/Reinject.hs
index 13109ac005d861a0fbf9a16cc703a0943bd1e261..98b729a2877b3ddec130dc78aeada41d0db874f1 100644 (file)
--- a/Command/Reinject.hs
+++ b/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

diff --git a/doc/git-annex-reinject.mdwn b/doc/git-annex-reinject.mdwn
index 3c07263a6f0d6cbccb0443e6ef17445d0718a01e..98fbbfc22e7181198e4d5b6857ecedef971c65ed 100644 (file)
--- a/doc/git-annex-reinject.mdwn
+++ b/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

diff --git a/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn b/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn
index 82bc64974a6ffdcb00d261e2e09ad9f42feac3fe..2205eb5fe718257f0e4fee84c1717207392d4ccb 100644 (file)
--- a/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn
+++ b/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