comparison demo/chat.ur @ 699:4e260887d8f2

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