Mercurial > urweb

comparison demo/batchFun.ur @ 823:669ac5e9a69e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Demo compiles with pattern-matching-fu
author Adam Chlipala <adamc@hcoop.net>
date Thu, 28 May 2009 10:35:25 -0400
parents 1fb318c17546
children 74e9e7642f08
comparison
equal deleted inserted replaced
822:d4e811beb8eb 823:669ac5e9a69e
6 NewState : transaction t_state.2, 6 NewState : transaction t_state.2,
7 Widget : t_state.2 -> xbody, 7 Widget : t_state.2 -> xbody,
8 ReadState : t_state.2 -> transaction t_state.1} 8 ReadState : t_state.2 -> transaction t_state.1}
9 con colsMeta = fn cols :: {(Type * Type)} => $(map colMeta cols) 9 con colsMeta = fn cols :: {(Type * Type)} => $(map colMeta cols)
10 10
11 fun default (t ::: Type) (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,
15 Inject = _, 15 Inject = _,
16 16
47 fun add r = 47 fun add r =
48 dml (insert t 48 dml (insert t
49 (foldR2 [fst] [colMeta] 49 (foldR2 [fst] [colMeta]
50 [fn cols => $(map (fn t :: (Type * Type) => 50 [fn cols => $(map (fn t :: (Type * Type) =>
51 sql_exp [] [] [] t.1) cols)] 51 sql_exp [] [] [] t.1) cols)]
52 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 52 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
53 [[nm] ~ rest] input col acc => 53 [[nm] ~ rest] input col acc =>
54 acc ++ {nm = @sql_inject col.Inject input}) 54 acc ++ {nm = @sql_inject col.Inject input})
55 {} [M.cols] M.fl (r -- #Id) M.cols 55 {} [M.cols] M.fl (r -- #Id) M.cols
56 ++ {Id = (SQL {[r.Id]})})) 56 ++ {Id = (SQL {[r.Id]})}))
57 57
72 Nil => <xml/> 72 Nil => <xml/>
73 | Cons (r, ls) => <xml> 73 | Cons (r, ls) => <xml>
74 <tr> 74 <tr>
75 <td>{[r.Id]}</td> 75 <td>{[r.Id]}</td>
76 {foldRX2 [colMeta] [fst] [_] 76 {foldRX2 [colMeta] [fst] [_]
77 (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)}) 77 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
78 [[nm] ~ rest] m v => 78 [[nm] ~ rest] m v =>
79 <xml><td>{m.Show v}</td></xml>) 79 <xml><td>{m.Show v}</td></xml>)
80 [M.cols] M.fl M.cols (r -- #Id)} 80 [M.cols] M.fl M.cols (r -- #Id)}
81 {if withDel then 81 {if withDel then
82 <xml><td><button value="Delete" onclick={del r.Id}/></td></xml> 82 <xml><td><button value="Delete" onclick={del r.Id}/></td></xml>
88 in 88 in
89 <xml><dyn signal={ls <- signal lss; return <xml><table> 89 <xml><dyn signal={ls <- signal lss; return <xml><table>
90 <tr> 90 <tr>
91 <th>Id</th> 91 <th>Id</th>
92 {foldRX [colMeta] [_] 92 {foldRX [colMeta] [_]
93 (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)}) 93 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
94 [[nm] ~ rest] m => 94 [[nm] ~ rest] m =>
95 <xml><th>{[m.Nam]}</th></xml>) 95 <xml><th>{[m.Nam]}</th></xml>)
96 [M.cols] M.fl M.cols} 96 [M.cols] M.fl M.cols}
97 </tr> 97 </tr>
98 {show' ls} 98 {show' ls}
103 lss <- source Nil; 103 lss <- source Nil;
104 batched <- source Nil; 104 batched <- source Nil;
105 105
106 id <- source ""; 106 id <- source "";
107 inps <- foldR [colMeta] [fn r => transaction ($(map snd r))] 107 inps <- foldR [colMeta] [fn r => transaction ($(map snd r))]
108 (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)}) [[nm] ~ rest] m acc => 108 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] m acc =>
109 s <- m.NewState; 109 s <- m.NewState;
110 r <- acc; 110 r <- acc;
111 return ({nm = s} ++ r)) 111 return ({nm = s} ++ r))
112 (return {}) 112 (return {})
113 [M.cols] M.fl M.cols; 113 [M.cols] M.fl M.cols;
114 114
115 let 115 let
116 fun add () = 116 fun add () =
117 id <- get id; 117 id <- get id;
118 vs <- foldR2 [colMeta] [snd] [fn r => transaction ($(map fst r))] 118 vs <- foldR2 [colMeta] [snd] [fn r => transaction ($(map fst r))]
119 (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)}) 119 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
120 [[nm] ~ rest] m s acc => 120 [[nm] ~ rest] m s acc =>
121 v <- m.ReadState s; 121 v <- m.ReadState s;
122 r <- acc; 122 r <- acc;
123 return ({nm = v} ++ r)) 123 return ({nm = v} ++ r))
124 (return {}) 124 (return {})
144 <h2>Batch new rows to add</h2> 144 <h2>Batch new rows to add</h2>
145 145
146 <table> 146 <table>
147 <tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr> 147 <tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr>
148 {foldRX2 [colMeta] [snd] [_] 148 {foldRX2 [colMeta] [snd] [_]
149 (fn (nm :: Name) (p :: (Type * Type)) (rest :: {(Type * Type)}) 149 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
150 [[nm] ~ rest] m s => 150 [[nm] ~ rest] m s =>
151 <xml><tr> <th>{[m.Nam]}:</th> <td>{m.Widget s}</td> </tr></xml>) 151 <xml><tr> <th>{[m.Nam]}:</th> <td>{m.Widget s}</td> </tr></xml>)
152 [M.cols] M.fl M.cols inps} 152 [M.cols] M.fl M.cols inps}
153 <tr> <th/> <td><button value="Batch it" onclick={add ()}/></td> </tr> 153 <tr> <th/> <td><button value="Batch it" onclick={add ()}/></td> </tr>
154 </table> 154 </table>