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