GPS Exchange Format library/CLI in OCaml
anil.recoil.org
1(** mlgpx Command Line Interface with pretty ANSI output *)
2
3open Cmdliner
4open Gpx
5
6(* Terminal and formatting setup *)
7let setup_fmt style_renderer =
8 Fmt_tty.setup_std_outputs ?style_renderer ();
9 ()
10
11(* Color formatters *)
12let info_style = Fmt.(styled (`Fg `Green))
13let warn_style = Fmt.(styled (`Fg `Yellow))
14let error_style = Fmt.(styled (`Fg `Red))
15let success_style = Fmt.(styled (`Fg `Green))
16let bold_style = Fmt.(styled `Bold)
17
18(* Logging functions *)
19let log_info fmt =
20 Fmt.pf Format.err_formatter "[%a] " (info_style Fmt.string) "INFO";
21 Format.kfprintf (fun fmt -> Format.pp_print_newline fmt (); Format.pp_print_flush fmt ()) Format.err_formatter fmt
22
23
24let log_error fmt =
25 Fmt.pf Format.err_formatter "[%a] " (error_style Fmt.string) "ERROR";
26 Format.kfprintf (fun fmt -> Format.pp_print_newline fmt (); Format.pp_print_flush fmt ()) Format.err_formatter fmt
27
28let log_success fmt =
29 Format.kfprintf (fun fmt -> Format.pp_print_newline fmt (); Format.pp_print_flush fmt ()) Format.std_formatter fmt
30
31(* Utility functions *)
32let waypoints_to_track_segments waypoints =
33 if waypoints = [] then
34 []
35 else
36 Track.Segment.make waypoints :: []
37
38let sort_waypoints sort_by_time sort_by_name waypoints =
39 if sort_by_time then
40 List.sort (fun wpt1 wpt2 ->
41 match Waypoint.time wpt1, Waypoint.time wpt2 with
42 | Some t1, Some t2 -> Ptime.compare t1 t2
43 | Some _, None -> -1
44 | None, Some _ -> 1
45 | None, None -> 0
46 ) waypoints
47 else if sort_by_name then
48 List.sort (fun wpt1 wpt2 ->
49 match Waypoint.name wpt1, Waypoint.name wpt2 with
50 | Some n1, Some n2 -> String.compare n1 n2
51 | Some _, None -> -1
52 | None, Some _ -> 1
53 | None, None -> 0
54 ) waypoints
55 else
56 waypoints
57
58(* Main conversion command *)
59let convert_waypoints_to_trackset input_file output_file track_name track_desc
60 sort_by_time sort_by_name preserve_waypoints verbose style_renderer =
61 setup_fmt style_renderer;
62 let run env =
63 try
64 let fs = Eio.Stdenv.fs env in
65
66 if verbose then
67 log_info "Reading GPX file: %a" (bold_style Fmt.string) input_file;
68
69 (* Read input GPX *)
70 let gpx = Gpx_eio.read ~fs input_file in
71
72 if verbose then
73 log_info "Found %d waypoints and %d existing tracks"
74 (Doc.waypoint_count gpx)
75 (Doc.track_count gpx);
76
77 (* Check if we have waypoints to convert *)
78 if Doc.waypoints gpx = [] then (
79 log_error "Input file contains no waypoints - nothing to convert";
80 exit 1
81 );
82
83 (* Sort waypoints if requested *)
84 let sorted_waypoints = sort_waypoints sort_by_time sort_by_name (Doc.waypoints gpx) in
85
86 if verbose && (sort_by_time || sort_by_name) then
87 log_info "Sorted %d waypoints" (List.length sorted_waypoints);
88
89 (* Convert waypoints to track segments *)
90 let track_segments = waypoints_to_track_segments sorted_waypoints in
91
92 (* Create the new track *)
93 let new_track = Track.make ~name:track_name in
94 let new_track = { new_track with
95 cmt = Some "Generated from waypoints by mlgpx CLI";
96 desc = track_desc;
97 src = Some "mlgpx";
98 type_ = Some "converted";
99 trksegs = track_segments;
100 } in
101
102 if verbose then (
103 let total_points = List.fold_left (fun acc seg -> acc + Track.Segment.point_count seg) 0 track_segments in
104 log_info "Created track %a with %d segments containing %d points"
105 (bold_style Fmt.string) track_name
106 (List.length track_segments) total_points
107 );
108
109 (* Build output GPX *)
110 let output_gpx =
111 if preserve_waypoints then
112 Doc.add_track gpx new_track
113 else
114 Doc.add_track (Doc.clear_waypoints gpx) new_track in
115 let output_gpx =
116 match Doc.metadata gpx with
117 | Some meta ->
118 let desc = match Metadata.description meta with
119 | Some existing -> existing ^ " (waypoints converted to track)"
120 | None -> "Waypoints converted to track" in
121 Doc.with_metadata output_gpx { meta with desc = Some desc }
122 | None ->
123 let meta = Metadata.make ~name:"Converted" in
124 let meta = { meta with desc = Some "Waypoints converted to track" } in
125 Doc.with_metadata output_gpx meta in
126
127 (* Validate output *)
128 let validation = Gpx.validate_gpx output_gpx in
129 if not validation.is_valid then (
130 log_error "Generated GPX failed validation:";
131 List.iter (fun (issue : Gpx.validation_issue) ->
132 let level_str = match issue.level with `Error -> "ERROR" | `Warning -> "WARNING" in
133 let level_color = match issue.level with `Error -> error_style | `Warning -> warn_style in
134 Fmt.pf Format.err_formatter " %a: %s\n" (level_color Fmt.string) level_str issue.message
135 ) validation.issues;
136 exit 1
137 );
138
139 if verbose then
140 log_info "Writing output to: %a" (bold_style Fmt.string) output_file;
141
142 (* Write output GPX *)
143 Gpx_eio.write ~fs output_file output_gpx;
144
145 if verbose then (
146 Fmt.pf Format.std_formatter "%a\n" (success_style Fmt.string) "Conversion completed successfully!";
147 log_info "Output contains:";
148 Fmt.pf Format.err_formatter " - %d waypoints%s\n"
149 (Doc.waypoint_count output_gpx)
150 (if preserve_waypoints then " (preserved)" else " (removed)");
151 Fmt.pf Format.err_formatter " - %d tracks (%a + %d existing)\n"
152 (Doc.track_count output_gpx)
153 (success_style Fmt.string) "1 new"
154 (Doc.track_count gpx)
155 ) else (
156 log_success "Converted %d waypoints to track: %a → %a"
157 (List.length sorted_waypoints)
158 (bold_style Fmt.string) input_file
159 (bold_style Fmt.string) output_file
160 )
161
162 with
163 | Gpx.Gpx_error err ->
164 log_error "GPX Error: %s" (Error.to_string err);
165 exit 2
166 | Sys_error msg ->
167 log_error "System error: %s" msg;
168 exit 2
169 | exn ->
170 log_error "Unexpected error: %s" (Printexc.to_string exn);
171 exit 2
172 in
173 Eio_main.run run
174
175(* Helper function to collect all timestamps from GPX *)
176let collect_all_timestamps gpx =
177 let times = ref [] in
178
179 (* Collect from waypoints *)
180 List.iter (fun wpt ->
181 match Waypoint.time wpt with
182 | Some t -> times := t :: !times
183 | None -> ()
184 ) (Doc.waypoints gpx);
185
186 (* Collect from routes *)
187 List.iter (fun route ->
188 List.iter (fun rtept ->
189 match Waypoint.time rtept with
190 | Some t -> times := t :: !times
191 | None -> ()
192 ) (Route.points route)
193 ) (Doc.routes gpx);
194
195 (* Collect from tracks *)
196 List.iter (fun track ->
197 List.iter (fun seg ->
198 List.iter (fun trkpt ->
199 match Waypoint.time trkpt with
200 | Some t -> times := t :: !times
201 | None -> ()
202 ) (Track.Segment.points seg)
203 ) (Track.segments track)
204 ) (Doc.tracks gpx);
205
206 !times
207
208(* Info command *)
209let info_command input_file verbose style_renderer =
210 setup_fmt style_renderer;
211 let run env =
212 try
213 let fs = Eio.Stdenv.fs env in
214
215 if verbose then
216 log_info "Analyzing GPX file: %a" (bold_style Fmt.string) input_file;
217
218 let gpx = Gpx_eio.read ~fs input_file in
219
220 (* Header *)
221 Fmt.pf Format.std_formatter "%a\n" (bold_style Fmt.string) "GPX File Information";
222
223 (* Basic info *)
224 Printf.printf " Version: %s\n" (Doc.version gpx);
225 Printf.printf " Creator: %s\n" (Doc.creator gpx);
226
227 (match Doc.metadata gpx with
228 | Some meta ->
229 Printf.printf " Name: %s\n" (Option.value (Metadata.name meta) ~default:"<unnamed>");
230 Printf.printf " Description: %s\n" (Option.value (Metadata.description meta) ~default:"<none>");
231 (match Metadata.time meta with
232 | Some time -> Printf.printf " Created: %s\n" (Ptime.to_rfc3339 time)
233 | None -> ())
234 | None ->
235 Printf.printf " No metadata\n");
236
237 (* Content summary *)
238 Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Content Summary";
239 Printf.printf " Waypoints: %d\n" (Doc.waypoint_count gpx);
240 Printf.printf " Routes: %d\n" (Doc.route_count gpx);
241 Printf.printf " Tracks: %d\n" (Doc.track_count gpx);
242
243 (* Time range *)
244 let all_times = collect_all_timestamps gpx in
245 if all_times <> [] then (
246 let sorted_times = List.sort Ptime.compare all_times in
247 let start_time = List.hd sorted_times in
248 let stop_time = List.hd (List.rev sorted_times) in
249
250 Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Time Range";
251 Fmt.pf Format.std_formatter " Start: %a\n" (info_style Fmt.string) (Ptime.to_rfc3339 start_time);
252 Fmt.pf Format.std_formatter " Stop: %a\n" (info_style Fmt.string) (Ptime.to_rfc3339 stop_time);
253
254 (* Calculate duration *)
255 let duration_span = Ptime.diff stop_time start_time in
256 match Ptime.Span.to_int_s duration_span with
257 | Some seconds ->
258 let days = seconds / 86400 in
259 let hours = (seconds mod 86400) / 3600 in
260 let minutes = (seconds mod 3600) / 60 in
261
262 if days > 0 then
263 Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
264 (Printf.sprintf "%d days, %d hours, %d minutes" days hours minutes)
265 else if hours > 0 then
266 Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
267 (Printf.sprintf "%d hours, %d minutes" hours minutes)
268 else
269 Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
270 (Printf.sprintf "%d minutes" minutes)
271 | None ->
272 (* Duration too large to represent as int *)
273 Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
274 (Printf.sprintf "%.1f days" (Ptime.Span.to_float_s duration_span /. 86400.));
275
276 Printf.printf " Total points with timestamps: %d\n" (List.length all_times)
277 );
278
279 (* Detailed waypoint info *)
280 if Doc.waypoints gpx <> [] then (
281 Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Waypoints";
282 let waypoints_with_time = List.filter (fun wpt -> Waypoint.time wpt <> None) (Doc.waypoints gpx) in
283 let waypoints_with_elevation = List.filter (fun wpt -> Waypoint.elevation wpt <> None) (Doc.waypoints gpx) in
284 Printf.printf " - %d with timestamps\n" (List.length waypoints_with_time);
285 Printf.printf " - %d with elevation data\n" (List.length waypoints_with_elevation);
286
287 if verbose && List.length (Doc.waypoints gpx) <= 10 then (
288 Printf.printf " Details:\n";
289 List.iteri (fun i wpt ->
290 let lat, lon = Waypoint.to_floats wpt in
291 Fmt.pf Format.std_formatter " %a %s (%.6f, %.6f)%s%s\n"
292 (info_style Fmt.string) (Printf.sprintf "%d." (i + 1))
293 (Option.value (Waypoint.name wpt) ~default:"<unnamed>")
294 lat lon
295 (match Waypoint.elevation wpt with Some e -> Printf.sprintf " elev=%.1fm" e | None -> "")
296 (match Waypoint.time wpt with Some t -> " @" ^ Ptime.to_rfc3339 t | None -> "")
297 ) (Doc.waypoints gpx)
298 )
299 );
300
301 (* Track info *)
302 if Doc.tracks gpx <> [] then (
303 Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Tracks";
304 List.iteri (fun i track ->
305 let total_points = Track.point_count track in
306 Fmt.pf Format.std_formatter " %a %s (%d segments, %d points)\n"
307 (info_style Fmt.string) (Printf.sprintf "%d." (i + 1))
308 (Option.value (Track.name track) ~default:"<unnamed>")
309 (Track.segment_count track) total_points
310 ) (Doc.tracks gpx)
311 );
312
313 (* Validation *)
314 let validation = Gpx.validate_gpx gpx in
315 Printf.printf "\n";
316 if validation.is_valid then
317 Fmt.pf Format.std_formatter "Validation: %a\n" (success_style Fmt.string) "PASSED"
318 else (
319 Fmt.pf Format.std_formatter "Validation: %a\n" (error_style Fmt.string) "FAILED";
320 List.iter (fun (issue : Gpx.validation_issue) ->
321 let level_str = match issue.level with `Error -> "ERROR" | `Warning -> "WARNING" in
322 let level_color = match issue.level with `Error -> error_style | `Warning -> warn_style in
323 Fmt.pf Format.std_formatter " %a: %s\n" (level_color Fmt.string) level_str issue.message
324 ) validation.issues
325 )
326
327 with
328 | Gpx.Gpx_error err ->
329 log_error "GPX Error: %s" (Error.to_string err);
330 exit 2
331 | Sys_error msg ->
332 log_error "System error: %s" msg;
333 exit 2
334 | exn ->
335 log_error "Unexpected error: %s" (Printexc.to_string exn);
336 exit 2
337 in
338 Eio_main.run run
339
340(* CLI argument definitions *)
341let input_file_arg =
342 let doc = "Input GPX file path" in
343 Arg.(required & pos 0 (some non_dir_file) None & info [] ~docv:"INPUT" ~doc)
344
345let output_file_arg =
346 let doc = "Output GPX file path" in
347 Arg.(required & pos 1 (some string) None & info [] ~docv:"OUTPUT" ~doc)
348
349let track_name_opt =
350 let doc = "Name for the generated track (default: \"Converted from waypoints\")" in
351 Arg.(value & opt string "Converted from waypoints" & info ["n"; "name"] ~docv:"NAME" ~doc)
352
353let track_description_opt =
354 let doc = "Description for the generated track" in
355 Arg.(value & opt (some string) None & info ["d"; "desc"] ~docv:"DESC" ~doc)
356
357let sort_by_time_flag =
358 let doc = "Sort waypoints by timestamp before conversion" in
359 Arg.(value & flag & info ["t"; "sort-time"] ~doc)
360
361let sort_by_name_flag =
362 let doc = "Sort waypoints by name before conversion" in
363 Arg.(value & flag & info ["sort-name"] ~doc)
364
365let preserve_waypoints_flag =
366 let doc = "Keep original waypoints in addition to generated track" in
367 Arg.(value & flag & info ["p"; "preserve"] ~doc)
368
369let verbose_flag =
370 let doc = "Enable verbose output" in
371 Arg.(value & flag & info ["v"; "verbose"] ~doc)
372
373(* Command definitions *)
374let convert_cmd =
375 let doc = "Convert waypoints to trackset" in
376 let man = [
377 `S Manpage.s_description;
378 `P "Convert all waypoints in a GPX file to a single track. This is useful for \
379 converting a collection of waypoints into a navigable route or for \
380 consolidating GPS data.";
381 `P "The conversion preserves all waypoint data (coordinates, elevation, \
382 timestamps, etc.) in the track points. By default, waypoints are removed \
383 from the output file unless --preserve is used.";
384 `S Manpage.s_examples;
385 `P "Convert waypoints to track:";
386 `Pre " mlgpx convert waypoints.gpx track.gpx";
387 `P "Convert with custom track name and preserve original waypoints:";
388 `Pre " mlgpx convert -n \"My Route\" --preserve waypoints.gpx route.gpx";
389 `P "Sort waypoints by timestamp before conversion:";
390 `Pre " mlgpx convert --sort-time waypoints.gpx sorted_track.gpx";
391 ] in
392 let term = Term.(const convert_waypoints_to_trackset $ input_file_arg $ output_file_arg
393 $ track_name_opt $ track_description_opt $ sort_by_time_flag
394 $ sort_by_name_flag $ preserve_waypoints_flag $ verbose_flag
395 $ Fmt_cli.style_renderer ()) in
396 Cmd.v (Cmd.info "convert" ~doc ~man) term
397
398let info_cmd =
399 let doc = "Display information about a GPX file" in
400 let man = [
401 `S Manpage.s_description;
402 `P "Analyze and display detailed information about a GPX file including \
403 statistics, content summary, and validation results.";
404 `P "This command is useful for understanding the structure and content \
405 of GPX files before processing them.";
406 `S Manpage.s_examples;
407 `P "Show basic information:";
408 `Pre " mlgpx info file.gpx";
409 `P "Show detailed information with waypoint details:";
410 `Pre " mlgpx info -v file.gpx";
411 ] in
412 let input_arg =
413 let doc = "GPX file to analyze" in
414 Arg.(required & pos 0 (some non_dir_file) None & info [] ~docv:"FILE" ~doc) in
415 let term = Term.(const info_command $ input_arg $ verbose_flag
416 $ Fmt_cli.style_renderer ()) in
417 Cmd.v (Cmd.info "info" ~doc ~man) term
418
419(* Main CLI *)
420let main_cmd =
421 let doc = "mlgpx - GPX file manipulation toolkit" in
422 let man = [
423 `S Manpage.s_description;
424 `P "mlgpx is a command-line toolkit for working with GPX (GPS Exchange Format) \
425 files. It provides tools for converting, analyzing, and manipulating GPS data.";
426 `S Manpage.s_commands;
427 `P "Available commands:";
428 `P "$(b,convert) - Convert waypoints to trackset";
429 `P "$(b,info) - Display GPX file information";
430 `S Manpage.s_common_options;
431 `P "$(b,--verbose), $(b,-v) - Enable verbose output";
432 `P "$(b,--color)={auto|always|never} - Control ANSI color output";
433 `P "$(b,--help) - Show command help";
434 `S Manpage.s_examples;
435 `P "Convert waypoints to track:";
436 `Pre " mlgpx convert waypoints.gpx track.gpx";
437 `P "Analyze a GPX file with colors:";
438 `Pre " mlgpx info --verbose --color=always file.gpx";
439 `P "Convert without colors for scripts:";
440 `Pre " mlgpx convert --color=never waypoints.gpx track.gpx";
441 `S Manpage.s_bugs;
442 `P "Report bugs at https://github.com/avsm/mlgpx/issues";
443 ] in
444 let default_term = Term.(ret (const (`Help (`Pager, None)))) in
445 Cmd.group (Cmd.info "mlgpx" ~version:"0.1.0" ~doc ~man) ~default:default_term
446 [convert_cmd; info_cmd]
447
448let () =
449 Printexc.record_backtrace true;
450 exit (Cmd.eval main_cmd)