Mercurial > urweb

annotate demo/more/bid.ur @ 1034:a779402841f6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Hooks for measuring how much interesting proving is going on in elaboration
author Adam Chlipala <adamc@hcoop.net>
date Tue, 17 Nov 2009 12:44:14 -0500
parents 6bcc1020d5cd
children
rev   line source
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