From e20e964083a048ad4cbb88cc1af3790694f51dfa Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 1 Nov 2009 10:20:20 -0500 Subject: Bidding interface --- demo/more/bid.ur | 53 +++++++++++++++++++++++++++++++++++++----------- demo/more/bid.urs | 3 ++- demo/more/conference.ur | 26 +++++++++++++++++++----- demo/more/conference.urp | 1 + demo/more/conference.urs | 16 ++++++++++----- demo/more/conference1.ur | 4 ++-- demo/more/select.ur | 3 +++ demo/more/select.urs | 1 + 8 files changed, 82 insertions(+), 25 deletions(-) create mode 100644 demo/more/select.ur create mode 100644 demo/more/select.urs (limited to 'demo') diff --git a/demo/more/bid.ur b/demo/more/bid.ur index 5bcaea3a..692f8e14 100644 --- a/demo/more/bid.ur +++ b/demo/more/bid.ur @@ -7,22 +7,51 @@ functor Make(M : Conference.INPUT) = struct 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 Bidding time! + 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 => + + {useMore + {summarizePaper (r.Paper -- #Id)} + + {Select.selectChar ((#"-", "No") :: (#"_", "Maybe") :: (#"+", "Yes") :: []) + r.Bid.Interest} + + } + ); + return +

Bid on papers

+ + + + 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 -

Bid on papers

end diff --git a/demo/more/bid.urs b/demo/more/bid.urs index 976d1ab6..f731f9ba 100644 --- a/demo/more/bid.urs +++ b/demo/more/bid.urs @@ -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 diff --git a/demo/more/conference.ur b/demo/more/conference.ur index a80f1ab1..e810043b 100644 --- a/demo/more/conference.ur +++ b/demo/more/conference.ur @@ -1,5 +1,5 @@ signature INPUT = sig - con paper :: {(Type * Type)} + con paper :: {Type} constraint [Id, Document] ~ paper type userId @@ -10,14 +10,19 @@ signature INPUT = sig 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 @@ functor Make(M : sig 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 @@ functor Make(M : sig None => error You must be logged in to do that. | Some r => return r + val getPcLogin = + r <- getLogin; + if r.OnPc then + return (r -- #OnPc) + else + error You are not on the PC. + 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 @@ functor Make(M : sig {if me.OnPc then

All papers

Your papers

{O.linksForPc} else diff --git a/demo/more/conference.urp b/demo/more/conference.urp index 3bc9156c..844baed9 100644 --- a/demo/more/conference.urp +++ b/demo/more/conference.urp @@ -8,4 +8,5 @@ bulkEdit dnat conference conferenceFields +select bid diff --git a/demo/more/conference.urs b/demo/more/conference.urs index 226e9768..f9729851 100644 --- a/demo/more/conference.urs +++ b/demo/more/conference.urs @@ -1,5 +1,5 @@ signature INPUT = sig - con paper :: {(Type * Type)} + con paper :: {Type} constraint [Id, Document] ~ paper type userId @@ -10,14 +10,19 @@ signature INPUT = sig 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 @@ functor Make(M : sig 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 diff --git a/demo/more/conference1.ur b/demo/more/conference1.ur index c51904e5..f8272b4f 100644 --- a/demo/more/conference1.ur +++ b/demo/more/conference1.ur @@ -7,9 +7,9 @@ open Conference.Make(struct 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) diff --git a/demo/more/select.ur b/demo/more/select.ur new file mode 100644 index 00000000..17cff4dd --- /dev/null +++ b/demo/more/select.ur @@ -0,0 +1,3 @@ +fun selectChar choices current = + List.mapX (fn (ch, label) => + ) choices diff --git a/demo/more/select.urs b/demo/more/select.urs new file mode 100644 index 00000000..f9208b91 --- /dev/null +++ b/demo/more/select.urs @@ -0,0 +1 @@ +val selectChar : list (char * string) -> option char -> xml select [] [] -- cgit v1.2.3