Mercurial > meta

comparison json.ur @ 22:8de201d70b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Implement JSON typeclass for polymorphic variants.
author Edward Z. Yang <ezyang@mit.edu>
date Wed, 02 May 2012 11:47:37 -0400
parents 6cd839818393
children 9d6b931fbd13
comparison
equal deleted inserted replaced
21:e7d64ea0f922 22:8de201d70b91
220 (r, String.substring s {Start = 1, Len = String.length s - 1}) 220 (r, String.substring s {Start = 1, Len = String.length s - 1})
221 else let 221 else let
222 val (name, s') = unescape s 222 val (name, s') = unescape s
223 val s' = skipSpaces s' 223 val s' = skipSpaces s'
224 val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then 224 val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then
225 error <xml>No colon after JSON object field naem</xml> 225 error <xml>No colon after JSON object field name</xml>
226 else 226 else
227 skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1}) 227 skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
228 228
229 val (r, s') = @foldR2 [json] [fn _ => string] [fn ts => $(map option ts) -> $(map option ts) * string] 229 val (r, s') = @foldR2 [json] [fn _ => string] [fn ts => $(map option ts) -> $(map option ts) * string]
230 (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name' acc r => 230 (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name' acc r =>
263 case v of 263 case v of
264 None => error <xml>Missing JSON object field {[name]}</xml> 264 None => error <xml>Missing JSON object field {[name]}</xml>
265 | Some v => v) fl r names, s') 265 | Some v => v) fl r names, s')
266 end 266 end
267 end} 267 end}
268
269 fun json_variant [ts ::: {Type}] (fl : folder ts) (jss : $(map json ts)) (names : $(map (fn _ => string) ts)) : json (variant ts) =
270 {ToJson = fn r => let val jnames = @map2 [json] [fn _ => string] [fn x => json x * string]
271 (fn [t] (j : json t) (name : string) => (j, name)) fl jss names
272 in @Variant.destrR [ident] [fn x => json x * string]
273 (fn [p ::_] (v : p) (j : json p, name : string) =>
274 "{" ^ escape name ^ ":" ^ j.ToJson v ^ "}") fl r jnames
275 end,
276 FromJson = fn s =>
277 if String.length s = 0 || String.sub s 0 <> #"{" then
278 error <xml>JSON variant doesn't begin with brace</xml>
279 else
280 let
281 val (name, s') = unescape s
282 val s' = skipSpaces s'
283 val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then
284 error <xml>No colon after JSON object field name</xml>
285 else
286 skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
287
288 val (r, s') = (@foldR2 [json] [fn _ => string]
289 [fn ts => ts' :: {Type} -> [ts ~ ts'] => variant (ts ++ ts') * string]
290 (fn [nm ::_] [t ::_] [rest ::_] [[nm] ~ rest] (j : json t) name'
291 (acc : ts' :: {Type} -> [rest ~ ts'] => variant (rest ++ ts') * string) [fwd ::_] [[nm = t] ++ rest ~ fwd] =>
292 if name = name'
293 then
294 let val (v, s') = j.FromJson s'
295 in (make [nm] v, s')
296 end
297 else acc [fwd ++ [nm = t]]
298 )
299 (fn [fwd ::_] [[] ~ fwd] => error <xml>Unknown JSON object variant name {[name]}</xml>)
300 fl jss names) [[]] !
301
302 val s' = skipSpaces s'
303 val s' = if String.length s' <> 0 && String.sub s' 0 = #"," then
304 skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
305 else
306 s'
307 in
308 if String.length s' = 0 then
309 error <xml>JSON object doesn't end in brace</xml>
310 else if String.sub s' 0 = #"}" then
311 (r, String.substring s' {Start = 1, Len = String.length s' - 1})
312 else error <xml>Junk after JSON value in object</xml>
313 end
314 }
315
316 val json_unit : json unit = json_record {} {}