@@ -1,4 +1,4 @@
1−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
22
33-- Module: Data.Aeson.Encode
44-- Copyright: (c) 2011 MailRank, Inc.
@@ -16,7 +16,6 @@ module Data.Aeson.Encode
1616 ) where
1717
1818import Blaze.ByteString.Builder
19−import Blaze.ByteString.Builder.Internal.Write
2019import Blaze.ByteString.Builder.Char.Utf8
2120import Data.Aeson.Encode.Number (fromNumber)
2221import Data.Aeson.Types (ToJSON(..), Value(..))
@@ -26,6 +25,8 @@ import qualified Data.Map as M
2625import qualified Data.Text as T
2726import qualified Data.Vector as V
2827
28+import Blaze.ByteString.Builder.Internal
29+import qualified Data.Text.Fusion as F
2930import Foreign
3031
3132-- | Encode a JSON value to a 'Builder'.
@@ -60,7 +61,7 @@ encode = toLazyByteString . fromValue . toJSON
6061-- unpacking to lists.
6162string :: T.Text -> Builder
6263string s =
63− fromChar '"' `mappend` fromWriteList writeJSONChar (T.unpack s) `mappend` fromChar '"'
64+ fromChar '"' `mappend` fromWriteText writeJSONChar s `mappend` fromChar '"'
6465
6566{-# INLINE writeJSONChar #-}
6667writeJSONChar :: Char -> Write
@@ -104,5 +105,55 @@ pokeWord16Hex x op = do
104105 pokeWord8 :: Int -> Word8 -> IO ()
105106 pokeWord8 off = poke (op `plusPtr` off)
106107
108+-- | Write a 'F.Stream' one element at a time to a builder using the given
109+-- write operation.
110+{-# INLINE fromWriteStream #-}
111+fromWriteStream :: (a -> Write) -> F.Stream a -> Builder
112+fromWriteStream write =
113+ makeBuilder
114+ where
115+ makeBuilder (F.Stream next s0 _) = fromBuildStepCont $ step s0
116+ where
117+ step s1 k !(BufRange op0 ope0) = go s1 op0
118+ where
119+ go s !op = case next s of
120+ F.Done -> do let !br' = BufRange op ope0
121+ k br'
122+ F.Skip s' -> go s' op
123+ F.Yield x s' ->
124+ let maxSize = getBound (write x)
125+ result
126+ | op `plusPtr` maxSize <= ope0 = do
127+ !op' <- runWrite (write x) op
128+ go s' op'
129+ | otherwise = do return $ bufferFull maxSize op (step s k)
130+ in result
131+
132+{-# INLINE fromWriteText #-}
133+fromWriteText :: (Char -> Write) -> T.Text -> Builder
134+fromWriteText w = fromWriteStream w . F.stream
135+
136+{-
137+fromWriteList :: (a -> Write) -> [a] -> Builder
138+fromWriteList write =
139+ makeBuilder
140+ where
141+ makeBuilder xs0 = fromBuildStepCont $ step xs0
142+ where
143+ step xs1 k !(BufRange op0 ope0) = go xs1 op0
144+ where
145+ go [] !op = do
146+ let !br' = BufRange op ope0
147+ k br'
148+
149+ go xs@(x':xs') !op
150+ | op `plusPtr` maxSize <= ope0 = do
151+ !op' <- runPoke wio op
152+ go xs' op'
153+ | otherwise = return $ bufferFull maxSize op (step xs k)
154+ where
155+ Write maxSize wio = write x'
156+{-# INLINE fromWriteList #-}
157+-}
107158
108159