diff options
-rw-r--r-- | demo/more/conference.ur | 64 | ||||
-rw-r--r-- | demo/more/conference.urp | 1 | ||||
-rw-r--r-- | demo/more/conference.urs | 1 | ||||
-rw-r--r-- | demo/more/conference1.ur | 2 | ||||
-rw-r--r-- | demo/more/conferenceFields.ur | 3 | ||||
-rw-r--r-- | demo/more/conferenceFields.urs | 7 | ||||
-rw-r--r-- | demo/more/meta.ur | 7 | ||||
-rw-r--r-- | demo/more/meta.urs | 2 |
8 files changed, 75 insertions, 12 deletions
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 <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 @@ functor Make(M : sig 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 @@ functor Make(M : sig 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 @@ functor Make(M : sig </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 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 => + <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)}] 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) |