Mercurial > urweb

comparison demo/crud.ur @ 1093:8d3aa6c7cee0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 bb3fc575cfe7
children ad15700272f6
comparison
equal deleted inserted replaced
1092:6f4b05fc4361 1093:8d3aa6c7cee0
48 fun list () = 48 fun list () =
49 rows <- queryX (SELECT * FROM tab AS T) 49 rows <- queryX (SELECT * FROM tab AS T)
50 (fn (fs : {T : $([Id = int] ++ map fst M.cols)}) => <xml> 50 (fn (fs : {T : $([Id = int] ++ map fst M.cols)}) => <xml>
51 <tr> 51 <tr>
52 <td>{[fs.T.Id]}</td> 52 <td>{[fs.T.Id]}</td>
53 {foldRX2 [fst] [colMeta] [tr] 53 {@foldRX2 [fst] [colMeta] [tr]
54 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] 54 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
55 [[nm] ~ rest] v col => <xml> 55 [[nm] ~ rest] v col => <xml>
56 <td>{col.Show v}</td> 56 <td>{col.Show v}</td>
57 </xml>) 57 </xml>)
58 [M.cols] M.fl (fs.T -- #Id) M.cols} 58 M.fl (fs.T -- #Id) M.cols}
59 <td> 59 <td>
60 <a link={upd fs.T.Id}>[Update]</a> 60 <a link={upd fs.T.Id}>[Update]</a>
61 <a link={confirm fs.T.Id}>[Delete]</a> 61 <a link={confirm fs.T.Id}>[Delete]</a>
62 </td> 62 </td>
63 </tr> 63 </tr>
64 </xml>); 64 </xml>);
65 return <xml> 65 return <xml>
66 <table border={1}> 66 <table border={1}>
67 <tr> 67 <tr>
68 <th>ID</th> 68 <th>ID</th>
69 {foldRX [colMeta] [tr] 69 {@foldRX [colMeta] [tr]
70 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] 70 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
71 [[nm] ~ rest] col => <xml> 71 [[nm] ~ rest] col => <xml>
72 <th>{cdata col.Nam}</th> 72 <th>{cdata col.Nam}</th>
73 </xml>) 73 </xml>)
74 [M.cols] M.fl M.cols} 74 M.fl M.cols}
75 </tr> 75 </tr>
76 {rows} 76 {rows}
77 </table> 77 </table>
78 78
79 <br/><hr/><br/> 79 <br/><hr/><br/>
80 80
81 <form> 81 <form>
82 {foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)] 82 {@foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
83 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] 83 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
84 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map snd rest)) => <xml> 84 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map snd rest)) => <xml>
85 <li> {cdata col.Nam}: {col.Widget [nm]}</li> 85 <li> {cdata col.Nam}: {col.Widget [nm]}</li>
86 {useMore acc} 86 {useMore acc}
87 </xml>) 87 </xml>)
88 <xml/> 88 <xml/>
89 [M.cols] M.fl M.cols} 89 M.fl M.cols}
90 90
91 <submit action={create}/> 91 <submit action={create}/>
92 </form> 92 </form>
93 </xml> 93 </xml>
94 94
95 and create (inputs : $(map snd M.cols)) = 95 and create (inputs : $(map snd M.cols)) =
96 id <- nextval seq; 96 id <- nextval seq;
97 dml (insert tab 97 dml (insert tab
98 (foldR2 [snd] [colMeta] 98 (@foldR2 [snd] [colMeta]
99 [fn cols => $(map (fn t :: (Type * Type) => 99 [fn cols => $(map (fn t :: (Type * Type) =>
100 sql_exp [] [] [] t.1) cols)] 100 sql_exp [] [] [] t.1) cols)]
101 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] 101 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
102 [[nm] ~ rest] => 102 [[nm] ~ rest] =>
103 fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)}) 103 fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)})
104 {} [M.cols] M.fl inputs M.cols 104 {} M.fl inputs M.cols
105 ++ {Id = (SQL {[id]})})); 105 ++ {Id = (SQL {[id]})}));
106 ls <- list (); 106 ls <- list ();
107 return <xml><body> 107 return <xml><body>
108 <p>Inserted with ID {[id]}.</p> 108 <p>Inserted with ID {[id]}.</p>
109 109
111 </body></xml> 111 </body></xml>
112 112
113 and upd (id : int) = 113 and upd (id : int) =
114 let 114 let
115 fun save (inputs : $(map snd M.cols)) = 115 fun save (inputs : $(map snd M.cols)) =
116 dml (update [map fst M.cols] ! 116 dml (update [map fst M.cols]
117 (foldR2 [snd] [colMeta] 117 (@foldR2 [snd] [colMeta]
118 [fn cols => $(map (fn t :: (Type * Type) => 118 [fn cols => $(map (fn t :: (Type * Type) =>
119 sql_exp [T = [Id = int] 119 sql_exp [T = [Id = int]
120 ++ map fst M.cols] 120 ++ map fst M.cols]
121 [] [] t.1) cols)] 121 [] [] t.1) cols)]
122 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] 122 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
123 [[nm] ~ rest] => 123 [[nm] ~ rest] =>
124 fn input col acc => acc ++ {nm = 124 fn input col acc => acc ++ {nm =
125 @sql_inject col.Inject (col.Parse input)}) 125 @sql_inject col.Inject (col.Parse input)})
126 {} [M.cols] M.fl inputs M.cols) 126 {} M.fl inputs M.cols)
127 tab (WHERE T.Id = {[id]})); 127 tab (WHERE T.Id = {[id]}));
128 ls <- list (); 128 ls <- list ();
129 return <xml><body> 129 return <xml><body>
130 <p>Saved!</p> 130 <p>Saved!</p>
131 131
134 in 134 in
135 fso <- oneOrNoRows (SELECT tab.{{map fst M.cols}} FROM tab WHERE tab.Id = {[id]}); 135 fso <- oneOrNoRows (SELECT tab.{{map fst M.cols}} FROM tab WHERE tab.Id = {[id]});
136 case fso : (Basis.option {Tab : $(map fst M.cols)}) of 136 case fso : (Basis.option {Tab : $(map fst M.cols)}) of
137 None => return <xml><body>Not found!</body></xml> 137 None => return <xml><body>Not found!</body></xml>
138 | Some fs => return <xml><body><form> 138 | Some fs => return <xml><body><form>
139 {foldR2 [fst] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)] 139 {@foldR2 [fst] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
140 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] 140 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
141 [[nm] ~ rest] (v : t.1) (col : colMeta t) 141 [[nm] ~ rest] (v : t.1) (col : colMeta t)
142 (acc : xml form [] (map snd rest)) => 142 (acc : xml form [] (map snd rest)) =>
143 <xml> 143 <xml>
144 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> 144 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
145 {useMore acc} 145 {useMore acc}
146 </xml>) 146 </xml>)
147 <xml/> 147 <xml/>
148 [M.cols] M.fl fs.Tab M.cols} 148 M.fl fs.Tab M.cols}
149 149
150 <submit action={save}/> 150 <submit action={save}/>
151 </form></body></xml> 151 </form></body></xml>
152 end 152 end
153 153