Mercurial > urweb
comparison tests/crud.ur @ 367:28d3d7210687
Improving indentation of XML after antiquote
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 16 Oct 2008 13:30:40 -0400 |
parents | 24a31b35e08f |
children | b6be16792584 |
comparison
equal
deleted
inserted
replaced
366:3004f8843e36 | 367:28d3d7210687 |
---|---|
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 (foldT2R2 [sndTT] [colMeta] | 50 () <- dml (insert tab |
51 [fn cols => $(mapT2T (fn t :: (Type * Type) => | 51 (foldT2R2 [sndTT] [colMeta] |
52 sql_exp [] [] [] t.1) cols)] | 52 [fn cols => $(mapT2T (fn t :: (Type * Type) => |
53 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | 53 sql_exp [] [] [] t.1) cols)] |
54 [[nm] ~ rest] => | 54 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) |
55 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) | 55 [[nm] ~ rest] => |
56 {} [M.cols] inputs M.cols | 56 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) |
57 with #Id = (SQL {id}))); | 57 {} [M.cols] inputs M.cols |
58 return <xml><body> | 58 with #Id = (SQL {id}))); |
59 Inserted with ID {txt _ id}. | 59 return <xml><body> |
60 </body></xml> | 60 Inserted with ID {txt _ id}. |
61 </body></xml> | |
61 | 62 |
62 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) = | 63 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) = |
63 () <- dml (update [mapT2T fstTT M.cols] (foldT2R2 [sndTT] [colMeta] | 64 () <- dml (update [mapT2T fstTT M.cols] |
64 [fn cols => $(mapT2T (fn t :: (Type * Type) => | 65 (foldT2R2 [sndTT] [colMeta] |
65 sql_exp [T = [Id = int] ++ mapT2T fstTT M.cols] [] [] t.1) cols)] | 66 [fn cols => $(mapT2T (fn t :: (Type * Type) => |
66 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | 67 sql_exp [T = [Id = int] ++ mapT2T fstTT M.cols] [] [] t.1) cols)] |
67 [[nm] ~ rest] => | 68 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) |
68 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) | 69 [[nm] ~ rest] => |
69 {} [M.cols] inputs M.cols) | 70 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) |
70 tab (WHERE T.Id = {id})); | 71 {} [M.cols] inputs M.cols) |
71 return <xml><body> | 72 tab (WHERE T.Id = {id})); |
72 Saved! | 73 return <xml><body> |
73 </body></xml> | 74 Saved! |
75 </body></xml> | |
74 | 76 |
75 fun update (id : int) = | 77 fun update (id : int) = |
76 fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id}); | 78 fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id}); |
77 case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of | 79 case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of |
78 None => return <xml><body>Not found!</body></xml> | 80 None => return <xml><body>Not found!</body></xml> |
79 | Some fs => return <xml><body><form> | 81 | Some fs => return <xml><body><form> |
80 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] | 82 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] |
81 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | 83 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) |
82 [[nm] ~ rest] (v : t.1) (col : colMeta t) | 84 [[nm] ~ rest] (v : t.1) (col : colMeta t) |
83 (acc : xml form [] (mapT2T sndTT rest)) => | 85 (acc : xml form [] (mapT2T sndTT rest)) => |
84 <xml> | 86 <xml> |
85 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> | 87 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> |
86 {useMore acc} | 88 {useMore acc} |
87 </xml>) | 89 </xml>) |
88 <xml/> | 90 <xml/> |
89 [M.cols] fs.Tab M.cols} | 91 [M.cols] fs.Tab M.cols} |
90 | 92 |
91 <submit action={save id}/> | 93 <submit action={save id}/> |
92 </form></body></xml> | 94 </form></body></xml> |
93 | 95 |
94 fun delete (id : int) = | 96 fun delete (id : int) = |
95 () <- dml (DELETE FROM tab WHERE Id = {id}); | 97 () <- dml (DELETE FROM tab WHERE Id = {id}); |
96 return <xml><body> | 98 return <xml><body> |
97 The deed is done. | 99 The deed is done. |
98 </body></xml> | 100 </body></xml> |
99 | 101 |
100 fun confirm (id : int) = return <xml><body> | 102 fun confirm (id : int) = return <xml><body> |
101 <p>Are you sure you want to delete ID #{txt _ id}?</p> | 103 <p>Are you sure you want to delete ID #{txt _ id}?</p> |
102 | 104 |
103 <p><a link={delete id}>I was born sure!</a></p> | 105 <p><a link={delete id}>I was born sure!</a></p> |
104 </body></xml> | 106 </body></xml> |
105 | 107 |
106 fun main () = | 108 fun main () = |
107 rows <- queryX (SELECT * FROM tab AS T) | 109 rows <- queryX (SELECT * FROM tab AS T) |
108 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml> | 110 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml> |
109 <tr> | 111 <tr> |
110 <td>{txt _ fs.T.Id}</td> | 112 <td>{txt _ fs.T.Id}</td> |
111 {foldT2RX2 [fstTT] [colMeta] [tr] | 113 {foldT2RX2 [fstTT] [colMeta] [tr] |
112 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | 114 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) |
113 [[nm] ~ rest] v col => <xml> | 115 [[nm] ~ rest] v col => <xml> |
114 <td>{col.Show v}</td> | 116 <td>{col.Show v}</td> |
115 </xml>) | 117 </xml>) |
116 [M.cols] (fs.T -- #Id) M.cols} | 118 [M.cols] (fs.T -- #Id) M.cols} |
117 <td><a link={update fs.T.Id}>[Update]</a> <a link={confirm fs.T.Id}>[Delete]</a></td> | 119 <td><a link={update fs.T.Id}>[Update]</a> <a link={confirm fs.T.Id}>[Delete]</a></td> |
118 </tr> | 120 </tr> |
119 </xml>); | 121 </xml>); |
120 return <xml><head> | 122 return <xml><head> |
121 <title>{cdata M.title}</title> | 123 <title>{cdata M.title}</title> |
122 | 124 |
123 </head><body> | 125 </head><body> |
124 | 126 |
125 <h1>{cdata M.title}</h1> | 127 <h1>{cdata M.title}</h1> |
126 | 128 |
127 <table border={1}> | 129 <table border={1}> |
128 <tr> | 130 <tr> |
129 <th>ID</th> | 131 <th>ID</th> |
130 {foldT2RX [colMeta] [tr] | 132 {foldT2RX [colMeta] [tr] |
131 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | 133 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) |
132 [[nm] ~ rest] col => <xml> | 134 [[nm] ~ rest] col => <xml> |
133 <th>{cdata col.Nam}</th> | 135 <th>{cdata col.Nam}</th> |
134 </xml>) | 136 </xml>) |
135 [M.cols] M.cols} | 137 [M.cols] M.cols} |
136 </tr> | 138 </tr> |
137 {rows} | 139 {rows} |
138 </table> | 140 </table> |
139 | 141 |
140 <br/> | 142 <br/> |
141 | 143 |
142 <form> | 144 <form> |
143 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] | 145 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] |
144 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) | 146 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) |
145 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml> | 147 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml> |
146 <li> {cdata col.Nam}: {col.Widget [nm]}</li> | 148 <li> {cdata col.Nam}: {col.Widget [nm]}</li> |
147 {useMore acc} | 149 {useMore acc} |
148 </xml>) | 150 </xml>) |
149 <xml/> | 151 <xml/> |
150 [M.cols] M.cols} | 152 [M.cols] M.cols} |
151 | 153 |
152 <submit action={create}/> | 154 <submit action={create}/> |
153 </form> | 155 </form> |
154 </body></xml> | 156 </body></xml> |
155 | 157 |
156 end | 158 end |