factor out maybeAddJSONField

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

Command/MetaData.hs

@@ -12,11 +12,10 @@ import Annex.MetaData
 import Annex.VectorClock
 import Logs.MetaData
 import Annex.WorkTree
-import Messages.JSON (JSONActionItem(..), AddJSONActionItemField(..))
 import Types.Messages
-import Utility.Aeson
 import Utility.SafeOutput
 import Limit
+import Messages.JSON (JSONActionItem(..), eitherDecode)
 
 import qualified Data.Set as S
 import qualified Data.Map as M
@@ -127,9 +126,7 @@ perform c o k = case getSet o of
 cleanup :: Key -> CommandCleanup
 cleanup k = do
 	m <- getCurrentMetaData k
-	case toJSON' (AddJSONActionItemField "fields" m) of
-		Object o -> maybeShowJSON $ AesonObject o
-		_ -> noop
+	maybeAddJSONField "fields" m
 	showLongNote $ UnquotedString $ unlines $ concatMap showmeta $
 		map unwrapmeta (fromMetaData m)
 	return True

Command/Reinject.hs

@@ -18,8 +18,6 @@ import Utility.Metered
 import Annex.WorkTree
 import qualified Git
 import qualified Annex
-import Utility.Aeson
-import Messages.JSON (AddJSONActionItemField(..))
 
 cmd :: Command
 cmd = withAnnexOptions [backendOption, jsonOptions] $
@@ -98,9 +96,7 @@ notAnnexed src a =
 
 perform :: RawFilePath -> Key -> CommandPerform
 perform src key = do
-	case toJSON' (AddJSONActionItemField "key" (serializeKey key)) of
-		Object o -> maybeShowJSON $ AesonObject o
-		_ -> noop
+	maybeAddJSONField "key" (serializeKey key)
 	ifM move
 		( next $ cleanup key
 		, giveup "failed"

Command/Unused.hs

@@ -35,7 +35,6 @@ 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
@@ -115,11 +114,9 @@ check fileprefix msg a c = do
 	let unusedlist = number c l
 	unless (null l) $
 		showLongNote $ UnquotedString $ msg 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
+	maybeAddJSONField
+		((if null fileprefix then "unused" else fileprefix) ++ "-list")
+		(V.fromList $ map (\(n,  k) -> (show n, serializeKey k)) unusedlist)
 	updateUnusedLog (toRawFilePath fileprefix) (M.fromList unusedlist)
 	return $ c + length l
 

Messages.hs

@@ -37,6 +37,7 @@ module Messages (
 	JSON.JSONChunk(..),
 	maybeShowJSON,
 	maybeShowJSON',
+	maybeAddJSONField,
 	showFullJSON,
 	showCustom,
 	showHeader,
@@ -227,6 +228,12 @@ maybeShowJSON v = void $ withMessageState $ bufferJSON (JSON.add v)
 maybeShowJSON' :: JSON.JSONBuilder -> Annex ()
 maybeShowJSON' v = void $ withMessageState $ bufferJSON v
 
+{- Adds a field to the current json object. -}
+maybeAddJSONField :: JSON.ToJSON' v => String -> v -> Annex ()
+maybeAddJSONField f v = case JSON.toJSON' (JSON.AddJSONActionItemField f v) of
+	JSON.Object o -> maybeShowJSON $ JSON.AesonObject o
+	_ -> noop
+
 {- Shows a complete JSON value, only when in json mode. -}
 showFullJSON :: JSON.JSONChunk v -> Annex Bool
 showFullJSON v = withMessageState $ bufferJSON (JSON.complete v)

Messages/JSON.hs

@@ -12,7 +12,6 @@ module Messages.JSON (
 	JSONChunk(..),
 	emit,
 	emit',
-	encode,
 	none,
 	start,
 	startActionItem,
@@ -29,6 +28,7 @@ module Messages.JSON (
 	ObjectMap(..),
 	JSONActionItem(..),
 	AddJSONActionItemField(..),
+	module Utility.Aeson,
 ) where
 
 import Control.Applicative

doc/todo/--json_for_unannex__and_ideally_any_other_command_.mdwn

@@ -45,7 +45,6 @@ Provisional list of commands that don't support --json and maybe should:
 * git-annex-initremote
 * git-annex-merge
 * git-annex-renameremote
-* git-annex-sync
 * git-annex-upgrade
 
 These commands could support json, but I punted:
@@ -113,3 +112,11 @@ These commands have been reviewed and should not support json:
   (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)
+* git-annex-sync (while it would be pretty easy to support, it outputs
+  different types of messages depending on what remotes it syncs with and
+  what needs to be done. Eg, copy to remote, or export to remote, or import
+  from remote. Each would be a different format of json message, which
+  violates the principle that all git-annex json output should be
+  discoverable by simply running the command. And of course, everything it
+  does can be done by other commands, which can support json without having
+  that problem.)