Ur/Web: demo/batch.ur annotate

annotate demo/batch.ur @ 834:74e9e7642f08

Do 'open constraints' automatically; fix sourceless <cselect> monoize bug; Monad library module

author	Adam Chlipala <adamc@hcoop.net>
date	Tue, 02 Jun 2009 11:50:53 -0400
parents	a44daa674810
children	ed06e25c70ef

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

Mercurial > urweb

annotate demo/batch.ur @ 834:74e9e7642f08