summaryrefslogtreecommitdiff
path: root/demo/more
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-11-02 14:11:08 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-11-02 14:11:08 -0500
commite8bcab2b86d2fd26920eef564832db6226d109fc (patch)
tree5478ca2d3d314d9a33ce30f1a391dcf03a9a4ff0 /demo/more
parentafc376b19ba6cf922cabf9993df0bb1bdd81299b (diff)
Saving paper assignments
Diffstat (limited to 'demo/more')
-rw-r--r--demo/more/bid.ur48
-rw-r--r--demo/more/conference.ur5
-rw-r--r--demo/more/conference.urs3
3 files changed, 38 insertions, 18 deletions
diff --git a/demo/more/bid.ur b/demo/more/bid.ur
index 931fc9c0..98a48fc4 100644
--- a/demo/more/bid.ur
+++ b/demo/more/bid.ur
@@ -21,26 +21,26 @@ functor Make(M : Conference.INPUT) = struct
FROM paper JOIN bid ON bid.Paper = paper.Id
JOIN user ON bid.User = user.Id
ORDER BY paper.Id, bid.Interest, user.Nam)
- (fn r (pid, int, acc, ints, papers) =>
- if pid = Some r.Paper.Id then
+ (fn r (paper, int, acc, ints, papers) =>
+ if (case paper of None => False | Some r' => r'.Id = r.Paper.Id) then
if int = r.Bid.Interest then
- return (pid, int, (r.User.Id, r.User.Nam) :: acc, ints, papers)
+ return (paper, int, (r.User.Id, r.User.Nam) :: acc, ints, papers)
else
- return (pid, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [],
+ return (paper, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [],
(int, acc) :: ints, papers)
else
- return (Some r.Paper.Id, r.Bid.Interest,
+ return (Some r.Paper, r.Bid.Interest,
(r.User.Id, r.User.Nam) :: [], [],
- case pid of
+ case paper of
None => papers
- | Some pid => (pid, (int, acc) :: ints) :: papers))
+ | Some r => (r.Id, r -- #Id, (int, acc) :: ints) :: papers))
(None, #" ", [], [], []);
let
val papersL = case tup.1 of
- Some pid => (pid, (tup.2, tup.3) :: tup.4) :: tup.5
- | _ => []
+ Some r => (r.Id, r -- #Id, (tup.2, tup.3) :: tup.4) :: tup.5
+ | None => []
- fun makePapers () = List.mapM (fn (pid, ints) =>
+ fun makePapers () = List.mapM (fn (pid, extra, ints) =>
ints <- List.mapM (fn (int, users) =>
cg <- CheckGroup.create
(List.mp
@@ -50,7 +50,13 @@ functor Make(M : Conference.INPUT) = struct
ex <- Expandable.create
(CheckGroup.render cg);
return (int, cg, ex)) ints;
- return (pid, ints)) papersL
+ return (pid, extra, ints)) papersL
+
+ fun saveAssignment ls =
+ dml (DELETE FROM assignment WHERE TRUE);
+ List.app (fn (pid, uids) =>
+ List.app (fn uid => dml (INSERT INTO assignment (Paper, User)
+ VALUES ({[pid]}, {[uid]}))) uids) ls
in
papers <- source [];
@@ -59,9 +65,9 @@ functor Make(M : Conference.INPUT) = struct
<h1>Assign papers</h1>
<dyn signal={papers <- signal papers;
- return (List.mapX (fn (pid, ints) => <xml>
+ return (List.mapX (fn (pid, extra, ints) => <xml>
<hr/>
- Paper #{[pid]}:
+ #{[pid]}: {summarizePaper extra}:
<dyn signal={n <- List.foldl (fn (_, cg, _) total =>
this <- CheckGroup.selected cg;
total <- total;
@@ -72,6 +78,17 @@ functor Make(M : Conference.INPUT) = struct
{[intOut int]}: {Expandable.render ex}
</xml>) ints}
</xml>) papers)}/>
+
+ <br/>
+ <button value="Save" onclick={papers <- get papers;
+ ls <- List.mapM (fn (pid, _, ints) =>
+ ints <- List.mapM (fn (_, cg, _) =>
+ current
+ (CheckGroup.selected cg))
+ ints;
+ return (pid, List.foldl List.append [] ints))
+ papers;
+ rpc (saveAssignment ls)}/>
</body></xml>
end
in
@@ -130,6 +147,7 @@ functor Make(M : Conference.INPUT) = struct
con yourPaperTables = [Assignment = _]
constraint [Paper] ~ yourPaperTables
fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper]
- (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) =
- sql_inner_join fi (sql_from_table [#Assignment] assignment) (WHERE Paper.Id = Assignment.Paper)
+ (uid : userId) (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) =
+ sql_inner_join fi (sql_from_table [#Assignment] assignment)
+ (WHERE Paper.Id = Assignment.Paper AND Assignment.User = {[uid]})
end
diff --git a/demo/more/conference.ur b/demo/more/conference.ur
index 7b3d3d71..7de3fc51 100644
--- a/demo/more/conference.ur
+++ b/demo/more/conference.ur
@@ -35,7 +35,8 @@ signature OUTPUT = sig
constraint [Paper] ~ yourPaperTables
val joinYourPaper : tabs ::: {{Type}} -> paper ::: {Type}
-> [[Paper] ~ tabs] => [[Paper] ~ yourPaperTables] => [tabs ~ yourPaperTables] => [[Id] ~ paper] =>
- sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)
+ userId
+ -> sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)
-> sql_from_items (yourPaperTables ++ [Paper = [Id = paperId] ++ paper] ++ tabs)
end
@@ -305,7 +306,7 @@ functor Make(M : sig
and your () =
me <- getLogin;
listPapers (sql_query {Rows = sql_query1 {Distinct = False,
- From = O.joinYourPaper (sql_from_table [#Paper] paper),
+ From = O.joinYourPaper me.Id (sql_from_table [#Paper] paper),
Where = (WHERE TRUE),
GroupBy = sql_subset_all [_],
Having = (WHERE TRUE),
diff --git a/demo/more/conference.urs b/demo/more/conference.urs
index 2f24bac8..16e6732f 100644
--- a/demo/more/conference.urs
+++ b/demo/more/conference.urs
@@ -35,7 +35,8 @@ signature OUTPUT = sig
constraint [Paper] ~ yourPaperTables
val joinYourPaper : tabs ::: {{Type}} -> paper ::: {Type}
-> [[Paper] ~ tabs] => [[Paper] ~ yourPaperTables] => [tabs ~ yourPaperTables] => [[Id] ~ paper] =>
- sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)
+ userId (* Current user *)
+ -> sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)
-> sql_from_items (yourPaperTables ++ [Paper = [Id = paperId] ++ paper] ++ tabs)
end