# HG changeset patch # User Adam Chlipala # Date 1406907824 14400 # Node ID 6be31671911b3b7db21a773c51769baa409dda71 # Parent ced78ef1c82f24fc316211783b3a661595205664 'aria-*' attributes diff -r ced78ef1c82f -r 6be31671911b doc/manual.tex --- a/doc/manual.tex Thu Jul 31 09:56:41 2014 -0400 +++ b/doc/manual.tex Fri Aug 01 11:43:44 2014 -0400 @@ -2065,7 +2065,7 @@ We will not list here the different HTML tags and related functions from the standard library. They should be easy enough to understand from the code in \texttt{basis.urs}. The set of tags in the library is not yet claimed to be complete for HTML standards. Also note that there is currently no way for the programmer to add his own tags, without using the foreign function interface (Section \ref{ffi}). -Some tags support HTML5 \texttt{data-*} attributes, which in Ur/Web are encoded as a single attribute $\mt{Data}$ with type $\mt{data\_attrs}$ encoding one or more attributes of this kind. See \texttt{basis.urs} for details. The usual HTML5 syntax for these attributes is supported by the Ur/Web parser as syntactic sugar. +Some tags support HTML5 \texttt{data-*} attributes, which in Ur/Web are encoded as a single attribute $\mt{Data}$ with type $\mt{data\_attrs}$ encoding one or more attributes of this kind. See \texttt{basis.urs} for details. The usual HTML5 syntax for these attributes is supported by the Ur/Web parser as syntactic sugar, and the same mechanism is reused to support \texttt{aria-*} attributes. One last useful function is for aborting any page generation, returning some XML as an error message. This function takes the place of some uses of a general exception mechanism. $$\begin{array}{l} diff -r ced78ef1c82f -r 6be31671911b lib/ur/basis.urs --- a/lib/ur/basis.urs Thu Jul 31 09:56:41 2014 -0400 +++ b/lib/ur/basis.urs Fri Aug 01 11:43:44 2014 -0400 @@ -797,9 +797,13 @@ val script : unit -> tag [Code = transaction unit] head [] [] [] -(* Type for HTML5 "data-*" attributes. *) +(* Type for HTML5 "data-*" and "aria-*" attributes. *) +type data_attr_kind +val data_kind : data_attr_kind +val aria_kind : data_attr_kind + type data_attr -val data_attr : string (* Key *) -> string (* Value *) -> data_attr +val data_attr : data_attr_kind -> string (* Key *) -> string (* Value *) -> data_attr (* This function will fail if the key doesn't meet HTML's lexical rules! *) val data_attrs : data_attr -> data_attr -> data_attr diff -r ced78ef1c82f -r 6be31671911b src/monoize.sml --- a/src/monoize.sml Thu Jul 31 09:56:41 2014 -0400 +++ b/src/monoize.sml Fri Aug 01 11:43:44 2014 -0400 @@ -235,6 +235,7 @@ | 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 @@ 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 -r ced78ef1c82f -r 6be31671911b src/urweb.grm --- a/src/urweb.grm Thu Jul 31 09:56:41 2014 -0400 +++ b/src/urweb.grm Fri Aug 01 11:43:44 2014 -0400 @@ -225,7 +225,7 @@ 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 @@ | 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 @@ [] => #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 @@ | "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 diff -r ced78ef1c82f -r 6be31671911b tests/data_attr.ur --- a/tests/data_attr.ur Thu Jul 31 09:56:41 2014 -0400 +++ b/tests/data_attr.ur Fri Aug 01 11:43:44 2014 -0400 @@ -1,5 +1,5 @@ fun dynd r = return -
How about that?
+
How about that?
 fun main () : transaction page = @@ -7,7 +7,7 @@ a <- source ""; v <- source ""; return -
Whoa there, cowboy!
+
Whoa there, cowboy!
@@ -20,7 +20,7 @@ =