Mercurial > urweb

comparison demo/more/bid.ur @ 1027:be1aec7333a5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Saving paper assignments
author Adam Chlipala <adamc@hcoop.net>
date Mon, 02 Nov 2009 14:11:08 -0500
parents 7facf72aaf0a
children 8b7971e74335
comparison
equal deleted inserted replaced
1026:c1f49f6ba856 1027:be1aec7333a5
19 fun assignPapers () = 19 fun assignPapers () =
20 tup <- query (SELECT paper.Id, paper.{{M.paper}}, user.Id, user.Nam, bid.Interest 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 21 FROM paper JOIN bid ON bid.Paper = paper.Id
22 JOIN user ON bid.User = user.Id 22 JOIN user ON bid.User = user.Id
23 ORDER BY paper.Id, bid.Interest, user.Nam) 23 ORDER BY paper.Id, bid.Interest, user.Nam)
24 (fn r (pid, int, acc, ints, papers) => 24 (fn r (paper, int, acc, ints, papers) =>
25 if pid = Some r.Paper.Id then 25 if (case paper of None => False | Some r' => r'.Id = r.Paper.Id) then
26 if int = r.Bid.Interest then 26 if int = r.Bid.Interest then
27 return (pid, int, (r.User.Id, r.User.Nam) :: acc, ints, papers) 27 return (paper, int, (r.User.Id, r.User.Nam) :: acc, ints, papers)
28 else 28 else
29 return (pid, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [], 29 return (paper, r.Bid.Interest, (r.User.Id, r.User.Nam) :: [],
30 (int, acc) :: ints, papers) 30 (int, acc) :: ints, papers)
31 else 31 else
32 return (Some r.Paper.Id, r.Bid.Interest, 32 return (Some r.Paper, r.Bid.Interest,
33 (r.User.Id, r.User.Nam) :: [], [], 33 (r.User.Id, r.User.Nam) :: [], [],
34 case pid of 34 case paper of
35 None => papers 35 None => papers
36 | Some pid => (pid, (int, acc) :: ints) :: papers)) 36 | Some r => (r.Id, r -- #Id, (int, acc) :: ints) :: papers))
37 (None, #" ", [], [], []); 37 (None, #" ", [], [], []);
38 let 38 let
39 val papersL = case tup.1 of 39 val papersL = case tup.1 of
40 Some pid => (pid, (tup.2, tup.3) :: tup.4) :: tup.5 40 Some r => (r.Id, r -- #Id, (tup.2, tup.3) :: tup.4) :: tup.5
41 | _ => [] 41 | None => []
42 42
43 fun makePapers () = List.mapM (fn (pid, ints) => 43 fun makePapers () = List.mapM (fn (pid, extra, ints) =>
44 ints <- List.mapM (fn (int, users) => 44 ints <- List.mapM (fn (int, users) =>
45 cg <- CheckGroup.create 45 cg <- CheckGroup.create
46 (List.mp 46 (List.mp
47 (fn (id, nam) => (id, txt nam, 47 (fn (id, nam) => (id, txt nam,
48 False)) 48 False))
49 users); 49 users);
50 ex <- Expandable.create 50 ex <- Expandable.create
51 (CheckGroup.render cg); 51 (CheckGroup.render cg);
52 return (int, cg, ex)) ints; 52 return (int, cg, ex)) ints;
53 return (pid, ints)) papersL 53 return (pid, extra, ints)) papersL
54
55 fun saveAssignment ls =
56 dml (DELETE FROM assignment WHERE TRUE);
57 List.app (fn (pid, uids) =>
58 List.app (fn uid => dml (INSERT INTO assignment (Paper, User)
59 VALUES ({[pid]}, {[uid]}))) uids) ls
54 in 60 in
55 papers <- source []; 61 papers <- source [];
56 62
57 return <xml><body onload={papersL <- makePapers (); 63 return <xml><body onload={papersL <- makePapers ();
58 set papers papersL}> 64 set papers papersL}>
59 <h1>Assign papers</h1> 65 <h1>Assign papers</h1>
60 66
61 <dyn signal={papers <- signal papers; 67 <dyn signal={papers <- signal papers;
62 return (List.mapX (fn (pid, ints) => <xml> 68 return (List.mapX (fn (pid, extra, ints) => <xml>
63 <hr/> 69 <hr/>
64 Paper #{[pid]}: 70 #{[pid]}: {summarizePaper extra}:
65 <dyn signal={n <- List.foldl (fn (_, cg, _) total => 71 <dyn signal={n <- List.foldl (fn (_, cg, _) total =>
66 this <- CheckGroup.selected cg; 72 this <- CheckGroup.selected cg;
67 total <- total; 73 total <- total;
68 return (List.length this + total)) (return 0) ints; 74 return (List.length this + total)) (return 0) ints;
69 return (txt n)}/><br/> 75 return (txt n)}/><br/>
70 76
71 {List.mapX (fn (int, _, ex) => <xml> 77 {List.mapX (fn (int, _, ex) => <xml>
72 {[intOut int]}: {Expandable.render ex} 78 {[intOut int]}: {Expandable.render ex}
73 </xml>) ints} 79 </xml>) ints}
74 </xml>) papers)}/> 80 </xml>) papers)}/>
81
82 <br/>
83 <button value="Save" onclick={papers <- get papers;
84 ls <- List.mapM (fn (pid, _, ints) =>
85 ints <- List.mapM (fn (_, cg, _) =>
86 current
87 (CheckGroup.selected cg))
88 ints;
89 return (pid, List.foldl List.append [] ints))
90 papers;
91 rpc (saveAssignment ls)}/>
75 </body></xml> 92 </body></xml>
76 end 93 end
77 in 94 in
78 <xml> 95 <xml>
79 <li><a link={assignPapers ()}> Assign papers to people</a></li> 96 <li><a link={assignPapers ()}> Assign papers to people</a></li>
128 end 145 end
129 146
130 con yourPaperTables = [Assignment = _] 147 con yourPaperTables = [Assignment = _]
131 constraint [Paper] ~ yourPaperTables 148 constraint [Paper] ~ yourPaperTables
132 fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper] 149 fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper]
133 (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) = 150 (uid : userId) (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) =
134 sql_inner_join fi (sql_from_table [#Assignment] assignment) (WHERE Paper.Id = Assignment.Paper) 151 sql_inner_join fi (sql_from_table [#Assignment] assignment)
152 (WHERE Paper.Id = Assignment.Paper AND Assignment.User = {[uid]})
135 end 153 end