# HG changeset patch # User Edward Z. Yang # Date 1335973657 14400 # Node ID 9d6b931fbd13007cfc1aedfe8dc16f0dea9ec9fa # Parent 8de201d70b91fdd253eb677565d6fdbe7852009c Implement JSON type class for recursive datatypes, using Mu combinator. diff -r 8de201d70b91 -r 9d6b931fbd13 json.ur --- a/json.ur Wed May 02 11:47:37 2012 -0400 +++ b/json.ur Wed May 02 11:47:37 2012 -0400 @@ -25,6 +25,7 @@ end fun toJson [a] (j : json a) : a -> string = j.ToJson +fun fromJson' [a] (j : json a) : string -> a * string = j.FromJson fun fromJson [a] (j : json a) (s : string) : a = let @@ -278,7 +279,7 @@ error JSON variant doesn't begin with brace else let - val (name, s') = unescape s + val (name, s') = unescape (skipSpaces (String.suffix s 1)) val s' = skipSpaces s' val s' = if String.length s' = 0 || String.sub s' 0 <> #":" then error No colon after JSON object field name @@ -314,3 +315,25 @@ } val json_unit : json unit = json_record {} {} + +functor Recursive (M : sig + con t :: Type -> Type + val json_t : a ::: Type -> json a -> json (t a) + end) = struct + open M + + datatype r = Rec of t r + + fun rTo (Rec x) = (json_t {ToJson = rTo, + FromJson = fn _ => error Tried to FromJson in ToJson!}).ToJson x + + fun rFrom s = + let + val (x, s') = (json_t {ToJson = fn _ => error Tried to ToJson in FromJson!, + FromJson = rFrom}).FromJson s + in + (Rec x, s') + end + + val json_r = {ToJson = rTo, FromJson = rFrom} +end diff -r 8de201d70b91 -r 9d6b931fbd13 json.urs --- a/json.urs Wed May 02 11:47:37 2012 -0400 +++ b/json.urs Wed May 02 11:47:37 2012 -0400 @@ -4,6 +4,7 @@ val toJson : a ::: Type -> json a -> a -> string val fromJson : a ::: Type -> json a -> string -> a +val fromJson' : a ::: Type -> json a -> string -> a * string val mkJson : a ::: Type -> {ToJson : a -> string, FromJson : string -> a * string} -> json a @@ -19,3 +20,12 @@ val json_variant : ts ::: {Type} -> folder ts -> $(map json ts) -> $(map (fn _ => string) ts) -> json (variant ts) val json_unit : json unit + +functor Recursive (M : sig + con t :: Type -> Type + val json_t : a ::: Type -> json a -> json (t a) + end) : sig + datatype r = Rec of M.t r + + val json_r : json r +end diff -r 8de201d70b91 -r 9d6b931fbd13 tests/testJson.ur --- a/tests/testJson.ur Wed May 02 11:47:37 2012 -0400 +++ b/tests/testJson.ur Wed May 02 11:47:37 2012 -0400 @@ -57,7 +57,7 @@ City: {[p.Address.City]}
State: {[p.Address.State]}
Postal code: {[p.Address.PostalCode]}
- Phone numbers: {List.mapX (fn pn => {[pn.Number]}; ) p.PhoneNumber}
+ fun parse r = return @@ -79,3 +79,44 @@ + +structure God = Json.Recursive(struct + con t a = variant [Fun = string * list a, + Var = string] + + fun json_t [a] (_ : json a) : json (t a) = + let + val json_fun : json (string * list a) = json_record ("1", "2") + in + json_variant {Fun = "Fun", Var = "Var"} + end + end) + +fun renderGod (God.Rec g) = + match g + {Fun = fn (s, gs) => + Main god: {[s]}
+ Subgods: + , + Var = fn s => + Var: {[s]} + } + +fun parseGod r = return +

Beautified

+ {renderGod (fromJson r.Text)} + +

Round-tripped

+ {[toJson (fromJson r.Text : God.r)]} + + +fun godMain () = return +

Parse ye gods

+ +
+
+ + +
 diff -r 8de201d70b91 -r 9d6b931fbd13 tests/testJson.urs --- a/tests/testJson.urs Wed May 02 11:47:37 2012 -0400 +++ b/tests/testJson.urs Wed May 02 11:47:37 2012 -0400 @@ -1,1 +1,2 @@ val main : {} -> transaction page +val godMain : {} -> transaction page