Mercurial > urweb

comparison lib/ur/top.ur @ 682:5bbb542243e8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Redo channels, making them single-client
author Adam Chlipala <adamc@hcoop.net>
date Sun, 29 Mar 2009 11:37:29 -0400
parents e5894f0e541a
children 9a2c18dab11d
comparison
equal deleted inserted replaced
681:6c9b8875f347 682:5bbb542243e8
141 (fn (nm :: Name) (t :: K) (rest :: {K}) [[nm] ~ rest] 141 (fn (nm :: Name) (t :: K) (rest :: {K}) [[nm] ~ rest]
142 r1 r2 acc => 142 r1 r2 acc =>
143 <xml>{f [nm] [t] [rest] ! r1 r2}{acc}</xml>) 143 <xml>{f [nm] [t] [rest] ! r1 r2}{acc}</xml>)
144 <xml/> 144 <xml/>
145 145
146 fun queryI (tables ::: {{Type}}) (exps ::: {Type})
147 [tables ~ exps] (q : sql_query tables exps)
148 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
149 -> transaction unit) =
150 query q
151 (fn fs _ => f fs)
152 ()
153
146 fun queryX (tables ::: {{Type}}) (exps ::: {Type}) (ctx ::: {Unit}) 154 fun queryX (tables ::: {{Type}}) (exps ::: {Type}) (ctx ::: {Unit})
147 [tables ~ exps] (q : sql_query tables exps) 155 [tables ~ exps] (q : sql_query tables exps)
148 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) 156 (f : $(exps ++ map (fn fields :: {Type} => $fields) tables)
149 -> xml ctx [] []) = 157 -> xml ctx [] []) =
150 query q 158 query q
186 (e1 : sql_exp tables agg exps (option t)) 194 (e1 : sql_exp tables agg exps (option t))
187 (e2 : option t) = 195 (e2 : option t) =
188 case e2 of 196 case e2 of
189 None => (SQL {e1} IS NULL) 197 None => (SQL {e1} IS NULL)
190 | Some _ => sql_binary sql_eq e1 (sql_inject e2) 198 | Some _ => sql_binary sql_eq e1 (sql_inject e2)
199
200
201 functor Broadcast(M : sig type t end) = struct
202 sequence s
203 table t : {Id : int, Client : option client, Channel : option (channel M.t)}
204
205 type topic = int
206
207 val inj : sql_injectable topic = _
208
209 val create = nextval s
210
211 val cleanup =
212 dml (DELETE FROM t WHERE Client IS NULL)
213
214 fun subscribe id =
215 cli <- self;
216 cleanup;
217 ro <- oneOrNoRows (SELECT t.Channel FROM t WHERE t.Id = {[id]} AND t.Client = {[Some cli]});
218 case ro of
219 None =>
220 ch <- channel;
221 dml (INSERT INTO t (Id, Client, Channel) VALUES ({[id]}, {[Some cli]}, {[Some ch]}));
222 return ch
223 | Some r =>
224 case r.T.Channel of
225 None => error <xml>Broadcast.subscribe: Got null result</xml>
226 | Some ch => return ch
227
228 fun send id msg =
229 cleanup;
230 queryI (SELECT t.Channel FROM t WHERE t.Id = {[id]})
231 (fn r => case r.T.Channel of
232 None => error <xml>Broadcast.send: Got null result</xml>
233 | Some ch => Basis.send ch msg)
234 end