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)
317 | JsonBoolean Boolean
319 | JsonObject [JsonField]
320 data JsonField = JsonField String Json
322 lookupJsonField :: String -> Json -> Maybe Json
323 lookupJsonField fieldName (JsonObject fields) = mapFirst selector fields
325 selector (JsonField name value) | name == fieldName = Just value
328 deriving instance Show Json
329 deriving instance Show JsonField
331 instance Json Json where
332 writeJson g (JsonString value) = writeString g value
333 writeJson g (JsonDouble value) = writeNumberDouble g value
334 writeJson g (JsonLong value) = writeNumberLong g value
335 writeJson g (JsonBoolean value) = writeBoolean g value
336 writeJson g JsonNull = writeNull g
337 writeJson g (JsonArray values) = do
339 iter (writeJson g) values
341 writeJson g (JsonObject fields) = do
343 iter (\(JsonField name value) -> do
344 writeFieldName g name
345 writeJson g value) fields
349 token = currentToken p
350 if token == VALUE_STRING
351 then JsonString (getText p)
352 else if token == VALUE_NUMBER_FLOAT
353 then JsonDouble (getDoubleValue p)
354 else if token == VALUE_NUMBER_INT
355 then JsonLong (getLongValue p)
356 else if token == VALUE_TRUE
357 then JsonBoolean True
358 else if token == VALUE_FALSE
359 then JsonBoolean False
360 else if token == VALUE_NULL
362 else if token == START_ARRAY
364 result = MList.create ()
365 while (nextToken p != END_ARRAY)
366 (MList.add result $ readJson p)
367 JsonArray (MList.freeze result)
368 else if token == START_OBJECT
370 result = MList.create ()
371 readJsonObjectContents result p
372 JsonObject (MList.freeze result)
373 else fail "Unsupported token type."
378 readJsonObjectContents :: MList.T JsonField -> JsonParser -> <Proc> ()
379 readJsonObjectContents result p =
380 match nextFieldName p with
382 MList.add result $ JsonField name (readNextJson p)
383 readJsonObjectContents result p
388 makeTypeEqual :: a -> a -> ()
389 makeTypeEqual _ _ = ()
392 testValue :: Json a => Show a => a -> <Proc> ()
395 v3 = fromJsonString v2
397 print "\(v1) -> \(v2) -> \(v3)"
399 then fail "Values differ"
402 testGenericJson :: String -> <Proc> ()
403 testGenericJson v1 = do
404 v2 = fromJsonString v1 :: Json
406 print "\(v1) -> \(v2) -> \(v3)"
408 then fail "Values differ"
416 testValue (123 :: Short)
417 testValue (123 :: Integer)
418 testValue (123 :: Long)
419 testValue (123 :: Double)
420 testValue (123 :: Float)
421 testValue (Nothing :: Maybe String)
422 testValue (Just "asd")
423 testValue ["a", "b", "c"]
424 testValue [[],["a"],["b","c"]]
427 testValue ("a", "b", "c")
428 testValue ("a", "b", "c", "d")
429 testValue [Just "a", Nothing]
430 testValue [("a", "b"), ("c", "d")]
431 testValue (("a", "b"), ("c", "d"))
433 testGenericJson "\"asd\""
434 testGenericJson "123"
435 testGenericJson "123.0"
436 testGenericJson "true"
437 testGenericJson "false"
438 testGenericJson "null"
439 testGenericJson "[1,2,3]"
440 testGenericJson "[[1],[2,3],[]]"
442 testGenericJson "{\"a\":123,\"b\":[]}"
443 testGenericJson "{\"a\":{}}"