summaryrefslogtreecommitdiff
path: root/demo
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-10-22 11:37:58 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-10-22 11:37:58 -0400
commitd2ddd6abe74aa089e261c051b3ddf6c182dce011 (patch)
treed01adf8864ff4c51397dad698c541b0d3c38b0f2 /demo
parentcf42469778104a3079191c6e871954ffb3b5c957 (diff)
Title and abstract
Diffstat (limited to 'demo')
-rw-r--r--demo/more/conference.ur15
-rw-r--r--demo/more/conference.urp1
-rw-r--r--demo/more/conference.urs3
-rw-r--r--demo/more/conference1.ur5
-rw-r--r--demo/more/conferenceFields.ur7
-rw-r--r--demo/more/conferenceFields.urs5
-rw-r--r--demo/more/meta.ur19
-rw-r--r--demo/more/meta.urs5
8 files changed, 55 insertions, 5 deletions
diff --git a/demo/more/conference.ur b/demo/more/conference.ur
index 8d06e4cf..0a540fa0 100644
--- a/demo/more/conference.ur
+++ b/demo/more/conference.ur
@@ -2,8 +2,9 @@ open Meta
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 @@ functor Make(M : sig
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 @@ functor Make(M : sig
<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 @@ functor Make(M : sig
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
diff --git a/demo/more/conference.urp b/demo/more/conference.urp
index 62ae39f9..cd064629 100644
--- a/demo/more/conference.urp
+++ b/demo/more/conference.urp
@@ -4,3 +4,4 @@ $/list
meta
bulkEdit
conference
+conferenceFields
diff --git a/demo/more/conference.urs b/demo/more/conference.urs
index 450725f9..1beb54a6 100644
--- a/demo/more/conference.urs
+++ b/demo/more/conference.urs
@@ -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
diff --git a/demo/more/conference1.ur b/demo/more/conference1.ur
index 5696e2f1..3fc5ff64 100644
--- a/demo/more/conference1.ur
+++ b/demo/more/conference1.ur
@@ -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"
diff --git a/demo/more/conferenceFields.ur b/demo/more/conferenceFields.ur
new file mode 100644
index 00000000..445b89b9
--- /dev/null
+++ b/demo/more/conferenceFields.ur
@@ -0,0 +1,7 @@
+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
new file mode 100644
index 00000000..9867db47
--- /dev/null
+++ b/demo/more/conferenceFields.urs
@@ -0,0 +1,5 @@
+con title :: (Type * Type)
+val title : Meta.meta title
+
+con abstract :: (Type * Type)
+val abstract : Meta.meta abstract
diff --git a/demo/more/meta.ur b/demo/more/meta.ur
index 2a8787f7..39aeb901 100644
--- a/demo/more/meta.ur
+++ b/demo/more/meta.ur
@@ -25,3 +25,22 @@ fun bool name = {Nam = name,
<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
diff --git a/demo/more/meta.urs b/demo/more/meta.urs
index d4d626c5..17e8a9f3 100644
--- a/demo/more/meta.urs
+++ b/demo/more/meta.urs
@@ -10,3 +10,8 @@ val int : string -> meta (int, string)
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)