Mercurial > urweb
comparison tests/crud.ur @ 370:4f75cc2e1373
Fix problem with sig/struct indenting
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 16 Oct 2008 14:52:50 -0400 |
parents | 226c977faa9c |
children | 782ef3ad8c28 |
comparison
equal
deleted
inserted
replaced
369:226c977faa9c | 370:4f75cc2e1373 |
---|---|
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 = _} |
32 | 32 |
33 functor Make(M : sig | 33 functor Make(M : sig |
34 con cols :: {(Type * Type)} | 34 con cols :: {(Type * Type)} |
35 constraint [Id] ~ cols | 35 constraint [Id] ~ cols |
36 val tab : sql_table ([Id = int] ++ mapT2T fstTT cols) | 36 val tab : sql_table ([Id = int] ++ mapT2T fstTT cols) |
37 | 37 |
38 val title : string | 38 val title : string |
39 | 39 |
40 val cols : colsMeta cols | 40 val cols : colsMeta cols |
41 end) = struct | 41 end) = struct |
42 | 42 |
43 open constraints M | 43 open constraints M |
44 val tab = M.tab | 44 val tab = M.tab |
45 | 45 |
46 sequence seq | 46 sequence seq |
47 | 47 |
48 fun create (inputs : $(mapT2T sndTT M.cols)) = | 48 fun create (inputs : $(mapT2T sndTT M.cols)) = |
49 id <- nextval seq; | 49 id <- nextval seq; |
50 () <- dml (insert tab | 50 () <- dml (insert tab |
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 {txt _ id}. |
61 </body></xml> | |
62 | |
63 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) = | |
64 () <- dml (update [mapT2T fstTT M.cols] | |
65 (foldT2R2 [sndTT] [colMeta] | |
66 [fn cols => $(mapT2T (fn t :: (Type * Type) => | |
67 sql_exp [T = [Id = int] | |
68 ++ mapT2T fstTT M.cols] | |
69 [] [] t.1) cols)] | |
70 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | |
71 [[nm] ~ rest] => | |
72 fn input col acc => acc with nm = | |
73 sql_inject col.Inject (col.Parse input)) | |
74 {} [M.cols] inputs M.cols) | |
75 tab (WHERE T.Id = {id})); | |
76 return <xml><body> | |
77 Saved! | |
78 </body></xml> | |
79 | |
80 fun update (id : int) = | |
81 fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id}); | |
82 case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of | |
83 None => return <xml><body>Not found!</body></xml> | |
84 | Some fs => return <xml><body><form> | |
85 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] | |
86 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | |
87 [[nm] ~ rest] (v : t.1) (col : colMeta t) | |
88 (acc : xml form [] (mapT2T sndTT rest)) => | |
89 <xml> | |
90 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> | |
91 {useMore acc} | |
92 </xml>) | |
93 <xml/> | |
94 [M.cols] fs.Tab M.cols} | |
95 | |
96 <submit action={save id}/> | |
97 </form></body></xml> | |
98 | |
99 fun delete (id : int) = | |
100 () <- dml (DELETE FROM tab WHERE Id = {id}); | |
101 return <xml><body> | |
102 The deed is done. | |
103 </body></xml> | |
104 | |
105 fun confirm (id : int) = return <xml><body> | |
106 <p>Are you sure you want to delete ID #{txt _ id}?</p> | |
107 | |
108 <p><a link={delete id}>I was born sure!</a></p> | |
61 </body></xml> | 109 </body></xml> |
62 | 110 |
63 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) = | 111 fun main () = |
64 () <- dml (update [mapT2T fstTT M.cols] | 112 rows <- queryX (SELECT * FROM tab AS T) |
65 (foldT2R2 [sndTT] [colMeta] | 113 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml> |
66 [fn cols => $(mapT2T (fn t :: (Type * Type) => | 114 <tr> |
67 sql_exp [T = [Id = int] | 115 <td>{txt _ fs.T.Id}</td> |
68 ++ mapT2T fstTT M.cols] | 116 {foldT2RX2 [fstTT] [colMeta] [tr] |
69 [] [] t.1) cols)] | 117 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) |
70 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | 118 [[nm] ~ rest] v col => <xml> |
71 [[nm] ~ rest] => | 119 <td>{col.Show v}</td> |
72 fn input col acc => acc with nm = | 120 </xml>) |
73 sql_inject col.Inject (col.Parse input)) | 121 [M.cols] (fs.T -- #Id) M.cols} |
74 {} [M.cols] inputs M.cols) | 122 <td> |
75 tab (WHERE T.Id = {id})); | 123 <a link={update fs.T.Id}>[Update]</a> |
76 return <xml><body> | 124 <a link={confirm fs.T.Id}>[Delete]</a> |
77 Saved! | 125 </td> |
78 </body></xml> | 126 </tr> |
127 </xml>); | |
128 return <xml><head> | |
129 <title>{cdata M.title}</title> | |
130 </head><body> | |
79 | 131 |
80 fun update (id : int) = | 132 <h1>{cdata M.title}</h1> |
81 fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id}); | |
82 case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of | |
83 None => return <xml><body>Not found!</body></xml> | |
84 | Some fs => return <xml><body><form> | |
85 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] | |
86 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | |
87 [[nm] ~ rest] (v : t.1) (col : colMeta t) | |
88 (acc : xml form [] (mapT2T sndTT rest)) => | |
89 <xml> | |
90 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> | |
91 {useMore acc} | |
92 </xml>) | |
93 <xml/> | |
94 [M.cols] fs.Tab M.cols} | |
95 | 133 |
96 <submit action={save id}/> | 134 <table border={1}> |
97 </form></body></xml> | 135 <tr> |
136 <th>ID</th> | |
137 {foldT2RX [colMeta] [tr] | |
138 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | |
139 [[nm] ~ rest] col => <xml> | |
140 <th>{cdata col.Nam}</th> | |
141 </xml>) | |
142 [M.cols] M.cols} | |
143 </tr> | |
144 {rows} | |
145 </table> | |
98 | 146 |
99 fun delete (id : int) = | 147 <br/> |
100 () <- dml (DELETE FROM tab WHERE Id = {id}); | |
101 return <xml><body> | |
102 The deed is done. | |
103 </body></xml> | |
104 | 148 |
105 fun confirm (id : int) = return <xml><body> | 149 <form> |
106 <p>Are you sure you want to delete ID #{txt _ id}?</p> | 150 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] |
107 | 151 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) |
108 <p><a link={delete id}>I was born sure!</a></p> | 152 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml> |
109 </body></xml> | 153 <li> {cdata col.Nam}: {col.Widget [nm]}</li> |
110 | 154 {useMore acc} |
111 fun main () = | 155 </xml>) |
112 rows <- queryX (SELECT * FROM tab AS T) | 156 <xml/> |
113 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml> | 157 [M.cols] M.cols} |
114 <tr> | 158 |
115 <td>{txt _ fs.T.Id}</td> | 159 <submit action={create}/> |
116 {foldT2RX2 [fstTT] [colMeta] [tr] | 160 </form> |
117 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | 161 </body></xml> |
118 [[nm] ~ rest] v col => <xml> | |
119 <td>{col.Show v}</td> | |
120 </xml>) | |
121 [M.cols] (fs.T -- #Id) M.cols} | |
122 <td> | |
123 <a link={update fs.T.Id}>[Update]</a> | |
124 <a link={confirm fs.T.Id}>[Delete]</a> | |
125 </td> | |
126 </tr> | |
127 </xml>); | |
128 return <xml><head> | |
129 <title>{cdata M.title}</title> | |
130 </head><body> | |
131 | |
132 <h1>{cdata M.title}</h1> | |
133 | |
134 <table border={1}> | |
135 <tr> | |
136 <th>ID</th> | |
137 {foldT2RX [colMeta] [tr] | |
138 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | |
139 [[nm] ~ rest] col => <xml> | |
140 <th>{cdata col.Nam}</th> | |
141 </xml>) | |
142 [M.cols] M.cols} | |
143 </tr> | |
144 {rows} | |
145 </table> | |
146 | |
147 <br/> | |
148 | |
149 <form> | |
150 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] | |
151 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | |
152 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml> | |
153 <li> {cdata col.Nam}: {col.Widget [nm]}</li> | |
154 {useMore acc} | |
155 </xml>) | |
156 <xml/> | |
157 [M.cols] M.cols} | |
158 | |
159 <submit action={create}/> | |
160 </form> | |
161 </body></xml> | |
162 | 162 |
163 end | 163 end |