diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-10-22 11:51:31 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-10-22 11:51:31 -0400 |
| commit | be70af1ef8d1de3b201507c9e9227d41eceeefdd (patch) | |
| tree | c5717cddb5c35dac338b88916ed982d2263d9cbc /demo/more | |
| parent | 7726688ab1c0bd5b73c4bb756fa6357b2212e44e (diff) | |
Move stuff from bulkEdit to meta
Diffstat (limited to 'demo/more')
| -rw-r--r-- | demo/more/bulkEdit.ur | 18 | ||||
| -rw-r--r-- | demo/more/conference.ur | 28 | ||||
| -rw-r--r-- | demo/more/conference.urs | 2 | ||||
| -rw-r--r-- | demo/more/meta.ur | 17 | ||||
| -rw-r--r-- | demo/more/meta.urs | 6 |
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)) |