Parameterized RPC query

6 files changed, 41 insertions, 22 deletions

diff --git a/src/jscomp.sml b/src/jscomp.sml
index 9651f930..383a9f6f 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -43,7 +43,10 @@ val funcs = [(("Basis", "alert"), "alert"),
              (("Basis", "htmlifyInt"), "ts"),
              (("Basis", "htmlifyString"), "eh"),
              (("Basis", "new_client_source"), "sc"),
-             (("Basis", "set_client_source"), "sv")]
+             (("Basis", "set_client_source"), "sv"),
+             (("Basis", "urlifyInt"), "ts"),
+             (("Basis", "urlifyFloat"), "ts"),
+             (("Basis", "urlifyString"), "escape")]
 
 structure FM = BinaryMapFn(struct
                            type ord_key = string * string
@@ -98,7 +101,7 @@ fun varDepth (e, _) =
       | ESignalReturn e => varDepth e
       | ESignalBind (e1, e2) => Int.max (varDepth e1, varDepth e2)
       | ESignalSource e => varDepth e
-      | EServerCall (_, es, ek, _) => foldl Int.max (varDepth ek) (map varDepth es)
+      | EServerCall (e, ek, _) => Int.max (varDepth e, varDepth ek)
 
 fun closedUpto d =
     let
@@ -139,7 +142,7 @@ fun closedUpto d =
               | ESignalReturn e => cu inner e
               | ESignalBind (e1, e2) => cu inner e1 andalso cu inner e2
               | ESignalSource e => cu inner e
-              | EServerCall (_, es, ek, _) => List.all (cu inner) es andalso cu inner ek
+              | EServerCall (e, ek, _) => cu inner e andalso cu inner ek
     in
         cu 0
     end
@@ -926,12 +929,15 @@ fun process file =
                                  st)
                             end
 
-                          | EServerCall (x, es, ek, t) =>
+                          | EServerCall (e, ek, t) =>
                             let
+                                val (e, st) = jsE inner (e, st)
                                 val (ek, st) = jsE inner (ek, st)
                                 val (unurl, st) = unurlifyExp loc (t, st)
                             in
-                                (strcat [str ("rc(\"" ^ !Monoize.urlPrefix ^ x ^ "\", function(s){var t=s.split(\"/\");var i=0;return "
+                                (strcat [str ("rc(\"" ^ !Monoize.urlPrefix ^ "\"+"),
+                                         e,
+                                         str (", function(s){var t=s.split(\"/\");var i=0;return "
                                               ^ unurl ^ "},"),
                                          ek,
                                          str ")"],
diff --git a/src/mono.sml b/src/mono.sml
index ea2b9720..b0be4c5f 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -109,7 +109,7 @@ datatype exp' =
        | ESignalBind of exp * exp
        | ESignalSource of exp
 
-       | EServerCall of string * exp list * exp * typ
+       | EServerCall of exp * exp * typ
 
 withtype exp = exp' located
 
diff --git a/src/mono_print.sml b/src/mono_print.sml
index ba4c57f1..a61b5847 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -308,11 +308,8 @@ fun p_exp' par env (e, _) =
                                 p_exp env e,
                                 string ")"]
 
-      | EServerCall (n, es, e, _) => box [string "Server(",
-                                          string n,
-                                          string ",",
-                                          space,
-                                          p_list (p_exp env) es,
+      | EServerCall (n, e, _) => box [string "Server(",
+                                          p_exp env n,
                                           string ")[",
                                           p_exp env e,
                                           string "]"]
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 2d0412fd..1f640004 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -346,7 +346,7 @@ fun reduce file =
                       | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2
                       | ESignalSource e => summarize d e
 
-                      | EServerCall (_, es, ek, _) => List.concat (map (summarize d) es) @ summarize d ek @ [Unsure]
+                      | EServerCall (e, ek, _) => summarize d e @ summarize d ek @ [Unsure]
             in
                 (*Print.prefaces "Summarize"
                                [("e", MonoPrint.p_exp MonoEnv.empty (e, ErrorMsg.dummySpan)),
diff --git a/src/mono_util.sml b/src/mono_util.sml
index d1157218..00113c9b 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -350,14 +350,12 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                      fn e' =>
                         (ESignalSource e', loc))
 
-              | EServerCall (n, es, ek, t) =>
-                S.bind2 (ListUtil.mapfold (fn e => mfe ctx e) es,
-                      fn es' =>
-                         S.bind2 (mfe ctx ek,
-                                 fn ek' =>
-                                    S.map2 (mft t,
-                                            fn t' =>
-                                               (EServerCall (n, es', ek', t'), loc))))
+              | EServerCall (n, ek, t) =>
+                S.bind2 (mfe ctx ek,
+                      fn ek' =>
+                         S.map2 (mft t,
+                              fn t' =>
+                                 (EServerCall (n, ek', t'), loc)))
     in
         mfe
     end
diff --git a/src/monoize.sml b/src/monoize.sml
index 43c3f47d..4efa2fea 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2228,8 +2228,26 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
           | L.EServerCall (n, es, ek, t) =>
             let
                 val t = monoType env t
-                val (_, _, _, name) = Env.lookupENamed env n
+                val (_, ft, _, name) = Env.lookupENamed env n
                 val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es
+
+                fun encodeArgs (es, ft, acc, fm) =
+                    case (es, ft) of
+                        ([], _) => (rev acc, fm)
+                      | (e :: es, (L.TFun (dom, ran), _)) =>
+                        let
+                            val (e, fm) = urlifyExp env fm (e, monoType env dom)
+                        in
+                            encodeArgs (es, ran, e
+                                                 :: (L'.EPrim (Prim.String "/"), loc)
+                                                 :: acc, fm)
+                        end
+                      | _ => raise Fail "Monoize: Not enough arguments visible in RPC function type"
+
+                val (call, fm) = encodeArgs (es, ft, [], fm)
+                val call = foldl (fn (e, call) => (L'.EStrcat (call, e), loc))
+                                 (L'.EPrim (Prim.String name), loc) call
+
                 val (ek, fm) = monoExp (env, st, fm) ek
 
                 val ekf = (L'.EAbs ("f",
@@ -2246,7 +2264,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                         (L'.ERecord [], loc)), loc)), loc)), loc)
                 val ek = (L'.EApp (ekf, ek), loc)
             in
-                ((L'.EServerCall (name, es, ek, t), loc), fm)
+                ((L'.EServerCall (call, ek, t), loc), fm)
             end
     end