diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2014-08-01 11:43:44 -0400 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2014-08-01 11:43:44 -0400 |
| commit | 8ef3bce7ec88bb0c73a5885bca9f27526a1eae8b (patch) | |
| tree | d48bf4300318cd966cab3547488c477feaf40119 /src | |
| parent | 3154131cddb8bc8fe76b86bd9f4902f1d531bce6 (diff) | |
'aria-*' attributes
Diffstat (limited to 'src')
| -rw-r--r-- | src/monoize.sml | 9 | ||||
| -rw-r--r-- | src/urweb.grm | 11 |
2 files changed, 14 insertions, 6 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index a639f4a6..9182c077 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -235,6 +235,7 @@ fun monoType env = | L.CFfi ("Basis", "requestHeader") => (L'.TFfi ("Basis", "string"), loc) | L.CFfi ("Basis", "responseHeader") => (L'.TFfi ("Basis", "string"), loc) | L.CFfi ("Basis", "envVar") => (L'.TFfi ("Basis", "string"), loc) + | L.CFfi ("Basis", "data_attr_kind") => (L'.TFfi ("Basis", "string"), loc) | L.CFfi ("Basis", "data_attr") => (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CFfi ("Basis", "serialized"), _), _) => @@ -3122,12 +3123,16 @@ fun monoExp (env, st, fm) (all as (e, loc)) = fm) end - | L.EFfiApp ("Basis", "data_attr", [(s1, _), (s2, _)]) => + | L.EFfi ("Basis", "data_kind") => ((L'.EPrim (Prim.String "data-"), loc), fm) + | L.EFfi ("Basis", "aria_kind") => ((L'.EPrim (Prim.String "aria-"), loc), fm) + + | L.EFfiApp ("Basis", "data_attr", [(sk, _), (s1, _), (s2, _)]) => let + val (sk, fm) = monoExp (env, st, fm) sk val (s1, fm) = monoExp (env, st, fm) s1 val (s2, fm) = monoExp (env, st, fm) s2 in - ((L'.EStrcat ((L'.EPrim (Prim.String "data-"), loc), + ((L'.EStrcat (sk, (L'.EStrcat ((L'.EFfiApp ("Basis", "blessData", [(s1, (L'.TFfi ("Basis", "string"), loc))]), loc), (L'.EStrcat ((L'.EPrim (Prim.String "=\""), loc), (L'.EStrcat ((L'.EFfiApp ("Basis", "attrifyString", [(s2, (L'.TFfi ("Basis", "string"), loc))]), loc), diff --git a/src/urweb.grm b/src/urweb.grm index 1f4540ba..862debc5 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -225,7 +225,7 @@ fun tagIn bt = datatype prop_kind = Delete | Update -datatype attr = Class of exp | DynClass of exp | Style of exp | DynStyle of exp | Normal of con * exp | Data of string * exp +datatype attr = Class of exp | DynClass of exp | Style of exp | DynStyle of exp | Normal of con * exp | Data of string * string * exp fun patType loc (p : pat) = case #1 p of @@ -486,7 +486,7 @@ fun patternOut (e : exp) = | rpat of (string * pat) list * bool | ptuple of pat list - | attrs of exp option * exp option * exp option * exp option * (string * exp) list * (con * exp) list + | attrs of exp option * exp option * exp option * exp option * (string * string * exp) list * (con * exp) list | attr of attr | attrv of exp @@ -1652,9 +1652,10 @@ tag : tagHead attrs (let [] => #6 attrs | data :: datas => let - fun doOne (name, value) = + fun doOne (kind, name, value) = let val e = (EVar (["Basis"], "data_attr", Infer), pos) + val e = (EApp (e, (EVar (["Basis"], kind ^ "_kind", Infer), pos)), pos) val e = (EApp (e, (EPrim (Prim.String name), pos)), pos) in (EApp (e, value), pos) @@ -1725,7 +1726,9 @@ attr : SYMBOL EQ attrv (case SYMBOL of | "dynStyle" => DynStyle attrv | _ => if String.isPrefix "data-" SYMBOL then - Data (String.extract (SYMBOL, 5, NONE), attrv) + Data ("data", String.extract (SYMBOL, 5, NONE), attrv) + else if String.isPrefix "aria-" SYMBOL then + Data ("aria", String.extract (SYMBOL, 5, NONE), attrv) else let val sym = makeAttr SYMBOL |