comparison tests/chat.ur @ 679:44f23712020d

Chat example working nicely, but without dead channel removal
author Adam Chlipala <adamc@hcoop.net>
date Thu, 26 Mar 2009 18:26:50 -0400
parents 5ff1ff38e2db
children 54ec237a3028
comparison
equal deleted inserted replaced
678:5ff1ff38e2db 679:44f23712020d
1 datatype log = End | Line of string * source log
2
3 fun render log =
4 case log of
5 End => <xml/>
6 | Line (line, logS) => <xml>{[line]}<br/><dyn signal={renderS logS}/></xml>
7
8 and renderS logS =
9 log <- signal logS;
10 return (render log)
11
1 sequence s 12 sequence s
2 table t : { Id : int, Title : string, Chan : option (channel string) } 13 table t : { Id : int, Title : string, Chan : option (channel string) }
14
15 fun chat id =
16 r <- oneRow (SELECT t.Title, t.Chan FROM t WHERE t.Id = {[id]});
17 ch <- (case r.T.Chan of
18 None => (ch <- channel;
19 dml (UPDATE t SET Chan = {[Some ch]} WHERE Id = {[id]});
20 return ch)
21 | Some ch => return ch);
22
23 newLine <- source "";
24 logHead <- source End;
25 logTail <- source logHead;
26
27 let
28 fun join () = subscribe ch
29
30 fun onload () =
31 let
32 fun listener () =
33 s <- recv ch;
34 oldTail <- get logTail;
35 newTail <- source End;
36 set oldTail (Line (s, newTail));
37 set logTail newTail;
38 listener ()
39 in
40 join ();
41 listener ()
42 end
43
44 fun speak line =
45 send ch line
46
47 fun doSpeak () =
48 line <- get newLine;
49 speak line
50 in
51 return <xml><body onload={onload ()}>
52 <h1>{[r.T.Title]}</h1>
53
54 <button value="Send:" onclick={doSpeak ()}/> <ctextbox source={newLine}/>
55
56 <h2>Messages</h2>
57
58 <dyn signal={renderS logHead}/>
59
60 </body></xml>
61 end
3 62
4 fun list () = 63 fun list () =
5 queryX (SELECT * FROM t) 64 queryX (SELECT * FROM t)
6 (fn r => <xml><tr> 65 (fn r => <xml><tr>
7 <td>{[r.T.Id]}</td> <td>{[r.T.Title]}</td> 66 <td>{[r.T.Id]}</td> <td><a link={chat r.T.Id}>{[r.T.Title]}</a></td>
8 <td><a link={delete r.T.Id}>[delete]</a></td> 67 <td><a link={delete r.T.Id}>[delete]</a></td>
9 </tr></xml>) 68 </tr></xml>)
10 69
11 and delete id = 70 and delete id =
12 dml (DELETE FROM t WHERE Id = {[id]}); 71 dml (DELETE FROM t WHERE Id = {[id]});