Mercurial > urweb

annotate demo/more/bid.ur @ 1025:7facf72aaf0a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial form for paper assignment
author Adam Chlipala <adamc@hcoop.net>
date Sun, 01 Nov 2009 14:26:20 -0500
parents e46227efcbba
children be1aec7333a5
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@1025 24 (fn r (pid, int, acc, ints, papers) =>
adamc@1025 25 if pid = Some r.Paper.Id then
adamc@1025 26 if int = r.Bid.Interest then
adamc@1025 27 return (pid, int, (r.User.Id, r.User.Nam) :: acc, ints, papers)
adamc@1025 28 else
adamc@1025 29 return (pid, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [],
adamc@1025 30 (int, acc) :: ints, papers)
adamc@1025 31 else
adamc@1025 32 return (Some r.Paper.Id, r.Bid.Interest,
adamc@1025 33 (r.User.Id, r.User.Nam) :: [], [],
adamc@1025 34 case pid of
adamc@1025 35 None => papers
adamc@1025 36 | Some pid => (pid, (int, acc) :: ints) :: papers))
adamc@1025 37 (None, #" ", [], [], []);
adamc@1025 38 let
adamc@1025 39 val papersL = case tup.1 of
adamc@1025 40 Some pid => (pid, (tup.2, tup.3) :: tup.4) :: tup.5
adamc@1025 41 | _ => []
adamc@1025 42
adamc@1025 43 fun makePapers () = List.mapM (fn (pid, 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@1025 53 return (pid, ints)) papersL
adamc@1025 54 in
adamc@1025 55 papers <- source [];
adamc@1025 56
adamc@1025 57 return <xml><body onload={papersL <- makePapers ();
adamc@1025 58 set papers papersL}>
adamc@1025 59 <h1>Assign papers</h1>
adamc@1025 60
adamc@1025 61 <dyn signal={papers <- signal papers;
adamc@1025 62 return (List.mapX (fn (pid, ints) => <xml>
adamc@1025 63 <hr/>
adamc@1025 64 Paper #{[pid]}:
adamc@1025 65 <dyn signal={n <- List.foldl (fn (_, cg, _) total =>
adamc@1025 66 this <- CheckGroup.selected cg;
adamc@1025 67 total <- total;
adamc@1025 68 return (List.length this + total)) (return 0) ints;
adamc@1025 69 return (txt n)}/><br/>
adamc@1025 70
adamc@1025 71 {List.mapX (fn (int, _, ex) => <xml>
adamc@1025 72 {[intOut int]}: {Expandable.render ex}
adamc@1025 73 </xml>) ints}
adamc@1025 74 </xml>) papers)}/>
adamc@1025 75 </body></xml>
adamc@1025 76 end
adamc@1025 77 in
adamc@1025 78 <xml>
adamc@1025 79 <li><a link={assignPapers ()}> Assign papers to people</a></li>
adamc@1025 80 </xml>
adamc@1025 81 end
adamc@1025 82
adamc@1022 83 val linksForPc =
adamc@1022 84 let
adamc@1023 85 fun yourBids () =
adamc@1023 86 me <- getPcLogin;
adamc@1023 87 ps <- queryX (SELECT paper.Id, paper.{{M.paper}}, bid.Interest
adamc@1023 88 FROM paper LEFT JOIN bid ON bid.Paper = paper.Id
adamc@1023 89 AND bid.User = {[me.Id]})
adamc@1025 90 (fn r => <xml><tr>
adamc@1025 91 <td>{useMore (summarizePaper (r.Paper -- #Id))}</td>
adamc@1025 92 <td><entry>
adamc@1025 93 <hidden{#Paper} value={show r.Paper.Id}/>
adamc@1025 94 <select{#Bid}>
adamc@1025 95 {useMore (Select.selectChar ((#"-", "No") :: (#"_", "Maybe") :: (#"+", "Yes") :: [])
adamc@1025 96 r.Bid.Interest)}
adamc@1025 97 </select></entry></td>
adamc@1025 98 </tr></xml>);
adamc@1023 99 return <xml><body>
adamc@1023 100 <h1>Bid on papers</h1>
adamc@1023 101
adamc@1023 102 <form>
adamc@1023 103 <subforms{#Papers}><table>
adamc@1023 104 <tr> <th>Paper</th> <th>Your Bid</th> </tr>
adamc@1023 105 {ps}
adamc@1023 106 </table></subforms>
adamc@1023 107 <submit value="Change" action={changeBids}/>
adamc@1023 108 </form>
adamc@1023 109 </body></xml>
adamc@1023 110
adamc@1023 111 and changeBids r =
adamc@1023 112 me <- getPcLogin;
adamc@1023 113 List.app (fn {Paper = p, Bid = b} =>
adamc@1023 114 case b of
adamc@1023 115 "" => return ()
adamc@1023 116 | _ => let
adamc@1023 117 val p = readError p
adamc@1023 118 in
adamc@1023 119 (dml (DELETE FROM bid WHERE Paper = {[p]} AND User = {[me.Id]});
adamc@1023 120 dml (INSERT INTO bid (Paper, User, Interest)
adamc@1023 121 VALUES ({[p]}, {[me.Id]}, {[String.sub b 0]})))
adamc@1023 122 end) r.Papers;
adamc@1023 123 yourBids ()
adamc@1022 124 in
adamc@1022 125 <xml>
adamc@1023 126 <li> <a link={yourBids ()}>Bid on papers</a></li>
adamc@1022 127 </xml>
adamc@1022 128 end
adamc@1022 129
adamc@1022 130 con yourPaperTables = [Assignment = _]
adamc@1022 131 constraint [Paper] ~ yourPaperTables
adamc@1022 132 fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper]
adamc@1022 133 (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) =
adamc@1022 134 sql_inner_join fi (sql_from_table [#Assignment] assignment) (WHERE Paper.Id = Assignment.Paper)
adamc@1022 135 end