From 85e6ad34c66d76c83b8b6884c40adc02353ed6fe Mon Sep 17 00:00:00 2001
From: Swrup <swrup@protonmail.com>
Date: Mon, 20 Jun 2022 10:05:35 +0200
Subject: [PATCH] add popup options

---
 src/icon.ml   |  4 ++--
 src/icon.mli  |  2 +-
 src/layer.ml  | 19 ++++++++++++-----
 src/layer.mli |  2 +-
 src/popup.ml  | 56 +++++++++++++++++++++++++++++++++++++++++++++++++++
 src/popup.mli | 27 +++++++++++++++++++++++++
 6 files changed, 101 insertions(+), 9 deletions(-)

diff --git a/src/icon.ml b/src/icon.ml
index 369c288..c40305d 100644
--- a/src/icon.ml
+++ b/src/icon.ml
@@ -45,5 +45,5 @@ let opt_to_jv = function
 
 let create icon_url options =
   let l = List.map (fun o -> (to_string o, opt_to_jv o)) options in
-  let tab = Array.of_list @@ (("iconUrl", Jv.of_string icon_url) :: l) in
-  Jv.call Global.leaflet "icon" [| Jv.obj tab |]
+  let l = Array.of_list @@ (("iconUrl", Jv.of_string icon_url) :: l) in
+  Jv.call Global.leaflet "icon" [| Jv.obj l |]
diff --git a/src/icon.mli b/src/icon.mli
index df3b33e..534c9d9 100644
--- a/src/icon.mli
+++ b/src/icon.mli
@@ -5,7 +5,7 @@ type t
 (** [to_jv o] is [o] as {!Jv.t} *)
 val to_jv : t -> Jv.t
 
-(* type for icon option used to create an icon*)
+(** type for icon option used to create an icon*)
 type opt =
   | Icon_retina_url of string
   | Icon_size of Point.t
diff --git a/src/layer.ml b/src/layer.ml
index b4261aa..fd2042c 100644
--- a/src/layer.ml
+++ b/src/layer.ml
@@ -31,10 +31,16 @@ let remove_from : type kind. Map.t -> kind t -> unit =
     let (_ : Jv.t) = Jv.call l "removeFrom" [| Map.to_jv map |] in
     ()
 
-let bind_popup : type kind. Brr.El.t -> ?options:Jv.t -> kind t -> unit =
- fun el ?(options = Jv.null) -> function
-  | Basic l | Geojson l | Marker l | Tile l ->
-    let (_ : Jv.t) = Jv.call l "bindPopup" [| Brr.El.to_jv el; options |] in
+let bind_popup : type kind. Brr.El.t -> Popup.opt list -> kind t -> unit =
+ fun el options -> function
+  | Basic layer | Geojson layer | Marker layer | Tile layer ->
+    let l =
+      Array.of_list
+      @@ List.map (fun o -> (Popup.opt_to_string o, Popup.opt_to_jv o)) options
+    in
+    let (_ : Jv.t) =
+      Jv.call layer "bindPopup" [| Brr.El.to_jv el; Jv.obj l |]
+    in
     ()
 
 let unbind_popup : type kind. kind t -> unit = function
@@ -98,7 +104,10 @@ let geojson_opt_to_jv = function
   | Markers_inherit_options b -> Jv.of_bool b
   | Point_to_layer f -> Jv.repr f
   | Style f -> Jv.repr f
-  | On_each_feature f -> Jv.repr f
+  | On_each_feature f ->
+    (* we need to wrap the Jv.t *)
+    let f feature jv = jv |> of_jv Geojson |> f feature in
+    Jv.repr f
   | Filter f -> Jv.repr f
   | Coords_to_latlng f -> Jv.repr f
 
diff --git a/src/layer.mli b/src/layer.mli
index 204afab..7eaabd2 100644
--- a/src/layer.mli
+++ b/src/layer.mli
@@ -24,7 +24,7 @@ val remove : _ t -> unit
 val remove_from : Map.t -> _ t -> unit
 
 (** [bind_popup popup layer] binds [popup] to [layer] *)
-val bind_popup : Brr.El.t -> ?options:Jv.t -> _ t -> unit
+val bind_popup : Brr.El.t -> Popup.opt list -> _ t -> unit
 
 (** [unbind_popup layer] unbinds the popup bound to [layer] *)
 val unbind_popup : _ t -> unit
diff --git a/src/popup.ml b/src/popup.ml
index 5447cd4..f7a1c69 100644
--- a/src/popup.ml
+++ b/src/popup.ml
@@ -21,3 +21,59 @@ let close map =
   ()
 
 let of_jv = Fun.id
+
+type opt =
+  | Pane of string
+  | Offset of Point.t
+  | Max_width of int
+  | Min_width of int
+  | Max_height of int
+  | Auto_pan of bool
+  | Auto_pan_padding_top_left of Point.t
+  | Auto_pan_padding_bottom_right of Point.t
+  | Auto_pan_padding of Point.t
+  | Keep_in_view of bool
+  | Close_button of bool
+  | Auto_close of bool
+  | Close_on_escape_key of bool
+  | Close_on_click of bool
+  | Class_name of string
+
+let opt_to_string = function
+  | Pane _ -> "pane"
+  | Offset _ -> "offset"
+  | Max_width _ -> "maxWidth"
+  | Min_width _ -> "minWidth"
+  | Max_height _ -> "maxHeight"
+  | Auto_pan _ -> "autoPan"
+  | Auto_pan_padding_top_left _ -> "autoPanPaddingTopLeft"
+  | Auto_pan_padding_bottom_right _ -> "autoPanPaddingBottomRight"
+  | Auto_pan_padding _ -> "autoPanPadding"
+  | Keep_in_view _ -> "keepInView"
+  | Close_button _ -> "closeButton"
+  | Auto_close _ -> "autoClose"
+  | Close_on_escape_key _ -> "closeOnEscapeKey"
+  | Close_on_click _ -> "closeOnClick"
+  | Class_name _ -> "className"
+
+let opt_to_jv = function
+  | Offset p
+  | Auto_pan_padding_top_left p
+  | Auto_pan_padding_bottom_right p
+  | Auto_pan_padding p ->
+    Point.to_jv p
+  | Max_width i | Min_width i | Max_height i -> Jv.of_int i
+  | Auto_pan b
+  | Keep_in_view b
+  | Close_button b
+  | Auto_close b
+  | Close_on_escape_key b
+  | Close_on_click b ->
+    Jv.of_bool b
+  | Pane s | Class_name s -> Jv.of_string s
+
+let create options =
+  let l =
+    Array.of_list @@ List.map (fun o -> (opt_to_string o, opt_to_jv o)) options
+  in
+  Jv.call Global.leaflet "popup" [| Jv.obj l |]
diff --git a/src/popup.mli b/src/popup.mli
index 9983c5c..da7f27a 100644
--- a/src/popup.mli
+++ b/src/popup.mli
@@ -2,6 +2,24 @@
 
 type t
 
+(** type for popup option used to create an popup*)
+type opt =
+  | Pane of string
+  | Offset of Point.t
+  | Max_width of int
+  | Min_width of int
+  | Max_height of int
+  | Auto_pan of bool
+  | Auto_pan_padding_top_left of Point.t
+  | Auto_pan_padding_bottom_right of Point.t
+  | Auto_pan_padding of Point.t
+  | Keep_in_view of bool
+  | Close_button of bool
+  | Auto_close of bool
+  | Close_on_escape_key of bool
+  | Close_on_click of bool
+  | Class_name of string
+
 (** [set_latlng latlng] changes the popup position to the given point*)
 val set_latlng : Latlng.t -> unit
 
@@ -16,3 +34,12 @@ val close : Map.t -> unit
 
 (** [of_jv jv] is [jv] as {!t} *)
 val of_jv : Jv.t -> t
+
+(** [opt_to_string opt] is [opt] as {!string} *)
+val opt_to_string : opt -> string
+
+(** [opt_to_jv opt] is [opt] as {!Jv.t} *)
+val opt_to_jv : opt -> Jv.t
+
+(** [create options] is a new popup setup withs [options] *)
+val create : opt list -> t