changeset 1008:1911e84df461

Move stuff from bulkEdit to meta
author Adam Chlipala <adamc@hcoop.net>
date Thu, 22 Oct 2009 11:51:31 -0400 (2009-10-22)
parents d3af9e54c828
children 59097824f19b
files demo/more/bulkEdit.ur demo/more/conference.ur demo/more/conference.urs demo/more/meta.ur demo/more/meta.urs
diffstat 5 files changed, 45 insertions(+), 26 deletions(-) [+]
line wrap: on
line diff
--- a/demo/more/bulkEdit.ur	Thu Oct 22 11:37:58 2009 -0400
+++ b/demo/more/bulkEdit.ur	Thu Oct 22 11:51:31 2009 -0400
@@ -23,25 +23,11 @@
 
     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 @@
 
     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 ()
--- a/demo/more/conference.ur	Thu Oct 22 11:37:58 2009 -0400
+++ b/demo/more/conference.ur	Thu Oct 22 11:51:31 2009 -0400
@@ -2,7 +2,7 @@
 
 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 @@
           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 @@
         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
--- a/demo/more/conference.urs	Thu Oct 22 11:37:58 2009 -0400
+++ b/demo/more/conference.urs	Thu Oct 22 11:51:31 2009 -0400
@@ -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
 
--- a/demo/more/meta.ur	Thu Oct 22 11:37:58 2009 -0400
+++ b/demo/more/meta.ur	Thu Oct 22 11:51:31 2009 -0400
@@ -44,3 +44,20 @@
                            </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
--- a/demo/more/meta.urs	Thu Oct 22 11:37:58 2009 -0400
+++ b/demo/more/meta.urs	Thu Oct 22 11:51:31 2009 -0400
@@ -15,3 +15,9 @@
 
 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))