Mercurial > urweb
comparison tests/crud.ur @ 339:075b36dbb1a4
Crud supports INSERT
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 14 Sep 2008 15:10:04 -0400 |
parents | 18d5affa790d |
children | 389399d65331 |
comparison
equal
deleted
inserted
replaced
338:e976b187d73a | 339:075b36dbb1a4 |
---|---|
1 con colMeta' = fn t :: Type => {Nam : string, Show : t -> xbody} | 1 con colMeta = fn t_formT :: (Type * Type) => { |
2 con colMeta = fn cols :: {Type} => $(Top.mapTT colMeta' cols) | 2 Nam : string, |
3 Show : t_formT.1 -> xbody, | |
4 Widget : nm :: Name -> xml form [] [nm = t_formT.2], | |
5 Parse : t_formT.2 -> t_formT.1, | |
6 Inject : sql_injectable t_formT.1 | |
7 } | |
8 con colsMeta = fn cols :: {(Type * Type)} => $(Top.mapT2T colMeta cols) | |
3 | 9 |
4 functor Make(M : sig | 10 functor Make(M : sig |
5 con cols :: {Type} | 11 con cols :: {(Type * Type)} |
6 constraint [Id] ~ cols | 12 constraint [Id] ~ cols |
7 val tab : sql_table ([Id = int] ++ cols) | 13 val tab : sql_table ([Id = int] ++ mapT2T fstTT cols) |
8 | 14 |
9 val title : string | 15 val title : string |
10 | 16 |
11 val cols : colMeta cols | 17 val cols : colsMeta cols |
12 end) = struct | 18 end) = struct |
13 | 19 |
14 open constraints M | 20 open constraints M |
15 val tab = M.tab | 21 val tab = M.tab |
22 | |
23 sequence seq | |
24 | |
25 fun create (inputs : $(mapT2T sndTT M.cols)) = | |
26 id <- nextval seq; | |
27 () <- dml (insert tab (foldT2R2 [sndTT] [colMeta] | |
28 [fn cols => $(mapT2T (fn t :: (Type * Type) => | |
29 sql_exp [T = [Id = int] ++ mapT2T fstTT M.cols] [] [] t.1) cols)] | |
30 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => | |
31 [[nm] ~ rest] => | |
32 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) | |
33 {} [M.cols] inputs M.cols | |
34 with #Id = (SQL {id}))); | |
35 return <html><body> | |
36 Inserted with ID {txt _ id}. | |
37 </body></html> | |
16 | 38 |
17 fun delete (id : int) = | 39 fun delete (id : int) = |
18 () <- dml (DELETE FROM tab WHERE Id = {id}); | 40 () <- dml (DELETE FROM tab WHERE Id = {id}); |
19 return <html><body> | 41 return <html><body> |
20 The deed is done. | 42 The deed is done. |
26 <p><a link={delete id}>I was born sure!</a></p> | 48 <p><a link={delete id}>I was born sure!</a></p> |
27 </body></html> | 49 </body></html> |
28 | 50 |
29 fun main () : transaction page = | 51 fun main () : transaction page = |
30 rows <- queryX (SELECT * FROM tab AS T) | 52 rows <- queryX (SELECT * FROM tab AS T) |
31 (fn (fs : {T : $([Id = int] ++ M.cols)}) => <body> | 53 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <body> |
32 <tr> | 54 <tr> |
33 <td>{txt _ fs.T.Id}</td> | 55 <td>{txt _ fs.T.Id}</td> |
34 {foldTRX2 [idT] [colMeta'] [tr] | 56 {foldT2RX2 [fstTT] [colMeta] [tr] |
35 (fn (nm :: Name) (t :: Type) (rest :: {Type}) => | 57 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => |
36 [[nm] ~ rest] => | 58 [[nm] ~ rest] => |
37 fn v col => <tr> | 59 fn v col => <tr> |
38 <td>{col.Show v}</td> | 60 <td>{col.Show v}</td> |
39 </tr>) | 61 </tr>) |
40 [M.cols] (fs.T -- #Id) M.cols} | 62 [M.cols] (fs.T -- #Id) M.cols} |
49 <h1>{cdata M.title}</h1> | 71 <h1>{cdata M.title}</h1> |
50 | 72 |
51 <table border={1}> | 73 <table border={1}> |
52 <tr> | 74 <tr> |
53 <th>ID</th> | 75 <th>ID</th> |
54 {foldTRX [colMeta'] [tr] | 76 {foldT2RX [colMeta] [tr] |
55 (fn (nm :: Name) (t :: Type) (rest :: {Type}) => | 77 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => |
56 [[nm] ~ rest] => | 78 [[nm] ~ rest] => |
57 fn col => <tr> | 79 fn col => <tr> |
58 <th>{cdata col.Nam}</th> | 80 <th>{cdata col.Nam}</th> |
59 </tr>) | 81 </tr>) |
60 [M.cols] M.cols} | 82 [M.cols] M.cols} |
61 </tr> | 83 </tr> |
62 {rows} | 84 {rows} |
63 </table> | 85 </table> |
86 | |
87 <br/> | |
88 | |
89 <lform> | |
90 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] | |
91 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => | |
92 [[nm] ~ rest] => | |
93 fn (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <lform> | |
94 <li> {cdata col.Nam}: {col.Widget [nm]}</li> | |
95 {useMore acc} | |
96 </lform>) | |
97 <lform></lform> | |
98 [M.cols] M.cols} | |
99 | |
100 <submit action={create}/> | |
101 </lform> | |
64 </body></html> | 102 </body></html> |
65 | 103 |
66 end | 104 end |