diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-10-04 16:15:13 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-10-04 16:15:13 -0400 |
| commit | f7e81b4b27489ea0cf814aa48426b3972f73532d (patch) | |
| tree | fe36f78ac70407492949f699f7c840f353957999 | |
| parent | 820db2a3a1c185ea91d8a8f14a30a52489595e3f (diff) | |
Use checkbox in CRUD example
| -rw-r--r-- | lib/basis.urs | 2 | ||||
| -rw-r--r-- | src/monoize.sml | 70 | ||||
| -rw-r--r-- | 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 } } |