aboutsummaryrefslogtreecommitdiff
path: root/Messages/Internal.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-09-09 18:13:55 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-09-09 18:13:55 -0400
commitd56429eefee3d2079ce7b45220844dc9a93f7e61 (patch)
treec419e52a94254558e3a4ed1772178bd3052fb73a /Messages/Internal.hs
parent60b279fb6885852d9d62dc1cf91d526523de9e75 (diff)
drop incremental json object display; clean up code
This gets rid of quite a lot of ugly hacks around json generation. I doubt that any real-world json parsers can parse incomplete objects, so while it's not as nice to need to wait for the complete object, especially for commands like `git annex info` that take a while, it doesn't seem worth the added complexity. This also causes the order of fields within the json objects to be reordered. Since any real json parser shouldn't care, the only possible problem would be with ad-hoc parsers of the old json output.
Diffstat (limited to 'Messages/Internal.hs')
-rw-r--r--Messages/Internal.hs43
1 files changed, 19 insertions, 24 deletions
diff --git a/Messages/Internal.hs b/Messages/Internal.hs
index 2c9a461a5..7ea8ee067 100644
--- a/Messages/Internal.hs
+++ b/Messages/Internal.hs
@@ -13,44 +13,39 @@ 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 :: JSONChunk -> String -> Annex ()
-outputMessage = outputMessage' False
-
-outputMessageFinal :: JSONChunk -> String -> Annex ()
-outputMessageFinal = outputMessage' True
-
-outputMessage' :: Bool -> JSONChunk -> String -> Annex ()
-outputMessage' endmessage json msg = withMessageState $ \s -> case outputType s of
+outputMessage :: JSONBuilder -> String -> Annex ()
+outputMessage jsonbuilder msg = withMessageState $ \s -> case outputType s of
NormalOutput
| concurrentOutputEnabled s -> concurrentMessage s False msg q
| otherwise -> liftIO $ flushed $ putStr msg
- JSONOutput _ -> void $ outputJSON json endmessage s
+ JSONOutput _ -> void $ outputJSON jsonbuilder s
QuietOutput -> q
-outputJSON :: JSONChunk -> Bool -> MessageState -> Annex Bool
-outputJSON json endmessage s = case outputType s of
- JSONOutput withprogress
- | withprogress || concurrentOutputEnabled s -> do
- -- Buffer json fragments until end is reached.
- if endmessage
- then do
- Annex.changeState $ \st ->
- st { Annex.output = s { jsonBuffer = none } }
- liftIO $ flushed $ emit b
- else Annex.changeState $ \st ->
- st { Annex.output = s { jsonBuffer = b } }
+-- Buffer changes to JSON until end is reached and then emit it.
+outputJSON :: JSONBuilder -> MessageState -> Annex Bool
+outputJSON jsonbuilder s = case outputType s of
+ JSONOutput _
+ | endjson -> do
+ Annex.changeState $ \st ->
+ st { Annex.output = s { jsonBuffer = Nothing } }
+ maybe noop (liftIO . flushed . emit) json
return True
| otherwise -> do
- liftIO $ flushed $ emit json
+ Annex.changeState $ \st ->
+ st { Annex.output = s { jsonBuffer = json } }
return True
_ -> return False
where
- b = jsonBuffer s `B.append` json
+ (json, endjson) = case jsonbuilder i of
+ Nothing -> (jsonBuffer s, False)
+ (Just (j, e)) -> (Just j, e)
+ i = case jsonBuffer s of
+ Nothing -> Nothing
+ Just b -> Just (b, False)
outputError :: String -> Annex ()
outputError msg = withMessageState $ \s ->