Mercurial > urweb

comparison tests/crud.ur @ 360:c1e96b387115

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Syntax highlighting for embedded XML
author Adam Chlipala <adamc@hcoop.net>
date Tue, 14 Oct 2008 16:37:43 -0400
parents a94a79820d49
children 260b680a6a04
comparison
equal deleted inserted replaced
359:465593c024ca 360:c1e96b387115
26 fun create (inputs : $(mapT2T sndTT M.cols)) = 26 fun create (inputs : $(mapT2T sndTT M.cols)) =
27 id <- nextval seq; 27 id <- nextval seq;
28 () <- dml (insert tab (foldT2R2 [sndTT] [colMeta] 28 () <- dml (insert tab (foldT2R2 [sndTT] [colMeta]
29 [fn cols => $(mapT2T (fn t :: (Type * Type) => 29 [fn cols => $(mapT2T (fn t :: (Type * Type) =>
30 sql_exp [] [] [] t.1) cols)] 30 sql_exp [] [] [] t.1) cols)]
31 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => 31 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
32 [[nm] ~ rest] => 32 [[nm] ~ rest] =>
33 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) 33 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input))
34 {} [M.cols] inputs M.cols 34 {} [M.cols] inputs M.cols
35 with #Id = (SQL {id}))); 35 with #Id = (SQL {id})));
36 return <html><body> 36 return <xml><body>
37 Inserted with ID {txt _ id}. 37 Inserted with ID {txt _ id}.
38 </body></html> 38 </body></xml>
39 39
40 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) = 40 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) =
41 () <- dml (update [mapT2T fstTT M.cols] (foldT2R2 [sndTT] [colMeta] 41 () <- dml (update [mapT2T fstTT M.cols] (foldT2R2 [sndTT] [colMeta]
42 [fn cols => $(mapT2T (fn t :: (Type * Type) => 42 [fn cols => $(mapT2T (fn t :: (Type * Type) =>
43 sql_exp [T = [Id = int] ++ mapT2T fstTT M.cols] [] [] t.1) cols)] 43 sql_exp [T = [Id = int] ++ mapT2T fstTT M.cols] [] [] t.1) cols)]
44 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => 44 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
45 [[nm] ~ rest] => 45 [[nm] ~ rest] =>
46 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) 46 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input))
47 {} [M.cols] inputs M.cols) 47 {} [M.cols] inputs M.cols)
48 tab (WHERE T.Id = {id})); 48 tab (WHERE T.Id = {id}));
49 return <html><body> 49 return <xml><body>
50 Saved! 50 Saved!
51 </body></html> 51 </body></xml>
52 52
53 fun update (id : int) = 53 fun update (id : int) =
54 fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id}); 54 fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id});
55 case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of 55 case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of
56 None => return <html><body>Not found!</body></html> 56 None => return <xml><body>Not found!</body></xml>
57 | Some fs => return <html><body><lform> 57 | Some fs => return <xml><body><lform>
58 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] 58 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
59 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => 59 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
60 [[nm] ~ rest] => 60 [[nm] ~ rest] (v : t.1) (col : colMeta t)
61 fn (v : t.1) (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <lform> 61 (acc : xml form [] (mapT2T sndTT rest)) =>
62 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> 62 <xml>
63 {useMore acc} 63 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
64 </lform>) 64 {useMore acc}
65 <lform></lform> 65 </xml>)
66 <xml/>
66 [M.cols] fs.Tab M.cols} 67 [M.cols] fs.Tab M.cols}
67 68
68 <submit action={save id}/> 69 <submit action={save id}/>
69 </lform></body></html> 70 </lform></body></xml>
70 71
71 fun delete (id : int) = 72 fun delete (id : int) =
72 () <- dml (DELETE FROM tab WHERE Id = {id}); 73 () <- dml (DELETE FROM tab WHERE Id = {id});
73 return <html><body> 74 return <xml><body>
74 The deed is done. 75 The deed is done.
75 </body></html> 76 </body></xml>
76 77
77 fun confirm (id : int) = return <html><body> 78 fun confirm (id : int) = return <xml><body>
78 <p>Are you sure you want to delete ID #{txt _ id}?</p> 79 <p>Are you sure you want to delete ID #{txt _ id}?</p>
79 80
80 <p><a link={delete id}>I was born sure!</a></p> 81 <p><a link={delete id}>I was born sure!</a></p>
81 </body></html> 82 </body></xml>
82 83
83 fun main () = 84 fun main () =
84 rows <- queryX (SELECT * FROM tab AS T) 85 rows <- queryX (SELECT * FROM tab AS T)
85 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <body> 86 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml>
86 <tr> 87 <tr>
87 <td>{txt _ fs.T.Id}</td> 88 <td>{txt _ fs.T.Id}</td>
88 {foldT2RX2 [fstTT] [colMeta] [tr] 89 {foldT2RX2 [fstTT] [colMeta] [tr]
89 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => 90 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
90 [[nm] ~ rest] => 91 [[nm] ~ rest] v col => <xml>
91 fn v col => <tr>
92 <td>{col.Show v}</td> 92 <td>{col.Show v}</td>
93 </tr>) 93 </xml>)
94 [M.cols] (fs.T -- #Id) M.cols} 94 [M.cols] (fs.T -- #Id) M.cols}
95 <td><a link={update fs.T.Id}>[Update]</a> <a link={confirm fs.T.Id}>[Delete]</a></td> 95 <td><a link={update fs.T.Id}>[Update]</a> <a link={confirm fs.T.Id}>[Delete]</a></td>
96 </tr> 96 </tr>
97 </body>); 97 </xml>);
98 return <html><head> 98 return <xml><head>
99 <title>{cdata M.title}</title> 99 <title>{cdata M.title}</title>
100 100
101 </head><body> 101 </head><body>
102 102
103 <h1>{cdata M.title}</h1> 103 <h1>{cdata M.title}</h1>
104 104
105 <table border={1}> 105 <table border={1}>
106 <tr> 106 <tr>
107 <th>ID</th> 107 <th>ID</th>
108 {foldT2RX [colMeta] [tr] 108 {foldT2RX [colMeta] [tr]
109 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => 109 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
110 [[nm] ~ rest] => 110 [[nm] ~ rest] col => <xml>
111 fn col => <tr>
112 <th>{cdata col.Nam}</th> 111 <th>{cdata col.Nam}</th>
113 </tr>) 112 </xml>)
114 [M.cols] M.cols} 113 [M.cols] M.cols}
115 </tr> 114 </tr>
116 {rows} 115 {rows}
117 </table> 116 </table>
118 117
119 <br/> 118 <br/>
120 119
121 <lform> 120 <lform>
122 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] 121 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
123 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) => 122 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
124 [[nm] ~ rest] => 123 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml>
125 fn (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <lform>
126 <li> {cdata col.Nam}: {col.Widget [nm]}</li> 124 <li> {cdata col.Nam}: {col.Widget [nm]}</li>
127 {useMore acc} 125 {useMore acc}
128 </lform>) 126 </xml>)
129 <lform></lform> 127 <xml/>
130 [M.cols] M.cols} 128 [M.cols] M.cols}
131 129
132 <submit action={create}/> 130 <submit action={create}/>
133 </lform> 131 </lform>
134 </body></html> 132 </body></xml>
135 133
136 end 134 end