comparison demo/more/bid.ur @ 1023:e46227efcbba

Bidding interface
author Adam Chlipala <adamc@hcoop.net>
date Sun, 01 Nov 2009 10:20:20 -0500
parents 4de35df3d545
children 7facf72aaf0a
comparison
equal deleted inserted replaced
1022:4de35df3d545 1023:e46227efcbba
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 isOnPc id =
11 ro <- oneOrNoRows1 (SELECT user.OnPc
12 FROM user
13 WHERE user.Id = {[id]});
14 return (case ro of
15 None => False
16 | Some r => r.OnPc)
17
18 val linksForPc = 10 val linksForPc =
19 let 11 let
20 fun bid () = 12 fun yourBids () =
21 me <- getLogin; 13 me <- getPcLogin;
22 return <xml>Bidding time!</xml> 14 ps <- queryX (SELECT paper.Id, paper.{{M.paper}}, bid.Interest
15 FROM paper LEFT JOIN bid ON bid.Paper = paper.Id
16 AND bid.User = {[me.Id]})
17 (fn r => <xml><entry>
18 <hidden{#Paper} value={show r.Paper.Id}/>
19 {useMore <xml><tr>
20 <td>{summarizePaper (r.Paper -- #Id)}</td>
21 <td><select{#Bid}>
22 {Select.selectChar ((#"-", "No") :: (#"_", "Maybe") :: (#"+", "Yes") :: [])
23 r.Bid.Interest}
24 </select></td>
25 </tr></xml>}
26 </entry></xml>);
27 return <xml><body>
28 <h1>Bid on papers</h1>
29
30 <form>
31 <subforms{#Papers}><table>
32 <tr> <th>Paper</th> <th>Your Bid</th> </tr>
33 {ps}
34 </table></subforms>
35 <submit value="Change" action={changeBids}/>
36 </form>
37 </body></xml>
38
39 and changeBids r =
40 me <- getPcLogin;
41 List.app (fn {Paper = p, Bid = b} =>
42 case b of
43 "" => return ()
44 | _ => let
45 val p = readError p
46 in
47 (dml (DELETE FROM bid WHERE Paper = {[p]} AND User = {[me.Id]});
48 dml (INSERT INTO bid (Paper, User, Interest)
49 VALUES ({[p]}, {[me.Id]}, {[String.sub b 0]})))
50 end) r.Papers;
51 yourBids ()
23 in 52 in
24 <xml> 53 <xml>
25 <li> <a link={bid ()}>Bid on papers</a></li> 54 <li> <a link={yourBids ()}>Bid on papers</a></li>
26 </xml> 55 </xml>
27 end 56 end
28 57
29 con yourPaperTables = [Assignment = _] 58 con yourPaperTables = [Assignment = _]
30 constraint [Paper] ~ yourPaperTables 59 constraint [Paper] ~ yourPaperTables