patrick.sirref.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 let track_points = List.map (fun (wpt : waypoint) -> (wpt :> track_point)) waypoints in
37 [{ trkpts = track_points; extensions = [] }]
38
39let 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
45 | None, Some _ -> 1
46 | None, None -> 0
47 ) waypoints
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
53 | None, Some _ -> 1
54 | None, None -> 0
55 ) waypoints
56 else
57 waypoints
58
59(* Main conversion command *)
60let 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;
63 let run env =
64 try
65 let fs = Eio.Stdenv.fs env in
66
67 if verbose then
68 log_info "Reading GPX file: %a" (bold_style Fmt.string) input_file;
69
70 (* Read input GPX *)
71 let gpx = Gpx_eio.read ~fs input_file in
72
73 if verbose then
74 log_info "Found %d waypoints and %d existing tracks"
75 (List.length gpx.waypoints)
76 (List.length gpx.tracks);
77
78 (* Check if we have waypoints to convert *)
79 if gpx.waypoints = [] then (
80 log_error "Input file contains no waypoints - nothing to convert";
81 exit 1
82 );
83
84 (* Sort waypoints if requested *)
85 let sorted_waypoints = sort_waypoints sort_by_time sort_by_name gpx.waypoints in
86
87 if verbose && (sort_by_time || sort_by_name) then
88 log_info "Sorted %d waypoints" (List.length sorted_waypoints);
89
90 (* Convert waypoints to track segments *)
91 let track_segments = waypoints_to_track_segments sorted_waypoints in
92
93 (* Create the new track *)
94 let new_track = {
95 name = Some track_name;
96 cmt = Some "Generated from waypoints by mlgpx CLI";
97 desc = track_desc;
98 src = Some "mlgpx";
99 links = [];
100 number = None;
101 type_ = Some "converted";
102 extensions = [];
103 trksegs = track_segments;
104 } in
105
106 if verbose then (
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
111 );
112
113 (* Build output GPX *)
114 let output_gpx = {
115 gpx with
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";
125 time = None })
126 } in
127
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;
137 exit 1
138 );
139
140 if verbose then
141 log_info "Writing output to: %a" (bold_style Fmt.string) output_file;
142
143 (* Write output GPX *)
144 Gpx_eio.write ~fs output_file output_gpx;
145
146 if verbose then (
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)
156 ) else (
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
161 )
162
163 with
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);
174 exit 2
175 | Sys_error msg ->
176 log_error "System error: %s" msg;
177 exit 2
178 | exn ->
179 log_error "Unexpected error: %s" (Printexc.to_string exn);
180 exit 2
181 in
182 Eio_main.run run
183
184(* Helper function to collect all timestamps from GPX *)
185let collect_all_timestamps gpx =
186 let times = ref [] in
187
188 (* Collect from waypoints *)
189 List.iter (fun (wpt : waypoint) ->
190 match wpt.time with
191 | Some t -> times := t :: !times
192 | None -> ()
193 ) gpx.waypoints;
194
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
200 | None -> ()
201 ) route.rtepts
202 ) gpx.routes;
203
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
210 | None -> ()
211 ) seg.trkpts
212 ) track.trksegs
213 ) gpx.tracks;
214
215 !times
216
217(* Info command *)
218let info_command input_file verbose style_renderer =
219 setup_fmt style_renderer;
220 let run env =
221 try
222 let fs = Eio.Stdenv.fs env in
223
224 if verbose then
225 log_info "Analyzing GPX file: %a" (bold_style Fmt.string) input_file;
226
227 let gpx = Gpx_eio.read ~fs input_file in
228
229 (* Header *)
230 Fmt.pf Format.std_formatter "%a\n" (bold_style Fmt.string) "GPX File Information";
231
232 (* Basic info *)
233 Printf.printf " Version: %s\n" gpx.version;
234 Printf.printf " Creator: %s\n" gpx.creator;
235
236 (match gpx.metadata with
237 | Some meta ->
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)
242 | None -> ())
243 | None ->
244 Printf.printf " No metadata\n");
245
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);
251
252 (* Time range *)
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
258
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);
262
263 (* Calculate duration *)
264 let duration_span = Ptime.diff stop_time start_time in
265 match Ptime.Span.to_int_s duration_span with
266 | Some seconds ->
267 let days = seconds / 86400 in
268 let hours = (seconds mod 86400) / 3600 in
269 let minutes = (seconds mod 3600) / 60 in
270
271 if days > 0 then
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)
277 else
278 Fmt.pf Format.std_formatter " Duration: %a\n" (bold_style Fmt.string)
279 (Printf.sprintf "%d minutes" minutes)
280 | None ->
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.));
284
285 Printf.printf " Total points with timestamps: %d\n" (List.length all_times)
286 );
287
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);
295
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 -> "")
305 ) gpx.waypoints
306 )
307 );
308
309 (* Track info *)
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
318 ) gpx.tracks
319 );
320
321 (* Validation *)
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"
326 else (
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
333 )
334
335 with
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);
346 exit 2
347 | Sys_error msg ->
348 log_error "System error: %s" msg;
349 exit 2
350 | exn ->
351 log_error "Unexpected error: %s" (Printexc.to_string exn);
352 exit 2
353 in
354 Eio_main.run run
355
356(* CLI argument definitions *)
357let 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)
360
361let output_file_arg =
362 let doc = "Output GPX file path" in
363 Arg.(required & pos 1 (some string) None & info [] ~docv:"OUTPUT" ~doc)
364
365let 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)
368
369let 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)
372
373let sort_by_time_flag =
374 let doc = "Sort waypoints by timestamp before conversion" in
375 Arg.(value & flag & info ["t"; "sort-time"] ~doc)
376
377let sort_by_name_flag =
378 let doc = "Sort waypoints by name before conversion" in
379 Arg.(value & flag & info ["sort-name"] ~doc)
380
381let preserve_waypoints_flag =
382 let doc = "Keep original waypoints in addition to generated track" in
383 Arg.(value & flag & info ["p"; "preserve"] ~doc)
384
385let verbose_flag =
386 let doc = "Enable verbose output" in
387 Arg.(value & flag & info ["v"; "verbose"] ~doc)
388
389(* Command definitions *)
390let convert_cmd =
391 let doc = "Convert waypoints to trackset" in
392 let man = [
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";
407 ] in
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
413
414let info_cmd =
415 let doc = "Display information about a GPX file" in
416 let man = [
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";
427 ] in
428 let input_arg =
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
434
435(* Main CLI *)
436let main_cmd =
437 let doc = "mlgpx - GPX file manipulation toolkit" in
438 let man = [
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";
457 `S Manpage.s_bugs;
458 `P "Report bugs at https://github.com/avsm/mlgpx/issues";
459 ] in
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]
463
464let () =
465 Printexc.record_backtrace true;
466 exit (Cmd.eval main_cmd)