Add support for Microdata

CHANGES.md

@@ -2,6 +2,8 @@
 
 * Add support for the clip-path presentation attribute
 	(#333 by Martin @MBodin Bodin)
+* Add support for Microdata attributes
+  (#343 by toastal)
 
 # 4.6.0
 

lib/html_f.ml

@@ -70,6 +70,8 @@ struct
 
   let uri_attrib a s = Xml.uri_attrib a s
 
+  let uris_attrib a ss = Xml.uris_attrib a ss
+
   let space_sep_attrib = Xml.space_sep_attrib
 
   let comma_sep_attrib = Xml.comma_sep_attrib
@@ -500,6 +502,18 @@ struct
 
   let a_aria name = space_sep_attrib ("aria-" ^ name)
 
+  (* Microdata *)
+
+  let a_itemid = uri_attrib "itemid"
+
+  let a_itemprop = string_attrib "itemprop"
+
+  let a_itemref = space_sep_attrib "itemref"
+
+  let a_itemscope = constant_attrib "itemscope"
+
+  let a_itemtype = uris_attrib "itemtype"
+
   type 'a elt = Xml.elt
 
   type ('a, 'b) nullary = ?a: (('a attrib) list) -> unit -> 'b elt
@@ -858,6 +872,8 @@ struct
 
     let uri_attrib a s = Xml.uri_attrib a s
 
+    let uris_attrib a ss = Xml.uris_attrib a ss
+
     let space_sep_attrib = Xml.space_sep_attrib
 
     let comma_sep_attrib = Xml.comma_sep_attrib

lib/html_sigs.mli

@@ -694,6 +694,24 @@ module type T = sig
       @see <https://www.w3.org/TR/wai-aria-1.1/#state_prop_def> List of WAI-ARIA attributes
   *)
 
+  (** {3 Microdata support} *)
+
+  (** {{: https://html.spec.whatwg.org/multipage/microdata.html} Microdata} is
+      a specification written by the W3C, defining a set of additional HTML
+      attributes that can be applied to elements to annotate content with
+      specific machine-readable labels using schemas.
+  *)
+
+  val a_itemid : Xml.uri wrap -> [> | `ItemID ] attrib
+
+  val a_itemprop : string wrap -> [> | `ItemProp ] attrib
+
+  val a_itemref : idrefs wrap -> [> | `ItemRef ] attrib
+
+  val a_itemscope : unit -> [> | `ItemScope ] attrib
+
+  val a_itemtype : Xml.uri list wrap -> [> | `ItemType ] attrib
+
   (** {2:elements Elements} *)
 
   val txt : string wrap -> [> | txt] elt
@@ -1169,10 +1187,13 @@ module type T = sig
     (** Same, for URI attribute *)
     val uri_attrib : string -> uri wrap -> 'a attrib
 
-    (** Same, for a space separated list of values *)
+    (** Same, for a space-separated list of URI attributes *)
+    val uris_attrib : string -> uri list wrap -> 'a attrib
+
+    (** Same, for a space-separated list of values *)
     val space_sep_attrib : string -> string list wrap -> 'a attrib
 
-    (** Same, for a comma separated list of values *)
+    (** Same, for a comma-separated list of values *)
     val comma_sep_attrib : string -> string list wrap -> 'a attrib
 
   end

lib/html_types.mli

@@ -54,7 +54,7 @@ type nmtoken = string
         @see <http://www.w3.org/TR/2000/REC-xml-20001006> XML 1.0 *)
 
 type nmtokens = nmtoken list
-(** One or more white space separated NMTOKEN values *)
+(** One or more whitespace-separated NMTOKEN values *)
 
 (** {2 Data Types} *)
 
@@ -380,8 +380,19 @@ type aria =
     | `Aria
   ]
 
+(** {2 Microdata} *)
+
+type microdata =
+  [
+    | `ItemID
+    | `ItemProp
+    | `ItemRef
+    | `ItemScope
+    | `ItemType
+  ]
+
 (** Common attributes *)
-type common = [ | core | i18n | events | aria ]
+type common = [ | core | i18n | events | aria | microdata ]
 
 (** {1 Categories of HTML elements}
 

lib/svg_sigs.mli

@@ -1038,10 +1038,10 @@ module type T = sig
     (** Same, for URI attribute *)
     val uri_attrib : string -> uri wrap -> 'a attrib
 
-    (** Same, for a space separated list of values *)
+    (** Same, for a space-separated list of values *)
     val space_sep_attrib : string -> string list wrap -> 'a attrib
 
-    (** Same, for a comma separated list of values *)
+    (** Same, for a comma-separated list of values *)
     val comma_sep_attrib : string -> string list wrap -> 'a attrib
 
   end

syntax/reflect/reflect.ml

@@ -174,6 +174,7 @@ let rec to_attribute_parser lang name ~loc = function
   | [[%type: shape]] ->
     [%expr variant]
 
+  | [[%type: Xml.uri list]]
   | [[%type: nmtokens]]
   | [[%type: idrefs]]
   | [[%type: charsets]]

test/test_ppx.ml

@@ -303,6 +303,16 @@ let attribs = "ppx attribs", HtmlTests.make Html.[
   [[%html "<div aria-hidden=true></div>"]],
   [div ~a:[a_aria "hidden" ["true"]] []] ;
 
+  "microdata attributes",
+  [[%html "<dl itemscope itemtype='https://md.example.com/track https://md.example.com/lighting'><dt>Name</dt><dd itemprop='name'>Turnout Lantern Kit</dd></dl>"]],
+  [dl
+     ~a:[a_itemscope (); a_itemtype ["https://md.example.com/track"; "https://md.example.com/lighting"]]
+     [
+       dt [ txt "Name" ];
+       dd ~a:[a_itemprop "name"] [ txt "Turnout Lantern Kit" ];
+     ]] ;
+
+
   "touch events",
   [[%html "<div ontouchstart='alert()'></div>"]],
   [div ~a:[a_ontouchstart "alert()"] []] ;