typename Author = (id:Int, name:String);
typename Paper = (id:Int, title:String);
var db = database "citations";
var authorsTable = table "authors" with (id : Int, name : String) where id readonly from db;
var papersTable = table "papers" with (id : Int, title : String) where id readonly from db;
var paperauthorTable = table "paperauthor" with (paperid : Int, authorid : Int) from db;
fun renderAuthor(author) {{stringToXml(author.name)}}
fun renderPaper(paper) {{stringToXml(paper.title)}}
var authorId = "author";
var paperId = "paper";
var authorLabel = "Author";
var paperLabel = "Paper";
sig header : (String) ~> Xml
fun header(title) {
{stringToXml(title)}
}
sig suggest : (String, String) ~> ()
fun suggest(authorPrefix, paperPrefix) client {
var (authorList, paperList) = completions(authorPrefix, paperPrefix);
domReplaceChildren(
authorList,
getNodeById(authorId)
);
domReplaceChildren(
paperList,
getNodeById(paperId)
)
}
sig formatAuthorList : ([Author]) ~> Xml
fun formatAuthorList(authors) server {
for (a <- authors)
<#>{renderAuthor(a)}
}
sig formatPaperList : ([Paper]) ~> Xml
fun formatPaperList(papers) server {
for (p <- papers)
<#>{renderPaper(p)}
}
sig getPapersAndCollaborators : (Author) ~> ([Paper], [Author])
fun getPapersAndCollaborators(author) server {
var papers =
query {
for (r <-- paperauthorTable)
where (r.authorid == author.id)
for (p <-- papersTable)
where (p.id == r.paperid)
[(id=p.id, title=p.title)]
};
# return all papers for which authorid is a co-author
fun lookupPapers(authorid) {
for (r <-- paperauthorTable)
where (r.authorid == authorid)
[(paperid=r.paperid)]
}
# return the authors of paper p satisfying the predicate f
fun lookupAuthors(p, f) {
for (r <-- paperauthorTable)
where (p.paperid == r.paperid && f(r.authorid))
[(id=r.authorid)]
}
# return the details for author c
fun lookupAuthorDetails(c) {
for (a <-- authorsTable)
where (c.id == a.id)
[(id=a.id, name=a.name)]
}
var collaborators =
query {
# papers written by author.id
var papers = lookupPapers(author.id);
# collaborators == authors \ {author.id}
var collaborators =
for (p <- papers)
lookupAuthors(p, fun (id) {id <> author.id});
for (c <- collaborators)
lookupAuthorDetails(c)
};
# var collaborators =
# query {
# for (r <-- paperauthorTable)
# for (q <-- paperauthorTable)
# for (a <-- authorsTable)
# where (r.authorid == author.id &&
# r.paperid == q.paperid && not (q.authorid == author.id) &&
# q.authorid == a.id)
# [(id=a.id, name=a.name)]
# };
(papers, distinct(collaborators))
}
sig showAuthorInfo : (Author) ~> Page
fun showAuthorInfo(author) server {
var (papers, collaborators) = getPapersAndCollaborators(author);
page
{header(author.name)}
{stringToXml(author.name)}
Papers
{formatPaperList(papers)}
Collaborators
{formatAuthorList(collaborators)}
}
sig getAuthors : (Paper) -> [Author]
fun getAuthors(paper) server {
query {
for (r <-- paperauthorTable)
where (paper.id == r.paperid)
for (a <-- authorsTable)
where (r.authorid == a.id)
[(id=a.id, name=a.name)]
}
}
fun updatePaper(paper) server {
update (p <-- papersTable)
where (p.id == paper.id)
set (title=paper.title);
showPaperInfo(paper)
}
fun updateAuthor(author) server {
update (a <-- authorsTable)
where (a.id == author.id)
set (name=author.name);
showAuthorInfo(author)
}
sig showPaperInfo : (Paper) ~> Page
fun showPaperInfo(paper) server {
var authors = getAuthors(paper);
page
{header(paper.title)}
{stringToXml(paper.title)}
Authors
{formatAuthorList(authors)}
}
sig completions : (String, String) ~> (Xml, Xml)
fun completions(authorPrefix, paperPrefix) server {
var authors =
if (authorPrefix == "") []
else {
if (paperPrefix == "") {
query [10] {
for (a <-- authorsTable)
where (a.name =~ /^{authorPrefix}.*/)
orderby (a.name)
[(id=a.id, name=a.name)]
}
} else {
query [10] {
for (a <-- authorsTable)
orderby (a.name)
for (p <-- papersTable)
for (r <-- paperauthorTable)
where (a.name =~ /^{authorPrefix}.*/ &&
p.title =~ /^{paperPrefix}.*/ &&
p.id == r.paperid && r.authorid == a.id)
[(id=a.id, name=a.name)]
}
}
};
var papers =
if (paperPrefix == "") []
else {
if (authorPrefix == "") {
query [10] {
for (p <-- papersTable)
where (p.title =~ /^{paperPrefix}.*/)
orderby (p.title)
[(id=p.id, title=p.title)]
}
} else {
distinct(
query [10] {
for (p <-- papersTable)
orderby (p.title)
for (a <-- authorsTable)
for (r <-- paperauthorTable)
where (a.name =~ /^{authorPrefix}.*/ &&
p.title =~ /^{paperPrefix}.*/ &&
p.id == r.paperid && r.authorid == a.id)
[(id=p.id, title=p.title)]
})
}
};
(formatAuthorList(authors), formatPaperList(papers))
}
sig distinct : ([(id:Int|r)]) ~> [(id:Int|r)]
fun distinct(xs) {
fold_left(
fun (ys, x) {
switch (ys) {
case [] -> [x]
case (y::ys) ->
if(x.id == y.id) {y::ys} else {x::y::ys}
}
},
[],
xs)
}
fun main () {
# granularity of server requests
var w = 1;
fun startSuggester(manager) {
spawn {
fun suggester(a, p, t) {
receive {
case Change -> {
# in practice sleeping isn't necessary
# because JavaScript is so slow that sending the
# message back and forth has the desired effect
# but this is what the code should look like
var u = clientTime();
if(u-t < w) { sleep(w-(u-t)) } else {()};
manager!GetCurrentState;
fun f() {
receive {
case Change -> f()
case Suggest(b, q) ->
if(a <> b || p <> q) {suggest(b, q)} else {()};
suggester(b, q, t)
}
}
f();
suggester(a, p, t)
}
case Suggest(b, q) ->
error("Didn't ask for a suggestion!");
}
}
var t = clientTime();
suggester("", "", t)
}
}
var manager = spawnClient {
fun receiver(a, p, s) {
receive {
case Suggest(authorPrefix, paperPrefix) -> {
var suggester =
switch(s) {
case Some(suggester) -> suggester
case None -> startSuggester(self())
};
if(authorPrefix <> a || paperPrefix <> p)
{suggester!Change}
# slow version
# {suggest(authorPrefix, paperPrefix)}
else {()};
receiver(authorPrefix, paperPrefix, Some(suggester))
}
case GetCurrentState ->
switch (s) {
case Some(suggester) -> suggester!Suggest(a, p); receiver(a, p, s)
case None -> error("No suggester!")
};
receiver(a, p, s)
}
}
receiver("", "", None)
};
page
{header("Citations")}
Find authors and papers
}
main()