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>