summaryrefslogtreecommitdiff
path: root/demo/more
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-10-22 12:16:31 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-10-22 12:16:31 -0400
commit0b93d889ce76c949c013d24cc3fe1a1cee2445b3 (patch)
tree901f503fbc6b4bc7f9a6fd4ee70911c981ec4891 /demo/more
parentbe70af1ef8d1de3b201507c9e9227d41eceeefdd (diff)
Viewing papers
Diffstat (limited to 'demo/more')
-rw-r--r--demo/more/conference.ur64
-rw-r--r--demo/more/conference.urp1
-rw-r--r--demo/more/conference.urs1
-rw-r--r--demo/more/conference1.ur2
-rw-r--r--demo/more/conferenceFields.ur3
-rw-r--r--demo/more/conferenceFields.urs7
-rw-r--r--demo/more/meta.ur7
-rw-r--r--demo/more/meta.urs2
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)
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-01 20:31:32 +0000