Mercurial > urweb
comparison demo/more/dbgrid.ur @ 936:6966d98c80b5
Include 'key' type in Grid
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 15 Sep 2009 09:45:46 -0400 |
parents | 2422360c78a3 |
children | 37dd42935dad |
comparison
equal
deleted
inserted
replaced
935:2422360c78a3 | 936:6966d98c80b5 |
---|---|
251 | 251 |
252 con aggregates :: {Type} | 252 con aggregates :: {Type} |
253 val aggregates : $(map (aggregateMeta (key ++ row)) aggregates) | 253 val aggregates : $(map (aggregateMeta (key ++ row)) aggregates) |
254 end) = struct | 254 end) = struct |
255 open Grid.Make(struct | 255 open Grid.Make(struct |
256 fun keyOf r = r --- M.row | |
257 | |
256 val list = query (SELECT * FROM {{M.tab}} AS T) (fn r rs => return (r.T :: rs)) [] | 258 val list = query (SELECT * FROM {{M.tab}} AS T) (fn r rs => return (r.T :: rs)) [] |
257 | 259 |
258 val wholeRow = @Folder.concat ! M.keyFolder M.rowFolder | 260 val wholeRow = @Folder.concat ! M.keyFolder M.rowFolder |
259 | 261 |
260 fun ensql [env] (r : $(M.key ++ M.row)) = | 262 fun ensql [env] (r : $(M.key ++ M.row)) = |
267 (fn [nm :: Name] [t :: Type] meta => meta.New) | 269 (fn [nm :: Name] [t :: Type] meta => meta.New) |
268 [_] wholeRow M.raw; | 270 [_] wholeRow M.raw; |
269 dml (insert M.tab (ensql row)); | 271 dml (insert M.tab (ensql row)); |
270 return row | 272 return row |
271 | 273 |
272 fun selector (r : $(M.key ++ M.row)) : sql_exp [T = M.key ++ M.row] [] [] bool = | 274 fun selector (r : $M.key) : sql_exp [T = M.key ++ M.row] [] [] bool = |
273 foldR2 [rawMeta] [id] | 275 foldR2 [rawMeta] [id] |
274 [fn key => rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool] | 276 [fn key => rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool] |
275 (fn [nm :: Name] [t :: Type] [key :: {Type}] [[nm] ~ key] | 277 (fn [nm :: Name] [t :: Type] [key :: {Type}] [[nm] ~ key] |
276 (meta : rawMeta t) (v : t) | 278 (meta : rawMeta t) (v : t) |
277 (exp : rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool) | 279 (exp : rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool) |
278 [rest :: {Type}] [rest ~ [nm = t] ++ key] => | 280 [rest :: {Type}] [rest ~ [nm = t] ++ key] => |
279 (WHERE T.{nm} = {@sql_inject meta.Inj v} AND {exp [[nm = t] ++ rest] !})) | 281 (WHERE T.{nm} = {@sql_inject meta.Inj v} AND {exp [[nm = t] ++ rest] !})) |
280 (fn [rest :: {Type}] [rest ~ []] => (WHERE TRUE)) | 282 (fn [rest :: {Type}] [rest ~ []] => (WHERE TRUE)) |
281 [_] M.keyFolder (M.raw --- map rawMeta M.row) (r --- M.row) | 283 [_] M.keyFolder (M.raw --- map rawMeta M.row) r |
282 [_] ! | 284 [_] ! |
283 | 285 |
284 fun save {Old = row, New = row'} = | 286 fun save key row = |
285 dml (update [M.key ++ M.row] ! | 287 dml (update [M.key ++ M.row] ! |
286 (ensql row') | 288 (ensql row) |
287 M.tab | 289 M.tab |
288 (selector row)) | 290 (selector key)) |
289 | 291 |
290 fun delete row = | 292 fun delete key = |
291 dml (Basis.delete M.tab (selector row)) | 293 dml (Basis.delete M.tab (selector key)) |
292 | 294 |
293 val cols = M.cols | 295 val cols = M.cols |
294 | 296 |
295 val folder = M.colsFolder | 297 val folder = M.colsFolder |
296 | 298 |