diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-04-05 11:48:55 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-04-05 11:48:55 -0400 |
| commit | 3b3f14a1c2021f307e9290ec8fba64d6c791a93a (patch) | |
| tree | affa61639daa2a14b7eb6c9f8bb56617fa62582c /demo/chat.ur | |
| parent | a44e147bbb6686867b425b7cf068d14c5f230f51 (diff) | |
Chat demo
Diffstat (limited to 'demo/chat.ur')
| -rw-r--r-- | demo/chat.ur | 90 |
1 files changed, 90 insertions, 0 deletions
diff --git a/demo/chat.ur b/demo/chat.ur new file mode 100644 index 00000000..ad1bf2ca --- /dev/null +++ b/demo/chat.ur @@ -0,0 +1,90 @@ +structure Room = Broadcast.Make(struct + type t = string + end) + +sequence s +table t : { Id : int, Title : string, Room : Room.topic } + +fun chat id = + r <- oneRow (SELECT t.Title, t.Room FROM t WHERE t.Id = {[id]}); + ch <- Room.subscribe r.T.Room; + + newLine <- source ""; + buf <- Buffer.create; + + let + fun onload () = + let + fun listener () = + s <- recv ch; + Buffer.write buf s; + listener () + in + listener () + end + + fun getRoom () = + r <- oneRow (SELECT t.Room FROM t WHERE t.Id = {[id]}); + return r.T.Room + + fun speak line = + room <- getRoom (); + Room.send room line + + fun doSpeak () = + line <- get newLine; + set 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={Buffer.render buf}/> + + </body></xml> + end + +fun list () = + queryX' (SELECT * FROM t) + (fn r => + count <- Room.subscribers r.T.Room; + return <xml><tr> + <td>{[r.T.Id]}</td> + <td><a link={chat r.T.Id}>{[r.T.Title]}</a></td> + <td>{[count]}</td> + <td><a link={delete r.T.Id}>[delete]</a></td> + </tr></xml>) + +and delete id = + dml (DELETE FROM t WHERE Id = {[id]}); + main () + +and main () = + let + fun create r = + id <- nextval s; + room <- Room.create; + dml (INSERT INTO t (Id, Title, Room) VALUES ({[id]}, {[r.Title]}, {[room]})); + main () + in + ls <- list (); + return <xml><body> + <h1>Current Channels</h1> + + <table> + <tr> <th>ID</th> <th>Title</th> <th>#Subscribers</th> </tr> + {ls} + </table> + + <h1>New Channel</h1> + + <form> + Title: <textbox{#Title}/><br/> + <submit action={create}/> + </form> + </body></xml> + end |