Mercurial > urweb

comparison demo/crud.ur @ 1302:d008c4c43a0a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Flex kinds for type-level tuples; ::_ notation
author Adam Chlipala <adam@chlipala.net>
date Sun, 10 Oct 2010 13:07:38 -0400
parents e8d68fd8ed4b
children c7b9a33c26c8
comparison
equal deleted inserted replaced
1301:4359e185d3af 1302:d008c4c43a0a
3 Show : db -> xbody, 3 Show : db -> xbody,
4 Widget : nm :: Name -> xml form [] [nm = widget], 4 Widget : nm :: Name -> xml form [] [nm = widget],
5 WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget], 5 WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget],
6 Parse : widget -> db, 6 Parse : widget -> db,
7 Inject : sql_injectable db} 7 Inject : sql_injectable db}
8 con colsMeta = fn cols :: {(Type * Type)} => $(map colMeta cols) 8 con colsMeta = fn cols => $(map colMeta cols)
9 9
10 fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t) 10 fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t)
11 name : colMeta (t, string) = 11 name : colMeta (t, string) =
12 {Nam = name, 12 {Nam = name,
13 Show = txt, 13 Show = txt,
49 rows <- queryX (SELECT * FROM tab AS T) 49 rows <- queryX (SELECT * FROM tab AS T)
50 (fn (fs : {T : $([Id = int] ++ map fst M.cols)}) => <xml> 50 (fn (fs : {T : $([Id = int] ++ map fst M.cols)}) => <xml>
51 <tr> 51 <tr>
52 <td>{[fs.T.Id]}</td> 52 <td>{[fs.T.Id]}</td>
53 {@mapX2 [fst] [colMeta] [tr] 53 {@mapX2 [fst] [colMeta] [tr]
54 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] 54 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] v col => <xml>
55 [[nm] ~ rest] v col => <xml> 55 <td>{col.Show v}</td>
56 <td>{col.Show v}</td> 56 </xml>)
57 </xml>)
58 M.fl (fs.T -- #Id) M.cols} 57 M.fl (fs.T -- #Id) M.cols}
59 <td> 58 <td>
60 <a link={upd fs.T.Id}>[Update]</a> 59 <a link={upd fs.T.Id}>[Update]</a>
61 <a link={confirm fs.T.Id}>[Delete]</a> 60 <a link={confirm fs.T.Id}>[Delete]</a>
62 </td> 61 </td>
65 return <xml> 64 return <xml>
66 <table border={1}> 65 <table border={1}>
67 <tr> 66 <tr>
68 <th>ID</th> 67 <th>ID</th>
69 {@mapX [colMeta] [tr] 68 {@mapX [colMeta] [tr]
70 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] 69 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] col => <xml>
71 [[nm] ~ rest] col => <xml> 70 <th>{cdata col.Nam}</th>
72 <th>{cdata col.Nam}</th> 71 </xml>)
73 </xml>)
74 M.fl M.cols} 72 M.fl M.cols}
75 </tr> 73 </tr>
76 {rows} 74 {rows}
77 </table> 75 </table>
78 76
79 <br/><hr/><br/> 77 <br/><hr/><br/>
80 78
81 <form> 79 <form>
82 {@foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)] 80 {@foldR [colMeta] [fn cols => xml form [] (map snd cols)]
83 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] 81 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map snd rest)) => <xml>
84 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map snd rest)) => <xml> 82 <li> {cdata col.Nam}: {col.Widget [nm]}</li>
85 <li> {cdata col.Nam}: {col.Widget [nm]}</li> 83 {useMore acc}
86 {useMore acc} 84 </xml>)
87 </xml>)
88 <xml/> 85 <xml/>
89 M.fl M.cols} 86 M.fl M.cols}
90 87
91 <submit action={create}/> 88 <submit action={create}/>
92 </form> 89 </form>
94 91
95 and create (inputs : $(map snd M.cols)) = 92 and create (inputs : $(map snd M.cols)) =
96 id <- nextval seq; 93 id <- nextval seq;
97 dml (insert tab 94 dml (insert tab
98 (@foldR2 [snd] [colMeta] 95 (@foldR2 [snd] [colMeta]
99 [fn cols => $(map (fn t :: (Type * Type) => 96 [fn cols => $(map (fn t => sql_exp [] [] [] t.1) cols)]
100 sql_exp [] [] [] t.1) cols)] 97 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] =>
101 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
102 [[nm] ~ rest] =>
103 fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)}) 98 fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)})
104 {} M.fl inputs M.cols 99 {} M.fl inputs M.cols
105 ++ {Id = (SQL {[id]})})); 100 ++ {Id = (SQL {[id]})}));
106 ls <- list (); 101 ls <- list ();
107 return <xml><body> 102 return <xml><body>
113 and upd (id : int) = 108 and upd (id : int) =
114 let 109 let
115 fun save (inputs : $(map snd M.cols)) = 110 fun save (inputs : $(map snd M.cols)) =
116 dml (update [map fst M.cols] 111 dml (update [map fst M.cols]
117 (@foldR2 [snd] [colMeta] 112 (@foldR2 [snd] [colMeta]
118 [fn cols => $(map (fn t :: (Type * Type) => 113 [fn cols => $(map (fn t => sql_exp [T = [Id = int] ++ map fst M.cols] [] [] t.1) cols)]
119 sql_exp [T = [Id = int] 114 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] =>
120 ++ map fst M.cols]
121 [] [] t.1) cols)]
122 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
123 [[nm] ~ rest] =>
124 fn input col acc => acc ++ {nm = 115 fn input col acc => acc ++ {nm =
125 @sql_inject col.Inject (col.Parse input)}) 116 @sql_inject col.Inject (col.Parse input)})
126 {} M.fl inputs M.cols) 117 {} M.fl inputs M.cols)
127 tab (WHERE T.Id = {[id]})); 118 tab (WHERE T.Id = {[id]}));
128 ls <- list (); 119 ls <- list ();
134 in 125 in
135 fso <- oneOrNoRows (SELECT tab.{{map fst M.cols}} FROM tab WHERE tab.Id = {[id]}); 126 fso <- oneOrNoRows (SELECT tab.{{map fst M.cols}} FROM tab WHERE tab.Id = {[id]});
136 case fso : (Basis.option {Tab : $(map fst M.cols)}) of 127 case fso : (Basis.option {Tab : $(map fst M.cols)}) of
137 None => return <xml><body>Not found!</body></xml> 128 None => return <xml><body>Not found!</body></xml>
138 | Some fs => return <xml><body><form> 129 | Some fs => return <xml><body><form>
139 {@foldR2 [fst] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)] 130 {@foldR2 [fst] [colMeta] [fn cols => xml form [] (map snd cols)]
140 (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] 131 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] (v : t.1) (col : colMeta t)
141 [[nm] ~ rest] (v : t.1) (col : colMeta t)
142 (acc : xml form [] (map snd rest)) => 132 (acc : xml form [] (map snd rest)) =>
143 <xml> 133 <xml>
144 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li> 134 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
145 {useMore acc} 135 {useMore acc}
146 </xml>) 136 </xml>)