Mercurial > urweb

annotate tests/chat.ur @ 679:44f23712020d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
rev   line source
adamc@679 1 datatype log = End | Line of string * source log
adamc@679 2
adamc@679 3 fun render log =
adamc@679 4 case log of
adamc@679 5 End => <xml/>
adamc@679 6 | Line (line, logS) => <xml>{[line]}<br/><dyn signal={renderS logS}/></xml>
adamc@679 7
adamc@679 8 and renderS logS =
adamc@679 9 log <- signal logS;
adamc@679 10 return (render log)
adamc@679 11
adamc@678 12 sequence s
adamc@678 13 table t : { Id : int, Title : string, Chan : option (channel string) }
adamc@678 14
adamc@679 15 fun chat id =
adamc@679 16 r <- oneRow (SELECT t.Title, t.Chan FROM t WHERE t.Id = {[id]});
adamc@679 17 ch <- (case r.T.Chan of
adamc@679 18 None => (ch <- channel;
adamc@679 19 dml (UPDATE t SET Chan = {[Some ch]} WHERE Id = {[id]});
adamc@679 20 return ch)
adamc@679 21 | Some ch => return ch);
adamc@679 22
adamc@679 23 newLine <- source "";
adamc@679 24 logHead <- source End;
adamc@679 25 logTail <- source logHead;
adamc@679 26
adamc@679 27 let
adamc@679 28 fun join () = subscribe ch
adamc@679 29
adamc@679 30 fun onload () =
adamc@679 31 let
adamc@679 32 fun listener () =
adamc@679 33 s <- recv ch;
adamc@679 34 oldTail <- get logTail;
adamc@679 35 newTail <- source End;
adamc@679 36 set oldTail (Line (s, newTail));
adamc@679 37 set logTail newTail;
adamc@679 38 listener ()
adamc@679 39 in
adamc@679 40 join ();
adamc@679 41 listener ()
adamc@679 42 end
adamc@679 43
adamc@679 44 fun speak line =
adamc@679 45 send ch line
adamc@679 46
adamc@679 47 fun doSpeak () =
adamc@679 48 line <- get newLine;
adamc@679 49 speak line
adamc@679 50 in
adamc@679 51 return <xml><body onload={onload ()}>
adamc@679 52 <h1>{[r.T.Title]}</h1>
adamc@679 53
adamc@679 54 <button value="Send:" onclick={doSpeak ()}/> <ctextbox source={newLine}/>
adamc@679 55
adamc@679 56 <h2>Messages</h2>
adamc@679 57
adamc@679 58 <dyn signal={renderS logHead}/>
adamc@679 59
adamc@679 60 </body></xml>
adamc@679 61 end
adamc@679 62
adamc@678 63 fun list () =
adamc@678 64 queryX (SELECT * FROM t)
adamc@678 65 (fn r => <xml><tr>
adamc@679 66 <td>{[r.T.Id]}</td> <td><a link={chat r.T.Id}>{[r.T.Title]}</a></td>
adamc@678 67 <td><a link={delete r.T.Id}>[delete]</a></td>
adamc@678 68 </tr></xml>)
adamc@678 69
adamc@678 70 and delete id =
adamc@678 71 dml (DELETE FROM t WHERE Id = {[id]});
adamc@678 72 main ()
adamc@678 73
adamc@678 74 and main () : transaction page =
adamc@678 75 let
adamc@678 76 fun create r =
adamc@678 77 id <- nextval s;
adamc@678 78 dml (INSERT INTO t (Id, Title, Chan) VALUES ({[id]}, {[r.Title]}, NULL));
adamc@678 79 main ()
adamc@678 80 in
adamc@678 81 ls <- list ();
adamc@678 82 return <xml><body>
adamc@678 83 <table>
adamc@678 84 <tr> <th>ID</th> <th>Title</th> </tr>
adamc@678 85 {ls}
adamc@678 86 </table>
adamc@678 87
adamc@678 88 <h1>New Channel</h1>
adamc@678 89
adamc@678 90 <form>
adamc@678 91 Title: <textbox{#Title}/><br/>
adamc@678 92 <submit action={create}/>
adamc@678 93 </form>
adamc@678 94 </body></xml>
adamc@678 95 end