From c672aad3fe693606fdff72f3b59ca26cc92c9fa9 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 22 Oct 2009 12:16:31 -0400 Subject: Viewing papers --- demo/more/conference.ur | 64 +++++++++++++++++++++++++++++++++++++++--- demo/more/conference.urp | 1 + demo/more/conference.urs | 1 + demo/more/conference1.ur | 2 ++ demo/more/conferenceFields.ur | 3 -- demo/more/conferenceFields.urs | 7 ++--- demo/more/meta.ur | 7 +++++ demo/more/meta.urs | 2 ++ 8 files changed, 75 insertions(+), 12 deletions(-) (limited to 'demo/more') diff --git a/demo/more/conference.ur b/demo/more/conference.ur index b9ade8da..290ff61d 100644 --- a/demo/more/conference.ur +++ b/demo/more/conference.ur @@ -11,6 +11,7 @@ functor Make(M : sig val review : $(map meta review) val submissionDeadline : time + val summarizePaper : $(map fst paper) -> xbody end) = struct table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool} @@ -42,6 +43,15 @@ functor Make(M : sig WHERE user.Id = {[r.Id]} AND user.Password = {[r.Password]}) + fun checkPaper id = + ro <- checkLogin; + if (case ro of + None => False + | Some r => r.OnPc) then + return () + else + error You must be logged in to do that. + structure Users = BulkEdit.Make(struct con keyName = #Id val visible = {Nam = string "Name", @@ -122,6 +132,11 @@ functor Make(M : sig else } + {if me.OnPc then +

+ else + } + {if now < M.submissionDeadline then

else @@ -135,10 +150,13 @@ functor Make(M : sig and submit () = let - fun doSubmit r = return - MIME type: {[fileMimeType r.Document]}
- Length: {[blobSize (fileData r.Document)]} - + fun doSubmit r = + id <- nextval paperId; + dml (insert paper ({Id = sql_inject id, Document = sql_inject (fileData r.Document)} + ++ ensql M.paper (r -- #Document) M.paperFolder)); + return + OK, done! + in return

Submit a Paper

@@ -151,4 +169,42 @@ functor Make(M : sig end + and all () = + ps <- queryX (SELECT paper.Id, paper.{{map fst M.paper}} FROM paper) + (fn r =>

{M.summarizePaper (r.Paper -- #Id)}

); + return +

All Papers

+ +

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

Paper #{[id]}

+ + {allContent M.paper r.Paper M.paperFolder}
+ + {if r.N = 0 then +

No paper uploaded yet.

+ else + Download paper ({[r.N]} bytes)} + + + 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 diff --git a/demo/more/conference.urp b/demo/more/conference.urp index cd064629..42d51ba9 100644 --- a/demo/more/conference.urp +++ b/demo/more/conference.urp @@ -1,3 +1,4 @@ +allow mime application/pdf $/option $/list diff --git a/demo/more/conference.urs b/demo/more/conference.urs index 59ea77f8..6c243f9b 100644 --- a/demo/more/conference.urs +++ b/demo/more/conference.urs @@ -9,6 +9,7 @@ functor Make(M : sig val review : $(map Meta.meta review) val submissionDeadline : time + val summarizePaper : $(map fst paper) -> xbody end) : sig val main : unit -> transaction page diff --git a/demo/more/conference1.ur b/demo/more/conference1.ur index 3fc5ff64..d52de976 100644 --- a/demo/more/conference1.ur +++ b/demo/more/conference1.ur @@ -6,4 +6,6 @@ open Conference.Make(struct val review = {} val submissionDeadline = readError "2009-10-22 23:59:59" + + fun summarizePaper r = cdata r.Title end) diff --git a/demo/more/conferenceFields.ur b/demo/more/conferenceFields.ur index 445b89b9..be0843af 100644 --- a/demo/more/conferenceFields.ur +++ b/demo/more/conferenceFields.ur @@ -1,7 +1,4 @@ open Meta -con title = (string, string) val title = string "Title" - -con abstract = (string, string) val abstract = textarea "Abstract" diff --git a/demo/more/conferenceFields.urs b/demo/more/conferenceFields.urs index 9867db47..8352071d 100644 --- a/demo/more/conferenceFields.urs +++ b/demo/more/conferenceFields.urs @@ -1,5 +1,2 @@ -con title :: (Type * Type) -val title : Meta.meta title - -con abstract :: (Type * Type) -val abstract : Meta.meta abstract +val title : Meta.meta (string, string) +val abstract : Meta.meta (string, string) diff --git a/demo/more/meta.ur b/demo/more/meta.ur index 944db822..9470eea0 100644 --- a/demo/more/meta.ur +++ b/demo/more/meta.ur @@ -35,6 +35,13 @@ fun textarea name = {Nam = name, Parse = fn s => s, Inject = _} +fun allContent [ts ::: {(Type * Type)}] (r : $(map meta ts)) (vs : $(map fst ts)) (fl : folder ts) = + foldRX2 [meta] [fst] [_] + (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] + (m : meta p) v => + {[m.Nam]}: {m.Show v}
) + [_] fl r vs + fun allWidgets [ts ::: {(Type * Type)}] (r : $(map meta ts)) (fl : folder ts) = foldR [meta] [fn ts :: {(Type * Type)} => xml form [] (map snd ts)] (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}] diff --git a/demo/more/meta.urs b/demo/more/meta.urs index e949e5ee..90c4e17e 100644 --- a/demo/more/meta.urs +++ b/demo/more/meta.urs @@ -13,6 +13,8 @@ val bool : string -> meta (bool, bool) val textarea : string -> meta (string, string) +val allContent : ts ::: {(Type * Type)} -> $(map meta ts) -> $(map fst ts) -> folder ts -> xbody + val allWidgets : ts ::: {(Type * Type)} -> $(map meta ts) -> folder ts -> xml form [] (map snd ts) -- cgit v1.2.3