Mercurial > meta
diff json.ur @ 23:9d6b931fbd13
Implement JSON type class for recursive datatypes, using Mu combinator.
author | Edward Z. Yang <ezyang@mit.edu> |
---|---|
date | Wed, 02 May 2012 11:47:37 -0400 |
parents | 8de201d70b91 |
children | 7530b2b54353 |
line wrap: on
line diff
--- 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 <xml>JSON variant doesn't begin with brace</xml> 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 <xml>No colon after JSON object field name</xml> @@ -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 <xml>Tried to FromJson in ToJson!</xml>}).ToJson x + + fun rFrom s = + let + val (x, s') = (json_t {ToJson = fn _ => error <xml>Tried to ToJson in FromJson!</xml>, + FromJson = rFrom}).FromJson s + in + (Rec x, s') + end + + val json_r = {ToJson = rTo, FromJson = rFrom} +end