From f7e81b4b27489ea0cf814aa48426b3972f73532d Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sat, 4 Oct 2008 16:15:13 -0400
Subject: Use checkbox in CRUD example

---
 lib/basis.urs   |  2 +-
 src/monoize.sml | 70 ++++++++++++++++++++++++++++++++++++++++-----------------
 tests/crud1.ur  |  8 +++----
 3 files changed, 54 insertions(+), 26 deletions(-)

diff --git a/lib/basis.urs b/lib/basis.urs
index 3dec0461..c1030874 100644
--- a/lib/basis.urs
+++ b/lib/basis.urs
@@ -300,7 +300,7 @@ val textbox : lformTag string [] [Value = string]
 val password : lformTag string [] []
 val ltextarea : lformTag string [] []
 
-val checkbox : lformTag bool [] []
+val checkbox : lformTag bool [] [Checked = bool]
 
 con radio = [Body, Radio]
 val radio : lformTag string radio []
diff --git a/src/monoize.sml b/src/monoize.sml
index 5642693b..9fc0458d 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1247,27 +1247,55 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                             val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc)
                         in
                             foldl (fn ((x, e, t), (s, fm)) =>
-                                      let
-                                          val xp = " " ^ lowercaseFirst x ^ "=\""
-
-                                          val fooify =
-                                              case x of
-                                                  "Href" => urlifyExp
-                                                | "Link" => urlifyExp
-                                                | "Action" => urlifyExp
-                                                | _ => attrifyExp
-
-                                          val (e, fm) = fooify env fm (e, t)
-                                      in
-                                          ((L'.EStrcat (s,
-                                                        (L'.EStrcat ((L'.EPrim (Prim.String xp), loc),
-                                                                     (L'.EStrcat (e,
-                                                                                  (L'.EPrim (Prim.String "\""),
-                                                                                   loc)),
-                                                                      loc)),
-                                                         loc)), loc),
-                                           fm)
-                                      end)
+                                      case t of
+                                          (L'.TFfi ("Basis", "bool"), _) =>
+                                          let
+                                              val s' = " " ^ lowercaseFirst x
+                                          in
+                                              ((L'.ECase (e,
+                                                          [((L'.PCon (L'.Enum,
+                                                                      L'.PConFfi {mod = "Basis",
+                                                                                  datatyp = "bool",
+                                                                                  con = "True",
+                                                                                  arg = NONE},
+                                                                      NONE), loc),
+                                                            (L'.EStrcat (s,
+                                                                         (L'.EPrim (Prim.String s'), loc)), loc)),
+                                                           ((L'.PCon (L'.Enum,
+                                                                      L'.PConFfi {mod = "Basis",
+                                                                                  datatyp = "bool",
+                                                                                  con = "False",
+                                                                                  arg = NONE},
+                                                                      NONE), loc),
+                                                            s)],
+                                                          {disc = (L'.TFfi ("Basis", "bool"), loc),
+                                                           result = (L'.TFfi ("Basis", "string"), loc)}), loc),
+                                               fm)
+                                          end
+                                        | _ =>
+                                          let
+                                              val fooify =
+                                                  case x of
+                                                      "Href" => urlifyExp
+                                                    | "Link" => urlifyExp
+                                                    | "Action" => urlifyExp
+                                                    | _ => attrifyExp
+
+                                              val xp = " " ^ lowercaseFirst x ^ "=\""
+
+
+
+                                              val (e, fm) = fooify env fm (e, t)
+                                          in
+                                              ((L'.EStrcat (s,
+                                                            (L'.EStrcat ((L'.EPrim (Prim.String xp), loc),
+                                                                         (L'.EStrcat (e,
+                                                                                      (L'.EPrim (Prim.String "\""),
+                                                                                       loc)),
+                                                                          loc)),
+                                                             loc)), loc),
+                                               fm)
+                                          end)
                                   (s, fm) xes
                         end
                       | _ => raise Fail "Non-record attributes!"
diff --git a/tests/crud1.ur b/tests/crud1.ur
index fb2e4854..a857d3d8 100644
--- a/tests/crud1.ur
+++ b/tests/crud1.ur
@@ -5,7 +5,7 @@ open Crud.Make(struct
                 A = (int, string),
                 B = (string, string),
                 C = (float, string),
-                D = (bool, string)
+                D = (bool, bool)
         ]
 
         val tab = t1
@@ -40,9 +40,9 @@ open Crud.Make(struct
                 D = {
                         Nam = "D",
                         Show = txt _,
-                        Widget = fn nm :: Name => <lform><textbox{nm}/></lform>,
-                        WidgetPopulated = fn (nm :: Name) b => <lform><textbox{nm} value={show _ b}/></lform>,
-                        Parse = readError _,
+                        Widget = fn nm :: Name => <lform><checkbox{nm}/></lform>,
+                        WidgetPopulated = fn (nm :: Name) b => <lform><checkbox{nm} checked={b}/></lform>,
+                        Parse = fn x => x,
                         Inject = sql_bool
                     }
         }
-- 
cgit v1.2.3