Mercurial > meta
diff tests/testJson.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 |
line wrap: on
line diff
--- 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 @@ <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.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> @@ -79,3 +79,44 @@ <submit value="Parse" action={parse}/> </form> </body></xml> + +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) => <xml> + <b>Main god:</b> {[s]}<br/> + <b>Subgods:</b> <ul> + {List.mapX (fn g' => <xml><li>{renderGod g'}</li></xml>) gs} + </ul> + </xml>, + Var = fn s => <xml> + <b>Var:</b> {[s]} + </xml>} + +fun parseGod r = return <xml><body> + <h2>Beautified</h2> + {renderGod (fromJson r.Text)} + + <h2>Round-tripped</h2> + {[toJson (fromJson r.Text : God.r)]} +</body></xml> + +fun godMain () = return <xml><body> + <h1>Parse ye gods</h1> + + <form> + <textarea{#Text} rows={10} cols={80}/><br/> + <submit value="Parse" action={parseGod}/> + </form> +</body></xml>