Getting around the reflect construct.

Author: Mbodin

lib/svg_sigs.mli

@@ -78,7 +78,7 @@ module type T = sig
   *)
   type 'a wrap = 'a Xml.W.t
 
-  (** [list_wrap] is a containre for list of elements.
+  (** [list_wrap] is a container for list of elements.
 
       In most cases, ['a list_wrap = 'a list]. For [R] modules (in eliom or js_of_ocaml),
       It will be {!ReactiveData.RList.t}.
@@ -488,7 +488,7 @@ module type T = sig
   val a_animation_fill : [< | `Freeze | `Remove ] wrap -> [> | `Fill_Animation ] attrib
     [@@reflect.attribute "fill" ["animate"]]
 
-  val a_fill_opacity : number wrap -> [> | `Fill_opacity ] attrib
+  val a_fill_opacity : opacity wrap -> [> | `Fill_opacity ] attrib
 
   val a_fill_rule : fill_rule wrap -> [> | `Fill_rule ] attrib
 
@@ -635,11 +635,11 @@ module type T = sig
        | `Text_after_edge | `Text_before_edge | `Inherit ] wrap ->
     [> | `Dominant_Baseline ] attrib
 
-  val a_opacity : number wrap -> [> | `Opacity ] attrib
+  val a_opacity : opacity wrap -> [> | `Opacity ] attrib
 
   val a_stop_color : color wrap -> [> | `Stop_Color ] attrib
 
-  val a_stop_opacity : number wrap -> [> | `Stop_Opacity ] attrib
+  val a_stop_opacity : opacity wrap -> [> | `Stop_Opacity ] attrib
 
   val a_stroke : paint wrap -> [> | `Stroke ] attrib
 
@@ -658,7 +658,7 @@ module type T = sig
 
   val a_stroke_dashoffset : Unit.length wrap -> [> `Stroke_Dashoffset ] attrib
 
-  val a_stroke_opacity : float wrap -> [> `Stroke_Opacity ] attrib
+  val a_stroke_opacity : opacity wrap -> [> `Stroke_Opacity ] attrib
 
   (** {2 Events}
 
@@ -1117,7 +1117,7 @@ module type Wrapped_functions = sig
 
   val string_of_paint : ([< Svg_types.paint], string) Xml.W.ft
 
-  val string_of_opacity : (float, string) Xml.W.ft
+  val string_of_opacity : (opacity, string) Xml.W.ft
 
   val string_of_fill_rule : ([< Svg_types.fill_rule], string) Xml.W.ft
 

lib/svg_types.mli

@@ -279,6 +279,8 @@ type strings = string list
 type color = string
 type icccolor = string
 
+type opacity = float
+
 type paint_whitout_icc =
   [ `None | `CurrentColor
   | `Color of (color * icccolor option)

syntax/attribute_value.ml

@@ -484,7 +484,7 @@ let paint ?separated_by:_ ?default:_ loc name s =
             `Icc ([%e iri], Some [%e paint_without_icc loc name remainder])]
     end [@metaloc loc]
 
-let fill_opacity =
+let opacity =
   let bad_form name loc =
     Common.error loc "Value of %s must be a number or percentage" name in
 

syntax/attribute_value.mli

@@ -198,8 +198,10 @@ val paint : parser
    {:{https://www.w3.org/TR/SVG/painting.html#SpecifyingPaint} Specifying
    paint}. *)
 
-val fill_opacity : parser
-(** Parses an SVG fill-opacity value, converting it into a number between 0. and 1.
+val opacity : parser
+(** Parses an SVG fill-opacity value (either a percentage or a number),
+  converting it into a number between 0. and 1.
+  This parser is also used in other places expecting opacity.
 
     @see <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill-opacity>
 *)

syntax/reflect/reflect.ml

@@ -154,6 +154,8 @@ let rec to_attribute_parser lang name ~loc = function
   | [[%type: iri]]
   | [[%type: color]] -> [%expr string]
 
+  | [[%type: opacity]] -> [%expr opacity]
+
   | [[%type: nmtoken]; [%type: text wrap]] -> [%expr wrap string]
   | [[%type: string]; [%type: string wrap]] -> [%expr wrap string]
   | [[%type: string]; [%type: string list wrap]] -> [%expr wrap (spaces string)]

test/test_jsx.re

@@ -333,12 +333,12 @@ let svg = (
       ),
       (
         "fill_opacity float, circle",
-        [<circle cx=1 cy=2 r=3 fill-opacity=0.5 />],
+        [<circle cx=1 cy=2 r=3 fill_opacity=0.5 />],
         [circle(~a=[a_cx (1., None); a_cy (2., None); a_r (3., None); a_fill_opacity 0.5], [])],
       ),
       (
         "fill_opacity percentage, rect",
-        [<rect x=1 y='2' width=3 height='4' fill-opacity='50%' />],
+        [<rect x=1 y='2' width=3 height='4' fill_opacity='50%' />],
         [rect(~a=[a_cx (1., None); a_cy (2., None); a_width (3., None); a_height (4., None); a_fill_opacity 0.5], [])],
       ),
       (