allow using Aeson for streaming JSON output

Keeping Text.JSON use for now, because it seems a better fit for most of
the commands, which don't use very structured JSON objects, but just output
whatever fields suites them. But this lets Aeson be used when a more
structured data type is available to serialize to JSON.

1 files changed, 30 insertions, 13 deletions

diff --git a/Utility/JSONStream.hs b/Utility/JSONStream.hs
index 2746678cc..efee1dec6 100644
--- a/Utility/JSONStream.hs
+++ b/Utility/JSONStream.hs
@@ -1,35 +1,51 @@
 {- Streaming JSON output.
  -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011, 2016 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
 
+{-# LANGUAGE GADTs #-}
+
 module Utility.JSONStream (
+	JSONChunk(..),
 	start,
 	add,
 	end
 ) where
 
-import Text.JSON
+import qualified Text.JSON as JSON
+import qualified Data.Aeson as Aeson
+import qualified Data.ByteString.Lazy.UTF8 as B
 
-{- Text.JSON does not support building up a larger JSON document piece by
- - piece as a stream. To support streaming, a hack. The JSObject is converted
- - to a string with its final "}" is left off, allowing it to be added to
- - later. -}
-start :: JSON a => [(String, a)] -> String
-start l
+{- Only JSON objects can be used as chunks in the stream, not
+ - other values.
+ -
+ - Both Aeson and Text.Json objects are supported. -}
+data JSONChunk a where
+	JSONObject :: JSON.JSON a => [(String, a)] -> JSONChunk [(String, a)]
+	AesonObject :: Aeson.Object -> JSONChunk Aeson.Object
+
+encodeJSONChunk :: JSONChunk a -> String
+encodeJSONChunk (JSONObject l) = JSON.encodeStrict $ JSON.toJSObject l
+encodeJSONChunk (AesonObject o) = B.toString (Aeson.encode o)
+
+{- Text.JSON and Aeson do not support building up a larger JSON document
+ - piece by piece as a stream. To support streaming, a hack. The final "}" 
+ - is left off the object, allowing it to be added to later. -}
+start :: JSONChunk a -> String
+start a
 	| last s == endchar = init s
 	| otherwise = bad s
   where
-	s = encodeStrict $ toJSObject l
+	s = encodeJSONChunk a
 
-add :: JSON a => [(String, a)] -> String
-add l
+add :: JSONChunk a -> String
+add a
 	| head s == startchar = ',' : drop 1 s
 	| otherwise = bad s
   where
-	s = start l
+	s = start a
 
 end :: String
 end = [endchar, '\n']
@@ -41,4 +57,5 @@ endchar :: Char
 endchar = '}'
 
 bad :: String -> a
-bad s = error $ "Text.JSON returned unexpected string: " ++ s
+bad s = error $ "JSON encoder generated unexpected value: " ++ s
+