unused: Support --json and --json-error-messages

Generalized AddJSONActionItemField to allow it to add several fields. Not entirely
happy with that, since the names of the fields have to be carefully chosen to
not conflict with other json fields. And fields added that way can't be parsed
back in FromJSON, except for the "fields" field that is special cased for metadata.
Still, I couldn't see another way to do it.

Also, omit file:null from the json output. Which does affect other commands,
eg git-annex whereis --all --json. Hopefully that won't break something that expects
a null file. If it did, that could be reverted, but it would be ugly to have
file:null in the unused --json

Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project
This commit is contained in:
Joey Hess 2023-05-08 14:39:12 -04:00
parent dd90c7abda
commit c208442292
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 40 additions and 16 deletions

View file

@ -39,7 +39,8 @@ git-annex (10.20230408) UNRELEASED; urgency=medium
broken. broken.
* Support --json and --json-error-messages in more commands * Support --json and --json-error-messages in more commands
(addunused, dead, describe, dropunused, expire, fix, log, migrate, (addunused, dead, describe, dropunused, expire, fix, log, migrate,
rekey, rmurl, semitrust, setpresentkey, trust, unannex, undo, untrust) rekey, rmurl, semitrust, setpresentkey, trust, unannex, undo, untrust,
unused)
* log: When --raw-date is used, display only seconds from the epoch, as * log: When --raw-date is used, display only seconds from the epoch, as
documented, omitting a trailing "s" that was included in the output documented, omitting a trailing "s" that was included in the output
before. before.

View file

@ -12,7 +12,7 @@ import Annex.MetaData
import Annex.VectorClock import Annex.VectorClock
import Logs.MetaData import Logs.MetaData
import Annex.WorkTree import Annex.WorkTree
import Messages.JSON (JSONActionItem(..), AddJSONActionItemFields(..)) import Messages.JSON (JSONActionItem(..), AddJSONActionItemField(..))
import Types.Messages import Types.Messages
import Utility.Aeson import Utility.Aeson
import Utility.SafeOutput import Utility.SafeOutput
@ -127,7 +127,7 @@ perform c o k = case getSet o of
cleanup :: Key -> CommandCleanup cleanup :: Key -> CommandCleanup
cleanup k = do cleanup k = do
m <- getCurrentMetaData k m <- getCurrentMetaData k
case toJSON' (AddJSONActionItemFields m) of case toJSON' (AddJSONActionItemField "fields" m) of
Object o -> maybeShowJSON $ AesonObject o Object o -> maybeShowJSON $ AesonObject o
_ -> noop _ -> noop
showLongNote $ UnquotedString $ unlines $ concatMap showmeta $ showLongNote $ UnquotedString $ unlines $ concatMap showmeta $

View file

@ -34,15 +34,19 @@ import Logs.View (is_branchView)
import Annex.BloomFilter import Annex.BloomFilter
import qualified Database.Keys import qualified Database.Keys
import Annex.InodeSentinal import Annex.InodeSentinal
import Utility.Aeson
import Messages.JSON (AddJSONActionItemField(..))
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Vector as V
import qualified Data.ByteString as S import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
import Data.Char import Data.Char
cmd :: Command cmd :: Command
cmd = command "unused" SectionMaintenance "look for unused file content" cmd = withAnnexOptions [jsonOptions] $
paramNothing (seek <$$> optParser) command "unused" SectionMaintenance "look for unused file content"
paramNothing (seek <$$> optParser)
data UnusedOptions = UnusedOptions data UnusedOptions = UnusedOptions
{ fromRemote :: Maybe RemoteName { fromRemote :: Maybe RemoteName
@ -105,13 +109,18 @@ checkRemoteUnused remotename refspec = go =<< Remote.nameToUUID remotename
Just ks -> excludeReferenced refspec ks Just ks -> excludeReferenced refspec ks
Nothing -> giveup "This repository is read-only." Nothing -> giveup "This repository is read-only."
check :: FilePath -> ([(Int, Key)] -> String) -> Annex [Key] -> Int -> Annex Int check :: String -> ([(Int, Key)] -> String) -> Annex [Key] -> Int -> Annex Int
check file msg a c = do check fileprefix msg a c = do
l <- a l <- a
let unusedlist = number c l let unusedlist = number c l
unless (null l) $ unless (null l) $
showLongNote $ UnquotedString $ msg unusedlist showLongNote $ UnquotedString $ msg unusedlist
updateUnusedLog (toRawFilePath file) (M.fromList unusedlist) let v = V.fromList $ map (\(n, k) -> (show n, serializeKey k)) unusedlist
let f = (if null fileprefix then "unused" else fileprefix) ++ "-list"
case toJSON' (AddJSONActionItemField f v) of
Object o -> maybeShowJSON $ AesonObject o
_ -> noop
updateUnusedLog (toRawFilePath fileprefix) (M.fromList unusedlist)
return $ c + length l return $ c + length l
number :: Int -> [a] -> [(Int, a)] number :: Int -> [a] -> [(Int, a)]

View file

@ -28,7 +28,7 @@ module Messages.JSON (
DualDisp(..), DualDisp(..),
ObjectMap(..), ObjectMap(..),
JSONActionItem(..), JSONActionItem(..),
AddJSONActionItemFields(..), AddJSONActionItemField(..),
) where ) where
import Control.Applicative import Control.Applicative
@ -223,7 +223,9 @@ instance ToJSON' a => ToJSON' (JSONActionItem a) where
, case itemKey i of , case itemKey i of
Just k -> Just $ "key" .= toJSON' k Just k -> Just $ "key" .= toJSON' k
Nothing -> Nothing Nothing -> Nothing
, Just $ "file" .= toJSON' (itemFile i) , case itemFile i of
Just f -> Just $ "file" .= toJSON' f
Nothing -> Nothing
, case itemFields i of , case itemFields i of
Just f -> Just $ "fields" .= toJSON' f Just f -> Just $ "fields" .= toJSON' f
Nothing -> Nothing Nothing -> Nothing
@ -240,13 +242,15 @@ instance FromJSON a => FromJSON (JSONActionItem a) where
<*> (v .:? "file") <*> (v .:? "file")
<*> (v .:? "uuid") <*> (v .:? "uuid")
<*> (v .:? "fields") <*> (v .:? "fields")
-- ^ fields is used for metadata, which is currently the
-- only json that gets parsed
<*> pure (SeekInput []) <*> pure (SeekInput [])
parseJSON _ = mempty parseJSON _ = mempty
-- This can be used to populate the "fields" after a JSONActionItem -- This can be used to populate a field after a JSONActionItem
-- has already been started. -- has already been started.
newtype AddJSONActionItemFields a = AddJSONActionItemFields a data AddJSONActionItemField a = AddJSONActionItemField String a
deriving (Show) deriving (Show)
instance ToJSON' a => ToJSON' (AddJSONActionItemFields a) where instance ToJSON' a => ToJSON' (AddJSONActionItemField a) where
toJSON' (AddJSONActionItemFields a) = object [ ("fields", toJSON' a) ] toJSON' (AddJSONActionItemField f a) = object [ (textKey (packString f), toJSON' a) ]

View file

@ -45,6 +45,16 @@ For example, to move all unused data to origin:
The git configuration annex.used-refspec can be used to configure The git configuration annex.used-refspec can be used to configure
this in a more permanent fashion. this in a more permanent fashion.
* `--json`
Enable JSON output. This is intended to be parsed by programs that use
git-annex.
* `--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. * Also the [[git-annex-common-options]](1) can be used.
# REFSPEC FORMAT # REFSPEC FORMAT

View file

@ -31,6 +31,7 @@ These commands have been updated to support --json:
* git-annex-untrust * git-annex-untrust
* git-annex-dead * git-annex-dead
* git-annex-describe * git-annex-describe
* git-annex-unused
Provisional list of commands that don't support --json and maybe should: Provisional list of commands that don't support --json and maybe should:
@ -41,13 +42,11 @@ Provisional list of commands that don't support --json and maybe should:
* git-annex-importfeed * git-annex-importfeed
* git-annex-init * git-annex-init
* git-annex-initremote * git-annex-initremote
* git-annex-inprogress
* git-annex-merge * git-annex-merge
* git-annex-reinit * git-annex-reinit
* git-annex-reinject * git-annex-reinject
* git-annex-renameremote * git-annex-renameremote
* git-annex-sync * git-annex-sync
* git-annex-unused
* git-annex-upgrade * git-annex-upgrade
These commands could support json, but I punted: These commands could support json, but I punted:
@ -110,3 +109,4 @@ These commands have been reviewed and should not support json:
* git-annex-adjust, git-annex-vadd, git-annex-vcycle, git-annex-vfilter, git-annex-view, git-annex-vpop * 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 (no output that would be useful to a program using these. They enter a
new branch and git branch will tell what it is.) new branch and git branch will tell what it is.)
* git-annex-inprogress (output is already machine readable)