leaflet/src/layer.ml

(* BSD-2-Clause License *)

type _ t =
  | Basic : Jv.t -> [> `Basic ] t
  | Geojson : Jv.t -> [> `Geojson ] t
  | Marker : Jv.t -> [> `Marker ] t
  | Tile : Jv.t -> [> `Tile ] t

type _ sub =
  | Basic : [> `Basic ] sub
  | Geojson : [> `Geojson ] sub
  | Marker : [> `Marker ] sub
  | Tile : [> `Tile ] sub

(** Basic layers *)

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 : type kind. kind t -> unit = function
  | Basic l | Geojson l | Marker l | Tile l ->
    let (_ : Jv.t) = Jv.call l "remove" [||] in
    ()

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 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 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 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 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 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 : type kind. kind t -> Jv.t = function
  | Basic l | Geojson l | Marker l | Tile l -> l

let of_jv : type kind. kind sub -> Jv.t -> kind t =
 fun tag l ->
  match tag with
  | Basic -> Basic l
  | Geojson -> Geojson l
  | Marker -> Marker l
  | Tile -> Tile l

let on : type kind. kind Event.sub -> (kind Event.t -> 'b) -> 'c t -> unit =
 fun event handler layer ->
  let name = Event.sub_to_string event in
  let handler v = handler @@ Event.of_jv event v in
  let (_ : Jv.t) =
    Jv.call (to_jv layer) "on" [| Jv.of_string name; Jv.repr handler |]
  in
  ()

(** 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 ->
  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