···
1
+
(** mlgpx Command Line Interface with pretty ANSI output *)
6
+
(* Terminal and formatting setup *)
7
+
let setup_fmt style_renderer =
8
+
Fmt_tty.setup_std_outputs ?style_renderer ();
11
+
(* Color formatters *)
12
+
let info_style = Fmt.(styled (`Fg `Green))
13
+
let warn_style = Fmt.(styled (`Fg `Yellow))
14
+
let error_style = Fmt.(styled (`Fg `Red))
15
+
let success_style = Fmt.(styled (`Fg `Green))
16
+
let bold_style = Fmt.(styled `Bold)
18
+
(* Logging functions *)
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
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
28
+
let log_success fmt =
29
+
Format.kfprintf (fun fmt -> Format.pp_print_newline fmt (); Format.pp_print_flush fmt ()) Format.std_formatter fmt
31
+
(* Utility functions *)
32
+
let waypoints_to_track_segments waypoints =
33
+
if waypoints = [] then
36
+
let track_points = List.map (fun (wpt : waypoint) -> (wpt :> track_point)) waypoints in
37
+
[{ trkpts = track_points; extensions = [] }]
39
+
let sort_waypoints sort_by_time sort_by_name waypoints =
40
+
if sort_by_time then
41
+
List.sort (fun (wpt1 : waypoint) (wpt2 : waypoint) ->
42
+
match wpt1.time, wpt2.time with
43
+
| Some t1, Some t2 -> Ptime.compare t1 t2
44
+
| Some _, None -> -1
48
+
else if sort_by_name then
49
+
List.sort (fun (wpt1 : waypoint) (wpt2 : waypoint) ->
50
+
match wpt1.name, wpt2.name with
51
+
| Some n1, Some n2 -> String.compare n1 n2
52
+
| Some _, None -> -1
59
+
(* Main conversion command *)
60
+
let convert_waypoints_to_trackset input_file output_file track_name track_desc
61
+
sort_by_time sort_by_name preserve_waypoints verbose style_renderer =
62
+
setup_fmt style_renderer;
65
+
let fs = Eio.Stdenv.fs env in
68
+
log_info "Reading GPX file: %a" (bold_style Fmt.string) input_file;
70
+
(* Read input GPX *)
71
+
let gpx = Gpx_eio.read ~fs input_file in
74
+
log_info "Found %d waypoints and %d existing tracks"
75
+
(List.length gpx.waypoints)
76
+
(List.length gpx.tracks);
78
+
(* Check if we have waypoints to convert *)
79
+
if gpx.waypoints = [] then (
80
+
log_error "Input file contains no waypoints - nothing to convert";
84
+
(* Sort waypoints if requested *)
85
+
let sorted_waypoints = sort_waypoints sort_by_time sort_by_name gpx.waypoints in
87
+
if verbose && (sort_by_time || sort_by_name) then
88
+
log_info "Sorted %d waypoints" (List.length sorted_waypoints);
90
+
(* Convert waypoints to track segments *)
91
+
let track_segments = waypoints_to_track_segments sorted_waypoints in
93
+
(* Create the new track *)
95
+
name = Some track_name;
96
+
cmt = Some "Generated from waypoints by mlgpx CLI";
101
+
type_ = Some "converted";
103
+
trksegs = track_segments;
107
+
let total_points = List.fold_left (fun acc seg -> acc + List.length seg.trkpts) 0 track_segments in
108
+
log_info "Created track %a with %d segments containing %d points"
109
+
(bold_style Fmt.string) track_name
110
+
(List.length track_segments) total_points
113
+
(* Build output GPX *)
116
+
waypoints = (if preserve_waypoints then gpx.waypoints else []);
117
+
tracks = new_track :: gpx.tracks;
118
+
metadata = (match gpx.metadata with
119
+
| Some meta -> Some { meta with
120
+
desc = Some (match meta.desc with
121
+
| Some existing -> existing ^ " (waypoints converted to track)"
122
+
| None -> "Waypoints converted to track") }
123
+
| None -> Some { empty_metadata with
124
+
desc = Some "Waypoints converted to track";
128
+
(* Validate output *)
129
+
let validation = validate_gpx output_gpx in
130
+
if not validation.is_valid then (
131
+
log_error "Generated GPX failed validation:";
132
+
List.iter (fun issue ->
133
+
let level_str = match issue.level with `Error -> "ERROR" | `Warning -> "WARNING" in
134
+
let level_color = match issue.level with `Error -> error_style | `Warning -> warn_style in
135
+
Fmt.pf Format.err_formatter " %a: %s\n" (level_color Fmt.string) level_str issue.message
136
+
) validation.issues;
141
+
log_info "Writing output to: %a" (bold_style Fmt.string) output_file;
143
+
(* Write output GPX *)
144
+
Gpx_eio.write ~fs output_file output_gpx;
147
+
Fmt.pf Format.std_formatter "%a\n" (success_style Fmt.string) "Conversion completed successfully!";
148
+
log_info "Output contains:";
149
+
Fmt.pf Format.err_formatter " - %d waypoints%s\n"
150
+
(List.length output_gpx.waypoints)
151
+
(if preserve_waypoints then " (preserved)" else " (removed)");
152
+
Fmt.pf Format.err_formatter " - %d tracks (%a + %d existing)\n"
153
+
(List.length output_gpx.tracks)
154
+
(success_style Fmt.string) "1 new"
155
+
(List.length gpx.tracks)
157
+
log_success "Converted %d waypoints to track: %a → %a"
158
+
(List.length sorted_waypoints)
159
+
(bold_style Fmt.string) input_file
160
+
(bold_style Fmt.string) output_file
164
+
| Gpx.Gpx_error err ->
165
+
log_error "GPX Error: %s" (match err with
166
+
| Invalid_xml s -> "Invalid XML: " ^ s
167
+
| Invalid_coordinate s -> "Invalid coordinate: " ^ s
168
+
| Missing_required_attribute (elem, attr) ->
169
+
Printf.sprintf "Missing attribute %s in %s" attr elem
170
+
| Missing_required_element s -> "Missing element: " ^ s
171
+
| Validation_error s -> "Validation error: " ^ s
172
+
| Xml_error s -> "XML error: " ^ s
173
+
| IO_error s -> "I/O error: " ^ s);
176
+
log_error "System error: %s" msg;
179
+
log_error "Unexpected error: %s" (Printexc.to_string exn);
184
+
(* Helper function to collect all timestamps from GPX *)
185
+
let collect_all_timestamps gpx =
186
+
let times = ref [] in
188
+
(* Collect from waypoints *)
189
+
List.iter (fun (wpt : waypoint) ->
190
+
match wpt.time with
191
+
| Some t -> times := t :: !times
195
+
(* Collect from routes *)
196
+
List.iter (fun route ->
197
+
List.iter (fun (rtept : route_point) ->
198
+
match rtept.time with
199
+
| Some t -> times := t :: !times
204
+
(* Collect from tracks *)
205
+
List.iter (fun track ->
206
+
List.iter (fun seg ->
207
+
List.iter (fun (trkpt : track_point) ->
208
+
match trkpt.time with
209
+
| Some t -> times := t :: !times
218
+
let info_command input_file verbose style_renderer =
219
+
setup_fmt style_renderer;
222
+
let fs = Eio.Stdenv.fs env in
225
+
log_info "Analyzing GPX file: %a" (bold_style Fmt.string) input_file;
227
+
let gpx = Gpx_eio.read ~fs input_file in
230
+
Fmt.pf Format.std_formatter "%a\n" (bold_style Fmt.string) "GPX File Information";
233
+
Printf.printf " Version: %s\n" gpx.version;
234
+
Printf.printf " Creator: %s\n" gpx.creator;
236
+
(match gpx.metadata with
238
+
Printf.printf " Name: %s\n" (Option.value meta.name ~default:"<unnamed>");
239
+
Printf.printf " Description: %s\n" (Option.value meta.desc ~default:"<none>");
240
+
(match meta.time with
241
+
| Some time -> Printf.printf " Created: %s\n" (Ptime.to_rfc3339 time)
244
+
Printf.printf " No metadata\n");
246
+
(* Content summary *)
247
+
Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Content Summary";
248
+
Printf.printf " Waypoints: %d\n" (List.length gpx.waypoints);
249
+
Printf.printf " Routes: %d\n" (List.length gpx.routes);
250
+
Printf.printf " Tracks: %d\n" (List.length gpx.tracks);
253
+
let all_times = collect_all_timestamps gpx in
254
+
if all_times <> [] then (
255
+
let sorted_times = List.sort Ptime.compare all_times in
256
+
let start_time = List.hd sorted_times in
257
+
let stop_time = List.hd (List.rev sorted_times) in
259
+
Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Time Range";
260
+
Fmt.pf Format.std_formatter " Start: %a\n" (info_style Fmt.string) (Ptime.to_rfc3339 start_time);
261
+
Fmt.pf Format.std_formatter " Stop: %a\n" (info_style Fmt.string) (Ptime.to_rfc3339 stop_time);
263
+
(* Calculate duration *)
264
+
let duration_span = Ptime.diff stop_time start_time in
265
+
match Ptime.Span.to_int_s duration_span with
267
+
let days = seconds / 86400 in
268
+
let hours = (seconds mod 86400) / 3600 in
269
+
let minutes = (seconds mod 3600) / 60 in
272
+
Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
273
+
(Printf.sprintf "%d days, %d hours, %d minutes" days hours minutes)
274
+
else if hours > 0 then
275
+
Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
276
+
(Printf.sprintf "%d hours, %d minutes" hours minutes)
278
+
Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
279
+
(Printf.sprintf "%d minutes" minutes)
281
+
(* Duration too large to represent as int *)
282
+
Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
283
+
(Printf.sprintf "%.1f days" (Ptime.Span.to_float_s duration_span /. 86400.));
285
+
Printf.printf " Total points with timestamps: %d\n" (List.length all_times)
288
+
(* Detailed waypoint info *)
289
+
if gpx.waypoints <> [] then (
290
+
Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Waypoints";
291
+
let waypoints_with_time = List.filter (fun (wpt : waypoint) -> wpt.time <> None) gpx.waypoints in
292
+
let waypoints_with_elevation = List.filter (fun (wpt : waypoint) -> wpt.ele <> None) gpx.waypoints in
293
+
Printf.printf " - %d with timestamps\n" (List.length waypoints_with_time);
294
+
Printf.printf " - %d with elevation data\n" (List.length waypoints_with_elevation);
296
+
if verbose && List.length gpx.waypoints <= 10 then (
297
+
Printf.printf " Details:\n";
298
+
List.iteri (fun i (wpt : waypoint) ->
299
+
Fmt.pf Format.std_formatter " %a %s (%.6f, %.6f)%s%s\n"
300
+
(info_style Fmt.string) (Printf.sprintf "%d." (i + 1))
301
+
(Option.value wpt.name ~default:"<unnamed>")
302
+
(latitude_to_float wpt.lat) (longitude_to_float wpt.lon)
303
+
(match wpt.ele with Some e -> Printf.sprintf " elev=%.1fm" e | None -> "")
304
+
(match wpt.time with Some t -> " @" ^ Ptime.to_rfc3339 t | None -> "")
310
+
if gpx.tracks <> [] then (
311
+
Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Tracks";
312
+
List.iteri (fun i track ->
313
+
let total_points = List.fold_left (fun acc seg -> acc + List.length seg.trkpts) 0 track.trksegs in
314
+
Fmt.pf Format.std_formatter " %a %s (%d segments, %d points)\n"
315
+
(info_style Fmt.string) (Printf.sprintf "%d." (i + 1))
316
+
(Option.value track.name ~default:"<unnamed>")
317
+
(List.length track.trksegs) total_points
322
+
let validation = validate_gpx gpx in
323
+
Printf.printf "\n";
324
+
if validation.is_valid then
325
+
Fmt.pf Format.std_formatter "Validation: %a\n" (success_style Fmt.string) "PASSED"
327
+
Fmt.pf Format.std_formatter "Validation: %a\n" (error_style Fmt.string) "FAILED";
328
+
List.iter (fun issue ->
329
+
let level_str = match issue.level with `Error -> "ERROR" | `Warning -> "WARNING" in
330
+
let level_color = match issue.level with `Error -> error_style | `Warning -> warn_style in
331
+
Fmt.pf Format.std_formatter " %a: %s\n" (level_color Fmt.string) level_str issue.message
332
+
) validation.issues
336
+
| Gpx.Gpx_error err ->
337
+
log_error "GPX Error: %s" (match err with
338
+
| Invalid_xml s -> "Invalid XML: " ^ s
339
+
| Invalid_coordinate s -> "Invalid coordinate: " ^ s
340
+
| Missing_required_attribute (elem, attr) ->
341
+
Printf.sprintf "Missing attribute %s in %s" attr elem
342
+
| Missing_required_element s -> "Missing element: " ^ s
343
+
| Validation_error s -> "Validation error: " ^ s
344
+
| Xml_error s -> "XML error: " ^ s
345
+
| IO_error s -> "I/O error: " ^ s);
348
+
log_error "System error: %s" msg;
351
+
log_error "Unexpected error: %s" (Printexc.to_string exn);
356
+
(* CLI argument definitions *)
357
+
let input_file_arg =
358
+
let doc = "Input GPX file path" in
359
+
Arg.(required & pos 0 (some non_dir_file) None & info [] ~docv:"INPUT" ~doc)
361
+
let output_file_arg =
362
+
let doc = "Output GPX file path" in
363
+
Arg.(required & pos 1 (some string) None & info [] ~docv:"OUTPUT" ~doc)
365
+
let track_name_opt =
366
+
let doc = "Name for the generated track (default: \"Converted from waypoints\")" in
367
+
Arg.(value & opt string "Converted from waypoints" & info ["n"; "name"] ~docv:"NAME" ~doc)
369
+
let track_description_opt =
370
+
let doc = "Description for the generated track" in
371
+
Arg.(value & opt (some string) None & info ["d"; "desc"] ~docv:"DESC" ~doc)
373
+
let sort_by_time_flag =
374
+
let doc = "Sort waypoints by timestamp before conversion" in
375
+
Arg.(value & flag & info ["t"; "sort-time"] ~doc)
377
+
let sort_by_name_flag =
378
+
let doc = "Sort waypoints by name before conversion" in
379
+
Arg.(value & flag & info ["sort-name"] ~doc)
381
+
let preserve_waypoints_flag =
382
+
let doc = "Keep original waypoints in addition to generated track" in
383
+
Arg.(value & flag & info ["p"; "preserve"] ~doc)
386
+
let doc = "Enable verbose output" in
387
+
Arg.(value & flag & info ["v"; "verbose"] ~doc)
389
+
(* Command definitions *)
391
+
let doc = "Convert waypoints to trackset" in
393
+
`S Manpage.s_description;
394
+
`P "Convert all waypoints in a GPX file to a single track. This is useful for \
395
+
converting a collection of waypoints into a navigable route or for \
396
+
consolidating GPS data.";
397
+
`P "The conversion preserves all waypoint data (coordinates, elevation, \
398
+
timestamps, etc.) in the track points. By default, waypoints are removed \
399
+
from the output file unless --preserve is used.";
400
+
`S Manpage.s_examples;
401
+
`P "Convert waypoints to track:";
402
+
`Pre " mlgpx convert waypoints.gpx track.gpx";
403
+
`P "Convert with custom track name and preserve original waypoints:";
404
+
`Pre " mlgpx convert -n \"My Route\" --preserve waypoints.gpx route.gpx";
405
+
`P "Sort waypoints by timestamp before conversion:";
406
+
`Pre " mlgpx convert --sort-time waypoints.gpx sorted_track.gpx";
408
+
let term = Term.(const convert_waypoints_to_trackset $ input_file_arg $ output_file_arg
409
+
$ track_name_opt $ track_description_opt $ sort_by_time_flag
410
+
$ sort_by_name_flag $ preserve_waypoints_flag $ verbose_flag
411
+
$ Fmt_cli.style_renderer ()) in
412
+
Cmd.v (Cmd.info "convert" ~doc ~man) term
415
+
let doc = "Display information about a GPX file" in
417
+
`S Manpage.s_description;
418
+
`P "Analyze and display detailed information about a GPX file including \
419
+
statistics, content summary, and validation results.";
420
+
`P "This command is useful for understanding the structure and content \
421
+
of GPX files before processing them.";
422
+
`S Manpage.s_examples;
423
+
`P "Show basic information:";
424
+
`Pre " mlgpx info file.gpx";
425
+
`P "Show detailed information with waypoint details:";
426
+
`Pre " mlgpx info -v file.gpx";
429
+
let doc = "GPX file to analyze" in
430
+
Arg.(required & pos 0 (some non_dir_file) None & info [] ~docv:"FILE" ~doc) in
431
+
let term = Term.(const info_command $ input_arg $ verbose_flag
432
+
$ Fmt_cli.style_renderer ()) in
433
+
Cmd.v (Cmd.info "info" ~doc ~man) term
437
+
let doc = "mlgpx - GPX file manipulation toolkit" in
439
+
`S Manpage.s_description;
440
+
`P "mlgpx is a command-line toolkit for working with GPX (GPS Exchange Format) \
441
+
files. It provides tools for converting, analyzing, and manipulating GPS data.";
442
+
`S Manpage.s_commands;
443
+
`P "Available commands:";
444
+
`P "$(b,convert) - Convert waypoints to trackset";
445
+
`P "$(b,info) - Display GPX file information";
446
+
`S Manpage.s_common_options;
447
+
`P "$(b,--verbose), $(b,-v) - Enable verbose output";
448
+
`P "$(b,--color)={auto|always|never} - Control ANSI color output";
449
+
`P "$(b,--help) - Show command help";
450
+
`S Manpage.s_examples;
451
+
`P "Convert waypoints to track:";
452
+
`Pre " mlgpx convert waypoints.gpx track.gpx";
453
+
`P "Analyze a GPX file with colors:";
454
+
`Pre " mlgpx info --verbose --color=always file.gpx";
455
+
`P "Convert without colors for scripts:";
456
+
`Pre " mlgpx convert --color=never waypoints.gpx track.gpx";
458
+
`P "Report bugs at https://github.com/avsm/mlgpx/issues";
460
+
let default_term = Term.(ret (const (`Help (`Pager, None)))) in
461
+
Cmd.group (Cmd.info "mlgpx" ~version:"0.1.0" ~doc ~man) ~default:default_term
462
+
[convert_cmd; info_cmd]
465
+
Printexc.record_backtrace true;
466
+
exit (Cmd.eval main_cmd)
anil.recoil.org