From 7e1e019f3fef4c229c06ba2c0c2aa3ec021eedad Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 22 Oct 2009 16:15:56 -0400 Subject: Initial support for char in SQL --- demo/more/conference.ur | 26 +++++++++++++++++++++++++- demo/more/conference.urp | 1 + demo/more/conference.urs | 1 + demo/more/conference1.ur | 2 +- demo/more/conferenceFields.ur | 19 +++++++++++++++++++ demo/more/conferenceFields.urs | 3 +++ demo/more/meta.ur | 12 ++++++++++++ demo/more/meta.urs | 3 +++ 8 files changed, 65 insertions(+), 2 deletions(-) (limited to 'demo/more') 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 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 =>
  • {[r.User.Nam]}
    • ); + myReview <- oneOrNoRows1 (SELECT review.{{map fst M.review}} + FROM review + WHERE review.User = {[me.Id]} + AND review.Paper = {[id]}); case ro of None => error Paper not found! | Some r => return @@ -274,6 +280,24 @@ functor Make(M : sig
    No paper uploaded yet.
     else Download paper ({[r.N]} bytes)} + +
    + + {case myReview of + None => +

    Add Your Review

    + +
    + {allWidgets M.review M.reviewFolder} +
    +     + | Some myReview => +

    Edit Your Review

    + +
    + {allPopulated M.review myReview M.reviewFolder} +
    +     }     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 Impossible: Empty option value + else + String.sub s 0 + +con dropdown = (char, string) +fun dropdown name opts = {Nam = name, + Show = txt, + Widget = fn [nm :: Name] => + {List.mapX (fn x => ) opts} + , + WidgetPopulated = fn [nm :: Name] v => + {List.mapX (fn x => ) opts} + , + 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) = [_] 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)) => + + {[m.Nam]}: {m.WidgetPopulated [nm] v}
    + {useMore acc} +     ) + + [_] 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) -- cgit v1.2.3