diff options
Diffstat (limited to 'demo')
| -rw-r--r-- | demo/more/conference.ur | 26 | ||||
| -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 | 19 | ||||
| -rw-r--r-- | demo/more/conferenceFields.urs | 3 | ||||
| -rw-r--r-- | demo/more/meta.ur | 12 | ||||
| -rw-r--r-- | demo/more/meta.urs | 3 |
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) |