Mercurial > urweb

comparison tests/crud.ur @ 367:28d3d7210687

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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