Mercurial > urweb

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/broadcast.ur	Sun Apr 05 11:48:55 2009 -0400
@@ -0,0 +1,28 @@
+functor Make(M : sig type t end) = struct
+    sequence s
+    table t : {Id : int, Client : client, Channel : channel M.t}
+
+    type topic = int
+
+    val inj : sql_injectable topic = _
+
+    val create = nextval s
+
+    fun subscribe id =
+        cli <- self;
+        ro <- oneOrNoRows (SELECT t.Channel FROM t WHERE t.Id = {[id]} AND t.Client = {[cli]});
+        case ro of
+            None =>
+            ch <- channel;
+            dml (INSERT INTO t (Id, Client, Channel) VALUES ({[id]}, {[cli]}, {[ch]}));
+            return ch
+          | Some r => return r.T.Channel
+
+    fun send id msg =
+        queryI (SELECT t.Channel FROM t WHERE t.Id = {[id]})
+        (fn r => Basis.send r.T.Channel msg)
+
+    fun subscribers id =
+        r <- oneRow (SELECT COUNT( * ) AS N FROM t WHERE t.Id = {[id]});
+        return r.N
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/broadcast.urs	Sun Apr 05 11:48:55 2009 -0400
@@ -0,0 +1,11 @@
+functor Make(M : sig type t end) : sig
+    type topic
+
+    val inj : sql_injectable topic
+
+    val create : transaction topic
+    val subscribe : topic -> transaction (channel M.t)
+    val send : topic -> M.t -> transaction unit
+
+    val subscribers : topic -> transaction int
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/chat.ur	Sun Apr 05 11:48:55 2009 -0400
@@ -0,0 +1,90 @@
+structure Room = Broadcast.Make(struct
+                                    type t = string
+                                end)
+
+sequence s
+table t : { Id : int, Title : string, Room : Room.topic }
+
+fun chat id =
+    r <- oneRow (SELECT t.Title, t.Room FROM t WHERE t.Id = {[id]});
+    ch <- Room.subscribe r.T.Room;
+
+    newLine <- source "";
+    buf <- Buffer.create;
+
+    let
+        fun onload () =
+            let
+                fun listener () =
+                    s <- recv ch;
+                    Buffer.write buf s;
+                    listener ()
+            in
+                listener ()
+            end
+
+        fun getRoom () =
+            r <- oneRow (SELECT t.Room FROM t WHERE t.Id = {[id]});
+            return r.T.Room
+
+        fun speak line =
+            room <- getRoom ();
+            Room.send room line
+
+        fun doSpeak () =
+            line <- get newLine;
+            set newLine "";
+            speak line
+    in
+        return <xml><body onload={onload ()}>
+          <h1>{[r.T.Title]}</h1>
+
+          <button value="Send:" onclick={doSpeak ()}/> <ctextbox source={newLine}/>
+
+          <h2>Messages</h2>
+
+          <dyn signal={Buffer.render buf}/>
+
+        </body></xml>
+    end
+
+fun list () =
+    queryX' (SELECT * FROM t)
+    (fn r =>
+        count <- Room.subscribers r.T.Room;
+        return <xml><tr>
+          <td>{[r.T.Id]}</td>
+          <td><a link={chat r.T.Id}>{[r.T.Title]}</a></td>
+          <td>{[count]}</td>
+          <td><a link={delete r.T.Id}>[delete]</a></td>
+        </tr></xml>)
+
+and delete id =
+    dml (DELETE FROM t WHERE Id = {[id]});
+    main ()
+
+and main () =
+    let
+        fun create r =
+            id <- nextval s;
+            room <- Room.create;
+            dml (INSERT INTO t (Id, Title, Room) VALUES ({[id]}, {[r.Title]}, {[room]}));
+            main ()
+    in
+        ls <- list ();
+        return <xml><body>
+          <h1>Current Channels</h1>
+
+          <table>
+            <tr> <th>ID</th> <th>Title</th> <th>#Subscribers</th> </tr>
+            {ls}
+          </table>
+
+          <h1>New Channel</h1>
+
+          <form>
+            Title: <textbox{#Title}/><br/>
+            <submit action={create}/>
+          </form>
+        </body></xml>
+    end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/chat.urp	Sun Apr 05 11:48:55 2009 -0400
@@ -0,0 +1,6 @@
+database dbname=test
+sql chat.sql
+
+broadcast
+buffer
+chat
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/chat.urs	Sun Apr 05 11:48:55 2009 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page
--- a/demo/prose	Sun Apr 05 11:24:55 2009 -0400
+++ b/demo/prose	Sun Apr 05 11:48:55 2009 -0400
@@ -256,3 +256,11 @@
 <p>The <tt>main</tt> function begins by retrieving the current client ID, allocating a new channel, and associating that channel with the current client in the database.  Next, we allocate a buffer and return the page, which in its <tt>onload</tt> attribute starts two loops running in parallel.  In contrast to in the last example, here we only use <tt>spawn</tt> with the call to the first loop, since every client-side event handler is implicitly started in a new thread.</tt>

 <p>The first loop, <tt>receiver</tt>, repeatedly reads messages from the channel and writes them to the buffer.  The second loop, <tt>sender</tt>, periodically sends messages to the channel.  Client code can't send messages directly.  Instead, we must use server-side functions to do the sending.  Clients aren't trusted to pass channels to the server, so our server-side function <tt>writeBack</tt> instead keys off of the client ID, looking up the corresponding channel in the database.</p>
+
+chat.urp
+
+<p>This example provides a simple anonymous online chatting system, with multiple named channels.</p>
+
+<p>First, we build another useful component.  Recall that each channel has an owning client, who has the exclusive ability to read messages sent to it.  On top of that functionality, we can build a kind of broadcast channel that accepts multiple subscribers.  The <tt>Broadcast</tt> module contains a functor with such an implementation.  We instantiate the functor with the type of data we want to send over the channel.  The functor output gives us an abstract type of "topics," which are subscribable IDs.  When a client subscribes to a topic, it is handed a channel that it can use to read new messages on that topic.  We also have an operation to count the number of subscribers to a topic.  This number shouldn't be treated as too precise, since some clients that have surfed away from the application may still be considered subscribed until a timeout period elapses.</p>
+
+<p>The main <tt>Chat</tt> application includes some standard management of a table of named channels.  All of the interesting client-server work is done with the <tt>recv</tt> function and with the functions provided by <tt>Broadcast</tt>.</p>
--- a/lib/ur/top.ur	Sun Apr 05 11:24:55 2009 -0400
+++ b/lib/ur/top.ur	Sun Apr 05 11:48:55 2009 -0400
@@ -196,29 +196,3 @@
     case e2 of
         None => (SQL {e1} IS NULL)
       | Some _ => sql_binary sql_eq e1 (sql_inject e2)
-
-
-functor Broadcast(M : sig type t end) = struct
-    sequence s
-    table t : {Id : int, Client : client, Channel : channel M.t}
-
-    type topic = int
-
-    val inj : sql_injectable topic = _
-
-    val create = nextval s
-
-    fun subscribe id =
-        cli <- self;
-        ro <- oneOrNoRows (SELECT t.Channel FROM t WHERE t.Id = {[id]} AND t.Client = {[cli]});
-        case ro of
-            None =>
-            ch <- channel;
-            dml (INSERT INTO t (Id, Client, Channel) VALUES ({[id]}, {[cli]}, {[ch]}));
-            return ch
-          | Some r => return r.T.Channel
-
-    fun send id msg =
-        queryI (SELECT t.Channel FROM t WHERE t.Id = {[id]})
-        (fn r => Basis.send r.T.Channel msg)
-end
--- a/lib/ur/top.urs	Sun Apr 05 11:24:55 2009 -0400
+++ b/lib/ur/top.urs	Sun Apr 05 11:48:55 2009 -0400
@@ -134,14 +134,3 @@
                   -> sql_exp tables agg exps (option t)
                   -> option t
                   -> sql_exp tables agg exps bool
-
-
-functor Broadcast(M : sig type t end) : sig
-    type topic
-
-    val inj : sql_injectable topic
-
-    val create : transaction topic
-    val subscribe : topic -> transaction (channel M.t)
-    val send : topic -> M.t -> transaction unit
-end