Mercurial > meta

comparison json.ur @ 23:9d6b931fbd13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Implement JSON type class for recursive datatypes, using Mu combinator.
author Edward Z. Yang <ezyang@mit.edu>
date Wed, 02 May 2012 11:47:37 -0400
parents 8de201d70b91
children 7530b2b54353
comparison
equal deleted inserted replaced
22:8de201d70b91 23:9d6b931fbd13
23 in 23 in
24 skip 0 24 skip 0
25 end 25 end
26 26
27 fun toJson [a] (j : json a) : a -> string = j.ToJson 27 fun toJson [a] (j : json a) : a -> string = j.ToJson
28 fun fromJson' [a] (j : json a) : string -> a * string = j.FromJson
28 29
29 fun fromJson [a] (j : json a) (s : string) : a = 30 fun fromJson [a] (j : json a) (s : string) : a =
30 let 31 let
31 val (v, s') = j.FromJson (skipSpaces s) 32 val (v, s') = j.FromJson (skipSpaces s)
32 in 33 in
276 FromJson = fn s => 277 FromJson = fn s =>
277 if String.length s = 0 || String.sub s 0 <> #"{" then 278 if String.length s = 0 || String.sub s 0 <> #"{" then
278 error <xml>JSON variant doesn't begin with brace</xml> 279 error <xml>JSON variant doesn't begin with brace</xml>
279 else 280 else
280 let 281 let
281 val (name, s') = unescape s 282 val (name, s') = unescape (skipSpaces (String.suffix s 1))
282 val s' = skipSpaces s' 283 val s' = skipSpaces s'
283 val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then 284 val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then
284 error <xml>No colon after JSON object field name</xml> 285 error <xml>No colon after JSON object field name</xml>
285 else 286 else
286 skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1}) 287 skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
312 else error <xml>Junk after JSON value in object</xml> 313 else error <xml>Junk after JSON value in object</xml>
313 end 314 end
314 } 315 }
315 316
316 val json_unit : json unit = json_record {} {} 317 val json_unit : json unit = json_record {} {}
318
319 functor Recursive (M : sig
320 con t :: Type -> Type
321 val json_t : a ::: Type -> json a -> json (t a)
322 end) = struct
323 open M
324
325 datatype r = Rec of t r
326
327 fun rTo (Rec x) = (json_t {ToJson = rTo,
328 FromJson = fn _ => error <xml>Tried to FromJson in ToJson!</xml>}).ToJson x
329
330 fun rFrom s =
331 let
332 val (x, s') = (json_t {ToJson = fn _ => error <xml>Tried to ToJson in FromJson!</xml>,
333 FromJson = rFrom}).FromJson s
334 in
335 (Rec x, s')
336 end
337
338 val json_r = {ToJson = rTo, FromJson = rFrom}
339 end