Mercurial > urweb

comparison src/monoize.sml @ 737:d049d31a1966

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
736:796e42c93c48 737:d049d31a1966
1660 (L'.EFfiApp ("Basis", "sqlifyString", [(L'.ERel 0, loc)]), loc)), loc), 1660 (L'.EFfiApp ("Basis", "sqlifyString", [(L'.ERel 0, loc)]), loc)), loc),
1661 fm) 1661 fm)
1662 | L.EFfi ("Basis", "sql_time") => 1662 | L.EFfi ("Basis", "sql_time") =>
1663 ((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "string"), loc), 1663 ((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "string"), loc),
1664 (L'.EFfiApp ("Basis", "sqlifyTime", [(L'.ERel 0, loc)]), loc)), loc), 1664 (L'.EFfiApp ("Basis", "sqlifyTime", [(L'.ERel 0, loc)]), loc)), loc),
1665 fm)
1666 | L.EFfi ("Basis", "sql_blob") =>
1667 ((L'.EAbs ("x", (L'.TFfi ("Basis", "blob"), loc), (L'.TFfi ("Basis", "string"), loc),
1668 (L'.EFfiApp ("Basis", "sqlifyBlob", [(L'.ERel 0, loc)]), loc)), loc),
1665 fm) 1669 fm)
1666 | L.ECApp ((L.EFfi ("Basis", "sql_channel"), _), _) => 1670 | L.ECApp ((L.EFfi ("Basis", "sql_channel"), _), _) =>
1667 ((L'.EAbs ("x", (L'.TFfi ("Basis", "channel"), loc), (L'.TFfi ("Basis", "string"), loc), 1671 ((L'.EAbs ("x", (L'.TFfi ("Basis", "channel"), loc), (L'.TFfi ("Basis", "string"), loc),
1668 (L'.EFfiApp ("Basis", "sqlifyChannel", [(L'.ERel 0, loc)]), loc)), loc), 1672 (L'.EFfiApp ("Basis", "sqlifyChannel", [(L'.ERel 0, loc)]), loc)), loc),
1669 fm) 1673 fm)
2337 end 2341 end
2338 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); 2342 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
2339 raise Fail "No name passed to ltextarea tag")) 2343 raise Fail "No name passed to ltextarea tag"))
2340 2344
2341 | "checkbox" => input "checkbox" 2345 | "checkbox" => input "checkbox"
2346 | "upload" => input "file"
2342 2347
2343 | "radio" => 2348 | "radio" =>
2344 (case targs of 2349 (case targs of
2345 [_, (L.CName name, _)] => 2350 [_, (L.CName name, _)] =>
2346 monoExp (env, St.setRadioGroup (st, name), fm) xml 2351 monoExp (env, St.setRadioGroup (st, name), fm) xml
2473 (L'.EStrcat (action, 2478 (L'.EStrcat (action,
2474 (L'.EPrim (Prim.String "\""), loc)), loc)), loc), 2479 (L'.EPrim (Prim.String "\""), loc)), loc)), loc),
2475 fm) 2480 fm)
2476 end 2481 end
2477 2482
2483 val hasUpload = CoreUtil.Exp.exists {kind = fn _ => false,
2484 con = fn _ => false,
2485 exp = fn e =>
2486 case e of
2487 L.EFfi ("Basis", "upload") => true
2488 | _ => false} xml
2489
2478 val (xml, fm) = monoExp (env, st, fm) xml 2490 val (xml, fm) = monoExp (env, st, fm) xml
2479 2491
2480 val xml = 2492 val xml =
2481 if IS.member (!readCookie, func) then 2493 if IS.member (!readCookie, func) then
2482 let 2494 let
2512 in 2524 in
2513 (L'.EStrcat (sigSet, xml), loc) 2525 (L'.EStrcat (sigSet, xml), loc)
2514 end 2526 end
2515 else 2527 else
2516 xml 2528 xml
2529
2530 val action = if hasUpload then
2531 (L'.EStrcat (action,
2532 (L'.EPrim (Prim.String " enctype=\"multipart/form-data\""), loc)), loc)
2533 else
2534 action
2535
2517 in 2536 in
2518 ((L'.EStrcat ((L'.EStrcat ((L'.EPrim (Prim.String "<form method=\"post\""), loc), 2537 ((L'.EStrcat ((L'.EStrcat ((L'.EPrim (Prim.String "<form method=\"post\""), loc),
2519 (L'.EStrcat (action, 2538 (L'.EStrcat (action,
2520 (L'.EPrim (Prim.String ">"), loc)), loc)), loc), 2539 (L'.EPrim (Prim.String ">"), loc)), loc)), loc),
2521 (L'.EStrcat (xml, 2540 (L'.EStrcat (xml,