1 import "StandardLibrary"
\r
3 import "JavaBuiltin" as Java
\r
5 importJava "com.fasterxml.jackson.core.JsonGenerator" where
\r
9 importJava "com.fasterxml.jackson.core.JsonGenerator" where
\r
10 writeNull :: JsonGenerator -> <Proc> ()
\r
12 writeStartArray :: JsonGenerator -> <Proc> ()
\r
13 @JavaName writeStartArray
\r
14 writeStartArrayN :: JsonGenerator -> Integer -> <Proc> ()
\r
15 writeEndArray :: JsonGenerator -> <Proc> ()
\r
17 writeStartObject :: JsonGenerator -> <Proc> ()
\r
18 writeFieldName :: JsonGenerator -> String -> <Proc> ()
\r
19 writeEndObject :: JsonGenerator -> <Proc> ()
\r
21 writeBoolean :: JsonGenerator -> Boolean -> <Proc> ()
\r
23 writeString :: JsonGenerator -> String -> <Proc> ()
\r
25 @JavaName writeNumber
\r
26 writeNumberDouble :: JsonGenerator -> Double -> <Proc> ()
\r
27 @JavaName writeNumber
\r
28 writeNumberInteger :: JsonGenerator -> Integer -> <Proc> ()
\r
29 @JavaName writeNumber
\r
30 writeNumberLong :: JsonGenerator -> Long -> <Proc> ()
\r
31 @JavaName writeNumber
\r
32 writeNumberShort :: JsonGenerator -> Short -> <Proc> ()
\r
33 @JavaName writeNumber
\r
34 writeNumberFloat :: JsonGenerator -> Float -> <Proc> ()
\r
37 closeGenerator :: JsonGenerator -> <Proc> ()
\r
40 importJava "com.fasterxml.jackson.core.JsonToken" where
\r
42 END_ARRAY :: JsonToken
\r
43 END_OBJECT :: JsonToken
\r
44 FIELD_NAME :: JsonToken
\r
45 NOT_AVAILABLE :: JsonToken
\r
46 START_ARRAY :: JsonToken
\r
47 START_OBJECT :: JsonToken
\r
48 VALUE_EMBEDDED_OBJECT :: JsonToken
\r
49 VALUE_FALSE :: JsonToken
\r
50 VALUE_NULL :: JsonToken
\r
51 VALUE_NUMBER_FLOAT :: JsonToken
\r
52 VALUE_NUMBER_INT :: JsonToken
\r
53 VALUE_STRING :: JsonToken
\r
54 VALUE_TRUE :: JsonToken
\r
56 importJava "com.fasterxml.jackson.core.JsonParser" where
\r
60 importJava "com.fasterxml.jackson.core.JsonParser" where
\r
61 nextToken :: JsonParser -> <Proc> JsonToken
\r
62 currentToken :: JsonParser -> <Proc> JsonToken
\r
63 getDoubleValue :: JsonParser -> <Proc> Double
\r
64 getIntValue :: JsonParser -> <Proc> Integer
\r
65 getText :: JsonParser -> <Proc> String
\r
66 getShortValue :: JsonParser -> <Proc> Short
\r
67 getFloatValue :: JsonParser -> <Proc> Float
\r
68 getLongValue :: JsonParser -> <Proc> Long
\r
69 nextFieldName :: JsonParser -> <Proc> Maybe String
\r
72 importJava "com.fasterxml.jackson.core.JsonFactory" where
\r
76 createJsonFactory :: <Proc> JsonFactory
\r
78 @JavaName createGenerator
\r
79 createWriterGenerator :: JsonFactory -> Writer -> <Proc> JsonGenerator
\r
81 @JavaName createParser
\r
82 createStringParser :: JsonFactory -> String -> <Proc> JsonParser
\r
85 defaultFactory = createJsonFactory
\r
89 assertStartArray :: JsonParser -> <Proc> ()
\r
90 assertStartArray p = if currentToken p == START_ARRAY
\r
92 else fail "Expected START_ARRAY token."
\r
96 assertEndArray :: JsonParser -> <Proc> ()
\r
97 assertEndArray p = if nextToken p == END_ARRAY
\r
99 else fail "Expected END_ARRAY token."
\r
101 // *** Json type class ********************************************************
\r
104 writeJson :: JsonGenerator -> a -> <Proc> ()
\r
105 readJson :: JsonParser -> <Proc> a
\r
106 toJson :: a -> Json
\r
107 fromJson :: Json -> a
\r
109 writeJson g v = writeJson g (toJson v)
\r
110 readJson p = fromJson (readJson p)
\r
113 readNextJson :: Json a => JsonParser -> <Proc> a
\r
114 readNextJson p = do
\r
119 Converts the value to a string encoded with JSON
\r
121 toJsonString :: Json a => a -> String
\r
122 toJsonString v = runProc do
\r
123 writer = createStringWriter
\r
124 generator = createWriterGenerator defaultFactory (toWriter writer)
\r
125 writeJson generator v
\r
126 closeGenerator generator
\r
127 resultOfStringWriter writer
\r
130 Parses a JSON encoded string into a value
\r
132 fromJsonString :: Json a => String -> a
\r
133 fromJsonString str = runProc do
\r
134 parser = createStringParser defaultFactory str
\r
135 readNextJson parser
\r
137 instance Json String where
\r
138 writeJson = writeString
\r
140 toJson = JsonString
\r
141 fromJson (JsonString value) = value
\r
143 instance Json Boolean where
\r
144 writeJson = writeBoolean
\r
146 if currentToken p == VALUE_TRUE
\r
149 toJson = JsonBoolean
\r
150 fromJson (JsonBoolean value) = value
\r
152 instance Json Double where
\r
153 writeJson = writeNumberDouble
\r
154 readJson = getDoubleValue
\r
155 toJson = JsonDouble
\r
156 fromJson (JsonDouble value) = value
\r
158 instance Json Float where
\r
159 writeJson = writeNumberFloat
\r
160 readJson = getFloatValue
\r
161 toJson = JsonDouble . toDouble
\r
162 fromJson (JsonDouble value) = fromDouble value
\r
164 instance Json Integer where
\r
165 writeJson = writeNumberInteger
\r
166 readJson = getIntValue
\r
167 toJson = JsonLong . fromInteger
\r
168 fromJson (JsonLong value) = Java.l2i value
\r
170 instance Json Long where
\r
171 writeJson = writeNumberLong
\r
172 readJson = getLongValue
\r
174 fromJson (JsonLong value) = value
\r
176 instance Json Short where
\r
177 writeJson = writeNumberShort
\r
178 readJson = getShortValue
\r
179 toJson = JsonLong . Java.i2l . Java.s2i
\r
180 fromJson (JsonLong value) = Java.i2s (Java.l2i value)
\r
182 instance (Json a) => Json (Maybe a) where
\r
183 writeJson g (Just v) = writeJson g v
\r
184 writeJson g Nothing = writeNull g
\r
186 if currentToken p == VALUE_NULL
\r
188 else Just (readJson p)
\r
189 toJson (Just value) = toJson value
\r
190 toJson Nothing = JsonNull
\r
191 fromJson JsonNull = Nothing
\r
192 fromJson json = Just (fromJson json)
\r
194 instance (Json a) => Json [a] where
\r
197 iter (writeJson g) l
\r
199 readJson p = MList.freeze result
\r
201 result = MList.create ()
\r
203 while (nextToken p != END_ARRAY)
\r
204 (MList.add result $ readJson p)
\r
205 toJson l = JsonArray (map toJson l)
\r
206 fromJson (JsonArray l) = map fromJson l
\r
208 instance Json () where
\r
216 toJson _ = JsonArray []
\r
217 fromJson (JsonArray []) = ()
\r
219 instance (Json a, Json b) => Json (a, b) where
\r
220 writeJson g (a, b) = do
\r
225 readJson p = (a, b)
\r
231 toJson (a, b) = JsonArray [toJson a, toJson b]
\r
232 fromJson (JsonArray [a, b]) = (fromJson a, fromJson b)
\r
234 instance (Json a, Json b, Json c) => Json (a, b, c) where
\r
235 writeJson g (a, b, c) = do
\r
241 readJson p = (a, b, c)
\r
248 toJson (a, b, c) = JsonArray [toJson a, toJson b, toJson c]
\r
249 fromJson (JsonArray [a, b, c]) = (fromJson a, fromJson b, fromJson c)
\r
251 instance (Json a, Json b, Json c, Json d) => Json (a, b, c, d) where
\r
252 writeJson g (a, b, c, d) = do
\r
259 readJson p = (a, b, c, d)
\r
267 toJson (a, b, c, d) = JsonArray [toJson a, toJson b, toJson c, toJson d]
\r
268 fromJson (JsonArray [a, b, c, d]) = (fromJson a, fromJson b, fromJson c, fromJson d)
\r
270 instance (Json a, Json b, Json c, Json d, Json e) => Json (a, b, c, d, e) where
\r
271 writeJson g (a, b, c, d, e) = do
\r
279 readJson p = (a, b, c, d, e)
\r
288 toJson (a, b, c, d, e) = JsonArray [toJson a, toJson b, toJson c, toJson d, toJson e]
\r
289 fromJson (JsonArray [a, b, c, d, e]) = (fromJson a, fromJson b, fromJson c, fromJson d, fromJson e)
\r
293 | JsonDouble Double
\r
296 | JsonBoolean Boolean
\r
298 | JsonObject [JsonField]
\r
299 data JsonField = JsonField String Json
\r
301 deriving instance Show Json
\r
302 deriving instance Show JsonField
\r
304 instance Json Json where
\r
305 writeJson g (JsonString value) = writeString g value
\r
306 writeJson g (JsonDouble value) = writeNumberDouble g value
\r
307 writeJson g (JsonLong value) = writeNumberLong g value
\r
308 writeJson g (JsonBoolean value) = writeBoolean g value
\r
309 writeJson g JsonNull = writeNull g
\r
310 writeJson g (JsonArray values) = do
\r
312 iter (writeJson g) values
\r
314 writeJson g (JsonObject fields) = do
\r
316 iter (\(JsonField name value) -> do
\r
317 writeFieldName g name
\r
318 writeJson g value) fields
\r
322 token = currentToken p
\r
323 if token == VALUE_STRING
\r
324 then JsonString (getText p)
\r
325 else if token == VALUE_NUMBER_FLOAT
\r
326 then JsonDouble (getDoubleValue p)
\r
327 else if token == VALUE_NUMBER_INT
\r
328 then JsonLong (getLongValue p)
\r
329 else if token == VALUE_TRUE
\r
330 then JsonBoolean True
\r
331 else if token == VALUE_FALSE
\r
332 then JsonBoolean False
\r
333 else if token == VALUE_NULL
\r
335 else if token == START_ARRAY
\r
337 result = MList.create ()
\r
338 while (nextToken p != END_ARRAY)
\r
339 (MList.add result $ readJson p)
\r
340 JsonArray (MList.freeze result)
\r
341 else if token == START_OBJECT
\r
343 result = MList.create ()
\r
344 readJsonObjectContents result p
\r
345 JsonObject (MList.freeze result)
\r
346 else fail "Unsupported token type."
\r
351 readJsonObjectContents :: MList.T JsonField -> JsonParser -> <Proc> ()
\r
352 readJsonObjectContents result p =
\r
353 match nextFieldName p with
\r
355 MList.add result $ JsonField name (readNextJson p)
\r
356 readJsonObjectContents result p
\r
361 makeTypeEqual :: a -> a -> ()
\r
362 makeTypeEqual _ _ = ()
\r
365 testValue :: Json a => Show a => a -> <Proc> ()
\r
367 v2 = toJsonString v1
\r
368 v3 = fromJsonString v2
\r
369 makeTypeEqual v1 v3
\r
370 print "\(v1) -> \(v2) -> \(v3)"
\r
372 then fail "Values differ"
\r
375 testGenericJson :: String -> <Proc> ()
\r
376 testGenericJson v1 = do
\r
377 v2 = fromJsonString v1 :: Json
\r
378 v3 = toJsonString v2
\r
379 print "\(v1) -> \(v2) -> \(v3)"
\r
381 then fail "Values differ"
\r
384 testIt :: <Proc> ()
\r
389 testValue (123 :: Short)
\r
390 testValue (123 :: Integer)
\r
391 testValue (123 :: Long)
\r
392 testValue (123 :: Double)
\r
393 testValue (123 :: Float)
\r
394 testValue (Nothing :: Maybe String)
\r
395 testValue (Just "asd")
\r
396 testValue ["a", "b", "c"]
\r
397 testValue [[],["a"],["b","c"]]
\r
399 testValue ("a", "b")
\r
400 testValue ("a", "b", "c")
\r
401 testValue ("a", "b", "c", "d")
\r
402 testValue [Just "a", Nothing]
\r
403 testValue [("a", "b"), ("c", "d")]
\r
404 testValue (("a", "b"), ("c", "d"))
\r
406 testGenericJson "\"asd\""
\r
407 testGenericJson "123"
\r
408 testGenericJson "123.0"
\r
409 testGenericJson "true"
\r
410 testGenericJson "false"
\r
411 testGenericJson "null"
\r
412 testGenericJson "[1,2,3]"
\r
413 testGenericJson "[[1],[2,3],[]]"
\r
414 testGenericJson "{}"
\r
415 testGenericJson "{\"a\":123,\"b\":[]}"
\r
416 testGenericJson "{\"a\":{}}"
\r