Mercurial > urweb

comparison tests/chat.ur @ 682:5bbb542243e8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Redo channels, making them single-client
author Adam Chlipala <adamc@hcoop.net>
date Sun, 29 Mar 2009 11:37:29 -0400
parents 54ec237a3028
children 01b6f2ee2ef0
comparison
equal deleted inserted replaced
681:6c9b8875f347 682:5bbb542243e8
7 7
8 and renderS logS = 8 and renderS logS =
9 log <- signal logS; 9 log <- signal logS;
10 return (render log) 10 return (render log)
11 11
12 structure Room = Broadcast(struct
13 type t = string
14 end)
15
12 sequence s 16 sequence s
13 table t : { Id : int, Title : string, Chan : option (channel string) } 17 table t : { Id : int, Title : string, Room : Room.topic }
14 18
15 fun chat id = 19 fun chat id =
16 r <- oneRow (SELECT t.Title, t.Chan FROM t WHERE t.Id = {[id]}); 20 r <- oneRow (SELECT t.Title, t.Room FROM t WHERE t.Id = {[id]});
17 ch <- (case r.T.Chan of 21 ch <- Room.subscribe r.T.Room;
18 None => (ch <- channel;
19 dml (UPDATE t SET Chan = {[Some ch]} WHERE Id = {[id]});
20 return ch)
21 | Some ch => return ch);
22 22
23 newLine <- source ""; 23 newLine <- source "";
24 logHead <- source End; 24 logHead <- source End;
25 logTail <- source logHead; 25 logTail <- source logHead;
26 26
27 let 27 let
28 fun getCh () =
29 r <- oneRow (SELECT t.Chan FROM t WHERE t.Id = {[id]});
30 case r.T.Chan of
31 None => error <xml>Channel disappeared</xml>
32 | Some ch => return ch
33
34 fun join () =
35 ch <- getCh ();
36 subscribe ch
37
38 fun onload () = 28 fun onload () =
39 let 29 let
40 fun listener () = 30 fun listener () =
41 s <- recv ch; 31 s <- recv ch;
42 oldTail <- get logTail; 32 oldTail <- get logTail;
43 newTail <- source End; 33 newTail <- source End;
44 set oldTail (Line (s, newTail)); 34 set oldTail (Line (s, newTail));
45 set logTail newTail; 35 set logTail newTail;
46 listener () 36 listener ()
47 in 37 in
48 join ();
49 listener () 38 listener ()
50 end 39 end
51 40
41 fun getRoom () =
42 r <- oneRow (SELECT t.Room FROM t WHERE t.Id = {[id]});
43 return r.T.Room
44
52 fun speak line = 45 fun speak line =
53 ch <- getCh (); 46 room <- getRoom ();
54 send ch line 47 Room.send room line
55 48
56 fun doSpeak () = 49 fun doSpeak () =
57 line <- get newLine; 50 line <- get newLine;
58 speak line 51 speak line
59 in 52 in
82 75
83 and main () : transaction page = 76 and main () : transaction page =
84 let 77 let
85 fun create r = 78 fun create r =
86 id <- nextval s; 79 id <- nextval s;
87 dml (INSERT INTO t (Id, Title, Chan) VALUES ({[id]}, {[r.Title]}, NULL)); 80 room <- Room.create;
81 dml (INSERT INTO t (Id, Title, Room) VALUES ({[id]}, {[r.Title]}, {[room]}));
88 main () 82 main ()
89 in 83 in
90 ls <- list (); 84 ls <- list ();
91 return <xml><body> 85 return <xml><body>
92 <table> 86 <table>