Mercurial > urweb
comparison demo/more/dbgrid.ur @ 1093:8d3aa6c7cee0
Make summary unification more conservative; infer implicit arguments after applications
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 26 Dec 2009 11:56:40 -0500 |
parents | fbc3a0eef45a |
children | f0afe61a6f8b |
comparison
equal
deleted
inserted
replaced
1092:6f4b05fc4361 | 1093:8d3aa6c7cee0 |
---|---|
382 val list = query (SELECT * FROM {{M.tab}} AS T) (fn r rs => return (r.T :: rs)) [] | 382 val list = query (SELECT * FROM {{M.tab}} AS T) (fn r rs => return (r.T :: rs)) [] |
383 | 383 |
384 val wholeRow = @Folder.concat ! M.keyFolder M.rowFolder | 384 val wholeRow = @Folder.concat ! M.keyFolder M.rowFolder |
385 | 385 |
386 fun ensql [env] (r : $(M.key ++ M.row)) = | 386 fun ensql [env] (r : $(M.key ++ M.row)) = |
387 map2 [rawMeta] [id] [sql_exp env [] []] | 387 @map2 [rawMeta] [id] [sql_exp env [] []] |
388 (fn [t] meta v => @sql_inject meta.Inj v) | 388 (fn [t] meta v => @sql_inject meta.Inj v) |
389 [_] wholeRow M.raw r | 389 wholeRow M.raw r |
390 | 390 |
391 val new = | 391 val new = |
392 row <- Monad.mapR [rawMeta] [id] | 392 row <- @Monad.mapR _ [rawMeta] [id] |
393 (fn [nm :: Name] [t :: Type] meta => meta.New) | 393 (fn [nm :: Name] [t :: Type] meta => meta.New) |
394 [_] wholeRow M.raw; | 394 wholeRow M.raw; |
395 dml (insert M.tab (ensql row)); | 395 dml (insert M.tab (ensql row)); |
396 return row | 396 return row |
397 | 397 |
398 fun selector (r : $M.key) : sql_exp [T = M.key ++ M.row] [] [] bool = | 398 fun selector (r : $M.key) : sql_exp [T = M.key ++ M.row] [] [] bool = |
399 foldR2 [rawMeta] [id] | 399 @foldR2 [rawMeta] [id] |
400 [fn key => rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool] | 400 [fn key => rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool] |
401 (fn [nm :: Name] [t :: Type] [key :: {Type}] [[nm] ~ key] | 401 (fn [nm :: Name] [t :: Type] [key :: {Type}] [[nm] ~ key] |
402 (meta : rawMeta t) (v : t) | 402 (meta : rawMeta t) (v : t) |
403 (exp : rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool) | 403 (exp : rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool) |
404 [rest :: {Type}] [rest ~ [nm = t] ++ key] => | 404 [rest :: {Type}] [rest ~ [nm = t] ++ key] => |
405 (WHERE T.{nm} = {@sql_inject meta.Inj v} AND {exp [[nm = t] ++ rest] !})) | 405 (WHERE T.{nm} = {@sql_inject meta.Inj v} AND {exp [[nm = t] ++ rest] !})) |
406 (fn [rest :: {Type}] [rest ~ []] => (WHERE TRUE)) | 406 (fn [rest :: {Type}] [rest ~ []] => (WHERE TRUE)) |
407 [_] M.keyFolder (M.raw --- map rawMeta M.row) r | 407 M.keyFolder (M.raw --- map rawMeta M.row) r |
408 [_] ! | 408 [_] ! |
409 | 409 |
410 fun save key row = | 410 fun save key row = |
411 dml (update [M.key ++ M.row] ! | 411 dml (update [M.key ++ M.row] |
412 (ensql row) | 412 (ensql row) |
413 M.tab | 413 M.tab |
414 (selector key)) | 414 (selector key)) |
415 | 415 |
416 fun delete key = | 416 fun delete key = |