Mercurial > urweb
changeset 1023:e46227efcbba
Bidding interface
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 01 Nov 2009 10:20:20 -0500 |
| parents | 4de35df3d545 |
| children | 93415bcf54c0 |
| files | demo/more/bid.ur demo/more/bid.urs demo/more/conference.ur demo/more/conference.urp demo/more/conference.urs demo/more/conference1.ur demo/more/select.ur demo/more/select.urs include/urweb.h lib/ur/basis.urs lib/ur/string.ur lib/ur/string.urs src/c/urweb.c src/cjr_print.sml src/corify.sml |
| diffstat | 15 files changed, 137 insertions(+), 38 deletions(-) [+] |
line wrap: on
line diff
--- a/demo/more/bid.ur Sat Oct 31 15:51:50 2009 -0400 +++ b/demo/more/bid.ur Sun Nov 01 10:20:20 2009 -0500 @@ -7,22 +7,51 @@ table assignment : {User : userId, Paper : paperId} PRIMARY KEY (User, Paper) - fun isOnPc id = - ro <- oneOrNoRows1 (SELECT user.OnPc - FROM user - WHERE user.Id = {[id]}); - return (case ro of - None => False - | Some r => r.OnPc) - val linksForPc = let - fun bid () = - me <- getLogin; - return <xml>Bidding time!</xml> + fun yourBids () = + me <- getPcLogin; + ps <- queryX (SELECT paper.Id, paper.{{M.paper}}, bid.Interest + FROM paper LEFT JOIN bid ON bid.Paper = paper.Id + AND bid.User = {[me.Id]}) + (fn r => <xml><entry> + <hidden{#Paper} value={show r.Paper.Id}/> + {useMore <xml><tr> + <td>{summarizePaper (r.Paper -- #Id)}</td> + <td><select{#Bid}> + {Select.selectChar ((#"-", "No") :: (#"_", "Maybe") :: (#"+", "Yes") :: []) + r.Bid.Interest} + </select></td> + </tr></xml>} + </entry></xml>); + return <xml><body> + <h1>Bid on papers</h1> + + <form> + <subforms{#Papers}><table> + <tr> <th>Paper</th> <th>Your Bid</th> </tr> + {ps} + </table></subforms> + <submit value="Change" action={changeBids}/> + </form> + </body></xml> + + and changeBids r = + me <- getPcLogin; + List.app (fn {Paper = p, Bid = b} => + case b of + "" => return () + | _ => let + val p = readError p + in + (dml (DELETE FROM bid WHERE Paper = {[p]} AND User = {[me.Id]}); + dml (INSERT INTO bid (Paper, User, Interest) + VALUES ({[p]}, {[me.Id]}, {[String.sub b 0]}))) + end) r.Papers; + yourBids () in <xml> - <li> <a link={bid ()}>Bid on papers</a></li> + <li> <a link={yourBids ()}>Bid on papers</a></li> </xml> end
--- a/demo/more/bid.urs Sat Oct 31 15:51:50 2009 -0400 +++ b/demo/more/bid.urs Sun Nov 01 10:20:20 2009 -0500 @@ -1,2 +1,3 @@ -functor Make (M : Conference.INPUT) : Conference.OUTPUT where con userId = M.userId +functor Make (M : Conference.INPUT) : Conference.OUTPUT where con paper = M.paper + where con userId = M.userId where con paperId = M.paperId
--- a/demo/more/conference.ur Sat Oct 31 15:51:50 2009 -0400 +++ b/demo/more/conference.ur Sun Nov 01 10:20:20 2009 -0500 @@ -1,5 +1,5 @@ signature INPUT = sig - con paper :: {(Type * Type)} + con paper :: {Type} constraint [Id, Document] ~ paper type userId @@ -10,14 +10,19 @@ type paperId val paperId_inj : sql_injectable_prim paperId - table paper : ([Id = paperId, Document = blob] ++ map fst paper) + val paperId_show : show paperId + val paperId_read : read paperId + table paper : ([Id = paperId, Document = blob] ++ paper) PRIMARY KEY Id val checkLogin : transaction (option {Id : userId, Nam : string, Chair : bool, OnPc : bool}) val getLogin : transaction {Id : userId, Nam : string, Chair : bool, OnPc : bool} + val getPcLogin : transaction {Id : userId, Nam : string, Chair : bool} + val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $paper -> xml ([Body] ++ ctx) [] [] end signature OUTPUT = sig + con paper :: {Type} type userId type paperId @@ -45,10 +50,11 @@ val reviewFolder : folder review val submissionDeadline : time - val summarizePaper : $(map fst paper) -> xbody + val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper) -> xml ([Body] ++ ctx) [] [] - functor Make (M : INPUT where con paper = paper) - : OUTPUT where con userId = M.userId + functor Make (M : INPUT where con paper = map fst paper) + : OUTPUT where con paper = map fst paper + where con userId = M.userId where con paperId = M.paperId end) = struct @@ -92,11 +98,20 @@ None => error <xml>You must be logged in to do that.</xml> | Some r => return r + val getPcLogin = + r <- getLogin; + if r.OnPc then + return (r -- #OnPc) + else + error <xml>You are not on the PC.</xml> + structure O = M.Make(struct val user = user val paper = paper val checkLogin = checkLogin val getLogin = getLogin + val getPcLogin = getPcLogin + val summarizePaper = @@M.summarizePaper end) val checkOnPc = @@ -195,6 +210,7 @@ {if me.OnPc then <xml> <li><a link={all ()}>All papers</a></li> + <li><a link={your ()}>Your papers</a></li> {O.linksForPc} </xml> else
--- a/demo/more/conference.urp Sat Oct 31 15:51:50 2009 -0400 +++ b/demo/more/conference.urp Sun Nov 01 10:20:20 2009 -0500 @@ -8,4 +8,5 @@ dnat conference conferenceFields +select bid
--- a/demo/more/conference.urs Sat Oct 31 15:51:50 2009 -0400 +++ b/demo/more/conference.urs Sun Nov 01 10:20:20 2009 -0500 @@ -1,5 +1,5 @@ signature INPUT = sig - con paper :: {(Type * Type)} + con paper :: {Type} constraint [Id, Document] ~ paper type userId @@ -10,14 +10,19 @@ type paperId val paperId_inj : sql_injectable_prim paperId - table paper : ([Id = paperId, Document = blob] ++ map fst paper) + val paperId_show : show paperId + val paperId_read : read paperId + table paper : ([Id = paperId, Document = blob] ++ paper) PRIMARY KEY Id val checkLogin : transaction (option {Id : userId, Nam : string, Chair : bool, OnPc : bool}) val getLogin : transaction {Id : userId, Nam : string, Chair : bool, OnPc : bool} + val getPcLogin : transaction {Id : userId, Nam : string, Chair : bool} + val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $paper -> xml ([Body] ++ ctx) [] [] end signature OUTPUT = sig + con paper :: {Type} type userId type paperId @@ -43,10 +48,11 @@ val reviewFolder : folder review val submissionDeadline : time - val summarizePaper : $(map fst paper) -> xbody + val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper) -> xml ([Body] ++ ctx) [] [] - functor Make (M : INPUT where con paper = paper) - : OUTPUT where con userId = M.userId + functor Make (M : INPUT where con paper = map fst paper) + : OUTPUT where con paper = map fst paper + where con userId = M.userId where con paperId = M.paperId end) : sig
--- a/demo/more/conference1.ur Sat Oct 31 15:51:50 2009 -0400 +++ b/demo/more/conference1.ur Sun Nov 01 10:20:20 2009 -0500 @@ -7,9 +7,9 @@ val submissionDeadline = readError "2009-11-22 23:59:59" - fun summarizePaper r = cdata r.Title + fun summarizePaper [ctx] [[Body] ~ ctx] r = cdata r.Title - functor Make (M : Conference.INPUT where con paper = _) = struct + functor Make (M : Conference.INPUT where con paper = [Title = string, Abstract = string]) = struct open Bid.Make(M) end end)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/more/select.ur Sun Nov 01 10:20:20 2009 -0500 @@ -0,0 +1,3 @@ +fun selectChar choices current = + List.mapX (fn (ch, label) => + <xml><option value={String.str ch} selected={current = Some ch}>{[label]}</option></xml>) choices
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/more/select.urs Sun Nov 01 10:20:20 2009 -0500 @@ -0,0 +1,1 @@ +val selectChar : list (char * string) -> option char -> xml select [] []
--- a/include/urweb.h Sat Oct 31 15:51:50 2009 -0400 +++ b/include/urweb.h Sun Nov 01 10:20:20 2009 -0500 @@ -115,6 +115,7 @@ uw_Basis_int uw_Basis_unurlifyInt(uw_context, char **); uw_Basis_float uw_Basis_unurlifyFloat(uw_context, char **); uw_Basis_string uw_Basis_unurlifyString(uw_context, char **); +uw_Basis_string uw_Basis_unurlifyString_fromClient(uw_context, char **); uw_Basis_bool uw_Basis_unurlifyBool(uw_context, char **); uw_Basis_time uw_Basis_unurlifyTime(uw_context, char **); @@ -127,6 +128,7 @@ uw_Basis_string uw_Basis_strchr(uw_context, const char *, uw_Basis_char); uw_Basis_int uw_Basis_strcspn(uw_context, const char *, const char *); uw_Basis_string uw_Basis_substring(uw_context, const char *, uw_Basis_int, uw_Basis_int); +uw_Basis_string uw_Basis_str1(uw_context, uw_Basis_char); uw_Basis_string uw_strdup(uw_context, const char *); uw_Basis_string uw_maybe_strdup(uw_context, const char *);
--- a/lib/ur/basis.urs Sat Oct 31 15:51:50 2009 -0400 +++ b/lib/ur/basis.urs Sun Nov 01 10:20:20 2009 -0500 @@ -62,6 +62,7 @@ val strindex : string -> char -> option int val strcspn : string -> string -> option int val substring : string -> int -> int -> string +val str1 : char -> string class show val show : t ::: Type -> show t -> t -> string
--- a/lib/ur/string.ur Sat Oct 31 15:51:50 2009 -0400 +++ b/lib/ur/string.ur Sun Nov 01 10:20:20 2009 -0500 @@ -1,5 +1,7 @@ type t = Basis.string +val str = Basis.str1 + val length = Basis.strlen val append = Basis.strcat
--- a/lib/ur/string.urs Sat Oct 31 15:51:50 2009 -0400 +++ b/lib/ur/string.urs Sun Nov 01 10:20:20 2009 -0500 @@ -1,5 +1,7 @@ type t = string +val str : char -> t + val length : t -> int val append : t -> t -> t
--- a/src/c/urweb.c Sat Oct 31 15:51:50 2009 -0400 +++ b/src/c/urweb.c Sun Nov 01 10:20:20 2009 -0500 @@ -1668,14 +1668,16 @@ return uw_Basis_unurlifyInt(ctx, s); } -static uw_Basis_string uw_unurlifyString_to(uw_context ctx, char *r, char *s) { +static uw_Basis_string uw_unurlifyString_to(int fromClient, uw_context ctx, char *r, char *s) { char *s1, *s2 = s; int n; - if (*s2 == '_') - ++s2; - else if (s2[0] == '%' && s2[1] == '5' && (s2[2] == 'f' || s2[2] == 'F')) - s2 += 3; + if (!fromClient) { + if (*s2 == '_') + ++s2; + else if (s2[0] == '%' && s2[1] == '5' && (s2[2] == 'f' || s2[2] == 'F')) + s2 += 3; + } for (s1 = r; *s2; ++s1, ++s2) { char c = *s2; @@ -1724,7 +1726,21 @@ uw_check_heap(ctx, len + 1); r = ctx->heap.front; - ctx->heap.front = uw_unurlifyString_to(ctx, ctx->heap.front, *s); + ctx->heap.front = uw_unurlifyString_to(0, ctx, ctx->heap.front, *s); + *s = new_s; + return r; +} + +uw_Basis_string uw_Basis_unurlifyString_fromClient(uw_context ctx, char **s) { + char *new_s = uw_unurlify_advance(*s); + char *r, *s1, *s2; + int len, n; + + len = strlen(*s); + uw_check_heap(ctx, len + 1); + + r = ctx->heap.front; + ctx->heap.front = uw_unurlifyString_to(1, ctx, ctx->heap.front, *s); *s = new_s; return r; } @@ -1963,6 +1979,19 @@ } +uw_Basis_string uw_Basis_str1(uw_context ctx, uw_Basis_char ch) { + char *r; + + uw_check_heap(ctx, 2); + r = ctx->heap.front; + r[0] = ch; + r[1] = 0; + + ctx->heap.front += 2; + + return r; +} + uw_Basis_string uw_strdup(uw_context ctx, uw_Basis_string s1) { int len = uw_Basis_strlen(ctx, s1) + 1; char *s;
--- a/src/cjr_print.sml Sat Oct 31 15:51:50 2009 -0400 +++ b/src/cjr_print.sml Sun Nov 01 10:20:20 2009 -0500 @@ -561,11 +561,15 @@ else str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE) -fun unurlify env (t, loc) = +fun unurlify fromClient env (t, loc) = let fun unurlify' rf t = case t of - TFfi ("Basis", "unit") => string ("uw_unit_v") + TFfi ("Basis", "unit") => string "uw_unit_v" + | TFfi ("Basis", "string") => string (if fromClient then + "uw_Basis_unurlifyString_fromClient(ctx, &request)" + else + "uw_Basis_unurlifyString(ctx, &request)") | TFfi (m, t) => string ("uw_" ^ ident m ^ "_unurlify" ^ capitalize t ^ "(ctx, &request)") | TRecord 0 => string "uw_unit_v" @@ -1835,7 +1839,7 @@ let fun getIt () = if isUnboxable t then - unurlify env t + unurlify false env t else box [string "({", newline, @@ -1845,7 +1849,7 @@ string "));", newline, string "*tmp = ", - unurlify env t, + unurlify false env t, string ";", newline, string "tmp;", @@ -2441,7 +2445,7 @@ space, string "=", space, - unurlify env t, + unurlify true env t, string ";", newline] end @@ -2599,7 +2603,7 @@ space, string "=", space, - unurlify env t, + unurlify false env t, string ";", newline]) ts), defInputs,
--- a/src/corify.sml Sat Oct 31 15:51:50 2009 -0400 +++ b/src/corify.sml Sun Nov 01 10:20:20 2009 -0500 @@ -43,8 +43,10 @@ String.extract (s, 5, NONE) else s + val s = String.concatWith "/" (rev (s :: mods)) + val s = String.implode (List.filter (fn ch => ch <> #"$") (String.explode s)) in - Settings.rewrite k (String.concatWith "/" (rev (s :: mods))) + Settings.rewrite k s end val relify = CharVector.map (fn #"/" => #"_"