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
55 instance Eq JsonToken where
\r
58 importJava "com.fasterxml.jackson.core.JsonParser" where
\r
62 importJava "com.fasterxml.jackson.core.JsonParser" where
\r
63 nextToken :: JsonParser -> <Proc> JsonToken
\r
64 currentToken :: JsonParser -> <Proc> JsonToken
\r
65 getDoubleValue :: JsonParser -> <Proc> Double
\r
66 getIntValue :: JsonParser -> <Proc> Integer
\r
67 getText :: JsonParser -> <Proc> String
\r
68 getShortValue :: JsonParser -> <Proc> Short
\r
69 getFloatValue :: JsonParser -> <Proc> Float
\r
70 getLongValue :: JsonParser -> <Proc> Long
\r
71 nextFieldName :: JsonParser -> <Proc> Maybe String
\r
74 importJava "com.fasterxml.jackson.core.JsonFactory" where
\r
78 createJsonFactory :: <Proc> JsonFactory
\r
80 @JavaName createGenerator
\r
81 createWriterGenerator :: JsonFactory -> Writer -> <Proc> JsonGenerator
\r
83 @JavaName createParser
\r
84 createStringParser :: JsonFactory -> String -> <Proc> JsonParser
\r
87 defaultFactory = createJsonFactory
\r
91 assertStartArray :: JsonParser -> <Proc> ()
\r
92 assertStartArray p = if currentToken p == START_ARRAY
\r
94 else fail "Expected START_ARRAY token."
\r
98 assertEndArray :: JsonParser -> <Proc> ()
\r
99 assertEndArray p = if nextToken p == END_ARRAY
\r
101 else fail "Expected END_ARRAY token."
\r
103 // *** Json type class ********************************************************
\r
106 writeJson :: JsonGenerator -> a -> <Proc> ()
\r
107 readJson :: JsonParser -> <Proc> a
\r
108 toJson :: a -> Json
\r
109 fromJson :: Json -> a
\r
111 writeJson g v = writeJson g (toJson v)
\r
112 readJson p = fromJson (readJson p)
\r
115 readNextJson :: Json a => JsonParser -> <Proc> a
\r
116 readNextJson p = do
\r
121 Converts the value to a string encoded with JSON
\r
123 toJsonString :: Json a => a -> String
\r
124 toJsonString v = runProc do
\r
125 writer = createStringWriter
\r
126 generator = createWriterGenerator defaultFactory (toWriter writer)
\r
127 writeJson generator v
\r
128 closeGenerator generator
\r
129 resultOfStringWriter writer
\r
132 Parses a JSON encoded string into a value
\r
134 fromJsonString :: Json a => String -> a
\r
135 fromJsonString str = runProc do
\r
136 parser = createStringParser defaultFactory str
\r
137 readNextJson parser
\r
139 instance Json String where
\r
140 writeJson = writeString
\r
142 toJson = JsonString
\r
143 fromJson (JsonString value) = value
\r
145 instance Json Boolean where
\r
146 writeJson = writeBoolean
\r
148 if currentToken p == VALUE_TRUE
\r
151 toJson = JsonBoolean
\r
152 fromJson (JsonBoolean value) = value
\r
154 instance Json Double where
\r
155 writeJson = writeNumberDouble
\r
156 readJson = getDoubleValue
\r
157 toJson = JsonDouble
\r
158 fromJson (JsonDouble value) = value
\r
160 instance Json Float where
\r
161 writeJson = writeNumberFloat
\r
162 readJson = getFloatValue
\r
163 toJson = JsonDouble . toDouble
\r
164 fromJson (JsonDouble value) = fromDouble value
\r
166 instance Json Integer where
\r
167 writeJson = writeNumberInteger
\r
168 readJson = getIntValue
\r
169 toJson = JsonLong . fromInteger
\r
170 fromJson (JsonLong value) = Java.l2i value
\r
172 instance Json Long where
\r
173 writeJson = writeNumberLong
\r
174 readJson = getLongValue
\r
176 fromJson (JsonLong value) = value
\r
178 instance Json Short where
\r
179 writeJson = writeNumberShort
\r
180 readJson = getShortValue
\r
181 toJson = JsonLong . Java.i2l . Java.s2i
\r
182 fromJson (JsonLong value) = Java.i2s (Java.l2i value)
\r
184 instance (Json a) => Json (Maybe a) where
\r
185 writeJson g (Just v) = writeJson g v
\r
186 writeJson g Nothing = writeNull g
\r
188 if currentToken p == VALUE_NULL
\r
190 else Just (readJson p)
\r
191 toJson (Just value) = toJson value
\r
192 toJson Nothing = JsonNull
\r
193 fromJson JsonNull = Nothing
\r
194 fromJson json = Just (fromJson json)
\r
196 instance (Json a) => Json [a] where
\r
199 iter (writeJson g) l
\r
201 readJson p = MList.freeze result
\r
203 result = MList.create ()
\r
205 while (nextToken p != END_ARRAY)
\r
206 (MList.add result $ readJson p)
\r
207 toJson l = JsonArray (map toJson l)
\r
208 fromJson (JsonArray l) = map fromJson l
\r
210 instance Json () where
\r
218 toJson _ = JsonArray []
\r
219 fromJson (JsonArray []) = ()
\r
221 instance (Json a, Json b) => Json (a, b) where
\r
222 writeJson g (a, b) = do
\r
227 readJson p = (a, b)
\r
233 toJson (a, b) = JsonArray [toJson a, toJson b]
\r
234 fromJson (JsonArray [a, b]) = (fromJson a, fromJson b)
\r
236 instance (Json a, Json b, Json c) => Json (a, b, c) where
\r
237 writeJson g (a, b, c) = do
\r
243 readJson p = (a, b, c)
\r
250 toJson (a, b, c) = JsonArray [toJson a, toJson b, toJson c]
\r
251 fromJson (JsonArray [a, b, c]) = (fromJson a, fromJson b, fromJson c)
\r
253 instance (Json a, Json b, Json c, Json d) => Json (a, b, c, d) where
\r
254 writeJson g (a, b, c, d) = do
\r
261 readJson p = (a, b, c, d)
\r
269 toJson (a, b, c, d) = JsonArray [toJson a, toJson b, toJson c, toJson d]
\r
270 fromJson (JsonArray [a, b, c, d]) = (fromJson a, fromJson b, fromJson c, fromJson d)
\r
272 instance (Json a, Json b, Json c, Json d, Json e) => Json (a, b, c, d, e) where
\r
273 writeJson g (a, b, c, d, e) = do
\r
281 readJson p = (a, b, c, d, e)
\r
290 toJson (a, b, c, d, e) = JsonArray [toJson a, toJson b, toJson c, toJson d, toJson e]
\r
291 fromJson (JsonArray [a, b, c, d, e]) = (fromJson a, fromJson b, fromJson c, fromJson d, fromJson e)
\r
295 | JsonDouble Double
\r
298 | JsonBoolean Boolean
\r
300 | JsonObject [JsonField]
\r
301 data JsonField = JsonField String Json
\r
303 deriving instance Show Json
\r
304 deriving instance Eq Json
\r
305 deriving instance Show JsonField
\r
306 deriving instance Eq JsonField
\r
308 instance Json Json where
\r
309 writeJson g (JsonString value) = writeString g value
\r
310 writeJson g (JsonDouble value) = writeNumberDouble g value
\r
311 writeJson g (JsonLong value) = writeNumberLong g value
\r
312 writeJson g (JsonBoolean value) = writeBoolean g value
\r
313 writeJson g JsonNull = writeNull g
\r
314 writeJson g (JsonArray values) = do
\r
316 iter (writeJson g) values
\r
318 writeJson g (JsonObject fields) = do
\r
320 iter (\(JsonField name value) -> do
\r
321 writeFieldName g name
\r
322 writeJson g value) fields
\r
326 token = currentToken p
\r
327 if token == VALUE_STRING
\r
328 then JsonString (getText p)
\r
329 else if token == VALUE_NUMBER_FLOAT
\r
330 then JsonDouble (getDoubleValue p)
\r
331 else if token == VALUE_NUMBER_INT
\r
332 then JsonLong (getLongValue p)
\r
333 else if token == VALUE_TRUE
\r
334 then JsonBoolean True
\r
335 else if token == VALUE_FALSE
\r
336 then JsonBoolean False
\r
337 else if token == VALUE_NULL
\r
339 else if token == START_ARRAY
\r
341 result = MList.create ()
\r
342 while (nextToken p != END_ARRAY)
\r
343 (MList.add result $ readJson p)
\r
344 JsonArray (MList.freeze result)
\r
345 else if token == START_OBJECT
\r
347 result = MList.create ()
\r
348 readJsonObjectContents result p
\r
349 JsonObject (MList.freeze result)
\r
350 else fail "Unsupported token type."
\r
355 readJsonObjectContents :: MList.T JsonField -> JsonParser -> <Proc> ()
\r
356 readJsonObjectContents result p =
\r
357 match nextFieldName p with
\r
359 MList.add result $ JsonField name (readNextJson p)
\r
360 readJsonObjectContents result p
\r
365 makeTypeEqual :: a -> a -> ()
\r
366 makeTypeEqual _ _ = ()
\r
369 testValue :: Json a => Show a => Eq a => a -> <Proc> ()
\r
371 v2 = toJsonString v1
\r
372 v3 = fromJsonString v2
\r
373 makeTypeEqual v1 v3
\r
374 print "\(v1) -> \(v2) -> \(v3)"
\r
376 then fail "Values differ"
\r
379 testGenericJson :: String -> <Proc> ()
\r
380 testGenericJson v1 = do
\r
381 v2 = fromJsonString v1 :: Json
\r
382 v3 = toJsonString v2
\r
383 print "\(v1) -> \(v2) -> \(v3)"
\r
385 then fail "Values differ"
\r
388 testIt :: <Proc> ()
\r
393 testValue (123 :: Short)
\r
394 testValue (123 :: Integer)
\r
395 testValue (123 :: Long)
\r
396 testValue (123 :: Double)
\r
397 testValue (123 :: Float)
\r
398 testValue (Nothing :: Maybe String)
\r
399 testValue (Just "asd")
\r
400 testValue ["a", "b", "c"]
\r
401 testValue [[],["a"],["b","c"]]
\r
403 testValue ("a", "b")
\r
404 testValue ("a", "b", "c")
\r
405 testValue ("a", "b", "c", "d")
\r
406 testValue [Just "a", Nothing]
\r
407 testValue [("a", "b"), ("c", "d")]
\r
408 testValue (("a", "b"), ("c", "d"))
\r
410 testGenericJson "\"asd\""
\r
411 testGenericJson "123"
\r
412 testGenericJson "123.0"
\r
413 testGenericJson "true"
\r
414 testGenericJson "false"
\r
415 testGenericJson "null"
\r
416 testGenericJson "[1,2,3]"
\r
417 testGenericJson "[[1],[2,3],[]]"
\r
418 testGenericJson "{}"
\r
419 testGenericJson "{\"a\":123,\"b\":[]}"
\r
420 testGenericJson "{\"a\":{}}"
\r