Mercurial > urweb

annotate demo/more/bid.ur @ 1027:be1aec7333a5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Saving paper assignments
author Adam Chlipala <adamc@hcoop.net>
date Mon, 02 Nov 2009 14:11:08 -0500
parents 7facf72aaf0a
children 8b7971e74335
rev   line source
adamc@1022 1 functor Make(M : Conference.INPUT) = struct
adamc@1022 2 open M
adamc@1022 3
adamc@1022 4 table bid : {User : userId, Paper : paperId, Interest : char}
adamc@1022 5 PRIMARY KEY (User, Paper)
adamc@1022 6
adamc@1022 7 table assignment : {User : userId, Paper : paperId}
adamc@1022 8 PRIMARY KEY (User, Paper)
adamc@1022 9
adamc@1025 10 fun intOut ch =
adamc@1025 11 case ch of
adamc@1025 12 #"_" => "Maybe"
adamc@1025 13 | #"-" => "No"
adamc@1025 14 | #"+" => "Yes"
adamc@1025 15 | _ => error <xml>Bid: Invalid Interest code</xml>
adamc@1025 16
adamc@1025 17 val linksForChair =
adamc@1025 18 let
adamc@1025 19 fun assignPapers () =
adamc@1025 20 tup <- query (SELECT paper.Id, paper.{{M.paper}}, user.Id, user.Nam, bid.Interest
adamc@1025 21 FROM paper JOIN bid ON bid.Paper = paper.Id
adamc@1025 22 JOIN user ON bid.User = user.Id
adamc@1025 23 ORDER BY paper.Id, bid.Interest, user.Nam)
adamc@1027 24 (fn r (paper, int, acc, ints, papers) =>
adamc@1027 25 if (case paper of None => False | Some r' => r'.Id = r.Paper.Id) then
adamc@1025 26 if int = r.Bid.Interest then
adamc@1027 27 return (paper, int, (r.User.Id, r.User.Nam) :: acc, ints, papers)
adamc@1025 28 else
adamc@1027 29 return (paper, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [],
adamc@1025 30 (int, acc) :: ints, papers)
adamc@1025 31 else
adamc@1027 32 return (Some r.Paper, r.Bid.Interest,
adamc@1025 33 (r.User.Id, r.User.Nam) :: [], [],
adamc@1027 34 case paper of
adamc@1025 35 None => papers
adamc@1027 36 | Some r => (r.Id, r -- #Id, (int, acc) :: ints) :: papers))
adamc@1025 37 (None, #" ", [], [], []);
adamc@1025 38 let
adamc@1025 39 val papersL = case tup.1 of
adamc@1027 40 Some r => (r.Id, r -- #Id, (tup.2, tup.3) :: tup.4) :: tup.5
adamc@1027 41 | None => []
adamc@1025 42
adamc@1027 43 fun makePapers () = List.mapM (fn (pid, extra, ints) =>
adamc@1025 44 ints <- List.mapM (fn (int, users) =>
adamc@1025 45 cg <- CheckGroup.create
adamc@1025 46 (List.mp
adamc@1025 47 (fn (id, nam) => (id, txt nam,
adamc@1025 48 False))
adamc@1025 49 users);
adamc@1025 50 ex <- Expandable.create
adamc@1025 51 (CheckGroup.render cg);
adamc@1025 52 return (int, cg, ex)) ints;
adamc@1027 53 return (pid, extra, ints)) papersL
adamc@1027 54
adamc@1027 55 fun saveAssignment ls =
adamc@1027 56 dml (DELETE FROM assignment WHERE TRUE);
adamc@1027 57 List.app (fn (pid, uids) =>
adamc@1027 58 List.app (fn uid => dml (INSERT INTO assignment (Paper, User)
adamc@1027 59 VALUES ({[pid]}, {[uid]}))) uids) ls
adamc@1025 60 in
adamc@1025 61 papers <- source [];
adamc@1025 62
adamc@1025 63 return <xml><body onload={papersL <- makePapers ();
adamc@1025 64 set papers papersL}>
adamc@1025 65 <h1>Assign papers</h1>
adamc@1025 66
adamc@1025 67 <dyn signal={papers <- signal papers;
adamc@1027 68 return (List.mapX (fn (pid, extra, ints) => <xml>
adamc@1025 69 <hr/>
adamc@1027 70 #{[pid]}: {summarizePaper extra}:
adamc@1025 71 <dyn signal={n <- List.foldl (fn (_, cg, _) total =>
adamc@1025 72 this <- CheckGroup.selected cg;
adamc@1025 73 total <- total;
adamc@1025 74 return (List.length this + total)) (return 0) ints;
adamc@1025 75 return (txt n)}/><br/>
adamc@1025 76
adamc@1025 77 {List.mapX (fn (int, _, ex) => <xml>
adamc@1025 78 {[intOut int]}: {Expandable.render ex}
adamc@1025 79 </xml>) ints}
adamc@1025 80 </xml>) papers)}/>
adamc@1027 81
adamc@1027 82 <br/>
adamc@1027 83 <button value="Save" onclick={papers <- get papers;
adamc@1027 84 ls <- List.mapM (fn (pid, _, ints) =>
adamc@1027 85 ints <- List.mapM (fn (_, cg, _) =>
adamc@1027 86 current
adamc@1027 87 (CheckGroup.selected cg))
adamc@1027 88 ints;
adamc@1027 89 return (pid, List.foldl List.append [] ints))
adamc@1027 90 papers;
adamc@1027 91 rpc (saveAssignment ls)}/>
adamc@1025 92 </body></xml>
adamc@1025 93 end
adamc@1025 94 in
adamc@1025 95 <xml>
adamc@1025 96 <li><a link={assignPapers ()}> Assign papers to people</a></li>
adamc@1025 97 </xml>
adamc@1025 98 end
adamc@1025 99
adamc@1022 100 val linksForPc =
adamc@1022 101 let
adamc@1023 102 fun yourBids () =
adamc@1023 103 me <- getPcLogin;
adamc@1023 104 ps <- queryX (SELECT paper.Id, paper.{{M.paper}}, bid.Interest
adamc@1023 105 FROM paper LEFT JOIN bid ON bid.Paper = paper.Id
adamc@1023 106 AND bid.User = {[me.Id]})
adamc@1025 107 (fn r => <xml><tr>
adamc@1025 108 <td>{useMore (summarizePaper (r.Paper -- #Id))}</td>
adamc@1025 109 <td><entry>
adamc@1025 110 <hidden{#Paper} value={show r.Paper.Id}/>
adamc@1025 111 <select{#Bid}>
adamc@1025 112 {useMore (Select.selectChar ((#"-", "No") :: (#"_", "Maybe") :: (#"+", "Yes") :: [])
adamc@1025 113 r.Bid.Interest)}
adamc@1025 114 </select></entry></td>
adamc@1025 115 </tr></xml>);
adamc@1023 116 return <xml><body>
adamc@1023 117 <h1>Bid on papers</h1>
adamc@1023 118
adamc@1023 119 <form>
adamc@1023 120 <subforms{#Papers}><table>
adamc@1023 121 <tr> <th>Paper</th> <th>Your Bid</th> </tr>
adamc@1023 122 {ps}
adamc@1023 123 </table></subforms>
adamc@1023 124 <submit value="Change" action={changeBids}/>
adamc@1023 125 </form>
adamc@1023 126 </body></xml>
adamc@1023 127
adamc@1023 128 and changeBids r =
adamc@1023 129 me <- getPcLogin;
adamc@1023 130 List.app (fn {Paper = p, Bid = b} =>
adamc@1023 131 case b of
adamc@1023 132 "" => return ()
adamc@1023 133 | _ => let
adamc@1023 134 val p = readError p
adamc@1023 135 in
adamc@1023 136 (dml (DELETE FROM bid WHERE Paper = {[p]} AND User = {[me.Id]});
adamc@1023 137 dml (INSERT INTO bid (Paper, User, Interest)
adamc@1023 138 VALUES ({[p]}, {[me.Id]}, {[String.sub b 0]})))
adamc@1023 139 end) r.Papers;
adamc@1023 140 yourBids ()
adamc@1022 141 in
adamc@1022 142 <xml>
adamc@1023 143 <li> <a link={yourBids ()}>Bid on papers</a></li>
adamc@1022 144 </xml>
adamc@1022 145 end
adamc@1022 146
adamc@1022 147 con yourPaperTables = [Assignment = _]
adamc@1022 148 constraint [Paper] ~ yourPaperTables
adamc@1022 149 fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper]
adamc@1027 150 (uid : userId) (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) =
adamc@1027 151 sql_inner_join fi (sql_from_table [#Assignment] assignment)
adamc@1027 152 (WHERE Paper.Id = Assignment.Paper AND Assignment.User = {[uid]})
adamc@1022 153 end