# HG changeset patch # User Adam Chlipala # Date 1238946535 14400 # Node ID 4e260887d8f2d942df2ffcd544acfccc7a520da7 # Parent 9b29ce0babb8715a7de3ce2d209d5719b00742b5 Chat demo diff -r 9b29ce0babb8 -r 4e260887d8f2 demo/broadcast.ur --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/broadcast.ur Sun Apr 05 11:48:55 2009 -0400 @@ -0,0 +1,28 @@ +functor Make(M : sig type t end) = struct + sequence s + table t : {Id : int, Client : client, Channel : channel M.t} + + type topic = int + + val inj : sql_injectable topic = _ + + val create = nextval s + + fun subscribe id = + cli <- self; + ro <- oneOrNoRows (SELECT t.Channel FROM t WHERE t.Id = {[id]} AND t.Client = {[cli]}); + case ro of + None => + ch <- channel; + dml (INSERT INTO t (Id, Client, Channel) VALUES ({[id]}, {[cli]}, {[ch]})); + return ch + | Some r => return r.T.Channel + + fun send id msg = + queryI (SELECT t.Channel FROM t WHERE t.Id = {[id]}) + (fn r => Basis.send r.T.Channel msg) + + fun subscribers id = + r <- oneRow (SELECT COUNT( * ) AS N FROM t WHERE t.Id = {[id]}); + return r.N +end diff -r 9b29ce0babb8 -r 4e260887d8f2 demo/broadcast.urs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/broadcast.urs Sun Apr 05 11:48:55 2009 -0400 @@ -0,0 +1,11 @@ +functor Make(M : sig type t end) : sig + type topic + + val inj : sql_injectable topic + + val create : transaction topic + val subscribe : topic -> transaction (channel M.t) + val send : topic -> M.t -> transaction unit + + val subscribers : topic -> transaction int +end diff -r 9b29ce0babb8 -r 4e260887d8f2 demo/chat.ur --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/chat.ur Sun Apr 05 11:48:55 2009 -0400 @@ -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 +

{[r.T.Title]}

+ +