avoid using Strings for JSON output; keep it ByteString throughout

This commit is contained in:
Joey Hess 2016-07-26 21:43:05 -04:00
parent a79736d80d
commit 5235fb1185
Failed to extract signature
2 changed files with 31 additions and 21 deletions

View file

@ -22,12 +22,14 @@ import Data.Aeson
import Control.Applicative import Control.Applicative
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.ByteString.Lazy as B
import System.IO
import qualified Utility.JSONStream as Stream import qualified Utility.JSONStream as Stream
import Types.Key import Types.Key
start :: String -> Maybe FilePath -> Maybe Key -> IO () start :: String -> Maybe FilePath -> Maybe Key -> IO ()
start command file key = putStr $ Stream.start $ Stream.AesonObject o start command file key = B.hPut stdout $ Stream.start $ Stream.AesonObject o
where where
Object o = toJSON $ JSONActionItem Object o = toJSON $ JSONActionItem
{ itemCommand = Just command { itemCommand = Just command
@ -37,16 +39,16 @@ start command file key = putStr $ Stream.start $ Stream.AesonObject o
} }
end :: Bool -> IO () end :: Bool -> IO ()
end b = putStr $ Stream.add (Stream.JSONChunk [("success", b)]) ++ Stream.end end b = B.hPut stdout $ Stream.add (Stream.JSONChunk [("success", b)]) `B.append` Stream.end
note :: String -> IO () note :: String -> IO ()
note s = add (Stream.JSONChunk [("note", s)]) note s = add (Stream.JSONChunk [("note", s)])
add :: Stream.JSONChunk a -> IO () add :: Stream.JSONChunk a -> IO ()
add = putStr . Stream.add add = B.hPut stdout . Stream.add
complete :: Stream.JSONChunk a -> IO () complete :: Stream.JSONChunk a -> IO ()
complete v = putStr $ Stream.start v ++ Stream.end complete v = B.hPut stdout $ Stream.start v `B.append` Stream.end
-- A value that can be displayed either normally, or as JSON. -- A value that can be displayed either normally, or as JSON.
data DualDisp = DualDisp data DualDisp = DualDisp

View file

@ -16,7 +16,9 @@ module Utility.JSONStream (
import Data.Aeson import Data.Aeson
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.ByteString.Lazy.UTF8 as B import qualified Data.ByteString.Lazy as B
import Data.Char
import Data.Word
data JSONChunk v where data JSONChunk v where
JSONChunk :: ToJSON v => [(String, v)] -> JSONChunk [(String, v)] JSONChunk :: ToJSON v => [(String, v)] -> JSONChunk [(String, v)]
@ -32,29 +34,35 @@ encodeJSONChunk (AesonObject o) = encode o
- with streaming output. To support streaming, a hack: - with streaming output. To support streaming, a hack:
- The final "}" is left off the JSON, allowing more chunks to be added - The final "}" is left off the JSON, allowing more chunks to be added
- to later. -} - to later. -}
start :: JSONChunk a -> String start :: JSONChunk a -> B.ByteString
start a start a
| last s == endchar = init s | not (B.null b) && B.last b == endchar = B.init b
| otherwise = bad s | otherwise = bad b
where where
s = B.toString $ encodeJSONChunk a b = encodeJSONChunk a
add :: JSONChunk a -> String add :: JSONChunk a -> B.ByteString
add a add a
| head s == startchar = ',' : drop 1 s | not (B.null b) && B.head b == startchar = B.cons addchar (B.drop 1 b)
| otherwise = bad s | otherwise = bad b
where where
s = start a b = start a
end :: String end :: B.ByteString
end = [endchar, '\n'] end = endchar `B.cons` sepchar `B.cons` B.empty
startchar :: Char startchar :: Word8
startchar = '{' startchar = fromIntegral (ord '{')
endchar :: Char endchar :: Word8
endchar = '}' endchar = fromIntegral (ord '}')
bad :: String -> a addchar :: Word8
bad s = error $ "JSON encoder generated unexpected value: " ++ s addchar = fromIntegral (ord ',')
sepchar :: Word8
sepchar = fromIntegral (ord '\n')
bad :: B.ByteString -> a
bad b = error $ "JSON encoder generated unexpected value: " ++ show b