Mercurial > urweb

comparison demo/more/conference.ur @ 1030:6bcc1020d5cd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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