Mercurial > urweb

annotate tests/crud.ur @ 337:18d5affa790d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Deletion for Crud
author Adam Chlipala <adamc@hcoop.net>
date Sat, 13 Sep 2008 20:15:30 -0400
parents 34847732cefc
children 075b36dbb1a4
rev   line source
adamc@336 1 con colMeta' = fn t :: Type => {Nam : string, Show : t -> xbody}
adamc@329 2 con colMeta = fn cols :: {Type} => $(Top.mapTT colMeta' cols)
adamc@326 3
adamc@325 4 functor Make(M : sig
adamc@325 5 con cols :: {Type}
adamc@325 6 constraint [Id] ~ cols
adamc@325 7 val tab : sql_table ([Id = int] ++ cols)
adamc@325 8
adamc@325 9 val title : string
adamc@325 10
adamc@327 11 val cols : colMeta cols
adamc@325 12 end) = struct
adamc@325 13
adamc@325 14 open constraints M
adamc@325 15 val tab = M.tab
adamc@325 16
adamc@337 17 fun delete (id : int) =
adamc@337 18 () <- dml (DELETE FROM tab WHERE Id = {id});
adamc@337 19 return <html><body>
adamc@337 20 The deed is done.
adamc@337 21 </body></html>
adamc@337 22
adamc@337 23 fun confirm (id : int) = return <html><body>
adamc@337 24 <p>Are you sure you want to delete ID #{txt _ id}?</p>
adamc@337 25
adamc@337 26 <p><a link={delete id}>I was born sure!</a></p>
adamc@337 27 </body></html>
adamc@337 28
adamc@334 29 fun main () : transaction page =
adamc@334 30 rows <- queryX (SELECT * FROM tab AS T)
adamc@334 31 (fn (fs : {T : $([Id = int] ++ M.cols)}) => <body>
adamc@326 32 <tr>
adamc@326 33 <td>{txt _ fs.T.Id}</td>
adamc@332 34 {foldTRX2 [idT] [colMeta'] [tr]
adamc@329 35 (fn (nm :: Name) (t :: Type) (rest :: {Type}) =>
adamc@326 36 [[nm] ~ rest] =>
adamc@336 37 fn v col => <tr>
adamc@336 38 <td>{col.Show v}</td>
adamc@326 39 </tr>)
adamc@326 40 [M.cols] (fs.T -- #Id) M.cols}
adamc@337 41 <td><a link={confirm fs.T.Id}>[Delete]</a></td>
adamc@326 42 </tr>
adamc@334 43 </body>);
adamc@325 44 return <html><head>
adamc@334 45 <title>{cdata M.title}</title>
adamc@325 46
adamc@325 47 </head><body>
adamc@325 48
adamc@334 49 <h1>{cdata M.title}</h1>
adamc@325 50
adamc@325 51 <table border={1}>
adamc@336 52 <tr>
adamc@336 53 <th>ID</th>
adamc@336 54 {foldTRX [colMeta'] [tr]
adamc@336 55 (fn (nm :: Name) (t :: Type) (rest :: {Type}) =>
adamc@336 56 [[nm] ~ rest] =>
adamc@336 57 fn col => <tr>
adamc@336 58 <th>{cdata col.Nam}</th>
adamc@336 59 </tr>)
adamc@336 60 [M.cols] M.cols}
adamc@336 61 </tr>
adamc@325 62 {rows}
adamc@325 63 </table>
adamc@325 64 </body></html>
adamc@325 65
adamc@325 66 end