3 An example how to implement
5 data GeographicalLocation = GeographicalLocation {
10 instance Json GeographicalLocation where
11 toJson GeographicalLocation { latitude, longitude } = JsonObject [
12 JsonField "latitude" (toJson latitude),
13 JsonField "longitude" (toJson longitude)
15 fromJson object = GeographicalLocation {
16 latitude = fromJson $ fromJust $ lookupJsonField "latitude" object,
17 longitude = fromJson $ fromJust $ lookupJsonField "longitude" object
21 import "StandardLibrary"
23 import "JavaBuiltin" as Java
25 importJava "com.fasterxml.jackson.core.JsonGenerator" where
29 importJava "com.fasterxml.jackson.core.JsonGenerator" where
30 writeNull :: JsonGenerator -> <Proc> ()
32 writeStartArray :: JsonGenerator -> <Proc> ()
33 @JavaName writeStartArray
34 writeStartArrayN :: JsonGenerator -> Integer -> <Proc> ()
35 writeEndArray :: JsonGenerator -> <Proc> ()
37 writeStartObject :: JsonGenerator -> <Proc> ()
38 writeFieldName :: JsonGenerator -> String -> <Proc> ()
39 writeEndObject :: JsonGenerator -> <Proc> ()
41 writeBoolean :: JsonGenerator -> Boolean -> <Proc> ()
43 writeString :: JsonGenerator -> String -> <Proc> ()
46 writeNumberDouble :: JsonGenerator -> Double -> <Proc> ()
48 writeNumberInteger :: JsonGenerator -> Integer -> <Proc> ()
50 writeNumberLong :: JsonGenerator -> Long -> <Proc> ()
52 writeNumberShort :: JsonGenerator -> Short -> <Proc> ()
54 writeNumberFloat :: JsonGenerator -> Float -> <Proc> ()
57 closeGenerator :: JsonGenerator -> <Proc> ()
60 importJava "com.fasterxml.jackson.core.JsonToken" where
62 END_ARRAY :: JsonToken
63 END_OBJECT :: JsonToken
64 FIELD_NAME :: JsonToken
65 NOT_AVAILABLE :: JsonToken
66 START_ARRAY :: JsonToken
67 START_OBJECT :: JsonToken
68 VALUE_EMBEDDED_OBJECT :: JsonToken
69 VALUE_FALSE :: JsonToken
70 VALUE_NULL :: JsonToken
71 VALUE_NUMBER_FLOAT :: JsonToken
72 VALUE_NUMBER_INT :: JsonToken
73 VALUE_STRING :: JsonToken
74 VALUE_TRUE :: JsonToken
76 importJava "com.fasterxml.jackson.core.JsonParser" where
80 importJava "com.fasterxml.jackson.core.JsonParser" where
81 nextToken :: JsonParser -> <Proc> JsonToken
82 currentToken :: JsonParser -> <Proc> JsonToken
83 getDoubleValue :: JsonParser -> <Proc> Double
84 getIntValue :: JsonParser -> <Proc> Integer
85 getText :: JsonParser -> <Proc> String
86 getShortValue :: JsonParser -> <Proc> Short
87 getFloatValue :: JsonParser -> <Proc> Float
88 getLongValue :: JsonParser -> <Proc> Long
89 nextFieldName :: JsonParser -> <Proc> Maybe String
92 importJava "com.fasterxml.jackson.core.JsonFactory" where
96 createJsonFactory :: <Proc> JsonFactory
98 @JavaName createGenerator
99 createWriterGenerator :: JsonFactory -> Writer -> <Proc> JsonGenerator
101 @JavaName createParser
102 createStringParser :: JsonFactory -> String -> <Proc> JsonParser
105 defaultFactory = createJsonFactory
109 assertStartArray :: JsonParser -> <Proc> ()
110 assertStartArray p = if currentToken p == START_ARRAY
112 else fail "Expected START_ARRAY token."
116 assertEndArray :: JsonParser -> <Proc> ()
117 assertEndArray p = if nextToken p == END_ARRAY
119 else fail "Expected END_ARRAY token."
121 // *** Json type class ********************************************************
124 writeJson :: JsonGenerator -> a -> <Proc> ()
125 readJson :: JsonParser -> <Proc> a
127 fromJson :: Json -> a
129 writeJson g v = writeJson g (toJson v)
130 readJson p = fromJson (readJson p)
133 readNextJson :: Json a => JsonParser -> <Proc> a
139 Converts the value to a string encoded with JSON
141 toJsonString :: Json a => a -> String
142 toJsonString v = runProc do
143 writer = createStringWriter
144 generator = createWriterGenerator defaultFactory (toWriter writer)
145 writeJson generator v
146 closeGenerator generator
147 resultOfStringWriter writer
150 Parses a JSON encoded string into a value
152 fromJsonString :: Json a => String -> a
153 fromJsonString str = runProc do
154 parser = createStringParser defaultFactory str
157 instance Json String where
158 writeJson = writeString
161 fromJson (JsonString value) = value
163 instance Json Boolean where
164 writeJson = writeBoolean
166 if currentToken p == VALUE_TRUE
170 fromJson (JsonBoolean value) = value
172 instance Json Double where
173 writeJson = writeNumberDouble
174 readJson = getDoubleValue
176 fromJson (JsonDouble value) = value
177 fromJson (JsonLong value) = Java.l2d value
179 instance Json Float where
180 writeJson = writeNumberFloat
181 readJson = getFloatValue
182 toJson = JsonDouble . toDouble
183 fromJson (JsonDouble value) = fromDouble value
185 instance Json Integer where
186 writeJson = writeNumberInteger
187 readJson = getIntValue
188 toJson = JsonLong . fromInteger
189 fromJson (JsonLong value) = Java.l2i value
191 instance Json Long where
192 writeJson = writeNumberLong
193 readJson = getLongValue
195 fromJson (JsonLong value) = value
197 instance Json Short where
198 writeJson = writeNumberShort
199 readJson = getShortValue
200 toJson = JsonLong . Java.i2l . Java.s2i
201 fromJson (JsonLong value) = Java.i2s (Java.l2i value)
203 instance (Json a) => Json (Maybe a) where
204 writeJson g (Just v) = writeJson g v
205 writeJson g Nothing = writeNull g
207 if currentToken p == VALUE_NULL
209 else Just (readJson p)
210 toJson (Just value) = toJson value
211 toJson Nothing = JsonNull
212 fromJson JsonNull = Nothing
213 fromJson json = Just (fromJson json)
215 instance (Json a) => Json [a] where
220 readJson p = MList.freeze result
222 result = MList.create ()
224 while (nextToken p != END_ARRAY)
225 (MList.add result $ readJson p)
226 toJson l = JsonArray (map toJson l)
227 fromJson (JsonArray l) = map fromJson l
229 instance Json () where
237 toJson _ = JsonArray []
238 fromJson (JsonArray []) = ()
240 instance (Json a, Json b) => Json (a, b) where
241 writeJson g (a, b) = do
252 toJson (a, b) = JsonArray [toJson a, toJson b]
253 fromJson (JsonArray [a, b]) = (fromJson a, fromJson b)
255 instance (Json a, Json b, Json c) => Json (a, b, c) where
256 writeJson g (a, b, c) = do
262 readJson p = (a, b, c)
269 toJson (a, b, c) = JsonArray [toJson a, toJson b, toJson c]
270 fromJson (JsonArray [a, b, c]) = (fromJson a, fromJson b, fromJson c)
272 instance (Json a, Json b, Json c, Json d) => Json (a, b, c, d) where
273 writeJson g (a, b, c, d) = do
280 readJson p = (a, b, c, d)
288 toJson (a, b, c, d) = JsonArray [toJson a, toJson b, toJson c, toJson d]
289 fromJson (JsonArray [a, b, c, d]) = (fromJson a, fromJson b, fromJson c, fromJson d)
291 instance (Json a, Json b, Json c, Json d, Json e) => Json (a, b, c, d, e) where
292 writeJson g (a, b, c, d, e) = do
300 readJson p = (a, b, c, d, e)
309 toJson (a, b, c, d, e) = JsonArray [toJson a, toJson b, toJson c, toJson d, toJson e]
310 fromJson (JsonArray [a, b, c, d, e]) = (fromJson a, fromJson b, fromJson c, fromJson d, fromJson e)
312 instance (Json a, Json b, Json c, Json d, Json e, Json f) => Json (a, b, c, d, e, f) where
313 writeJson g (a, b, c, d, e, f) = do
322 readJson p = (a, b, c, d, e, f)
332 toJson (a, b, c, d, e, f) = JsonArray [toJson a, toJson b, toJson c, toJson d, toJson e, toJson f]
333 fromJson (JsonArray [a, b, c, d, e, f]) = (fromJson a, fromJson b, fromJson c, fromJson d, fromJson e, fromJson f)
341 | JsonBoolean Boolean
343 | JsonObject [JsonField]
344 data JsonField = JsonField String Json
346 lookupJsonField :: String -> Json -> Maybe Json
347 lookupJsonField fieldName (JsonObject fields) = mapFirst selector fields
349 selector (JsonField name value) | name == fieldName = Just value
352 deriving instance Show Json
353 deriving instance Show JsonField
355 instance Json Json where
356 writeJson g (JsonString value) = writeString g value
357 writeJson g (JsonDouble value) = writeNumberDouble g value
358 writeJson g (JsonLong value) = writeNumberLong g value
359 writeJson g (JsonBoolean value) = writeBoolean g value
360 writeJson g JsonNull = writeNull g
361 writeJson g (JsonArray values) = do
363 iter (writeJson g) values
365 writeJson g (JsonObject fields) = do
367 iter (\(JsonField name value) -> do
368 writeFieldName g name
369 writeJson g value) fields
373 token = currentToken p
374 if token == VALUE_STRING
375 then JsonString (getText p)
376 else if token == VALUE_NUMBER_FLOAT
377 then JsonDouble (getDoubleValue p)
378 else if token == VALUE_NUMBER_INT
379 then JsonLong (getLongValue p)
380 else if token == VALUE_TRUE
381 then JsonBoolean True
382 else if token == VALUE_FALSE
383 then JsonBoolean False
384 else if token == VALUE_NULL
386 else if token == START_ARRAY
388 result = MList.create ()
389 while (nextToken p != END_ARRAY)
390 (MList.add result $ readJson p)
391 JsonArray (MList.freeze result)
392 else if token == START_OBJECT
394 result = MList.create ()
395 readJsonObjectContents result p
396 JsonObject (MList.freeze result)
397 else fail "Unsupported token type."
402 readJsonObjectContents :: MList.T JsonField -> JsonParser -> <Proc> ()
403 readJsonObjectContents result p =
404 match nextFieldName p with
406 MList.add result $ JsonField name (readNextJson p)
407 readJsonObjectContents result p
412 makeTypeEqual :: a -> a -> ()
413 makeTypeEqual _ _ = ()
416 testValue :: Json a => Show a => a -> <Proc> ()
419 v3 = fromJsonString v2
421 print "\(v1) -> \(v2) -> \(v3)"
423 then fail "Values differ"
426 testGenericJson :: String -> <Proc> ()
427 testGenericJson v1 = do
428 v2 = fromJsonString v1 :: Json
430 print "\(v1) -> \(v2) -> \(v3)"
432 then fail "Values differ"
440 testValue (123 :: Short)
441 testValue (123 :: Integer)
442 testValue (123 :: Long)
443 testValue (123 :: Double)
444 testValue (123 :: Float)
445 testValue (Nothing :: Maybe String)
446 testValue (Just "asd")
447 testValue ["a", "b", "c"]
448 testValue [[],["a"],["b","c"]]
451 testValue ("a", "b", "c")
452 testValue ("a", "b", "c", "d")
453 testValue [Just "a", Nothing]
454 testValue [("a", "b"), ("c", "d")]
455 testValue (("a", "b"), ("c", "d"))
457 testGenericJson "\"asd\""
458 testGenericJson "123"
459 testGenericJson "123.0"
460 testGenericJson "true"
461 testGenericJson "false"
462 testGenericJson "null"
463 testGenericJson "[1,2,3]"
464 testGenericJson "[[1],[2,3],[]]"
466 testGenericJson "{\"a\":123,\"b\":[]}"
467 testGenericJson "{\"a\":{}}"