changeset 1007:d3af9e54c828

Title and abstract
author Adam Chlipala <adamc@hcoop.net>
date Thu, 22 Oct 2009 11:37:58 -0400
parents 5a0f6ec208ce
children 1911e84df461
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, 55 insertions(+), 5 deletions(-) [+]
line wrap: on
line diff
--- a/demo/more/conference.ur	Thu Oct 22 11:15:37 2009 -0400
+++ b/demo/more/conference.ur	Thu Oct 22 11:37:58 2009 -0400
@@ -2,8 +2,9 @@
 
 functor Make(M : sig
                  con paper :: {(Type * Type)}
-                 constraint [Id, Title] ~ paper
+                 constraint [Id] ~ paper
                  val paper : $(map meta paper)
+                 val paperFolder : folder paper
 
                  con review :: {(Type * Type)}
                  constraint [Paper, User] ~ review
@@ -17,7 +18,7 @@
           CONSTRAINT Nam UNIQUE Nam
     sequence userId
 
-    con paper = [Id = int, Title = string] ++ map fst M.paper
+    con paper = [Id = int] ++ map fst M.paper
     table paper : paper
           PRIMARY KEY Id
     sequence paperId
@@ -122,7 +123,7 @@
                     <xml/>}
 
                {if now < M.submissionDeadline then
-                    <xml><li>Submit</li></xml>
+                    <xml><li><a link={submit ()}>Submit</a></li></xml>
                 else
                     <xml/>}
              </xml>}
@@ -132,4 +133,12 @@
         m <- main' ();
         return <xml><body>{m}</body></xml>
 
+    and submit () = return <xml><body>
+      <h1>Submit a Paper</h1>
+
+      <form>
+        {allWidgets M.paper M.paperFolder}
+      </form>
+    </body></xml>
+
 end
--- a/demo/more/conference.urp	Thu Oct 22 11:15:37 2009 -0400
+++ b/demo/more/conference.urp	Thu Oct 22 11:37:58 2009 -0400
@@ -4,3 +4,4 @@
 meta
 bulkEdit
 conference
+conferenceFields
--- a/demo/more/conference.urs	Thu Oct 22 11:15:37 2009 -0400
+++ b/demo/more/conference.urs	Thu Oct 22 11:37:58 2009 -0400
@@ -1,7 +1,8 @@
 functor Make(M : sig
                  con paper :: {(Type * Type)}
-                 constraint [Id, Title] ~ paper
+                 constraint [Id] ~ paper
                  val paper : $(map Meta.meta paper)
+                 val paperFolder : folder paper
 
                  con review :: {(Type * Type)}
                  constraint [Paper, User] ~ review
--- a/demo/more/conference1.ur	Thu Oct 22 11:15:37 2009 -0400
+++ b/demo/more/conference1.ur	Thu Oct 22 11:37:58 2009 -0400
@@ -1,5 +1,8 @@
+open ConferenceFields
+
 open Conference.Make(struct
-                         val paper = {}
+                         val paper = {Title = title,
+                                      Abstract = abstract}
                          val review = {}
 
                          val submissionDeadline = readError "2009-10-22 23:59:59"
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/more/conferenceFields.ur	Thu Oct 22 11:37:58 2009 -0400
@@ -0,0 +1,7 @@
+open Meta
+
+con title = (string, string)
+val title = string "Title"
+
+con abstract = (string, string)
+val abstract = textarea "Abstract"
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/more/conferenceFields.urs	Thu Oct 22 11:37:58 2009 -0400
@@ -0,0 +1,5 @@
+con title :: (Type * Type)
+val title : Meta.meta title
+
+con abstract :: (Type * Type)
+val abstract : Meta.meta abstract
--- a/demo/more/meta.ur	Thu Oct 22 11:15:37 2009 -0400
+++ b/demo/more/meta.ur	Thu Oct 22 11:37:58 2009 -0400
@@ -25,3 +25,22 @@
                                       <xml><checkbox{nm} checked={b}/></xml>,
                  Parse = fn x => x,
                  Inject = _}
+
+fun textarea name = {Nam = name,
+                     Show = cdata,
+                     Widget = fn [nm :: Name] => <xml><br/><textarea{nm} rows={10} cols={80}/></xml>,
+                     WidgetPopulated = fn [nm :: Name] s => <xml><br/>
+                       <textarea{nm} rows={10} cols={80}>{[s]}</textarea>
+                     </xml>,
+                     Parse = fn s => s,
+                     Inject = _}
+
+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)}]
+                           [[nm] ~ rest] (col : meta t) (acc : xml form [] (map snd rest)) => <xml>
+                             <b>{[col.Nam]}</b>: {col.Widget [nm]}<br/>
+                             {useMore acc}
+                           </xml>)
+          <xml/>
+          [_] fl r
--- a/demo/more/meta.urs	Thu Oct 22 11:15:37 2009 -0400
+++ b/demo/more/meta.urs	Thu Oct 22 11:37:58 2009 -0400
@@ -10,3 +10,8 @@
 val float : string -> meta (float, string)
 val string : string -> meta (string, string)
 val bool : string -> meta (bool, bool)
+
+val textarea : string -> meta (string, string)
+
+val allWidgets : ts ::: {(Type * Type)} -> $(map meta ts) -> folder ts
+                 -> xml form [] (map snd ts)