adamc@1022: functor Make(M : Conference.INPUT) = struct
adamc@1022:     open M
adamc@1022: 
adamc@1022:     table bid : {User : userId, Paper : paperId, Interest : char}
adamc@1022:           PRIMARY KEY (User, Paper)
adamc@1022: 
adamc@1022:     table assignment : {User : userId, Paper : paperId}
adamc@1022:           PRIMARY KEY (User, Paper)
adamc@1022: 
adamc@1025:     fun intOut ch =
adamc@1025:         case ch of
adamc@1025:             #"_" => "Maybe"
adamc@1025:           | #"-" => "No"
adamc@1025:           | #"+" => "Yes"
adamc@1025:           | _ => error <xml>Bid: Invalid Interest code</xml>
adamc@1025: 
adamc@1025:     val linksForChair =
adamc@1025:         let
adamc@1025:             fun assignPapers () =
adamc@1025:                 tup <- query (SELECT paper.Id, paper.{{M.paper}}, user.Id, user.Nam, bid.Interest
adamc@1025:                               FROM paper JOIN bid ON bid.Paper = paper.Id
adamc@1025:                                 JOIN user ON bid.User = user.Id
adamc@1025:                               ORDER BY paper.Id, bid.Interest, user.Nam)
adamc@1027:                        (fn r (paper, int, acc, ints, papers) =>
adamc@1027:                            if (case paper of None => False | Some r' => r'.Id = r.Paper.Id) then
adamc@1025:                                if int = r.Bid.Interest then
adamc@1027:                                    return (paper, int, (r.User.Id, r.User.Nam) :: acc, ints, papers)
adamc@1025:                                else
adamc@1027:                                    return (paper, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [],
adamc@1025:                                            (int, acc) :: ints, papers)
adamc@1025:                            else
adamc@1027:                                return (Some r.Paper, r.Bid.Interest,
adamc@1025:                                        (r.User.Id, r.User.Nam) :: [], [],
adamc@1027:                                        case paper of
adamc@1025:                                            None => papers
adamc@1027:                                          | Some r => (r.Id, r -- #Id, (int, acc) :: ints) :: papers))
adamc@1025:                        (None, #" ", [], [], []);
adamc@1025:                 let
adamc@1025:                     val papersL = case tup.1 of
adamc@1027:                                       Some r => (r.Id, r -- #Id, (tup.2, tup.3) :: tup.4) :: tup.5
adamc@1027:                                     | None => []
adamc@1025: 
adamc@1027:                     fun makePapers () = List.mapM (fn (pid, extra, ints) =>
adamc@1025:                                                       ints <- List.mapM (fn (int, users) =>
adamc@1025:                                                                             cg <- CheckGroup.create
adamc@1025:                                                                                       (List.mp
adamc@1025:                                                                                            (fn (id, nam) => (id, txt nam,
adamc@1025:                                                                                                              False))
adamc@1025:                                                                                            users);
adamc@1025:                                                                             ex <- Expandable.create
adamc@1025:                                                                                       (CheckGroup.render cg);
adamc@1025:                                                                             return (int, cg, ex)) ints;
adamc@1027:                                                       return (pid, extra, ints)) papersL
adamc@1027: 
adamc@1027:                     fun saveAssignment ls =
adamc@1027:                         dml (DELETE FROM assignment WHERE TRUE);
adamc@1027:                         List.app (fn (pid, uids) =>
adamc@1027:                                      List.app (fn uid => dml (INSERT INTO assignment (Paper, User)
adamc@1027:                                                               VALUES ({[pid]}, {[uid]}))) uids) ls
adamc@1025:                 in
adamc@1025:                     papers <- source [];
adamc@1025: 
adamc@1025:                     return <xml><body onload={papersL <- makePapers ();
adamc@1025:                                               set papers papersL}>
adamc@1025:                       <h1>Assign papers</h1>
adamc@1025: 
adamc@1025:                       <dyn signal={papers <- signal papers;
adamc@1027:                                    return (List.mapX (fn (pid, extra, ints) => <xml>
adamc@1025:                                      <hr/>
adamc@1027:                                      #{[pid]}: {summarizePaper extra}:
adamc@1025:                                      <dyn signal={n <- List.foldl (fn (_, cg, _) total =>
adamc@1025:                                                                       this <- CheckGroup.selected cg;
adamc@1025:                                                                       total <- total;
adamc@1025:                                                                       return (List.length this + total)) (return 0) ints;
adamc@1025:                                                   return (txt n)}/><br/>
adamc@1025:                                        
adamc@1025:                                      {List.mapX (fn (int, _, ex) => <xml>
adamc@1025:                                        {[intOut int]}: {Expandable.render ex}
adamc@1025:                                      </xml>) ints}
adamc@1025:                                    </xml>) papers)}/>
adamc@1027: 
adamc@1027:                         <br/>
adamc@1027:                         <button value="Save" onclick={papers <- get papers;
adamc@1027:                                                       ls <- List.mapM (fn (pid, _, ints) =>
adamc@1027:                                                                           ints <- List.mapM (fn (_, cg, _) =>
adamc@1027:                                                                                                 current
adamc@1027:                                                                                                 (CheckGroup.selected cg))
adamc@1027:                                                                                             ints;
adamc@1027:                                                                           return (pid, List.foldl List.append [] ints))
adamc@1027:                                                                       papers;
adamc@1027:                                                       rpc (saveAssignment ls)}/>
adamc@1025:                     </body></xml>
adamc@1025:                 end
adamc@1025:         in
adamc@1025:             <xml>
adamc@1025:               <li><a link={assignPapers ()}> Assign papers to people</a></li>
adamc@1025:             </xml>
adamc@1025:         end
adamc@1025: 
adamc@1022:     val linksForPc =
adamc@1022:         let
adamc@1023:             fun yourBids () =
adamc@1023:                 me <- getPcLogin;
adamc@1023:                 ps <- queryX (SELECT paper.Id, paper.{{M.paper}}, bid.Interest
adamc@1023:                               FROM paper LEFT JOIN bid ON bid.Paper = paper.Id
adamc@1023:                                 AND bid.User = {[me.Id]})
adamc@1025:                              (fn r => <xml><tr>
adamc@1025:                                <td>{useMore (summarizePaper (r.Paper -- #Id))}</td>
adamc@1025:                                <td><entry>
adamc@1025:                                  <hidden{#Paper} value={show r.Paper.Id}/>
adamc@1025:                                  <select{#Bid}>
adamc@1025:                                    {useMore (Select.selectChar ((#"-", "No") :: (#"_", "Maybe") :: (#"+", "Yes") :: [])
adamc@1025:                                                       r.Bid.Interest)}
adamc@1025:                                  </select></entry></td>
adamc@1025:                              </tr></xml>);
adamc@1023:                 return <xml><body>
adamc@1023:                   <h1>Bid on papers</h1>
adamc@1023: 
adamc@1023:                   <form>
adamc@1023:                     <subforms{#Papers}><table>
adamc@1023:                       <tr> <th>Paper</th> <th>Your Bid</th> </tr>
adamc@1023:                       {ps}
adamc@1023:                     </table></subforms>
adamc@1023:                     <submit value="Change" action={changeBids}/>
adamc@1023:                   </form>
adamc@1023:                 </body></xml>
adamc@1023: 
adamc@1023:             and changeBids r =
adamc@1023:                 me <- getPcLogin;
adamc@1023:                 List.app (fn {Paper = p, Bid = b} =>
adamc@1023:                              case b of
adamc@1023:                                  "" => return ()
adamc@1023:                                | _ => let
adamc@1023:                                      val p = readError p
adamc@1023:                                  in
adamc@1023:                                      (dml (DELETE FROM bid WHERE Paper = {[p]} AND User = {[me.Id]});
adamc@1023:                                       dml (INSERT INTO bid (Paper, User, Interest)
adamc@1023:                                            VALUES ({[p]}, {[me.Id]}, {[String.sub b 0]})))
adamc@1023:                                  end) r.Papers;
adamc@1023:                 yourBids ()
adamc@1022:         in
adamc@1022:             <xml>
adamc@1023:               <li> <a link={yourBids ()}>Bid on papers</a></li>
adamc@1022:             </xml>
adamc@1022:         end
adamc@1022: 
adamc@1022:     con yourPaperTables = [Assignment = _]
adamc@1022:     constraint [Paper] ~ yourPaperTables
adamc@1022:     fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper]
adamc@1027:         (uid : userId) (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) =
adamc@1027:         sql_inner_join fi (sql_from_table [#Assignment] assignment)
adamc@1027:                        (WHERE Paper.Id = Assignment.Paper AND Assignment.User = {[uid]})
adamc@1022: end