Mercurial > urweb
annotate demo/chat.ur @ 2177:00cf8214c2e3
Switching to a more dynamic method of handling database reconnection, restarting transactions
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sat, 17 Oct 2015 11:08:12 -0400 |
parents | e6bc6bbd7a32 |
children |
rev | line source |
---|---|
adamc@699 | 1 structure Room = Broadcast.Make(struct |
adamc@699 | 2 type t = string |
adamc@699 | 3 end) |
adamc@699 | 4 |
adamc@699 | 5 sequence s |
adamc@699 | 6 table t : { Id : int, Title : string, Room : Room.topic } |
adamc@708 | 7 PRIMARY KEY Id |
adamc@699 | 8 |
adamc@732 | 9 fun chat id () = |
adamc@699 | 10 r <- oneRow (SELECT t.Title, t.Room FROM t WHERE t.Id = {[id]}); |
adamc@699 | 11 ch <- Room.subscribe r.T.Room; |
adamc@699 | 12 |
adamc@699 | 13 newLine <- source ""; |
adamc@699 | 14 buf <- Buffer.create; |
adamc@699 | 15 |
adamc@699 | 16 let |
adamc@699 | 17 fun onload () = |
adamc@699 | 18 let |
adamc@699 | 19 fun listener () = |
adamc@699 | 20 s <- recv ch; |
adamc@699 | 21 Buffer.write buf s; |
adamc@699 | 22 listener () |
adamc@699 | 23 in |
adamc@699 | 24 listener () |
adamc@699 | 25 end |
adamc@699 | 26 |
adamc@699 | 27 fun getRoom () = |
adamc@699 | 28 r <- oneRow (SELECT t.Room FROM t WHERE t.Id = {[id]}); |
adamc@699 | 29 return r.T.Room |
adamc@699 | 30 |
adamc@699 | 31 fun speak line = |
adamc@699 | 32 room <- getRoom (); |
adamc@699 | 33 Room.send room line |
adamc@699 | 34 |
adamc@699 | 35 fun doSpeak () = |
adamc@699 | 36 line <- get newLine; |
adamc@699 | 37 set newLine ""; |
adamc@908 | 38 rpc (speak line) |
adamc@699 | 39 in |
adamc@699 | 40 return <xml><body onload={onload ()}> |
adamc@699 | 41 <h1>{[r.T.Title]}</h1> |
adamc@699 | 42 |
adam@1784 | 43 <button value="Send:" onclick={fn _ => doSpeak ()}/> <ctextbox source={newLine}/> |
adamc@699 | 44 |
adamc@699 | 45 <h2>Messages</h2> |
adamc@699 | 46 |
adamc@699 | 47 <dyn signal={Buffer.render buf}/> |
adamc@699 | 48 |
adamc@699 | 49 </body></xml> |
adamc@699 | 50 end |
adamc@699 | 51 |
adamc@699 | 52 fun list () = |
adamc@699 | 53 queryX' (SELECT * FROM t) |
adamc@699 | 54 (fn r => |
adamc@699 | 55 count <- Room.subscribers r.T.Room; |
adamc@699 | 56 return <xml><tr> |
adamc@699 | 57 <td>{[r.T.Id]}</td> |
adamc@732 | 58 <td>{[r.T.Title]}</td> |
adamc@699 | 59 <td>{[count]}</td> |
adamc@732 | 60 <td><form><submit action={chat r.T.Id} value="Enter"/></form></td> |
adamc@732 | 61 <td><form><submit action={delete r.T.Id} value="Delete"/></form></td> |
adamc@699 | 62 </tr></xml>) |
adamc@699 | 63 |
adamc@732 | 64 and delete id () = |
adamc@699 | 65 dml (DELETE FROM t WHERE Id = {[id]}); |
adamc@699 | 66 main () |
adamc@699 | 67 |
adamc@699 | 68 and main () = |
adamc@699 | 69 let |
adamc@699 | 70 fun create r = |
adamc@699 | 71 id <- nextval s; |
adamc@699 | 72 room <- Room.create; |
adamc@699 | 73 dml (INSERT INTO t (Id, Title, Room) VALUES ({[id]}, {[r.Title]}, {[room]})); |
adamc@699 | 74 main () |
adamc@699 | 75 in |
adamc@699 | 76 ls <- list (); |
adamc@699 | 77 return <xml><body> |
adamc@699 | 78 <h1>Current Channels</h1> |
adamc@699 | 79 |
adamc@699 | 80 <table> |
adamc@699 | 81 <tr> <th>ID</th> <th>Title</th> <th>#Subscribers</th> </tr> |
adamc@699 | 82 {ls} |
adamc@699 | 83 </table> |
adamc@699 | 84 |
adamc@699 | 85 <h1>New Channel</h1> |
adamc@699 | 86 |
adamc@699 | 87 <form> |
adamc@699 | 88 Title: <textbox{#Title}/><br/> |
adamc@699 | 89 <submit action={create}/> |
adamc@699 | 90 </form> |
adamc@699 | 91 </body></xml> |
adamc@699 | 92 end |