demo/more/bid.ur


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135

functor Make(M : Conference.INPUT) = struct
    open M

    table bid : {User : userId, Paper : paperId, Interest : char}
          PRIMARY KEY (User, Paper)

    table assignment : {User : userId, Paper : paperId}
          PRIMARY KEY (User, Paper)

    fun intOut ch =
        case ch of
            #"_" => "Maybe"
          | #"-" => "No"
          | #"+" => "Yes"
          | _ => error <xml>Bid: Invalid Interest code</xml>

    val linksForChair =
        let
            fun assignPapers () =
                tup <- query (SELECT paper.Id, paper.{{M.paper}}, user.Id, user.Nam, bid.Interest
                              FROM paper JOIN bid ON bid.Paper = paper.Id
                                JOIN user ON bid.User = user.Id
                              ORDER BY paper.Id, bid.Interest, user.Nam)
                       (fn r (pid, int, acc, ints, papers) =>
                           if pid = Some r.Paper.Id then
                               if int = r.Bid.Interest then
                                   return (pid, int, (r.User.Id, r.User.Nam) :: acc, ints, papers)
                               else
                                   return (pid, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [],
                                           (int, acc) :: ints, papers)
                           else
                               return (Some r.Paper.Id, r.Bid.Interest,
                                       (r.User.Id, r.User.Nam) :: [], [],
                                       case pid of
                                           None => papers
                                         | Some pid => (pid, (int, acc) :: ints) :: papers))
                       (None, #" ", [], [], []);
                let
                    val papersL = case tup.1 of
                                      Some pid => (pid, (tup.2, tup.3) :: tup.4) :: tup.5
                                    | _ => []

                    fun makePapers () = List.mapM (fn (pid, ints) =>
                                                      ints <- List.mapM (fn (int, users) =>
                                                                            cg <- CheckGroup.create
                                                                                      (List.mp
                                                                                           (fn (id, nam) => (id, txt nam,
                                                                                                             False))
                                                                                           users);
                                                                            ex <- Expandable.create
                                                                                      (CheckGroup.render cg);
                                                                            return (int, cg, ex)) ints;
                                                      return (pid, ints)) papersL
                in
                    papers <- source [];

                    return <xml><body onload={papersL <- makePapers ();
                                              set papers papersL}>
                      <h1>Assign papers</h1>

                      <dyn signal={papers <- signal papers;
                                   return (List.mapX (fn (pid, ints) => <xml>
                                     <hr/>
                                     Paper #{[pid]}:
                                     <dyn signal={n <- List.foldl (fn (_, cg, _) total =>
                                                                      this <- CheckGroup.selected cg;
                                                                      total <- total;
                                                                      return (List.length this + total)) (return 0) ints;
                                                  return (txt n)}/><br/>
                                       
                                     {List.mapX (fn (int, _, ex) => <xml>
                                       {[intOut int]}: {Expandable.render ex}
                                     </xml>) ints}
                                   </xml>) papers)}/>
                    </body></xml>
                end
        in
            <xml>
              <li><a link={assignPapers ()}> Assign papers to people</a></li>
            </xml>
        end

    val linksForPc =
        let
            fun yourBids () =
                me <- getPcLogin;
                ps <- queryX (SELECT paper.Id, paper.{{M.paper}}, bid.Interest
                              FROM paper LEFT JOIN bid ON bid.Paper = paper.Id
                                AND bid.User = {[me.Id]})
                             (fn r => <xml><tr>
                               <td>{useMore (summarizePaper (r.Paper -- #Id))}</td>
                               <td><entry>
                                 <hidden{#Paper} value={show r.Paper.Id}/>
                                 <select{#Bid}>
                                   {useMore (Select.selectChar ((#"-", "No") :: (#"_", "Maybe") :: (#"+", "Yes") :: [])
                                                      r.Bid.Interest)}
                                 </select></entry></td>
                             </tr></xml>);
                return <xml><body>
                  <h1>Bid on papers</h1>

                  <form>
                    <subforms{#Papers}><table>
                      <tr> <th>Paper</th> <th>Your Bid</th> </tr>
                      {ps}
                    </table></subforms>
                    <submit value="Change" action={changeBids}/>
                  </form>
                </body></xml>

            and changeBids r =
                me <- getPcLogin;
                List.app (fn {Paper = p, Bid = b} =>
                             case b of
                                 "" => return ()
                               | _ => let
                                     val p = readError p
                                 in
                                     (dml (DELETE FROM bid WHERE Paper = {[p]} AND User = {[me.Id]});
                                      dml (INSERT INTO bid (Paper, User, Interest)
                                           VALUES ({[p]}, {[me.Id]}, {[String.sub b 0]})))
                                 end) r.Papers;
                yourBids ()
        in
            <xml>
              <li> <a link={yourBids ()}>Bid on papers</a></li>
            </xml>
        end

    con yourPaperTables = [Assignment = _]
    constraint [Paper] ~ yourPaperTables
    fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper]
        (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) =
        sql_inner_join fi (sql_from_table [#Assignment] assignment) (WHERE Paper.Id = Assignment.Paper)
end