Update: hg rev 4105f779de7b

doc/manual.tex

@@ -1389,6 +1389,8 @@ \subsection{Monads}
   \hspace{.1in} \to \mt{monad} \; \mt{m}
 \end{array}$$
 
+The Ur/Web compiler provides syntactic sugar for monads, similar to Haskell's \cd{do} notation.  An expression $x \leftarrow e_1; e_2$ is desugarded to $\mt{bind} \; e_1 \; (\lambda x \Rightarrow e_2)$, and an expression $e_1; e_2$ is desugared to $\mt{bind} \; e_1 \; (\lambda () \Rightarrow e_2)$.
+
 \subsection{Transactions}
 
 Ur is a pure language; we use Haskell's trick to support controlled side effects.  The standard library defines a monad $\mt{transaction}$, meant to stand for actions that may be undone cleanly.  By design, no other kinds of actions are supported.
@@ -2031,6 +2033,8 @@ \subsubsection{Asynchronous Message-Passing}
 
 Clients and channels live only as long as the web browser page views that they are associated with.  When a user surfs away, his client and its channels will be garbage-collected, after that user is not heard from for the timeout period.  Garbage collection deletes any database row that contains a client or channel directly.  Any reference to one of these types inside an $\mt{option}$ is set to $\mt{None}$ instead.  Both kinds of handling have the flavor of weak pointers, and that is a useful way to think about clients and channels in the database.
 
+\emph{Note}: Currently, there are known concurrency issues with multi-threaded applications that employ message-passing on top of database engines that don't support true serializable transactions.  Postgres 9.1 is the only supported engine that does this properly.
+
 
 \section{Ur/Web Syntax Extensions}
 

lib/js/urweb.js

@@ -129,13 +129,17 @@ function pf(loc) {
     throw ("Pattern match failure (" + loc + ")");
 }
 
+var lameDuck = false;
+
 function runHandlers(kind, ls, arg) {
-    if (ls == null)
-        alert(kind + ": " + arg);
-    for (; ls; ls = ls.next)
-        try {
-            exec({c:"a", f:{c:"a", f:ls.data, x:{c:"c", v:arg}}, x:{c:"c", v:null}});
-        } catch (v) { }
+    if (!lameDuck) {
+        if (ls == null)
+            alert(kind + ": " + arg);
+        for (; ls; ls = ls.next)
+            try {
+                exec({c:"a", f:{c:"a", f:ls.data, x:{c:"c", v:arg}}, x:{c:"c", v:null}});
+            } catch (v) { }
+    }
 }
 
 var errorHandlers = null;
@@ -736,6 +740,7 @@ var client_id = null;
 var client_pass = 0;
 var url_prefix = "/";
 var timeout = 60;
+var isPost = false;
 
 function getXHR(uri)
 {
@@ -772,8 +777,10 @@ function requestUri(xhr, uri, needsSig) {
 
     xhr.open("POST", uri, true);
     xhr.setRequestHeader("Content-type", "text/plain");
-    xhr.setRequestHeader("Content-length", "0");
-    xhr.setRequestHeader("Connection", "close");
+    try {
+        xhr.setRequestHeader("Content-length", "0");
+        xhr.setRequestHeader("Connection", "close");
+    } catch (e) { }
 
     if (client_id != null) {
         xhr.setRequestHeader("UrWeb-Client", client_id.toString());
@@ -907,6 +914,17 @@ function listener() {
                     return;
                 var lines = text.split("\n");
 
+                if (lines.length == 1 && lines[0] == "R") {
+                    lameDuck = true;
+
+                    if (isPost)
+                        history.back();
+                    else
+                        location.reload();
+
+                    return;
+                }
+
                 if (lines.length < 2) {
                     discon();
                     return;

src/c/urweb.c

@@ -220,7 +220,6 @@ static void release_client(client *c) {
   pthread_mutex_lock(&c->lock);
   --c->refcount;
   pthread_mutex_unlock(&c->lock);
-
 }
 
 static const char begin_msgs[] = "Content-type: text/plain\r\n\r\n";
@@ -248,14 +247,21 @@ void uw_set_on_success(char *s) {
   on_success = s;
 }
 
+static void chastise(int (*send)(int sockfd, const void *buf, ssize_t len), int sock) {
+  send(sock, on_success, strlen(on_success));
+  send(sock, begin_msgs, sizeof(begin_msgs) - 1);
+  send(sock, "R", 1);
+  close(sock);
+}
+
 void uw_client_connect(unsigned id, int pass, int sock,
                        int (*send)(int sockfd, const void *buf, ssize_t len),
                        int (*close)(int fd),
                        void *logger_data, uw_logger log_error) {
   client *c = find_client(id);
 
   if (c == NULL) {
-    close(sock);
+    chastise(send, sock);
     log_error(logger_data, "Out-of-bounds client request (%u)\n", id);
     return;
   }
@@ -264,14 +270,14 @@ void uw_client_connect(unsigned id, int pass, int sock,
 
   if (c->mode != USED) {
     pthread_mutex_unlock(&c->lock);
-    close(sock);
+    chastise(send, sock);
     log_error(logger_data, "Client request for unused slot (%u)\n", id);
     return;
   }
 
   if (pass != c->pass) {
     pthread_mutex_unlock(&c->lock);
-    close(sock);
+    chastise(send, sock);
     log_error(logger_data, "Wrong client password (%u, %d)\n", id, pass);
     return;
   }
@@ -1343,7 +1349,8 @@ const char *uw_Basis_get_settings(uw_context ctx, uw_unit u) {
     char *sig = ctx->needs_sig ? ctx->app->cookie_sig(ctx) : "";
     char *r = uw_malloc(ctx, 59 + 3 * INTS_MAX + strlen(ctx->app->url_prefix)
                         + (ctx->needs_sig ? strlen(sig) + 7 : 0));
-    sprintf(r, "client_id=%u;client_pass=%d;url_prefix=\"%s\";timeout=%d;%s%s%slistener();",
+    sprintf(r, "isPost=%s;client_id=%u;client_pass=%d;url_prefix=\"%s\";timeout=%d;%s%s%slistener();",
+            (ctx->isPost ? "true" : "false"),
             ctx->client->id,
             ctx->client->pass,
             ctx->app->url_prefix,
@@ -3185,7 +3192,8 @@ void uw_commit(uw_context ctx) {
     delta *d = &ctx->deltas[i];
     client *c = find_client(d->client);
 
-    assert (c != NULL && c->mode == USED);
+    assert (c != NULL);
+    assert(c->mode == USED);
 
     client_send(c, &d->msgs, ctx->script.start, uw_buffer_used(&ctx->script));
   }

src/postgres.sml

@@ -754,6 +754,14 @@ fun dmlCommon {loc, dml, mode} =
                    newline],
               string "}",
               newline,
+              string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
+              box [newline,
+                   string "PQclear(res);",
+                   newline,
+                   string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
+                   newline],
+              string "}",
+              newline,
               case mode of
                   Settings.Error => box [string "PQclear(res);",
                                          newline,

tests/goback.ur

@@ -0,0 +1,20 @@
+table channels : { Channel : channel {} }
+
+fun get () =
+    ch <- channel;
+    dml (INSERT INTO channels (Channel) VALUES ({[ch]}));
+    return <xml><body onload={recv ch}>
+      Hi.
+    </body></xml>
+
+fun post () =
+    ch <- channel;
+    dml (INSERT INTO channels (Channel) VALUES ({[ch]}));
+    return <xml><body onload={recv ch}>
+      Hi!
+    </body></xml>
+
+fun main () = return <xml><body>
+  <li><a link={get ()}>Get</a></li>
+  <li><form><submit action={post}/></form></li>
+</body></xml>

tests/goback.urp

@@ -0,0 +1,6 @@
+database dbname=goback
+sql goback.sql
+rewrite all Goback/*
+safeGet get
+
+goback

tests/goback.urs

@@ -0,0 +1 @@
+val main : {} -> transaction page