diff src/monoize.sml @ 737:d049d31a1966

Initial support for blobs and upload
author Adam Chlipala <adamc@hcoop.net>
date Sat, 25 Apr 2009 13:59:11 -0400
parents 796e42c93c48
children f7e2026dd5ae
line wrap: on
line diff
--- a/src/monoize.sml	Thu Apr 23 16:13:02 2009 -0400
+++ b/src/monoize.sml	Sat Apr 25 13:59:11 2009 -0400
@@ -1663,6 +1663,10 @@
             ((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "string"), loc),
                        (L'.EFfiApp ("Basis", "sqlifyTime", [(L'.ERel 0, loc)]), loc)), loc),
              fm)
+          | L.EFfi ("Basis", "sql_blob") =>
+            ((L'.EAbs ("x", (L'.TFfi ("Basis", "blob"), loc), (L'.TFfi ("Basis", "string"), loc),
+                       (L'.EFfiApp ("Basis", "sqlifyBlob", [(L'.ERel 0, loc)]), loc)), loc),
+             fm)
           | L.ECApp ((L.EFfi ("Basis", "sql_channel"), _), _) =>
             ((L'.EAbs ("x", (L'.TFfi ("Basis", "channel"), loc), (L'.TFfi ("Basis", "string"), loc),
                        (L'.EFfiApp ("Basis", "sqlifyChannel", [(L'.ERel 0, loc)]), loc)), loc),
@@ -2339,6 +2343,7 @@
                                raise Fail "No name passed to ltextarea tag"))
 
                   | "checkbox" => input "checkbox"
+                  | "upload" => input "file"
 
                   | "radio" =>
                     (case targs of
@@ -2475,6 +2480,13 @@
                          fm)
                     end
 
+                val hasUpload = CoreUtil.Exp.exists {kind = fn _ => false,
+                                                     con = fn _ => false,
+                                                     exp = fn e =>
+                                                              case e of
+                                                                  L.EFfi ("Basis", "upload") => true
+                                                                | _ => false} xml
+
                 val (xml, fm) = monoExp (env, st, fm) xml
 
                 val xml =
@@ -2514,6 +2526,13 @@
                         end
                     else
                         xml
+
+                val action = if hasUpload then
+                                 (L'.EStrcat (action,
+                                              (L'.EPrim (Prim.String " enctype=\"multipart/form-data\""), loc)), loc)
+                             else
+                                 action
+
             in
                 ((L'.EStrcat ((L'.EStrcat ((L'.EPrim (Prim.String "<form method=\"post\""), loc),
                                            (L'.EStrcat (action,