Mercurial > urweb

comparison 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
comparison
equal deleted inserted replaced
1024:93415bcf54c0 1025:7facf72aaf0a
5 PRIMARY KEY (User, Paper) 5 PRIMARY KEY (User, Paper)
6 6
7 table assignment : {User : userId, Paper : paperId} 7 table assignment : {User : userId, Paper : paperId}
8 PRIMARY KEY (User, Paper) 8 PRIMARY KEY (User, Paper)
9 9
10 fun intOut ch =
11 case ch of
12 #"_" => "Maybe"
13 | #"-" => "No"
14 | #"+" => "Yes"
15 | _ => error <xml>Bid: Invalid Interest code</xml>
16
17 val linksForChair =
18 let
19 fun assignPapers () =
20 tup <- query (SELECT paper.Id, paper.{{M.paper}}, user.Id, user.Nam, bid.Interest
21 FROM paper JOIN bid ON bid.Paper = paper.Id
22 JOIN user ON bid.User = user.Id
23 ORDER BY paper.Id, bid.Interest, user.Nam)
24 (fn r (pid, int, acc, ints, papers) =>
25 if pid = Some r.Paper.Id then
26 if int = r.Bid.Interest then
27 return (pid, int, (r.User.Id, r.User.Nam) :: acc, ints, papers)
28 else
29 return (pid, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [],
30 (int, acc) :: ints, papers)
31 else
32 return (Some r.Paper.Id, r.Bid.Interest,
33 (r.User.Id, r.User.Nam) :: [], [],
34 case pid of
35 None => papers
36 | Some pid => (pid, (int, acc) :: ints) :: papers))
37 (None, #" ", [], [], []);
38 let
39 val papersL = case tup.1 of
40 Some pid => (pid, (tup.2, tup.3) :: tup.4) :: tup.5
41 | _ => []
42
43 fun makePapers () = List.mapM (fn (pid, ints) =>
44 ints <- List.mapM (fn (int, users) =>
45 cg <- CheckGroup.create
46 (List.mp
47 (fn (id, nam) => (id, txt nam,
48 False))
49 users);
50 ex <- Expandable.create
51 (CheckGroup.render cg);
52 return (int, cg, ex)) ints;
53 return (pid, ints)) papersL
54 in
55 papers <- source [];
56
57 return <xml><body onload={papersL <- makePapers ();
58 set papers papersL}>
59 <h1>Assign papers</h1>
60
61 <dyn signal={papers <- signal papers;
62 return (List.mapX (fn (pid, ints) => <xml>
63 <hr/>
64 Paper #{[pid]}:
65 <dyn signal={n <- List.foldl (fn (_, cg, _) total =>
66 this <- CheckGroup.selected cg;
67 total <- total;
68 return (List.length this + total)) (return 0) ints;
69 return (txt n)}/><br/>
70
71 {List.mapX (fn (int, _, ex) => <xml>
72 {[intOut int]}: {Expandable.render ex}
73 </xml>) ints}
74 </xml>) papers)}/>
75 </body></xml>
76 end
77 in
78 <xml>
79 <li><a link={assignPapers ()}> Assign papers to people</a></li>
80 </xml>
81 end
82
10 val linksForPc = 83 val linksForPc =
11 let 84 let
12 fun yourBids () = 85 fun yourBids () =
13 me <- getPcLogin; 86 me <- getPcLogin;
14 ps <- queryX (SELECT paper.Id, paper.{{M.paper}}, bid.Interest 87 ps <- queryX (SELECT paper.Id, paper.{{M.paper}}, bid.Interest
15 FROM paper LEFT JOIN bid ON bid.Paper = paper.Id 88 FROM paper LEFT JOIN bid ON bid.Paper = paper.Id
16 AND bid.User = {[me.Id]}) 89 AND bid.User = {[me.Id]})
17 (fn r => <xml><entry> 90 (fn r => <xml><tr>
18 <hidden{#Paper} value={show r.Paper.Id}/> 91 <td>{useMore (summarizePaper (r.Paper -- #Id))}</td>
19 {useMore <xml><tr> 92 <td><entry>
20 <td>{summarizePaper (r.Paper -- #Id)}</td> 93 <hidden{#Paper} value={show r.Paper.Id}/>
21 <td><select{#Bid}> 94 <select{#Bid}>
22 {Select.selectChar ((#"-", "No") :: (#"_", "Maybe") :: (#"+", "Yes") :: []) 95 {useMore (Select.selectChar ((#"-", "No") :: (#"_", "Maybe") :: (#"+", "Yes") :: [])
23 r.Bid.Interest} 96 r.Bid.Interest)}
24 </select></td> 97 </select></entry></td>
25 </tr></xml>} 98 </tr></xml>);
26 </entry></xml>);
27 return <xml><body> 99 return <xml><body>
28 <h1>Bid on papers</h1> 100 <h1>Bid on papers</h1>
29 101
30 <form> 102 <form>
31 <subforms{#Papers}><table> 103 <subforms{#Papers}><table>