Mercurial > urweb

comparison tests/crud.ur @ 370:4f75cc2e1373

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