summaryrefslogtreecommitdiff
path: root/demo/more
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-10-22 11:51:31 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-10-22 11:51:31 -0400
commit34d3f5b515acbe3e83c0f2201253a08c4dea38b6 (patch)
treec5717cddb5c35dac338b88916ed982d2263d9cbc /demo/more
parentd2ddd6abe74aa089e261c051b3ddf6c182dce011 (diff)
Move stuff from bulkEdit to meta
Diffstat (limited to 'demo/more')
-rw-r--r--demo/more/bulkEdit.ur18
-rw-r--r--demo/more/conference.ur28
-rw-r--r--demo/more/conference.urs2
-rw-r--r--demo/more/meta.ur17
-rw-r--r--demo/more/meta.urs6
5 files changed, 45 insertions, 26 deletions
diff --git a/demo/more/bulkEdit.ur b/demo/more/bulkEdit.ur
index 004c77aa..0226c3dd 100644
--- a/demo/more/bulkEdit.ur
+++ b/demo/more/bulkEdit.ur
@@ -23,25 +23,11 @@ functor Make(M : sig
open M
- fun ensql [avail] (r : $(map snd visible)) : $(map (sql_exp avail [] []) (map fst visible)) =
- map2 [meta] [snd] [fn ts :: (Type * Type) => sql_exp avail [] [] ts.1]
- (fn [ts] meta v => @sql_inject meta.Inject (meta.Parse v))
- [_] folder visible r
-
fun main () =
items <- queryX (SELECT t.{keyName}, t.{{map fst visible}} FROM t)
(fn r => <xml><entry><tr>
<hidden{keyName} value={show r.T.keyName}/>
- {useMore (foldR2 [meta] [fst] [fn cols :: {(Type * Type)} =>
- xml [Body, Form, Tr] [] (map snd cols)]
- (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest]
- (m : meta p) v (acc : xml [Body, Form, Tr] [] (map snd rest)) =>
- <xml>
- <td>{m.WidgetPopulated [nm] v}</td>
- {useMore acc}
- </xml>)
- <xml/>
- [_] folder visible (r.T -- keyName))}
+ {useMore (allPopulatedTr visible (r.T -- keyName) folder)}
</tr></entry></xml>);
return <xml><body>
@@ -58,7 +44,7 @@ functor Make(M : sig
and save r =
List.app (fn user => dml (update [map fst visible] !
- (ensql (user -- keyName))
+ (ensql visible (user -- keyName) folder)
t
(WHERE t.{keyName} = {[readError user.keyName]}))) r.Users;
main ()
diff --git a/demo/more/conference.ur b/demo/more/conference.ur
index 0a540fa0..b9ade8da 100644
--- a/demo/more/conference.ur
+++ b/demo/more/conference.ur
@@ -2,7 +2,7 @@ open Meta
functor Make(M : sig
con paper :: {(Type * Type)}
- constraint [Id] ~ paper
+ constraint [Id, Document] ~ paper
val paper : $(map meta paper)
val paperFolder : folder paper
@@ -18,7 +18,7 @@ functor Make(M : sig
CONSTRAINT Nam UNIQUE Nam
sequence userId
- con paper = [Id = int] ++ map fst M.paper
+ con paper = [Id = int, Document = blob] ++ map fst M.paper
table paper : paper
PRIMARY KEY Id
sequence paperId
@@ -133,12 +133,22 @@ 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>
+ and submit () =
+ let
+ fun doSubmit r = return <xml><body>
+ MIME type: {[fileMimeType r.Document]}<br/>
+ Length: {[blobSize (fileData r.Document)]}
+ </body></xml>
+ in
+ return <xml><body>
+ <h1>Submit a Paper</h1>
+
+ <form>
+ {allWidgets M.paper M.paperFolder}
+ <b>Paper:</b> <upload{#Document}/><br/>
+ <submit value="Submit" action={doSubmit}/>
+ </form>
+ </body></xml>
+ end
end
diff --git a/demo/more/conference.urs b/demo/more/conference.urs
index 1beb54a6..59ea77f8 100644
--- a/demo/more/conference.urs
+++ b/demo/more/conference.urs
@@ -1,6 +1,6 @@
functor Make(M : sig
con paper :: {(Type * Type)}
- constraint [Id] ~ paper
+ constraint [Id, Document] ~ paper
val paper : $(map Meta.meta paper)
val paperFolder : folder paper
diff --git a/demo/more/meta.ur b/demo/more/meta.ur
index 39aeb901..944db822 100644
--- a/demo/more/meta.ur
+++ b/demo/more/meta.ur
@@ -44,3 +44,20 @@ fun allWidgets [ts ::: {(Type * Type)}] (r : $(map meta ts)) (fl : folder ts) =
</xml>)
<xml/>
[_] fl r
+
+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)]
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest]
+ (m : meta p) v (acc : xml [Body, Form, Tr] [] (map snd rest)) =>
+ <xml>
+ <td>{m.WidgetPopulated [nm] v}</td>
+ {useMore acc}
+ </xml>)
+ <xml/>
+ [_] fl r vs
+
+fun ensql [avail] [ts ::: {(Type * Type)}] (r : $(map meta ts)) (vs : $(map snd ts)) (fl : folder ts) =
+ map2 [meta] [snd] [fn ts :: (Type * Type) => sql_exp avail [] [] ts.1]
+ (fn [ts] meta v => @sql_inject meta.Inject (meta.Parse v))
+ [_] fl r vs
diff --git a/demo/more/meta.urs b/demo/more/meta.urs
index 17e8a9f3..e949e5ee 100644
--- a/demo/more/meta.urs
+++ b/demo/more/meta.urs
@@ -15,3 +15,9 @@ val textarea : string -> meta (string, string)
val allWidgets : ts ::: {(Type * Type)} -> $(map meta 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)
+
+val ensql : avail ::: {{Type}} -> ts ::: {(Type * Type)} -> $(map meta ts) -> $(map snd ts) -> folder ts
+ -> $(map (sql_exp avail [] []) (map fst ts))