summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-03-26 18:26:50 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-03-26 18:26:50 -0400
commit754569fc0cf4affbf1227c44059352316a61fa24 (patch)
tree07c0072a1323075a100a6b42f0101ebbaa90f3c8 /tests
parentdac2c194b1416d7710081d5c57c24d52e110a224 (diff)
Chat example working nicely, but without dead channel removal
Diffstat (limited to 'tests')
-rw-r--r--tests/chat.ur61
1 files changed, 60 insertions, 1 deletions
diff --git a/tests/chat.ur b/tests/chat.ur
index 710d97d4..2d79cd00 100644
--- a/tests/chat.ur
+++ b/tests/chat.ur
@@ -1,10 +1,69 @@
+datatype log = End | Line of string * source log
+
+fun render log =
+ case log of
+ End => <xml/>
+ | Line (line, logS) => <xml>{[line]}<br/><dyn signal={renderS logS}/></xml>
+
+and renderS logS =
+ log <- signal logS;
+ return (render log)
+
sequence s
table t : { Id : int, Title : string, Chan : option (channel string) }
+fun chat id =
+ r <- oneRow (SELECT t.Title, t.Chan FROM t WHERE t.Id = {[id]});
+ ch <- (case r.T.Chan of
+ None => (ch <- channel;
+ dml (UPDATE t SET Chan = {[Some ch]} WHERE Id = {[id]});
+ return ch)
+ | Some ch => return ch);
+
+ newLine <- source "";
+ logHead <- source End;
+ logTail <- source logHead;
+
+ let
+ fun join () = subscribe ch
+
+ fun onload () =
+ let
+ fun listener () =
+ s <- recv ch;
+ oldTail <- get logTail;
+ newTail <- source End;
+ set oldTail (Line (s, newTail));
+ set logTail newTail;
+ listener ()
+ in
+ join ();
+ listener ()
+ end
+
+ fun speak line =
+ send ch line
+
+ fun doSpeak () =
+ line <- get newLine;
+ speak line
+ in
+ return <xml><body onload={onload ()}>
+ <h1>{[r.T.Title]}</h1>
+
+ <button value="Send:" onclick={doSpeak ()}/> <ctextbox source={newLine}/>
+
+ <h2>Messages</h2>
+
+ <dyn signal={renderS logHead}/>
+
+ </body></xml>
+ end
+
fun list () =
queryX (SELECT * FROM t)
(fn r => <xml><tr>
- <td>{[r.T.Id]}</td> <td>{[r.T.Title]}</td>
+ <td>{[r.T.Id]}</td> <td><a link={chat r.T.Id}>{[r.T.Title]}</a></td>
<td><a link={delete r.T.Id}>[delete]</a></td>
</tr></xml>)