Mercurial > urweb

annotate demo/more/conference.ur @ 1009:59097824f19b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Viewing papers
author Adam Chlipala <adamc@hcoop.net>
date Thu, 22 Oct 2009 12:16:31 -0400
parents 1911e84df461
children 6b0f3853cc81
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@1008 5 constraint [Id, Document] ~ 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@1009 14 val summarizePaper : $(map fst paper) -> xbody
adamc@1001 15 end) = struct
adamc@1001 16
adamc@1003 17 table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool}
adamc@1003 18 PRIMARY KEY Id,
adamc@1003 19 CONSTRAINT Nam UNIQUE Nam
adamc@1003 20 sequence userId
adamc@1003 21
adamc@1008 22 con paper = [Id = int, Document = blob] ++ map fst M.paper
adamc@1003 23 table paper : paper
adamc@1003 24 PRIMARY KEY Id
adamc@1003 25 sequence paperId
adamc@1003 26
adamc@1003 27 con review = [Paper = int, User = int] ++ map fst M.review
adamc@1003 28 table review : review
adamc@1003 29 PRIMARY KEY (Paper, User),
adamc@1003 30 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
adamc@1003 31 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
adamc@1003 32 sequence reviewId
adamc@1003 33
adamc@1003 34 cookie login : {Id : int, Password : string}
adamc@1003 35
adamc@1004 36 val checkLogin =
adamc@1003 37 r <- getCookie login;
adamc@1003 38 case r of
adamc@1003 39 None => return None
adamc@1003 40 | Some r =>
adamc@1003 41 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc
adamc@1003 42 FROM user
adamc@1003 43 WHERE user.Id = {[r.Id]}
adamc@1003 44 AND user.Password = {[r.Password]})
adamc@1003 45
adamc@1009 46 fun checkPaper id =
adamc@1009 47 ro <- checkLogin;
adamc@1009 48 if (case ro of
adamc@1009 49 None => False
adamc@1009 50 | Some r => r.OnPc) then
adamc@1009 51 return ()
adamc@1009 52 else
adamc@1009 53 error <xml>You must be logged in to do that.</xml>
adamc@1009 54
adamc@1004 55 structure Users = BulkEdit.Make(struct
adamc@1004 56 con keyName = #Id
adamc@1004 57 val visible = {Nam = string "Name",
adamc@1004 58 Chair = bool "Chair?",
adamc@1004 59 OnPc = bool "On PC?"}
adamc@1004 60
adamc@1004 61 val title = "Users"
adamc@1004 62 val isAllowed =
adamc@1004 63 me <- checkLogin;
adamc@1004 64 return (Option.isSome me)
adamc@1004 65
adamc@1004 66 val t = user
adamc@1004 67 end)
adamc@1004 68
adamc@1004 69
adamc@1003 70 fun doRegister r =
adamc@1003 71 n <- oneRowE1 (SELECT COUNT( * ) AS N
adamc@1003 72 FROM user
adamc@1003 73 WHERE user.Nam = {[r.Nam]});
adamc@1003 74 if n > 0 then
adamc@1003 75 register (Some "Sorry; that username is taken.")
adamc@1003 76 else
adamc@1003 77 id <- nextval userId;
adamc@1003 78 dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc)
adamc@1003 79 VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE));
adamc@1003 80 setCookie login {Id = id, Password = r.Password};
adamc@1003 81 main ()
adamc@1003 82
adamc@1003 83 and register msg = return <xml><body>
adamc@1003 84 <h1>Registering a New Account</h1>
adamc@1003 85
adamc@1003 86 {case msg of
adamc@1003 87 None => <xml/>
adamc@1003 88 | Some msg => <xml><div>{[msg]}</div></xml>}
adamc@1003 89
adamc@1003 90 <form><table>
adamc@1003 91 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
adamc@1003 92 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
adamc@1003 93 <tr> <th><submit action={doRegister}/></th> </tr>
adamc@1003 94 </table></form>
adamc@1003 95 </body></xml>
adamc@1003 96
adamc@1006 97 and signin r =
adamc@1006 98 ro <- oneOrNoRowsE1 (SELECT user.Id AS N
adamc@1006 99 FROM user
adamc@1006 100 WHERE user.Nam = {[r.Nam]}
adamc@1006 101 AND user.Password = {[r.Password]});
adamc@1006 102 (case ro of
adamc@1006 103 None => return ()
adamc@1006 104 | Some id => setCookie login {Id = id, Password = r.Password});
adamc@1006 105 m <- main' ();
adamc@1006 106 return <xml><body>
adamc@1006 107 {case ro of
adamc@1006 108 None => <xml><div>Invalid username or password.</div></xml>
adamc@1006 109 | _ => <xml/>}
adamc@1006 110
adamc@1006 111 {m}
adamc@1006 112 </body></xml>
adamc@1006 113
adamc@1006 114 and main' () =
adamc@1004 115 me <- checkLogin;
adamc@1006 116 now <- now;
adamc@1006 117 return <xml><ul>
adamc@1003 118 {case me of
adamc@1006 119 None => <xml>
adamc@1006 120 <li><a link={register None}>Register for access</a></li>
adamc@1006 121 <li><b>Log in:</b> <form><table>
adamc@1006 122 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
adamc@1006 123 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
adamc@1006 124 <tr> <th><submit value="Log in" action={signin}/></th> </tr>
adamc@1006 125 </table></form></li>
adamc@1006 126 </xml>
adamc@1004 127 | Some me => <xml>
adamc@1004 128 <div>Welcome, {[me.Nam]}!</div>
adamc@1004 129
adamc@1004 130 {if me.Chair then
adamc@1004 131 <xml><li><a link={Users.main ()}>Manage users</a></li></xml>
adamc@1004 132 else
adamc@1004 133 <xml/>}
adamc@1006 134
adamc@1009 135 {if me.OnPc then
adamc@1009 136 <xml><li><a link={all ()}>All papers</a></li></xml>
adamc@1009 137 else
adamc@1009 138 <xml/>}
adamc@1009 139
adamc@1006 140 {if now < M.submissionDeadline then
adamc@1007 141 <xml><li><a link={submit ()}>Submit</a></li></xml>
adamc@1006 142 else
adamc@1006 143 <xml/>}
adamc@1004 144 </xml>}
adamc@1006 145 </ul></xml>
adamc@1006 146
adamc@1006 147 and main () =
adamc@1006 148 m <- main' ();
adamc@1006 149 return <xml><body>{m}</body></xml>
adamc@1001 150
adamc@1008 151 and submit () =
adamc@1008 152 let
adamc@1009 153 fun doSubmit r =
adamc@1009 154 id <- nextval paperId;
adamc@1009 155 dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)}
adamc@1009 156 ++ ensql M.paper (r -- #Document) M.paperFolder));
adamc@1009 157 return <xml><body>
adamc@1009 158 OK, done!
adamc@1009 159 </body></xml>
adamc@1008 160 in
adamc@1008 161 return <xml><body>
adamc@1008 162 <h1>Submit a Paper</h1>
adamc@1008 163
adamc@1008 164 <form>
adamc@1008 165 {allWidgets M.paper M.paperFolder}
adamc@1008 166 <b>Paper:</b> <upload{#Document}/><br/>
adamc@1008 167 <submit value="Submit" action={doSubmit}/>
adamc@1008 168 </form>
adamc@1008 169 </body></xml>
adamc@1008 170 end
adamc@1007 171
adamc@1009 172 and all () =
adamc@1009 173 ps <- queryX (SELECT paper.Id, paper.{{map fst M.paper}} FROM paper)
adamc@1009 174 (fn r => <xml><li><a link={one r.Paper.Id}>{M.summarizePaper (r.Paper -- #Id)}</a></li></xml>);
adamc@1009 175 return <xml><body>
adamc@1009 176 <h1>All Papers</h1>
adamc@1009 177
adamc@1009 178 <ul>
adamc@1009 179 {ps}
adamc@1009 180 </ul>
adamc@1009 181 </body></xml>
adamc@1009 182
adamc@1009 183 and one id =
adamc@1009 184 checkPaper id;
adamc@1009 185 ro <- oneOrNoRows (SELECT paper.{{map fst M.paper}}, octet_length(paper.Document) AS N
adamc@1009 186 FROM paper
adamc@1009 187 WHERE paper.Id = {[id]});
adamc@1009 188 case ro of
adamc@1009 189 None => error <xml>Paper not found!</xml>
adamc@1009 190 | Some r => return <xml><body>
adamc@1009 191 <h1>Paper #{[id]}</h1>
adamc@1009 192
adamc@1009 193 {allContent M.paper r.Paper M.paperFolder}<br/>
adamc@1009 194
adamc@1009 195 {if r.N = 0 then
adamc@1009 196 <xml><div>No paper uploaded yet.</div></xml>
adamc@1009 197 else
adamc@1009 198 <xml><a link={download id}>Download paper</a> ({[r.N]} bytes)</xml>}
adamc@1009 199 </body></xml>
adamc@1009 200
adamc@1009 201 and download id =
adamc@1009 202 checkPaper id;
adamc@1009 203 ro <- oneOrNoRows (SELECT paper.Document
adamc@1009 204 FROM paper
adamc@1009 205 WHERE paper.Id = {[id]});
adamc@1009 206 case ro of
adamc@1009 207 None => error <xml>Paper not found!</xml>
adamc@1009 208 | Some r => returnBlob r.Paper.Document (blessMime "application/pdf")
adamc@1009 209
adamc@1001 210 end