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 You must be logged in to do that.
| Some r => return r
fun checkPaper id =
r <- getLogin;
if r.OnPc then
return ()
else
error You aren't authorized to see that paper.
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)
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
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
Registering a New Account
{case msg of
None =>
| Some msg =>
{[msg]}
}
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
{case ro of
None =>
Invalid username or password.
| _ => }
{m}
and main' () =
me <- checkLogin;
now <- now;
return
and main () =
m <- main' ();
return {m}
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 At least one of those coauthor usernames isn't registered.
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 Impossible empty uid!
| Some uid => dml (INSERT INTO authorship (Paper, User)
VALUES ({[id]}, {[uid]})))
(Some me.Id :: coauthors);
return
Thanks for submitting!
fun authorBlanks n =
case n of
O =>
| S n => Author:
and authorBlanksS n =
n <- signal n;
return (authorBlanks n)
in
me <- getLogin;
numAuthors <- source O;
return
Submit a Paper
end
and all () =
ps <- queryX (SELECT paper.Id, paper.{{map fst M.paper}} FROM paper)
(fn r =>
and one id =
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 =>
{[r.User.Nam]}
);
myReview <- oneOrNoRows1 (SELECT review.{{map fst M.review}}
FROM review
WHERE review.User = {[me.Id]}
AND review.Paper = {[id]});
case ro of
None => error Paper not found!
| Some r => return
Paper #{[id]}
Authors:
{authors}
{allContent M.paper r.Paper M.paperFolder}
{if r.N = 0 then
No paper uploaded yet.
else
Download paper ({[r.N]} bytes)}
{case myReview of
None =>
Add Your Review
| Some myReview =>
Edit Your Review
}
and download id =
checkPaper id;
ro <- oneOrNoRows (SELECT paper.Document
FROM paper
WHERE paper.Id = {[id]});
case ro of
None => error Paper not found!
| Some r => returnBlob r.Paper.Document (blessMime "application/pdf")
end