Mercurial > urweb
changeset 1010:6b0f3853cc81
authorship table
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 22 Oct 2009 14:05:48 -0400 |
| parents | 59097824f19b |
| children | 16f7cb0891b6 |
| files | demo/more/conference.ur demo/more/conference.urs |
| diffstat | 2 files changed, 92 insertions(+), 14 deletions(-) [+] |
line wrap: on
line diff
--- a/demo/more/conference.ur Thu Oct 22 12:16:31 2009 -0400 +++ b/demo/more/conference.ur Thu Oct 22 14:05:48 2009 -0400 @@ -2,7 +2,7 @@ functor Make(M : sig con paper :: {(Type * Type)} - constraint [Id, Document] ~ paper + constraint [Id, Document, Authors] ~ paper val paper : $(map meta paper) val paperFolder : folder paper @@ -24,6 +24,11 @@ PRIMARY KEY Id sequence paperId + table authorship : {Paper : int, User : int} + PRIMARY KEY (Paper, User), + CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id), + CONSTRAINT User FOREIGN KEY User REFERENCES user(Id) + con review = [Paper = int, User = int] ++ map fst M.review table review : review PRIMARY KEY (Paper, User), @@ -43,14 +48,18 @@ WHERE user.Id = {[r.Id]} AND user.Password = {[r.Password]}) + val getLogin = + ro <- checkLogin; + case ro of + None => error <xml>You must be logged in to do that.</xml> + | Some r => return r + fun checkPaper id = - ro <- checkLogin; - if (case ro of - None => False - | Some r => r.OnPc) then + r <- getLogin; + if r.OnPc then return () else - error <xml>You must be logged in to do that.</xml> + error <xml>You aren't authorized to see that paper.</xml> structure Users = BulkEdit.Make(struct con keyName = #Id @@ -66,6 +75,29 @@ val t = user end) + datatype dnat = O | S of source dnat + type dnatS = source dnat + + fun inc n = + v <- get n; + case v of + O => + n' <- source O; + set n (S n') + | S n => inc n + + fun dec n = + let + fun dec' last n = + v <- get n; + case v of + O => (case last of + None => return () + | Some n' => set n' O) + | S n' => dec' (Some n) n' + in + dec' None n + end fun doRegister r = n <- oneRowE1 (SELECT COUNT( * ) AS N @@ -151,18 +183,54 @@ and submit () = let fun doSubmit r = - id <- nextval paperId; - dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)} - ++ ensql M.paper (r -- #Document) M.paperFolder)); - return <xml><body> - OK, done! - </body></xml> + me <- getLogin; + coauthors <- List.mapM (fn name => oneOrNoRowsE1 (SELECT user.Id AS N + FROM user + WHERE user.Nam = {[name.Nam]})) r.Authors; + if List.exists Option.isNone coauthors then + error <xml>At least one of those coauthor usernames isn't registered.</xml> + else + id <- nextval paperId; + dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)} + ++ ensql M.paper (r -- #Authors -- #Document) M.paperFolder)); + List.app (fn uid => + case uid of + None => error <xml>Impossible empty uid!</xml> + | Some uid => dml (INSERT INTO authorship (Paper, User) + VALUES ({[id]}, {[uid]}))) + (Some me.Id :: coauthors); + return <xml><body> + Thanks for submitting! + </body></xml> + + fun authorBlanks n = + case n of + O => <xml/> + | S n => <xml> + <entry><b>Author:</b> <textbox{#Nam}/><br/></entry> + <dyn signal={authorBlanksS n}/> + </xml> + + and authorBlanksS n = + n <- signal n; + return (authorBlanks n) in + me <- getLogin; + numAuthors <- source O; + return <xml><body> <h1>Submit a Paper</h1> <form> - {allWidgets M.paper M.paperFolder} + <b>Author:</b> {[me.Nam]}<br/> + <subforms{#Authors}> + <dyn signal={authorBlanksS numAuthors}/> + </subforms> + <button value="Add author" onclick={inc numAuthors}/><br/> + <button value="Remove author" onclick={dec numAuthors}/><br/> + <br/> + + {useMore (allWidgets M.paper M.paperFolder)} <b>Paper:</b> <upload{#Document}/><br/> <submit value="Submit" action={doSubmit}/> </form> @@ -185,11 +253,21 @@ ro <- oneOrNoRows (SELECT paper.{{map fst M.paper}}, octet_length(paper.Document) AS N FROM paper WHERE paper.Id = {[id]}); + authors <- queryX (SELECT user.Nam + FROM authorship + JOIN user ON authorship.User = user.Id + WHERE authorship.Paper = {[id]}) + (fn r => <xml><li>{[r.User.Nam]}</li></xml>); case ro of None => error <xml>Paper not found!</xml> | Some r => return <xml><body> <h1>Paper #{[id]}</h1> + <h3>Authors:</h3> + <ul> + {authors} + </ul> + {allContent M.paper r.Paper M.paperFolder}<br/> {if r.N = 0 then
--- a/demo/more/conference.urs Thu Oct 22 12:16:31 2009 -0400 +++ b/demo/more/conference.urs Thu Oct 22 14:05:48 2009 -0400 @@ -1,6 +1,6 @@ functor Make(M : sig con paper :: {(Type * Type)} - constraint [Id, Document] ~ paper + constraint [Id, Document, Authors] ~ paper val paper : $(map Meta.meta paper) val paperFolder : folder paper