Mercurial > urweb

annotate demo/more/conference.ur @ 1022:4de35df3d545

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Start of bidding implementation compiles
author Adam Chlipala <adamc@hcoop.net>
date Sat, 31 Oct 2009 15:51:50 -0400
parents e47303e5d73d
children e46227efcbba
rev   line source
adamc@1022 1 signature INPUT = sig
adamc@1022 2 con paper :: {(Type * Type)}
adamc@1022 3 constraint [Id, Document] ~ paper
adamc@1022 4
adamc@1022 5 type userId
adamc@1022 6 val userId_inj : sql_injectable_prim userId
adamc@1022 7 table user : {Id : userId, Nam : string, Password : string, Chair : bool, OnPc : bool}
adamc@1022 8 PRIMARY KEY Id,
adamc@1022 9 CONSTRAINT Nam UNIQUE Nam
adamc@1022 10
adamc@1022 11 type paperId
adamc@1022 12 val paperId_inj : sql_injectable_prim paperId
adamc@1022 13 table paper : ([Id = paperId, Document = blob] ++ map fst paper)
adamc@1022 14 PRIMARY KEY Id
adamc@1022 15
adamc@1022 16 val checkLogin : transaction (option {Id : userId, Nam : string, Chair : bool, OnPc : bool})
adamc@1022 17 val getLogin : transaction {Id : userId, Nam : string, Chair : bool, OnPc : bool}
adamc@1022 18 end
adamc@1022 19
adamc@1022 20 signature OUTPUT = sig
adamc@1022 21 type userId
adamc@1022 22 type paperId
adamc@1022 23
adamc@1022 24 val linksForPc : xbody
adamc@1022 25
adamc@1022 26 con yourPaperTables :: {{Type}}
adamc@1022 27 constraint [Paper] ~ yourPaperTables
adamc@1022 28 val joinYourPaper : tabs ::: {{Type}} -> paper ::: {Type}
adamc@1022 29 -> [[Paper] ~ tabs] => [[Paper] ~ yourPaperTables] => [tabs ~ yourPaperTables] => [[Id] ~ paper] =>
adamc@1022 30 sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)
adamc@1022 31 -> sql_from_items (yourPaperTables ++ [Paper = [Id = paperId] ++ paper] ++ tabs)
adamc@1022 32 end
adamc@1022 33
adamc@1004 34 open Meta
adamc@1001 35
adamc@1001 36 functor Make(M : sig
adamc@1003 37 con paper :: {(Type * Type)}
adamc@1010 38 constraint [Id, Document, Authors] ~ paper
adamc@1003 39 val paper : $(map meta paper)
adamc@1007 40 val paperFolder : folder paper
adamc@1003 41
adamc@1001 42 con review :: {(Type * Type)}
adamc@1003 43 constraint [Paper, User] ~ review
adamc@1003 44 val review : $(map meta review)
adamc@1011 45 val reviewFolder : folder review
adamc@1006 46
adamc@1006 47 val submissionDeadline : time
adamc@1009 48 val summarizePaper : $(map fst paper) -> xbody
adamc@1022 49
adamc@1022 50 functor Make (M : INPUT where con paper = paper)
adamc@1022 51 : OUTPUT where con userId = M.userId
adamc@1022 52 where con paperId = M.paperId
adamc@1001 53 end) = struct
adamc@1001 54
adamc@1003 55 table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool}
adamc@1003 56 PRIMARY KEY Id,
adamc@1003 57 CONSTRAINT Nam UNIQUE Nam
adamc@1003 58 sequence userId
adamc@1003 59
adamc@1008 60 con paper = [Id = int, Document = blob] ++ map fst M.paper
adamc@1003 61 table paper : paper
adamc@1003 62 PRIMARY KEY Id
adamc@1003 63 sequence paperId
adamc@1003 64
adamc@1010 65 table authorship : {Paper : int, User : int}
adamc@1010 66 PRIMARY KEY (Paper, User),
adamc@1011 67 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id) ON DELETE CASCADE,
adamc@1010 68 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
adamc@1010 69
adamc@1003 70 con review = [Paper = int, User = int] ++ map fst M.review
adamc@1003 71 table review : review
adamc@1003 72 PRIMARY KEY (Paper, User),
adamc@1003 73 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
adamc@1003 74 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
adamc@1003 75 sequence reviewId
adamc@1003 76
adamc@1003 77 cookie login : {Id : int, Password : string}
adamc@1003 78
adamc@1004 79 val checkLogin =
adamc@1003 80 r <- getCookie login;
adamc@1003 81 case r of
adamc@1003 82 None => return None
adamc@1003 83 | Some r =>
adamc@1003 84 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc
adamc@1003 85 FROM user
adamc@1003 86 WHERE user.Id = {[r.Id]}
adamc@1003 87 AND user.Password = {[r.Password]})
adamc@1003 88
adamc@1010 89 val getLogin =
adamc@1010 90 ro <- checkLogin;
adamc@1010 91 case ro of
adamc@1010 92 None => error <xml>You must be logged in to do that.</xml>
adamc@1010 93 | Some r => return r
adamc@1010 94
adamc@1022 95 structure O = M.Make(struct
adamc@1022 96 val user = user
adamc@1022 97 val paper = paper
adamc@1022 98 val checkLogin = checkLogin
adamc@1022 99 val getLogin = getLogin
adamc@1022 100 end)
adamc@1022 101
adamc@1022 102 val checkOnPc =
adamc@1022 103 r <- getLogin;
adamc@1022 104 if r.OnPc then
adamc@1022 105 return ()
adamc@1022 106 else
adamc@1022 107 error <xml>You aren't authorized to do that.</xml>
adamc@1022 108
adamc@1009 109 fun checkPaper id =
adamc@1010 110 r <- getLogin;
adamc@1010 111 if r.OnPc then
adamc@1009 112 return ()
adamc@1009 113 else
adamc@1010 114 error <xml>You aren't authorized to see that paper.</xml>
adamc@1009 115
adamc@1004 116 structure Users = BulkEdit.Make(struct
adamc@1004 117 con keyName = #Id
adamc@1004 118 val visible = {Nam = string "Name",
adamc@1004 119 Chair = bool "Chair?",
adamc@1004 120 OnPc = bool "On PC?"}
adamc@1004 121
adamc@1004 122 val title = "Users"
adamc@1004 123 val isAllowed =
adamc@1004 124 me <- checkLogin;
adamc@1004 125 return (Option.isSome me)
adamc@1004 126
adamc@1004 127 val t = user
adamc@1004 128 end)
adamc@1004 129
adamc@1003 130 fun doRegister r =
adamc@1003 131 n <- oneRowE1 (SELECT COUNT( * ) AS N
adamc@1003 132 FROM user
adamc@1003 133 WHERE user.Nam = {[r.Nam]});
adamc@1003 134 if n > 0 then
adamc@1003 135 register (Some "Sorry; that username is taken.")
adamc@1003 136 else
adamc@1003 137 id <- nextval userId;
adamc@1003 138 dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc)
adamc@1003 139 VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE));
adamc@1003 140 setCookie login {Id = id, Password = r.Password};
adamc@1003 141 main ()
adamc@1003 142
adamc@1003 143 and register msg = return <xml><body>
adamc@1003 144 <h1>Registering a New Account</h1>
adamc@1003 145
adamc@1003 146 {case msg of
adamc@1003 147 None => <xml/>
adamc@1003 148 | Some msg => <xml><div>{[msg]}</div></xml>}
adamc@1003 149
adamc@1003 150 <form><table>
adamc@1003 151 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
adamc@1003 152 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
adamc@1003 153 <tr> <th><submit action={doRegister}/></th> </tr>
adamc@1003 154 </table></form>
adamc@1003 155 </body></xml>
adamc@1003 156
adamc@1006 157 and signin r =
adamc@1006 158 ro <- oneOrNoRowsE1 (SELECT user.Id AS N
adamc@1006 159 FROM user
adamc@1006 160 WHERE user.Nam = {[r.Nam]}
adamc@1006 161 AND user.Password = {[r.Password]});
adamc@1006 162 (case ro of
adamc@1006 163 None => return ()
adamc@1006 164 | Some id => setCookie login {Id = id, Password = r.Password});
adamc@1006 165 m <- main' ();
adamc@1006 166 return <xml><body>
adamc@1006 167 {case ro of
adamc@1006 168 None => <xml><div>Invalid username or password.</div></xml>
adamc@1006 169 | _ => <xml/>}
adamc@1006 170
adamc@1006 171 {m}
adamc@1006 172 </body></xml>
adamc@1006 173
adamc@1006 174 and main' () =
adamc@1004 175 me <- checkLogin;
adamc@1006 176 now <- now;
adamc@1006 177 return <xml><ul>
adamc@1003 178 {case me of
adamc@1006 179 None => <xml>
adamc@1006 180 <li><a link={register None}>Register for access</a></li>
adamc@1006 181 <li><b>Log in:</b> <form><table>
adamc@1006 182 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
adamc@1006 183 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
adamc@1006 184 <tr> <th><submit value="Log in" action={signin}/></th> </tr>
adamc@1006 185 </table></form></li>
adamc@1006 186 </xml>
adamc@1004 187 | Some me => <xml>
adamc@1004 188 <div>Welcome, {[me.Nam]}!</div>
adamc@1004 189
adamc@1004 190 {if me.Chair then
adamc@1004 191 <xml><li><a link={Users.main ()}>Manage users</a></li></xml>
adamc@1004 192 else
adamc@1004 193 <xml/>}
adamc@1006 194
adamc@1009 195 {if me.OnPc then
adamc@1022 196 <xml>
adamc@1022 197 <li><a link={all ()}>All papers</a></li>
adamc@1022 198 {O.linksForPc}
adamc@1022 199 </xml>
adamc@1009 200 else
adamc@1009 201 <xml/>}
adamc@1009 202
adamc@1006 203 {if now < M.submissionDeadline then
adamc@1007 204 <xml><li><a link={submit ()}>Submit</a></li></xml>
adamc@1006 205 else
adamc@1006 206 <xml/>}
adamc@1004 207 </xml>}
adamc@1006 208 </ul></xml>
adamc@1006 209
adamc@1006 210 and main () =
adamc@1006 211 m <- main' ();
adamc@1006 212 return <xml><body>{m}</body></xml>
adamc@1001 213
adamc@1008 214 and submit () =
adamc@1008 215 let
adamc@1009 216 fun doSubmit r =
adamc@1010 217 me <- getLogin;
adamc@1010 218 coauthors <- List.mapM (fn name => oneOrNoRowsE1 (SELECT user.Id AS N
adamc@1010 219 FROM user
adamc@1010 220 WHERE user.Nam = {[name.Nam]})) r.Authors;
adamc@1010 221 if List.exists Option.isNone coauthors then
adamc@1010 222 error <xml>At least one of those coauthor usernames isn't registered.</xml>
adamc@1010 223 else
adamc@1010 224 id <- nextval paperId;
adamc@1010 225 dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)}
adamc@1010 226 ++ ensql M.paper (r -- #Authors -- #Document) M.paperFolder));
adamc@1010 227 List.app (fn uid =>
adamc@1010 228 case uid of
adamc@1010 229 None => error <xml>Impossible empty uid!</xml>
adamc@1010 230 | Some uid => dml (INSERT INTO authorship (Paper, User)
adamc@1010 231 VALUES ({[id]}, {[uid]})))
adamc@1010 232 (Some me.Id :: coauthors);
adamc@1010 233 return <xml><body>
adamc@1010 234 Thanks for submitting!
adamc@1010 235 </body></xml>
adamc@1008 236 in
adamc@1010 237 me <- getLogin;
adamc@1015 238 numAuthors <- Dnat.zero;
adamc@1010 239
adamc@1008 240 return <xml><body>
adamc@1008 241 <h1>Submit a Paper</h1>
adamc@1008 242
adamc@1008 243 <form>
adamc@1010 244 <b>Author:</b> {[me.Nam]}<br/>
adamc@1010 245 <subforms{#Authors}>
adamc@1015 246 {Dnat.render <xml><entry><b>Author:</b> <textbox{#Nam}/><br/></entry></xml> numAuthors}
adamc@1010 247 </subforms>
adamc@1015 248 <button value="Add author" onclick={Dnat.inc numAuthors}/><br/>
adamc@1015 249 <button value="Remove author" onclick={Dnat.dec numAuthors}/><br/>
adamc@1010 250 <br/>
adamc@1010 251
adamc@1010 252 {useMore (allWidgets M.paper M.paperFolder)}
adamc@1008 253 <b>Paper:</b> <upload{#Document}/><br/>
adamc@1008 254 <submit value="Submit" action={doSubmit}/>
adamc@1008 255 </form>
adamc@1008 256 </body></xml>
adamc@1008 257 end
adamc@1007 258
adamc@1022 259 and listPapers [tabs] [[Paper] ~ tabs] (q : sql_query ([Paper = [Id = int] ++ map fst M.paper] ++ tabs) []) =
adamc@1022 260 checkOnPc;
adamc@1022 261 ps <- queryX q
adamc@1022 262 (fn r => <xml><li><a link={one r.Paper.Id}>{M.summarizePaper (r.Paper -- #Id)}</a></li></xml>);
adamc@1009 263 return <xml><body>
adamc@1009 264 <h1>All Papers</h1>
adamc@1022 265
adamc@1009 266 <ul>
adamc@1009 267 {ps}
adamc@1009 268 </ul>
adamc@1009 269 </body></xml>
adamc@1009 270
adamc@1022 271 and all () =
adamc@1022 272 checkOnPc;
adamc@1022 273 listPapers (SELECT paper.Id, paper.{{map fst M.paper}} FROM paper)
adamc@1022 274
adamc@1022 275 and your () =
adamc@1022 276 me <- getLogin;
adamc@1022 277 listPapers (sql_query {Rows = sql_query1 {Distinct = False,
adamc@1022 278 From = O.joinYourPaper (sql_from_table [#Paper] paper),
adamc@1022 279 Where = (WHERE TRUE),
adamc@1022 280 GroupBy = sql_subset_all [_],
adamc@1022 281 Having = (WHERE TRUE),
adamc@1022 282 SelectFields = sql_subset [[Paper = ([Id = _] ++ map fst M.paper, _)]
adamc@1022 283 ++ map (fn ts => ([], ts))
adamc@1022 284 O.yourPaperTables],
adamc@1022 285 SelectExps = {}},
adamc@1022 286 OrderBy = sql_order_by_Nil [_],
adamc@1022 287 Limit = sql_no_limit,
adamc@1022 288 Offset = sql_no_offset})
adamc@1022 289
adamc@1009 290 and one id =
adamc@1012 291 let
adamc@1012 292 fun newReview r =
adamc@1012 293 me <- getLogin;
adamc@1012 294 checkPaper id;
adamc@1012 295 dml (insert review ({Paper = sql_inject id, User = sql_inject me.Id}
adamc@1012 296 ++ ensql M.review r M.reviewFolder));
adamc@1012 297 one id
adamc@1009 298
adamc@1012 299 fun saveReview r =
adamc@1012 300 me <- getLogin;
adamc@1012 301 checkPaper id;
adamc@1012 302 dml (update [map fst M.review] ! (ensql M.review r M.reviewFolder)
adamc@1012 303 review (WHERE T.Paper = {[id]} AND T.User = {[me.Id]}));
adamc@1012 304 one id
adamc@1012 305 in
adamc@1012 306 me <- getLogin;
adamc@1012 307 checkPaper id;
adamc@1012 308 ro <- oneOrNoRows (SELECT paper.{{map fst M.paper}}, octet_length(paper.Document) AS N
adamc@1012 309 FROM paper
adamc@1012 310 WHERE paper.Id = {[id]});
adamc@1012 311 authors <- queryX (SELECT user.Nam
adamc@1012 312 FROM authorship
adamc@1012 313 JOIN user ON authorship.User = user.Id
adamc@1012 314 WHERE authorship.Paper = {[id]})
adamc@1012 315 (fn r => <xml><li>{[r.User.Nam]}</li></xml>);
adamc@1012 316 myReview <- oneOrNoRows1 (SELECT review.{{map fst M.review}}
adamc@1012 317 FROM review
adamc@1012 318 WHERE review.User = {[me.Id]}
adamc@1012 319 AND review.Paper = {[id]});
adamc@1012 320 case ro of
adamc@1012 321 None => error <xml>Paper not found!</xml>
adamc@1012 322 | Some r => return <xml><body>
adamc@1012 323 <h1>Paper #{[id]}</h1>
adamc@1010 324
adamc@1012 325 <h3>Authors:</h3>
adamc@1012 326 <ul>
adamc@1012 327 {authors}
adamc@1012 328 </ul>
adamc@1009 329
adamc@1012 330 {allContent M.paper r.Paper M.paperFolder}<br/>
adamc@1011 331
adamc@1012 332 {if r.N = 0 then
adamc@1012 333 <xml><div>No paper uploaded yet.</div></xml>
adamc@1012 334 else
adamc@1012 335 <xml><a link={download id}>Download paper</a> ({[r.N]} bytes)</xml>}
adamc@1011 336
adamc@1012 337 <hr/>
adamc@1011 338
adamc@1012 339 {case myReview of
adamc@1012 340 None => <xml>
adamc@1012 341 <h2>Add Your Review</h2>
adamc@1012 342
adamc@1012 343 <form>
adamc@1012 344 {allWidgets M.review M.reviewFolder}
adamc@1012 345 <submit value="Add" action={newReview}/>
adamc@1012 346 </form>
adamc@1012 347 </xml>
adamc@1012 348 | Some myReview => <xml>
adamc@1012 349 <h2>Edit Your Review</h2>
adamc@1012 350
adamc@1012 351 <form>
adamc@1012 352 {allPopulated M.review myReview M.reviewFolder}
adamc@1012 353 <submit value="Save" action={saveReview}/>
adamc@1012 354 </form>
adamc@1012 355 </xml>}
adamc@1012 356 </body></xml>
adamc@1012 357 end
adamc@1009 358
adamc@1009 359 and download id =
adamc@1009 360 checkPaper id;
adamc@1009 361 ro <- oneOrNoRows (SELECT paper.Document
adamc@1009 362 FROM paper
adamc@1009 363 WHERE paper.Id = {[id]});
adamc@1009 364 case ro of
adamc@1009 365 None => error <xml>Paper not found!</xml>
adamc@1009 366 | Some r => returnBlob r.Paper.Document (blessMime "application/pdf")
adamc@1009 367
adamc@1001 368 end