diff --git a/src/dune b/src/dune
index bce2f76..ed4515f 100644
--- a/src/dune
+++ b/src/dune
@@ -1,15 +1,7 @@
(library
(public_name leaflet)
- (modules
- event
- geojson_layer
- global
- latlng
- layer
- map
- marker
- popup
- tile_layer)
+ (modules event global latlng layer map popup)
+ (private_modules global)
(libraries brr)
(js_of_ocaml
(javascript_files leaflet.js)))
diff --git a/src/event.ml b/src/event.ml
index 491f322..6b456d2 100644
--- a/src/event.ml
+++ b/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 *)
diff --git a/src/event.mli b/src/event.mli
index bf4f2d7..9592bfb 100644
--- a/src/event.mli
+++ b/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
diff --git a/src/geojson_layer.ml b/src/geojson_layer.ml
deleted file mode 100644
index c5c113d..0000000
--- a/src/geojson_layer.ml
+++ /dev/null
@@ -1,4 +0,0 @@
-include Layer
-
-let create ?(options = Jv.null) geojson =
- of_jv_t @@ Jv.call Global.leaflet "geoJSON" [| geojson; options |]
diff --git a/src/geojson_layer.mli b/src/geojson_layer.mli
deleted file mode 100644
index e8c4660..0000000
--- a/src/geojson_layer.mli
+++ /dev/null
@@ -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
diff --git a/src/latlng.ml b/src/latlng.ml
index d2b4dbc..6611746 100644
--- a/src/latlng.ml
+++ b/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
diff --git a/src/latlng.mli b/src/latlng.mli
index fb793ae..c63a970 100644
--- a/src/latlng.mli
+++ b/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
diff --git a/src/layer.ml b/src/layer.ml
index d0c8b62..fd9b07a 100644
--- a/src/layer.ml
+++ b/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 =
- ignore @@ Jv.call layer "removeFrom" [| Map.to_jv_t map |]
+let remove : type kind. kind t -> unit = function
+ | Basic l | Geojson l | Marker l | Tile l ->
+ let (_ : Jv.t) = Jv.call l "remove" [||] in
+ ()
-let bind_popup el layer =
- ignore @@ Jv.call layer "bindPopup" [| Brr.El.to_jv el |]
+let remove_from : type kind. Map.t -> kind t -> unit =
+ 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
+ "© OpenStreetMap \
+ contributors" )
+ |]
+ |]
+ in
+ Tile jv_t
diff --git a/src/layer.mli b/src/layer.mli
index 98fe10c..0baf3fd 100644
--- a/src/layer.mli
+++ b/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
diff --git a/src/map.ml b/src/map.ml
index e070351..57598f4 100644
--- a/src/map.ml
+++ b/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 =
- Jv.call (to_jv_t map) "getContainer" [||] |> Brr.El.of_jv
+let get_container map = Jv.call (to_jv map) "getContainer" [||] |> Brr.El.of_jv
-let set_view latlng ?zoom map =
- let latlng = Latlng.to_jv_t latlng in
- ignore
- @@
- match zoom with
- | None -> Jv.call map "setView" [| latlng |]
- | Some zoom -> Jv.call map "setView" [| latlng; Jv.of_int zoom |]
+let set_view latlng ~zoom map =
+ let latlng = Latlng.to_jv latlng in
+ let (_ : Jv.t) =
+ match zoom with
+ | None -> Jv.call map "setView" [| latlng |]
+ | 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
- ignore @@ Jv.call map "on" [| Jv.of_string name; Jv.repr handler |]
+ let handler v = handler @@ Event.of_jv event v in
+ 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 |]
diff --git a/src/map.mli b/src/map.mli
index fdbd710..f4f6f2b 100644
--- a/src/map.mli
+++ b/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
diff --git a/src/marker.ml b/src/marker.ml
deleted file mode 100644
index 44925a1..0000000
--- a/src/marker.ml
+++ /dev/null
@@ -1,4 +0,0 @@
-include Layer
-
-let create latlng =
- of_jv_t @@ Jv.call Global.leaflet "marker" [| Latlng.to_jv_t latlng |]
diff --git a/src/marker.mli b/src/marker.mli
deleted file mode 100644
index ab77fc5..0000000
--- a/src/marker.mli
+++ /dev/null
@@ -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
diff --git a/src/popup.ml b/src/popup.ml
index bc0febf..fb0264c 100644
--- a/src/popup.ml
+++ b/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
diff --git a/src/popup.mli b/src/popup.mli
index 5ca939b..65e5dfc 100644
--- a/src/popup.mli
+++ b/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
diff --git a/src/tile_layer.ml b/src/tile_layer.ml
deleted file mode 100644
index 1dae48c..0000000
--- a/src/tile_layer.ml
+++ /dev/null
@@ -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
- "© OpenStreetMap \
- contributors" )
- |]
- |]
diff --git a/src/tile_layer.mli b/src/tile_layer.mli
deleted file mode 100644
index b1834b5..0000000
--- a/src/tile_layer.mli
+++ /dev/null
@@ -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