More FFI compiler options

12 files changed, 47 insertions, 2 deletions

diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index b40d4248..3a124ff4 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2839,6 +2839,8 @@ fun p_file env (ds, ps) =
                                                      ^ OS.Path.joinDirFile {dir = Settings.getUrlPrefix (),
                                                                             file = "app.js"}
                                                      ^ "\\\"></script>\\n"),
+                                    p_list (fn x => string ("<script src=\\\"" ^ x ^ "\\\"></script>"))
+                                           (Settings.getScripts ()),
                                     string "\");",
                                     newline,
                                     string "uw_set_needs_push(ctx, ",
diff --git a/src/compiler.sig b/src/compiler.sig
index d49d34b0..fd3c86cf 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -41,6 +41,7 @@ signature COMPILER = sig
          ffi : string list,
          link : string list,
          headers : string list,
+         scripts : string list,
          clientToServer : Settings.ffi list,
          effectful : Settings.ffi list,
          clientOnly : Settings.ffi list,
diff --git a/src/compiler.sml b/src/compiler.sml
index cdde57ad..1a7868e3 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -45,6 +45,7 @@ type job = {
      ffi : string list,
      link : string list,
      headers : string list,
+     scripts : string list,
      clientToServer : Settings.ffi list,
      effectful : Settings.ffi list,
      clientOnly : Settings.ffi list,
@@ -208,7 +209,7 @@ val parseUr = {
      print = SourcePrint.p_file}    
 
 fun p_job {prefix, database, exe, sql, sources, debug, profile,
-           timeout, ffi, link, headers,
+           timeout, ffi, link, headers, scripts,
            clientToServer, effectful, clientOnly, serverOnly, jsFuncs} =
     let
         open Print.PD
@@ -241,6 +242,7 @@ fun p_job {prefix, database, exe, sql, sources, debug, profile,
              newline,
              p_list_sep (box []) (fn s => box [string "Ffi", space, string s, newline]) ffi,
              p_list_sep (box []) (fn s => box [string "Header", space, string s, newline]) headers,
+             p_list_sep (box []) (fn s => box [string "Script", space, string s, newline]) scripts,
              p_list_sep (box []) (fn s => box [string "Link", space, string s, newline]) link,
              p_ffi "ClientToServer" clientToServer,
              p_ffi "Effectful" effectful,
@@ -305,6 +307,7 @@ val parseUrp = {
                   val ffi = ref []
                   val link = ref []
                   val headers = ref []
+                  val scripts = ref []
                   val clientToServer = ref []
                   val effectful = ref []
                   val clientOnly = ref []
@@ -323,6 +326,7 @@ val parseUrp = {
                        ffi = rev (!ffi),
                        link = rev (!link),
                        headers = rev (!headers),
+                       scripts = rev (!scripts),
                        clientToServer = rev (!clientToServer),
                        effectful = rev (!effectful),
                        clientOnly = rev (!clientOnly),
@@ -387,6 +391,7 @@ val parseUrp = {
                                 | "ffi" => ffi := relify arg :: !ffi
                                 | "link" => link := relifyA arg :: !link
                                 | "include" => headers := relifyA arg :: !headers
+                                | "script" => scripts := arg :: !scripts
                                 | "clientToServer" => clientToServer := ffiS () :: !clientToServer
                                 | "effectful" => effectful := ffiS () :: !effectful
                                 | "clientOnly" => clientOnly := ffiS () :: !clientOnly
@@ -402,6 +407,7 @@ val parseUrp = {
                   Settings.setUrlPrefix (#prefix job);
                   Settings.setTimeout (#timeout job);
                   Settings.setHeaders (#headers job);
+                  Settings.setScripts (#scripts job);
                   Settings.setClientToServer (#clientToServer job);
                   Settings.setEffectful (#effectful job);
                   Settings.setClientOnly (#clientOnly job);
diff --git a/src/demo.sml b/src/demo.sml
index 9fa08021..0b7f3345 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -98,6 +98,7 @@ fun make {prefix, dirname, guided} =
             ffi = [],
             link = [],
             headers = [],
+            scripts = [],
             clientToServer = [],
             effectful = [],
             clientOnly = [],
diff --git a/src/settings.sig b/src/settings.sig
index 4e764a78..514fb0ee 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -39,6 +39,10 @@ signature SETTINGS = sig
     val setHeaders : string list -> unit
     val getHeaders : unit -> string list
 
+    (* Which extra JavaScript URLs should be included? *)
+    val setScripts : string list -> unit
+    val getScripts : unit -> string list
+
     type ffi = string * string
 
     (* Which FFI types may be sent from clients to servers? *)
diff --git a/src/settings.sml b/src/settings.sml
index b022219d..9e619b54 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -30,6 +30,7 @@ structure Settings :> SETTINGS = struct
 val urlPrefix = ref "/"
 val timeout = ref 0
 val headers = ref ([] : string list)
+val scripts = ref ([] : string list)
 
 fun getUrlPrefix () = !urlPrefix
 fun setUrlPrefix p =
@@ -46,6 +47,9 @@ fun setTimeout n = timeout := n
 fun getHeaders () = !headers
 fun setHeaders ls = headers := ls
 
+fun getScripts () = !scripts
+fun setScripts ls = scripts := ls
+
 type ffi = string * string
 
 structure K = struct
diff --git a/tests/cffi.ur b/tests/cffi.ur
index cc93b8f5..039eac55 100644
--- a/tests/cffi.ur
+++ b/tests/cffi.ur
@@ -1,6 +1,12 @@
+fun printer () = Test.foo
+
 fun effect () =
   Test.print;
-  return <xml/>
+  return <xml><body>
+    <button value="Remote" onclick={printer ()}/>
+    <button value="Local" onclick={Test.bar "Hoho"}/>
+    <button value="Either" onclick={Test.print}/>
+  </body></xml>
 
 fun main () = return <xml><body>
   {[Test.out (Test.frob (Test.create "Hello ") "world!")]}
diff --git a/tests/cffi.urp b/tests/cffi.urp
index ed64da3a..f2755cb6 100644
--- a/tests/cffi.urp
+++ b/tests/cffi.urp
@@ -1,7 +1,12 @@
 debug
 ffi test
 include test.h
+script http://localhost/test/test.js
 link test.o
 effectful Test.print
+serverOnly Test.foo
+clientOnly Test.bar
+jsFunc Test.print=print
+jsFunc Test.bar=bar
 
 cffi
diff --git a/tests/test.c b/tests/test.c
index b4f23670..1249721e 100644
--- a/tests/test.c
+++ b/tests/test.c
@@ -20,3 +20,8 @@ uw_Basis_unit uw_Test_print(uw_context ctx) {
   printf("Hi there!\n");
   return uw_unit_v;
 }
+
+uw_Basis_unit uw_Test_foo(uw_context ctx) {
+  printf("FOO!\n");
+  return uw_unit_v;
+}
diff --git a/tests/test.h b/tests/test.h
index d94cf02d..d1574e1b 100644
--- a/tests/test.h
+++ b/tests/test.h
@@ -7,3 +7,4 @@ uw_Basis_string uw_Test_out(uw_context, uw_Test_t);
 uw_Test_t uw_Test_frob(uw_context, uw_Test_t, uw_Basis_string);
 
 uw_Basis_unit uw_Test_print(uw_context);
+uw_Basis_unit uw_Test_foo(uw_context);
diff --git a/tests/test.js b/tests/test.js
new file mode 100644
index 00000000..4f29ca81
--- /dev/null
+++ b/tests/test.js
@@ -0,0 +1,7 @@
+function print() {
+  alert("Hi there!");
+}
+
+function bar(s) {
+  alert("<<" + s + ">>");
+}
diff --git a/tests/test.urs b/tests/test.urs
index b3c8505c..05efcb5b 100644
--- a/tests/test.urs
+++ b/tests/test.urs
@@ -4,3 +4,6 @@ val create : string -> t
 val out : t -> string
 val frob : t -> string -> t
 val print : transaction unit
+
+val foo : transaction unit
+val bar : string -> transaction unit