# HG changeset patch
# User Edward Z. Yang <ezyang@mit.edu>
# Date 1335973657 14400
# Node ID 8de201d70b91fdd253eb677565d6fdbe7852009c
# Parent  e7d64ea0f922ca7a69cbba88a298ce1210a22636
Implement JSON typeclass for polymorphic variants.

diff -r e7d64ea0f922 -r 8de201d70b91 json.ur
--- 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 {} {}
diff -r e7d64ea0f922 -r 8de201d70b91 json.urs
--- 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
diff -r e7d64ea0f922 -r 8de201d70b91 lib.urp
--- 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
diff -r e7d64ea0f922 -r 8de201d70b91 tests/testJson.ur
--- 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>