GPS Exchange Format library/CLI in OCaml
anil.recoil.org
1(** GPX metadata and bounds types *)
2
3(** Bounding box *)
4type bounds = {
5 minlat : Coordinate.latitude;
6 minlon : Coordinate.longitude;
7 maxlat : Coordinate.latitude;
8 maxlon : Coordinate.longitude;
9}
10
11(** Main metadata type *)
12type t = {
13 name : string option;
14 desc : string option;
15 author : Link.person option;
16 copyright : Link.copyright option;
17 links : Link.t list;
18 time : Ptime.t option;
19 keywords : string option;
20 bounds : bounds option;
21 extensions : Extension.t list;
22}
23
24(** {2 Bounds Operations} *)
25
26module Bounds = struct
27 type t = bounds
28
29 (** Create bounds from coordinates *)
30 let make ~minlat ~minlon ~maxlat ~maxlon = { minlat; minlon; maxlat; maxlon }
31
32 (** Create bounds from float coordinates with validation *)
33 let make_from_floats ~minlat ~minlon ~maxlat ~maxlon =
34 match
35 Coordinate.latitude minlat,
36 Coordinate.longitude minlon,
37 Coordinate.latitude maxlat,
38 Coordinate.longitude maxlon
39 with
40 | Ok minlat, Ok minlon, Ok maxlat, Ok maxlon ->
41 if Coordinate.latitude_to_float minlat <= Coordinate.latitude_to_float maxlat &&
42 Coordinate.longitude_to_float minlon <= Coordinate.longitude_to_float maxlon
43 then Ok { minlat; minlon; maxlat; maxlon }
44 else Error "Invalid bounds: min values must be <= max values"
45 | Error e, _, _, _ | _, Error e, _, _ | _, _, Error e, _ | _, _, _, Error e -> Error e
46
47 (** Get corner coordinates *)
48 let min_coords t = Coordinate.make t.minlat t.minlon
49 let max_coords t = Coordinate.make t.maxlat t.maxlon
50
51 (** Get all bounds as tuple *)
52 let bounds t = (t.minlat, t.minlon, t.maxlat, t.maxlon)
53
54 (** Check if coordinate is within bounds *)
55 let contains bounds coord =
56 let lat = Coordinate.lat coord in
57 let lon = Coordinate.lon coord in
58 Coordinate.latitude_to_float bounds.minlat <= Coordinate.latitude_to_float lat &&
59 Coordinate.latitude_to_float lat <= Coordinate.latitude_to_float bounds.maxlat &&
60 Coordinate.longitude_to_float bounds.minlon <= Coordinate.longitude_to_float lon &&
61 Coordinate.longitude_to_float lon <= Coordinate.longitude_to_float bounds.maxlon
62
63 (** Calculate bounds area *)
64 let area t =
65 let lat_diff = Coordinate.latitude_to_float t.maxlat -. Coordinate.latitude_to_float t.minlat in
66 let lon_diff = Coordinate.longitude_to_float t.maxlon -. Coordinate.longitude_to_float t.minlon in
67 lat_diff *. lon_diff
68
69 (** Compare bounds *)
70 let compare t1 t2 =
71 let minlat_cmp = Float.compare
72 (Coordinate.latitude_to_float t1.minlat)
73 (Coordinate.latitude_to_float t2.minlat) in
74 if minlat_cmp <> 0 then minlat_cmp
75 else
76 let minlon_cmp = Float.compare
77 (Coordinate.longitude_to_float t1.minlon)
78 (Coordinate.longitude_to_float t2.minlon) in
79 if minlon_cmp <> 0 then minlon_cmp
80 else
81 let maxlat_cmp = Float.compare
82 (Coordinate.latitude_to_float t1.maxlat)
83 (Coordinate.latitude_to_float t2.maxlat) in
84 if maxlat_cmp <> 0 then maxlat_cmp
85 else Float.compare
86 (Coordinate.longitude_to_float t1.maxlon)
87 (Coordinate.longitude_to_float t2.maxlon)
88
89 (** Test bounds equality *)
90 let equal t1 t2 = compare t1 t2 = 0
91
92 (** Pretty print bounds *)
93 let pp ppf t =
94 Format.fprintf ppf "[(%g,%g) - (%g,%g)]"
95 (Coordinate.latitude_to_float t.minlat)
96 (Coordinate.longitude_to_float t.minlon)
97 (Coordinate.latitude_to_float t.maxlat)
98 (Coordinate.longitude_to_float t.maxlon)
99end
100
101(** {2 Metadata Operations} *)
102
103(** Create empty metadata *)
104let empty = {
105 name = None; desc = None; author = None; copyright = None;
106 links = []; time = None; keywords = None; bounds = None;
107 extensions = [];
108}
109
110(** Create metadata with name *)
111let make ~name = { empty with name = Some name }
112
113(** Get name *)
114let name t = t.name
115
116(** Get description *)
117let description t = t.desc
118
119(** Get author *)
120let author t = t.author
121
122(** Get copyright *)
123let copyright t = t.copyright
124
125(** Get links *)
126let links t = t.links
127
128(** Get time *)
129let time t = t.time
130
131(** Get keywords *)
132let keywords t = t.keywords
133
134(** Get bounds *)
135let bounds_opt t = t.bounds
136
137(** Get extensions *)
138let extensions t = t.extensions
139
140(** Update name *)
141let with_name t name = { t with name = Some name }
142
143(** Update description *)
144let with_description t desc = { t with desc = Some desc }
145
146(** Update keywords *)
147let with_keywords t keywords = { t with keywords = Some keywords }
148
149(** Update time *)
150let with_time t time = { t with time }
151
152(** Update bounds *)
153let with_bounds t bounds = { t with bounds = Some bounds }
154
155(** Update author *)
156let with_author t author = { t with author = Some author }
157
158(** Update copyright *)
159let with_copyright t copyright = { t with copyright = Some copyright }
160
161(** Add link *)
162let add_link t link = { t with links = link :: t.links }
163
164(** Add extensions *)
165let add_extensions t extensions = { t with extensions = extensions @ t.extensions }
166
167(** Compare metadata *)
168let compare t1 t2 =
169 let name_cmp = Option.compare String.compare t1.name t2.name in
170 if name_cmp <> 0 then name_cmp
171 else
172 let desc_cmp = Option.compare String.compare t1.desc t2.desc in
173 if desc_cmp <> 0 then desc_cmp
174 else Option.compare Ptime.compare t1.time t2.time
175
176(** Test metadata equality *)
177let equal t1 t2 = compare t1 t2 = 0
178
179(** Pretty print metadata *)
180let pp ppf t =
181 match t.name with
182 | Some name -> Format.fprintf ppf "\"%s\"" name
183 | None -> Format.fprintf ppf "(unnamed)"