1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
|
open Meta
functor Make(M : sig
con paper :: {(Type * Type)}
constraint [Id, Document, Authors] ~ paper
val paper : $(map meta paper)
val paperFolder : folder paper
con review :: {(Type * Type)}
constraint [Paper, User] ~ review
val review : $(map meta review)
val reviewFolder : folder review
val submissionDeadline : time
val summarizePaper : $(map fst paper) -> xbody
end) = struct
table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool}
PRIMARY KEY Id,
CONSTRAINT Nam UNIQUE Nam
sequence userId
con paper = [Id = int, Document = blob] ++ map fst M.paper
table paper : paper
PRIMARY KEY Id
sequence paperId
table authorship : {Paper : int, User : int}
PRIMARY KEY (Paper, User),
CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id) ON DELETE CASCADE,
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),
CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
sequence reviewId
cookie login : {Id : int, Password : string}
val checkLogin =
r <- getCookie login;
case r of
None => return None
| Some r =>
oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc
FROM user
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 =
r <- getLogin;
if r.OnPc then
return ()
else
error <xml>You aren't authorized to see that paper.</xml>
structure Users = BulkEdit.Make(struct
con keyName = #Id
val visible = {Nam = string "Name",
Chair = bool "Chair?",
OnPc = bool "On PC?"}
val title = "Users"
val isAllowed =
me <- checkLogin;
return (Option.isSome me)
val t = user
end)
fun doRegister r =
n <- oneRowE1 (SELECT COUNT( * ) AS N
FROM user
WHERE user.Nam = {[r.Nam]});
if n > 0 then
register (Some "Sorry; that username is taken.")
else
id <- nextval userId;
dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc)
VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE));
setCookie login {Id = id, Password = r.Password};
main ()
and register msg = return <xml><body>
<h1>Registering a New Account</h1>
{case msg of
None => <xml/>
| Some msg => <xml><div>{[msg]}</div></xml>}
<form><table>
<tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
<tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
<tr> <th><submit action={doRegister}/></th> </tr>
</table></form>
</body></xml>
and signin r =
ro <- oneOrNoRowsE1 (SELECT user.Id AS N
FROM user
WHERE user.Nam = {[r.Nam]}
AND user.Password = {[r.Password]});
(case ro of
None => return ()
| Some id => setCookie login {Id = id, Password = r.Password});
m <- main' ();
return <xml><body>
{case ro of
None => <xml><div>Invalid username or password.</div></xml>
| _ => <xml/>}
{m}
</body></xml>
and main' () =
me <- checkLogin;
now <- now;
return <xml><ul>
{case me of
None => <xml>
<li><a link={register None}>Register for access</a></li>
<li><b>Log in:</b> <form><table>
<tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
<tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
<tr> <th><submit value="Log in" action={signin}/></th> </tr>
</table></form></li>
</xml>
| Some me => <xml>
<div>Welcome, {[me.Nam]}!</div>
{if me.Chair then
<xml><li><a link={Users.main ()}>Manage users</a></li></xml>
else
<xml/>}
{if me.OnPc then
<xml><li><a link={all ()}>All papers</a></li></xml>
else
<xml/>}
{if now < M.submissionDeadline then
<xml><li><a link={submit ()}>Submit</a></li></xml>
else
<xml/>}
</xml>}
</ul></xml>
and main () =
m <- main' ();
return <xml><body>{m}</body></xml>
and submit () =
let
fun doSubmit r =
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>
in
me <- getLogin;
numAuthors <- Dnat.zero;
return <xml><body>
<h1>Submit a Paper</h1>
<form>
<b>Author:</b> {[me.Nam]}<br/>
<subforms{#Authors}>
{Dnat.render <xml><entry><b>Author:</b> <textbox{#Nam}/><br/></entry></xml> numAuthors}
</subforms>
<button value="Add author" onclick={Dnat.inc numAuthors}/><br/>
<button value="Remove author" onclick={Dnat.dec numAuthors}/><br/>
<br/>
{useMore (allWidgets M.paper M.paperFolder)}
<b>Paper:</b> <upload{#Document}/><br/>
<submit value="Submit" action={doSubmit}/>
</form>
</body></xml>
end
and all () =
ps <- queryX (SELECT paper.Id, paper.{{map fst M.paper}} FROM paper)
(fn r => <xml><li><a link={one r.Paper.Id}>{M.summarizePaper (r.Paper -- #Id)}</a></li></xml>);
return <xml><body>
<h1>All Papers</h1>
<ul>
{ps}
</ul>
</body></xml>
and one id =
let
fun newReview r =
me <- getLogin;
checkPaper id;
dml (insert review ({Paper = sql_inject id, User = sql_inject me.Id}
++ ensql M.review r M.reviewFolder));
one id
fun saveReview r =
me <- getLogin;
checkPaper id;
dml (update [map fst M.review] ! (ensql M.review r M.reviewFolder)
review (WHERE T.Paper = {[id]} AND T.User = {[me.Id]}));
one id
in
me <- getLogin;
checkPaper id;
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>);
myReview <- oneOrNoRows1 (SELECT review.{{map fst M.review}}
FROM review
WHERE review.User = {[me.Id]}
AND review.Paper = {[id]});
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
<xml><div>No paper uploaded yet.</div></xml>
else
<xml><a link={download id}>Download paper</a> ({[r.N]} bytes)</xml>}
<hr/>
{case myReview of
None => <xml>
<h2>Add Your Review</h2>
<form>
{allWidgets M.review M.reviewFolder}
<submit value="Add" action={newReview}/>
</form>
</xml>
| Some myReview => <xml>
<h2>Edit Your Review</h2>
<form>
{allPopulated M.review myReview M.reviewFolder}
<submit value="Save" action={saveReview}/>
</form>
</xml>}
</body></xml>
end
and download id =
checkPaper id;
ro <- oneOrNoRows (SELECT paper.Document
FROM paper
WHERE paper.Id = {[id]});
case ro of
None => error <xml>Paper not found!</xml>
| Some r => returnBlob r.Paper.Document (blessMime "application/pdf")
end
|
