summaryrefslogtreecommitdiff
path: root/demo/more
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-10-22 16:15:56 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-10-22 16:15:56 -0400
commitdf4090ae1a231b363a0bc5d38036628e738276ee (patch)
treea765ee0cd11f8b42d77606fa4d133daceefff056 /demo/more
parentdff3c4a68a27213e3c2ebcd6223e14ae79842a7a (diff)
Initial support for char in SQL
Diffstat (limited to 'demo/more')
-rw-r--r--demo/more/conference.ur26
-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.ur19
-rw-r--r--demo/more/conferenceFields.urs3
-rw-r--r--demo/more/meta.ur12
-rw-r--r--demo/more/meta.urs3
8 files changed, 65 insertions, 2 deletions
diff --git a/demo/more/conference.ur b/demo/more/conference.ur
index 8e408d2f..72750248 100644
--- a/demo/more/conference.ur
+++ b/demo/more/conference.ur
@@ -9,6 +9,7 @@ functor Make(M : sig
con review :: {(Type * Type)}
constraint [Paper, User] ~ review
val review : $(map meta review)
+ val reviewFolder : folder review
val submissionDeadline : time
val summarizePaper : $(map fst paper) -> xbody
@@ -26,7 +27,7 @@ functor Make(M : sig
table authorship : {Paper : int, User : int}
PRIMARY KEY (Paper, User),
- CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
+ CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id) ON DELETE CASCADE,
CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
con review = [Paper = int, User = int] ++ map fst M.review
@@ -249,6 +250,7 @@ functor Make(M : sig
</body></xml>
and one id =
+ me <- getLogin;
checkPaper id;
ro <- oneOrNoRows (SELECT paper.{{map fst M.paper}}, octet_length(paper.Document) AS N
FROM paper
@@ -258,6 +260,10 @@ functor Make(M : sig
JOIN user ON authorship.User = user.Id
WHERE authorship.Paper = {[id]})
(fn r => <xml><li>{[r.User.Nam]}</li></xml>);
+ myReview <- oneOrNoRows1 (SELECT review.{{map fst M.review}}
+ FROM review
+ WHERE review.User = {[me.Id]}
+ AND review.Paper = {[id]});
case ro of
None => error <xml>Paper not found!</xml>
| Some r => return <xml><body>
@@ -274,6 +280,24 @@ functor Make(M : sig
<xml><div>No paper uploaded yet.</div></xml>
else
<xml><a link={download id}>Download paper</a> ({[r.N]} bytes)</xml>}
+
+ <hr/>
+
+ {case myReview of
+ None => <xml>
+ <h2>Add Your Review</h2>
+
+ <form>
+ {allWidgets M.review M.reviewFolder}
+ </form>
+ </xml>
+ | Some myReview => <xml>
+ <h2>Edit Your Review</h2>
+
+ <form>
+ {allPopulated M.review myReview M.reviewFolder}
+ </form>
+ </xml>}
</body></xml>
and download id =
diff --git a/demo/more/conference.urp b/demo/more/conference.urp
index 42d51ba9..0fd67b8a 100644
--- a/demo/more/conference.urp
+++ b/demo/more/conference.urp
@@ -1,5 +1,6 @@
allow mime application/pdf
+$/string
$/option
$/list
meta
diff --git a/demo/more/conference.urs b/demo/more/conference.urs
index 04e8e298..53fd478d 100644
--- a/demo/more/conference.urs
+++ b/demo/more/conference.urs
@@ -7,6 +7,7 @@ functor Make(M : sig
con review :: {(Type * Type)}
constraint [Paper, User] ~ review
val review : $(map Meta.meta review)
+ val reviewFolder : folder review
val submissionDeadline : time
val summarizePaper : $(map fst paper) -> xbody
diff --git a/demo/more/conference1.ur b/demo/more/conference1.ur
index d52de976..b6867728 100644
--- a/demo/more/conference1.ur
+++ b/demo/more/conference1.ur
@@ -3,7 +3,7 @@ open ConferenceFields
open Conference.Make(struct
val paper = {Title = title,
Abstract = abstract}
- val review = {}
+ val review = {Rating = dropdown "Rating" (#"A" :: #"B" :: #"C" :: #"D" :: [])}
val submissionDeadline = readError "2009-10-22 23:59:59"
diff --git a/demo/more/conferenceFields.ur b/demo/more/conferenceFields.ur
index be0843af..ae9ed5a7 100644
--- a/demo/more/conferenceFields.ur
+++ b/demo/more/conferenceFields.ur
@@ -2,3 +2,22 @@ open Meta
val title = string "Title"
val abstract = textarea "Abstract"
+
+fun charIn s =
+ if String.length s = 0 then
+ error <xml>Impossible: Empty option value</xml>
+ else
+ String.sub s 0
+
+con dropdown = (char, string)
+fun dropdown name opts = {Nam = name,
+ Show = txt,
+ Widget = fn [nm :: Name] => <xml><select{nm}>
+ {List.mapX (fn x => <xml><option>{[x]}</option></xml>) opts}
+ </select></xml>,
+ WidgetPopulated = fn [nm :: Name] v => <xml><select{nm}>
+ {List.mapX (fn x => <xml><option selected={x = v}>{[x]}</option></xml>) opts}
+ </select></xml>,
+ Parse = charIn,
+ Inject = _}
+
diff --git a/demo/more/conferenceFields.urs b/demo/more/conferenceFields.urs
index 8352071d..d235ec4c 100644
--- a/demo/more/conferenceFields.urs
+++ b/demo/more/conferenceFields.urs
@@ -1,2 +1,5 @@
val title : Meta.meta (string, string)
val abstract : Meta.meta (string, string)
+
+con dropdown :: (Type * Type)
+val dropdown : string -> list char -> Meta.meta dropdown
diff --git a/demo/more/meta.ur b/demo/more/meta.ur
index 9470eea0..74b5004f 100644
--- a/demo/more/meta.ur
+++ b/demo/more/meta.ur
@@ -52,6 +52,18 @@ fun allWidgets [ts ::: {(Type * Type)}] (r : $(map meta ts)) (fl : folder ts) =
<xml/>
[_] fl r
+fun allPopulated [ts ::: {(Type * Type)}] (r : $(map meta ts)) (vs : $(map fst ts)) (fl : folder ts) =
+ foldR2 [meta] [fst] [fn cols :: {(Type * Type)} =>
+ xml form [] (map snd cols)]
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest]
+ (m : meta p) v (acc : xml form [] (map snd rest)) =>
+ <xml>
+ {[m.Nam]}: {m.WidgetPopulated [nm] v}<br/>
+ {useMore acc}
+ </xml>)
+ <xml/>
+ [_] fl r vs
+
fun allPopulatedTr [ts ::: {(Type * Type)}] (r : $(map meta ts)) (vs : $(map fst ts)) (fl : folder ts) =
foldR2 [meta] [fst] [fn cols :: {(Type * Type)} =>
xml [Body, Form, Tr] [] (map snd cols)]
diff --git a/demo/more/meta.urs b/demo/more/meta.urs
index 90c4e17e..0d3422af 100644
--- a/demo/more/meta.urs
+++ b/demo/more/meta.urs
@@ -18,6 +18,9 @@ val allContent : ts ::: {(Type * Type)} -> $(map meta ts) -> $(map fst ts) -> fo
val allWidgets : ts ::: {(Type * Type)} -> $(map meta ts) -> folder ts
-> xml form [] (map snd ts)
+val allPopulated : ts ::: {(Type * Type)} -> $(map meta ts) -> $(map fst ts) -> folder ts
+ -> xml form [] (map snd ts)
+
val allPopulatedTr : ts ::: {(Type * Type)} -> $(map meta ts) -> $(map fst ts) -> folder ts
-> xml ([Tr] ++ form) [] (map snd ts)
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-01 20:45:12 +0000