diff options
Diffstat (limited to 'demo/more/bid.ur')
| -rw-r--r-- | demo/more/bid.ur | 48 |
1 files changed, 33 insertions, 15 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 |