Mercurial > urweb
comparison tests/crud.ur @ 403:8084fa9216de
New implicit argument handling
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 21 Oct 2008 16:41:11 -0400 |
parents | 782ef3ad8c28 |
children | 1fb318c17546 |
comparison
equal
deleted
inserted
replaced
402:ebf27030ae3b | 403:8084fa9216de |
---|---|
9 con colsMeta = fn cols :: {(Type * Type)} => $(Top.mapT2T colMeta cols) | 9 con colsMeta = fn cols :: {(Type * Type)} => $(Top.mapT2T colMeta cols) |
10 | 10 |
11 fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t) | 11 fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t) |
12 name : colMeta (t, string) = | 12 name : colMeta (t, string) = |
13 {Nam = name, | 13 {Nam = name, |
14 Show = txt _, | 14 Show = txt, |
15 Widget = fn nm :: Name => <xml><textbox{nm}/></xml>, | 15 Widget = fn nm :: Name => <xml><textbox{nm}/></xml>, |
16 WidgetPopulated = fn (nm :: Name) n => | 16 WidgetPopulated = fn (nm :: Name) n => |
17 <xml><textbox{nm} value={show _ n}/></xml>, | 17 <xml><textbox{nm} value={show n}/></xml>, |
18 Parse = readError _, | 18 Parse = readError, |
19 Inject = _} | 19 Inject = _} |
20 | 20 |
21 val int = default _ _ _ | 21 val int = default |
22 val float = default _ _ _ | 22 val float = default |
23 val string = default _ _ _ | 23 val string = default |
24 | 24 |
25 fun bool name = {Nam = name, | 25 fun bool name = {Nam = name, |
26 Show = txt _, | 26 Show = txt, |
27 Widget = fn nm :: Name => <xml><checkbox{nm}/></xml>, | 27 Widget = fn nm :: Name => <xml><checkbox{nm}/></xml>, |
28 WidgetPopulated = fn (nm :: Name) b => | 28 WidgetPopulated = fn (nm :: Name) b => |
29 <xml><checkbox{nm} checked={b}/></xml>, | 29 <xml><checkbox{nm} checked={b}/></xml>, |
30 Parse = fn x => x, | 30 Parse = fn x => x, |
31 Inject = _} | 31 Inject = _} |
51 (foldT2R2 [sndTT] [colMeta] | 51 (foldT2R2 [sndTT] [colMeta] |
52 [fn cols => $(mapT2T (fn t :: (Type * Type) => | 52 [fn cols => $(mapT2T (fn t :: (Type * Type) => |
53 sql_exp [] [] [] t.1) cols)] | 53 sql_exp [] [] [] t.1) cols)] |
54 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | 54 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) |
55 [[nm] ~ rest] => | 55 [[nm] ~ rest] => |
56 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) | 56 fn input col acc => acc with nm = @sql_inject col.Inject (col.Parse input)) |
57 {} [M.cols] inputs M.cols | 57 {} [M.cols] inputs M.cols |
58 with #Id = (SQL {id}))); | 58 with #Id = (SQL {id}))); |
59 return <xml><body> | 59 return <xml><body> |
60 Inserted with ID {txt _ id}. | 60 Inserted with ID {[id]}. |
61 </body></xml> | 61 </body></xml> |
62 | 62 |
63 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) = | 63 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) = |
64 () <- dml (update [mapT2T fstTT M.cols] | 64 () <- dml (update [mapT2T fstTT M.cols] |
65 (foldT2R2 [sndTT] [colMeta] | 65 (foldT2R2 [sndTT] [colMeta] |
68 ++ mapT2T fstTT M.cols] | 68 ++ mapT2T fstTT M.cols] |
69 [] [] t.1) cols)] | 69 [] [] t.1) cols)] |
70 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | 70 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) |
71 [[nm] ~ rest] => | 71 [[nm] ~ rest] => |
72 fn input col acc => acc with nm = | 72 fn input col acc => acc with nm = |
73 sql_inject col.Inject (col.Parse input)) | 73 @sql_inject col.Inject (col.Parse input)) |
74 {} [M.cols] inputs M.cols) | 74 {} [M.cols] inputs M.cols) |
75 tab (WHERE T.Id = {id})); | 75 tab (WHERE T.Id = {id})); |
76 return <xml><body> | 76 return <xml><body> |
77 Saved! | 77 Saved! |
78 </body></xml> | 78 </body></xml> |
101 return <xml><body> | 101 return <xml><body> |
102 The deed is done. | 102 The deed is done. |
103 </body></xml> | 103 </body></xml> |
104 | 104 |
105 fun confirm (id : int) = return <xml><body> | 105 fun confirm (id : int) = return <xml><body> |
106 <p>Are you sure you want to delete ID #{txt _ id}?</p> | 106 <p>Are you sure you want to delete ID #{[id]}?</p> |
107 | 107 |
108 <p><a link={delete id}>I was born sure!</a></p> | 108 <p><a link={delete id}>I was born sure!</a></p> |
109 </body></xml> | 109 </body></xml> |
110 | 110 |
111 fun main () = | 111 fun main () = |
112 rows <- queryX (SELECT * FROM tab AS T) | 112 rows <- queryX (SELECT * FROM tab AS T) |
113 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml> | 113 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml> |
114 <tr> | 114 <tr> |
115 <td>{txt _ fs.T.Id}</td> | 115 <td>{[fs.T.Id]}</td> |
116 {foldT2RX2 [fstTT] [colMeta] [tr] | 116 {foldT2RX2 [fstTT] [colMeta] [tr] |
117 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | 117 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) |
118 [[nm] ~ rest] v col => <xml> | 118 [[nm] ~ rest] v col => <xml> |
119 <td>{col.Show v}</td> | 119 <td>{col.Show v}</td> |
120 </xml>) | 120 </xml>) |