Added INFO to external special remote protocol.

It's left up to the special remote to detect when git-annex is new enough
to support the message; an old git-annex will blow up.

This commit was supported by the NSF-funded DataLad project.

2 files changed, 22 insertions, 4 deletions

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)]