summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-01-08 10:30:14 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-01-08 10:30:14 -0500
commit9608c763d7b2923c11e8abd29e28271ae470a5fe (patch)
treed4648aecea89bd3799de7a6ee50a6333bd967e1a
parent4b109c964ac7f433b4feb9d28b135dee28f75b87 (diff)
Injected a non-special-case datatype
-rw-r--r--jslib/urweb.js4
-rw-r--r--src/jscomp.sml7
-rw-r--r--tests/jsinj.ur18
3 files changed, 27 insertions, 2 deletions
diff --git a/jslib/urweb.js b/jslib/urweb.js
index 16424eb3..9d28b461 100644
--- a/jslib/urweb.js
+++ b/jslib/urweb.js
@@ -41,6 +41,10 @@ function dyn(s) {
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") }
diff --git a/src/jscomp.sml b/src/jscomp.sml
index bb457ab3..64cb1771 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -40,7 +40,7 @@ val funcs = [(("Basis", "alert"), "alert"),
(("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 @@ fun process file =
str loc "}"]
else
e
- | _ => e),
+ | _ => strcat loc [str loc ("{n:" ^ Int.toString cn
+ ^ ",v:"),
+ e,
+ str loc "}"]),
st)
end)
st cs
diff --git a/tests/jsinj.ur b/tests/jsinj.ur
index f3954085..182de33b 100644
--- a/tests/jsinj.ur
+++ b/tests/jsinj.ur
@@ -20,6 +20,16 @@ fun delist ls : xbody =
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 pair : int * float
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 @@ fun main () : transaction page =
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 @@ fun main () : transaction page =
<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>