Mercurial > urweb

annotate demo/batch.ur @ 1917:398298ca82b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add keepalive option to the http protocol
author Adam Chlipala <adam@chlipala.net>
date Thu, 28 Nov 2013 11:06:11 -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