Mercurial > urweb

annotate demo/more/conference.ur @ 1006:5a0f6ec208ce

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Checking deadline; sign-in
author Adam Chlipala <adamc@hcoop.net>
date Thu, 22 Oct 2009 11:15:37 -0400
parents a87495bcaeec
children d3af9e54c828
rev   line source
adamc@1004 1 open Meta
adamc@1001 2
adamc@1001 3 functor Make(M : sig
adamc@1003 4 con paper :: {(Type * Type)}
adamc@1003 5 constraint [Id, Title] ~ paper
adamc@1003 6 val paper : $(map meta paper)
adamc@1003 7
adamc@1001 8 con review :: {(Type * Type)}
adamc@1003 9 constraint [Paper, User] ~ review
adamc@1003 10 val review : $(map meta review)
adamc@1006 11
adamc@1006 12 val submissionDeadline : time
adamc@1001 13 end) = struct
adamc@1001 14
adamc@1003 15 table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool}
adamc@1003 16 PRIMARY KEY Id,
adamc@1003 17 CONSTRAINT Nam UNIQUE Nam
adamc@1003 18 sequence userId
adamc@1003 19
adamc@1003 20 con paper = [Id = int, Title = string] ++ map fst M.paper
adamc@1003 21 table paper : paper
adamc@1003 22 PRIMARY KEY Id
adamc@1003 23 sequence paperId
adamc@1003 24
adamc@1003 25 con review = [Paper = int, User = int] ++ map fst M.review
adamc@1003 26 table review : review
adamc@1003 27 PRIMARY KEY (Paper, User),
adamc@1003 28 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
adamc@1003 29 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
adamc@1003 30 sequence reviewId
adamc@1003 31
adamc@1003 32 cookie login : {Id : int, Password : string}
adamc@1003 33
adamc@1004 34 val checkLogin =
adamc@1003 35 r <- getCookie login;
adamc@1003 36 case r of
adamc@1003 37 None => return None
adamc@1003 38 | Some r =>
adamc@1003 39 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc
adamc@1003 40 FROM user
adamc@1003 41 WHERE user.Id = {[r.Id]}
adamc@1003 42 AND user.Password = {[r.Password]})
adamc@1003 43
adamc@1004 44 structure Users = BulkEdit.Make(struct
adamc@1004 45 con keyName = #Id
adamc@1004 46 val visible = {Nam = string "Name",
adamc@1004 47 Chair = bool "Chair?",
adamc@1004 48 OnPc = bool "On PC?"}
adamc@1004 49
adamc@1004 50 val title = "Users"
adamc@1004 51 val isAllowed =
adamc@1004 52 me <- checkLogin;
adamc@1004 53 return (Option.isSome me)
adamc@1004 54
adamc@1004 55 val t = user
adamc@1004 56 end)
adamc@1004 57
adamc@1004 58
adamc@1003 59 fun doRegister r =
adamc@1003 60 n <- oneRowE1 (SELECT COUNT( * ) AS N
adamc@1003 61 FROM user
adamc@1003 62 WHERE user.Nam = {[r.Nam]});
adamc@1003 63 if n > 0 then
adamc@1003 64 register (Some "Sorry; that username is taken.")
adamc@1003 65 else
adamc@1003 66 id <- nextval userId;
adamc@1003 67 dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc)
adamc@1003 68 VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE));
adamc@1003 69 setCookie login {Id = id, Password = r.Password};
adamc@1003 70 main ()
adamc@1003 71
adamc@1003 72 and register msg = return <xml><body>
adamc@1003 73 <h1>Registering a New Account</h1>
adamc@1003 74
adamc@1003 75 {case msg of
adamc@1003 76 None => <xml/>
adamc@1003 77 | Some msg => <xml><div>{[msg]}</div></xml>}
adamc@1003 78
adamc@1003 79 <form><table>
adamc@1003 80 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
adamc@1003 81 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
adamc@1003 82 <tr> <th><submit action={doRegister}/></th> </tr>
adamc@1003 83 </table></form>
adamc@1003 84 </body></xml>
adamc@1003 85
adamc@1006 86 and signin r =
adamc@1006 87 ro <- oneOrNoRowsE1 (SELECT user.Id AS N
adamc@1006 88 FROM user
adamc@1006 89 WHERE user.Nam = {[r.Nam]}
adamc@1006 90 AND user.Password = {[r.Password]});
adamc@1006 91 (case ro of
adamc@1006 92 None => return ()
adamc@1006 93 | Some id => setCookie login {Id = id, Password = r.Password});
adamc@1006 94 m <- main' ();
adamc@1006 95 return <xml><body>
adamc@1006 96 {case ro of
adamc@1006 97 None => <xml><div>Invalid username or password.</div></xml>
adamc@1006 98 | _ => <xml/>}
adamc@1006 99
adamc@1006 100 {m}
adamc@1006 101 </body></xml>
adamc@1006 102
adamc@1006 103 and main' () =
adamc@1004 104 me <- checkLogin;
adamc@1006 105 now <- now;
adamc@1006 106 return <xml><ul>
adamc@1003 107 {case me of
adamc@1006 108 None => <xml>
adamc@1006 109 <li><a link={register None}>Register for access</a></li>
adamc@1006 110 <li><b>Log in:</b> <form><table>
adamc@1006 111 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
adamc@1006 112 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
adamc@1006 113 <tr> <th><submit value="Log in" action={signin}/></th> </tr>
adamc@1006 114 </table></form></li>
adamc@1006 115 </xml>
adamc@1004 116 | Some me => <xml>
adamc@1004 117 <div>Welcome, {[me.Nam]}!</div>
adamc@1004 118
adamc@1004 119 {if me.Chair then
adamc@1004 120 <xml><li><a link={Users.main ()}>Manage users</a></li></xml>
adamc@1004 121 else
adamc@1004 122 <xml/>}
adamc@1006 123
adamc@1006 124 {if now < M.submissionDeadline then
adamc@1006 125 <xml><li>Submit</li></xml>
adamc@1006 126 else
adamc@1006 127 <xml/>}
adamc@1004 128 </xml>}
adamc@1006 129 </ul></xml>
adamc@1006 130
adamc@1006 131 and main () =
adamc@1006 132 m <- main' ();
adamc@1006 133 return <xml><body>{m}</body></xml>
adamc@1001 134
adamc@1001 135 end