Mercurial > urweb

comparison demo/more/grid.ur @ 937:37dd42935dad

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Summary row with aggregates
author Adam Chlipala <adamc@hcoop.net>
date Tue, 15 Sep 2009 10:18:56 -0400
parents 6966d98c80b5
children e2be476673f2
comparison
equal deleted inserted replaced
936:6966d98c80b5 937:37dd42935dad
30 30
31 val folder : folder cols 31 val folder : folder cols
32 32
33 con aggregates :: {Type} 33 con aggregates :: {Type}
34 val aggregates : $(map (aggregateMeta row) aggregates) 34 val aggregates : $(map (aggregateMeta row) aggregates)
35 val aggFolder : folder aggregates
35 end) = struct 36 end) = struct
36 style tabl 37 style tabl
37 style tr 38 style tr
38 style th 39 style th
39 style td 40 style td
41 style agg
40 42
41 fun make (row : M.row) [t] (m : colMeta' M.row t) : transaction t = m.Project row 43 fun make (row : M.row) [t] (m : colMeta' M.row t) : transaction t = m.Project row
42 44
43 fun makeAll cols row = @@Monad.exec [transaction] _ [map snd M.cols] 45 fun makeAll cols row = @@Monad.exec [transaction] _ [map snd M.cols]
44 (map2 [fst] [colMeta M.row] [fn p :: (Type * Type) => transaction p.2] 46 (map2 [fst] [colMeta M.row] [fn p :: (Type * Type) => transaction p.2]
75 fun render grid = <xml> 77 fun render grid = <xml>
76 <table class={tabl}> 78 <table class={tabl}>
77 <tr class={tr}> 79 <tr class={tr}>
78 <th/> <th/> 80 <th/> <th/>
79 {foldRX2 [fst] [colMeta M.row] [_] 81 {foldRX2 [fst] [colMeta M.row] [_]
80 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] 82 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest]
81 data (meta : colMeta M.row p) => 83 data (meta : colMeta M.row p) =>
82 <xml><th class={th}>{[(meta.Handlers data).Header]}</th></xml>) 84 <xml><th class={th}>{[(meta.Handlers data).Header]}</th></xml>)
83 [_] M.folder grid.Cols M.cols} 85 [_] M.folder grid.Cols M.cols}
84 </tr> 86 </tr>
85 87
86 {Dlist.render (fn {Row = rowS, Cols = colsS, Updating = ud} pos => 88 {Dlist.render (fn {Row = rowS, Cols = colsS, Updating = ud} pos =>
87 let 89 let
88 val delete = 90 val delete =
89 Dlist.delete pos; 91 Dlist.delete pos;
90 row <- get rowS; 92 row <- get rowS;
91 rpc (M.delete (M.keyOf row)) 93 rpc (M.delete (M.keyOf row))
92 94
93 val update = set ud True 95 val update = set ud True
94 96
95 val cancel = 97 val cancel =
96 set ud False; 98 set ud False;
97 row <- get rowS; 99 row <- get rowS;
98 cols <- makeAll grid.Cols row; 100 cols <- makeAll grid.Cols row;
99 set colsS cols 101 set colsS cols
100 102
101 val save = 103 val save =
102 cols <- get colsS; 104 cols <- get colsS;
103 errors <- Monad.foldR3 [fst] [colMeta M.row] [snd] [fn _ => option string] 105 errors <- Monad.foldR3 [fst] [colMeta M.row] [snd] [fn _ => option string]
104 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] 106 (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
105 [[nm] ~ rest] data meta v errors => 107 [[nm] ~ rest] data meta v errors =>
106 b <- current ((meta.Handlers data).Validate v); 108 b <- current ((meta.Handlers data).Validate v);
107 return (if b then 109 return (if b then
108 errors 110 errors
109 else 111 else
110 case errors of 112 case errors of
111 None => Some ((meta.Handlers data).Header) 113 None => Some ((meta.Handlers data).Header)
112 | Some s => Some ((meta.Handlers data).Header 114 | Some s => Some ((meta.Handlers data).Header
113 ^ ", " ^ s))) 115 ^ ", " ^ s)))
114 None [_] M.folder grid.Cols M.cols cols; 116 None [_] M.folder grid.Cols M.cols cols;
115 117
116 case errors of 118 case errors of
117 Some s => alert ("Can't save because the following columns have invalid values:\n" 119 Some s => alert ("Can't save because the following columns have invalid values:\n"
118 ^ s) 120 ^ s)
119 | None => 121 | None =>
120 set ud False; 122 set ud False;
121 row <- get rowS; 123 row <- get rowS;
122 row' <- Monad.foldR3 [fst] [colMeta M.row] [snd] [fn _ => M.row] 124 row' <- Monad.foldR3 [fst] [colMeta M.row] [snd] [fn _ => M.row]
125 (fn [nm :: Name] [t :: (Type * Type)]
126 [rest :: {(Type * Type)}]
127 [[nm] ~ rest] data meta v row' =>
128 (meta.Handlers data).Update row' v)
129 row [_] M.folder grid.Cols M.cols cols;
130 rpc (M.save (M.keyOf row) row');
131 set rowS row';
132
133 cols <- makeAll grid.Cols row';
134 set colsS cols
135 in
136 <xml><tr class={tr}>
137 <td>
138 <dyn signal={b <- signal ud;
139 return (if b then
140 <xml><button value="Save" onclick={save}/></xml>
141 else
142 <xml><button value="Update" onclick={update}/></xml>)}/>
143 </td>
144
145 <td><dyn signal={b <- signal ud;
146 return (if b then
147 <xml><button value="Cancel" onclick={cancel}/></xml>
148 else
149 <xml><button value="Delete" onclick={delete}/></xml>)}/>
150 </td>
151
152 <dyn signal={cols <- signal colsS;
153 return (foldRX3 [fst] [colMeta M.row] [snd] [_]
123 (fn [nm :: Name] [t :: (Type * Type)] 154 (fn [nm :: Name] [t :: (Type * Type)]
124 [rest :: {(Type * Type)}] 155 [rest :: {(Type * Type)}]
125 [[nm] ~ rest] data meta v row' => 156 [[nm] ~ rest] data meta v =>
126 (meta.Handlers data).Update row' v) 157 <xml><td class={td}>
127 row [_] M.folder grid.Cols M.cols cols; 158 <dyn signal={b <- signal ud;
128 rpc (M.save (M.keyOf row) row'); 159 return (if b then
129 set rowS row'; 160 (meta.Handlers data).Edit v
130 161 else
131 cols <- makeAll grid.Cols row'; 162 (meta.Handlers data).Display
132 set colsS cols 163 v)}/>
133 in 164 <dyn signal={b <- signal ud;
134 <xml><tr class={tr}> 165 if b then
135 <td> 166 valid <-
136 <dyn signal={b <- signal ud; 167 (meta.Handlers data).Validate v;
137 return (if b then 168 return (if valid then
138 <xml><button value="Save" onclick={save}/></xml> 169 <xml/>
139 else 170 else
140 <xml><button value="Update" onclick={update}/></xml>)}/> 171 <xml>!</xml>)
141 </td> 172 else
142 <td><dyn signal={b <- signal ud; 173 return <xml/>}/>
143 return (if b then 174 </td></xml>)
144 <xml><button value="Cancel" onclick={cancel}/></xml> 175 [_] M.folder grid.Cols M.cols cols)}/>
145 else 176 </tr></xml>
146 <xml><button value="Delete" onclick={delete}/></xml>)}/> 177 end) grid.Rows}
147 </td> 178
148 179 <dyn signal={rows <- Dlist.foldl (fn row => Monad.mapR2 [aggregateMeta M.row] [id] [id]
149 <dyn signal={cols <- signal colsS; 180 (fn [nm :: Name] [t :: Type] meta acc =>
150 return (foldRX3 [fst] [colMeta M.row] [snd] [_] 181 Monad.mp (fn v => meta.Step v acc)
151 (fn [nm :: Name] [t :: (Type * Type)] 182 (signal row.Row))
152 [rest :: {(Type * Type)}] 183 [_] M.aggFolder M.aggregates)
153 [[nm] ~ rest] data meta v => 184 (mp [aggregateMeta M.row] [id]
154 <xml><td class={td}> 185 (fn [t] meta => meta.Initial)
155 <dyn signal={b <- signal ud; 186 [_] M.aggFolder M.aggregates) grid.Rows;
156 return (if b then 187 return <xml><tr>
157 (meta.Handlers data).Edit v 188 <td/><td/>
158 else 189 {foldRX2 [aggregateMeta M.row] [id] [_]
159 (meta.Handlers data).Display 190 (fn [nm :: Name] [t :: Type] [rest :: {Type}] [[nm] ~ rest] meta acc =>
160 v)}/> 191 <xml><td class={agg}>{meta.Display acc}</td></xml>)
161 <dyn signal={b <- signal ud; 192 [_] M.aggFolder M.aggregates rows}
162 if b then 193 </tr></xml>}/>
163 valid <-
164 (meta.Handlers data).Validate v;
165 return (if valid then
166 <xml/>
167 else
168 <xml>!</xml>)
169 else
170 return <xml/>}/>
171 </td></xml>)
172 [_] M.folder grid.Cols M.cols cols)}/>
173 </tr></xml>
174 end) grid.Rows}
175 </table> 194 </table>
176 195
177 <button value="New row" onclick={row <- rpc M.new; 196 <button value="New row" onclick={row <- rpc M.new;
178 addRow grid.Cols grid.Rows row}/> 197 addRow grid.Cols grid.Rows row}/>
179 <button value="Refresh" onclick={sync grid}/> 198 <button value="Refresh" onclick={sync grid}/>