Mercurial > urweb

annotate tests/roundTrip.ur @ 1665:f9ffe8497742

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix channel delivery to handle sending of messages for channels whose clients haven't connected yet
author Adam Chlipala <adam@chlipala.net>
date Sun, 08 Jan 2012 15:47:05 -0500
parents 8a169fc0838b
children
rev   line source
adamc@728 1 table channels : { Client : client, Channel : channel (string * int * float) }
adamc@728 2 PRIMARY KEY Client
adamc@728 3
adam@1348 4 table dearlyDeparted : { Client : option client, When : time }
adam@1348 5
adam@1348 6 task clientLeaves = fn cli : client =>
adam@1348 7 dml (INSERT INTO dearlyDeparted (Client, When) VALUES ({[Some cli]}, CURRENT_TIMESTAMP));
adam@1348 8 debug "Our favorite client has LEFT!"
adam@1348 9
adamc@728 10 fun writeBack v =
adamc@728 11 me <- self;
adamc@728 12 r <- oneRow (SELECT channels.Channel FROM channels WHERE channels.Client = {[me]});
adamc@728 13 send r.Channels.Channel v
adamc@728 14
adam@1348 15 fun main' () =
adamc@728 16 me <- self;
adamc@728 17 ch <- channel;
adamc@728 18 dml (INSERT INTO channels (Client, Channel) VALUES ({[me]}, {[ch]}));
adamc@728 19
adamc@728 20 buf <- Buffer.create;
adamc@728 21
adamc@728 22 let
adamc@728 23 fun receiverA () =
adamc@728 24 v <- recv ch;
adamc@728 25 Buffer.write buf ("A:(" ^ v.1 ^ ", " ^ show v.2 ^ ", " ^ show v.3 ^ ")");
adamc@728 26 receiverA ()
adamc@728 27
adamc@728 28 fun receiverB () =
adamc@728 29 v <- recv ch;
adamc@728 30 Buffer.write buf ("B:(" ^ v.1 ^ ", " ^ show v.2 ^ ", " ^ show v.3 ^ ")");
adamc@728 31 error <xml>Bail out!</xml>;
adamc@728 32 receiverB ()
adamc@728 33
adamc@728 34 fun sender s n f =
adamc@729 35 sleep 2000;
adam@1348 36 rpc (writeBack (s, n, f));
adamc@728 37 sender (s ^ "!") (n + 1) (f + 1.23)
adamc@728 38 in
adamc@729 39 return <xml><body onload={onDisconnect (alert "Server booted me");
adamc@729 40 onConnectFail (alert "Connection failed");
adamc@729 41 onServerError (fn s => alert ("Server error: " ^ s));
adamc@729 42 spawn (receiverA ()); spawn (receiverB ()); sender "" 0 0.0}>
adamc@728 43 <dyn signal={Buffer.render buf}/>
adamc@728 44 </body></xml>
adamc@728 45 end
adam@1348 46
adam@1348 47 fun main () = return <xml><body><form><submit action={main'}/></form></body></xml>