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
178 instance Json Float where
179 writeJson = writeNumberFloat
180 readJson = getFloatValue
181 toJson = JsonDouble . toDouble
182 fromJson (JsonDouble value) = fromDouble value
184 instance Json Integer where
185 writeJson = writeNumberInteger
186 readJson = getIntValue
187 toJson = JsonLong . fromInteger
188 fromJson (JsonLong value) = Java.l2i value
190 instance Json Long where
191 writeJson = writeNumberLong
192 readJson = getLongValue
194 fromJson (JsonLong value) = value
196 instance Json Short where
197 writeJson = writeNumberShort
198 readJson = getShortValue
199 toJson = JsonLong . Java.i2l . Java.s2i
200 fromJson (JsonLong value) = Java.i2s (Java.l2i value)
202 instance (Json a) => Json (Maybe a) where
203 writeJson g (Just v) = writeJson g v
204 writeJson g Nothing = writeNull g
206 if currentToken p == VALUE_NULL
208 else Just (readJson p)
209 toJson (Just value) = toJson value
210 toJson Nothing = JsonNull
211 fromJson JsonNull = Nothing
212 fromJson json = Just (fromJson json)
214 instance (Json a) => Json [a] where
219 readJson p = MList.freeze result
221 result = MList.create ()
223 while (nextToken p != END_ARRAY)
224 (MList.add result $ readJson p)
225 toJson l = JsonArray (map toJson l)
226 fromJson (JsonArray l) = map fromJson l
228 instance Json () where
236 toJson _ = JsonArray []
237 fromJson (JsonArray []) = ()
239 instance (Json a, Json b) => Json (a, b) where
240 writeJson g (a, b) = do
251 toJson (a, b) = JsonArray [toJson a, toJson b]
252 fromJson (JsonArray [a, b]) = (fromJson a, fromJson b)
254 instance (Json a, Json b, Json c) => Json (a, b, c) where
255 writeJson g (a, b, c) = do
261 readJson p = (a, b, c)
268 toJson (a, b, c) = JsonArray [toJson a, toJson b, toJson c]
269 fromJson (JsonArray [a, b, c]) = (fromJson a, fromJson b, fromJson c)
271 instance (Json a, Json b, Json c, Json d) => Json (a, b, c, d) where
272 writeJson g (a, b, c, d) = do
279 readJson p = (a, b, c, d)
287 toJson (a, b, c, d) = JsonArray [toJson a, toJson b, toJson c, toJson d]
288 fromJson (JsonArray [a, b, c, d]) = (fromJson a, fromJson b, fromJson c, fromJson d)
290 instance (Json a, Json b, Json c, Json d, Json e) => Json (a, b, c, d, e) where
291 writeJson g (a, b, c, d, e) = do
299 readJson p = (a, b, c, d, e)
308 toJson (a, b, c, d, e) = JsonArray [toJson a, toJson b, toJson c, toJson d, toJson e]
309 fromJson (JsonArray [a, b, c, d, e]) = (fromJson a, fromJson b, fromJson c, fromJson d, fromJson e)
316 | JsonBoolean Boolean
318 | JsonObject [JsonField]
319 data JsonField = JsonField String Json
321 lookupJsonField :: String -> Json -> Maybe Json
322 lookupJsonField fieldName (JsonObject fields) = mapFirst selector fields
324 selector (JsonField name value) | name == fieldName = Just value
327 deriving instance Show Json
328 deriving instance Show JsonField
330 instance Json Json where
331 writeJson g (JsonString value) = writeString g value
332 writeJson g (JsonDouble value) = writeNumberDouble g value
333 writeJson g (JsonLong value) = writeNumberLong g value
334 writeJson g (JsonBoolean value) = writeBoolean g value
335 writeJson g JsonNull = writeNull g
336 writeJson g (JsonArray values) = do
338 iter (writeJson g) values
340 writeJson g (JsonObject fields) = do
342 iter (\(JsonField name value) -> do
343 writeFieldName g name
344 writeJson g value) fields
348 token = currentToken p
349 if token == VALUE_STRING
350 then JsonString (getText p)
351 else if token == VALUE_NUMBER_FLOAT
352 then JsonDouble (getDoubleValue p)
353 else if token == VALUE_NUMBER_INT
354 then JsonLong (getLongValue p)
355 else if token == VALUE_TRUE
356 then JsonBoolean True
357 else if token == VALUE_FALSE
358 then JsonBoolean False
359 else if token == VALUE_NULL
361 else if token == START_ARRAY
363 result = MList.create ()
364 while (nextToken p != END_ARRAY)
365 (MList.add result $ readJson p)
366 JsonArray (MList.freeze result)
367 else if token == START_OBJECT
369 result = MList.create ()
370 readJsonObjectContents result p
371 JsonObject (MList.freeze result)
372 else fail "Unsupported token type."
377 readJsonObjectContents :: MList.T JsonField -> JsonParser -> <Proc> ()
378 readJsonObjectContents result p =
379 match nextFieldName p with
381 MList.add result $ JsonField name (readNextJson p)
382 readJsonObjectContents result p
387 makeTypeEqual :: a -> a -> ()
388 makeTypeEqual _ _ = ()
391 testValue :: Json a => Show a => a -> <Proc> ()
394 v3 = fromJsonString v2
396 print "\(v1) -> \(v2) -> \(v3)"
398 then fail "Values differ"
401 testGenericJson :: String -> <Proc> ()
402 testGenericJson v1 = do
403 v2 = fromJsonString v1 :: Json
405 print "\(v1) -> \(v2) -> \(v3)"
407 then fail "Values differ"
415 testValue (123 :: Short)
416 testValue (123 :: Integer)
417 testValue (123 :: Long)
418 testValue (123 :: Double)
419 testValue (123 :: Float)
420 testValue (Nothing :: Maybe String)
421 testValue (Just "asd")
422 testValue ["a", "b", "c"]
423 testValue [[],["a"],["b","c"]]
426 testValue ("a", "b", "c")
427 testValue ("a", "b", "c", "d")
428 testValue [Just "a", Nothing]
429 testValue [("a", "b"), ("c", "d")]
430 testValue (("a", "b"), ("c", "d"))
432 testGenericJson "\"asd\""
433 testGenericJson "123"
434 testGenericJson "123.0"
435 testGenericJson "true"
436 testGenericJson "false"
437 testGenericJson "null"
438 testGenericJson "[1,2,3]"
439 testGenericJson "[[1],[2,3],[]]"
441 testGenericJson "{\"a\":123,\"b\":[]}"
442 testGenericJson "{\"a\":{}}"