use gadts for layer, clean code

src/dune

@@ -1,15 +1,7 @@
 (library
  (public_name leaflet)
- (modules
+ (modules event global latlng layer map popup)
-  event
+ (private_modules global)
-  geojson_layer
-  global
-  latlng
-  layer
-  map
-  marker
-  popup
-  tile_layer)
  (libraries brr)
  (js_of_ocaml
   (javascript_files leaflet.js)))

src/event.ml

@@ -9,7 +9,7 @@ type _ sub =
   | Move_end : [> `Basic ] sub
   | Zoom_end : [> `Basic ] sub
 
-let of_jv_t : type kind. kind sub -> Jv.t -> kind t =
+let of_jv : type kind. kind sub -> Jv.t -> kind t =
  fun tag e ->
   match tag with Click -> Mouse e | Move_end -> Basic e | Zoom_end -> Basic e
 
@@ -48,7 +48,7 @@ let layer_point : [ `Mouse ] t -> Jv.t = function
   | Mouse e -> Jv.get e "layerPoint"
 
 let latlng : [ `Mouse ] t -> Latlng.t = function
-  | Mouse e -> Jv.get e "latlng" |> Latlng.of_jv_t
+  | Mouse e -> Jv.get e "latlng" |> Latlng.of_jv
 
 (** Error events *)
 

src/event.mli

@@ -9,7 +9,7 @@ type _ sub =
   | Move_end : [> `Basic ] sub
   | Zoom_end : [> `Basic ] sub
 
-val of_jv_t : 'a sub -> Jv.t -> 'a t
+val of_jv : 'a sub -> Jv.t -> 'a t
 
 val sub_to_string : _ sub -> string
 

src/geojson_layer.ml

@@ -1,4 +0,0 @@
-include Layer
-
-let create ?(options = Jv.null) geojson =
-  of_jv_t @@ Jv.call Global.leaflet "geoJSON" [| geojson; options |]

src/geojson_layer.mli

@@ -1,23 +0,0 @@
-type t
-
-val create : ?options:Jv.t -> Jv.t -> t
-
-val add_to : Map.t -> t -> unit
-
-val remove : t -> unit
-
-val remove_from : Map.t -> t -> unit
-
-val bind_popup : Brr.El.t -> t -> unit
-
-val unbind_popup : t -> unit
-
-val open_popup : t -> unit
-
-val close_popup : t -> unit
-
-val get_popup : t -> Popup.t
-
-val of_jv_t : Jv.t -> t
-
-val to_jv_t : t -> Jv.t

src/latlng.ml

@@ -9,6 +9,6 @@ let lng latlng = Jv.get latlng "lng" |> Jv.to_float
 
 let equals a b = Jv.call a "equals" [| b |] |> Jv.to_bool
 
-let of_jv_t = Fun.id
+let of_jv = Fun.id
 
-let to_jv_t = Fun.id
+let to_jv = Fun.id

src/latlng.mli

@@ -8,6 +8,6 @@ val lng : t -> float
 
 val equals : t -> t -> bool
 
-val of_jv_t : Jv.t -> t
+val of_jv : Jv.t -> t
 
-val to_jv_t : t -> Jv.t
+val to_jv : t -> Jv.t

src/layer.ml

@@ -1,23 +1,89 @@
-type t = Jv.t
+type _ t =
+  | Basic : Jv.t -> [> `Basic ] t
+  | Geojson : Jv.t -> [> `Geojson ] t
+  | Marker : Jv.t -> [> `Marker ] t
+  | Tile : Jv.t -> [> `Tile ] t
 
-let add_to map layer = ignore @@ Jv.call layer "addTo" [| Map.to_jv_t map |]
+(** Basic layers *)
 
-let remove layer = ignore @@ Jv.call layer "remove" [||]
+let add_to : type kind. Map.t -> kind t -> unit =
+ fun map -> function
+  | Basic l | Geojson l | Marker l | Tile l ->
+    let (_ : Jv.t) = Jv.call l "addTo" [| Map.to_jv map |] in
+    ()
 
-let remove_from map layer =
+let remove : type kind. kind t -> unit = function
-  ignore @@ Jv.call layer "removeFrom" [| Map.to_jv_t map |]
+  | Basic l | Geojson l | Marker l | Tile l ->
+    let (_ : Jv.t) = Jv.call l "remove" [||] in
+    ()
 
-let bind_popup el layer =
+let remove_from : type kind. Map.t -> kind t -> unit =
-  ignore @@ Jv.call layer "bindPopup" [| Brr.El.to_jv el |]
+ fun map -> function
+  | Basic l | Geojson l | Marker l | Tile l ->
+    let (_ : Jv.t) = Jv.call l "removeFrom" [| Map.to_jv map |] in
+    ()
 
-let unbind_popup layer = ignore @@ Jv.call layer "unbindPopup" [||]
+let bind_popup : type kind. Brr.El.t -> kind t -> unit =
+ fun el -> function
+  | Basic l | Geojson l | Marker l | Tile l ->
+    let (_ : Jv.t) = Jv.call l "bindPopup" [| Brr.El.to_jv el |] in
+    ()
 
-let open_popup layer = ignore @@ Jv.call layer "openPopup" [||]
+let unbind_popup : type kind. kind t -> unit = function
+  | Basic l | Geojson l | Marker l | Tile l ->
+    let (_ : Jv.t) = Jv.call l "unbindPopup" [||] in
+    ()
 
-let close_popup layer = ignore @@ Jv.call layer "closePopup" [||]
+let open_popup : type kind. kind t -> unit = function
+  | Basic l | Geojson l | Marker l | Tile l ->
+    let (_ : Jv.t) = Jv.call l "openPopup" [||] in
+    ()
 
-let get_popup layer = Popup.of_jv_t @@ Jv.call layer "getPopup" [||]
+let close_popup : type kind. kind t -> unit = function
+  | Basic l | Geojson l | Marker l | Tile l ->
+    let (_ : Jv.t) = Jv.call l "closePopup" [||] in
+    ()
 
-let of_jv_t = Fun.id
+let get_popup : type kind. kind t -> Popup.t = function
+  | Basic l | Geojson l | Marker l | Tile l ->
+    Jv.call l "getPopup" [||] |> Popup.of_jv
 
-let to_jv_t = Fun.id
+let to_jv : type kind. kind t -> Jv.t = function
+  | Basic l | Geojson l | Marker l | Tile l -> l
+
+(** Geojson layers *)
+
+let create_geojson : ?options:Jv.t -> Jv.t -> [ `Geojson ] t =
+ fun ?(options = Jv.null) geojson ->
+  let jv_t = Jv.call Global.leaflet "geoJSON" [| geojson; options |] in
+  Geojson jv_t
+
+(** Marker layers *)
+
+let create_marker : Latlng.t -> [ `Marker ] t =
+ fun latlng ->
+  let jv_t = Jv.call Global.leaflet "marker" [| Latlng.to_jv latlng |] in
+  Marker jv_t
+
+(** Tile layers *)
+
+let create_tile_osm : string option -> [ `Tile ] t =
+ fun url ->
+  (* see https://wiki.openstreetmap.org/wiki/Tile_servers *)
+  let url =
+    Option.value url
+      ~default:"https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png"
+  in
+  let jv_t =
+    Jv.call Global.leaflet "tileLayer"
+      [| Jv.of_string url
+       ; Jv.obj
+           [| ( "attribution"
+              , Jv.of_string
+                  "&copy; <a \
+                   href=\"https://www.openstreetmap.org/copyright\">OpenStreetMap</a> \
+                   contributors" )
+           |]
+      |]
+  in
+  Tile jv_t

src/layer.mli

@@ -1,21 +1,37 @@
-type t
+type _ t =
+  | Basic : Jv.t -> [> `Basic ] t
+  | Geojson : Jv.t -> [> `Geojson ] t
+  | Marker : Jv.t -> [> `Marker ] t
+  | Tile : Jv.t -> [> `Tile ] t
 
-val add_to : Map.t -> t -> unit
+(** Basic layers *)
 
-val remove : t -> unit
+val add_to : Map.t -> _ t -> unit
 
-val remove_from : Map.t -> t -> unit
+val remove : _ t -> unit
 
-val bind_popup : Brr.El.t -> t -> unit
+val remove_from : Map.t -> _ t -> unit
 
-val unbind_popup : t -> unit
+val bind_popup : Brr.El.t -> _ t -> unit
 
-val open_popup : t -> unit
+val unbind_popup : _ t -> unit
 
-val close_popup : t -> unit
+val open_popup : _ t -> unit
 
-val get_popup : t -> Popup.t
+val close_popup : _ t -> unit
 
-val of_jv_t : Jv.t -> t
+val get_popup : _ t -> Popup.t
 
-val to_jv_t : t -> Jv.t
+val to_jv : _ t -> Jv.t
+
+(** Geojson layers *)
+
+val create_geojson : ?options:Jv.t -> Jv.t -> [ `Geojson ] t
+
+(** Marker layers *)
+
+val create_marker : Latlng.t -> [ `Marker ] t
+
+(** Tile layers *)
+
+val create_tile_osm : string option -> [ `Tile ] t

src/map.ml

@@ -1,38 +1,43 @@
 type t = Jv.t
 
-let of_jv_t = Fun.id
+let of_jv = Fun.id
 
-let to_jv_t = Fun.id
+let to_jv = Fun.id
 
 let create ?(options = Jv.null) container_id =
   Jv.call Global.leaflet "map" [| Jv.of_string container_id; options |]
 
-let invalidate_size map = ignore @@ Jv.call map "invalidateSize" [| Jv.true' |]
+let invalidate_size map =
+  let (_ : Jv.t) = Jv.call map "invalidateSize" [| Jv.true' |] in
+  ()
 
-let fit_world map = ignore @@ Jv.call map "fitWorld" [||]
+let fit_world map =
+  let (_ : Jv.t) = Jv.call map "fitWorld" [||] in
+  ()
 
-let get_container map =
+let get_container map = Jv.call (to_jv map) "getContainer" [||] |> Brr.El.of_jv
-  Jv.call (to_jv_t map) "getContainer" [||] |> Brr.El.of_jv
 
-let set_view latlng ?zoom map =
+let set_view latlng ~zoom map =
-  let latlng = Latlng.to_jv_t latlng in
+  let latlng = Latlng.to_jv latlng in
-  ignore
+  let (_ : Jv.t) =
-  @@
+    match zoom with
-  match zoom with
+    | None -> Jv.call map "setView" [| latlng |]
-  | None -> Jv.call map "setView" [| latlng |]
+    | Some zoom -> Jv.call map "setView" [| latlng; Jv.of_int zoom |]
-  | Some zoom -> Jv.call map "setView" [| latlng; Jv.of_int zoom |]
+  in
+  ()
 
 let as_target map = Brr.Ev.target_of_jv map
 
 let on : type kind. kind Event.sub -> (kind Event.t -> 'b) -> t -> unit =
  fun event handler map ->
   let name = Event.sub_to_string event in
-  let handler v = handler @@ Event.of_jv_t event v in
+  let handler v = handler @@ Event.of_jv event v in
-  ignore @@ Jv.call map "on" [| Jv.of_string name; Jv.repr handler |]
+  let (_ : Jv.t) = Jv.call map "on" [| Jv.of_string name; Jv.repr handler |] in
+  ()
 
-let get_center map = Latlng.of_jv_t @@ Jv.call map "getCenter" [||]
+let get_center map = Latlng.of_jv @@ Jv.call map "getCenter" [||]
 
 let get_zoom map = Jv.call map "getZoom" [||] |> Jv.to_int
 
 let wrapped_latlng latlng map =
-  Latlng.of_jv_t @@ Jv.call map "wrapLatLng" [| Latlng.to_jv_t latlng |]
+  Latlng.of_jv @@ Jv.call map "wrapLatLng" [| Latlng.to_jv latlng |]

src/map.mli

@@ -4,7 +4,7 @@ val create : ?options:Jv.t -> string -> t
 
 val invalidate_size : t -> unit
 
-val set_view : Latlng.t -> ?zoom:int -> t -> unit
+val set_view : Latlng.t -> zoom:int option -> t -> unit
 
 val fit_world : t -> unit
 
@@ -20,6 +20,6 @@ val wrapped_latlng : Latlng.t -> t -> Latlng.t
 
 val as_target : t -> Brr.Ev.target
 
-val of_jv_t : Jv.t -> t
+val of_jv : Jv.t -> t
 
-val to_jv_t : t -> Jv.t
+val to_jv : t -> Jv.t

src/marker.ml

@@ -1,4 +0,0 @@
-include Layer
-
-let create latlng =
-  of_jv_t @@ Jv.call Global.leaflet "marker" [| Latlng.to_jv_t latlng |]

src/marker.mli

@@ -1,23 +0,0 @@
-type t
-
-val create : Latlng.t -> t
-
-val add_to : Map.t -> t -> unit
-
-val remove : t -> unit
-
-val remove_from : Map.t -> t -> unit
-
-val bind_popup : Brr.El.t -> t -> unit
-
-val unbind_popup : t -> unit
-
-val open_popup : t -> unit
-
-val close_popup : t -> unit
-
-val get_popup : t -> Popup.t
-
-val of_jv_t : Jv.t -> t
-
-val to_jv_t : t -> Jv.t

src/popup.ml

@@ -3,13 +3,19 @@ type t = Jv.t
 let popup = Jv.call Global.leaflet "popup" [||]
 
 let set_latlng latlng =
-  ignore @@ Jv.call popup "setLatLng" [| Latlng.to_jv_t latlng |]
+  let (_ : Jv.t) = Jv.call popup "setLatLng" [| Latlng.to_jv latlng |] in
+  ()
 
 let set_content content =
-  ignore @@ Jv.call popup "setContent" [| Jv.of_string content |]
+  let (_ : Jv.t) = Jv.call popup "setContent" [| Jv.of_string content |] in
+  ()
 
-let open_on map = ignore @@ Jv.call popup "openOn" [| Map.to_jv_t map |]
+let open_on map =
+  let (_ : Jv.t) = Jv.call popup "openOn" [| Map.to_jv map |] in
+  ()
 
-let close map = ignore @@ Jv.call (Map.to_jv_t map) "closePopup" [||]
+let close map =
+  let (_ : Jv.t) = Jv.call (Map.to_jv map) "closePopup" [||] in
+  ()
 
-let of_jv_t = Fun.id
+let of_jv = Fun.id

src/popup.mli

@@ -8,4 +8,4 @@ val open_on : Map.t -> unit
 
 val close : Map.t -> unit
 
-val of_jv_t : Jv.t -> t
+val of_jv : Jv.t -> t

src/tile_layer.ml

@@ -1,19 +0,0 @@
-include Layer
-
-let create_osm ?tile_url () =
-  (* see https://wiki.openstreetmap.org/wiki/Tile_servers *)
-  let tile_url =
-    Option.fold ~some:Fun.id
-      ~none:"https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png" tile_url
-  in
-  of_jv_t
-  @@ Jv.call Global.leaflet "tileLayer"
-       [| Jv.of_string tile_url
-        ; Jv.obj
-            [| ( "attribution"
-               , Jv.of_string
-                   "&copy; <a \
-                    href=\"https://www.openstreetmap.org/copyright\">OpenStreetMap</a> \
-                    contributors" )
-            |]
-       |]

src/tile_layer.mli

@@ -1,23 +0,0 @@
-type t
-
-val create_osm : ?tile_url:string -> unit -> t
-
-val add_to : Map.t -> t -> unit
-
-val remove : t -> unit
-
-val remove_from : Map.t -> t -> unit
-
-val bind_popup : Brr.El.t -> t -> unit
-
-val unbind_popup : t -> unit
-
-val open_popup : t -> unit
-
-val close_popup : t -> unit
-
-val get_popup : t -> Popup.t
-
-val of_jv_t : Jv.t -> t
-
-val to_jv_t : t -> Jv.t