diff options
-rw-r--r-- | CHANGELOG | 1 | ||||
-rw-r--r-- | Messages.hs | 15 | ||||
-rw-r--r-- | Messages/Internal.hs | 20 | ||||
-rw-r--r-- | Messages/JSON.hs | 6 | ||||
-rw-r--r-- | Remote/External.hs | 1 | ||||
-rw-r--r-- | Remote/External/Types.hs | 2 | ||||
-rw-r--r-- | doc/design/external_special_remote_protocol.mdwn | 9 | ||||
-rw-r--r-- | doc/todo/INFO_message_for_custom_special_remotes.mdwn | 2 | ||||
-rw-r--r-- | doc/todo/INFO_message_for_custom_special_remotes/comment_1_ea99a5099f78767859c05aeb5217a12d._comment | 11 |
9 files changed, 59 insertions, 8 deletions
@@ -1,6 +1,7 @@ git-annex (6.20180113) UNRELEASED; urgency=medium * inprogress: Avoid showing failures for files not in progress. + * Added INFO to external special remote protocol. -- Joey Hess <id@joeyh.name> Wed, 24 Jan 2018 20:42:55 -0400 diff --git a/Messages.hs b/Messages.hs index 08a7bb719..d5dee72e2 100644 --- a/Messages.hs +++ b/Messages.hs @@ -19,6 +19,7 @@ module Messages ( showStoringStateAction, showOutput, showLongNote, + showInfo, showEndOk, showEndFail, showEndResult, @@ -123,7 +124,15 @@ showOutput = unlessM commandProgressDisabled $ outputMessage JSON.none "\n" showLongNote :: String -> Annex () -showLongNote s = outputMessage (JSON.note s) ('\n' : indent s ++ "\n") +showLongNote s = outputMessage (JSON.note s) (formatLongNote s) + +formatLongNote :: String -> String +formatLongNote s = '\n' : indent s ++ "\n" + +-- Used by external special remote, displayed same as showLongNote +-- to console, but json object containing the info is emitted immediately. +showInfo :: String -> Annex () +showInfo s = outputMessage' outputJSON (JSON.info s) (formatLongNote s) showEndOk :: Annex () showEndOk = showEndResult True @@ -165,11 +174,11 @@ indent = intercalate "\n" . map (\l -> " " ++ l) . lines {- Shows a JSON chunk only when in json mode. -} maybeShowJSON :: JSON.JSONChunk v -> Annex () -maybeShowJSON v = void $ withMessageState $ outputJSON (JSON.add v) +maybeShowJSON v = void $ withMessageState $ bufferJSON (JSON.add v) {- Shows a complete JSON value, only when in json mode. -} showFullJSON :: JSON.JSONChunk v -> Annex Bool -showFullJSON v = withMessageState $ outputJSON (JSON.complete v) +showFullJSON v = withMessageState $ bufferJSON (JSON.complete v) {- Performs an action that outputs nonstandard/customized output, and - in JSON mode wraps its output in JSON.start and JSON.end, so it's diff --git a/Messages/Internal.hs b/Messages/Internal.hs index 6ec72812a..3972503dc 100644 --- a/Messages/Internal.hs +++ b/Messages/Internal.hs @@ -17,16 +17,19 @@ withMessageState :: (MessageState -> Annex a) -> Annex a withMessageState a = Annex.getState Annex.output >>= a outputMessage :: JSONBuilder -> String -> Annex () -outputMessage jsonbuilder msg = withMessageState $ \s -> case outputType s of +outputMessage = outputMessage' bufferJSON + +outputMessage' :: (JSONBuilder -> MessageState -> Annex Bool) -> JSONBuilder -> String -> Annex () +outputMessage' jsonoutputter jsonbuilder msg = withMessageState $ \s -> case outputType s of NormalOutput | concurrentOutputEnabled s -> concurrentMessage s False msg q | otherwise -> liftIO $ flushed $ putStr msg - JSONOutput _ -> void $ outputJSON jsonbuilder s + JSONOutput _ -> void $ jsonoutputter jsonbuilder s QuietOutput -> q -- Buffer changes to JSON until end is reached and then emit it. -outputJSON :: JSONBuilder -> MessageState -> Annex Bool -outputJSON jsonbuilder s = case outputType s of +bufferJSON :: JSONBuilder -> MessageState -> Annex Bool +bufferJSON jsonbuilder s = case outputType s of JSONOutput _ | endjson -> do Annex.changeState $ \st -> @@ -46,6 +49,15 @@ outputJSON jsonbuilder s = case outputType s of Nothing -> Nothing Just b -> Just (b, False) +-- Immediately output JSON. +outputJSON :: JSONBuilder -> MessageState -> Annex Bool +outputJSON jsonbuilder s = case outputType s of + JSONOutput _ -> do + maybe noop (liftIO . flushed . emit) + (fst <$> jsonbuilder Nothing) + return True + _ -> return False + outputError :: String -> Annex () outputError msg = withMessageState $ \s -> if concurrentOutputEnabled s diff --git a/Messages/JSON.hs b/Messages/JSON.hs index 3ad0e5708..6ca3c1383 100644 --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -15,6 +15,7 @@ module Messages.JSON ( start, end, note, + info, add, complete, progress, @@ -77,6 +78,11 @@ note :: String -> JSONBuilder note s (Just (o, e)) = Just (HM.insert "note" (toJSON s) o, e) note _ Nothing = Nothing +info :: String -> JSONBuilder +info s _ = Just (o, True) + where + Object o = object ["info" .= toJSON s] + data JSONChunk v where AesonObject :: Object -> JSONChunk Object JSONChunk :: ToJSON v => [(String, v)] -> JSONChunk [(String, v)] diff --git a/Remote/External.hs b/Remote/External.hs index 4220c47d7..5a1e7f210 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -421,6 +421,7 @@ handleRequest' st external req mp responsehandler mapM_ (send . VALUE) =<< getUrlsWithPrefix key prefix send (VALUE "") -- end of list handleRemoteRequest (DEBUG msg) = liftIO $ debugM "external" msg + handleRemoteRequest (INFO msg) = showInfo msg handleRemoteRequest (VERSION _) = sendMessage st external (ERROR "too late to send VERSION") diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 77f3e837e..9e511e450 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -253,6 +253,7 @@ data RemoteRequest | SETURIMISSING Key URI | GETURLS Key String | DEBUG String + | INFO String deriving (Show) instance Proto.Receivable RemoteRequest where @@ -276,6 +277,7 @@ instance Proto.Receivable RemoteRequest where parseCommand "SETURIMISSING" = Proto.parse2 SETURIMISSING parseCommand "GETURLS" = Proto.parse2 GETURLS parseCommand "DEBUG" = Proto.parse1 DEBUG + parseCommand "INFO" = Proto.parse1 INFO parseCommand _ = Proto.parseFail -- Responses to RemoteRequest. diff --git a/doc/design/external_special_remote_protocol.mdwn b/doc/design/external_special_remote_protocol.mdwn index 401c42d6c..e31ee9e9b 100644 --- a/doc/design/external_special_remote_protocol.mdwn +++ b/doc/design/external_special_remote_protocol.mdwn @@ -400,8 +400,15 @@ handling a request. (git-annex replies one or more times with VALUE for each url. The final VALUE has an empty value, indicating the end of the url list.) * `DEBUG message` - Tells git-annex to display the message if --debug is enabled. + Tells git-annex to display the message if --debug is enabled. (git-annex does not send a reply to this message.) +* `INFO message` + Tells git-annex to display the message to the user. + When git-annex is in --json mode, the message will be emitted immediately + in its own json object, with an "info" field. + (git-annex does not send a reply to this message.) + This message was first supported by git-annex version + 6.20180206 ## general messages diff --git a/doc/todo/INFO_message_for_custom_special_remotes.mdwn b/doc/todo/INFO_message_for_custom_special_remotes.mdwn index b41ea89bc..b2ed38258 100644 --- a/doc/todo/INFO_message_for_custom_special_remotes.mdwn +++ b/doc/todo/INFO_message_for_custom_special_remotes.mdwn @@ -1,3 +1,5 @@ I wondered if it would be sensible to ask to extend [externals special remote protocol](https://git-annex.branchable.com/design/external_special_remote_protocol/) with ability for custom remotes to pass back some INFO level message (not only DEBUG or ERROR). The reason is: in datalad-archives special remote we usually need to `git annex get` first the key containing the archive, which might be sizeable. Since there is ATM no way to communicate back to git-annex, so it could communicate back to the datalad which runs it, it results in no output/message to the user that possibly a heavy download is happening in the background. So, we would need to establish our own communication from datalad-archives special remote all the way to top level datalad process to report that, or I wondered if may be we could report back to git-annex, and it in turn report back to the original process (running e.g. `annex get --json --json-progress`) so it could spit out that message wrapped into a json record within the stream, so we could process and output that to the user. [[!meta author=yoh]] + +> [[done]] --[[Joey]] diff --git a/doc/todo/INFO_message_for_custom_special_remotes/comment_1_ea99a5099f78767859c05aeb5217a12d._comment b/doc/todo/INFO_message_for_custom_special_remotes/comment_1_ea99a5099f78767859c05aeb5217a12d._comment new file mode 100644 index 000000000..c2e9f318e --- /dev/null +++ b/doc/todo/INFO_message_for_custom_special_remotes/comment_1_ea99a5099f78767859c05aeb5217a12d._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2018-02-06T16:58:04Z" + content=""" +I've added it. However, note that previous versions of git-annex will +not react well to an unknown message being sent, so to use it safely you +will need to detect a new enough version of git-annex. (I've had a todo item +on the protocol for a while to have a way to detect what messages git-annex +understands.) +"""]] |