Mercurial > urweb
annotate demo/batch.ur @ 2097:9272476e2a1c
Client-side conversion of string to bool
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 25 Dec 2014 18:32:27 -0500 |
parents | e6bc6bbd7a32 |
children |
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 |
adam@1784 | 28 <xml><td><button value="Delete" onclick={fn _ => rpc (del id)}/> |
adamc@908 | 29 </td></xml> |
adamc@649 | 30 else |
adamc@649 | 31 <xml/>} </tr> |
adamc@649 | 32 {show' ls} |
adamc@649 | 33 </xml> |
adamc@649 | 34 in |
adamc@649 | 35 <xml><dyn signal={ls <- signal lss; return <xml><table> |
adamc@649 | 36 <tr> <th>Id</th> <th>A</th> </tr> |
adamc@649 | 37 {show' ls} |
adamc@649 | 38 </table></xml>}/></xml> |
adamc@649 | 39 end |
adamc@649 | 40 |
adamc@782 | 41 fun main () = |
adamc@649 | 42 lss <- source Nil; |
adamc@649 | 43 batched <- source Nil; |
adamc@649 | 44 |
adamc@649 | 45 id <- source ""; |
adamc@649 | 46 a <- source ""; |
adamc@649 | 47 |
adamc@649 | 48 let |
adamc@649 | 49 fun add () = |
adamc@649 | 50 id <- get id; |
adamc@649 | 51 a <- get a; |
adamc@649 | 52 ls <- get batched; |
adamc@649 | 53 |
adamc@649 | 54 set batched (Cons ((readError id, a), ls)) |
adamc@649 | 55 |
adamc@649 | 56 fun exec () = |
adamc@649 | 57 ls <- get batched; |
adamc@649 | 58 |
adamc@908 | 59 rpc (doBatch ls); |
adamc@649 | 60 set batched Nil |
adamc@649 | 61 in |
adamc@649 | 62 return <xml><body> |
adamc@649 | 63 <h2>Rows</h2> |
adamc@649 | 64 |
adamc@649 | 65 {show True lss} |
adamc@649 | 66 |
adam@1784 | 67 <button value="Update" onclick={fn _ => ls <- rpc (allRows ()); set lss ls}/><br/> |
adamc@649 | 68 <br/> |
adamc@649 | 69 |
adamc@649 | 70 <h2>Batch new rows to add</h2> |
adamc@649 | 71 |
adamc@649 | 72 <table> |
adamc@649 | 73 <tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr> |
adamc@649 | 74 <tr> <th>A:</th> <td><ctextbox source={a}/></td> </tr> |
adam@1784 | 75 <tr> <th/> <td><button value="Batch it" onclick={fn _ => add ()}/></td> </tr> |
adamc@649 | 76 </table> |
adamc@649 | 77 |
adamc@649 | 78 <h2>Already batched:</h2> |
adamc@649 | 79 {show False batched} |
adam@1784 | 80 <button value="Execute" onclick={fn _ => exec ()}/> |
adamc@649 | 81 </body></xml> |
adamc@649 | 82 end |