adamc@1004: open Meta adamc@1001: adamc@1001: functor Make(M : sig adamc@1003: con paper :: {(Type * Type)} adamc@1008: constraint [Id, Document] ~ paper adamc@1003: val paper : $(map meta paper) adamc@1007: val paperFolder : folder paper adamc@1003: adamc@1001: con review :: {(Type * Type)} adamc@1003: constraint [Paper, User] ~ review adamc@1003: val review : $(map meta review) adamc@1006: adamc@1006: val submissionDeadline : time adamc@1009: val summarizePaper : $(map fst paper) -> xbody adamc@1001: end) = struct adamc@1001: adamc@1003: table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool} adamc@1003: PRIMARY KEY Id, adamc@1003: CONSTRAINT Nam UNIQUE Nam adamc@1003: sequence userId adamc@1003: adamc@1008: con paper = [Id = int, Document = blob] ++ map fst M.paper adamc@1003: table paper : paper adamc@1003: PRIMARY KEY Id adamc@1003: sequence paperId adamc@1003: adamc@1003: con review = [Paper = int, User = int] ++ map fst M.review adamc@1003: table review : review adamc@1003: PRIMARY KEY (Paper, User), adamc@1003: CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id), adamc@1003: CONSTRAINT User FOREIGN KEY User REFERENCES user(Id) adamc@1003: sequence reviewId adamc@1003: adamc@1003: cookie login : {Id : int, Password : string} adamc@1003: adamc@1004: val checkLogin = adamc@1003: r <- getCookie login; adamc@1003: case r of adamc@1003: None => return None adamc@1003: | Some r => adamc@1003: oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc adamc@1003: FROM user adamc@1003: WHERE user.Id = {[r.Id]} adamc@1003: AND user.Password = {[r.Password]}) adamc@1003: adamc@1009: fun checkPaper id = adamc@1009: ro <- checkLogin; adamc@1009: if (case ro of adamc@1009: None => False adamc@1009: | Some r => r.OnPc) then adamc@1009: return () adamc@1009: else adamc@1009: error You must be logged in to do that. adamc@1009: adamc@1004: structure Users = BulkEdit.Make(struct adamc@1004: con keyName = #Id adamc@1004: val visible = {Nam = string "Name", adamc@1004: Chair = bool "Chair?", adamc@1004: OnPc = bool "On PC?"} adamc@1004: adamc@1004: val title = "Users" adamc@1004: val isAllowed = adamc@1004: me <- checkLogin; adamc@1004: return (Option.isSome me) adamc@1004: adamc@1004: val t = user adamc@1004: end) adamc@1004: adamc@1004: adamc@1003: fun doRegister r = adamc@1003: n <- oneRowE1 (SELECT COUNT( * ) AS N adamc@1003: FROM user adamc@1003: WHERE user.Nam = {[r.Nam]}); adamc@1003: if n > 0 then adamc@1003: register (Some "Sorry; that username is taken.") adamc@1003: else adamc@1003: id <- nextval userId; adamc@1003: dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc) adamc@1003: VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE)); adamc@1003: setCookie login {Id = id, Password = r.Password}; adamc@1003: main () adamc@1003: adamc@1003: and register msg = return adamc@1003:

Registering a New Account

adamc@1003: adamc@1003: {case msg of adamc@1003: None => adamc@1003: | Some msg =>
{[msg]}
} adamc@1003: adamc@1003:
adamc@1003: adamc@1003: adamc@1003: adamc@1003:
Username:
Password:
adamc@1003: adamc@1003: adamc@1006: and signin r = adamc@1006: ro <- oneOrNoRowsE1 (SELECT user.Id AS N adamc@1006: FROM user adamc@1006: WHERE user.Nam = {[r.Nam]} adamc@1006: AND user.Password = {[r.Password]}); adamc@1006: (case ro of adamc@1006: None => return () adamc@1006: | Some id => setCookie login {Id = id, Password = r.Password}); adamc@1006: m <- main' (); adamc@1006: return adamc@1006: {case ro of adamc@1006: None =>
Invalid username or password.
 adamc@1006: | _ => } adamc@1006: adamc@1006: {m} adamc@1006: adamc@1006: adamc@1006: and main' () = adamc@1004: me <- checkLogin; adamc@1006: now <- now; adamc@1006: return
    adamc@1003: {case me of adamc@1006: None => adamc@1006:
  • Register for access
    • adamc@1006:
  • Log in:
    adamc@1006: adamc@1006: adamc@1006: adamc@1006:
    Username:
    Password:
    • adamc@1006:     adamc@1004: | Some me => adamc@1004:
    Welcome, {[me.Nam]}!
    adamc@1004: adamc@1004: {if me.Chair then adamc@1004:
  • Manage users
    •  adamc@1004: else adamc@1004: } adamc@1006: adamc@1009: {if me.OnPc then adamc@1009:
  • All papers
    •  adamc@1009: else adamc@1009: } adamc@1009: adamc@1006: {if now < M.submissionDeadline then adamc@1007:
  • Submit
    •  adamc@1006: else adamc@1006: } adamc@1004: } adamc@1006:
adamc@1006: adamc@1006: and main () = adamc@1006: m <- main' (); adamc@1006: return {m} adamc@1001: adamc@1008: and submit () = adamc@1008: let adamc@1009: fun doSubmit r = adamc@1009: id <- nextval paperId; adamc@1009: dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)} adamc@1009: ++ ensql M.paper (r -- #Document) M.paperFolder)); adamc@1009: return adamc@1009: OK, done! adamc@1009: adamc@1008: in adamc@1008: return adamc@1008:

Submit a Paper

adamc@1008: adamc@1008:
adamc@1008: {allWidgets M.paper M.paperFolder} adamc@1008: Paper:
adamc@1008: adamc@1008: adamc@1008:
adamc@1008: end adamc@1007: adamc@1009: and all () = adamc@1009: ps <- queryX (SELECT paper.Id, paper.{{map fst M.paper}} FROM paper) adamc@1009: (fn r =>
  • {M.summarizePaper (r.Paper -- #Id)}
    • ); adamc@1009: return adamc@1009:

    All Papers

    adamc@1009: adamc@1009:
      adamc@1009: {ps} adamc@1009:
    adamc@1009:     adamc@1009: adamc@1009: and one id = adamc@1009: checkPaper id; adamc@1009: ro <- oneOrNoRows (SELECT paper.{{map fst M.paper}}, octet_length(paper.Document) AS N adamc@1009: FROM paper adamc@1009: WHERE paper.Id = {[id]}); adamc@1009: case ro of adamc@1009: None => error Paper not found! adamc@1009: | Some r => return adamc@1009:

    Paper #{[id]}

    adamc@1009: adamc@1009: {allContent M.paper r.Paper M.paperFolder}
    adamc@1009: adamc@1009: {if r.N = 0 then adamc@1009:
    No paper uploaded yet.
     adamc@1009: else adamc@1009: Download paper ({[r.N]} bytes)} adamc@1009:     adamc@1009: adamc@1009: and download id = adamc@1009: checkPaper id; adamc@1009: ro <- oneOrNoRows (SELECT paper.Document adamc@1009: FROM paper adamc@1009: WHERE paper.Id = {[id]}); adamc@1009: case ro of adamc@1009: None => error Paper not found! adamc@1009: | Some r => returnBlob r.Paper.Document (blessMime "application/pdf") adamc@1009: adamc@1001: end