Mercurial > urweb

annotate demo/chat.ur @ 1053:4eb1c4a1b057

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Escaping UTF-8 in MonoOpt
author Adam Chlipala <adamc@hcoop.net>
date Thu, 03 Dec 2009 11:20:13 -0500
parents ed06e25c70ef
children e6bc6bbd7a32
rev   line source
adamc@699 1 structure Room = Broadcast.Make(struct
adamc@699 2 type t = string
adamc@699 3 end)
adamc@699 4
adamc@699 5 sequence s
adamc@699 6 table t : { Id : int, Title : string, Room : Room.topic }
adamc@708 7 PRIMARY KEY Id
adamc@699 8
adamc@732 9 fun chat id () =
adamc@699 10 r <- oneRow (SELECT t.Title, t.Room FROM t WHERE t.Id = {[id]});
adamc@699 11 ch <- Room.subscribe r.T.Room;
adamc@699 12
adamc@699 13 newLine <- source "";
adamc@699 14 buf <- Buffer.create;
adamc@699 15
adamc@699 16 let
adamc@699 17 fun onload () =
adamc@699 18 let
adamc@699 19 fun listener () =
adamc@699 20 s <- recv ch;
adamc@699 21 Buffer.write buf s;
adamc@699 22 listener ()
adamc@699 23 in
adamc@699 24 listener ()
adamc@699 25 end
adamc@699 26
adamc@699 27 fun getRoom () =
adamc@699 28 r <- oneRow (SELECT t.Room FROM t WHERE t.Id = {[id]});
adamc@699 29 return r.T.Room
adamc@699 30
adamc@699 31 fun speak line =
adamc@699 32 room <- getRoom ();
adamc@699 33 Room.send room line
adamc@699 34
adamc@699 35 fun doSpeak () =
adamc@699 36 line <- get newLine;
adamc@699 37 set newLine "";
adamc@908 38 rpc (speak line)
adamc@699 39 in
adamc@699 40 return <xml><body onload={onload ()}>
adamc@699 41 <h1>{[r.T.Title]}</h1>
adamc@699 42
adamc@699 43 <button value="Send:" onclick={doSpeak ()}/> <ctextbox source={newLine}/>
adamc@699 44
adamc@699 45 <h2>Messages</h2>
adamc@699 46
adamc@699 47 <dyn signal={Buffer.render buf}/>
adamc@699 48
adamc@699 49 </body></xml>
adamc@699 50 end
adamc@699 51
adamc@699 52 fun list () =
adamc@699 53 queryX' (SELECT * FROM t)
adamc@699 54 (fn r =>
adamc@699 55 count <- Room.subscribers r.T.Room;
adamc@699 56 return <xml><tr>
adamc@699 57 <td>{[r.T.Id]}</td>
adamc@732 58 <td>{[r.T.Title]}</td>
adamc@699 59 <td>{[count]}</td>
adamc@732 60 <td><form><submit action={chat r.T.Id} value="Enter"/></form></td>
adamc@732 61 <td><form><submit action={delete r.T.Id} value="Delete"/></form></td>
adamc@699 62 </tr></xml>)
adamc@699 63
adamc@732 64 and delete id () =
adamc@699 65 dml (DELETE FROM t WHERE Id = {[id]});
adamc@699 66 main ()
adamc@699 67
adamc@699 68 and main () =
adamc@699 69 let
adamc@699 70 fun create r =
adamc@699 71 id <- nextval s;
adamc@699 72 room <- Room.create;
adamc@699 73 dml (INSERT INTO t (Id, Title, Room) VALUES ({[id]}, {[r.Title]}, {[room]}));
adamc@699 74 main ()
adamc@699 75 in
adamc@699 76 ls <- list ();
adamc@699 77 return <xml><body>
adamc@699 78 <h1>Current Channels</h1>
adamc@699 79
adamc@699 80 <table>
adamc@699 81 <tr> <th>ID</th> <th>Title</th> <th>#Subscribers</th> </tr>
adamc@699 82 {ls}
adamc@699 83 </table>
adamc@699 84
adamc@699 85 <h1>New Channel</h1>
adamc@699 86
adamc@699 87 <form>
adamc@699 88 Title: <textbox{#Title}/><br/>
adamc@699 89 <submit action={create}/>
adamc@699 90 </form>
adamc@699 91 </body></xml>
adamc@699 92 end