changeset 597:d49d58a69877

Injected a non-special-case datatype
author Adam Chlipala <adamc@hcoop.net>
date Thu, 08 Jan 2009 10:30:14 -0500
parents d1ec54288b1a
children 4c2c740c6931
files jslib/urweb.js src/jscomp.sml tests/jsinj.ur
diffstat 3 files changed, 27 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- a/jslib/urweb.js	Thu Jan 08 10:15:45 2009 -0500
+++ b/jslib/urweb.js	Thu Jan 08 10:30:14 2009 -0500
@@ -41,6 +41,10 @@
   s.h = cons(function() { x.innerHTML = s.v }, s.h);
 }
 
+function eh(x) {
+  return x.split("&").join("&amp;").split("<").join("&lt;").split(">").join("&gt;");
+}
+
 function ts(x) { return x.toString() }
 function bs(b) { return (b ? "True" : "False") }
 
--- a/src/jscomp.sml	Thu Jan 08 10:15:45 2009 -0500
+++ b/src/jscomp.sml	Thu Jan 08 10:30:14 2009 -0500
@@ -40,7 +40,7 @@
              (("Basis", "htmlifyBool"), "bs"),
              (("Basis", "htmlifyFloat"), "ts"),
              (("Basis", "htmlifyInt"), "ts"),
-             (("Basis", "htmlifyString"), "escape"),
+             (("Basis", "htmlifyString"), "eh"),
              (("Basis", "new_client_source"), "sc"),
              (("Basis", "set_client_source"), "sv")]
 
@@ -274,7 +274,10 @@
                                                                            str loc "}"]
                                                            else
                                                                e
-                                                         | _ => e),
+                                                         | _ => strcat loc [str loc ("{n:" ^ Int.toString cn
+                                                                                     ^ ",v:"),
+                                                                            e,
+                                                                            str loc "}"]),
                                                       st)
                                                  end)
                                              st cs
--- a/tests/jsinj.ur	Thu Jan 08 10:15:45 2009 -0500
+++ b/tests/jsinj.ur	Thu Jan 08 10:30:14 2009 -0500
@@ -20,6 +20,16 @@
         Nil => <xml>Nil</xml>
       | Cons (h, t) => <xml>{cdata h} :: {delist t}</xml>
 
+datatype weird = Foo | Bar | Baz of string
+
+fun weirdToString w =
+    case w of
+        Foo => "Foo"
+      | Bar => "Bar"
+      | Baz s => s
+
+val show_weird = mkShow weirdToString
+
 cookie int : int
 cookie float : float
 cookie string : string
@@ -28,6 +38,7 @@
 cookie option : option int
 cookie color : color
 cookie list : list string
+cookie weird : weird
 
 fun main () : transaction page =
     n <- getCookie int;
@@ -62,6 +73,10 @@
     l <- return (getOpt l (Cons ("A", Cons ("B", Nil))));
     sl <- source Nil;
 
+    w <- getCookie weird;
+    w <- return (getOpt w (Baz "TADA!"));
+    sw <- source Foo;
+
     return <xml><body>
       <dyn signal={n <- signal sn; return <xml>{[n]}</xml>}/>
       <a onclick={set sn n}>CHANGE</a><br/>
@@ -88,4 +103,7 @@
 
       <dyn signal={l <- signal sl; return <xml>{delist l}</xml>}/>
       <a onclick={set sl l}>CHANGE</a><br/>
+
+      <dyn signal={w <- signal sw; return <xml>{[w]}</xml>}/>
+      <a onclick={set sw w}>CHANGE</a><br/>
     </body></xml>