···
+
(** mlgpx Command Line Interface with pretty ANSI output *)
+
(* Terminal and formatting setup *)
+
let setup_fmt style_renderer =
+
Fmt_tty.setup_std_outputs ?style_renderer ();
+
let info_style = Fmt.(styled (`Fg `Green))
+
let warn_style = Fmt.(styled (`Fg `Yellow))
+
let error_style = Fmt.(styled (`Fg `Red))
+
let success_style = Fmt.(styled (`Fg `Green))
+
let bold_style = Fmt.(styled `Bold)
+
(* Logging functions *)
+
Fmt.pf Format.err_formatter "[%a] " (info_style Fmt.string) "INFO";
+
Format.kfprintf (fun fmt -> Format.pp_print_newline fmt (); Format.pp_print_flush fmt ()) Format.err_formatter fmt
+
Fmt.pf Format.err_formatter "[%a] " (error_style Fmt.string) "ERROR";
+
Format.kfprintf (fun fmt -> Format.pp_print_newline fmt (); Format.pp_print_flush fmt ()) Format.err_formatter fmt
+
Format.kfprintf (fun fmt -> Format.pp_print_newline fmt (); Format.pp_print_flush fmt ()) Format.std_formatter fmt
+
(* Utility functions *)
+
let waypoints_to_track_segments waypoints =
+
let track_points = List.map (fun (wpt : waypoint) -> (wpt :> track_point)) waypoints in
+
[{ trkpts = track_points; extensions = [] }]
+
let sort_waypoints sort_by_time sort_by_name waypoints =
+
List.sort (fun (wpt1 : waypoint) (wpt2 : waypoint) ->
+
match wpt1.time, wpt2.time with
+
| Some t1, Some t2 -> Ptime.compare t1 t2
+
else if sort_by_name then
+
List.sort (fun (wpt1 : waypoint) (wpt2 : waypoint) ->
+
match wpt1.name, wpt2.name with
+
| Some n1, Some n2 -> String.compare n1 n2
+
(* Main conversion command *)
+
let convert_waypoints_to_trackset input_file output_file track_name track_desc
+
sort_by_time sort_by_name preserve_waypoints verbose style_renderer =
+
setup_fmt style_renderer;
+
let fs = Eio.Stdenv.fs env in
+
log_info "Reading GPX file: %a" (bold_style Fmt.string) input_file;
+
let gpx = Gpx_eio.read ~fs input_file in
+
log_info "Found %d waypoints and %d existing tracks"
+
(List.length gpx.waypoints)
+
(List.length gpx.tracks);
+
(* Check if we have waypoints to convert *)
+
if gpx.waypoints = [] then (
+
log_error "Input file contains no waypoints - nothing to convert";
+
(* Sort waypoints if requested *)
+
let sorted_waypoints = sort_waypoints sort_by_time sort_by_name gpx.waypoints in
+
if verbose && (sort_by_time || sort_by_name) then
+
log_info "Sorted %d waypoints" (List.length sorted_waypoints);
+
(* Convert waypoints to track segments *)
+
let track_segments = waypoints_to_track_segments sorted_waypoints in
+
(* Create the new track *)
+
name = Some track_name;
+
cmt = Some "Generated from waypoints by mlgpx CLI";
+
type_ = Some "converted";
+
trksegs = track_segments;
+
let total_points = List.fold_left (fun acc seg -> acc + List.length seg.trkpts) 0 track_segments in
+
log_info "Created track %a with %d segments containing %d points"
+
(bold_style Fmt.string) track_name
+
(List.length track_segments) total_points
+
waypoints = (if preserve_waypoints then gpx.waypoints else []);
+
tracks = new_track :: gpx.tracks;
+
metadata = (match gpx.metadata with
+
| Some meta -> Some { meta with
+
desc = Some (match meta.desc with
+
| Some existing -> existing ^ " (waypoints converted to track)"
+
| None -> "Waypoints converted to track") }
+
| None -> Some { empty_metadata with
+
desc = Some "Waypoints converted to track";
+
let validation = validate_gpx output_gpx in
+
if not validation.is_valid then (
+
log_error "Generated GPX failed validation:";
+
List.iter (fun issue ->
+
let level_str = match issue.level with `Error -> "ERROR" | `Warning -> "WARNING" in
+
let level_color = match issue.level with `Error -> error_style | `Warning -> warn_style in
+
Fmt.pf Format.err_formatter " %a: %s\n" (level_color Fmt.string) level_str issue.message
+
log_info "Writing output to: %a" (bold_style Fmt.string) output_file;
+
Gpx_eio.write ~fs output_file output_gpx;
+
Fmt.pf Format.std_formatter "%a\n" (success_style Fmt.string) "Conversion completed successfully!";
+
log_info "Output contains:";
+
Fmt.pf Format.err_formatter " - %d waypoints%s\n"
+
(List.length output_gpx.waypoints)
+
(if preserve_waypoints then " (preserved)" else " (removed)");
+
Fmt.pf Format.err_formatter " - %d tracks (%a + %d existing)\n"
+
(List.length output_gpx.tracks)
+
(success_style Fmt.string) "1 new"
+
(List.length gpx.tracks)
+
log_success "Converted %d waypoints to track: %a → %a"
+
(List.length sorted_waypoints)
+
(bold_style Fmt.string) input_file
+
(bold_style Fmt.string) output_file
+
log_error "GPX Error: %s" (match err with
+
| Invalid_xml s -> "Invalid XML: " ^ s
+
| Invalid_coordinate s -> "Invalid coordinate: " ^ s
+
| Missing_required_attribute (elem, attr) ->
+
Printf.sprintf "Missing attribute %s in %s" attr elem
+
| Missing_required_element s -> "Missing element: " ^ s
+
| Validation_error s -> "Validation error: " ^ s
+
| Xml_error s -> "XML error: " ^ s
+
| IO_error s -> "I/O error: " ^ s);
+
log_error "System error: %s" msg;
+
log_error "Unexpected error: %s" (Printexc.to_string exn);
+
(* Helper function to collect all timestamps from GPX *)
+
let collect_all_timestamps gpx =
+
(* Collect from waypoints *)
+
List.iter (fun (wpt : waypoint) ->
+
| Some t -> times := t :: !times
+
(* Collect from routes *)
+
List.iter (fun route ->
+
List.iter (fun (rtept : route_point) ->
+
| Some t -> times := t :: !times
+
(* Collect from tracks *)
+
List.iter (fun track ->
+
List.iter (fun (trkpt : track_point) ->
+
| Some t -> times := t :: !times
+
let info_command input_file verbose style_renderer =
+
setup_fmt style_renderer;
+
let fs = Eio.Stdenv.fs env in
+
log_info "Analyzing GPX file: %a" (bold_style Fmt.string) input_file;
+
let gpx = Gpx_eio.read ~fs input_file in
+
Fmt.pf Format.std_formatter "%a\n" (bold_style Fmt.string) "GPX File Information";
+
Printf.printf " Version: %s\n" gpx.version;
+
Printf.printf " Creator: %s\n" gpx.creator;
+
(match gpx.metadata with
+
Printf.printf " Name: %s\n" (Option.value meta.name ~default:"<unnamed>");
+
Printf.printf " Description: %s\n" (Option.value meta.desc ~default:"<none>");
+
| Some time -> Printf.printf " Created: %s\n" (Ptime.to_rfc3339 time)
+
Printf.printf " No metadata\n");
+
Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Content Summary";
+
Printf.printf " Waypoints: %d\n" (List.length gpx.waypoints);
+
Printf.printf " Routes: %d\n" (List.length gpx.routes);
+
Printf.printf " Tracks: %d\n" (List.length gpx.tracks);
+
let all_times = collect_all_timestamps gpx in
+
if all_times <> [] then (
+
let sorted_times = List.sort Ptime.compare all_times in
+
let start_time = List.hd sorted_times in
+
let stop_time = List.hd (List.rev sorted_times) in
+
Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Time Range";
+
Fmt.pf Format.std_formatter " Start: %a\n" (info_style Fmt.string) (Ptime.to_rfc3339 start_time);
+
Fmt.pf Format.std_formatter " Stop: %a\n" (info_style Fmt.string) (Ptime.to_rfc3339 stop_time);
+
(* Calculate duration *)
+
let duration_span = Ptime.diff stop_time start_time in
+
match Ptime.Span.to_int_s duration_span with
+
let days = seconds / 86400 in
+
let hours = (seconds mod 86400) / 3600 in
+
let minutes = (seconds mod 3600) / 60 in
+
Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
+
(Printf.sprintf "%d days, %d hours, %d minutes" days hours minutes)
+
Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
+
(Printf.sprintf "%d hours, %d minutes" hours minutes)
+
Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
+
(Printf.sprintf "%d minutes" minutes)
+
(* Duration too large to represent as int *)
+
Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
+
(Printf.sprintf "%.1f days" (Ptime.Span.to_float_s duration_span /. 86400.));
+
Printf.printf " Total points with timestamps: %d\n" (List.length all_times)
+
(* Detailed waypoint info *)
+
if gpx.waypoints <> [] then (
+
Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Waypoints";
+
let waypoints_with_time = List.filter (fun (wpt : waypoint) -> wpt.time <> None) gpx.waypoints in
+
let waypoints_with_elevation = List.filter (fun (wpt : waypoint) -> wpt.ele <> None) gpx.waypoints in
+
Printf.printf " - %d with timestamps\n" (List.length waypoints_with_time);
+
Printf.printf " - %d with elevation data\n" (List.length waypoints_with_elevation);
+
if verbose && List.length gpx.waypoints <= 10 then (
+
Printf.printf " Details:\n";
+
List.iteri (fun i (wpt : waypoint) ->
+
Fmt.pf Format.std_formatter " %a %s (%.6f, %.6f)%s%s\n"
+
(info_style Fmt.string) (Printf.sprintf "%d." (i + 1))
+
(Option.value wpt.name ~default:"<unnamed>")
+
(latitude_to_float wpt.lat) (longitude_to_float wpt.lon)
+
(match wpt.ele with Some e -> Printf.sprintf " elev=%.1fm" e | None -> "")
+
(match wpt.time with Some t -> " @" ^ Ptime.to_rfc3339 t | None -> "")
+
if gpx.tracks <> [] then (
+
Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Tracks";
+
List.iteri (fun i track ->
+
let total_points = List.fold_left (fun acc seg -> acc + List.length seg.trkpts) 0 track.trksegs in
+
Fmt.pf Format.std_formatter " %a %s (%d segments, %d points)\n"
+
(info_style Fmt.string) (Printf.sprintf "%d." (i + 1))
+
(Option.value track.name ~default:"<unnamed>")
+
(List.length track.trksegs) total_points
+
let validation = validate_gpx gpx in
+
if validation.is_valid then
+
Fmt.pf Format.std_formatter "Validation: %a\n" (success_style Fmt.string) "PASSED"
+
Fmt.pf Format.std_formatter "Validation: %a\n" (error_style Fmt.string) "FAILED";
+
List.iter (fun issue ->
+
let level_str = match issue.level with `Error -> "ERROR" | `Warning -> "WARNING" in
+
let level_color = match issue.level with `Error -> error_style | `Warning -> warn_style in
+
Fmt.pf Format.std_formatter " %a: %s\n" (level_color Fmt.string) level_str issue.message
+
log_error "GPX Error: %s" (match err with
+
| Invalid_xml s -> "Invalid XML: " ^ s
+
| Invalid_coordinate s -> "Invalid coordinate: " ^ s
+
| Missing_required_attribute (elem, attr) ->
+
Printf.sprintf "Missing attribute %s in %s" attr elem
+
| Missing_required_element s -> "Missing element: " ^ s
+
| Validation_error s -> "Validation error: " ^ s
+
| Xml_error s -> "XML error: " ^ s
+
| IO_error s -> "I/O error: " ^ s);
+
log_error "System error: %s" msg;
+
log_error "Unexpected error: %s" (Printexc.to_string exn);
+
(* CLI argument definitions *)
+
let doc = "Input GPX file path" in
+
Arg.(required & pos 0 (some non_dir_file) None & info [] ~docv:"INPUT" ~doc)
+
let doc = "Output GPX file path" in
+
Arg.(required & pos 1 (some string) None & info [] ~docv:"OUTPUT" ~doc)
+
let doc = "Name for the generated track (default: \"Converted from waypoints\")" in
+
Arg.(value & opt string "Converted from waypoints" & info ["n"; "name"] ~docv:"NAME" ~doc)
+
let track_description_opt =
+
let doc = "Description for the generated track" in
+
Arg.(value & opt (some string) None & info ["d"; "desc"] ~docv:"DESC" ~doc)
+
let sort_by_time_flag =
+
let doc = "Sort waypoints by timestamp before conversion" in
+
Arg.(value & flag & info ["t"; "sort-time"] ~doc)
+
let sort_by_name_flag =
+
let doc = "Sort waypoints by name before conversion" in
+
Arg.(value & flag & info ["sort-name"] ~doc)
+
let preserve_waypoints_flag =
+
let doc = "Keep original waypoints in addition to generated track" in
+
Arg.(value & flag & info ["p"; "preserve"] ~doc)
+
let doc = "Enable verbose output" in
+
Arg.(value & flag & info ["v"; "verbose"] ~doc)
+
(* Command definitions *)
+
let doc = "Convert waypoints to trackset" in
+
`S Manpage.s_description;
+
`P "Convert all waypoints in a GPX file to a single track. This is useful for \
+
converting a collection of waypoints into a navigable route or for \
+
consolidating GPS data.";
+
`P "The conversion preserves all waypoint data (coordinates, elevation, \
+
timestamps, etc.) in the track points. By default, waypoints are removed \
+
from the output file unless --preserve is used.";
+
`P "Convert waypoints to track:";
+
`Pre " mlgpx convert waypoints.gpx track.gpx";
+
`P "Convert with custom track name and preserve original waypoints:";
+
`Pre " mlgpx convert -n \"My Route\" --preserve waypoints.gpx route.gpx";
+
`P "Sort waypoints by timestamp before conversion:";
+
`Pre " mlgpx convert --sort-time waypoints.gpx sorted_track.gpx";
+
let term = Term.(const convert_waypoints_to_trackset $ input_file_arg $ output_file_arg
+
$ track_name_opt $ track_description_opt $ sort_by_time_flag
+
$ sort_by_name_flag $ preserve_waypoints_flag $ verbose_flag
+
$ Fmt_cli.style_renderer ()) in
+
Cmd.v (Cmd.info "convert" ~doc ~man) term
+
let doc = "Display information about a GPX file" in
+
`S Manpage.s_description;
+
`P "Analyze and display detailed information about a GPX file including \
+
statistics, content summary, and validation results.";
+
`P "This command is useful for understanding the structure and content \
+
of GPX files before processing them.";
+
`P "Show basic information:";
+
`Pre " mlgpx info file.gpx";
+
`P "Show detailed information with waypoint details:";
+
`Pre " mlgpx info -v file.gpx";
+
let doc = "GPX file to analyze" in
+
Arg.(required & pos 0 (some non_dir_file) None & info [] ~docv:"FILE" ~doc) in
+
let term = Term.(const info_command $ input_arg $ verbose_flag
+
$ Fmt_cli.style_renderer ()) in
+
Cmd.v (Cmd.info "info" ~doc ~man) term
+
let doc = "mlgpx - GPX file manipulation toolkit" in
+
`S Manpage.s_description;
+
`P "mlgpx is a command-line toolkit for working with GPX (GPS Exchange Format) \
+
files. It provides tools for converting, analyzing, and manipulating GPS data.";
+
`P "Available commands:";
+
`P "$(b,convert) - Convert waypoints to trackset";
+
`P "$(b,info) - Display GPX file information";
+
`S Manpage.s_common_options;
+
`P "$(b,--verbose), $(b,-v) - Enable verbose output";
+
`P "$(b,--color)={auto|always|never} - Control ANSI color output";
+
`P "$(b,--help) - Show command help";
+
`P "Convert waypoints to track:";
+
`Pre " mlgpx convert waypoints.gpx track.gpx";
+
`P "Analyze a GPX file with colors:";
+
`Pre " mlgpx info --verbose --color=always file.gpx";
+
`P "Convert without colors for scripts:";
+
`Pre " mlgpx convert --color=never waypoints.gpx track.gpx";
+
`P "Report bugs at https://github.com/avsm/mlgpx/issues";
+
let default_term = Term.(ret (const (`Help (`Pager, None)))) in
+
Cmd.group (Cmd.info "mlgpx" ~version:"0.1.0" ~doc ~man) ~default:default_term
+
[convert_cmd; info_cmd]
+
Printexc.record_backtrace true;
+
exit (Cmd.eval main_cmd)
anil.recoil.org