Mercurial > meta
changeset 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 |
| files | json.ur tests/testJson.ur |
| diffstat | 2 files changed, 72 insertions(+), 16 deletions(-) [+] |
line wrap: on
line diff
--- a/json.ur Thu Dec 02 11:35:01 2010 -0500 +++ b/json.ur Thu Dec 02 11:59:55 2010 -0500 @@ -198,4 +198,57 @@ "" => "" | _ => "," ^ acc)) "" fl jss names r ^ "}", - FromJson = fn _ => error <xml>Uhoh!</xml>} + FromJson = fn s => + let + fun fromJ s (r : $(map option ts)) : $(map option ts) * string = + if String.length s = 0 then + error <xml>JSON object doesn't end in brace</xml> + else if String.sub s 0 = #"}" then + (r, String.substring s {Start = 1, Len = String.length s - 1}) + else let + val (name, s') = unescape s + val s' = skipSpaces s' + val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then + error <xml>No colon after JSON object field naem</xml> + else + skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1}) + + val (r, s') = @foldR2 [json] [fn _ => string] [fn ts => $(map option ts) -> $(map option ts) * string] + (fn [nm ::_] [t ::_] [r ::_] [[nm] ~ r] (j : json t) name' acc r => + if name = name' then + let + val (v, s') = j.FromJson s' + in + (r -- nm ++ {nm = Some v}, s') + end + else + let + val (r', s') = acc (r -- nm) + in + (r' ++ {nm = r.nm}, s') + end) + (fn _ => error <xml>Unknown JSON object field name {[name]}</xml>) + fl jss names r + + val s' = skipSpaces s' + val s' = if String.length s' <> 0 && String.sub s' 0 = #"," then + skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1}) + else + s' + in + fromJ s' r + end + in + if String.length s = 0 || String.sub s 0 <> #"{" then + error <xml>JSON record doesn't begin with brace</xml> + else + let + val (r, s') = fromJ (String.substring s {Start = 1, Len = String.length s - 1}) + (@map0 [option] (fn [t ::_] => None) fl) + in + (@map2 [option] [fn _ => string] [id] (fn [t] (v : option t) name => + case v of + None => error <xml>Missing JSON object field {[name]}</xml> + | Some v => v) fl r names, s') + end + end}
--- a/tests/testJson.ur Thu Dec 02 11:35:01 2010 -0500 +++ b/tests/testJson.ur Thu Dec 02 11:59:55 2010 -0500 @@ -3,18 +3,21 @@ val json_abcd : json {A : int, B : float, C : string, D : bool} = json_record {A = "a", B = "b", C = "c", D = "d"} -fun main () : transaction page = return <xml><body> - {[toJson (1 :: 2 :: 8 :: [])]}<br/> - {[fromJson "[1,2, 8]" : list int]} - <hr/> - {[toJson (1.2 :: 2.4 :: (-8.8) :: [])]}<br/> - {[fromJson "[1.4,-2.7, 8.215506]" : list float]} - <hr/> - {[toJson ("hi" :: "bye" :: "tricky\\\" one!" :: [])]}<br/> - {[fromJson "[\"abc\", \"\\\\whoa\"]" : list string]} - <hr/> - {[toJson (True :: False :: True :: [])]}<br/> - {[fromJson "[true,false, true]" : list bool]} - <hr/> - {[toJson {A = 1, B = 2.3, C = "Hi", D = True}]} -</body></xml> +fun main () : transaction page = + d <- return (fromJson "{\"a\": 1, \"b\": 2.3, \"c\": \"Hi\", \"d\": true}" : {A : int, B : float, C : string, D : bool}); + return <xml><body> + {[toJson (1 :: 2 :: 8 :: [])]}<br/> + {[fromJson "[1,2, 8]" : list int]} + <hr/> + {[toJson (1.2 :: 2.4 :: (-8.8) :: [])]}<br/> + {[fromJson "[1.4,-2.7, 8.215506]" : list float]} + <hr/> + {[toJson ("hi" :: "bye" :: "tricky\\\" one!" :: [])]}<br/> + {[fromJson "[\"abc\", \"\\\\whoa\"]" : list string]} + <hr/> + {[toJson (True :: False :: True :: [])]}<br/> + {[fromJson "[true,false, true]" : list bool]} + <hr/> + {[toJson {A = 1, B = 2.3, C = "Hi", D = True}]}<br/> + A: {[d.A]}, B: {[d.B]}, C: {[d.C]}, D: {[d.D]} + </body></xml>