diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-03-26 18:26:50 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-03-26 18:26:50 -0400 |
| commit | 474fa30ad829b58eba6074e7ee14307418b07358 (patch) | |
| tree | 07c0072a1323075a100a6b42f0101ebbaa90f3c8 /tests/chat.ur | |
| parent | c088dec7eff828276b3e9e8891b7cdc041e65430 (diff) | |
Chat example working nicely, but without dead channel removal
Diffstat (limited to 'tests/chat.ur')
| -rw-r--r-- | tests/chat.ur | 61 |
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>) |