@@ -8,7 +8,7 @@ module Json.Encode
88 , Value(..)
99 , array
1010 , object
11− , text
11+ , string
1212 , name
1313 , bool
1414 , int
@@ -25,15 +25,11 @@ import Prelude hiding (null)
2525import Control.Arrow ((***))
2626import qualified Data.ByteString.Char8 as BSC
2727import qualified Data.ByteString.Builder as B
28−import qualified Data.ByteString.Builder.Prim as BP
29−import Data.ByteString.Builder.Prim ((>*<))
3028import qualified Data.Map as Map
3129import qualified Data.Scientific as Sci
3230import Data.Monoid ((<>))
3331import qualified Data.Name as Name
34−import qualified Data.Text as Text
35−import qualified Data.Text.Encoding as Text
36−import qualified Data.Word as W
32+import qualified Data.Utf8 as Utf8
3733import System.IO (IOMode(WriteMode), withBinaryFile)
3834
3935
@@ -43,7 +39,7 @@ import System.IO (IOMode(WriteMode), withBinaryFile)
4339
4440data Value
4541 = Array [Value]
46− | Object [(Text.Text, Value)]
42+ | Object [(Utf8.String, Value)]
4743 | String B.Builder
4844 | Boolean Bool
4945 | Integer Int
@@ -56,19 +52,19 @@ array =
5652 Array
5753
5854
59−object :: [(Text.Text,Value)] -> Value
55+object :: [(Utf8.String,Value)] -> Value
6056object =
6157 Object
6258
6359
64−text :: Text.Text -> Value
65−text txt =
66− String (encodeText txt)
60+string :: Utf8.String -> Value
61+string str =
62+ String (encodeUtf8 str)
6763
6864
6965name :: Name.Name -> Value
7066name nm =
71− String ("\"" <> Name.toBuilder nm <> "\"")
67+ String (B.char7 '"' <> Name.toBuilder nm <> B.char7 '"')
7268
7369
7470bool :: Bool -> Value
@@ -91,7 +87,7 @@ null =
9187 Null
9288
9389
94−dict :: (k -> Text.Text) -> (v -> Value) -> Map.Map k v -> Value
90+dict :: (k -> Utf8.String) -> (v -> Value) -> Map.Map k v -> Value
9591dict encodeKey encodeValue pairs =
9692 Object $ map (encodeKey *** encodeValue) (Map.toList pairs)
9793
@@ -149,7 +145,7 @@ encodeUgly value =
149145 Object (first : rest) ->
150146 let
151147 encodeEntry char (key, entry) =
152− B.char7 char <> encodeText key <> B.char7 ':' <> encodeUgly entry
148+ B.char7 char <> encodeUtf8 key <> B.char7 ':' <> encodeUgly entry
153149 in
154150 encodeEntry '{' first <> mconcat (map (encodeEntry ',') rest) <> B.char7 '}'
155151
@@ -210,6 +206,15 @@ encodeHelp indent value =
210206
211207
212208
209+-- ENCODE UTF-8
210+
211+
212+encodeUtf8 :: Utf8.String -> B.Builder
213+encodeUtf8 str =
214+ B.char7 '"' <> Utf8.toBuilder str <> B.char7 '"'
215+
216+
217+
213218-- ENCODE ARRAY
214219
215220
@@ -232,7 +237,7 @@ arrayClose =
232237-- ENCODE OBJECT
233238
234239
235−encodeObject :: BSC.ByteString -> (Text.Text, Value) -> [(Text.Text, Value)] -> B.Builder
240+encodeObject :: BSC.ByteString -> (Utf8.String, Value) -> [(Utf8.String, Value)] -> B.Builder
236241encodeObject =
237242 encodeSequence objectOpen objectClose encodeField
238243
@@ -247,9 +252,9 @@ objectClose =
247252 B.char7 '}'
248253
249254
250−encodeField :: BSC.ByteString -> (Text.Text, Value) -> B.Builder
255+encodeField :: BSC.ByteString -> (Utf8.String, Value) -> B.Builder
251256encodeField indent (key, value) =
252− encodeText key <> B.string7 ": " <> encodeHelp indent value
257+ encodeUtf8 key <> B.string7 ": " <> encodeHelp indent value
253258
254259
255260
@@ -288,34 +293,3 @@ commaNewline =
288293newline :: B.Builder
289294newline =
290295 B.char7 '\n'
291−
292−
293−
294−-- ENCODE TEXT
295−
296−
297−encodeText :: Text.Text -> B.Builder
298−encodeText txt =
299− B.char7 '"' <> Text.encodeUtf8BuilderEscaped escapeAscii txt <> B.char7 '"'
300−
301−
302−{-# INLINE escapeAscii #-}
303−escapeAscii :: BP.BoundedPrim W.Word8
304−escapeAscii =
305− BP.condB (== 0x5C {- \\ -}) (ascii2 ('\\','\\')) $
306− BP.condB (== 0x22 {- \" -}) (ascii2 ('\\','"' )) $
307− BP.condB (>= 0x20 ) (BP.liftFixedToBounded BP.word8) $
308− BP.condB (== 0x0A {- \n -}) (ascii2 ('\\','n' )) $
309− BP.condB (== 0x0D {- \r -}) (ascii2 ('\\','r' )) $
310− BP.condB (== 0x09 {- \t -}) (ascii2 ('\\','t' )) $
311− BP.liftFixedToBounded hexEscape -- fallback for chars < 0x20
312− where
313− hexEscape :: BP.FixedPrim W.Word8
314− hexEscape = (\c -> ('\\', ('u', fromIntegral c))) BP.>$<
315− BP.char8 >*< BP.char8 >*< BP.word16HexFixed
316−
317−
318−{-# INLINE ascii2 #-}
319−ascii2 :: (Char, Char) -> BP.BoundedPrim a
320−ascii2 cs =
321− BP.liftFixedToBounded $ const cs BP.>$< BP.char7 >*< BP.char7