From 218146e27b7cd6ad51ba9ac23f0f825ff2a0bf11 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 7 Nov 2009 11:06:38 -0500 Subject: Saving paper decisions --- demo/more/conference.ur | 9 ++++++- demo/more/conference.urs | 8 +++++- demo/more/conference1.ur | 13 +++++++--- demo/more/conferenceFields.ur | 1 + demo/more/conferenceFields.urs | 1 + demo/more/decision.ur | 58 +++++++++++++++++++++++++++--------------- demo/more/decision.urs | 3 ++- lib/ur/top.ur | 4 +-- lib/ur/top.urs | 6 ++--- 9 files changed, 71 insertions(+), 32 deletions(-) diff --git a/demo/more/conference.ur b/demo/more/conference.ur index 8f6dff2a..bf8e364a 100644 --- a/demo/more/conference.ur +++ b/demo/more/conference.ur @@ -16,6 +16,11 @@ signature INPUT = sig 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 @@ functor Make(M : sig 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 @@ functor Make(M : sig structure O = M.Make(struct val user = user val paper = paper + val review = review val checkLogin = checkLogin val getLogin = getLogin val getPcLogin = getPcLogin diff --git a/demo/more/conference.urs b/demo/more/conference.urs index 8ecb1692..de35ad05 100644 --- a/demo/more/conference.urs +++ b/demo/more/conference.urs @@ -16,6 +16,11 @@ signature INPUT = sig 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 @@ functor Make(M : sig 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 diff --git a/demo/more/conference1.ur b/demo/more/conference1.ur index a365efa8..646ba489 100644 --- a/demo/more/conference1.ur +++ b/demo/more/conference1.ur @@ -10,16 +10,23 @@ open Conference.Make(struct 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 + + fun status [ctx] [[Body] ~ ctx] r = + queryX (SELECT review.Rating + FROM review + WHERE review.Paper = {[r.Id]}) + (fn r => {[r.Review.Rating]}; ) - functor Make (M : Conference.INPUT where con paper = _) = struct open Conference.Join(struct structure O1 = Bid.Make(M) structure O2 = Decision.Make(struct con paperOther = _ open M - fun status [ctx] [[Body] ~ ctx] - r = ! + val status = @@status end) end) end diff --git a/demo/more/conferenceFields.ur b/demo/more/conferenceFields.ur index d22bd877..18387c96 100644 --- a/demo/more/conferenceFields.ur +++ b/demo/more/conferenceFields.ur @@ -22,3 +22,4 @@ fun dropdown name opts = {Nam = name, Parse = charIn, Inject = _} +val dropdown_show = _ diff --git a/demo/more/conferenceFields.urs b/demo/more/conferenceFields.urs index 04cf902f..3a034770 100644 --- a/demo/more/conferenceFields.urs +++ b/demo/more/conferenceFields.urs @@ -4,3 +4,4 @@ val commentsForAuthors : Meta.meta (string, string) con dropdown :: (Type * Type) val dropdown : string -> list char -> Meta.meta dropdown +val dropdown_show : show dropdown.1 diff --git a/demo/more/decision.ur b/demo/more/decision.ur index b93658ee..efd1b9c7 100644 --- a/demo/more/decision.ur +++ b/demo/more/decision.ur @@ -12,37 +12,53 @@ functor Make(M : sig 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 => - {useMore (summarizePaper (r.Paper -- #Id))} - {useMore (status (r.Paper -- #Id -- #Decision))} - - - - - - - - ); + ps <- queryX' (SELECT paper.Id, paper.Decision, paper.{{M.paperOther}} + FROM paper + ORDER BY paper.Id) + (fn r => st <- status (r.Paper -- #Decision); + return + {useMore (summarizePaper (r.Paper -- #Id))} + {useMore st} + + + + + + + + ); return

Make acceptance decisions

-
- - - {ps} -
Paper Status Decision
- +
+ + + + {ps} +
Paper Status Decision
+ + +
+ + 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 Invalid decision code]} + WHERE Id = {[readError pid]})) r.Papers; + makeDecisions () in
  • Make acceptance decisions
    • diff --git a/demo/more/decision.urs b/demo/more/decision.urs index 9ae585b0..e33403cb 100644 --- a/demo/more/decision.urs +++ b/demo/more/decision.urs @@ -6,7 +6,8 @@ functor Make (M : sig 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 diff --git a/lib/ur/top.ur b/lib/ur/top.ur index 10b3f711..423507b5 100644 --- a/lib/ur/top.ur +++ b/lib/ur/top.ur @@ -224,10 +224,10 @@ fun queryX [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Ty (fn fs acc => return {acc}{f fs}) -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; diff --git a/lib/ur/top.urs b/lib/ur/top.urs index 80d402b1..6470d7d7 100644 --- a/lib/ur/top.urs +++ b/lib/ur/top.urs @@ -132,12 +132,12 @@ val queryX : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit} -> inp ::: -> 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] => -- cgit v1.2.3