Mercurial > urweb

annotate demo/chat.ur @ 731:e0dd85ea58e1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Label exported symbols by effect-ness; factor out some common datatypes
author Adam Chlipala <adamc@hcoop.net>
date Thu, 16 Apr 2009 14:49:25 -0400
parents 1a317a707d71
children 5819fb63c93a
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@699 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@699 38 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@699 58 <td><a link={chat r.T.Id}>{[r.T.Title]}</a></td>
adamc@699 59 <td>{[count]}</td>
adamc@699 60 <td><a link={delete r.T.Id}>[delete]</a></td>
adamc@699 61 </tr></xml>)
adamc@699 62
adamc@699 63 and delete id =
adamc@699 64 dml (DELETE FROM t WHERE Id = {[id]});
adamc@699 65 main ()
adamc@699 66
adamc@699 67 and main () =
adamc@699 68 let
adamc@699 69 fun create r =
adamc@699 70 id <- nextval s;
adamc@699 71 room <- Room.create;
adamc@699 72 dml (INSERT INTO t (Id, Title, Room) VALUES ({[id]}, {[r.Title]}, {[room]}));
adamc@699 73 main ()
adamc@699 74 in
adamc@699 75 ls <- list ();
adamc@699 76 return <xml><body>
adamc@699 77 <h1>Current Channels</h1>
adamc@699 78
adamc@699 79 <table>
adamc@699 80 <tr> <th>ID</th> <th>Title</th> <th>#Subscribers</th> </tr>
adamc@699 81 {ls}
adamc@699 82 </table>
adamc@699 83
adamc@699 84 <h1>New Channel</h1>
adamc@699 85
adamc@699 86 <form>
adamc@699 87 Title: <textbox{#Title}/><br/>
adamc@699 88 <submit action={create}/>
adamc@699 89 </form>
adamc@699 90 </body></xml>
adamc@699 91 end