Add a unit ppx attribute value parser.

Author: Drup

ppx/ppx_attribute_value.ml

@@ -181,6 +181,14 @@ let bool ?separated_by:_ ?default:_ loc name s =
 
   Some (Exp.construct ~loc (Location.mkloc (Longident.parse s) loc) None)
 
+let unit ?separated_by:_ ?default:_ loc name s =
+  if s = "" || s = name then
+    Some (Ast_convenience.(with_default_loc loc unit))
+  else
+    Ppx_common.error loc
+      {|Value of %s must be %s or "".|}
+      name name
+
 let int ?separated_by ?default loc name s =
   match int_exp loc s with
   | Some _ as e -> e

ppx/ppx_attribute_value.mli

@@ -97,6 +97,9 @@ val bool : parser
 (** [bool _ _ s] produces a parse tree for the boolean [true] if [s = "true"]
     and [false] if [s = "false"]. *)
 
+val unit : parser
+(** [unit _ name s] produces a parse tree for [()]. It fails if [name <> s]. *)
+
 val int : parser
 (** [int _ _ s] produces a parse tree for [int_of_string s]. *)
 

ppx/ppx_reflect.ml

@@ -97,6 +97,7 @@ let rec to_attribute_parser name = function
 
   | [[%type: character]] -> [%expr char]
   | [[%type: bool]] -> [%expr bool]
+  | [[%type: unit]] -> [%expr nowrap unit]
 
   | [[%type: number]]
   | [[%type: pixels]]

test/test_ppx.ml

@@ -64,6 +64,18 @@ let basics = "ppx basics", tyxml_tests Html.[
 
 ]
 
+let attribs = "ppx attribs", tyxml_tests Html.[
+
+  "unit absent",
+  [[%html "<div hidden></div>"]],
+  [div ~a:[a_hidden ()] []] ;
+
+  "unit present",
+  [[%html "<div hidden=hidden></div>"]],
+  [div ~a:[a_hidden ()] []] ;
+
+]
+
 let ns_nesting = "namespace nesting" , tyxml_tests Html.[
 
   "html/svg",
@@ -122,6 +134,7 @@ let antiquot = "ppx antiquot", tyxml_tests Html.[
 
 let tests = [
   basics ;
+  attribs ;
   ns_nesting ;
   antiquot ;
 ]