From 7870dc46565003d2b7493a244477e4d4d5f9c943 Mon Sep 17 00:00:00 2001
From: Martin Bodin <martin.bodin@inria.fr>
Date: Thu, 30 Nov 2023 15:32:43 +0100
Subject: [PATCH] Getting around the reflect construct.

---
 lib/svg_sigs.mli           | 12 ++++++------
 lib/svg_types.mli          |  2 ++
 syntax/attribute_value.ml  |  2 +-
 syntax/attribute_value.mli |  6 ++++--
 syntax/reflect/reflect.ml  |  2 ++
 test/test_jsx.re           |  4 ++--
 6 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/lib/svg_sigs.mli b/lib/svg_sigs.mli
index ebd6dd1a2..c288c0e9d 100644
--- a/lib/svg_sigs.mli
+++ b/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 : (Svg_types.opacity, string) Xml.W.ft
   
   val string_of_fill_rule : ([< Svg_types.fill_rule], string) Xml.W.ft
 
diff --git a/lib/svg_types.mli b/lib/svg_types.mli
index a786da522..92ebc1f77 100644
--- a/lib/svg_types.mli
+++ b/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)
diff --git a/syntax/attribute_value.ml b/syntax/attribute_value.ml
index 84d4c2d6c..5f32acd57 100644
--- a/syntax/attribute_value.ml
+++ b/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
 
diff --git a/syntax/attribute_value.mli b/syntax/attribute_value.mli
index 6214b1385..661822582 100644
--- a/syntax/attribute_value.mli
+++ b/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>
 *)
diff --git a/syntax/reflect/reflect.ml b/syntax/reflect/reflect.ml
index dafd1975b..62a512e8e 100644
--- a/syntax/reflect/reflect.ml
+++ b/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)]
diff --git a/test/test_jsx.re b/test/test_jsx.re
index 37283c243..297292bac 100644
--- a/test/test_jsx.re
+++ b/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], [])],
       ),
       (