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