Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 277 lines (216 sloc) 7.781 kb
cabae3c @lpsmith Proof-of-concept for json-builder
authored
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Json
4 -- Copyright : (c) 2011 Leon P Smith
5 -- License : BSD3
6 --
7 -- Maintainer : Leon P Smith <leon@melding-monads.com>
8 --
9 -- Data structure agnostic JSON serialization
10 --
11 -----------------------------------------------------------------------------
12
6f1b0b6 @lpsmith Add preliminary support for Text, improve support for numerical types
authored
13 {-# LANGUAGE BangPatterns #-}
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
14 {-# LANGUAGE ViewPatterns #-}
6f1b0b6 @lpsmith Add preliminary support for Text, improve support for numerical types
authored
15 {-# LANGUAGE OverloadedStrings #-}
16 {-# LANGUAGE FlexibleInstances #-}
17 {-# LANGUAGE OverlappingInstances #-}
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
18 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
cabae3c @lpsmith Proof-of-concept for json-builder
authored
19
20 module Json
0c6d267 @lpsmith Improve quoting for Text type, misc cleanups and optimizations
authored
21 ( Key (..)
22 , Value(..)
cabae3c @lpsmith Proof-of-concept for json-builder
authored
23 , Object
24 , row
25 , Array
26 , element
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
27 , Escaped(..)
cabae3c @lpsmith Proof-of-concept for json-builder
authored
28 ) where
29
30 import Blaze.ByteString.Builder as Blaze
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
31 ( Write
32 , Builder
33 , copyByteString
34 , fromByteString
35 , fromLazyByteString
36 , writeByteString
37 , fromWrite
38 , fromWriteList
39 , writeWord8 )
40 import Blaze.ByteString.Builder.Char.Utf8
41 ( fromChar, writeChar, fromText, fromLazyText )
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
42 import Blaze.Text (float, double, integral)
43
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
44 import Data.Bits ( Bits((.&.), shiftR) )
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
45 import qualified Data.Map as Map
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
46 import Data.Monoid ( Monoid (mempty, mappend, mconcat) )
47 import Data.Int ( Int8, Int16, Int32, Int64)
48 import Data.Word ( Word, Word8, Word16, Word32, Word64 )
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
49
50 import qualified Data.Char as Char
51
cabae3c @lpsmith Proof-of-concept for json-builder
authored
52 import qualified Data.ByteString as BS
53 import qualified Data.ByteString.Lazy as BL
4c3be4d @lpsmith Json string quoting
authored
54 import qualified Data.ByteString.UTF8 as BU
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
55 import qualified Data.ByteString.Lazy.UTF8 as BLU
cabae3c @lpsmith Proof-of-concept for json-builder
authored
56 import Data.ByteString.Char8()
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
57 import Data.ByteString.Internal ( c2w )
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
58
6f1b0b6 @lpsmith Add preliminary support for Text, improve support for numerical types
authored
59 import qualified Data.Text as T
0c6d267 @lpsmith Improve quoting for Text type, misc cleanups and optimizations
authored
60 import qualified Data.Text.Lazy as TL
cabae3c @lpsmith Proof-of-concept for json-builder
authored
61
62 ---- The "core" of json-builder
63
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
64 class Value a => Key a where
65 escape :: a -> Escaped
66
cabae3c @lpsmith Proof-of-concept for json-builder
authored
67 class Value a where
68 toBuilder :: a -> Blaze.Builder
69
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
70 newtype Escaped = Escaped Blaze.Builder deriving (Monoid)
71
72 instance Key Escaped where
73 escape = id
74
75 instance Value Escaped where
76 toBuilder (Escaped str) = fromChar '"' `mappend` str `mappend` fromChar '"'
6f1b0b6 @lpsmith Add preliminary support for Text, improve support for numerical types
authored
77
3fa5280 @lpsmith Remove toByteString/toLazyByteString functions
authored
78 data Pair = Pair !Blaze.Builder !Bool
cabae3c @lpsmith Proof-of-concept for json-builder
authored
79
80 newtype Object = Object (Bool -> Pair)
81 instance Value Object where
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
82 toBuilder (Object f)
83 = case f True of
84 Pair fb _ -> mconcat [fromChar '{', fb, fromChar '}']
cabae3c @lpsmith Proof-of-concept for json-builder
authored
85
86 instance Monoid Object where
87 mempty = Object $ \x -> Pair mempty x
88 mappend (Object f) (Object g)
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
89 = Object $ \x -> case f x of
90 Pair fb x' ->
91 case g x' of
92 Pair gb x'' ->
93 Pair (fb `mappend` gb) x''
cabae3c @lpsmith Proof-of-concept for json-builder
authored
94
0c6d267 @lpsmith Improve quoting for Text type, misc cleanups and optimizations
authored
95 row :: (Key k, Value a) => k -> a -> Object
96 row k a = Object syntax
cabae3c @lpsmith Proof-of-concept for json-builder
authored
97 where
0c6d267 @lpsmith Improve quoting for Text type, misc cleanups and optimizations
authored
98 syntax = comma (mconcat [ toBuilder k, fromChar ':', toBuilder a ])
cabae3c @lpsmith Proof-of-concept for json-builder
authored
99 comma b True = Pair b False
100 comma b False = Pair (fromChar ',' `mappend` b) False
101
102
103 newtype Array = Array (Bool -> Pair)
104
105 instance Value Array where
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
106 toBuilder (Array f)
107 = case f True of
108 Pair fb _ -> mconcat [fromChar '[', fb, fromChar ']']
cabae3c @lpsmith Proof-of-concept for json-builder
authored
109
110 instance Monoid Array where
111 mempty = Array $ \x -> Pair mempty x
112 mappend (Array f) (Array g)
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
113 = Array $ \x -> case f x of
114 Pair fb x' ->
115 case g x' of
116 Pair gb x'' ->
117 Pair (fb `mappend` gb) x''
cabae3c @lpsmith Proof-of-concept for json-builder
authored
118
119 element :: Value a => a -> Array
120 element a = Array $ comma (toBuilder a)
121 where
122 comma b True = Pair b False
123 comma b False = Pair (fromChar ',' `mappend` b) False
124
125
126 -- Primitive instances for json-builder
127
128 instance Value () where
0c6d267 @lpsmith Improve quoting for Text type, misc cleanups and optimizations
authored
129 toBuilder _ = copyByteString "null"
cabae3c @lpsmith Proof-of-concept for json-builder
authored
130
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
131 instance Value Int where
132 toBuilder = integral
133
134 instance Value Int8 where
135 toBuilder = integral
136
137 instance Value Int16 where
138 toBuilder = integral
139
140 instance Value Int32 where
141 toBuilder = integral
142
143 instance Value Int64 where
144 toBuilder = integral
145
146 instance Value Integer where
147 toBuilder = integral
148
149 instance Value Word where
150 toBuilder = integral
151
152 instance Value Word8 where
153 toBuilder = integral
154
155 instance Value Word16 where
156 toBuilder = integral
157
158 instance Value Word32 where
159 toBuilder = integral
160
161 instance Value Word64 where
6f1b0b6 @lpsmith Add preliminary support for Text, improve support for numerical types
authored
162 toBuilder = integral
cabae3c @lpsmith Proof-of-concept for json-builder
authored
163
164 instance Value Double where
6f1b0b6 @lpsmith Add preliminary support for Text, improve support for numerical types
authored
165 toBuilder = double
166
167 instance Value Float where
168 toBuilder = float
cabae3c @lpsmith Proof-of-concept for json-builder
authored
169
170 instance Value Bool where
0c6d267 @lpsmith Improve quoting for Text type, misc cleanups and optimizations
authored
171 toBuilder True = copyByteString "true"
172 toBuilder False = copyByteString "false"
cabae3c @lpsmith Proof-of-concept for json-builder
authored
173
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
174 instance Key BS.ByteString where
175 escape x = Escaped (loop (splitQ x))
4c3be4d @lpsmith Json string quoting
authored
176 where
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
177 splitQ = BU.break quoteNeeded
178
4c3be4d @lpsmith Json string quoting
authored
179 loop (a,b)
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
180 = fromByteString a `mappend`
4c3be4d @lpsmith Json string quoting
authored
181 case BU.decode b of
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
182 Nothing -> mempty
183 Just (c,n) -> fromWrite (quoteChar c) `mappend`
03ba86d @lpsmith Buglet: The first char of a string would always be quoted
authored
184 loop (splitQ (BS.drop n b))
185
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
186 instance Value BS.ByteString where
187 toBuilder = toBuilder . escape
4c3be4d @lpsmith Json string quoting
authored
188
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
189 instance Key BL.ByteString where
190 escape x = Escaped (loop (splitQ x))
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
191 where
192 splitQ = BLU.break quoteNeeded
4c3be4d @lpsmith Json string quoting
authored
193
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
194 loop (a,b)
195 = fromLazyByteString a `mappend`
196 case BLU.decode b of
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
197 Nothing -> mempty
198 Just (c,n) -> fromWrite (quoteChar c) `mappend`
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
199 loop (splitQ (BL.drop n b))
4c3be4d @lpsmith Json string quoting
authored
200
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
201 instance Value BL.ByteString where
202 toBuilder = toBuilder . escape
6f1b0b6 @lpsmith Add preliminary support for Text, improve support for numerical types
authored
203
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
204 instance Key T.Text where
205 escape x = Escaped (loop (splitQ x))
0c6d267 @lpsmith Improve quoting for Text type, misc cleanups and optimizations
authored
206 where
207 splitQ = T.break quoteNeeded
208
209 loop (a,b)
210 = fromText a `mappend`
211 case T.uncons b of
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
212 Nothing -> mempty
213 Just (c,b') -> fromWrite (quoteChar c) `mappend`
214 loop (splitQ b')
0c6d267 @lpsmith Improve quoting for Text type, misc cleanups and optimizations
authored
215
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
216 instance Value T.Text where
217 toBuilder = toBuilder . escape
0c6d267 @lpsmith Improve quoting for Text type, misc cleanups and optimizations
authored
218
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
219 instance Key TL.Text where
220 escape x = Escaped (loop (splitQ x))
0c6d267 @lpsmith Improve quoting for Text type, misc cleanups and optimizations
authored
221 where
222 splitQ = TL.break quoteNeeded
223
224 loop (a,b)
225 = fromLazyText a `mappend`
226 case TL.uncons b of
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
227 Nothing -> mempty
228 Just (c,b') -> fromWrite (quoteChar c) `mappend`
229 loop (splitQ b')
6f1b0b6 @lpsmith Add preliminary support for Text, improve support for numerical types
authored
230
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
231 instance Value TL.Text where
232 toBuilder = toBuilder . escape
35ccf9f @lpsmith add a Text instance for Json-Builder
authored
233
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
234 instance Key [Char] where
235 escape str = Escaped (fromWriteList writeEscapedChar str)
236 where
237 writeEscapedChar c | quoteNeeded c = quoteChar c
238 | otherwise = writeChar c
6f1b0b6 @lpsmith Add preliminary support for Text, improve support for numerical types
authored
239
240 instance Value [Char] where
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
241 toBuilder = toBuilder . escape
cabae3c @lpsmith Proof-of-concept for json-builder
authored
242
243 instance Value a => Value [a] where
244 toBuilder = toBuilder . mconcat . map element
dc96671 @lpsmith Add support for Data.Map and fix up .cabal file
authored
245
0c6d267 @lpsmith Improve quoting for Text type, misc cleanups and optimizations
authored
246 instance (Key k, Value a) => Value (Map.Map k a) where
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
247 toBuilder = toBuilder
248 . Map.foldrWithKey (\k a b -> row k a `mappend` b) mempty
249
250 ------------------------------------------------------------------------------
251
252 quoteNeeded :: Char -> Bool
253 quoteNeeded c = c == '\\' || c == '"' || Char.ord c < 0x20
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
254 {-# INLINE quoteNeeded #-}
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
255
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
256 quoteChar :: Char -> Write
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
257 quoteChar c = case c of
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
258 '\\' -> writeByteString "\\\\"
259 '"' -> writeByteString "\\\""
260 '\b' -> writeByteString "\\b"
261 '\f' -> writeByteString "\\f"
262 '\n' -> writeByteString "\\n"
263 '\r' -> writeByteString "\\r"
264 '\t' -> writeByteString "\\t"
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
265 _ -> hexEscape c
266
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
267 hexEscape :: Char -> Write
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
268 hexEscape (c2w -> c)
ee4b371 @lpsmith Added "Escaped" value, optimized String escaping, and other misc changes
authored
269 = writeByteString "\\u00"
270 `mappend` writeWord8 (char ((c `shiftR` 4) .&. 0xF))
271 `mappend` writeWord8 (char ( c .&. 0xF))
f40d2c3 @lpsmith Code cleanups and optimize escaping
authored
272
273 char :: Word8 -> Word8
274 char i | i < 10 = i + 48
275 | otherwise = i + 87
276 {-# INLINE char #-}
Something went wrong with that request. Please try again.