Mercurial > urweb

comparison demo/crud.ur @ 622:d64533157f40

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Debug reverse-engineering unification
author Adam Chlipala <adamc@hcoop.net>
date Sat, 21 Feb 2009 16:11:56 -0500
parents 12d163bb856f
children 6c4643880df5
comparison
equal deleted inserted replaced
621:8998114760c1 622:d64533157f40
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)} => $(map 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,
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] ++ map 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
45 45
46 sequence seq 46 sequence seq
47 47
48 fun list () = 48 fun list () =
49 rows <- queryX (SELECT * FROM tab AS T) 49 rows <- queryX (SELECT * FROM tab AS T)
50 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml> 50 (fn (fs : {T : $([Id = int] ++ map fstTT M.cols)}) => <xml>
51 <tr> 51 <tr>
52 <td>{[fs.T.Id]}</td> 52 <td>{[fs.T.Id]}</td>
53 {foldT2RX2 [fstTT] [colMeta] [tr] 53 {foldT2RX2 [fstTT] [colMeta] [tr]
54 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 54 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
55 [[nm] ~ rest] v col => <xml> 55 [[nm] ~ rest] v col => <xml>
77 </table> 77 </table>
78 78
79 <br/><hr/><br/> 79 <br/><hr/><br/>
80 80
81 <form> 81 <form>
82 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] 82 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)]
83 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 83 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
84 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml> 84 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map sndTT rest)) => <xml>
85 <li> {cdata col.Nam}: {col.Widget [nm]}</li> 85 <li> {cdata col.Nam}: {col.Widget [nm]}</li>
86 {useMore acc} 86 {useMore acc}
87 </xml>) 87 </xml>)
88 <xml/> 88 <xml/>
89 [M.cols] M.cols} 89 [M.cols] M.cols}
90 90
91 <submit action={create}/> 91 <submit action={create}/>
92 </form> 92 </form>
93 </xml> 93 </xml>
94 94
95 and create (inputs : $(mapT2T sndTT M.cols)) = 95 and create (inputs : $(map sndTT M.cols)) =
96 id <- nextval seq; 96 id <- nextval seq;
97 dml (insert tab 97 dml (insert tab
98 (foldT2R2 [sndTT] [colMeta] 98 (foldT2R2 [sndTT] [colMeta]
99 [fn cols => $(mapT2T (fn t :: (Type * Type) => 99 [fn cols => $(map (fn t :: (Type * Type) =>
100 sql_exp [] [] [] t.1) cols)] 100 sql_exp [] [] [] t.1) cols)]
101 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 101 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
102 [[nm] ~ rest] => 102 [[nm] ~ rest] =>
103 fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)}) 103 fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)})
104 {} [M.cols] inputs M.cols 104 {} [M.cols] inputs M.cols
110 {ls} 110 {ls}
111 </body></xml> 111 </body></xml>
112 112
113 and upd (id : int) = 113 and upd (id : int) =
114 let 114 let
115 fun save (inputs : $(mapT2T sndTT M.cols)) = 115 fun save (inputs : $(map sndTT M.cols)) =
116 dml (update [mapT2T fstTT M.cols] 116 dml (update [map fstTT M.cols]
117 (foldT2R2 [sndTT] [colMeta] 117 (foldT2R2 [sndTT] [colMeta]
118 [fn cols => $(mapT2T (fn t :: (Type * Type) => 118 [fn cols => $(map (fn t :: (Type * Type) =>
119 sql_exp [T = [Id = int] 119 sql_exp [T = [Id = int]
120 ++ mapT2T fstTT M.cols] 120 ++ map fstTT M.cols]
121 [] [] t.1) cols)] 121 [] [] t.1) cols)]
122 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 122 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
123 [[nm] ~ rest] => 123 [[nm] ~ rest] =>
124 fn input col acc => acc ++ {nm = 124 fn input col acc => acc ++ {nm =
125 @sql_inject col.Inject (col.Parse input)}) 125 @sql_inject col.Inject (col.Parse input)})
130 <p>Saved!</p> 130 <p>Saved!</p>
131 131
132 {ls} 132 {ls}
133 </body></xml> 133 </body></xml>
134 in 134 in
135 fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {[id]}); 135 fso <- oneOrNoRows (SELECT tab.{{map fstTT M.cols}} FROM tab WHERE tab.Id = {[id]});
136 case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of 136 case fso : (Basis.option {Tab : $(map fstTT M.cols)}) of
137 None => return <xml><body>Not found!</body></xml> 137 None => return <xml><body>Not found!</body></xml>
138 | Some fs => return <xml><body><form> 138 | Some fs => return <xml><body><form>
139 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] 139 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map sndTT cols)]
140 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) 140 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
141 [[nm] ~ rest] (v : t.1) (col : colMeta t) 141 [[nm] ~ rest] (v : t.1) (col : colMeta t)
142 (acc : xml form [] (mapT2T sndTT rest)) => 142 (acc : xml form [] (map sndTT rest)) =>
143 <xml> 143 <xml>
144 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> 144 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
145 {useMore acc} 145 {useMore acc}
146 </xml>) 146 </xml>)
147 <xml/> 147 <xml/>