Mercurial > urweb
changeset 1032:5d9f47124c4c
Saving paper decisions
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 07 Nov 2009 11:06:38 -0500 |
| parents | 5dccff15fa62 |
| children | b734ff578ac7 |
| files | demo/more/conference.ur demo/more/conference.urs demo/more/conference1.ur demo/more/conferenceFields.ur demo/more/conferenceFields.urs demo/more/decision.ur demo/more/decision.urs lib/ur/top.ur lib/ur/top.urs |
| diffstat | 9 files changed, 71 insertions(+), 32 deletions(-) [+] |
line wrap: on
line diff
--- a/demo/more/conference.ur Mon Nov 02 15:54:22 2009 -0500 +++ b/demo/more/conference.ur Sat Nov 07 11:06:38 2009 -0500 @@ -16,6 +16,11 @@ table paper : ([Id = paperId, Document = blob] ++ paper) PRIMARY KEY Id + con review :: {Type} + constraint [Paper, User] ~ review + table review : ([Paper = paperId, User = userId] ++ review) + PRIMARY KEY (Paper, User) + 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} @@ -63,7 +68,8 @@ val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper ++ paperPrivate) -> xml ([Body] ++ ctx) [] [] - functor Make (M : INPUT where con paper = map fst paper ++ paperPrivate) + functor Make (M : INPUT where con paper = map fst paper ++ paperPrivate + where con review = map fst review) : OUTPUT where con paper = map fst paper ++ paperPrivate where con userId = M.userId where con paperId = M.paperId @@ -126,6 +132,7 @@ structure O = M.Make(struct val user = user val paper = paper + val review = review val checkLogin = checkLogin val getLogin = getLogin val getPcLogin = getPcLogin
--- a/demo/more/conference.urs Mon Nov 02 15:54:22 2009 -0500 +++ b/demo/more/conference.urs Sat Nov 07 11:06:38 2009 -0500 @@ -16,6 +16,11 @@ table paper : ([Id = paperId, Document = blob] ++ paper) PRIMARY KEY Id + con review :: {Type} + constraint [Paper, User] ~ review + table review : ([Paper = paperId, User = userId] ++ review) + PRIMARY KEY (Paper, User) + 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} @@ -61,7 +66,8 @@ val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper ++ paperPrivate) -> xml ([Body] ++ ctx) [] [] - functor Make (M : INPUT where con paper = map fst paper ++ paperPrivate) + functor Make (M : INPUT where con paper = map fst paper ++ paperPrivate + where con review = map fst review) : OUTPUT where con paper = map fst paper ++ paperPrivate where con userId = M.userId where con paperId = M.paperId
--- a/demo/more/conference1.ur Mon Nov 02 15:54:22 2009 -0500 +++ b/demo/more/conference1.ur Sat Nov 07 11:06:38 2009 -0500 @@ -10,16 +10,23 @@ val submissionDeadline = readError "2009-11-22 23:59:59" fun summarizePaper [ctx] [[Body] ~ ctx] r = txt r.Title + functor Make (M : Conference.INPUT where con paper = _ + where con review = _) = struct + open M - functor Make (M : Conference.INPUT where con paper = _) = struct + fun status [ctx] [[Body] ~ ctx] r = + queryX (SELECT review.Rating + FROM review + WHERE review.Paper = {[r.Id]}) + (fn r => <xml>{[r.Review.Rating]}; </xml>) + open Conference.Join(struct structure O1 = Bid.Make(M) structure O2 = Decision.Make(struct con paperOther = _ open M - fun status [ctx] [[Body] ~ ctx] - r = <xml>!</xml> + val status = @@status end) end) end
--- a/demo/more/conferenceFields.ur Mon Nov 02 15:54:22 2009 -0500 +++ b/demo/more/conferenceFields.ur Sat Nov 07 11:06:38 2009 -0500 @@ -22,3 +22,4 @@ Parse = charIn, Inject = _} +val dropdown_show = _
--- a/demo/more/conferenceFields.urs Mon Nov 02 15:54:22 2009 -0500 +++ b/demo/more/conferenceFields.urs Sat Nov 07 11:06:38 2009 -0500 @@ -4,3 +4,4 @@ con dropdown :: (Type * Type) val dropdown : string -> list char -> Meta.meta dropdown +val dropdown_show : show dropdown.1
--- a/demo/more/decision.ur Mon Nov 02 15:54:22 2009 -0500 +++ b/demo/more/decision.ur Sat Nov 07 11:06:38 2009 -0500 @@ -12,37 +12,53 @@ include Conference.INPUT where con paper = [Decision = option bool] ++ paperOther - val status : ctx ::: {Unit} -> [[Body] ~ ctx] => $paperOther -> xml ([Body] ++ ctx) [] [] + val status : ctx ::: {Unit} -> [[Body] ~ ctx] => $([Id = paperId] ++ paperOther) + -> transaction (xml ([Body] ++ ctx) [] []) end) = struct open M val linksForChair = let fun makeDecisions () = - ps <- queryX (SELECT paper.Id, paper.Decision, paper.{{M.paperOther}} - FROM paper - ORDER BY paper.Id) - (fn r => <xml><tr> - <td>{useMore (summarizePaper (r.Paper -- #Id))}</td> - <td>{useMore (status (r.Paper -- #Id -- #Decision))}</td> - <td><entry> - <hidden{#Paper} value={show r.Paper.Id}/> - <select{#Decision}> - <option selected={r.Paper.Decision = None}>?</option> - <option selected={r.Paper.Decision = Some True}>Accept</option> - <option selected={r.Paper.Decision = Some False}>Reject</option> - </select></entry></td> - </tr></xml>); + ps <- queryX' (SELECT paper.Id, paper.Decision, paper.{{M.paperOther}} + FROM paper + ORDER BY paper.Id) + (fn r => st <- status (r.Paper -- #Decision); + return <xml><tr> + <td>{useMore (summarizePaper (r.Paper -- #Id))}</td> + <td>{useMore st}</td> + <td><entry> + <hidden{#Paper} value={show r.Paper.Id}/> + <select{#Decision}> + <option selected={r.Paper.Decision = None}>?</option> + <option selected={r.Paper.Decision = Some True}>Accept</option> + <option selected={r.Paper.Decision = Some False}>Reject</option> + </select></entry></td> + </tr></xml>); return <xml><body> <h1>Make acceptance decisions</h1> - <form><subforms{#Papers}> - <table> - <tr> <th>Paper</th> <th>Status</th> <th>Decision</th> </tr> - {ps} - </table> - </subforms></form> + <form> + <subforms{#Papers}> + <table> + <tr> <th>Paper</th> <th>Status</th> <th>Decision</th> </tr> + {ps} + </table> + </subforms> + <submit value="Save" action={saveDecisions}/> + </form> </body></xml> + + and saveDecisions r = + List.app (fn {Paper = pid, Decision = dec} => + dml (UPDATE paper + SET Decision = {[case dec of + "?" => None + | "Accept" => Some True + | "Reject" => Some False + | _ => error <xml>Invalid decision code</xml>]} + WHERE Id = {[readError pid]})) r.Papers; + makeDecisions () in <xml> <li><a link={makeDecisions ()}>Make acceptance decisions</a></li>
--- a/demo/more/decision.urs Mon Nov 02 15:54:22 2009 -0500 +++ b/demo/more/decision.urs Sat Nov 07 11:06:38 2009 -0500 @@ -6,7 +6,8 @@ include Conference.INPUT where con paper = [Decision = option bool] ++ paperOther - val status : ctx ::: {Unit} -> [[Body] ~ ctx] => $paperOther -> xml ([Body] ++ ctx) [] [] + val status : ctx ::: {Unit} -> [[Body] ~ ctx] => $([Id = paperId] ++ paperOther) + -> transaction (xml ([Body] ++ ctx) [] []) end) : Conference.OUTPUT where con paper = [Decision = option bool] ++ M.paperOther where con userId = M.userId where con paperId = M.paperId
--- a/lib/ur/top.ur Mon Nov 02 15:54:22 2009 -0500 +++ b/lib/ur/top.ur Sat Nov 07 11:06:38 2009 -0500 @@ -224,10 +224,10 @@ (fn fs acc => return <xml>{acc}{f fs}</xml>) <xml/> -fun queryX' [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] +fun queryX' [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}] [tables ~ exps] (q : sql_query tables exps) (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) - -> transaction (xml ctx [] [])) = + -> transaction (xml ctx inp [])) = query q (fn fs acc => r <- f fs;
--- a/lib/ur/top.urs Mon Nov 02 15:54:22 2009 -0500 +++ b/lib/ur/top.urs Sat Nov 07 11:06:38 2009 -0500 @@ -132,12 +132,12 @@ -> xml ctx inp []) -> transaction (xml ctx inp []) -val queryX' : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit} +val queryX' : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type} -> [tables ~ exps] => sql_query tables exps -> ($(exps ++ map (fn fields :: {Type} => $fields) tables) - -> transaction (xml ctx [] [])) - -> transaction (xml ctx [] []) + -> transaction (xml ctx inp [])) + -> transaction (xml ctx inp []) val oneOrNoRows : tables ::: {{Type}} -> exps ::: {Type} -> [tables ~ exps] =>