From c20844229264950a6d87cc6baf3f82041d33bfe7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 8 May 2023 14:39:12 -0400 Subject: [PATCH] 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 --- CHANGELOG | 3 ++- Command/MetaData.hs | 4 ++-- Command/Unused.hs | 19 ++++++++++++++----- Messages/JSON.hs | 16 ++++++++++------ doc/git-annex-unused.mdwn | 10 ++++++++++ ...annex__and_ideally_any_other_command_.mdwn | 4 ++-- 6 files changed, 40 insertions(+), 16 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index 8b98c34004..ecd1b86f9d 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -39,7 +39,8 @@ git-annex (10.20230408) UNRELEASED; urgency=medium broken. * Support --json and --json-error-messages in more commands (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 documented, omitting a trailing "s" that was included in the output before. diff --git a/Command/MetaData.hs b/Command/MetaData.hs index b01b751641..d5a280ec4b 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -12,7 +12,7 @@ import Annex.MetaData import Annex.VectorClock import Logs.MetaData import Annex.WorkTree -import Messages.JSON (JSONActionItem(..), AddJSONActionItemFields(..)) +import Messages.JSON (JSONActionItem(..), AddJSONActionItemField(..)) import Types.Messages import Utility.Aeson import Utility.SafeOutput @@ -127,7 +127,7 @@ perform c o k = case getSet o of cleanup :: Key -> CommandCleanup cleanup k = do m <- getCurrentMetaData k - case toJSON' (AddJSONActionItemFields m) of + case toJSON' (AddJSONActionItemField "fields" m) of Object o -> maybeShowJSON $ AesonObject o _ -> noop showLongNote $ UnquotedString $ unlines $ concatMap showmeta $ diff --git a/Command/Unused.hs b/Command/Unused.hs index aa4f70aee9..d78ada994a 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -34,15 +34,19 @@ import Logs.View (is_branchView) import Annex.BloomFilter import qualified Database.Keys import Annex.InodeSentinal +import Utility.Aeson +import Messages.JSON (AddJSONActionItemField(..)) import qualified Data.Map as M +import qualified Data.Vector as V import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import Data.Char cmd :: Command -cmd = command "unused" SectionMaintenance "look for unused file content" - paramNothing (seek <$$> optParser) +cmd = withAnnexOptions [jsonOptions] $ + command "unused" SectionMaintenance "look for unused file content" + paramNothing (seek <$$> optParser) data UnusedOptions = UnusedOptions { fromRemote :: Maybe RemoteName @@ -105,13 +109,18 @@ checkRemoteUnused remotename refspec = go =<< Remote.nameToUUID remotename Just ks -> excludeReferenced refspec ks Nothing -> giveup "This repository is read-only." -check :: FilePath -> ([(Int, Key)] -> String) -> Annex [Key] -> Int -> Annex Int -check file msg a c = do +check :: String -> ([(Int, Key)] -> String) -> Annex [Key] -> Int -> Annex Int +check fileprefix msg a c = do l <- a let unusedlist = number c l unless (null l) $ 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 number :: Int -> [a] -> [(Int, a)] diff --git a/Messages/JSON.hs b/Messages/JSON.hs index 00acc4d244..2347f24d45 100644 --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -28,7 +28,7 @@ module Messages.JSON ( DualDisp(..), ObjectMap(..), JSONActionItem(..), - AddJSONActionItemFields(..), + AddJSONActionItemField(..), ) where import Control.Applicative @@ -223,7 +223,9 @@ instance ToJSON' a => ToJSON' (JSONActionItem a) where , case itemKey i of Just k -> Just $ "key" .= toJSON' k Nothing -> Nothing - , Just $ "file" .= toJSON' (itemFile i) + , case itemFile i of + Just f -> Just $ "file" .= toJSON' f + Nothing -> Nothing , case itemFields i of Just f -> Just $ "fields" .= toJSON' f Nothing -> Nothing @@ -240,13 +242,15 @@ instance FromJSON a => FromJSON (JSONActionItem a) where <*> (v .:? "file") <*> (v .:? "uuid") <*> (v .:? "fields") + -- ^ fields is used for metadata, which is currently the + -- only json that gets parsed <*> pure (SeekInput []) 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. -newtype AddJSONActionItemFields a = AddJSONActionItemFields a +data AddJSONActionItemField a = AddJSONActionItemField String a deriving (Show) -instance ToJSON' a => ToJSON' (AddJSONActionItemFields a) where - toJSON' (AddJSONActionItemFields a) = object [ ("fields", toJSON' a) ] +instance ToJSON' a => ToJSON' (AddJSONActionItemField a) where + toJSON' (AddJSONActionItemField f a) = object [ (textKey (packString f), toJSON' a) ] diff --git a/doc/git-annex-unused.mdwn b/doc/git-annex-unused.mdwn index fea0b98e4c..32bd720f1b 100644 --- a/doc/git-annex-unused.mdwn +++ b/doc/git-annex-unused.mdwn @@ -45,6 +45,16 @@ For example, to move all unused data to origin: The git configuration annex.used-refspec can be used to configure 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. # REFSPEC FORMAT 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 52a286f566..1f3230ee76 100644 --- a/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn +++ b/doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn @@ -31,6 +31,7 @@ These commands have been updated to support --json: * git-annex-untrust * git-annex-dead * git-annex-describe +* git-annex-unused 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-init * git-annex-initremote -* git-annex-inprogress * git-annex-merge * git-annex-reinit * git-annex-reinject * git-annex-renameremote * git-annex-sync -* git-annex-unused * git-annex-upgrade 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 (no output that would be useful to a program using these. They enter a new branch and git branch will tell what it is.) +* git-annex-inprogress (output is already machine readable)