Mercurial > urweb
comparison demo/more/conference.ur @ 1030:6bcc1020d5cd
Start of Decision
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Mon, 02 Nov 2009 15:48:06 -0500 |
parents | 53a22f46f377 |
children | 5d9f47124c4c |
comparison
equal
deleted
inserted
replaced
1029:53a22f46f377 | 1030:6bcc1020d5cd |
---|---|
43 open Meta | 43 open Meta |
44 | 44 |
45 functor Make(M : sig | 45 functor Make(M : sig |
46 con paper :: {(Type * Type)} | 46 con paper :: {(Type * Type)} |
47 constraint [Id, Document, Authors] ~ paper | 47 constraint [Id, Document, Authors] ~ paper |
48 val paper : $(map meta paper) | 48 val paper : $(map Meta.meta paper) |
49 val paperFolder : folder paper | 49 val paperFolder : folder paper |
50 | |
51 con paperPrivate :: {Type} | |
52 constraint [Id, Document, Authors] ~ paperPrivate | |
53 constraint paper ~ paperPrivate | |
54 val paperPrivate : $(map Meta.private paperPrivate) | |
55 val paperPrivateFolder : folder paperPrivate | |
50 | 56 |
51 con review :: {(Type * Type)} | 57 con review :: {(Type * Type)} |
52 constraint [Paper, User] ~ review | 58 constraint [Paper, User] ~ review |
53 val review : $(map meta review) | 59 val review : $(map Meta.meta review) |
54 val reviewFolder : folder review | 60 val reviewFolder : folder review |
55 | 61 |
56 val submissionDeadline : time | 62 val submissionDeadline : time |
57 val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper) -> xml ([Body] ++ ctx) [] [] | 63 val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper ++ paperPrivate) |
58 | 64 -> xml ([Body] ++ ctx) [] [] |
59 functor Make (M : INPUT where con paper = map fst paper) | 65 |
60 : OUTPUT where con paper = map fst paper | 66 functor Make (M : INPUT where con paper = map fst paper ++ paperPrivate) |
67 : OUTPUT where con paper = map fst paper ++ paperPrivate | |
61 where con userId = M.userId | 68 where con userId = M.userId |
62 where con paperId = M.paperId | 69 where con paperId = M.paperId |
63 end) = struct | 70 end) = struct |
64 | 71 |
65 table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool} | 72 table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool} |
66 PRIMARY KEY Id, | 73 PRIMARY KEY Id, |
67 CONSTRAINT Nam UNIQUE Nam | 74 CONSTRAINT Nam UNIQUE Nam |
68 sequence userId | 75 sequence userId |
69 | 76 |
70 con paper = [Id = int, Document = blob] ++ map fst M.paper | 77 con paper = [Id = int, Document = blob] ++ map fst M.paper ++ M.paperPrivate |
71 table paper : paper | 78 table paper : paper |
72 PRIMARY KEY Id | 79 PRIMARY KEY Id |
73 sequence paperId | 80 sequence paperId |
74 | 81 |
75 table authorship : {Paper : int, User : int} | 82 table authorship : {Paper : int, User : int} |
252 if List.exists Option.isNone coauthors then | 259 if List.exists Option.isNone coauthors then |
253 error <xml>At least one of those coauthor usernames isn't registered.</xml> | 260 error <xml>At least one of those coauthor usernames isn't registered.</xml> |
254 else | 261 else |
255 id <- nextval paperId; | 262 id <- nextval paperId; |
256 dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)} | 263 dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)} |
257 ++ ensql M.paper (r -- #Authors -- #Document) M.paperFolder)); | 264 ++ ensql M.paper (r -- #Authors -- #Document) M.paperFolder |
265 ++ initialize M.paperPrivate M.paperPrivateFolder)); | |
258 List.app (fn uid => | 266 List.app (fn uid => |
259 case uid of | 267 case uid of |
260 None => error <xml>Impossible empty uid!</xml> | 268 None => error <xml>Impossible empty uid!</xml> |
261 | Some uid => dml (INSERT INTO authorship (Paper, User) | 269 | Some uid => dml (INSERT INTO authorship (Paper, User) |
262 VALUES ({[id]}, {[uid]}))) | 270 VALUES ({[id]}, {[uid]}))) |
285 <submit value="Submit" action={doSubmit}/> | 293 <submit value="Submit" action={doSubmit}/> |
286 </form> | 294 </form> |
287 </body></xml> | 295 </body></xml> |
288 end | 296 end |
289 | 297 |
290 and listPapers [tabs] [[Paper] ~ tabs] (q : sql_query ([Paper = [Id = int] ++ map fst M.paper] ++ tabs) []) = | 298 and listPapers [tabs] [[Paper] ~ tabs] |
299 (q : sql_query ([Paper = [Id = int] ++ map fst M.paper ++ M.paperPrivate] ++ tabs) []) = | |
291 checkOnPc; | 300 checkOnPc; |
292 ps <- queryX q | 301 ps <- queryX q |
293 (fn r => <xml><li><a link={one r.Paper.Id}>{M.summarizePaper (r.Paper -- #Id)}</a></li></xml>); | 302 (fn r => <xml><li><a link={one r.Paper.Id}>{M.summarizePaper (r.Paper -- #Id)}</a> |
303 </li></xml>); | |
294 return <xml><body> | 304 return <xml><body> |
295 <h1>All Papers</h1> | 305 <h1>All Papers</h1> |
296 | 306 |
297 <ul> | 307 <ul> |
298 {ps} | 308 {ps} |
299 </ul> | 309 </ul> |
300 </body></xml> | 310 </body></xml> |
301 | 311 |
302 and all () = | 312 and all () = |
303 checkOnPc; | 313 checkOnPc; |
304 listPapers (SELECT paper.Id, paper.{{map fst M.paper}} FROM paper) | 314 listPapers (SELECT paper.Id, paper.{{map fst M.paper ++ M.paperPrivate}} FROM paper) |
305 | 315 |
306 and your () = | 316 and your () = |
307 me <- getLogin; | 317 me <- getLogin; |
308 listPapers (sql_query {Rows = sql_query1 {Distinct = False, | 318 listPapers (sql_query {Rows = sql_query1 {Distinct = False, |
309 From = O.joinYourPaper me.Id (sql_from_table [#Paper] paper), | 319 From = O.joinYourPaper me.Id (sql_from_table [#Paper] paper), |
310 Where = (WHERE TRUE), | 320 Where = (WHERE TRUE), |
311 GroupBy = sql_subset_all [_], | 321 GroupBy = sql_subset_all [_], |
312 Having = (WHERE TRUE), | 322 Having = (WHERE TRUE), |
313 SelectFields = sql_subset [[Paper = ([Id = _] ++ map fst M.paper, _)] | 323 SelectFields = sql_subset [[Paper = |
324 ([Id = _] | |
325 ++ map fst M.paper | |
326 ++ M.paperPrivate, _)] | |
314 ++ map (fn ts => ([], ts)) | 327 ++ map (fn ts => ([], ts)) |
315 O.yourPaperTables], | 328 O.yourPaperTables], |
316 SelectExps = {}}, | 329 SelectExps = {}}, |
317 OrderBy = sql_order_by_Nil [_], | 330 OrderBy = sql_order_by_Nil [_], |
318 Limit = sql_no_limit, | 331 Limit = sql_no_limit, |
410 case ro of | 423 case ro of |
411 None => error <xml>Paper not found!</xml> | 424 None => error <xml>Paper not found!</xml> |
412 | Some r => returnBlob r.Paper.Document (blessMime "application/pdf") | 425 | Some r => returnBlob r.Paper.Document (blessMime "application/pdf") |
413 | 426 |
414 end | 427 end |
428 | |
429 | |
430 functor Join(M : sig | |
431 structure O1 : OUTPUT | |
432 | |
433 structure O2 : OUTPUT where con paper = O1.paper | |
434 where con userId = O1.userId | |
435 where con paperId = O1.paperId | |
436 | |
437 constraint O1.yourPaperTables ~ O2.yourPaperTables | |
438 end) | |
439 = struct | |
440 open M | |
441 open O1 | |
442 | |
443 val linksForPc = <xml>{O1.linksForPc}{O2.linksForPc}</xml> | |
444 val linksForChair = <xml>{O1.linksForChair}{O2.linksForChair}</xml> | |
445 | |
446 con yourPaperTables = O1.yourPaperTables ++ O2.yourPaperTables | |
447 constraint [Paper] ~ yourPaperTables | |
448 | |
449 fun joinYourPaper [tabs] [paper] [[Paper] ~ tabs] [[Paper] ~ _] [tabs ~ yourPaperTables] [[Id] ~ paper] | |
450 uid (fi : sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)) = | |
451 O2.joinYourPaper uid (O1.joinYourPaper uid fi) | |
452 end |