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>)