blob: 720130b48d4707c0a2e274c7ce078b36cd091b18 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
structure Room = Broadcast.Make(struct
type t = string
end)
sequence s
table t : { Id : int, Title : string, Room : Room.topic }
PRIMARY KEY Id
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 "";
rpc (speak line)
in
return <xml><body onload={onload ()}>
<h1>{[r.T.Title]}</h1>
<button value="Send:" onclick={fn _ => 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>{[r.T.Title]}</td>
<td>{[count]}</td>
<td><form><submit action={chat r.T.Id} value="Enter"/></form></td>
<td><form><submit action={delete r.T.Id} value="Delete"/></form></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
|
