patrick.sirref.org
1(** Core GPX types matching the GPX 1.1 XSD schema *)
2
3[@@@warning "-30"]
4
5(** Geographic coordinates with validation constraints *)
6type latitude = private float
7type longitude = private float
8type degrees = private float
9
10(** Smart constructors for validated coordinates *)
11let latitude f =
12 if f >= -90.0 && f <= 90.0 then Ok (Obj.magic f : latitude)
13 else Error (Printf.sprintf "Invalid latitude: %f (must be between -90.0 and 90.0)" f)
14
15let longitude f =
16 if f >= -180.0 && f < 180.0 then Ok (Obj.magic f : longitude)
17 else Error (Printf.sprintf "Invalid longitude: %f (must be between -180.0 and 180.0)" f)
18
19let degrees f =
20 if f >= 0.0 && f < 360.0 then Ok (Obj.magic f : degrees)
21 else Error (Printf.sprintf "Invalid degrees: %f (must be between 0.0 and 360.0)" f)
22
23(** Convert back to float *)
24let latitude_to_float (lat : latitude) = (lat :> float)
25let longitude_to_float (lon : longitude) = (lon :> float)
26let degrees_to_float (deg : degrees) = (deg :> float)
27
28(** GPS fix types as defined in GPX spec *)
29type fix_type =
30 | None_fix
31 | Fix_2d
32 | Fix_3d
33 | Dgps
34 | Pps
35
36(** Person information *)
37type person = {
38 name : string option;
39 email : string option;
40 link : link option;
41}
42
43(** Link information *)
44and link = {
45 href : string;
46 text : string option;
47 type_ : string option;
48}
49
50(** Copyright information *)
51type copyright = {
52 author : string;
53 year : int option;
54 license : string option;
55}
56
57(** Bounding box *)
58type bounds = {
59 minlat : latitude;
60 minlon : longitude;
61 maxlat : latitude;
62 maxlon : longitude;
63}
64
65(** Metadata container *)
66type metadata = {
67 name : string option;
68 desc : string option;
69 author : person option;
70 copyright : copyright option;
71 links : link list;
72 time : Ptime.t option;
73 keywords : string option;
74 bounds : bounds option;
75 extensions : extension list;
76}
77
78(** Extension mechanism for custom elements *)
79and extension = {
80 namespace : string option;
81 name : string;
82 attributes : (string * string) list;
83 content : extension_content;
84}
85
86and extension_content =
87 | Text of string
88 | Elements of extension list
89 | Mixed of string * extension list
90
91(** Base waypoint data shared by wpt, rtept, trkpt *)
92type waypoint_data = {
93 lat : latitude;
94 lon : longitude;
95 ele : float option;
96 time : Ptime.t option;
97 magvar : degrees option;
98 geoidheight : float option;
99 name : string option;
100 cmt : string option;
101 desc : string option;
102 src : string option;
103 links : link list;
104 sym : string option;
105 type_ : string option;
106 fix : fix_type option;
107 sat : int option;
108 hdop : float option;
109 vdop : float option;
110 pdop : float option;
111 ageofdgpsdata : float option;
112 dgpsid : int option;
113 extensions : extension list;
114}
115
116(** Waypoint *)
117type waypoint = waypoint_data
118
119(** Route point *)
120type route_point = waypoint_data
121
122(** Track point *)
123type track_point = waypoint_data
124
125(** Route definition *)
126type route = {
127 name : string option;
128 cmt : string option;
129 desc : string option;
130 src : string option;
131 links : link list;
132 number : int option;
133 type_ : string option;
134 extensions : extension list;
135 rtepts : route_point list;
136}
137
138(** Track segment *)
139type track_segment = {
140 trkpts : track_point list;
141 extensions : extension list;
142}
143
144(** Track definition *)
145type track = {
146 name : string option;
147 cmt : string option;
148 desc : string option;
149 src : string option;
150 links : link list;
151 number : int option;
152 type_ : string option;
153 extensions : extension list;
154 trksegs : track_segment list;
155}
156
157(** Main GPX document *)
158type gpx = {
159 version : string; (* GPX version: "1.0" or "1.1" *)
160 creator : string;
161 metadata : metadata option;
162 waypoints : waypoint list;
163 routes : route list;
164 tracks : track list;
165 extensions : extension list;
166}
167
168(** Parser/Writer errors *)
169type error =
170 | Invalid_xml of string
171 | Invalid_coordinate of string
172 | Missing_required_attribute of string * string
173 | Missing_required_element of string
174 | Validation_error of string
175 | Xml_error of string
176 | IO_error of string
177
178exception Gpx_error of error
179
180(** Result type for operations that can fail *)
181type 'a result = ('a, error) Result.t
182
183(** Utility functions *)
184
185(** Convert fix_type to string *)
186let fix_type_to_string = function
187 | None_fix -> "none"
188 | Fix_2d -> "2d"
189 | Fix_3d -> "3d"
190 | Dgps -> "dgps"
191 | Pps -> "pps"
192
193(** Parse fix_type from string *)
194let fix_type_of_string = function
195 | "none" -> Some None_fix
196 | "2d" -> Some Fix_2d
197 | "3d" -> Some Fix_3d
198 | "dgps" -> Some Dgps
199 | "pps" -> Some Pps
200 | _ -> None
201
202(** Create empty waypoint_data with required coordinates *)
203let make_waypoint_data lat lon = {
204 lat; lon;
205 ele = None; time = None; magvar = None; geoidheight = None;
206 name = None; cmt = None; desc = None; src = None; links = [];
207 sym = None; type_ = None; fix = None; sat = None;
208 hdop = None; vdop = None; pdop = None; ageofdgpsdata = None;
209 dgpsid = None; extensions = [];
210}
211
212(** Create empty metadata *)
213let empty_metadata = {
214 name = None; desc = None; author = None; copyright = None;
215 links = []; time = None; keywords = None; bounds = None;
216 extensions = [];
217}
218
219(** Create empty GPX document *)
220let make_gpx ~creator = {
221 version = "1.1";
222 creator;
223 metadata = None;
224 waypoints = [];
225 routes = [];
226 tracks = [];
227 extensions = [];
228}