Mercurial > urweb

annotate demo/more/conference.ur @ 1025:7facf72aaf0a

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