Mercurial > urweb
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]}); |