Mercurial > meta
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} |