better locking for json with -J

Avoid threads emitting json at the same time and scrambling, which was
still possible even with the buffering, just less likely.

Converted json IO actions to JSONChunk data too.

1 files changed, 13 insertions, 13 deletions

diff --git a/Messages/Internal.hs b/Messages/Internal.hs
index bf212b71b..2c9a461a5 100644
--- a/Messages/Internal.hs
+++ b/Messages/Internal.hs
@@ -11,17 +11,20 @@ import Common
 import Annex
 import Types.Messages
 import Messages.Concurrent
+import Messages.JSON
+
+import qualified Data.ByteString.Lazy as B
 
 withMessageState :: (MessageState -> Annex a) -> Annex a
 withMessageState a = Annex.getState Annex.output >>= a
 
-outputMessage :: IO () -> String -> Annex ()
+outputMessage :: JSONChunk -> String -> Annex ()
 outputMessage = outputMessage' False
 
-outputMessageFinal :: IO () -> String -> Annex ()
+outputMessageFinal :: JSONChunk -> String -> Annex ()
 outputMessageFinal = outputMessage' True
 
-outputMessage' :: Bool -> IO () -> String -> Annex ()
+outputMessage' :: Bool -> JSONChunk -> String -> Annex ()
 outputMessage' endmessage json msg = withMessageState $ \s -> case outputType s of
 	NormalOutput
 		| concurrentOutputEnabled s -> concurrentMessage s False msg q
@@ -29,7 +32,7 @@ outputMessage' endmessage json msg = withMessageState $ \s -> case outputType s
 	JSONOutput _ -> void $ outputJSON json endmessage s
 	QuietOutput -> q
 
-outputJSON :: IO () -> Bool -> MessageState -> Annex Bool
+outputJSON :: JSONChunk -> Bool -> MessageState -> Annex Bool
 outputJSON json endmessage s = case outputType s of
 	JSONOutput withprogress
 		| withprogress || concurrentOutputEnabled s -> do
@@ -37,20 +40,17 @@ outputJSON json endmessage s = case outputType s of
 			if endmessage
 				then do
 					Annex.changeState $ \st -> 
-						st { Annex.output = s { jsonBuffer = [] } }
-					liftIO $ flushed $ do
-						showJSONBuffer s
-						json
+						st { Annex.output = s { jsonBuffer = none } }
+					liftIO $ flushed $ emit b
 				else Annex.changeState $ \st ->
-				        st { Annex.output = s { jsonBuffer = json : jsonBuffer s } }
+				        st { Annex.output = s { jsonBuffer = b } }
 			return True
 		| otherwise -> do
-			liftIO $ flushed json
+			liftIO $ flushed $ emit json
 			return True
 	_ -> return False
-
-showJSONBuffer :: MessageState -> IO ()
-showJSONBuffer s = sequence_ $ reverse $ jsonBuffer s
+  where
+	b = jsonBuffer s `B.append` json
 
 outputError :: String -> Annex ()
 outputError msg = withMessageState $ \s ->