Mercurial > meta
changeset 22:8de201d70b91
Implement JSON typeclass for polymorphic variants.
| author | Edward Z. Yang <ezyang@mit.edu> |
|---|---|
| date | Wed, 02 May 2012 11:47:37 -0400 |
| parents | e7d64ea0f922 |
| children | 9d6b931fbd13 |
| files | json.ur json.urs lib.urp tests/testJson.ur |
| diffstat | 4 files changed, 66 insertions(+), 6 deletions(-) [+] |
line wrap: on
line diff
--- a/json.ur Thu Jan 05 18:04:04 2012 -0500 +++ b/json.ur Wed May 02 11:47:37 2012 -0400 @@ -222,7 +222,7 @@ 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> + error <xml>No colon after JSON object field name</xml> else skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1}) @@ -265,3 +265,52 @@ | Some v => v) fl r names, s') end end} + +fun json_variant [ts ::: {Type}] (fl : folder ts) (jss : $(map json ts)) (names : $(map (fn _ => string) ts)) : json (variant ts) = + {ToJson = fn r => let val jnames = @map2 [json] [fn _ => string] [fn x => json x * string] + (fn [t] (j : json t) (name : string) => (j, name)) fl jss names + in @Variant.destrR [ident] [fn x => json x * string] + (fn [p ::_] (v : p) (j : json p, name : string) => + "{" ^ escape name ^ ":" ^ j.ToJson v ^ "}") fl r jnames + end, + FromJson = fn s => + if String.length s = 0 || String.sub s 0 <> #"{" then + error <xml>JSON variant doesn't begin with brace</xml> + 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 name</xml> + else + skipSpaces (String.substring s' {Start = 1, Len = String.length s' - 1}) + + val (r, s') = (@foldR2 [json] [fn _ => string] + [fn ts => ts' :: {Type} -> [ts ~ ts'] => variant (ts ++ ts') * string] + (fn [nm ::_] [t ::_] [rest ::_] [[nm] ~ rest] (j : json t) name' + (acc : ts' :: {Type} -> [rest ~ ts'] => variant (rest ++ ts') * string) [fwd ::_] [[nm = t] ++ rest ~ fwd] => + if name = name' + then + let val (v, s') = j.FromJson s' + in (make [nm] v, s') + end + else acc [fwd ++ [nm = t]] + ) + (fn [fwd ::_] [[] ~ fwd] => error <xml>Unknown JSON object variant name {[name]}</xml>) + fl jss names) [[]] ! + + 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 + 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 error <xml>Junk after JSON value in object</xml> + end + } + +val json_unit : json unit = json_record {} {}
--- a/json.urs Thu Jan 05 18:04:04 2012 -0500 +++ b/json.urs Wed May 02 11:47:37 2012 -0400 @@ -16,3 +16,6 @@ val json_list : a ::: Type -> json a -> json (list a) val json_record : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json $ts +val json_variant : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json (variant ts) + +val json_unit : json unit
--- a/lib.urp Thu Jan 05 18:04:04 2012 -0500 +++ b/lib.urp Wed May 02 11:47:37 2012 -0400 @@ -1,11 +1,11 @@ $/char $/string $/option -json incl mem eq variant +json sql parse html
--- a/tests/testJson.ur Thu Jan 05 18:04:04 2012 -0500 +++ b/tests/testJson.ur Wed May 02 11:47:37 2012 -0400 @@ -7,7 +7,11 @@ State : string, PostalCode : string} -type phoneNumber = {Type_ : string, +type phoneType = variant [Mobile = string, + LandLine = unit, + Secret = unit] + +type phoneNumber = {Type_ : phoneType, Number : string} type person = {FirstName : string, @@ -23,8 +27,8 @@ City = "Hoserville", State = "QQ", PostalCode = "66666"}, - PhoneNumber = {Type_ = "mobile", Number = "1234"} - :: {Type_ = "secret", Number = "ssssh"} + PhoneNumber = {Type_ = make [#Mobile] "Verizon", Number = "1234"} + :: {Type_ = make [#Secret] (), Number = "ssssh"} :: []} val json_address : json address = json_record {StreetAddress = "streetAddress", @@ -32,6 +36,10 @@ State = "state", PostalCode = "postalCode"} +val json_phoneType : json phoneType = json_variant {Mobile = "mobile", + LandLine = "landline", + Secret = "secret"} + val json_phoneNumber : json phoneNumber = json_record {Type_ = "type", Number = "number"} @@ -49,7 +57,7 @@ <b>City:</b> {[p.Address.City]}<br/> <b>State:</b> {[p.Address.State]}<br/> <b>Postal code:</b> {[p.Address.PostalCode]}<br/> - <b>Phone numbers:</b> {List.mapX (fn pn => <xml>{[pn.Type_]} => {[pn.Number]}; </xml>) p.PhoneNumber}<br/> + <b>Phone numbers:</b> {List.mapX (fn pn => <xml>{[pn.Number]}; </xml>) p.PhoneNumber}<br/> </xml> fun parse r = return <xml><body>