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:
parent
2a3c2b1843
commit
fcf5d11c63
11 changed files with 66 additions and 60 deletions
46
Messages.hs
46
Messages.hs
|
@ -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) ""
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue