adamc@1022
|
1 signature INPUT = sig
|
adamc@1023
|
2 con paper :: {Type}
|
adamc@1022
|
3 constraint [Id, Document] ~ paper
|
adamc@1022
|
4
|
adamc@1022
|
5 type userId
|
adamc@1022
|
6 val userId_inj : sql_injectable_prim userId
|
adamc@1022
|
7 table user : {Id : userId, Nam : string, Password : string, Chair : bool, OnPc : bool}
|
adamc@1022
|
8 PRIMARY KEY Id,
|
adamc@1022
|
9 CONSTRAINT Nam UNIQUE Nam
|
adamc@1022
|
10
|
adamc@1022
|
11 type paperId
|
adamc@1022
|
12 val paperId_inj : sql_injectable_prim paperId
|
adamc@1023
|
13 val paperId_show : show paperId
|
adamc@1023
|
14 val paperId_read : read paperId
|
adamc@1025
|
15 val paperId_eq : eq paperId
|
adamc@1023
|
16 table paper : ([Id = paperId, Document = blob] ++ paper)
|
adamc@1022
|
17 PRIMARY KEY Id
|
adamc@1022
|
18
|
adamc@1022
|
19 val checkLogin : transaction (option {Id : userId, Nam : string, Chair : bool, OnPc : bool})
|
adamc@1022
|
20 val getLogin : transaction {Id : userId, Nam : string, Chair : bool, OnPc : bool}
|
adamc@1023
|
21 val getPcLogin : transaction {Id : userId, Nam : string, Chair : bool}
|
adamc@1025
|
22 val checkChair : transaction unit
|
adamc@1023
|
23 val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $paper -> xml ([Body] ++ ctx) [] []
|
adamc@1022
|
24 end
|
adamc@1022
|
25
|
adamc@1022
|
26 signature OUTPUT = sig
|
adamc@1023
|
27 con paper :: {Type}
|
adamc@1022
|
28 type userId
|
adamc@1022
|
29 type paperId
|
adamc@1022
|
30
|
adamc@1022
|
31 val linksForPc : xbody
|
adamc@1025
|
32 val linksForChair : xbody
|
adamc@1022
|
33
|
adamc@1022
|
34 con yourPaperTables :: {{Type}}
|
adamc@1022
|
35 constraint [Paper] ~ yourPaperTables
|
adamc@1022
|
36 val joinYourPaper : tabs ::: {{Type}} -> paper ::: {Type}
|
adamc@1022
|
37 -> [[Paper] ~ tabs] => [[Paper] ~ yourPaperTables] => [tabs ~ yourPaperTables] => [[Id] ~ paper] =>
|
adamc@1022
|
38 sql_from_items ([Paper = [Id = paperId] ++ paper] ++ tabs)
|
adamc@1022
|
39 -> sql_from_items (yourPaperTables ++ [Paper = [Id = paperId] ++ paper] ++ tabs)
|
adamc@1022
|
40 end
|
adamc@1022
|
41
|
adamc@1004
|
42 open Meta
|
adamc@1001
|
43
|
adamc@1001
|
44 functor Make(M : sig
|
adamc@1003
|
45 con paper :: {(Type * Type)}
|
adamc@1010
|
46 constraint [Id, Document, Authors] ~ paper
|
adamc@1003
|
47 val paper : $(map meta paper)
|
adamc@1007
|
48 val paperFolder : folder paper
|
adamc@1003
|
49
|
adamc@1001
|
50 con review :: {(Type * Type)}
|
adamc@1003
|
51 constraint [Paper, User] ~ review
|
adamc@1003
|
52 val review : $(map meta review)
|
adamc@1011
|
53 val reviewFolder : folder review
|
adamc@1006
|
54
|
adamc@1006
|
55 val submissionDeadline : time
|
adamc@1023
|
56 val summarizePaper : ctx ::: {Unit} -> [[Body] ~ ctx] => $(map fst paper) -> xml ([Body] ++ ctx) [] []
|
adamc@1022
|
57
|
adamc@1023
|
58 functor Make (M : INPUT where con paper = map fst paper)
|
adamc@1023
|
59 : OUTPUT where con paper = map fst paper
|
adamc@1023
|
60 where con userId = M.userId
|
adamc@1022
|
61 where con paperId = M.paperId
|
adamc@1001
|
62 end) = struct
|
adamc@1001
|
63
|
adamc@1003
|
64 table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool}
|
adamc@1003
|
65 PRIMARY KEY Id,
|
adamc@1003
|
66 CONSTRAINT Nam UNIQUE Nam
|
adamc@1003
|
67 sequence userId
|
adamc@1003
|
68
|
adamc@1008
|
69 con paper = [Id = int, Document = blob] ++ map fst M.paper
|
adamc@1003
|
70 table paper : paper
|
adamc@1003
|
71 PRIMARY KEY Id
|
adamc@1003
|
72 sequence paperId
|
adamc@1003
|
73
|
adamc@1010
|
74 table authorship : {Paper : int, User : int}
|
adamc@1010
|
75 PRIMARY KEY (Paper, User),
|
adamc@1011
|
76 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id) ON DELETE CASCADE,
|
adamc@1010
|
77 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
|
adamc@1010
|
78
|
adamc@1003
|
79 con review = [Paper = int, User = int] ++ map fst M.review
|
adamc@1003
|
80 table review : review
|
adamc@1003
|
81 PRIMARY KEY (Paper, User),
|
adamc@1003
|
82 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
|
adamc@1003
|
83 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
|
adamc@1003
|
84 sequence reviewId
|
adamc@1003
|
85
|
adamc@1003
|
86 cookie login : {Id : int, Password : string}
|
adamc@1003
|
87
|
adamc@1004
|
88 val checkLogin =
|
adamc@1003
|
89 r <- getCookie login;
|
adamc@1003
|
90 case r of
|
adamc@1003
|
91 None => return None
|
adamc@1003
|
92 | Some r =>
|
adamc@1003
|
93 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc
|
adamc@1003
|
94 FROM user
|
adamc@1003
|
95 WHERE user.Id = {[r.Id]}
|
adamc@1003
|
96 AND user.Password = {[r.Password]})
|
adamc@1003
|
97
|
adamc@1010
|
98 val getLogin =
|
adamc@1010
|
99 ro <- checkLogin;
|
adamc@1010
|
100 case ro of
|
adamc@1010
|
101 None => error <xml>You must be logged in to do that.</xml>
|
adamc@1010
|
102 | Some r => return r
|
adamc@1010
|
103
|
adamc@1023
|
104 val getPcLogin =
|
adamc@1023
|
105 r <- getLogin;
|
adamc@1023
|
106 if r.OnPc then
|
adamc@1023
|
107 return (r -- #OnPc)
|
adamc@1023
|
108 else
|
adamc@1023
|
109 error <xml>You are not on the PC.</xml>
|
adamc@1023
|
110
|
adamc@1025
|
111 val checkChair =
|
adamc@1025
|
112 r <- getLogin;
|
adamc@1025
|
113 if r.Chair then
|
adamc@1025
|
114 return ()
|
adamc@1025
|
115 else
|
adamc@1025
|
116 error <xml>You are not a chair.</xml>
|
adamc@1025
|
117
|
adamc@1022
|
118 structure O = M.Make(struct
|
adamc@1022
|
119 val user = user
|
adamc@1022
|
120 val paper = paper
|
adamc@1022
|
121 val checkLogin = checkLogin
|
adamc@1022
|
122 val getLogin = getLogin
|
adamc@1023
|
123 val getPcLogin = getPcLogin
|
adamc@1025
|
124 val checkChair = checkChair
|
adamc@1023
|
125 val summarizePaper = @@M.summarizePaper
|
adamc@1022
|
126 end)
|
adamc@1022
|
127
|
adamc@1022
|
128 val checkOnPc =
|
adamc@1022
|
129 r <- getLogin;
|
adamc@1022
|
130 if r.OnPc then
|
adamc@1022
|
131 return ()
|
adamc@1022
|
132 else
|
adamc@1022
|
133 error <xml>You aren't authorized to do that.</xml>
|
adamc@1022
|
134
|
adamc@1009
|
135 fun checkPaper id =
|
adamc@1010
|
136 r <- getLogin;
|
adamc@1010
|
137 if r.OnPc then
|
adamc@1009
|
138 return ()
|
adamc@1009
|
139 else
|
adamc@1010
|
140 error <xml>You aren't authorized to see that paper.</xml>
|
adamc@1009
|
141
|
adamc@1004
|
142 structure Users = BulkEdit.Make(struct
|
adamc@1004
|
143 con keyName = #Id
|
adamc@1004
|
144 val visible = {Nam = string "Name",
|
adamc@1004
|
145 Chair = bool "Chair?",
|
adamc@1004
|
146 OnPc = bool "On PC?"}
|
adamc@1004
|
147
|
adamc@1004
|
148 val title = "Users"
|
adamc@1004
|
149 val isAllowed =
|
adamc@1004
|
150 me <- checkLogin;
|
adamc@1004
|
151 return (Option.isSome me)
|
adamc@1004
|
152
|
adamc@1004
|
153 val t = user
|
adamc@1004
|
154 end)
|
adamc@1004
|
155
|
adamc@1003
|
156 fun doRegister r =
|
adamc@1003
|
157 n <- oneRowE1 (SELECT COUNT( * ) AS N
|
adamc@1003
|
158 FROM user
|
adamc@1003
|
159 WHERE user.Nam = {[r.Nam]});
|
adamc@1003
|
160 if n > 0 then
|
adamc@1003
|
161 register (Some "Sorry; that username is taken.")
|
adamc@1003
|
162 else
|
adamc@1003
|
163 id <- nextval userId;
|
adamc@1003
|
164 dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc)
|
adamc@1003
|
165 VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE));
|
adamc@1003
|
166 setCookie login {Id = id, Password = r.Password};
|
adamc@1003
|
167 main ()
|
adamc@1003
|
168
|
adamc@1003
|
169 and register msg = return <xml><body>
|
adamc@1003
|
170 <h1>Registering a New Account</h1>
|
adamc@1003
|
171
|
adamc@1003
|
172 {case msg of
|
adamc@1003
|
173 None => <xml/>
|
adamc@1003
|
174 | Some msg => <xml><div>{[msg]}</div></xml>}
|
adamc@1003
|
175
|
adamc@1003
|
176 <form><table>
|
adamc@1003
|
177 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
|
adamc@1003
|
178 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
|
adamc@1003
|
179 <tr> <th><submit action={doRegister}/></th> </tr>
|
adamc@1003
|
180 </table></form>
|
adamc@1003
|
181 </body></xml>
|
adamc@1003
|
182
|
adamc@1006
|
183 and signin r =
|
adamc@1006
|
184 ro <- oneOrNoRowsE1 (SELECT user.Id AS N
|
adamc@1006
|
185 FROM user
|
adamc@1006
|
186 WHERE user.Nam = {[r.Nam]}
|
adamc@1006
|
187 AND user.Password = {[r.Password]});
|
adamc@1006
|
188 (case ro of
|
adamc@1006
|
189 None => return ()
|
adamc@1006
|
190 | Some id => setCookie login {Id = id, Password = r.Password});
|
adamc@1006
|
191 m <- main' ();
|
adamc@1006
|
192 return <xml><body>
|
adamc@1006
|
193 {case ro of
|
adamc@1006
|
194 None => <xml><div>Invalid username or password.</div></xml>
|
adamc@1006
|
195 | _ => <xml/>}
|
adamc@1006
|
196
|
adamc@1006
|
197 {m}
|
adamc@1006
|
198 </body></xml>
|
adamc@1006
|
199
|
adamc@1006
|
200 and main' () =
|
adamc@1004
|
201 me <- checkLogin;
|
adamc@1006
|
202 now <- now;
|
adamc@1006
|
203 return <xml><ul>
|
adamc@1003
|
204 {case me of
|
adamc@1006
|
205 None => <xml>
|
adamc@1006
|
206 <li><a link={register None}>Register for access</a></li>
|
adamc@1006
|
207 <li><b>Log in:</b> <form><table>
|
adamc@1006
|
208 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
|
adamc@1006
|
209 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
|
adamc@1006
|
210 <tr> <th><submit value="Log in" action={signin}/></th> </tr>
|
adamc@1006
|
211 </table></form></li>
|
adamc@1006
|
212 </xml>
|
adamc@1004
|
213 | Some me => <xml>
|
adamc@1004
|
214 <div>Welcome, {[me.Nam]}!</div>
|
adamc@1004
|
215
|
adamc@1004
|
216 {if me.Chair then
|
adamc@1025
|
217 <xml>
|
adamc@1025
|
218 <li><a link={Users.main ()}>Manage users</a></li>
|
adamc@1025
|
219 {O.linksForChair}
|
adamc@1025
|
220 </xml>
|
adamc@1004
|
221 else
|
adamc@1004
|
222 <xml/>}
|
adamc@1006
|
223
|
adamc@1009
|
224 {if me.OnPc then
|
adamc@1022
|
225 <xml>
|
adamc@1022
|
226 <li><a link={all ()}>All papers</a></li>
|
adamc@1023
|
227 <li><a link={your ()}>Your papers</a></li>
|
adamc@1022
|
228 {O.linksForPc}
|
adamc@1022
|
229 </xml>
|
adamc@1009
|
230 else
|
adamc@1009
|
231 <xml/>}
|
adamc@1009
|
232
|
adamc@1006
|
233 {if now < M.submissionDeadline then
|
adamc@1007
|
234 <xml><li><a link={submit ()}>Submit</a></li></xml>
|
adamc@1006
|
235 else
|
adamc@1006
|
236 <xml/>}
|
adamc@1004
|
237 </xml>}
|
adamc@1006
|
238 </ul></xml>
|
adamc@1006
|
239
|
adamc@1006
|
240 and main () =
|
adamc@1006
|
241 m <- main' ();
|
adamc@1006
|
242 return <xml><body>{m}</body></xml>
|
adamc@1001
|
243
|
adamc@1008
|
244 and submit () =
|
adamc@1008
|
245 let
|
adamc@1009
|
246 fun doSubmit r =
|
adamc@1010
|
247 me <- getLogin;
|
adamc@1010
|
248 coauthors <- List.mapM (fn name => oneOrNoRowsE1 (SELECT user.Id AS N
|
adamc@1010
|
249 FROM user
|
adamc@1010
|
250 WHERE user.Nam = {[name.Nam]})) r.Authors;
|
adamc@1010
|
251 if List.exists Option.isNone coauthors then
|
adamc@1010
|
252 error <xml>At least one of those coauthor usernames isn't registered.</xml>
|
adamc@1010
|
253 else
|
adamc@1010
|
254 id <- nextval paperId;
|
adamc@1010
|
255 dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)}
|
adamc@1010
|
256 ++ ensql M.paper (r -- #Authors -- #Document) M.paperFolder));
|
adamc@1010
|
257 List.app (fn uid =>
|
adamc@1010
|
258 case uid of
|
adamc@1010
|
259 None => error <xml>Impossible empty uid!</xml>
|
adamc@1010
|
260 | Some uid => dml (INSERT INTO authorship (Paper, User)
|
adamc@1010
|
261 VALUES ({[id]}, {[uid]})))
|
adamc@1010
|
262 (Some me.Id :: coauthors);
|
adamc@1010
|
263 return <xml><body>
|
adamc@1010
|
264 Thanks for submitting!
|
adamc@1010
|
265 </body></xml>
|
adamc@1008
|
266 in
|
adamc@1010
|
267 me <- getLogin;
|
adamc@1015
|
268 numAuthors <- Dnat.zero;
|
adamc@1010
|
269
|
adamc@1008
|
270 return <xml><body>
|
adamc@1008
|
271 <h1>Submit a Paper</h1>
|
adamc@1008
|
272
|
adamc@1008
|
273 <form>
|
adamc@1010
|
274 <b>Author:</b> {[me.Nam]}<br/>
|
adamc@1010
|
275 <subforms{#Authors}>
|
adamc@1015
|
276 {Dnat.render <xml><entry><b>Author:</b> <textbox{#Nam}/><br/></entry></xml> numAuthors}
|
adamc@1010
|
277 </subforms>
|
adamc@1015
|
278 <button value="Add author" onclick={Dnat.inc numAuthors}/><br/>
|
adamc@1015
|
279 <button value="Remove author" onclick={Dnat.dec numAuthors}/><br/>
|
adamc@1010
|
280 <br/>
|
adamc@1010
|
281
|
adamc@1010
|
282 {useMore (allWidgets M.paper M.paperFolder)}
|
adamc@1008
|
283 <b>Paper:</b> <upload{#Document}/><br/>
|
adamc@1008
|
284 <submit value="Submit" action={doSubmit}/>
|
adamc@1008
|
285 </form>
|
adamc@1008
|
286 </body></xml>
|
adamc@1008
|
287 end
|
adamc@1007
|
288
|
adamc@1022
|
289 and listPapers [tabs] [[Paper] ~ tabs] (q : sql_query ([Paper = [Id = int] ++ map fst M.paper] ++ tabs) []) =
|
adamc@1022
|
290 checkOnPc;
|
adamc@1022
|
291 ps <- queryX q
|
adamc@1022
|
292 (fn r => <xml><li><a link={one r.Paper.Id}>{M.summarizePaper (r.Paper -- #Id)}</a></li></xml>);
|
adamc@1009
|
293 return <xml><body>
|
adamc@1009
|
294 <h1>All Papers</h1>
|
adamc@1022
|
295
|
adamc@1009
|
296 <ul>
|
adamc@1009
|
297 {ps}
|
adamc@1009
|
298 </ul>
|
adamc@1009
|
299 </body></xml>
|
adamc@1009
|
300
|
adamc@1022
|
301 and all () =
|
adamc@1022
|
302 checkOnPc;
|
adamc@1022
|
303 listPapers (SELECT paper.Id, paper.{{map fst M.paper}} FROM paper)
|
adamc@1022
|
304
|
adamc@1022
|
305 and your () =
|
adamc@1022
|
306 me <- getLogin;
|
adamc@1022
|
307 listPapers (sql_query {Rows = sql_query1 {Distinct = False,
|
adamc@1022
|
308 From = O.joinYourPaper (sql_from_table [#Paper] paper),
|
adamc@1022
|
309 Where = (WHERE TRUE),
|
adamc@1022
|
310 GroupBy = sql_subset_all [_],
|
adamc@1022
|
311 Having = (WHERE TRUE),
|
adamc@1022
|
312 SelectFields = sql_subset [[Paper = ([Id = _] ++ map fst M.paper, _)]
|
adamc@1022
|
313 ++ map (fn ts => ([], ts))
|
adamc@1022
|
314 O.yourPaperTables],
|
adamc@1022
|
315 SelectExps = {}},
|
adamc@1022
|
316 OrderBy = sql_order_by_Nil [_],
|
adamc@1022
|
317 Limit = sql_no_limit,
|
adamc@1022
|
318 Offset = sql_no_offset})
|
adamc@1022
|
319
|
adamc@1009
|
320 and one id =
|
adamc@1012
|
321 let
|
adamc@1012
|
322 fun newReview r =
|
adamc@1012
|
323 me <- getLogin;
|
adamc@1012
|
324 checkPaper id;
|
adamc@1012
|
325 dml (insert review ({Paper = sql_inject id, User = sql_inject me.Id}
|
adamc@1012
|
326 ++ ensql M.review r M.reviewFolder));
|
adamc@1012
|
327 one id
|
adamc@1009
|
328
|
adamc@1012
|
329 fun saveReview r =
|
adamc@1012
|
330 me <- getLogin;
|
adamc@1012
|
331 checkPaper id;
|
adamc@1012
|
332 dml (update [map fst M.review] ! (ensql M.review r M.reviewFolder)
|
adamc@1012
|
333 review (WHERE T.Paper = {[id]} AND T.User = {[me.Id]}));
|
adamc@1012
|
334 one id
|
adamc@1012
|
335 in
|
adamc@1012
|
336 me <- getLogin;
|
adamc@1012
|
337 checkPaper id;
|
adamc@1012
|
338 ro <- oneOrNoRows (SELECT paper.{{map fst M.paper}}, octet_length(paper.Document) AS N
|
adamc@1012
|
339 FROM paper
|
adamc@1012
|
340 WHERE paper.Id = {[id]});
|
adamc@1012
|
341 authors <- queryX (SELECT user.Nam
|
adamc@1012
|
342 FROM authorship
|
adamc@1012
|
343 JOIN user ON authorship.User = user.Id
|
adamc@1012
|
344 WHERE authorship.Paper = {[id]})
|
adamc@1012
|
345 (fn r => <xml><li>{[r.User.Nam]}</li></xml>);
|
adamc@1012
|
346 myReview <- oneOrNoRows1 (SELECT review.{{map fst M.review}}
|
adamc@1012
|
347 FROM review
|
adamc@1012
|
348 WHERE review.User = {[me.Id]}
|
adamc@1012
|
349 AND review.Paper = {[id]});
|
adamc@1012
|
350 case ro of
|
adamc@1012
|
351 None => error <xml>Paper not found!</xml>
|
adamc@1012
|
352 | Some r => return <xml><body>
|
adamc@1012
|
353 <h1>Paper #{[id]}</h1>
|
adamc@1010
|
354
|
adamc@1012
|
355 <h3>Authors:</h3>
|
adamc@1012
|
356 <ul>
|
adamc@1012
|
357 {authors}
|
adamc@1012
|
358 </ul>
|
adamc@1009
|
359
|
adamc@1012
|
360 {allContent M.paper r.Paper M.paperFolder}<br/>
|
adamc@1011
|
361
|
adamc@1012
|
362 {if r.N = 0 then
|
adamc@1012
|
363 <xml><div>No paper uploaded yet.</div></xml>
|
adamc@1012
|
364 else
|
adamc@1012
|
365 <xml><a link={download id}>Download paper</a> ({[r.N]} bytes)</xml>}
|
adamc@1011
|
366
|
adamc@1012
|
367 <hr/>
|
adamc@1011
|
368
|
adamc@1012
|
369 {case myReview of
|
adamc@1012
|
370 None => <xml>
|
adamc@1012
|
371 <h2>Add Your Review</h2>
|
adamc@1012
|
372
|
adamc@1012
|
373 <form>
|
adamc@1012
|
374 {allWidgets M.review M.reviewFolder}
|
adamc@1012
|
375 <submit value="Add" action={newReview}/>
|
adamc@1012
|
376 </form>
|
adamc@1012
|
377 </xml>
|
adamc@1012
|
378 | Some myReview => <xml>
|
adamc@1012
|
379 <h2>Edit Your Review</h2>
|
adamc@1012
|
380
|
adamc@1012
|
381 <form>
|
adamc@1012
|
382 {allPopulated M.review myReview M.reviewFolder}
|
adamc@1012
|
383 <submit value="Save" action={saveReview}/>
|
adamc@1012
|
384 </form>
|
adamc@1012
|
385 </xml>}
|
adamc@1012
|
386 </body></xml>
|
adamc@1012
|
387 end
|
adamc@1009
|
388
|
adamc@1009
|
389 and download id =
|
adamc@1009
|
390 checkPaper id;
|
adamc@1009
|
391 ro <- oneOrNoRows (SELECT paper.Document
|
adamc@1009
|
392 FROM paper
|
adamc@1009
|
393 WHERE paper.Id = {[id]});
|
adamc@1009
|
394 case ro of
|
adamc@1009
|
395 None => error <xml>Paper not found!</xml>
|
adamc@1009
|
396 | Some r => returnBlob r.Paper.Document (blessMime "application/pdf")
|
adamc@1009
|
397
|
adamc@1001
|
398 end
|