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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156

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, assignment.User
                              FROM paper JOIN bid ON bid.Paper = paper.Id
                                JOIN user ON bid.User = user.Id
                                LEFT JOIN assignment ON assignment.Paper = paper.Id AND assignment.User = user.Id
                              ORDER BY paper.Id, bid.Interest, user.Nam)
                       (fn r (paper, int, acc, ints, papers) =>
                           if (case paper of None => False | Some r' => r'.Id = r.Paper.Id) then
                               if int = r.Bid.Interest then
                                   return (paper, int, (r.User.Id, r.User.Nam, Option.isSome r.Assignment.User) :: acc,
                                           ints, papers)
                               else
                                   return (paper, r.Bid.Interest, (r.User.Id, r.User.Nam,
                                                                   Option.isSome r.Assignment.User) :: [],
                                           (int, acc) :: ints, papers)
                           else
                               return (Some r.Paper, r.Bid.Interest,
                                       (r.User.Id, r.User.Nam, Option.isSome r.Assignment.User) :: [], [],
                                       case paper of
                                           None => papers
                                         | Some r => (r.Id, r -- #Id, (int, acc) :: ints) :: papers))
                       (None, #" ", [], [], []);
                let
                    val papersL = case tup.1 of
                                      Some r => (r.Id, r -- #Id, (tup.2, tup.3) :: tup.4) :: tup.5
                                    | None => []

                    fun makePapers () = List.mapM (fn (pid, extra, ints) =>
                                                      ints <- List.mapM (fn (int, users) =>
                                                                            cg <- CheckGroup.create
                                                                                      (List.mp
                                                                                           (fn (id, nam, sel) =>
                                                                                               (id, txt nam, sel))
                                                                                           users);
                                                                            ex <- Expandable.create
                                                                                      (CheckGroup.render cg);
                                                                            return (int, cg, ex)) ints;
                                                      return (pid, extra, ints)) papersL

                    fun saveAssignment ls =
                        dml (DELETE FROM assignment WHERE TRUE);
                        List.app (fn (pid, uids) =>
                                     List.app (fn uid => dml (INSERT INTO assignment (Paper, User)
                                                              VALUES ({[pid]}, {[uid]}))) uids) ls
                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, extra, ints) => <xml>
                                     <hr/>
                                     #{[pid]}: {summarizePaper extra}:
                                     <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)}/>

                        <br/>
                        <button value="Save" onclick={papers <- get papers;
                                                      ls <- List.mapM (fn (pid, _, ints) =>
                                                                          ints <- List.mapM (fn (_, cg, _) =>
                                                                                                current
                                                                                                (CheckGroup.selected cg))
                                                                                            ints;
                                                                          return (pid, List.foldl List.append [] ints))
                                                                      papers;
                                                      rpc (saveAssignment ls)}/>
                    </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]
        (uid : userId) (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) =
        sql_inner_join fi (sql_from_table [#Assignment] assignment)
                       (WHERE Paper.Id = Assignment.Paper AND Assignment.User = {[uid]})
end