add "input" field to json output

The use case of this field is mostly to support -J combined with --json.
When that is implemented, a user will be able to look at the field to
determine which of the requests they have sent it corresponds to.

The field typically has a single value in its list, but in some cases
mutliple values (eg 2 command-line params) are combined together and the
list will have more.

Note that json parsing was already non-strict, so old git-annex metadata
--json --batch can be fed json produced by the new git-annex and will
not stumble over the new field.
This commit is contained in:
Joey Hess 2020-09-15 16:22:44 -04:00
parent 2a3c2b1843
commit fcf5d11c63
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
11 changed files with 66 additions and 60 deletions

View file

@ -9,7 +9,7 @@
module Messages (
showStart,
showStart',
showStartOther,
showStartMessage,
showEndMessage,
StartMessage(..),
@ -64,39 +64,39 @@ import Types
import Types.Messages
import Types.ActionItem
import Types.Concurrency
import Types.Command (StartMessage(..))
import Types.Command (StartMessage(..), SeekInput)
import Types.Transfer (transferKey)
import Messages.Internal
import Messages.Concurrent
import qualified Messages.JSON as JSON
import qualified Annex
showStart :: String -> RawFilePath -> Annex ()
showStart command file = outputMessage json $
showStart :: String -> RawFilePath -> SeekInput -> Annex ()
showStart command file si = outputMessage json $
encodeBS' command <> " " <> file <> " "
where
json = JSON.start command (Just file) Nothing
json = JSON.start command (Just file) Nothing si
showStart' :: String -> Maybe String -> Annex ()
showStart' command mdesc = outputMessage json $ encodeBS' $
showStartKey :: String -> Key -> ActionItem -> SeekInput -> Annex ()
showStartKey command key ai si = outputMessage json $
encodeBS' command <> " " <> actionItemDesc ai <> " "
where
json = JSON.start command (actionItemWorkTreeFile ai) (Just key) si
showStartOther :: String -> Maybe String -> SeekInput -> Annex ()
showStartOther command mdesc si = outputMessage json $ encodeBS' $
command ++ (maybe "" (" " ++) mdesc) ++ " "
where
json = JSON.start command Nothing Nothing
showStartKey :: String -> Key -> ActionItem -> Annex ()
showStartKey command key i = outputMessage json $
encodeBS' command <> " " <> actionItemDesc i <> " "
where
json = JSON.start command (actionItemWorkTreeFile i) (Just key)
json = JSON.start command Nothing Nothing si
showStartMessage :: StartMessage -> Annex ()
showStartMessage (StartMessage command ai si) = case ai of
ActionItemAssociatedFile _ k -> showStartKey command k ai
ActionItemKey k -> showStartKey command k ai
ActionItemBranchFilePath _ k -> showStartKey command k ai
ActionItemFailedTransfer t _ -> showStartKey command (transferKey t) ai
ActionItemWorkTreeFile file -> showStart command file
ActionItemOther msg -> showStart' command msg
ActionItemAssociatedFile _ k -> showStartKey command k ai si
ActionItemKey k -> showStartKey command k ai si
ActionItemBranchFilePath _ k -> showStartKey command k ai si
ActionItemFailedTransfer t _ -> showStartKey command (transferKey t) ai si
ActionItemWorkTreeFile file -> showStart command file si
ActionItemOther msg -> showStartOther command msg si
OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si)
showStartMessage (StartUsualMessages command ai si) = do
outputType <$> Annex.getState Annex.output >>= \case
@ -238,9 +238,9 @@ showFullJSON v = withMessageState $ bufferJSON (JSON.complete v)
- a complete JSON document.
- This is only needed when showStart and showEndOk is not used.
-}
showCustom :: String -> Annex Bool -> Annex ()
showCustom command a = do
outputMessage (JSON.start command Nothing Nothing) ""
showCustom :: String -> SeekInput -> Annex Bool -> Annex ()
showCustom command si a = do
outputMessage (JSON.start command Nothing Nothing si) ""
r <- a
outputMessage (JSON.end r) ""