diff options
Diffstat (limited to 'demo')
| -rw-r--r-- | demo/more/conference.ur | 104 | ||||
| -rw-r--r-- | demo/more/conference.urs | 2 |
2 files changed, 92 insertions, 14 deletions
diff --git a/demo/more/conference.ur b/demo/more/conference.ur index 290ff61d..8e408d2f 100644 --- a/demo/more/conference.ur +++ b/demo/more/conference.ur @@ -2,7 +2,7 @@ open Meta 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 @@ functor Make(M : sig 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 @@ functor Make(M : sig WHERE user.Id = {[r.Id]} AND user.Password = {[r.Password]}) - fun checkPaper id = + val getLogin = ro <- checkLogin; - if (case ro of - None => False - | Some r => r.OnPc) then + case ro of + None => error <xml>You must be logged in to do that.</xml> + | Some r => return r + + fun checkPaper id = + 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 @@ functor Make(M : sig 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 @@ functor Make(M : sig 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 @@ functor Make(M : sig 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 diff --git a/demo/more/conference.urs b/demo/more/conference.urs index 6c243f9b..04e8e298 100644 --- a/demo/more/conference.urs +++ b/demo/more/conference.urs @@ -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 |