diff options
author | Adam Chlipala <adam@chlipala.net> | 2012-05-06 14:01:29 -0400 |
---|---|---|
committer | Adam Chlipala <adam@chlipala.net> | 2012-05-06 14:01:29 -0400 |
commit | 9e25c1ce13add31807463c913129c24643944e38 (patch) | |
tree | ccabcef63f0d66632cc4c8c486c6d3663eef3ced /src/monoize.sml | |
parent | 4387731e477e2af050841f916a03f5d8a975a164 (diff) |
'style' attributes
Diffstat (limited to 'src/monoize.sml')
-rw-r--r-- | src/monoize.sml | 67 |
1 files changed, 61 insertions, 6 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 1b7018de..fe2d67bd 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -221,6 +221,9 @@ fun monoType env = | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) | L.CFfi ("Basis", "css_class") => (L'.TFfi ("Basis", "string"), loc) + | L.CFfi ("Basis", "css_value") => (L'.TFfi ("Basis", "string"), loc) + | L.CFfi ("Basis", "css_property") => (L'.TFfi ("Basis", "string"), loc) + | L.CFfi ("Basis", "css_style") => (L'.TFfi ("Basis", "string"), loc) | L.CFfi ("Basis", "id") => (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CFfi ("Basis", "serialized"), _), _) => @@ -2951,6 +2954,43 @@ fun monoExp (env, st, fm) (all as (e, loc)) = fm) end + | L.EFfiApp ("Basis", "css_url", [(s, _)]) => + let + val (s, fm) = monoExp (env, st, fm) s + in + ((L'.EStrcat ((L'.EPrim (Prim.String "url("), loc), + (L'.EStrcat ((L'.EFfiApp ("Basis", "css_url", [(s, (L'.TFfi ("Basis", "string"), loc))]), loc), + (L'.EPrim (Prim.String ")"), loc)), loc)), loc), + fm) + end + + | L.EFfiApp ("Basis", "property", [(s, _)]) => + let + val (s, fm) = monoExp (env, st, fm) s + in + ((L'.EStrcat ((L'.EFfiApp ("Basis", "property", [(s, (L'.TFfi ("Basis", "string"), loc))]), loc), + (L'.EPrim (Prim.String ":"), loc)), loc), + fm) + end + | L.EFfiApp ("Basis", "value", [(s1, _), (s2, _)]) => + let + val (s1, fm) = monoExp (env, st, fm) s1 + val (s2, fm) = monoExp (env, st, fm) s2 + in + ((L'.EStrcat (s1, (L'.EStrcat ((L'.EPrim (Prim.String " "), loc), s2), loc)), loc), + fm) + end + + | L.EFfi ("Basis", "noStyle") => ((L'.EPrim (Prim.String ""), loc), fm) + | L.EFfiApp ("Basis", "oneProperty", [(s1, _), (s2, _)]) => + let + val (s1, fm) = monoExp (env, st, fm) s1 + val (s2, fm) = monoExp (env, st, fm) s2 + in + ((L'.EStrcat (s1, (L'.EStrcat (s2, (L'.EPrim (Prim.String ";"), loc)), loc)), loc), + fm) + end + | L.EApp ( (L.ECApp ( (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), @@ -2992,18 +3032,20 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L.EApp ( (L.EApp ( (L.EApp ( - (L.ECApp ( - (L.ECApp ( + (L.EApp ( + (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.EFfi ("Basis", "tag"), - _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), - class), _), - dynClass), _), + (L.ECApp ( + (L.EFfi ("Basis", "tag"), + _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), + class), _), + dynClass), _), + style), _), attrs), _), tag), _), xml) => @@ -3061,6 +3103,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val (class, fm) = monoExp (env, st, fm) class val (dynClass, fm) = monoExp (env, st, fm) dynClass + val (style, fm) = monoExp (env, st, fm) style val dynamics = ["dyn", "ctextbox", "ccheckbox", "cselect", "coption", "ctextarea"] @@ -3088,6 +3131,18 @@ fun monoExp (env, st, fm) (all as (e, loc)) = {disc = t, result = t}), loc) + val s = (L'.ECase (style, + [((L'.PPrim (Prim.String ""), loc), + s), + ((L'.PVar ("x", t), loc), + (L'.EStrcat (s, + (L'.EStrcat ((L'.EPrim (Prim.String " style=\""), loc), + (L'.EStrcat ((L'.ERel 0, loc), + (L'.EPrim (Prim.String "\""), loc)), + loc)), loc)), loc))], + {disc = t, + result = t}), loc) + val (s, fm) = foldl (fn (("Action", _, _), acc) => acc | (("Source", _, _), acc) => acc | ((x, e, t), (s, fm)) => |