GPS Exchange Format library/CLI in OCaml
anil.recoil.org
1(** GPX validation utilities *)
2
3(** Validation error messages *)
4type validation_issue = {
5 level : [`Error | `Warning];
6 message : string;
7 location : string option;
8}
9
10type validation_result = {
11 issues : validation_issue list;
12 is_valid : bool;
13}
14
15let make_error ?location message = {
16 level = `Error;
17 message;
18 location;
19}
20
21let make_warning ?location message = {
22 level = `Warning;
23 message;
24 location;
25}
26
27(** Validate waypoint data *)
28let validate_waypoint_data wpt location =
29 let issues = ref [] in
30
31 (* Check for negative satellite count *)
32 (match Waypoint.sat wpt with
33 | Some sat when sat < 0 ->
34 issues := make_warning ~location ("Negative satellite count: " ^ string_of_int sat) :: !issues
35 | _ -> ());
36
37 (* Check for unreasonable precision values *)
38 let check_precision name value =
39 match value with
40 | Some v when v < 0.0 ->
41 issues := make_warning ~location (Printf.sprintf "Negative %s value: %.2f" name v) :: !issues
42 | Some v when v > 1000.0 ->
43 issues := make_warning ~location (Printf.sprintf "Very large %s value: %.2f" name v) :: !issues
44 | _ -> ()
45 in
46
47 check_precision "hdop" (Waypoint.hdop wpt);
48 check_precision "vdop" (Waypoint.vdop wpt);
49 check_precision "pdop" (Waypoint.pdop wpt);
50
51 (* Check elevation reasonableness *)
52 (match Waypoint.elevation wpt with
53 | Some ele when ele < -15000.0 ->
54 issues := make_warning ~location (Printf.sprintf "Very low elevation: %.2f m" ele) :: !issues
55 | Some ele when ele > 15000.0 ->
56 issues := make_warning ~location (Printf.sprintf "Very high elevation: %.2f m" ele) :: !issues
57 | _ -> ());
58
59 (* Check DGPS age *)
60 (match Waypoint.ageofdgpsdata wpt with
61 | Some age when age < 0.0 ->
62 issues := make_error ~location "Negative DGPS age" :: !issues
63 | _ -> ());
64
65 !issues
66
67(** Validate bounds *)
68let validate_bounds bounds =
69 let issues = ref [] in
70 let location = "bounds" in
71
72 let (minlat, minlon, maxlat, maxlon) = Metadata.Bounds.bounds bounds in
73 if Coordinate.latitude_to_float minlat >= Coordinate.latitude_to_float maxlat then
74 issues := make_error ~location "minlat must be less than maxlat" :: !issues;
75
76 if Coordinate.longitude_to_float minlon >= Coordinate.longitude_to_float maxlon then
77 issues := make_error ~location "minlon must be less than maxlon" :: !issues;
78
79 !issues
80
81(** Validate metadata *)
82let validate_metadata metadata =
83 let issues = ref [] in
84
85 (* Validate bounds if present *)
86 (match Metadata.bounds_opt metadata with
87 | Some bounds -> issues := validate_bounds bounds @ !issues
88 | None -> ());
89
90 (* Check for reasonable copyright year *)
91 (match Metadata.copyright metadata with
92 | Some copyright ->
93 (match Link.copyright_year copyright with
94 | Some year when year < 1900 || year > 2100 ->
95 issues := make_warning ~location:"metadata.copyright"
96 (Printf.sprintf "Unusual copyright year: %d" year) :: !issues
97 | _ -> ())
98 | None -> ());
99
100 !issues
101
102(** Validate route *)
103let validate_route route =
104 let issues = ref [] in
105 let location = "route" in
106
107 (* Check for empty route *)
108 let points = Route.points route in
109 if points = [] then
110 issues := make_warning ~location "Route has no points" :: !issues;
111
112 (* Validate route points *)
113 List.iteri (fun i rtept ->
114 let point_location = Printf.sprintf "route.rtept[%d]" i in
115 issues := validate_waypoint_data rtept point_location @ !issues
116 ) points;
117
118 !issues
119
120(** Validate track segment *)
121let validate_track_segment trkseg seg_idx =
122 let issues = ref [] in
123 let location = Printf.sprintf "track.trkseg[%d]" seg_idx in
124
125 (* Check for empty segment *)
126 let points = Track.Segment.points trkseg in
127 if points = [] then
128 issues := make_warning ~location "Track segment has no points" :: !issues;
129
130 (* Validate track points *)
131 List.iteri (fun i trkpt ->
132 let point_location = Printf.sprintf "%s.trkpt[%d]" location i in
133 issues := validate_waypoint_data trkpt point_location @ !issues
134 ) points;
135
136 (* Check for time ordering if timestamps are present *)
137 let rec check_time_order prev_time = function
138 | [] -> ()
139 | trkpt :: rest ->
140 (match (prev_time, Waypoint.time trkpt) with
141 | (Some prev, Some curr) when Ptime.compare prev curr > 0 ->
142 issues := make_warning ~location "Track points not in chronological order" :: !issues
143 | _ -> ());
144 check_time_order (Waypoint.time trkpt) rest
145 in
146 check_time_order None points;
147
148 !issues
149
150(** Validate track *)
151let validate_track track =
152 let issues = ref [] in
153 let location = "track" in
154
155 (* Check for empty track *)
156 let segments = Track.segments track in
157 if segments = [] then
158 issues := make_warning ~location "Track has no segments" :: !issues;
159
160 (* Validate track segments *)
161 List.iteri (fun i trkseg ->
162 issues := validate_track_segment trkseg i @ !issues
163 ) segments;
164
165 !issues
166
167(** Validate complete GPX document *)
168let validate_gpx gpx =
169 let issues = ref [] in
170
171 (* Check GPX version *)
172 let version = Doc.version gpx in
173 if version <> "1.0" && version <> "1.1" then
174 issues := make_error ~location:"gpx"
175 (Printf.sprintf "Unsupported GPX version: %s (supported: 1.0, 1.1)" version) :: !issues
176 else if version = "1.0" then
177 issues := make_warning ~location:"gpx"
178 "GPX 1.0 detected - consider upgrading to GPX 1.1 for better compatibility" :: !issues;
179
180 (* Check for empty creator *)
181 let creator = Doc.creator gpx in
182 if String.trim creator = "" then
183 issues := make_error ~location:"gpx" "Creator cannot be empty" :: !issues;
184
185 (* Validate metadata *)
186 (match Doc.metadata gpx with
187 | Some metadata -> issues := validate_metadata metadata @ !issues
188 | None -> ());
189
190 (* Validate waypoints *)
191 let waypoints = Doc.waypoints gpx in
192 List.iteri (fun i wpt ->
193 let location = Printf.sprintf "waypoint[%d]" i in
194 issues := validate_waypoint_data wpt location @ !issues
195 ) waypoints;
196
197 (* Validate routes *)
198 let routes = Doc.routes gpx in
199 List.iteri (fun _i route ->
200 issues := validate_route route @ !issues
201 ) routes;
202
203 (* Validate tracks *)
204 let tracks = Doc.tracks gpx in
205 List.iteri (fun _i track ->
206 issues := validate_track track @ !issues
207 ) tracks;
208
209 (* Check for completely empty GPX *)
210 if waypoints = [] && routes = [] && tracks = [] then
211 issues := make_warning ~location:"gpx" "GPX document contains no geographic data" :: !issues;
212
213 let all_issues = !issues in
214 let has_errors = List.exists (fun issue -> issue.level = `Error) all_issues in
215
216 { issues = all_issues; is_valid = not has_errors }
217
218(** Quick validation - returns true if document is valid *)
219let is_valid gpx =
220 let result = validate_gpx gpx in
221 result.is_valid
222
223(** Get only error messages *)
224let errors gpx =
225 let result = validate_gpx gpx in
226 List.filter (fun issue -> issue.level = `Error) result.issues
227
228(** Get only warning messages *)
229let warnings gpx =
230 let result = validate_gpx gpx in
231 List.filter (fun issue -> issue.level = `Warning) result.issues
232
233(** Format validation issue for display *)
234let format_issue issue =
235 let level_str = match issue.level with
236 | `Error -> "ERROR"
237 | `Warning -> "WARNING"
238 in
239 let location_str = match issue.location with
240 | Some loc -> " at " ^ loc
241 | None -> ""
242 in
243 Printf.sprintf "%s%s: %s" level_str location_str issue.message