Mercurial > urweb
comparison demo/more/conference.ur @ 1010:6b0f3853cc81
authorship table
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 22 Oct 2009 14:05:48 -0400 |
parents | 59097824f19b |
children | 16f7cb0891b6 |
comparison
equal
deleted
inserted
replaced
1009:59097824f19b | 1010:6b0f3853cc81 |
---|---|
1 open Meta | 1 open Meta |
2 | 2 |
3 functor Make(M : sig | 3 functor Make(M : sig |
4 con paper :: {(Type * Type)} | 4 con paper :: {(Type * Type)} |
5 constraint [Id, Document] ~ paper | 5 constraint [Id, Document, Authors] ~ paper |
6 val paper : $(map meta paper) | 6 val paper : $(map meta paper) |
7 val paperFolder : folder paper | 7 val paperFolder : folder paper |
8 | 8 |
9 con review :: {(Type * Type)} | 9 con review :: {(Type * Type)} |
10 constraint [Paper, User] ~ review | 10 constraint [Paper, User] ~ review |
21 | 21 |
22 con paper = [Id = int, Document = blob] ++ map fst M.paper | 22 con paper = [Id = int, Document = blob] ++ map fst M.paper |
23 table paper : paper | 23 table paper : paper |
24 PRIMARY KEY Id | 24 PRIMARY KEY Id |
25 sequence paperId | 25 sequence paperId |
26 | |
27 table authorship : {Paper : int, User : int} | |
28 PRIMARY KEY (Paper, User), | |
29 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id), | |
30 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id) | |
26 | 31 |
27 con review = [Paper = int, User = int] ++ map fst M.review | 32 con review = [Paper = int, User = int] ++ map fst M.review |
28 table review : review | 33 table review : review |
29 PRIMARY KEY (Paper, User), | 34 PRIMARY KEY (Paper, User), |
30 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id), | 35 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id), |
41 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc | 46 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc |
42 FROM user | 47 FROM user |
43 WHERE user.Id = {[r.Id]} | 48 WHERE user.Id = {[r.Id]} |
44 AND user.Password = {[r.Password]}) | 49 AND user.Password = {[r.Password]}) |
45 | 50 |
51 val getLogin = | |
52 ro <- checkLogin; | |
53 case ro of | |
54 None => error <xml>You must be logged in to do that.</xml> | |
55 | Some r => return r | |
56 | |
46 fun checkPaper id = | 57 fun checkPaper id = |
47 ro <- checkLogin; | 58 r <- getLogin; |
48 if (case ro of | 59 if r.OnPc then |
49 None => False | |
50 | Some r => r.OnPc) then | |
51 return () | 60 return () |
52 else | 61 else |
53 error <xml>You must be logged in to do that.</xml> | 62 error <xml>You aren't authorized to see that paper.</xml> |
54 | 63 |
55 structure Users = BulkEdit.Make(struct | 64 structure Users = BulkEdit.Make(struct |
56 con keyName = #Id | 65 con keyName = #Id |
57 val visible = {Nam = string "Name", | 66 val visible = {Nam = string "Name", |
58 Chair = bool "Chair?", | 67 Chair = bool "Chair?", |
64 return (Option.isSome me) | 73 return (Option.isSome me) |
65 | 74 |
66 val t = user | 75 val t = user |
67 end) | 76 end) |
68 | 77 |
78 datatype dnat = O | S of source dnat | |
79 type dnatS = source dnat | |
80 | |
81 fun inc n = | |
82 v <- get n; | |
83 case v of | |
84 O => | |
85 n' <- source O; | |
86 set n (S n') | |
87 | S n => inc n | |
88 | |
89 fun dec n = | |
90 let | |
91 fun dec' last n = | |
92 v <- get n; | |
93 case v of | |
94 O => (case last of | |
95 None => return () | |
96 | Some n' => set n' O) | |
97 | S n' => dec' (Some n) n' | |
98 in | |
99 dec' None n | |
100 end | |
69 | 101 |
70 fun doRegister r = | 102 fun doRegister r = |
71 n <- oneRowE1 (SELECT COUNT( * ) AS N | 103 n <- oneRowE1 (SELECT COUNT( * ) AS N |
72 FROM user | 104 FROM user |
73 WHERE user.Nam = {[r.Nam]}); | 105 WHERE user.Nam = {[r.Nam]}); |
149 return <xml><body>{m}</body></xml> | 181 return <xml><body>{m}</body></xml> |
150 | 182 |
151 and submit () = | 183 and submit () = |
152 let | 184 let |
153 fun doSubmit r = | 185 fun doSubmit r = |
154 id <- nextval paperId; | 186 me <- getLogin; |
155 dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)} | 187 coauthors <- List.mapM (fn name => oneOrNoRowsE1 (SELECT user.Id AS N |
156 ++ ensql M.paper (r -- #Document) M.paperFolder)); | 188 FROM user |
157 return <xml><body> | 189 WHERE user.Nam = {[name.Nam]})) r.Authors; |
158 OK, done! | 190 if List.exists Option.isNone coauthors then |
159 </body></xml> | 191 error <xml>At least one of those coauthor usernames isn't registered.</xml> |
192 else | |
193 id <- nextval paperId; | |
194 dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)} | |
195 ++ ensql M.paper (r -- #Authors -- #Document) M.paperFolder)); | |
196 List.app (fn uid => | |
197 case uid of | |
198 None => error <xml>Impossible empty uid!</xml> | |
199 | Some uid => dml (INSERT INTO authorship (Paper, User) | |
200 VALUES ({[id]}, {[uid]}))) | |
201 (Some me.Id :: coauthors); | |
202 return <xml><body> | |
203 Thanks for submitting! | |
204 </body></xml> | |
205 | |
206 fun authorBlanks n = | |
207 case n of | |
208 O => <xml/> | |
209 | S n => <xml> | |
210 <entry><b>Author:</b> <textbox{#Nam}/><br/></entry> | |
211 <dyn signal={authorBlanksS n}/> | |
212 </xml> | |
213 | |
214 and authorBlanksS n = | |
215 n <- signal n; | |
216 return (authorBlanks n) | |
160 in | 217 in |
218 me <- getLogin; | |
219 numAuthors <- source O; | |
220 | |
161 return <xml><body> | 221 return <xml><body> |
162 <h1>Submit a Paper</h1> | 222 <h1>Submit a Paper</h1> |
163 | 223 |
164 <form> | 224 <form> |
165 {allWidgets M.paper M.paperFolder} | 225 <b>Author:</b> {[me.Nam]}<br/> |
226 <subforms{#Authors}> | |
227 <dyn signal={authorBlanksS numAuthors}/> | |
228 </subforms> | |
229 <button value="Add author" onclick={inc numAuthors}/><br/> | |
230 <button value="Remove author" onclick={dec numAuthors}/><br/> | |
231 <br/> | |
232 | |
233 {useMore (allWidgets M.paper M.paperFolder)} | |
166 <b>Paper:</b> <upload{#Document}/><br/> | 234 <b>Paper:</b> <upload{#Document}/><br/> |
167 <submit value="Submit" action={doSubmit}/> | 235 <submit value="Submit" action={doSubmit}/> |
168 </form> | 236 </form> |
169 </body></xml> | 237 </body></xml> |
170 end | 238 end |
183 and one id = | 251 and one id = |
184 checkPaper id; | 252 checkPaper id; |
185 ro <- oneOrNoRows (SELECT paper.{{map fst M.paper}}, octet_length(paper.Document) AS N | 253 ro <- oneOrNoRows (SELECT paper.{{map fst M.paper}}, octet_length(paper.Document) AS N |
186 FROM paper | 254 FROM paper |
187 WHERE paper.Id = {[id]}); | 255 WHERE paper.Id = {[id]}); |
256 authors <- queryX (SELECT user.Nam | |
257 FROM authorship | |
258 JOIN user ON authorship.User = user.Id | |
259 WHERE authorship.Paper = {[id]}) | |
260 (fn r => <xml><li>{[r.User.Nam]}</li></xml>); | |
188 case ro of | 261 case ro of |
189 None => error <xml>Paper not found!</xml> | 262 None => error <xml>Paper not found!</xml> |
190 | Some r => return <xml><body> | 263 | Some r => return <xml><body> |
191 <h1>Paper #{[id]}</h1> | 264 <h1>Paper #{[id]}</h1> |
265 | |
266 <h3>Authors:</h3> | |
267 <ul> | |
268 {authors} | |
269 </ul> | |
192 | 270 |
193 {allContent M.paper r.Paper M.paperFolder}<br/> | 271 {allContent M.paper r.Paper M.paperFolder}<br/> |
194 | 272 |
195 {if r.N = 0 then | 273 {if r.N = 0 then |
196 <xml><div>No paper uploaded yet.</div></xml> | 274 <xml><div>No paper uploaded yet.</div></xml> |