Mercurial > urweb

comparison demo/batchFun.ur @ 1302:d008c4c43a0a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Flex kinds for type-level tuples; ::_ notation
author Adam Chlipala <adam@chlipala.net>
date Sun, 10 Oct 2010 13:07:38 -0400
parents ad15700272f6
children 78fe9841c39d
comparison
equal deleted inserted replaced
1301:4359e185d3af 1302:d008c4c43a0a
4 Inject : sql_injectable db, 4 Inject : sql_injectable db,
5 5
6 NewState : transaction state, 6 NewState : transaction state,
7 Widget : state -> xbody, 7 Widget : state -> xbody,
8 ReadState : state -> transaction db} 8 ReadState : state -> transaction db}
9 con colsMeta = fn cols :: {(Type * Type)} => $(map colMeta cols) 9 con colsMeta = fn cols => $(map colMeta cols)
10 10
11 fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t) 11 fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t)
12 name : colMeta (t, source string) = 12 name : colMeta (t, source string) =
13 {Nam = name, 13 {Nam = name,
14 Show = txt, 14 Show = txt,
44 Nil 44 Nil
45 45
46 fun add r = 46 fun add r =
47 dml (insert t 47 dml (insert t
48 (@foldR2 [fst] [colMeta] 48 (@foldR2 [fst] [colMeta]
49 [fn cols => $(map (fn t :: (Type * Type) => 49 [fn cols => $(map (fn t => sql_exp [] [] [] t.1) cols)]
50 sql_exp [] [] [] t.1) cols)] 50 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] input col acc =>
51 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
52 [[nm] ~ rest] input col acc =>
53 acc ++ {nm = @sql_inject col.Inject input}) 51 acc ++ {nm = @sql_inject col.Inject input})
54 {} M.fl (r -- #Id) M.cols 52 {} M.fl (r -- #Id) M.cols
55 ++ {Id = (SQL {[r.Id]})})) 53 ++ {Id = (SQL {[r.Id]})}))
56 54
57 fun doBatch ls = 55 fun doBatch ls =
71 Nil => <xml/> 69 Nil => <xml/>
72 | Cons (r, ls) => <xml> 70 | Cons (r, ls) => <xml>
73 <tr> 71 <tr>
74 <td>{[r.Id]}</td> 72 <td>{[r.Id]}</td>
75 {@mapX2 [colMeta] [fst] [_] 73 {@mapX2 [colMeta] [fst] [_]
76 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] 74 (fn [nm :: Name] [p ::_] [rest ::_] [[nm] ~ rest] m v =>
77 [[nm] ~ rest] m v =>
78 <xml><td>{m.Show v}</td></xml>) 75 <xml><td>{m.Show v}</td></xml>)
79 M.fl M.cols (r -- #Id)} 76 M.fl M.cols (r -- #Id)}
80 {if withDel then 77 {if withDel then
81 <xml><td><button value="Delete" onclick={rpc (del r.Id)}/></td></xml> 78 <xml><td><button value="Delete" onclick={rpc (del r.Id)}/></td></xml>
82 else 79 else
87 in 84 in
88 <xml><dyn signal={ls <- signal lss; return <xml><table> 85 <xml><dyn signal={ls <- signal lss; return <xml><table>
89 <tr> 86 <tr>
90 <th>Id</th> 87 <th>Id</th>
91 {@mapX [colMeta] [_] 88 {@mapX [colMeta] [_]
92 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] 89 (fn [nm :: Name] [p ::_] [rest ::_] [[nm] ~ rest] m =>
93 [[nm] ~ rest] m =>
94 <xml><th>{[m.Nam]}</th></xml>) 90 <xml><th>{[m.Nam]}</th></xml>)
95 M.fl M.cols} 91 M.fl M.cols}
96 </tr> 92 </tr>
97 {show' ls} 93 {show' ls}
98 </table></xml>}/></xml> 94 </table></xml>}/></xml>
102 lss <- source Nil; 98 lss <- source Nil;
103 batched <- source Nil; 99 batched <- source Nil;
104 100
105 id <- source ""; 101 id <- source "";
106 inps <- @foldR [colMeta] [fn r => transaction ($(map snd r))] 102 inps <- @foldR [colMeta] [fn r => transaction ($(map snd r))]
107 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] m acc => 103 (fn [nm :: Name] [p ::_] [rest ::_] [[nm] ~ rest] m acc =>
108 s <- m.NewState; 104 s <- m.NewState;
109 r <- acc; 105 r <- acc;
110 return ({nm = s} ++ r)) 106 return ({nm = s} ++ r))
111 (return {}) 107 (return {})
112 M.fl M.cols; 108 M.fl M.cols;
113 109
114 let 110 let
115 fun add () = 111 fun add () =
116 id <- get id; 112 id <- get id;
117 vs <- @foldR2 [colMeta] [snd] [fn r => transaction ($(map fst r))] 113 vs <- @foldR2 [colMeta] [snd] [fn r => transaction ($(map fst r))]
118 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] 114 (fn [nm :: Name] [p ::_] [rest ::_] [[nm] ~ rest] m s acc =>
119 [[nm] ~ rest] m s acc =>
120 v <- m.ReadState s; 115 v <- m.ReadState s;
121 r <- acc; 116 r <- acc;
122 return ({nm = v} ++ r)) 117 return ({nm = v} ++ r))
123 (return {}) 118 (return {})
124 M.fl M.cols inps; 119 M.fl M.cols inps;
143 <h2>Batch new rows to add</h2> 138 <h2>Batch new rows to add</h2>
144 139
145 <table> 140 <table>
146 <tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr> 141 <tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr>
147 {@mapX2 [colMeta] [snd] [_] 142 {@mapX2 [colMeta] [snd] [_]
148 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] 143 (fn [nm :: Name] [p ::_] [rest ::_] [[nm] ~ rest] m s =>
149 [[nm] ~ rest] m s =>
150 <xml><tr> <th>{[m.Nam]}:</th> <td>{m.Widget s}</td> </tr></xml>) 144 <xml><tr> <th>{[m.Nam]}:</th> <td>{m.Widget s}</td> </tr></xml>)
151 M.fl M.cols inps} 145 M.fl M.cols inps}
152 <tr> <th/> <td><button value="Batch it" onclick={add ()}/></td> </tr> 146 <tr> <th/> <td><button value="Batch it" onclick={add ()}/></td> </tr>
153 </table> 147 </table>
154 148