Ur/Web: demo/batch.ur annotate

annotate demo/batch.ur @ 693:655bcc9b77e0

_Really_ implement embedded closure GC; extend Scriptcheck to figure out when client IDs must be assigned

author	Adam Chlipala <adamc@hcoop.net>
date	Sat, 04 Apr 2009 14:03:39 -0400
parents	96ebc6bdb5a0
children	1a317a707d71

rev	line source
adamc@649	1 datatype list t = Nil \| Cons of t * list t
adamc@649	2
adamc@649	3 table t : {Id : int, A : string}
adamc@649	4
adamc@649	5 fun allRows () =
adamc@649	6 query (SELECT * FROM t)
adamc@649	7 (fn r acc => return (Cons ((r.T.Id, r.T.A), acc)))
adamc@649	8 Nil
adamc@649	9
adamc@649	10 fun doBatch ls =
adamc@649	11 case ls of
adamc@649	12 Nil => return ()
adamc@649	13 \| Cons ((id, a), ls') =>
adamc@649	14 dml (INSERT INTO t (Id, A) VALUES ({[id]}, {[a]}));
adamc@649	15 doBatch ls'
adamc@649	16
adamc@649	17 fun del id =
adamc@649	18 dml (DELETE FROM t WHERE t.Id = {[id]})
adamc@649	19
adamc@649	20 fun show withDel lss =
adamc@649	21 let
adamc@649	22 fun show' ls =
adamc@649	23 case ls of
adamc@649	24 Nil => <xml/>
adamc@649	25 \| Cons ((id, a), ls) => <xml>
adamc@649	26 <tr><td>{[id]}</td> <td>{[a]}</td> {if withDel then
adamc@649	27 <xml><td><button value="Delete" onclick={del id}/></td></xml>
adamc@649	28 else
adamc@649	29 <xml/>} </tr>
adamc@649	30 {show' ls}
adamc@649	31 </xml>
adamc@649	32 in
adamc@649	33 <xml><dyn signal={ls <- signal lss; return <xml><table>
adamc@649	34 <tr> <th>Id</th> <th>A</th> </tr>
adamc@649	35 {show' ls}
adamc@649	36 </table></xml>}/></xml>
adamc@649	37 end
adamc@649	38
adamc@649	39 fun main () =
adamc@649	40 lss <- source Nil;
adamc@649	41 batched <- source Nil;
adamc@649	42
adamc@649	43 id <- source "";
adamc@649	44 a <- source "";
adamc@649	45
adamc@649	46 let
adamc@649	47 fun add () =
adamc@649	48 id <- get id;
adamc@649	49 a <- get a;
adamc@649	50 ls <- get batched;
adamc@649	51
adamc@649	52 set batched (Cons ((readError id, a), ls))
adamc@649	53
adamc@649	54 fun exec () =
adamc@649	55 ls <- get batched;
adamc@649	56
adamc@649	57 doBatch ls;
adamc@649	58 set batched Nil
adamc@649	59 in
adamc@649	60 return <xml><body>
adamc@649	61 <h2>Rows</h2>
adamc@649	62
adamc@649	63 {show True lss}
adamc@649	64
adamc@649	65 <button value="Update" onclick={ls <- allRows (); set lss ls}/><br/>
adamc@649	66 <br/>
adamc@649	67
adamc@649	68 <h2>Batch new rows to add</h2>
adamc@649	69
adamc@649	70 <table>
adamc@649	71 <tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr>
adamc@649	72 <tr> <th>A:</th> <td><ctextbox source={a}/></td> </tr>
adamc@649	73 <tr> <th/> <td><button value="Batch it" onclick={add ()}/></td> </tr>
adamc@649	74 </table>
adamc@649	75
adamc@649	76 <h2>Already batched:</h2>
adamc@649	77 {show False batched}
adamc@649	78 <button value="Execute" onclick={exec ()}/>
adamc@649	79 </body></xml>
adamc@649	80 end

Mercurial > urweb

annotate demo/batch.ur @ 693:655bcc9b77e0