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)