this repo has no description
Add typed Leaflet_map wrapper, use in Zarr notebook
Leaflet_map provides a type-safe OCaml interface to the Leaflet widget:
- Leaflet_map.create: typed config (center, zoom, height) + typed callbacks
(on_click receives latlng, on_bbox_drawn receives bounds)
- Leaflet_map.add_image_overlay: typed bounds + url + opacity
- Leaflet_map.add_marker: typed latlng + optional color/label
- All JSON serialization hidden inside the wrapper
The notebook no longer uses raw Widget.command/Scanf.sscanf for map
interaction. Compare:
Before: Widget.command ~id "addImageOverlay" (Printf.sprintf {|{...}|} ...)
After: Leaflet_map.add_image_overlay map ~url ~bounds ~opacity:0.7 ()
Before: Scanf.sscanf json {|{"lat":%f,"lng":%f}|} (fun a b -> ...)
After: on_click:(fun pt -> ... pt.lat ... pt.lng ...)
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+203
-1
+1
-1
widget-leaflet/dune
+1
-1
widget-leaflet/dune
+109
widget-leaflet/leaflet_map.ml
+109
widget-leaflet/leaflet_map.ml
···
1
+
type t = { id : string }
2
+
3
+
type latlng = { lat : float; lng : float }
4
+
type bounds = { south : float; west : float; north : float; east : float }
5
+
type move_info = { center : latlng; zoom : int; bounds : bounds }
6
+
7
+
let id t = t.id
8
+
9
+
let cmd t name data =
10
+
Widget.command ~id:t.id name data
11
+
12
+
let parse_latlng json =
13
+
Scanf.sscanf json {| {"lat":%f,"lng":%f}|} (fun lat lng -> { lat; lng })
14
+
15
+
let parse_bounds json =
16
+
Scanf.sscanf json {| {"south":%f,"west":%f,"north":%f,"east":%f}|}
17
+
(fun s w n e -> { south = s; west = w; north = n; east = e })
18
+
19
+
let parse_move json =
20
+
(* moveend sends: {"center":[lat,lng],"zoom":z,"bounds":{"south":...}} *)
21
+
let j = Yojson.Safe.from_string json in
22
+
let member k = function
23
+
| `Assoc l -> (try List.assoc k l with Not_found -> `Null)
24
+
| _ -> `Null in
25
+
let to_float = function `Float f -> f | `Int i -> Float.of_int i | _ -> 0.0 in
26
+
let center = match member "center" j with
27
+
| `List [lat; lng] -> { lat = to_float lat; lng = to_float lng }
28
+
| _ -> { lat = 0.0; lng = 0.0 } in
29
+
let zoom = match member "zoom" j with
30
+
| `Int z -> z | _ -> 0 in
31
+
let b = member "bounds" j in
32
+
let bounds = {
33
+
south = to_float (member "south" b);
34
+
west = to_float (member "west" b);
35
+
north = to_float (member "north" b);
36
+
east = to_float (member "east" b);
37
+
} in
38
+
{ center; zoom; bounds }
39
+
40
+
let create ?(id = "leaflet-map") ?tile_url ?(height = "500px")
41
+
~center:(clat, clng) ~zoom
42
+
?on_click ?on_bbox_drawn ?on_move () =
43
+
let t = { id } in
44
+
let config_parts =
45
+
[ Printf.sprintf {|"center":[%f,%f]|} clat clng;
46
+
Printf.sprintf {|"zoom":%d|} zoom;
47
+
Printf.sprintf {|"height":"%s"|} height ]
48
+
@ (match tile_url with
49
+
| Some url -> [Printf.sprintf {|"tileUrl":"%s"|} url]
50
+
| None -> [])
51
+
in
52
+
let config = "{" ^ String.concat "," config_parts ^ "}" in
53
+
let handlers = List.filter_map Fun.id [
54
+
(match on_click with
55
+
| Some f -> Some ("click", (fun v ->
56
+
match v with Some j -> f (parse_latlng j) | None -> ()))
57
+
| None -> None);
58
+
(match on_bbox_drawn with
59
+
| Some f -> Some ("bbox_drawn", (fun v ->
60
+
match v with Some j -> f (parse_bounds j) | None -> ()))
61
+
| None -> None);
62
+
(match on_move with
63
+
| Some f -> Some ("moveend", (fun v ->
64
+
match v with Some j -> f (parse_move j) | None -> ()))
65
+
| None -> None);
66
+
] in
67
+
Widget.display_managed ~id ~kind:"leaflet-map" ~config ~handlers;
68
+
t
69
+
70
+
let fly_to t { lat; lng } ?zoom () =
71
+
let data = match zoom with
72
+
| Some z -> Printf.sprintf {|{"lat":%f,"lng":%f,"zoom":%d}|} lat lng z
73
+
| None -> Printf.sprintf {|{"lat":%f,"lng":%f}|} lat lng
74
+
in
75
+
cmd t "flyTo" data
76
+
77
+
let fit_bounds t { south; west; north; east } =
78
+
cmd t "fitBounds"
79
+
(Printf.sprintf {|[[%f,%f],[%f,%f]]|} south west north east)
80
+
81
+
let set_data t geojson =
82
+
cmd t "setData" geojson
83
+
84
+
let invalidate_size t =
85
+
cmd t "invalidateSize" ""
86
+
87
+
let enable_bbox_draw t =
88
+
cmd t "enableBboxDraw" ""
89
+
90
+
let add_image_overlay t ~url ~bounds ?(opacity = 0.7) () =
91
+
cmd t "addImageOverlay"
92
+
(Printf.sprintf {|{"url":"%s","bounds":[[%f,%f],[%f,%f]],"opacity":%f}|}
93
+
url bounds.south bounds.west bounds.north bounds.east opacity)
94
+
95
+
let remove_image_overlay t =
96
+
cmd t "removeImageOverlay" ""
97
+
98
+
let add_marker t { lat; lng } ?(color = "#ff0000") ?label () =
99
+
let data = match label with
100
+
| Some l ->
101
+
Printf.sprintf {|{"lat":%f,"lng":%f,"color":"%s","label":"%s"}|}
102
+
lat lng color l
103
+
| None ->
104
+
Printf.sprintf {|{"lat":%f,"lng":%f,"color":"%s"}|} lat lng color
105
+
in
106
+
cmd t "addMarker" data
107
+
108
+
let clear_markers t =
109
+
cmd t "clearMarkers" ""
+93
widget-leaflet/leaflet_map.mli
+93
widget-leaflet/leaflet_map.mli
···
1
+
(** Type-safe interface to the Leaflet map widget.
2
+
3
+
Wraps the string-based [Widget.command] and handler protocol with
4
+
typed OCaml functions. All JSON serialization is handled internally.
5
+
6
+
{2 Example}
7
+
8
+
{[
9
+
let map = Leaflet_map.create ~center:(52.2, 0.12) ~zoom:13 () in
10
+
Leaflet_map.on_bbox_drawn map (fun bbox ->
11
+
Printf.printf "Selected: %f,%f to %f,%f\n"
12
+
bbox.south bbox.west bbox.north bbox.east);
13
+
Leaflet_map.enable_bbox_draw map;
14
+
Leaflet_map.add_image_overlay map ~url ~bounds ~opacity:0.7
15
+
]} *)
16
+
17
+
(** {1 Types} *)
18
+
19
+
type t
20
+
(** A Leaflet map widget. *)
21
+
22
+
type latlng = { lat : float; lng : float }
23
+
(** A geographic point. *)
24
+
25
+
type bounds = { south : float; west : float; north : float; east : float }
26
+
(** A geographic bounding box. *)
27
+
28
+
type move_info = {
29
+
center : latlng;
30
+
zoom : int;
31
+
bounds : bounds;
32
+
}
33
+
(** Information sent on map move events. *)
34
+
35
+
(** {1 Creating a map} *)
36
+
37
+
val create :
38
+
?id:string ->
39
+
?tile_url:string ->
40
+
?height:string ->
41
+
center:float * float ->
42
+
zoom:int ->
43
+
?on_click:(latlng -> unit) ->
44
+
?on_bbox_drawn:(bounds -> unit) ->
45
+
?on_move:(move_info -> unit) ->
46
+
unit -> t
47
+
(** Create and display a Leaflet map widget.
48
+
49
+
@param id Widget ID (default: ["leaflet-map"])
50
+
@param tile_url Tile server URL (default: OpenStreetMap)
51
+
@param height CSS height (default: ["500px"])
52
+
@param center Initial center as [(lat, lng)]
53
+
@param zoom Initial zoom level
54
+
@param on_click Called when the map is clicked
55
+
@param on_bbox_drawn Called when a bounding box is drawn
56
+
@param on_move Called when the map view changes *)
57
+
58
+
(** {1 Map ID} *)
59
+
60
+
val id : t -> string
61
+
(** The widget ID of this map. *)
62
+
63
+
(** {1 Commands} *)
64
+
65
+
val fly_to : t -> latlng -> ?zoom:int -> unit -> unit
66
+
(** Smoothly pan/zoom to a location. *)
67
+
68
+
val fit_bounds : t -> bounds -> unit
69
+
(** Fit the map view to a bounding box. *)
70
+
71
+
val set_data : t -> string -> unit
72
+
(** Set GeoJSON data on the map. [data] is a GeoJSON string. *)
73
+
74
+
val invalidate_size : t -> unit
75
+
(** Notify the map that its container size changed. *)
76
+
77
+
val enable_bbox_draw : t -> unit
78
+
(** Enter bounding-box drawing mode. The user draws a rectangle
79
+
by clicking and dragging. Fires the [on_bbox_drawn] callback. *)
80
+
81
+
val add_image_overlay : t -> url:string -> bounds:bounds ->
82
+
?opacity:float -> unit -> unit
83
+
(** Add (or replace) an image overlay on the map. *)
84
+
85
+
val remove_image_overlay : t -> unit
86
+
(** Remove the current image overlay. *)
87
+
88
+
val add_marker : t -> latlng -> ?color:string -> ?label:string ->
89
+
unit -> unit
90
+
(** Add a circle marker at a location. *)
91
+
92
+
val clear_markers : t -> unit
93
+
(** Remove all markers. *)