Mercurial > urweb
changeset 1009:59097824f19b
Viewing papers
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 22 Oct 2009 12:16:31 -0400 |
| parents | 1911e84df461 |
| children | 6b0f3853cc81 |
| files | demo/more/conference.ur demo/more/conference.urp demo/more/conference.urs demo/more/conference1.ur demo/more/conferenceFields.ur demo/more/conferenceFields.urs demo/more/meta.ur demo/more/meta.urs |
| diffstat | 8 files changed, 75 insertions(+), 12 deletions(-) [+] |
line wrap: on
line diff
--- a/demo/more/conference.ur Thu Oct 22 11:51:31 2009 -0400 +++ b/demo/more/conference.ur Thu Oct 22 12:16:31 2009 -0400 @@ -11,6 +11,7 @@ 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 @@ 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 <xml>You must be logged in to do that.</xml> + structure Users = BulkEdit.Make(struct con keyName = #Id val visible = {Nam = string "Name", @@ -122,6 +132,11 @@ 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 @@ -135,10 +150,13 @@ and submit () = let - fun doSubmit r = return <xml><body> - MIME type: {[fileMimeType r.Document]}<br/> - Length: {[blobSize (fileData r.Document)]} - </body></xml> + 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 <xml><body> + OK, done! + </body></xml> in return <xml><body> <h1>Submit a Paper</h1> @@ -151,4 +169,42 @@ </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 = + 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 <xml>Paper not found!</xml> + | Some r => return <xml><body> + <h1>Paper #{[id]}</h1> + + {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>} + </body></xml> + + 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
--- a/demo/more/conference.urp Thu Oct 22 11:51:31 2009 -0400 +++ b/demo/more/conference.urp Thu Oct 22 12:16:31 2009 -0400 @@ -1,3 +1,4 @@ +allow mime application/pdf $/option $/list
--- a/demo/more/conference.urs Thu Oct 22 11:51:31 2009 -0400 +++ b/demo/more/conference.urs Thu Oct 22 12:16:31 2009 -0400 @@ -9,6 +9,7 @@ val review : $(map Meta.meta review) val submissionDeadline : time + val summarizePaper : $(map fst paper) -> xbody end) : sig val main : unit -> transaction page
--- a/demo/more/conference1.ur Thu Oct 22 11:51:31 2009 -0400 +++ b/demo/more/conference1.ur Thu Oct 22 12:16:31 2009 -0400 @@ -6,4 +6,6 @@ val review = {} val submissionDeadline = readError "2009-10-22 23:59:59" + + fun summarizePaper r = cdata r.Title end)
--- a/demo/more/conferenceFields.ur Thu Oct 22 11:51:31 2009 -0400 +++ b/demo/more/conferenceFields.ur Thu Oct 22 12:16:31 2009 -0400 @@ -1,7 +1,4 @@ open Meta -con title = (string, string) val title = string "Title" - -con abstract = (string, string) val abstract = textarea "Abstract"
--- a/demo/more/conferenceFields.urs Thu Oct 22 11:51:31 2009 -0400 +++ b/demo/more/conferenceFields.urs Thu Oct 22 12:16:31 2009 -0400 @@ -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)
--- a/demo/more/meta.ur Thu Oct 22 11:51:31 2009 -0400 +++ b/demo/more/meta.ur Thu Oct 22 12:16:31 2009 -0400 @@ -35,6 +35,13 @@ 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 => + <xml><b>{[m.Nam]}</b>: {m.Show v}<br/></xml>) + [_] 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)}]
--- a/demo/more/meta.urs Thu Oct 22 11:51:31 2009 -0400 +++ b/demo/more/meta.urs Thu Oct 22 12:16:31 2009 -0400 @@ -13,6 +13,8 @@ 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)