Mercurial > urweb

comparison demo/crud.ur @ 632:6c4643880df5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Demos compile again, with manual folders
author Adam Chlipala <adamc@hcoop.net>
date Tue, 24 Feb 2009 15:12:13 -0500
parents d64533157f40
children 24fd1edfcaa3
comparison
equal deleted inserted replaced
631:effa7d43aac3 632:6c4643880df5
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 fl : folder cols
37
36 val tab : sql_table ([Id = int] ++ map fstTT cols) 38 val tab : sql_table ([Id = int] ++ map fstTT cols)
37 39
38 val title : string 40 val title : string
39 41
40 val cols : colsMeta cols 42 val cols : colsMeta cols
48 fun list () = 50 fun list () =
49 rows <- queryX (SELECT * FROM tab AS T) 51 rows <- queryX (SELECT * FROM tab AS T)
50 (fn (fs : {T : $([Id = int] ++ map fstTT M.cols)}) => <xml> 52 (fn (fs : {T : $([Id = int] ++ map fstTT M.cols)}) => <xml>
51 <tr> 53 <tr>
52 <td>{[fs.T.Id]}</td> 54 <td>{[fs.T.Id]}</td>
53 {foldT2RX2 [fstTT] [colMeta] [tr] 55 {foldRX2 [fstTT] [colMeta] [tr]
54 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 56 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
55 [[nm] ~ rest] v col => <xml> 57 [[nm] ~ rest] v col => <xml>
56 <td>{col.Show v}</td> 58 <td>{col.Show v}</td>
57 </xml>) 59 </xml>)
58 [M.cols] (fs.T -- #Id) M.cols} 60 [M.cols] M.fl (fs.T -- #Id) M.cols}
59 <td> 61 <td>
60 <a link={upd fs.T.Id}>[Update]</a> 62 <a link={upd fs.T.Id}>[Update]</a>
61 <a link={confirm fs.T.Id}>[Delete]</a> 63 <a link={confirm fs.T.Id}>[Delete]</a>
62 </td> 64 </td>
63 </tr> 65 </tr>
64 </xml>); 66 </xml>);
65 return <xml> 67 return <xml>
66 <table border={1}> 68 <table border={1}>
67 <tr> 69 <tr>
68 <th>ID</th> 70 <th>ID</th>
69 {foldT2RX [colMeta] [tr] 71 {foldRX [colMeta] [tr]
70 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 72 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
71 [[nm] ~ rest] col => <xml> 73 [[nm] ~ rest] col => <xml>
72 <th>{cdata col.Nam}</th> 74 <th>{cdata col.Nam}</th>
73 </xml>) 75 </xml>)
74 [M.cols] M.cols} 76 [M.cols] M.fl M.cols}
75 </tr> 77 </tr>
76 {rows} 78 {rows}
77 </table> 79 </table>
78 80
79 <br/><hr/><br/> 81 <br/><hr/><br/>
80 82
81 <form> 83 <form>
82 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)] 84 {foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)]
83 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 85 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
84 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map sndTT rest)) => <xml> 86 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map sndTT rest)) => <xml>
85 <li> {cdata col.Nam}: {col.Widget [nm]}</li> 87 <li> {cdata col.Nam}: {col.Widget [nm]}</li>
86 {useMore acc} 88 {useMore acc}
87 </xml>) 89 </xml>)
88 <xml/> 90 <xml/>
89 [M.cols] M.cols} 91 [M.cols] M.fl M.cols}
90 92
91 <submit action={create}/> 93 <submit action={create}/>
92 </form> 94 </form>
93 </xml> 95 </xml>
94 96
95 and create (inputs : $(map sndTT M.cols)) = 97 and create (inputs : $(map sndTT M.cols)) =
96 id <- nextval seq; 98 id <- nextval seq;
97 dml (insert tab 99 dml (insert tab
98 (foldT2R2 [sndTT] [colMeta] 100 (foldR2 [sndTT] [colMeta]
99 [fn cols => $(map (fn t :: (Type * Type) => 101 [fn cols => $(map (fn t :: (Type * Type) =>
100 sql_exp [] [] [] t.1) cols)] 102 sql_exp [] [] [] t.1) cols)]
101 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 103 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
102 [[nm] ~ rest] => 104 [[nm] ~ rest] =>
103 fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)}) 105 fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)})
104 {} [M.cols] inputs M.cols 106 {} [M.cols] M.fl inputs M.cols
105 ++ {Id = (SQL {[id]})})); 107 ++ {Id = (SQL {[id]})}));
106 ls <- list (); 108 ls <- list ();
107 return <xml><body> 109 return <xml><body>
108 <p>Inserted with ID {[id]}.</p> 110 <p>Inserted with ID {[id]}.</p>
109 111
111 </body></xml> 113 </body></xml>
112 114
113 and upd (id : int) = 115 and upd (id : int) =
114 let 116 let
115 fun save (inputs : $(map sndTT M.cols)) = 117 fun save (inputs : $(map sndTT M.cols)) =
116 dml (update [map fstTT M.cols] 118 dml (update [map fstTT M.cols] !
117 (foldT2R2 [sndTT] [colMeta] 119 (foldR2 [sndTT] [colMeta]
118 [fn cols => $(map (fn t :: (Type * Type) => 120 [fn cols => $(map (fn t :: (Type * Type) =>
119 sql_exp [T = [Id = int] 121 sql_exp [T = [Id = int]
120 ++ map fstTT M.cols] 122 ++ map fstTT M.cols]
121 [] [] t.1) cols)] 123 [] [] t.1) cols)]
122 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 124 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
123 [[nm] ~ rest] => 125 [[nm] ~ rest] =>
124 fn input col acc => acc ++ {nm = 126 fn input col acc => acc ++ {nm =
125 @sql_inject col.Inject (col.Parse input)}) 127 @sql_inject col.Inject (col.Parse input)})
126 {} [M.cols] inputs M.cols) 128 {} [M.cols] M.fl inputs M.cols)
127 tab (WHERE T.Id = {[id]})); 129 tab (WHERE T.Id = {[id]}));
128 ls <- list (); 130 ls <- list ();
129 return <xml><body> 131 return <xml><body>
130 <p>Saved!</p> 132 <p>Saved!</p>
131 133
134 in 136 in
135 fso <- oneOrNoRows (SELECT tab.{{map fstTT M.cols}} FROM tab WHERE tab.Id = {[id]}); 137 fso <- oneOrNoRows (SELECT tab.{{map fstTT M.cols}} FROM tab WHERE tab.Id = {[id]});
136 case fso : (Basis.option {Tab : $(map fstTT M.cols)}) of 138 case fso : (Basis.option {Tab : $(map fstTT M.cols)}) of
137 None => return <xml><body>Not found!</body></xml> 139 None => return <xml><body>Not found!</body></xml>
138 | Some fs => return <xml><body><form> 140 | Some fs => return <xml><body><form>
139 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)] 141 {foldR2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)]
140 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 142 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
141 [[nm] ~ rest] (v : t.1) (col : colMeta t) 143 [[nm] ~ rest] (v : t.1) (col : colMeta t)
142 (acc : xml form [] (map sndTT rest)) => 144 (acc : xml form [] (map sndTT rest)) =>
143 <xml> 145 <xml>
144 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> 146 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
145 {useMore acc} 147 {useMore acc}
146 </xml>) 148 </xml>)
147 <xml/> 149 <xml/>
148 [M.cols] fs.Tab M.cols} 150 [M.cols] M.fl fs.Tab M.cols}
149 151
150 <submit action={save}/> 152 <submit action={save}/>
151 </form></body></xml> 153 </form></body></xml>
152 end 154 end
153 155