Mercurial > urweb

annotate demo/more/conference.ur @ 1007:d3af9e54c828

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