annotate tests/roundTrip.ur @ 1779:7095e1b7240b
HTTP daemons now take '-a' option to set IP address to listen on
author |
Adam Chlipala <adam@chlipala.net> |
date |
Sat, 23 Jun 2012 09:46:40 -0400 |
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>
|