Mercurial > urweb

annotate demo/crud.ur @ 1739:c414850f206f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add support for -boot flag, which allows in-tree execution of Ur/Web The boot flag rewrites most hardcoded paths to point to the build directory, and also forces static compilation. This is convenient for developing Ur/Web, or if you cannot 'sudo make install' Ur/Web. The following changes were made: * Header files were moved to include/urweb instead of include; this lets FFI users point their C_INCLUDE_PATH at this directory at write <urweb/urweb.h>. For internal Ur/Web executables, we simply pass -I$PATH/include/urweb as normal. * Differentiate between LIB and SRCLIB; SRCLIB is Ur and JavaScript source files, while LIB is compiled products from libtool. For in-tree compilation these live in different places. * No longer reference Config for paths; instead use Settings; these settings can be changed dynamically by Compiler.enableBoot () (TODO: add a disableBoot function.) * config.h is now generated directly in include/urweb/config.h, for consistency's sake (especially since it gets installed along with the rest of the headers!) * All of the autotools build products got updated. * The linkStatic field in protocols now only contains the name of the build product, and not the absolute path. Future users have to be careful not to reference the Settings files to early, lest they get an old version (this was the source of two bugs during development of this patch.)
author Edward Z. Yang <ezyang@mit.edu>
date Wed, 02 May 2012 17:17:57 -0400
parents c7b9a33c26c8
children 6bc2a8cb3a67
rev   line source
adamc@1002 1 con colMeta = fn (db :: Type, widget :: Type) =>
adamc@1002 2 {Nam : string,
adamc@1002 3 Show : db -> xbody,
adamc@1002 4 Widget : nm :: Name -> xml form [] [nm = widget],
adamc@1002 5 WidgetPopulated : nm :: Name -> db -> xml form [] [nm = widget],
adamc@1002 6 Parse : widget -> db,
adamc@1002 7 Inject : sql_injectable db}
adam@1302 8 con colsMeta = fn cols => $(map colMeta cols)
adamc@421 9
adamc@823 10 fun default [t] (sh : show t) (rd : read t) (inj : sql_injectable t)
adamc@421 11 name : colMeta (t, string) =
adamc@421 12 {Nam = name,
adamc@421 13 Show = txt,
adamc@823 14 Widget = fn [nm :: Name] => <xml><textbox{nm}/></xml>,
adamc@823 15 WidgetPopulated = fn [nm :: Name] n =>
adamc@421 16 <xml><textbox{nm} value={show n}/></xml>,
adamc@421 17 Parse = readError,
adamc@421 18 Inject = _}
adamc@421 19
adamc@421 20 val int = default
adamc@421 21 val float = default
adamc@421 22 val string = default
adamc@421 23
adamc@421 24 fun bool name = {Nam = name,
adamc@421 25 Show = txt,
adamc@823 26 Widget = fn [nm :: Name] => <xml><checkbox{nm}/></xml>,
adamc@823 27 WidgetPopulated = fn [nm :: Name] b =>
adamc@421 28 <xml><checkbox{nm} checked={b}/></xml>,
adamc@421 29 Parse = fn x => x,
adamc@421 30 Inject = _}
adamc@421 31
adamc@421 32 functor Make(M : sig
adamc@421 33 con cols :: {(Type * Type)}
adamc@421 34 constraint [Id] ~ cols
adamc@632 35 val fl : folder cols
adamc@632 36
adamc@706 37 table tab : ([Id = int] ++ map fst cols)
adamc@421 38
adamc@421 39 val title : string
adamc@421 40
adamc@421 41 val cols : colsMeta cols
adamc@421 42 end) = struct
adamc@421 43
adamc@421 44 val tab = M.tab
adamc@421 45
adamc@421 46 sequence seq
adamc@421 47
adamc@421 48 fun list () =
adamc@421 49 rows <- queryX (SELECT * FROM tab AS T)
adamc@637 50 (fn (fs : {T : $([Id = int] ++ map fst M.cols)}) => <xml>
adamc@421 51 <tr>
adamc@421 52 <td>{[fs.T.Id]}</td>
adamc@1172 53 {@mapX2 [fst] [colMeta] [tr]
adam@1302 54 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] v col => <xml>
adam@1302 55 <td>{col.Show v}</td>
adam@1302 56 </xml>)
adamc@1093 57 M.fl (fs.T -- #Id) M.cols}
adamc@421 58 <td>
adamc@421 59 <a link={upd fs.T.Id}>[Update]</a>
adamc@421 60 <a link={confirm fs.T.Id}>[Delete]</a>
adamc@421 61 </td>
adamc@421 62 </tr>
adamc@421 63 </xml>);
adamc@421 64 return <xml>
adamc@421 65 <table border={1}>
adamc@421 66 <tr>
adamc@421 67 <th>ID</th>
adamc@1172 68 {@mapX [colMeta] [tr]
adam@1302 69 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] col => <xml>
adam@1302 70 <th>{cdata col.Nam}</th>
adam@1302 71 </xml>)
adamc@1093 72 M.fl M.cols}
adamc@421 73 </tr>
adamc@421 74 {rows}
adamc@421 75 </table>
adamc@421 76
adamc@421 77 <br/><hr/><br/>
adamc@421 78
adamc@421 79 <form>
adam@1302 80 {@foldR [colMeta] [fn cols => xml form [] (map snd cols)]
adam@1303 81 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] (col : colMeta t) acc => <xml>
adam@1302 82 <li> {cdata col.Nam}: {col.Widget [nm]}</li>
adam@1302 83 {useMore acc}
adam@1302 84 </xml>)
adamc@1093 85 <xml/>
adamc@1093 86 M.fl M.cols}
adamc@421 87
adamc@421 88 <submit action={create}/>
adamc@421 89 </form>
adamc@421 90 </xml>
adamc@421 91
adamc@637 92 and create (inputs : $(map snd M.cols)) =
adamc@421 93 id <- nextval seq;
adamc@434 94 dml (insert tab
adamc@1093 95 (@foldR2 [snd] [colMeta]
adam@1302 96 [fn cols => $(map (fn t => sql_exp [] [] [] t.1) cols)]
adam@1302 97 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] =>
adamc@1093 98 fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)})
adamc@1093 99 {} M.fl inputs M.cols
adamc@471 100 ++ {Id = (SQL {[id]})}));
adamc@421 101 ls <- list ();
adamc@421 102 return <xml><body>
adamc@421 103 <p>Inserted with ID {[id]}.</p>
adamc@421 104
adamc@421 105 {ls}
adamc@421 106 </body></xml>
adamc@421 107
adamc@499 108 and upd (id : int) =
adamc@499 109 let
adamc@637 110 fun save (inputs : $(map snd M.cols)) =
adamc@1093 111 dml (update [map fst M.cols]
adamc@1093 112 (@foldR2 [snd] [colMeta]
adam@1302 113 [fn cols => $(map (fn t => sql_exp [T = [Id = int] ++ map fst M.cols] [] [] t.1) cols)]
adam@1302 114 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] =>
adamc@1093 115 fn input col acc => acc ++ {nm =
adamc@1093 116 @sql_inject col.Inject (col.Parse input)})
adamc@1093 117 {} M.fl inputs M.cols)
adamc@499 118 tab (WHERE T.Id = {[id]}));
adamc@499 119 ls <- list ();
adamc@499 120 return <xml><body>
adamc@499 121 <p>Saved!</p>
adamc@421 122
adamc@499 123 {ls}
adamc@499 124 </body></xml>
adamc@499 125 in
adamc@637 126 fso <- oneOrNoRows (SELECT tab.{{map fst M.cols}} FROM tab WHERE tab.Id = {[id]});
adamc@637 127 case fso : (Basis.option {Tab : $(map fst M.cols)}) of
adamc@499 128 None => return <xml><body>Not found!</body></xml>
adamc@499 129 | Some fs => return <xml><body><form>
adam@1302 130 {@foldR2 [fst] [colMeta] [fn cols => xml form [] (map snd cols)]
adam@1303 131 (fn [nm :: Name] [t ::_] [rest ::_] [[nm] ~ rest] v (col : colMeta t)
adamc@1093 132 (acc : xml form [] (map snd rest)) =>
adamc@1093 133 <xml>
adamc@1093 134 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
adamc@1093 135 {useMore acc}
adamc@1093 136 </xml>)
adamc@1093 137 <xml/>
adamc@1093 138 M.fl fs.Tab M.cols}
adamc@421 139
adamc@499 140 <submit action={save}/>
adamc@499 141 </form></body></xml>
adamc@499 142 end
adamc@421 143
adamc@499 144 and confirm (id : int) =
adamc@499 145 let
adamc@499 146 fun delete () =
adamc@499 147 dml (DELETE FROM tab WHERE Id = {[id]});
adamc@499 148 ls <- list ();
adamc@499 149 return <xml><body>
adamc@499 150 <p>The deed is done.</p>
adamc@499 151
adamc@499 152 {ls}
adamc@499 153 </body></xml>
adamc@499 154 in
adamc@499 155 return <xml><body>
adamc@499 156 <p>Are you sure you want to delete ID #{[id]}?</p>
adamc@499 157
adamc@732 158 <form><submit action={delete} value="I was born sure!"/></form>
adamc@499 159 </body></xml>
adamc@1265 160 end
adamc@421 161
adamc@421 162 and main () =
adamc@421 163 ls <- list ();
adamc@421 164 return <xml><head>
adamc@421 165 <title>{cdata M.title}</title>
adamc@421 166 </head><body>
adamc@421 167
adamc@421 168 <h1>{cdata M.title}</h1>
adamc@421 169
adamc@421 170 {ls}
adamc@421 171 </body></xml>
adamc@421 172
adamc@421 173 end