Mercurial > urweb

diff demo/chat.ur @ 699:4e260887d8f2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Chat demo
author Adam Chlipala <adamc@hcoop.net>
date Sun, 05 Apr 2009 11:48:55 -0400
parents
children 1a317a707d71
line wrap: on
line diff
--- /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