summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/js/urweb.js168
-rw-r--r--lib/ur/basis.urs5
-rw-r--r--src/jscomp.sml11
-rw-r--r--src/mono_reduce.sml8
-rw-r--r--src/mono_util.sml28
-rw-r--r--tests/roundTrip.ur7
-rw-r--r--tests/updateErr.ur17
-rw-r--r--tests/updateErr.urp4
8 files changed, 177 insertions, 71 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 534769a5..877ed77f 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -23,6 +23,79 @@ function length(ls) {
}
+// Error handling
+
+function whine(msg) {
+ alert(msg);
+ throw msg;
+}
+
+function pf() {
+ whine("Pattern match failure");
+}
+
+function runHandlers(ls, arg) {
+ for (; ls; ls = ls.next)
+ try {
+ ls.data(arg)(null);
+ } catch (v) { }
+}
+
+var errorHandlers = null;
+
+function onError(f) {
+ errorHandlers = cons(f, errorHandlers);
+}
+
+function er(s) {
+ runHandlers(errorHandlers, s);
+ throw {uw_error: s};
+}
+
+var failHandlers = null;
+
+function onFail(f) {
+ failHandlers = cons(f, failHandlers);
+}
+
+function doExn(v) {
+ if (v == null || v.uw_error == null) {
+ var s = (v == null ? "null" : v.toString());
+ runHandlers(failHandlers, s);
+ }
+}
+
+var disconnectHandlers = null;
+
+function onDisconnect(f) {
+ disconnectHandlers = cons(function (_){return f}, disconnectHandlers);
+}
+
+function discon() {
+ runHandlers(disconnectHandlers, null);
+}
+
+var connectHandlers = null;
+
+function onConnectFail(f) {
+ connectHandlers = cons(function (_){return f}, connectHandlers);
+}
+
+function conn() {
+ runHandlers(connectHandlers, null);
+}
+
+var serverHandlers = null;
+
+function onServerError(f) {
+ serverHandlers = cons(f, serverHandlers);
+}
+
+function servErr(s) {
+ runHandlers(serverHandlers, s);
+}
+
+
// Embedding closures in XML strings
function cs(f) {
@@ -90,19 +163,23 @@ function flattenLocal(s) {
function populate(node) {
var s = node.signal;
var oldSources = node.sources;
- var sr = s();
- var newSources = sr.sources;
+ try {
+ var sr = s();
+ var newSources = sr.sources;
- for (var sp = oldSources; sp; sp = sp.next)
- if (!member(sp.data, newSources))
- sp.data.dyns = remove(node, sp.data.dyns);
+ for (var sp = oldSources; sp; sp = sp.next)
+ if (!member(sp.data, newSources))
+ sp.data.dyns = remove(node, sp.data.dyns);
- for (var sp = newSources; sp; sp = sp.next)
- if (!member(sp.data, oldSources))
- sp.data.dyns = cons(node, sp.data.dyns);
+ for (var sp = newSources; sp; sp = sp.next)
+ if (!member(sp.data, oldSources))
+ sp.data.dyns = cons(node, sp.data.dyns);
- node.sources = newSources;
- node.recreate(sr.data);
+ node.sources = newSources;
+ node.recreate(sr.data);
+ } catch (v) {
+ doExn(v);
+ }
}
function sc(v) {
@@ -160,7 +237,11 @@ function runScripts(node) {
scriptsCopy[i] = scripts[i];
for (var i = 0; i < len; ++i) {
thisScript = scriptsCopy[i];
- eval(thisScript.textContent);
+ try {
+ eval(thisScript.textContent);
+ } catch (v) {
+ doExn(v);
+ }
}
thisScript = savedScript;
@@ -227,7 +308,7 @@ function pi(s) {
if (r.toString() == s)
return r;
else
- throw "Can't parse int: " + s;
+ er("Can't parse int: " + s);
}
function pfl(s) {
@@ -235,7 +316,7 @@ function pfl(s) {
if (r.toString() == s)
return r;
else
- throw "Can't parse float: " + s;
+ er("Can't parse float: " + s);
}
function uf(s) {
@@ -247,43 +328,6 @@ function uu(s) {
}
-// Error handling
-
-function whine(msg) {
- alert(msg);
- throw msg;
-}
-
-function pf() {
- whine("Pattern match failure");
-}
-
-var errorHandlers = null;
-
-function onError(f) {
- errorHandlers = cons(f, errorHandlers);
-}
-
-function er(s) {
- for (var ls = errorHandlers; ls; ls = ls.next)
- ls.data(s)(null);
- throw {uw_error: s};
-}
-
-var failHandlers = null;
-
-function onFail(f) {
- failHandlers = cons(f, failHandlers);
-}
-
-function doExn(v) {
- if (v == null || v.uw_error == null) {
- var s = (v == null ? "null" : v.toString());
- for (var ls = failHandlers; ls; ls = ls.next)
- ls.data(s)(null);
- }
-}
-
// Remote calls
@@ -333,10 +377,14 @@ function rc(uri, parse, k) {
isok = true;
} catch (e) { }
- if (isok)
- k(parse(xhr.responseText));
- else {
- whine("Error querying remote server!");
+ if (isok) {
+ try {
+ k(parse(xhr.responseText));
+ } catch (v) {
+ doExn(v);
+ }
+ } else {
+ conn();
}
}
};
@@ -406,8 +454,10 @@ function listener() {
if (isok) {
var lines = xhr.responseText.split("\n");
- if (lines.length < 2)
- return; // throw "Empty message from remote server";
+ if (lines.length < 2) {
+ discon();
+ return;
+ }
for (var i = 0; i+1 < lines.length; i += 2) {
var chn = lines[i];
@@ -439,9 +489,9 @@ function listener() {
connect();
}
else {
- /*try {
- whine("Error querying remote server for messages! " + xhr.status);
- } catch (e) { }*/
+ try {
+ servError("Error querying remote server for messages: " + xhr.status);
+ } catch (e) { servError("Error querying remote server for messages"); }
}
}
};
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index af1cf972..99ac50fe 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -552,8 +552,11 @@ val td : other ::: {Unit} -> [other ~ [Body, Tr]] =>
val error : t ::: Type -> xbody -> t
+(* Client-side-only handlers: *)
val onError : (xbody -> transaction unit) -> transaction unit
val onFail : (string -> transaction unit) -> transaction unit
-(* Client-side only *)
+val onConnectFail : transaction unit -> transaction unit
+val onDisconnect : transaction unit -> transaction unit
+val onServerError : (string -> transaction unit) -> transaction unit
val show_xml : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> show (xml ctx use bind)
diff --git a/src/jscomp.sml b/src/jscomp.sml
index d7a74fab..f839a67d 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -53,7 +53,11 @@ val funcs = [(("Basis", "alert"), "alert"),
(("Basis", "strcat"), "cat"),
(("Basis", "intToString"), "ts"),
(("Basis", "floatToString"), "ts"),
- (("Basis", "onError"), "onError")]
+ (("Basis", "onError"), "onError"),
+ (("Basis", "onFail"), "onFail"),
+ (("Basis", "onConnectFail"), "onConnectFail"),
+ (("Basis", "onDisconnect"), "onDisconnect"),
+ (("Basis", "onServerError"), "onServerError")]
structure FM = BinaryMapFn(struct
type ord_key = string * string
@@ -764,6 +768,11 @@ fun process file =
end
| EBinop (s, e1, e2) =>
let
+ val s =
+ case s of
+ "!strcmp" => "=="
+ | _ => s
+
val (e1, st) = jsE inner (e1, st)
val (e2, st) = jsE inner (e2, st)
in
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 19140b81..4c337e14 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -62,6 +62,10 @@ fun impure (e, _) =
| EFfiApp ("Basis", "subscribe", _) => true
| EFfiApp ("Basis", "send", _) => true
| EFfiApp ("Basis", "onError", _) => true
+ | EFfiApp ("Basis", "onFail", _) => true
+ | EFfiApp ("Basis", "onConnectFail", _) => true
+ | EFfiApp ("Basis", "onDisconnect", _) => true
+ | EFfiApp ("Basis", "onServerError", _) => true
| EFfiApp _ => false
| EApp ((EFfi _, _), _) => false
| EApp _ => true
@@ -287,6 +291,10 @@ fun reduce file =
| EFfiApp ("Basis", "subscribe", es) => ffi es
| EFfiApp ("Basis", "send", es) => ffi es
| EFfiApp ("Basis", "onError", es) => ffi es
+ | EFfiApp ("Basis", "onFail", es) => ffi es
+ | EFfiApp ("Basis", "onConnectFail", es) => ffi es
+ | EFfiApp ("Basis", "onDisconnect", es) => ffi es
+ | EFfiApp ("Basis", "onServerError", es) => ffi es
| EFfiApp (_, _, es) => List.concat (map (summarize d) es)
| EApp ((EFfi _, _), e) => summarize d e
| EApp _ =>
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 238f65d3..c7309df4 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -325,15 +325,19 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
fn t' =>
(EUnurlify (e', t'), loc)))
| EJavaScript (m, e, NONE) =>
- S.map2 (mfe ctx e,
- fn e' =>
- (EJavaScript (m, e', NONE), loc))
+ S.bind2 (mfmode ctx m,
+ fn m' =>
+ S.map2 (mfe ctx e,
+ fn e' =>
+ (EJavaScript (m', e', NONE), loc)))
| EJavaScript (m, e, SOME e2) =>
- S.bind2 (mfe ctx e,
- fn e' =>
- S.map2 (mfe ctx e2,
- fn e2' =>
- (EJavaScript (m, e', SOME e2'), loc)))
+ S.bind2 (mfmode ctx m,
+ fn m' =>
+ S.bind2 (mfe ctx e,
+ fn e' =>
+ S.map2 (mfe ctx e2,
+ fn e2' =>
+ (EJavaScript (m, e', SOME e2'), loc))))
| ESignalReturn e =>
S.map2 (mfe ctx e,
@@ -372,6 +376,14 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
S.map2 (mfe ctx ek,
fn ek' =>
(ESleep (s', ek'), loc)))
+
+ and mfmode ctx mode =
+ case mode of
+ Attribute => S.return2 mode
+ | Script => S.return2 mode
+ | Source t =>
+ S.map2 (mft t,
+ fn t' => Source t')
in
mfe
end
diff --git a/tests/roundTrip.ur b/tests/roundTrip.ur
index 26a0113e..d22b2d41 100644
--- a/tests/roundTrip.ur
+++ b/tests/roundTrip.ur
@@ -26,11 +26,14 @@ fun main () =
receiverB ()
fun sender s n f =
- sleep 9;
+ sleep 2000;
writeBack (s, n, f);
sender (s ^ "!") (n + 1) (f + 1.23)
in
- return <xml><body onload={spawn (receiverA ()); spawn (receiverB ()); sender "" 0 0.0}>
+ return <xml><body onload={onDisconnect (alert "Server booted me");
+ onConnectFail (alert "Connection failed");
+ onServerError (fn s => alert ("Server error: " ^ s));
+ spawn (receiverA ()); spawn (receiverB ()); sender "" 0 0.0}>
<dyn signal={Buffer.render buf}/>
</body></xml>
end
diff --git a/tests/updateErr.ur b/tests/updateErr.ur
new file mode 100644
index 00000000..345e3aa8
--- /dev/null
+++ b/tests/updateErr.ur
@@ -0,0 +1,17 @@
+fun main () : transaction page =
+ s <- source "";
+ b <- Buffer.create;
+ txt <- source "";
+
+ return <xml><body onload={onError (fn xml => Buffer.write b (show xml));
+ onFail (fn s => alert ("FAIL! " ^ s))}>
+ <dyn signal={s <- signal s; return <xml>{[s]}</xml>}/><br/>
+ <dyn signal={s <- signal s; if s = "" then return <xml>Init</xml> else error <xml>Crapky</xml>}/><br/>
+ <dyn signal={s <- signal s; return <xml>"{[s]}"</xml>}/><br/>
+
+ <ctextbox source={txt}/> <button onclick={s' <- get txt; set s s'; set txt ""}/>
+
+ <hr/>
+
+ <dyn signal={Buffer.render b}/>
+ </body></xml>
diff --git a/tests/updateErr.urp b/tests/updateErr.urp
new file mode 100644
index 00000000..80d8200b
--- /dev/null
+++ b/tests/updateErr.urp
@@ -0,0 +1,4 @@
+debug
+
+buffer
+updateErr
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-30 02:09:43 +0000