Mercurial > urweb
changeset 613:c5991cdb0c4b
Initial parsing of RPC results
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 15 Feb 2009 12:33:41 -0500 |
| parents | d80256efc160 |
| children | 5891f47d7cff |
| files | lib/js/urweb.js src/cjr_print.sml src/jscomp.sml src/rpcify.sml tests/rpc2.ur tests/rpc2.urp |
| diffstat | 6 files changed, 185 insertions(+), 31 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/js/urweb.js Sun Feb 15 11:33:53 2009 -0500 +++ b/lib/js/urweb.js Sun Feb 15 12:33:41 2009 -0500 @@ -129,7 +129,7 @@ } } -function rc(uri, k) { +function rc(uri, parse, k) { var xhr = getXHR(); xhr.onreadystatechange = function() { @@ -142,7 +142,7 @@ } catch (e) { } if (isok) - k(xhr.responseText); + k(parse(xhr.responseText)); else alert("Error querying remote server!"); }
--- a/src/cjr_print.sml Sun Feb 15 11:33:53 2009 -0500 +++ b/src/cjr_print.sml Sun Feb 15 12:33:41 2009 -0500 @@ -863,30 +863,37 @@ val xts = E.lookupStruct env i - val (blocks, _) = ListUtil.foldlMap - (fn ((x, t), wasEmpty) => - (box [string "{", - newline, - p_typ env t, - space, - string ("it" ^ Int.toString (level + 1)), - space, - string "=", - space, - string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"), - newline, - box (if wasEmpty then - [] - else - [string "uw_write(ctx, \"/\");", - newline]), - urlify' rf (level + 1) t, - string "}", - newline], - empty t)) - false xts + val (blocks, _) = foldl + (fn ((x, t), (blocks, printingSinceLastSlash)) => + let + val thisEmpty = empty t + in + if thisEmpty then + (blocks, printingSinceLastSlash) + else + (box [string "{", + newline, + p_typ env t, + space, + string ("it" ^ Int.toString (level + 1)), + space, + string "=", + space, + string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"), + newline, + box (if printingSinceLastSlash then + [string "uw_write(ctx, \"/\");", + newline] + else + []), + urlify' rf (level + 1) t, + string "}", + newline] :: blocks, + true) + end) + ([], false) xts in - box blocks + box (rev blocks) end | TDatatype (Enum, i, _) => box []
--- a/src/jscomp.sml Sun Feb 15 11:33:53 2009 -0500 +++ b/src/jscomp.sml Sun Feb 15 12:33:41 2009 -0500 @@ -304,6 +304,120 @@ Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)]; (str loc "ERROR", st)) + fun unurlifyExp loc (t : typ, st) = + case #1 t of + TRecord [] => ("null", st) + | TRecord [(x, t)] => + let + val (e, st) = unurlifyExp loc (t, st) + in + ("{_" ^ x ^ ":" ^ e ^ "}", + st) + end + | TRecord ((x, t) :: xts) => + let + val (e', st) = unurlifyExp loc (t, st) + val (es, st) = ListUtil.foldlMap + (fn ((x, t), st) => + let + val (e, st) = unurlifyExp loc (t, st) + in + (",_" ^ x ^ ":" ^ e, st) + end) + st xts + in + (String.concat ("{_" + :: x + :: ":" + :: e' + :: es + @ ["}"]), st) + end + + | TFfi ("Basis", "string") => ("decode(t[i++])", st) + | TFfi ("Basis", "int") => ("parseInt(t[i++])", st) + | TFfi ("Basis", "float") => ("parseFloat(t[i++])", st) + + | TFfi ("Basis", "bool") => ("t[i++] == \"True\"", st) + + | TOption t => raise Fail "!!" (* + let + val (e', st) = quoteExp loc t ((ERel 0, loc), st) + in + ((ECase (e, + [((PNone t, loc), + str loc "null"), + ((PSome (t, (PVar ("x", t), loc)), loc), + if isNullable t then + strcat loc [str loc "{v:", e', str loc "}"] + else + e')], + {disc = (TOption t, loc), + result = (TFfi ("Basis", "string"), loc)}), loc), + st) + end*) + + | TDatatype (n, ref (dk, cs)) => raise Fail "!!" (* + (case IM.find (#injectors st, n) of + SOME n' => ((EApp ((ENamed n', loc), e), loc), st) + | NONE => + let + val dk = ElabUtil.classifyDatatype cs + + val n' = #maxName st + val st = {decls = #decls st, + script = #script st, + included = #included st, + injectors = IM.insert (#injectors st, n, n'), + maxName = n' + 1} + + val (pes, st) = ListUtil.foldlMap + (fn ((_, cn, NONE), st) => + (((PCon (dk, PConVar cn, NONE), loc), + case dk of + Option => str loc "null" + | _ => str loc (Int.toString cn)), + st) + | ((_, cn, SOME t), st) => + let + val (e, st) = quoteExp loc t ((ERel 0, loc), st) + in + (((PCon (dk, PConVar cn, SOME (PVar ("x", t), loc)), loc), + case dk of + Option => + if isNullable t then + strcat loc [str loc "{_v:", + e, + str loc "}"] + else + e + | _ => strcat loc [str loc ("{n:" ^ Int.toString cn + ^ ",v:"), + e, + str loc "}"]), + st) + end) + st cs + + val s = (TFfi ("Basis", "string"), loc) + val body = (ECase ((ERel 0, loc), pes, + {disc = t, result = s}), loc) + val body = (EAbs ("x", t, s, body), loc) + + val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc), + body, "jsify")], loc) :: #decls st, + script = #script st, + included = #included st, + injectors = #injectors st, + maxName = #maxName st} + in + ((EApp ((ENamed n', loc), e), loc), st) + end)*) + + | _ => (EM.errorAt loc "Don't know how to unurlify type in JavaScript"; + Print.prefaces "Can't unurlify" [("t", MonoPrint.p_typ MonoEnv.empty t)]; + ("ERROR", st)) + fun jsExp mode skip outer = let val len = length outer @@ -812,11 +926,13 @@ st) end - | EServerCall (x, es, ek, _) => + | EServerCall (x, es, ek, t) => let val (ek, st) = jsE inner (ek, st) + val (unurl, st) = unurlifyExp loc (t, st) in - (strcat [str ("rc(\"" ^ !Monoize.urlPrefix ^ x ^ "\","), + (strcat [str ("rc(\"" ^ !Monoize.urlPrefix ^ x ^ "\", function(s){var t=s.split(\"/\");var i=0;return " + ^ unurl ^ "},"), ek, str ")"], st)
--- a/src/rpcify.sml Sun Feb 15 11:33:53 2009 -0500 +++ b/src/rpcify.sml Sun Feb 15 12:33:41 2009 -0500 @@ -103,8 +103,8 @@ let fun doOne ((_, n, t, _, _), tfuncs) = let - fun crawl ((t, _), args) = - case t of + fun crawl (t, args) = + case #1 t of CApp ((CFfi ("Basis", "transaction"), _), ran) => SOME (rev args, ran) | TFun (arg, rest) => crawl (rest, arg :: args) | _ => NONE @@ -130,7 +130,7 @@ trans1), _), trans2) => (case (serverSide trans1, clientSide trans1, serverSide trans2, clientSide trans2) of - (true, false, false, _) => + (true, false, false, true) => let fun getApp (e, args) = case #1 e of @@ -156,7 +156,8 @@ val ran = case IM.find (tfuncs, n) of - NONE => raise Fail "Rpcify: Undetected transaction function" + NONE => (Print.prefaces "BAD" [("e", CorePrint.p_exp CoreEnv.empty (e, loc))]; + raise Fail "Rpcify: Undetected transaction function") | SOME (_, ran) => ran in (EServerCall (n, args, trans2, ran), st)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/rpc2.ur Sun Feb 15 12:33:41 2009 -0500 @@ -0,0 +1,25 @@ +sequence s +sequence s2 + +fun dint src = n <- signal src; return <xml>{[n]}</xml> + +fun main () : transaction page = + let + fun getNext () = + n <- nextval s; + n2 <- nextval s2; + return (n, n2) + in + src1 <- source 0; + src2 <- source 0; + return <xml><body> + <button value="Get It On!" + onclick={p <- getNext (); + case p of + (n1, n2) => set src1 n1; + set src2 n2}/> + <br/> + Current1: <dyn signal={dint src1}/> + Current2: <dyn signal={dint src2}/> + </body></xml> + end