Initial parsing of RPC results

6 files changed, 185 insertions, 31 deletions

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index bfca94a4..c78229af 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -129,7 +129,7 @@ function getXHR()
   }
 }
 
-function rc(uri, k) {
+function rc(uri, parse, k) {
   var xhr = getXHR();
 
   xhr.onreadystatechange = function() {
@@ -142,7 +142,7 @@ function rc(uri, k) {
       } catch (e) { }
 
       if (isok)
-        k(xhr.responseText);
+        k(parse(xhr.responseText));
       else
         alert("Error querying remote server!");
     }
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index fcd18fb7..c1911c8d 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -863,30 +863,37 @@ fun urlify env t =
 
                     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 []
diff --git a/src/jscomp.sml b/src/jscomp.sml
index de671fef..9651f930 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -304,6 +304,120 @@ fun process file =
                       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 @@ fun process file =
                                  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)
diff --git a/src/rpcify.sml b/src/rpcify.sml
index 45d178ee..6601a14b 100644
--- a/src/rpcify.sml
+++ b/src/rpcify.sml
@@ -103,8 +103,8 @@ fun frob file =
                          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 @@ fun frob file =
                       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 @@ fun frob file =
 
                          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)
diff --git a/tests/rpc2.ur b/tests/rpc2.ur
new file mode 100644
index 00000000..47548e76
--- /dev/null
+++ b/tests/rpc2.ur
@@ -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
diff --git a/tests/rpc2.urp b/tests/rpc2.urp
new file mode 100644
index 00000000..74f46f98
--- /dev/null
+++ b/tests/rpc2.urp
@@ -0,0 +1,5 @@
+debug
+sql rpc2.sql
+database dbname=rpc2
+
+rpc2