Mercurial > urweb

comparison tests/crud.ur @ 369:226c977faa9c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Crud indented properly, except for <xml>...</xml> outside parens and sig/struct
author Adam Chlipala <adamc@hcoop.net>
date Thu, 16 Oct 2008 14:40:28 -0400
parents b6be16792584
children 4f75cc2e1373
comparison
equal deleted inserted replaced
368:b6be16792584 369:226c977faa9c
1 con colMeta = fn t_formT :: (Type * Type) => { 1 con colMeta = fn t_formT :: (Type * Type) => {
2 Nam : string, 2 Nam : string,
3 Show : t_formT.1 -> xbody, 3 Show : t_formT.1 -> xbody,
4 Widget : nm :: Name -> xml form [] [nm = t_formT.2], 4 Widget : nm :: Name -> xml form [] [nm = t_formT.2],
5 WidgetPopulated : nm :: Name -> t_formT.1 -> xml form [] [nm = t_formT.2], 5 WidgetPopulated : nm :: Name -> t_formT.1 -> xml form [] [nm = t_formT.2],
6 Parse : t_formT.2 -> t_formT.1, 6 Parse : t_formT.2 -> t_formT.1,
7 Inject : sql_injectable t_formT.1 7 Inject : sql_injectable t_formT.1
8 } 8 }
9 con colsMeta = fn cols :: {(Type * Type)} => $(Top.mapT2T colMeta cols) 9 con colsMeta = fn cols :: {(Type * Type)} => $(Top.mapT2T colMeta cols)
10 10
11 fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t) 11 fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t)
12 name : colMeta (t, string) = 12 name : colMeta (t, string) =
13 {Nam = name, 13 {Nam = name,
14 Show = txt _, 14 Show = txt _,
15 Widget = fn nm :: Name => (<xml><textbox{nm}/></xml>), 15 Widget = fn nm :: Name => (<xml><textbox{nm}/></xml>),
16 WidgetPopulated = fn (nm :: Name) n => 16 WidgetPopulated = fn (nm :: Name) n =>
17 (<xml><textbox{nm} value={show _ n}/></xml>), 17 (<xml><textbox{nm} value={show _ n}/></xml>),
18 Parse = readError _,e 18 Parse = readError _,
19 Inject = _} 19 Inject = _}
20 20
21 val int = default _ _ _ 21 val int = default _ _ _
22 val float = default _ _ _ 22 val float = default _ _ _
23 val string = default _ _ _ 23 val string = default _ _ _
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
62 62
63 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) = 63 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) =
64 () <- dml (update [mapT2T fstTT M.cols] 64 () <- dml (update [mapT2T fstTT M.cols]
65 (foldT2R2 [sndTT] [colMeta] 65 (foldT2R2 [sndTT] [colMeta]
66 [fn cols => $(mapT2T (fn t :: (Type * Type) => 66 [fn cols => $(mapT2T (fn t :: (Type * Type) =>
67 sql_exp [T = [Id = int] ++ mapT2T fstTT M.cols] [] [] t.1) cols)] 67 sql_exp [T = [Id = int]
68 ++ mapT2T fstTT M.cols]
69 [] [] t.1) cols)]
68 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 70 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
69 [[nm] ~ rest] => 71 [[nm] ~ rest] =>
70 fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) 72 fn input col acc => acc with nm =
73 sql_inject col.Inject (col.Parse input))
71 {} [M.cols] inputs M.cols) 74 {} [M.cols] inputs M.cols)
72 tab (WHERE T.Id = {id})); 75 tab (WHERE T.Id = {id}));
73 return <xml><body> 76 return <xml><body>
74 Saved! 77 Saved!
75 </body></xml> 78 </body></xml>
77 fun update (id : int) = 80 fun update (id : int) =
78 fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id}); 81 fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id});
79 case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of 82 case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of
80 None => return <xml><body>Not found!</body></xml> 83 None => return <xml><body>Not found!</body></xml>
81 | Some fs => return <xml><body><form> 84 | Some fs => return <xml><body><form>
82 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] 85 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
83 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 86 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
84 [[nm] ~ rest] (v : t.1) (col : colMeta t) 87 [[nm] ~ rest] (v : t.1) (col : colMeta t)
85 (acc : xml form [] (mapT2T sndTT rest)) => 88 (acc : xml form [] (mapT2T sndTT rest)) =>
86 <xml> 89 <xml>
87 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> 90 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
88 {useMore acc} 91 {useMore acc}
89 </xml>) 92 </xml>)
90 <xml/> 93 <xml/>
91 [M.cols] fs.Tab M.cols} 94 [M.cols] fs.Tab M.cols}
92 95
93 <submit action={save id}/> 96 <submit action={save id}/>
94 </form></body></xml> 97 </form></body></xml>
95 98
96 fun delete (id : int) = 99 fun delete (id : int) =
97 () <- dml (DELETE FROM tab WHERE Id = {id}); 100 () <- dml (DELETE FROM tab WHERE Id = {id});
98 return <xml><body> 101 return <xml><body>
99 The deed is done. 102 The deed is done.
100 </body></xml> 103 </body></xml>
101 104
102 fun confirm (id : int) = return <xml><body> 105 fun confirm (id : int) = return <xml><body>
103 <p>Are you sure you want to delete ID #{txt _ id}?</p> 106 <p>Are you sure you want to delete ID #{txt _ id}?</p>
104 107
105 <p><a link={delete id}>I was born sure!</a></p> 108 <p><a link={delete id}>I was born sure!</a></p>
106 </body></xml> 109 </body></xml>
107 110
108 fun main () = 111 fun main () =
109 rows <- queryX (SELECT * FROM tab AS T) 112 rows <- queryX (SELECT * FROM tab AS T)
110 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml> 113 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml>
111 <tr> 114 <tr>
112 <td>{txt _ fs.T.Id}</td> 115 <td>{txt _ fs.T.Id}</td>
113 {foldT2RX2 [fstTT] [colMeta] [tr] 116 {foldT2RX2 [fstTT] [colMeta] [tr]
114 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 117 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
115 [[nm] ~ rest] v col => <xml> 118 [[nm] ~ rest] v col => <xml>
116 <td>{col.Show v}</td> 119 <td>{col.Show v}</td>
117 </xml>) 120 </xml>)
118 [M.cols] (fs.T -- #Id) M.cols} 121 [M.cols] (fs.T -- #Id) M.cols}
119 <td><a link={update fs.T.Id}>[Update]</a> <a link={confirm fs.T.Id}>[Delete]</a></td> 122 <td>
120 </tr> 123 <a link={update fs.T.Id}>[Update]</a>
121 </xml>); 124 <a link={confirm fs.T.Id}>[Delete]</a>
125 </td>
126 </tr>
127 </xml>);
122 return <xml><head> 128 return <xml><head>
123 <title>{cdata M.title}</title> 129 <title>{cdata M.title}</title>
124
125 </head><body> 130 </head><body>
126 131
127 <h1>{cdata M.title}</h1> 132 <h1>{cdata M.title}</h1>
128 133
129 <table border={1}> 134 <table border={1}>
130 <tr> 135 <tr>
131 <th>ID</th> 136 <th>ID</th>
132 {foldT2RX [colMeta] [tr] 137 {foldT2RX [colMeta] [tr]
133 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 138 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
134 [[nm] ~ rest] col => <xml> 139 [[nm] ~ rest] col => <xml>
135 <th>{cdata col.Nam}</th> 140 <th>{cdata col.Nam}</th>
136 </xml>) 141 </xml>)
137 [M.cols] M.cols} 142 [M.cols] M.cols}
138 </tr> 143 </tr>
139 {rows} 144 {rows}
140 </table> 145 </table>
141 146
142 <br/> 147 <br/>
143 148
144 <form> 149 <form>
145 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] 150 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
146 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 151 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
147 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml> 152 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml>
148 <li> {cdata col.Nam}: {col.Widget [nm]}</li> 153 <li> {cdata col.Nam}: {col.Widget [nm]}</li>
149 {useMore acc} 154 {useMore acc}
150 </xml>) 155 </xml>)
151 <xml/> 156 <xml/>
152 [M.cols] M.cols} 157 [M.cols] M.cols}
153 158
154 <submit action={create}/> 159 <submit action={create}/>
155 </form> 160 </form>
156 </body></xml> 161 </body></xml>
157 162
158 end 163 end