zapashcanon
/
leaflet
forked from swrup/leaflet
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

use gadts for layer, clean code

master
zapashcanon 3 months ago
parent
f4ab3e17ad
commit
fbfb403734
Signed by: zapashcanon GPG Key ID: 8981C3C62D1D28F1
17 changed files with 152 additions and 163 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 12
      src/dune
  2. 4
      src/event.ml
  3. 2
      src/event.mli
  4. 4
      src/geojson_layer.ml
  5. 23
      src/geojson_layer.mli
  6. 4
      src/latlng.ml
  7. 4
      src/latlng.mli
  8. 92
      src/layer.ml
  9. 38
      src/layer.mli
  10. 39
      src/map.ml
  11. 6
      src/map.mli
  12. 4
      src/marker.ml
  13. 23
      src/marker.mli
  14. 16
      src/popup.ml
  15. 2
      src/popup.mli
  16. 19
      src/tile_layer.ml
  17. 23
      src/tile_layer.mli

12
src/dune
View File

@ -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)))

4
src/event.ml
View File

@ -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 *)

2
src/event.mli
View File

@ -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

4
src/geojson_layer.ml
View File

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

23
src/geojson_layer.mli
View File

@ -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

4
src/latlng.ml
View File

@ -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

4
src/latlng.mli
View File

@ -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

92
src/layer.ml
View File

@ -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
"&copy; <a \
href=\"https://www.openstreetmap.org/copyright\">OpenStreetMap</a> \
contributors" )
|]
|]
in
Tile jv_t

38
src/layer.mli
View File

@ -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

39
src/map.ml
View File

@ -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 |]

6
src/map.mli
View File

@ -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

4
src/marker.ml
View File

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

23
src/marker.mli
View File

@ -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

16
src/popup.ml
View File

@ -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

2
src/popup.mli
View File

@ -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

19
src/tile_layer.ml
View File

@ -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" )
|]
|]

23
src/tile_layer.mli
View File

@ -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
Write Preview
Loading…
Cancel
Save