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 /src/monoize.sml | |
parent | 820db2a3a1c185ea91d8a8f14a30a52489595e3f (diff) |
Use checkbox in CRUD example
Diffstat (limited to 'src/monoize.sml')
-rw-r--r-- | src/monoize.sml | 70 |
1 files changed, 49 insertions, 21 deletions
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!" |