comparison json.ur @ 2:478524b9d23a

Parsed a JSON record
author Adam Chlipala <adam@chlipala.net>
date Thu, 02 Dec 2010 11:59:55 -0500
parents 4d103b4450ee
children 189245a3c075
comparison
equal deleted inserted replaced
1:4d103b4450ee 2:478524b9d23a
196 (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name v acc => 196 (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name v acc =>
197 escape name ^ ":" ^ j.ToJson v ^ (case acc of 197 escape name ^ ":" ^ j.ToJson v ^ (case acc of
198 "" => "" 198 "" => ""
199 | _ => "," ^ acc)) 199 | _ => "," ^ acc))
200 "" fl jss names r ^ "}", 200 "" fl jss names r ^ "}",
201 FromJson = fn _ => error <xml>Uhoh!</xml>} 201 FromJson = fn s =>
202 let
203 fun fromJ s (r : $(map option ts)) : $(map option ts) * string =
204 if String.length s = 0 then
205 error <xml>JSON object doesn't end in brace</xml>
206 else if String.sub s 0 = #"}" then
207 (r, String.substring s {Start = 1, Len = String.length s - 1})
208 else let
209 val (name, s') = unescape s
210 val s' = skipSpaces s'
211 val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then
212 error <xml>No colon after JSON object field naem</xml>
213 else
214 skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
215
216 val (r, s') = @foldR2 [json] [fn _ => string] [fn ts => $(map option ts) -> $(map option ts) * string]
217 (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name' acc r =>
218 if name = name' then
219 let
220 val (v, s') = j.FromJson s'
221 in
222 (r -- nm ++ {nm = Some v}, s')
223 end
224 else
225 let
226 val (r', s') = acc (r -- nm)
227 in
228 (r' ++ {nm = r.nm}, s')
229 end)
230 (fn _ => error <xml>Unknown JSON object field name {[name]}</xml>)
231 fl jss names r
232
233 val s' = skipSpaces s'
234 val s' = if String.length s' <> 0 && String.sub s' 0 = #"," then
235 skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1})
236 else
237 s'
238 in
239 fromJ s' r
240 end
241 in
242 if String.length s = 0 || String.sub s 0 <> #"{" then
243 error <xml>JSON record doesn't begin with brace</xml>
244 else
245 let
246 val (r, s') = fromJ (String.substring s {Start = 1, Len = String.length s - 1})
247 (@map0 [option] (fn [t ::_] => None) fl)
248 in
249 (@map2 [option] [fn _ => string] [id] (fn [t] (v : option t) name =>
250 case v of
251 None => error <xml>Missing JSON object field {[name]}</xml>
252 | Some v => v) fl r names, s')
253 end
254 end}