Mercurial > urweb
annotate demo/batch.ur @ 695:500e93aa436f
sleep and better Scriptcheck
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 04 Apr 2009 15:56:47 -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 |