Mercurial > urweb

annotate tests/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 1fb318c17546
children
rev   line source
adamc@339 1 con colMeta = fn t_formT :: (Type * Type) => {
adamc@369 2 Nam : string,
adamc@369 3 Show : t_formT.1 -> xbody,
adamc@369 4 Widget : nm :: Name -> xml form [] [nm = t_formT.2],
adamc@369 5 WidgetPopulated : nm :: Name -> t_formT.1 -> xml form [] [nm = t_formT.2],
adamc@369 6 Parse : t_formT.2 -> t_formT.1,
adamc@369 7 Inject : sql_injectable t_formT.1
adamc@369 8 }
adamc@339 9 con colsMeta = fn cols :: {(Type * Type)} => $(Top.mapT2T colMeta cols)
adamc@326 10
adamc@362 11 fun default (t ::: Type) (sh : show t) (rd : read t) (inj : sql_injectable t)
adamc@362 12 name : colMeta (t, string) =
adamc@362 13 {Nam = name,
adamc@403 14 Show = txt,
adamc@371 15 Widget = fn nm :: Name => <xml><textbox{nm}/></xml>,
adamc@362 16 WidgetPopulated = fn (nm :: Name) n =>
adamc@403 17 <xml><textbox{nm} value={show n}/></xml>,
adamc@403 18 Parse = readError,
adamc@362 19 Inject = _}
adamc@362 20
adamc@403 21 val int = default
adamc@403 22 val float = default
adamc@403 23 val string = default
adamc@362 24
adamc@362 25 fun bool name = {Nam = name,
adamc@403 26 Show = txt,
adamc@371 27 Widget = fn nm :: Name => <xml><checkbox{nm}/></xml>,
adamc@362 28 WidgetPopulated = fn (nm :: Name) b =>
adamc@371 29 <xml><checkbox{nm} checked={b}/></xml>,
adamc@362 30 Parse = fn x => x,
adamc@362 31 Inject = _}
adamc@362 32
adamc@325 33 functor Make(M : sig
adamc@370 34 con cols :: {(Type * Type)}
adamc@370 35 constraint [Id] ~ cols
adamc@706 36 table tab : ([Id = int] ++ mapT2T fstTT cols)
adamc@325 37
adamc@370 38 val title : string
adamc@325 39
adamc@370 40 val cols : colsMeta cols
adamc@369 41 end) = struct
adamc@325 42
adamc@370 43 open constraints M
adamc@370 44 val tab = M.tab
adamc@325 45
adamc@370 46 sequence seq
adamc@339 47
adamc@370 48 fun create (inputs : $(mapT2T sndTT M.cols)) =
adamc@370 49 id <- nextval seq;
adamc@370 50 () <- dml (insert tab
adamc@370 51 (foldT2R2 [sndTT] [colMeta]
adamc@370 52 [fn cols => $(mapT2T (fn t :: (Type * Type) =>
adamc@370 53 sql_exp [] [] [] t.1) cols)]
adamc@370 54 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
adamc@370 55 [[nm] ~ rest] =>
adamc@403 56 fn input col acc => acc with nm = @sql_inject col.Inject (col.Parse input))
adamc@370 57 {} [M.cols] inputs M.cols
adamc@370 58 with #Id = (SQL {id})));
adamc@370 59 return <xml><body>
adamc@403 60 Inserted with ID {[id]}.
adamc@370 61 </body></xml>
adamc@370 62
adamc@370 63 fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) =
adamc@370 64 () <- dml (update [mapT2T fstTT M.cols]
adamc@370 65 (foldT2R2 [sndTT] [colMeta]
adamc@370 66 [fn cols => $(mapT2T (fn t :: (Type * Type) =>
adamc@370 67 sql_exp [T = [Id = int]
adamc@370 68 ++ mapT2T fstTT M.cols]
adamc@370 69 [] [] t.1) cols)]
adamc@370 70 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
adamc@370 71 [[nm] ~ rest] =>
adamc@370 72 fn input col acc => acc with nm =
adamc@403 73 @sql_inject col.Inject (col.Parse input))
adamc@370 74 {} [M.cols] inputs M.cols)
adamc@370 75 tab (WHERE T.Id = {id}));
adamc@370 76 return <xml><body>
adamc@370 77 Saved!
adamc@370 78 </body></xml>
adamc@370 79
adamc@370 80 fun update (id : int) =
adamc@370 81 fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id});
adamc@370 82 case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of
adamc@370 83 None => return <xml><body>Not found!</body></xml>
adamc@370 84 | Some fs => return <xml><body><form>
adamc@370 85 {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
adamc@370 86 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
adamc@370 87 [[nm] ~ rest] (v : t.1) (col : colMeta t)
adamc@370 88 (acc : xml form [] (mapT2T sndTT rest)) =>
adamc@370 89 <xml>
adamc@370 90 <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
adamc@370 91 {useMore acc}
adamc@370 92 </xml>)
adamc@370 93 <xml/>
adamc@370 94 [M.cols] fs.Tab M.cols}
adamc@370 95
adamc@370 96 <submit action={save id}/>
adamc@370 97 </form></body></xml>
adamc@370 98
adamc@370 99 fun delete (id : int) =
adamc@370 100 () <- dml (DELETE FROM tab WHERE Id = {id});
adamc@370 101 return <xml><body>
adamc@370 102 The deed is done.
adamc@370 103 </body></xml>
adamc@370 104
adamc@370 105 fun confirm (id : int) = return <xml><body>
adamc@403 106 <p>Are you sure you want to delete ID #{[id]}?</p>
adamc@370 107
adamc@370 108 <p><a link={delete id}>I was born sure!</a></p>
adamc@367 109 </body></xml>
adamc@339 110
adamc@370 111 fun main () =
adamc@370 112 rows <- queryX (SELECT * FROM tab AS T)
adamc@370 113 (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => <xml>
adamc@370 114 <tr>
adamc@403 115 <td>{[fs.T.Id]}</td>
adamc@370 116 {foldT2RX2 [fstTT] [colMeta] [tr]
adamc@370 117 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
adamc@370 118 [[nm] ~ rest] v col => <xml>
adamc@370 119 <td>{col.Show v}</td>
adamc@370 120 </xml>)
adamc@370 121 [M.cols] (fs.T -- #Id) M.cols}
adamc@370 122 <td>
adamc@370 123 <a link={update fs.T.Id}>[Update]</a>
adamc@370 124 <a link={confirm fs.T.Id}>[Delete]</a>
adamc@370 125 </td>
adamc@370 126 </tr>
adamc@370 127 </xml>);
adamc@370 128 return <xml><head>
adamc@370 129 <title>{cdata M.title}</title>
adamc@370 130 </head><body>
adamc@341 131
adamc@370 132 <h1>{cdata M.title}</h1>
adamc@341 133
adamc@370 134 <table border={1}>
adamc@370 135 <tr>
adamc@370 136 <th>ID</th>
adamc@370 137 {foldT2RX [colMeta] [tr]
adamc@370 138 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
adamc@370 139 [[nm] ~ rest] col => <xml>
adamc@370 140 <th>{cdata col.Nam}</th>
adamc@370 141 </xml>)
adamc@370 142 [M.cols] M.cols}
adamc@370 143 </tr>
adamc@370 144 {rows}
adamc@370 145 </table>
adamc@341 146
adamc@370 147 <br/>
adamc@337 148
adamc@370 149 <form>
adamc@370 150 {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)]
adamc@370 151 (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)})
adamc@370 152 [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => <xml>
adamc@370 153 <li> {cdata col.Nam}: {col.Widget [nm]}</li>
adamc@370 154 {useMore acc}
adamc@370 155 </xml>)
adamc@370 156 <xml/>
adamc@370 157 [M.cols] M.cols}
adamc@370 158
adamc@370 159 <submit action={create}/>
adamc@370 160 </form>
adamc@370 161 </body></xml>
adamc@325 162
adamc@325 163 end