commit f3a68c3b171c14a66616ccf3790add13fcfce62d · patrick.sirref.org/ocaml-gpx

+1 -466

bin/mlgpx_cli.ml

···

       1
       1
       -
       (** mlgpx Command Line Interface with pretty ANSI output *)

     

       2
       2
       -
       

     

       3
       3
       -
       open Cmdliner

     

       4
       4
       -
       open Gpx

     

       5
       5
       -
       

     

       6
       6
       -
       (* Terminal and formatting setup *)

     

       7
       7
       -
       let setup_fmt style_renderer =

     

       8
       8
       -
         Fmt_tty.setup_std_outputs ?style_renderer ();

     

       9
       9
       -
         ()

     

       10
       10
       -
       

     

       11
       11
       -
       (* Color formatters *)

     

       12
       12
       -
       let info_style = Fmt.(styled (`Fg `Green))

     

       13
       13
       -
       let warn_style = Fmt.(styled (`Fg `Yellow))

     

       14
       14
       -
       let error_style = Fmt.(styled (`Fg `Red))

     

       15
       15
       -
       let success_style = Fmt.(styled (`Fg `Green))

     

       16
       16
       -
       let bold_style = Fmt.(styled `Bold)

     

       17
       17
       -
       

     

       18
       18
       -
       (* Logging functions *)

     

       19
       19
       -
       let log_info fmt = 

     

       20
       20
       -
         Fmt.pf Format.err_formatter "[%a] " (info_style Fmt.string) "INFO";

     

       21
       21
       -
         Format.kfprintf (fun fmt -> Format.pp_print_newline fmt (); Format.pp_print_flush fmt ()) Format.err_formatter fmt

     

       22
       22
       -
       

     

       23
       23
       -
       

     

       24
       24
       -
       let log_error fmt = 

     

       25
       25
       -
         Fmt.pf Format.err_formatter "[%a] " (error_style Fmt.string) "ERROR";

     

       26
       26
       -
         Format.kfprintf (fun fmt -> Format.pp_print_newline fmt (); Format.pp_print_flush fmt ()) Format.err_formatter fmt

     

       27
       27
       -
       

     

       28
       28
       -
       let log_success fmt = 

     

       29
       29
       -
         Format.kfprintf (fun fmt -> Format.pp_print_newline fmt (); Format.pp_print_flush fmt ()) Format.std_formatter fmt

     

       30
       30
       -
       

     

       31
       31
       -
       (* Utility functions *)

     

       32
       32
       -
       let waypoints_to_track_segments waypoints =

     

       33
       33
       -
         if waypoints = [] then

     

       34
       34
       -
           []

     

       35
       35
       -
         else

     

       36
       36
       -
           let track_points = List.map (fun (wpt : waypoint) -> (wpt :> track_point)) waypoints in

     

       37
       37
       -
           [{ trkpts = track_points; extensions = [] }]

     

       38
       38
       -
       

     

       39
       39
       -
       let sort_waypoints sort_by_time sort_by_name waypoints =

     

       40
       40
       -
         if sort_by_time then

     

       41
       41
       -
           List.sort (fun (wpt1 : waypoint) (wpt2 : waypoint) ->

     

       42
       42
       -
             match wpt1.time, wpt2.time with

     

       43
       43
       -
             | Some t1, Some t2 -> Ptime.compare t1 t2

     

       44
       44
       -
             | Some _, None -> -1

     

       45
       45
       -
             | None, Some _ -> 1

     

       46
       46
       -
             | None, None -> 0

     

       47
       47
       -
           ) waypoints

     

       48
       48
       -
         else if sort_by_name then

     

       49
       49
       -
           List.sort (fun (wpt1 : waypoint) (wpt2 : waypoint) ->

     

       50
       50
       -
             match wpt1.name, wpt2.name with

     

       51
       51
       -
             | Some n1, Some n2 -> String.compare n1 n2

     

       52
       52
       -
             | Some _, None -> -1

     

       53
       53
       -
             | None, Some _ -> 1

     

       54
       54
       -
             | None, None -> 0

     

       55
       55
       -
           ) waypoints

     

       56
       56
       -
         else

     

       57
       57
       -
           waypoints

     

       58
       58
       -
       

     

       59
       59
       -
       (* Main conversion command *)

     

       60
       60
       -
       let convert_waypoints_to_trackset input_file output_file track_name track_desc 

     

       61
       61
       -
                                         sort_by_time sort_by_name preserve_waypoints verbose style_renderer =

     

       62
       62
       -
         setup_fmt style_renderer;

     

       63
       63
       -
         let run env =

     

       64
       64
       -
           try

     

       65
       65
       -
             let fs = Eio.Stdenv.fs env in

     

       66
       66
       -
             

     

       67
       67
       -
             if verbose then

     

       68
       68
       -
               log_info "Reading GPX file: %a" (bold_style Fmt.string) input_file;

     

       69
       69
       -
             

     

       70
       70
       -
             (* Read input GPX *)

     

       71
       71
       -
             let gpx = Gpx_eio.read ~fs input_file in

     

       72
       72
       -
             

     

       73
       73
       -
             if verbose then

     

       74
       74
       -
               log_info "Found %d waypoints and %d existing tracks" 

     

       75
       75
       -
                 (List.length gpx.waypoints)

     

       76
       76
       -
                 (List.length gpx.tracks);

     

       77
       77
       -
             

     

       78
       78
       -
             (* Check if we have waypoints to convert *)

     

       79
       79
       -
             if gpx.waypoints = [] then (

     

       80
       80
       -
               log_error "Input file contains no waypoints - nothing to convert";

     

       81
       81
       -
               exit 1

     

       82
       82
       -
             );

     

       83
       83
       -
             

     

       84
       84
       -
             (* Sort waypoints if requested *)

     

       85
       85
       -
             let sorted_waypoints = sort_waypoints sort_by_time sort_by_name gpx.waypoints in

     

       86
       86
       -
             

     

       87
       87
       -
             if verbose && (sort_by_time || sort_by_name) then

     

       88
       88
       -
               log_info "Sorted %d waypoints" (List.length sorted_waypoints);

     

       89
       89
       -
             

     

       90
       90
       -
             (* Convert waypoints to track segments *)

     

       91
       91
       -
             let track_segments = waypoints_to_track_segments sorted_waypoints in

     

       92
       92
       -
             

     

       93
       93
       -
             (* Create the new track *)

     

       94
       94
       -
             let new_track = {

     

       95
       95
       -
               name = Some track_name;

     

       96
       96
       -
               cmt = Some "Generated from waypoints by mlgpx CLI";

     

       97
       97
       -
               desc = track_desc;

     

       98
       98
       -
               src = Some "mlgpx";

     

       99
       99
       -
               links = [];

     

       100
       100
       -
               number = None;

     

       101
       101
       -
               type_ = Some "converted";

     

       102
       102
       -
               extensions = [];

     

       103
       103
       -
               trksegs = track_segments;

     

       104
       104
       -
             } in

     

       105
       105
       -
             

     

       106
       106
       -
             if verbose then (

     

       107
       107
       -
               let total_points = List.fold_left (fun acc seg -> acc + List.length seg.trkpts) 0 track_segments in

     

       108
       108
       -
               log_info "Created track %a with %d segments containing %d points"

     

       109
       109
       -
                 (bold_style Fmt.string) track_name

     

       110
       110
       -
                 (List.length track_segments) total_points

     

       111
       111
       -
             );

     

       112
       112
       -
             

     

       113
       113
       -
             (* Build output GPX *)

     

       114
       114
       -
             let output_gpx = {

     

       115
       115
       -
               gpx with

     

       116
       116
       -
               waypoints = (if preserve_waypoints then gpx.waypoints else []);

     

       117
       117
       -
               tracks = new_track :: gpx.tracks;

     

       118
       118
       -
               metadata = (match gpx.metadata with

     

       119
       119
       -
                 | Some meta -> Some { meta with 

     

       120
       120
       -
                     desc = Some (match meta.desc with

     

       121
       121
       -
                       | Some existing -> existing ^ " (waypoints converted to track)"

     

       122
       122
       -
                       | None -> "Waypoints converted to track") }

     

       123
       123
       -
                 | None -> Some { empty_metadata with 

     

       124
       124
       -
                     desc = Some "Waypoints converted to track";

     

       125
       125
       -
                     time = None })

     

       126
       126
       -
             } in

     

       127
       127
       -
             

     

       128
       128
       -
             (* Validate output *)

     

       129
       129
       -
             let validation = validate_gpx output_gpx in

     

       130
       130
       -
             if not validation.is_valid then (

     

       131
       131
       -
               log_error "Generated GPX failed validation:";

     

       132
       132
       -
               List.iter (fun issue ->

     

       133
       133
       -
                 let level_str = match issue.level with `Error -> "ERROR" | `Warning -> "WARNING" in

     

       134
       134
       -
                 let level_color = match issue.level with `Error -> error_style | `Warning -> warn_style in

     

       135
       135
       -
                 Fmt.pf Format.err_formatter "  %a: %s\n" (level_color Fmt.string) level_str issue.message

     

       136
       136
       -
               ) validation.issues;

     

       137
       137
       -
               exit 1

     

       138
       138
       -
             );

     

       139
       139
       -
             

     

       140
       140
       -
             if verbose then

     

       141
       141
       -
               log_info "Writing output to: %a" (bold_style Fmt.string) output_file;

     

       142
       142
       -
             

     

       143
       143
       -
             (* Write output GPX *)

     

       144
       144
       -
             Gpx_eio.write ~fs output_file output_gpx;

     

       145
       145
       -
             

     

       146
       146
       -
             if verbose then (

     

       147
       147
       -
               Fmt.pf Format.std_formatter "%a\n" (success_style Fmt.string) "Conversion completed successfully!";

     

       148
       148
       -
               log_info "Output contains:";

     

       149
       149
       -
               Fmt.pf Format.err_formatter "  - %d waypoints%s\n" 

     

       150
       150
       -
                 (List.length output_gpx.waypoints)

     

       151
       151
       -
                 (if preserve_waypoints then " (preserved)" else " (removed)");

     

       152
       152
       -
               Fmt.pf Format.err_formatter "  - %d tracks (%a + %d existing)\n"

     

       153
       153
       -
                 (List.length output_gpx.tracks)

     

       154
       154
       -
                 (success_style Fmt.string) "1 new"

     

       155
       155
       -
                 (List.length gpx.tracks)

     

       156
       156
       -
             ) else (

     

       157
       157
       -
               log_success "Converted %d waypoints to track: %a → %a" 

     

       158
       158
       -
                 (List.length sorted_waypoints)

     

       159
       159
       -
                 (bold_style Fmt.string) input_file

     

       160
       160
       -
                 (bold_style Fmt.string) output_file

     

       161
       161
       -
             )

     

       162
       162
       -
             

     

       163
       163
       -
           with

     

       164
       164
       -
           | Gpx.Gpx_error err ->

     

       165
       165
       -
               log_error "GPX Error: %s" (match err with

     

       166
       166
       -
                 | Invalid_xml s -> "Invalid XML: " ^ s

     

       167
       167
       -
                 | Invalid_coordinate s -> "Invalid coordinate: " ^ s

     

       168
       168
       -
                 | Missing_required_attribute (elem, attr) -> 

     

       169
       169
       -
                     Printf.sprintf "Missing attribute %s in %s" attr elem

     

       170
       170
       -
                 | Missing_required_element s -> "Missing element: " ^ s

     

       171
       171
       -
                 | Validation_error s -> "Validation error: " ^ s

     

       172
       172
       -
                 | Xml_error s -> "XML error: " ^ s

     

       173
       173
       -
                 | IO_error s -> "I/O error: " ^ s);

     

       174
       174
       -
               exit 2

     

       175
       175
       -
           | Sys_error msg ->

     

       176
       176
       -
               log_error "System error: %s" msg;

     

       177
       177
       -
               exit 2

     

       178
       178
       -
           | exn ->

     

       179
       179
       -
               log_error "Unexpected error: %s" (Printexc.to_string exn);

     

       180
       180
       -
               exit 2

     

       181
       181
       -
         in

     

       182
       182
       -
         Eio_main.run run

     

       183
       183
       -
       

     

       184
       184
       -
       (* Helper function to collect all timestamps from GPX *)

     

       185
       185
       -
       let collect_all_timestamps gpx =

     

       186
       186
       -
         let times = ref [] in

     

       187
       187
       -
         

     

       188
       188
       -
         (* Collect from waypoints *)

     

       189
       189
       -
         List.iter (fun (wpt : waypoint) ->

     

       190
       190
       -
           match wpt.time with

     

       191
       191
       -
           | Some t -> times := t :: !times

     

       192
       192
       -
           | None -> ()

     

       193
       193
       -
         ) gpx.waypoints;

     

       194
       194
       -
         

     

       195
       195
       -
         (* Collect from routes *)

     

       196
       196
       -
         List.iter (fun route ->

     

       197
       197
       -
           List.iter (fun (rtept : route_point) ->

     

       198
       198
       -
             match rtept.time with

     

       199
       199
       -
             | Some t -> times := t :: !times

     

       200
       200
       -
             | None -> ()

     

       201
       201
       -
           ) route.rtepts

     

       202
       202
       -
         ) gpx.routes;

     

       203
       203
       -
         

     

       204
       204
       -
         (* Collect from tracks *)

     

       205
       205
       -
         List.iter (fun track ->

     

       206
       206
       -
           List.iter (fun seg ->

     

       207
       207
       -
             List.iter (fun (trkpt : track_point) ->

     

       208
       208
       -
               match trkpt.time with

     

       209
       209
       -
               | Some t -> times := t :: !times

     

       210
       210
       -
               | None -> ()

     

       211
       211
       -
             ) seg.trkpts

     

       212
       212
       -
           ) track.trksegs

     

       213
       213
       -
         ) gpx.tracks;

     

       214
       214
       -
         

     

       215
       215
       -
         !times

     

       216
       216
       -
       

     

       217
       217
       -
       (* Info command *)

     

       218
       218
       -
       let info_command input_file verbose style_renderer =

     

       219
       219
       -
         setup_fmt style_renderer;

     

       220
       220
       -
         let run env =

     

       221
       221
       -
           try

     

       222
       222
       -
             let fs = Eio.Stdenv.fs env in

     

       223
       223
       -
             

     

       224
       224
       -
             if verbose then

     

       225
       225
       -
               log_info "Analyzing GPX file: %a" (bold_style Fmt.string) input_file;

     

       226
       226
       -
             

     

       227
       227
       -
             let gpx = Gpx_eio.read ~fs input_file in

     

       228
       228
       -
             

     

       229
       229
       -
             (* Header *)

     

       230
       230
       -
             Fmt.pf Format.std_formatter "%a\n" (bold_style Fmt.string) "GPX File Information";

     

       231
       231
       -
             

     

       232
       232
       -
             (* Basic info *)

     

       233
       233
       -
             Printf.printf "  Version: %s\n" gpx.version;

     

       234
       234
       -
             Printf.printf "  Creator: %s\n" gpx.creator;

     

       235
       235
       -
             

     

       236
       236
       -
             (match gpx.metadata with

     

       237
       237
       -
              | Some meta ->

     

       238
       238
       -
                  Printf.printf "  Name: %s\n" (Option.value meta.name ~default:"<unnamed>");

     

       239
       239
       -
                  Printf.printf "  Description: %s\n" (Option.value meta.desc ~default:"<none>");

     

       240
       240
       -
                  (match meta.time with

     

       241
       241
       -
                   | Some time -> Printf.printf "  Created: %s\n" (Ptime.to_rfc3339 time)

     

       242
       242
       -
                   | None -> ())

     

       243
       243
       -
              | None -> 

     

       244
       244
       -
                  Printf.printf "  No metadata\n");

     

       245
       245
       -
             

     

       246
       246
       -
             (* Content summary *)

     

       247
       247
       -
             Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Content Summary";

     

       248
       248
       -
             Printf.printf "  Waypoints: %d\n" (List.length gpx.waypoints);

     

       249
       249
       -
             Printf.printf "  Routes: %d\n" (List.length gpx.routes);

     

       250
       250
       -
             Printf.printf "  Tracks: %d\n" (List.length gpx.tracks);

     

       251
       251
       -
             

     

       252
       252
       -
             (* Time range *)

     

       253
       253
       -
             let all_times = collect_all_timestamps gpx in

     

       254
       254
       -
             if all_times <> [] then (

     

       255
       255
       -
               let sorted_times = List.sort Ptime.compare all_times in

     

       256
       256
       -
               let start_time = List.hd sorted_times in

     

       257
       257
       -
               let stop_time = List.hd (List.rev sorted_times) in

     

       258
       258
       -
               

     

       259
       259
       -
               Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Time Range";

     

       260
       260
       -
               Fmt.pf Format.std_formatter "  Start: %a\n" (info_style Fmt.string) (Ptime.to_rfc3339 start_time);

     

       261
       261
       -
               Fmt.pf Format.std_formatter "  Stop:  %a\n" (info_style Fmt.string) (Ptime.to_rfc3339 stop_time);

     

       262
       262
       -
               

     

       263
       263
       -
               (* Calculate duration *)

     

       264
       264
       -
               let duration_span = Ptime.diff stop_time start_time in

     

       265
       265
       -
               match Ptime.Span.to_int_s duration_span with

     

       266
       266
       -
               | Some seconds ->

     

       267
       267
       -
                   let days = seconds / 86400 in

     

       268
       268
       -
                   let hours = (seconds mod 86400) / 3600 in

     

       269
       269
       -
                   let minutes = (seconds mod 3600) / 60 in

     

       270
       270
       -
                   

     

       271
       271
       -
                   if days > 0 then

     

       272
       272
       -
                     Fmt.pf Format.std_formatter "  Duration: %a\n" (bold_style Fmt.string) 

     

       273
       273
       -
                       (Printf.sprintf "%d days, %d hours, %d minutes" days hours minutes)

     

       274
       274
       -
                   else if hours > 0 then

     

       275
       275
       -
                     Fmt.pf Format.std_formatter "  Duration: %a\n" (bold_style Fmt.string)

     

       276
       276
       -
                       (Printf.sprintf "%d hours, %d minutes" hours minutes)

     

       277
       277
       -
                   else

     

       278
       278
       -
                     Fmt.pf Format.std_formatter "  Duration: %a\n" (bold_style Fmt.string)

     

       279
       279
       -
                       (Printf.sprintf "%d minutes" minutes)

     

       280
       280
       -
               | None ->

     

       281
       281
       -
                   (* Duration too large to represent as int *)

     

       282
       282
       -
                   Fmt.pf Format.std_formatter "  Duration: %a\n" (bold_style Fmt.string) 

     

       283
       283
       -
                     (Printf.sprintf "%.1f days" (Ptime.Span.to_float_s duration_span /. 86400.));

     

       284
       284
       -
               

     

       285
       285
       -
               Printf.printf "  Total points with timestamps: %d\n" (List.length all_times)

     

       286
       286
       -
             );

     

       287
       287
       -
             

     

       288
       288
       -
             (* Detailed waypoint info *)

     

       289
       289
       -
             if gpx.waypoints <> [] then (

     

       290
       290
       -
               Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Waypoints";

     

       291
       291
       -
               let waypoints_with_time = List.filter (fun (wpt : waypoint) -> wpt.time <> None) gpx.waypoints in

     

       292
       292
       -
               let waypoints_with_elevation = List.filter (fun (wpt : waypoint) -> wpt.ele <> None) gpx.waypoints in

     

       293
       293
       -
               Printf.printf "  - %d with timestamps\n" (List.length waypoints_with_time);

     

       294
       294
       -
               Printf.printf "  - %d with elevation data\n" (List.length waypoints_with_elevation);

     

       295
       295
       -
               

     

       296
       296
       -
               if verbose && List.length gpx.waypoints <= 10 then (

     

       297
       297
       -
                 Printf.printf "  Details:\n";

     

       298
       298
       -
                 List.iteri (fun i (wpt : waypoint) ->

     

       299
       299
       -
                   Fmt.pf Format.std_formatter "    %a %s (%.6f, %.6f)%s%s\n" 

     

       300
       300
       -
                     (info_style Fmt.string) (Printf.sprintf "%d." (i + 1))

     

       301
       301
       -
                     (Option.value wpt.name ~default:"<unnamed>")

     

       302
       302
       -
                     (latitude_to_float wpt.lat) (longitude_to_float wpt.lon)

     

       303
       303
       -
                     (match wpt.ele with Some e -> Printf.sprintf " elev=%.1fm" e | None -> "")

     

       304
       304
       -
                     (match wpt.time with Some t -> " @" ^ Ptime.to_rfc3339 t | None -> "")

     

       305
       305
       -
                 ) gpx.waypoints

     

       306
       306
       -
               )

     

       307
       307
       -
             );

     

       308
       308
       -
             

     

       309
       309
       -
             (* Track info *)

     

       310
       310
       -
             if gpx.tracks <> [] then (

     

       311
       311
       -
               Fmt.pf Format.std_formatter "\n%a\n" (bold_style Fmt.string) "Tracks";

     

       312
       312
       -
               List.iteri (fun i track ->

     

       313
       313
       -
                 let total_points = List.fold_left (fun acc seg -> acc + List.length seg.trkpts) 0 track.trksegs in

     

       314
       314
       -
                 Fmt.pf Format.std_formatter "  %a %s (%d segments, %d points)\n"

     

       315
       315
       -
                   (info_style Fmt.string) (Printf.sprintf "%d." (i + 1))

     

       316
       316
       -
                   (Option.value track.name ~default:"<unnamed>")

     

       317
       317
       -
                   (List.length track.trksegs) total_points

     

       318
       318
       -
               ) gpx.tracks

     

       319
       319
       -
             );

     

       320
       320
       -
             

     

       321
       321
       -
             (* Validation *)

     

       322
       322
       -
             let validation = validate_gpx gpx in

     

       323
       323
       -
             Printf.printf "\n";

     

       324
       324
       -
             if validation.is_valid then

     

       325
       325
       -
               Fmt.pf Format.std_formatter "Validation: %a\n" (success_style Fmt.string) "PASSED"

     

       326
       326
       -
             else (

     

       327
       327
       -
               Fmt.pf Format.std_formatter "Validation: %a\n" (error_style Fmt.string) "FAILED";

     

       328
       328
       -
               List.iter (fun issue ->

     

       329
       329
       -
                 let level_str = match issue.level with `Error -> "ERROR" | `Warning -> "WARNING" in

     

       330
       330
       -
                 let level_color = match issue.level with `Error -> error_style | `Warning -> warn_style in

     

       331
       331
       -
                 Fmt.pf Format.std_formatter "  %a: %s\n" (level_color Fmt.string) level_str issue.message

     

       332
       332
       -
               ) validation.issues

     

       333
       333
       -
             )

     

       334
       334
       -
             

     

       335
       335
       -
           with

     

       336
       336
       -
           | Gpx.Gpx_error err ->

     

       337
       337
       -
               log_error "GPX Error: %s" (match err with

     

       338
       338
       -
                 | Invalid_xml s -> "Invalid XML: " ^ s

     

       339
       339
       -
                 | Invalid_coordinate s -> "Invalid coordinate: " ^ s

     

       340
       340
       -
                 | Missing_required_attribute (elem, attr) -> 

     

       341
       341
       -
                     Printf.sprintf "Missing attribute %s in %s" attr elem

     

       342
       342
       -
                 | Missing_required_element s -> "Missing element: " ^ s

     

       343
       343
       -
                 | Validation_error s -> "Validation error: " ^ s

     

       344
       344
       -
                 | Xml_error s -> "XML error: " ^ s

     

       345
       345
       -
                 | IO_error s -> "I/O error: " ^ s);

     

       346
       346
       -
               exit 2

     

       347
       347
       -
           | Sys_error msg ->

     

       348
       348
       -
               log_error "System error: %s" msg;

     

       349
       349
       -
               exit 2

     

       350
       350
       -
           | exn ->

     

       351
       351
       -
               log_error "Unexpected error: %s" (Printexc.to_string exn);

     

       352
       352
       -
               exit 2

     

       353
       353
       -
         in

     

       354
       354
       -
         Eio_main.run run

     

       355
       355
       -
       

     

       356
       356
       -
       (* CLI argument definitions *)

     

       357
       357
       -
       let input_file_arg =

     

       358
       358
       -
         let doc = "Input GPX file path" in

     

       359
       359
       -
         Arg.(required & pos 0 (some non_dir_file) None & info [] ~docv:"INPUT" ~doc)

     

       360
       360
       -
       

     

       361
       361
       -
       let output_file_arg =

     

       362
       362
       -
         let doc = "Output GPX file path" in

     

       363
       363
       -
         Arg.(required & pos 1 (some string) None & info [] ~docv:"OUTPUT" ~doc)

     

       364
       364
       -
       

     

       365
       365
       -
       let track_name_opt =

     

       366
       366
       -
         let doc = "Name for the generated track (default: \"Converted from waypoints\")" in

     

       367
       367
       -
         Arg.(value & opt string "Converted from waypoints" & info ["n"; "name"] ~docv:"NAME" ~doc)

     

       368
       368
       -
       

     

       369
       369
       -
       let track_description_opt =

     

       370
       370
       -
         let doc = "Description for the generated track" in

     

       371
       371
       -
         Arg.(value & opt (some string) None & info ["d"; "desc"] ~docv:"DESC" ~doc)

     

       372
       372
       -
       

     

       373
       373
       -
       let sort_by_time_flag =

     

       374
       374
       -
         let doc = "Sort waypoints by timestamp before conversion" in

     

       375
       375
       -
         Arg.(value & flag & info ["t"; "sort-time"] ~doc)

     

       376
       376
       -
       

     

       377
       377
       -
       let sort_by_name_flag =

     

       378
       378
       -
         let doc = "Sort waypoints by name before conversion" in

     

       379
       379
       -
         Arg.(value & flag & info ["sort-name"] ~doc)

     

       380
       380
       -
       

     

       381
       381
       -
       let preserve_waypoints_flag =

     

       382
       382
       -
         let doc = "Keep original waypoints in addition to generated track" in

     

       383
       383
       -
         Arg.(value & flag & info ["p"; "preserve"] ~doc)

     

       384
       384
       -
       

     

       385
       385
       -
       let verbose_flag =

     

       386
       386
       -
         let doc = "Enable verbose output" in

     

       387
       387
       -
         Arg.(value & flag & info ["v"; "verbose"] ~doc)

     

       388
       388
       -
       

     

       389
       389
       -
       (* Command definitions *)

     

       390
       390
       -
       let convert_cmd =

     

       391
       391
       -
         let doc = "Convert waypoints to trackset" in

     

       392
       392
       -
         let man = [

     

       393
       393
       -
           `S Manpage.s_description;

     

       394
       394
       -
           `P "Convert all waypoints in a GPX file to a single track. This is useful for \

     

       395
       395
       -
               converting a collection of waypoints into a navigable route or for \

     

       396
       396
       -
               consolidating GPS data.";

     

       397
       397
       -
           `P "The conversion preserves all waypoint data (coordinates, elevation, \

     

       398
       398
       -
               timestamps, etc.) in the track points. By default, waypoints are removed \

     

       399
       399
       -
               from the output file unless --preserve is used.";

     

       400
       400
       -
           `S Manpage.s_examples;

     

       401
       401
       -
           `P "Convert waypoints to track:";

     

       402
       402
       -
           `Pre "  mlgpx convert waypoints.gpx track.gpx";

     

       403
       403
       -
           `P "Convert with custom track name and preserve original waypoints:";

     

       404
       404
       -
           `Pre "  mlgpx convert -n \"My Route\" --preserve waypoints.gpx route.gpx";

     

       405
       405
       -
           `P "Sort waypoints by timestamp before conversion:";

     

       406
       406
       -
           `Pre "  mlgpx convert --sort-time waypoints.gpx sorted_track.gpx";

     

       407
       407
       -
         ] in

     

       408
       408
       -
         let term = Term.(const convert_waypoints_to_trackset $ input_file_arg $ output_file_arg 

     

       409
       409
       -
                          $ track_name_opt $ track_description_opt $ sort_by_time_flag 

     

       410
       410
       -
                          $ sort_by_name_flag $ preserve_waypoints_flag $ verbose_flag

     

       411
       411
       -
                          $ Fmt_cli.style_renderer ()) in

     

       412
       412
       -
         Cmd.v (Cmd.info "convert" ~doc ~man) term

     

       413
       413
       -
       

     

       414
       414
       -
       let info_cmd =

     

       415
       415
       -
         let doc = "Display information about a GPX file" in

     

       416
       416
       -
         let man = [

     

       417
       417
       -
           `S Manpage.s_description;

     

       418
       418
       -
           `P "Analyze and display detailed information about a GPX file including \

     

       419
       419
       -
               statistics, content summary, and validation results.";

     

       420
       420
       -
           `P "This command is useful for understanding the structure and content \

     

       421
       421
       -
               of GPX files before processing them.";

     

       422
       422
       -
           `S Manpage.s_examples;

     

       423
       423
       -
           `P "Show basic information:";

     

       424
       424
       -
           `Pre "  mlgpx info file.gpx";

     

       425
       425
       -
           `P "Show detailed information with waypoint details:";

     

       426
       426
       -
           `Pre "  mlgpx info -v file.gpx";

     

       427
       427
       -
         ] in

     

       428
       428
       -
         let input_arg = 

     

       429
       429
       -
           let doc = "GPX file to analyze" in

     

       430
       430
       -
           Arg.(required & pos 0 (some non_dir_file) None & info [] ~docv:"FILE" ~doc) in

     

       431
       431
       -
         let term = Term.(const info_command $ input_arg $ verbose_flag 

     

       432
       432
       -
                          $ Fmt_cli.style_renderer ()) in

     

       433
       433
       -
         Cmd.v (Cmd.info "info" ~doc ~man) term

     

       434
       434
       -
       

     

       435
       435
       -
       (* Main CLI *)

     

       436
       436
       -
       let main_cmd =

     

       437
       437
       -
         let doc = "mlgpx - GPX file manipulation toolkit" in

     

       438
       438
       -
         let man = [

     

       439
       439
       -
           `S Manpage.s_description;

     

       440
       440
       -
           `P "mlgpx is a command-line toolkit for working with GPX (GPS Exchange Format) \

     

       441
       441
       -
               files. It provides tools for converting, analyzing, and manipulating GPS data.";

     

       442
       442
       -
           `S Manpage.s_commands;

     

       443
       443
       -
           `P "Available commands:";

     

       444
       444
       -
           `P "$(b,convert) - Convert waypoints to trackset";

     

       445
       445
       -
           `P "$(b,info) - Display GPX file information";

     

       446
       446
       -
           `S Manpage.s_common_options;

     

       447
       447
       -
           `P "$(b,--verbose), $(b,-v) - Enable verbose output";

     

       448
       448
       -
           `P "$(b,--color)={auto|always|never} - Control ANSI color output";

     

       449
       449
       -
           `P "$(b,--help) - Show command help";

     

       450
       450
       -
           `S Manpage.s_examples;

     

       451
       451
       -
           `P "Convert waypoints to track:";

     

       452
       452
       -
           `Pre "  mlgpx convert waypoints.gpx track.gpx";

     

       453
       453
       -
           `P "Analyze a GPX file with colors:";

     

       454
       454
       -
           `Pre "  mlgpx info --verbose --color=always file.gpx";

     

       455
       455
       -
           `P "Convert without colors for scripts:";

     

       456
       456
       -
           `Pre "  mlgpx convert --color=never waypoints.gpx track.gpx";

     

       457
       457
       -
           `S Manpage.s_bugs;

     

       458
       458
       -
           `P "Report bugs at https://github.com/avsm/mlgpx/issues";

     

       459
       459
       -
         ] in

     

       460
       460
       -
         let default_term = Term.(ret (const (`Help (`Pager, None)))) in

     

       461
       461
       -
         Cmd.group (Cmd.info "mlgpx" ~version:"0.1.0" ~doc ~man) ~default:default_term 

     

       462
       462
       -
           [convert_cmd; info_cmd]

     

       463
       463
       -
       

     

       464
       464
       -
       let () = 

     

       465
       465
       -
         Printexc.record_backtrace true;

     

       466
       466
       -
         exit (Cmd.eval main_cmd)

     

       1
       1
       +
       (* Temporarily disabled during refactoring *)

-2

example_direct.gpx

···

       1
       1
       -
       <?xml version="1.0" encoding="UTF-8"?>

     

       2
       2
       -
       <gpx version="1.1" creator="mlgpx direct API example" xmlns="http://www.topografix.com/GPX/1/1" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd"><metadata><name>Example GPX File</name><desc>Demonstration of mlgpx library capabilities</desc></metadata><wpt lat="37.774900" lon="-122.419400"><name>San Francisco</name><desc>Golden Gate Bridge area</desc></wpt><trk><name>Example Track</name><cmt>Sample GPS track</cmt><desc>Demonstrates track creation</desc><trkseg><trkpt lat="37.774900" lon="-122.419400"><name>Start</name></trkpt><trkpt lat="37.784900" lon="-122.409400"><name>Mid Point</name></trkpt><trkpt lat="37.794900" lon="-122.399400"><name>End</name></trkpt></trkseg></trk></gpx>

-2

example_output.gpx

···

       1
       1
       -
       <?xml version="1.0" encoding="UTF-8"?>

     

       2
       2
       -
       <gpx version="1.1" creator="eio-example" xmlns="http://www.topografix.com/GPX/1/1" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd"><wpt lat="37.774900" lon="-122.419400"><name>San Francisco</name></wpt><wpt lat="37.784900" lon="-122.409400"><name>Near SF</name></wpt><rte><name>SF Route</name><rtept lat="37.774900" lon="-122.419400"/><rtept lat="37.784900" lon="-122.409400"/></rte><trk><name>SF Walk</name><trkseg><trkpt lat="37.774900" lon="-122.419400"/><trkpt lat="37.775900" lon="-122.418400"/><trkpt lat="37.776900" lon="-122.417400"/><trkpt lat="37.777900" lon="-122.416400"/></trkseg></trk></gpx>

+2 -3

examples/dune

···

       1
       1
        
       (executable

     

       2
       2
        
        (public_name simple_gpx)

     

       3
       3
        
        (name simple_gpx)

     

       4
       4
       -
        (libraries gpx_unix))

     

       4
       4
       +
        (libraries gpx xmlm))

     

       5
       5
        
       

     

       6
       6
        
       (executable

     

       7
       7
        
        (public_name effects_example)

     

       8
       8
        
        (name effects_example)

     

       9
       9
       -
        (libraries gpx_eio eio_main)

     

       10
       10
       -
        (optional))

     

       9
       9
       +
        (libraries gpx xmlm))

+87 -58

examples/effects_example.ml

···

       1
       1
       -
       (** Example using GPX with real Eio effects-based API 

     

       2
       2
       -
        

     

       3
       3
       -
           This demonstrates the real Eio-based API with structured concurrency

     

       4
       4
       -
           and proper resource management.

     

       5
       5
       -
       **)

     

       1
       1
       +
       (** Simple GPX example demonstrating basic functionality **)

     

       6
       2
        
       

     

       7
       7
       -
       open Gpx_eio

     

       3
       3
       +
       open Gpx

     

       8
       4
        
       

     

       9
       9
       -
       let main env =

     

       5
       5
       +
       let () =

     

       6
       6
       +
         Printf.printf "=== Simple GPX Example ===\n\n";

     

       7
       7
       +
         

     

       10
       8
        
         try

     

       11
       11
       -
           let fs = Eio.Stdenv.fs env in

     

       12
       12
       -
           

     

       13
       9
        
           (* Create some GPS coordinates *)

     

       14
       14
       -
           let lat1 = Gpx.latitude 37.7749 |> Result.get_ok in

     

       15
       15
       -
           let lon1 = Gpx.longitude (-122.4194) |> Result.get_ok in

     

       16
       16
       -
           let lat2 = Gpx.latitude 37.7849 |> Result.get_ok in

     

       17
       17
       -
           let lon2 = Gpx.longitude (-122.4094) |> Result.get_ok in

     

       10
       10
       +
           let lat1 = Coordinate.latitude 37.7749 |> Result.get_ok in

     

       11
       11
       +
           let lon1 = Coordinate.longitude (-122.4194) |> Result.get_ok in

     

       12
       12
       +
           let lat2 = Coordinate.latitude 37.7849 |> Result.get_ok in

     

       13
       13
       +
           let lon2 = Coordinate.longitude (-122.4094) |> Result.get_ok in

     

       18
       14
        
           

     

       19
       15
        
           (* Create waypoints *)

     

       20
       20
       -
           let waypoint1 = make_waypoint ~fs ~lat:(Gpx.latitude_to_float lat1) ~lon:(Gpx.longitude_to_float lon1) ~name:"San Francisco" () in

     

       21
       21
       -
           let waypoint2 = make_waypoint ~fs ~lat:(Gpx.latitude_to_float lat2) ~lon:(Gpx.longitude_to_float lon2) ~name:"Near SF" () in

     

       16
       16
       +
           let waypoint1 = Waypoint.make lat1 lon1 in

     

       17
       17
       +
           let waypoint1 = Waypoint.with_name waypoint1 "San Francisco" in

     

       18
       18
       +
           let waypoint2 = Waypoint.make lat2 lon2 in

     

       19
       19
       +
           let waypoint2 = Waypoint.with_name waypoint2 "Near SF" in

     

       22
       20
        
           

     

       23
       21
        
           (* Create a simple track from coordinates *)

     

       24
       24
       -
           let track = make_track_from_coords ~fs ~name:"SF Walk" [

     

       22
       22
       +
           let track = Track.make ~name:"SF Walk" in

     

       23
       23
       +
           let track_segment = Track.Segment.empty in

     

       24
       24
       +
           let coords = [

     

       25
       25
        
             (37.7749, -122.4194);

     

       26
       26
        
             (37.7759, -122.4184);

     

       27
       27
        
             (37.7769, -122.4174);

     

       28
       28
        
             (37.7779, -122.4164);

     

       29
       29
        
           ] in

     

       30
       30
       +
           let track_segment = List.fold_left (fun seg (lat_f, lon_f) ->

     

       31
       31
       +
             match Coordinate.latitude lat_f, Coordinate.longitude lon_f with

     

       32
       32
       +
             | Ok lat, Ok lon ->

     

       33
       33
       +
                 let pt = Waypoint.make lat lon in

     

       34
       34
       +
                 Track.Segment.add_point seg pt

     

       35
       35
       +
             | _ -> seg

     

       36
       36
       +
           ) track_segment coords in

     

       37
       37
       +
           let track = Track.add_segment track track_segment in

     

       30
       38
        
           

     

       31
       39
        
           (* Create a route *)

     

       32
       32
       -
           let route = make_route_from_coords ~fs ~name:"SF Route" [

     

       40
       40
       +
           let route = Route.make ~name:"SF Route" in

     

       41
       41
       +
           let route_coords = [

     

       33
       42
        
             (37.7749, -122.4194);

     

       34
       43
        
             (37.7849, -122.4094);

     

       35
       44
        
           ] in

     

       45
       45
       +
           let route = List.fold_left (fun r (lat_f, lon_f) ->

     

       46
       46
       +
             match Coordinate.latitude lat_f, Coordinate.longitude lon_f with

     

       47
       47
       +
             | Ok lat, Ok lon ->

     

       48
       48
       +
                 let pt = Waypoint.make lat lon in

     

       49
       49
       +
                 Route.add_point r pt

     

       50
       50
       +
             | _ -> r

     

       51
       51
       +
           ) route route_coords in

     

       36
       52
        
           

     

       37
       53
        
           (* Create GPX document with all elements *)

     

       38
       38
       -
           let gpx = Gpx.make_gpx ~creator:"eio-example" in

     

       39
       39
       -
           let gpx = { gpx with 

     

       40
       40
       -
             waypoints = [waypoint1; waypoint2];

     

       41
       41
       -
             tracks = [track];

     

       42
       42
       -
             routes = [route];

     

       43
       43
       -
           } in

     

       54
       54
       +
           let gpx = Gpx_doc.empty ~creator:"simple-example" in

     

       55
       55
       +
           let gpx = Gpx_doc.add_waypoint gpx waypoint1 in

     

       56
       56
       +
           let gpx = Gpx_doc.add_waypoint gpx waypoint2 in

     

       57
       57
       +
           let gpx = Gpx_doc.add_track gpx track in

     

       58
       58
       +
           let gpx = Gpx_doc.add_route gpx route in

     

       44
       59
        
           

     

       45
       45
       -
           Printf.printf "Created GPX document with:\\n";

     

       46
       46
       -
           print_stats gpx;

     

       47
       47
       -
           Printf.printf "\\n";

     

       60
       60
       +
           Printf.printf "Created GPX document with:\n";

     

       61
       61
       +
           Printf.printf "  Waypoints: %d\n" (List.length (Gpx_doc.get_waypoints gpx));

     

       62
       62
       +
           Printf.printf "  Tracks: %d\n" (List.length (Gpx_doc.get_tracks gpx));

     

       63
       63
       +
           Printf.printf "  Routes: %d\n" (List.length (Gpx_doc.get_routes gpx));

     

       64
       64
       +
           Printf.printf "\n";

     

       48
       65
        
           

     

       49
       66
        
           (* Write to file with validation *)

     

       50
       50
       -
           write ~validate:true ~fs "example_output.gpx" gpx;

     

       51
       51
       -
           Printf.printf "Wrote GPX to example_output.gpx\\n";

     

       67
       67
       +
           let out_chan = open_out "example_output.gpx" in

     

       68
       68
       +
           let dest = (`Channel out_chan) in

     

       69
       69
       +
           (match write ~validate:true dest gpx with

     

       70
       70
       +
            | Ok () ->

     

       71
       71
       +
                close_out out_chan;

     

       72
       72
       +
                Printf.printf "Wrote GPX to example_output.gpx\n"

     

       73
       73
       +
            | Error e ->

     

       74
       74
       +
                close_out out_chan;

     

       75
       75
       +
                Printf.eprintf "Error writing GPX: %s\n" (Error.to_string e)

     

       76
       76
       +
           );

     

       52
       77
        
           

     

       53
       78
        
           (* Read it back and verify *)

     

       54
       54
       -
           let gpx2 = read ~validate:true ~fs "example_output.gpx" in

     

       55
       55
       -
           Printf.printf "Read back GPX document with %d waypoints, %d tracks, %d routes\\n" 

     

       56
       56
       -
             (List.length gpx2.waypoints) (List.length gpx2.tracks) (List.length gpx2.routes);

     

       57
       57
       -
           

     

       58
       58
       -
           (* Extract coordinates from track *)

     

       59
       59
       -
           match gpx2.tracks with

     

       60
       60
       -
           | track :: _ ->

     

       61
       61
       -
               let coords = track_coords track in

     

       62
       62
       -
               Printf.printf "Track coordinates: %d points\\n" (List.length coords);

     

       63
       63
       -
               List.iteri (fun i (lat, lon) ->

     

       64
       64
       -
                 Printf.printf "  Point %d: %.4f, %.4f\\n" i lat lon

     

       65
       65
       -
               ) coords

     

       66
       66
       -
           | [] -> Printf.printf "No tracks found\\n";

     

       79
       79
       +
           let in_chan = open_in "example_output.gpx" in

     

       80
       80
       +
           let input = Xmlm.make_input (`Channel in_chan) in

     

       81
       81
       +
           (match parse ~validate:true input with

     

       82
       82
       +
            | Ok gpx2 ->

     

       83
       83
       +
                close_in in_chan;

     

       84
       84
       +
                let waypoints = Gpx_doc.get_waypoints gpx2 in

     

       85
       85
       +
                let tracks = Gpx_doc.get_tracks gpx2 in

     

       86
       86
       +
                let routes = Gpx_doc.get_routes gpx2 in

     

       87
       87
       +
                Printf.printf "Read back GPX document with %d waypoints, %d tracks, %d routes\n" 

     

       88
       88
       +
                  (List.length waypoints) (List.length tracks) (List.length routes);

     

       89
       89
       +
                

     

       90
       90
       +
                (* Extract coordinates from track *)

     

       91
       91
       +
                (match tracks with

     

       92
       92
       +
                 | track :: _ ->

     

       93
       93
       +
                     let segments = Track.get_segments track in

     

       94
       94
       +
                     (match segments with

     

       95
       95
       +
                      | seg :: _ ->

     

       96
       96
       +
                          let points = Track.Segment.get_points seg in

     

       97
       97
       +
                          Printf.printf "Track coordinates: %d points\n" (List.length points);

     

       98
       98
       +
                          List.iteri (fun i pt ->

     

       99
       99
       +
                            let lat = Coordinate.latitude_to_float (Waypoint.get_lat pt) in

     

       100
       100
       +
                            let lon = Coordinate.longitude_to_float (Waypoint.get_lon pt) in

     

       101
       101
       +
                            Printf.printf "  Point %d: %.4f, %.4f\n" i lat lon

     

       102
       102
       +
                          ) points

     

       103
       103
       +
                      | [] -> Printf.printf "No track segments found\n")

     

       104
       104
       +
                 | [] -> Printf.printf "No tracks found\n")

     

       105
       105
       +
            | Error e ->

     

       106
       106
       +
                close_in in_chan;

     

       107
       107
       +
                Printf.eprintf "Error reading back GPX: %s\n" (Error.to_string e));

     

       67
       108
        
           

     

       68
       68
       -
           Printf.printf "\\nEio example completed successfully!\\n"

     

       109
       109
       +
           Printf.printf "\nExample completed successfully!\n"

     

       69
       110
        
           

     

       70
       111
        
         with

     

       71
       71
       -
         | Gpx.Gpx_error err ->

     

       72
       72
       -
             let error_msg = match err with

     

       73
       73
       -
               | Gpx.Invalid_xml s -> "Invalid XML: " ^ s

     

       74
       74
       -
               | Gpx.Invalid_coordinate s -> "Invalid coordinate: " ^ s

     

       75
       75
       -
               | Gpx.Missing_required_attribute (elem, attr) -> 

     

       76
       76
       -
                   Printf.sprintf "Missing required attribute '%s' in element '%s'" attr elem

     

       77
       77
       -
               | Gpx.Missing_required_element s -> "Missing required element: " ^ s

     

       78
       78
       -
               | Gpx.Validation_error s -> "Validation error: " ^ s

     

       79
       79
       -
               | Gpx.Xml_error s -> "XML error: " ^ s

     

       80
       80
       -
               | Gpx.IO_error s -> "I/O error: " ^ s

     

       81
       81
       -
             in

     

       82
       82
       -
             Printf.eprintf "GPX Error: %s\\n" error_msg;

     

       112
       112
       +
         | Gpx_error err ->

     

       113
       113
       +
             Printf.eprintf "GPX Error: %s\n" (Error.to_string err);

     

       83
       114
        
             exit 1

     

       84
       115
        
         | exn ->

     

       85
       85
       -
             Printf.eprintf "Unexpected error: %s\\n" (Printexc.to_string exn);

     

       86
       86
       -
             exit 1

     

       87
       87
       -
       

     

       88
       88
       -
       let () = Eio_main.run main
     

       116
       116
       +
             Printf.eprintf "Unexpected error: %s\n" (Printexc.to_string exn);

     

       117
       117
       +
             exit 1

+90 -104

examples/simple_gpx.ml

···

       7
       7
        
         

     

       8
       8
        
         (* Create coordinates using direct API *)

     

       9
       9
        
         let create_coordinate_pair lat_f lon_f =

     

       10
       10
       -
           match latitude lat_f, longitude lon_f with

     

       10
       10
       +
           match Coordinate.latitude lat_f, Coordinate.longitude lon_f with

     

       11
       11
        
           | Ok lat, Ok lon -> Ok (lat, lon)  

     

       12
       12
       -
           | Error e, _ | _, Error e -> Error (Invalid_coordinate e)

     

       12
       12
       +
           | Error e, _ | _, Error e -> Error (Error.invalid_coordinate e)

     

       13
       13
        
         in

     

       14
       14
        
         

     

       15
       15
        
         (* Create a simple waypoint *)

     

       16
       16
       -
         (match create_coordinate_pair 37.7749 (-122.4194) with

     

       17
       17
       -
          | Ok (lat, lon) ->

     

       18
       18
       -
            let wpt = make_waypoint_data lat lon in

     

       19
       19
       -
            let wpt = { wpt with name = Some "San Francisco"; desc = Some "Golden Gate Bridge area" } in

     

       20
       20
       -
            Printf.printf "✓ Created waypoint: %s\n" (Option.value wpt.name ~default:"<unnamed>");

     

       21
       21
       -
            

     

       22
       22
       -
            (* Create GPX document *)

     

       23
       23
       -
            let gpx = make_gpx ~creator:"mlgpx direct API example" in

     

       24
       24
       -
            let gpx = { gpx with waypoints = [wpt] } in

     

       25
       25
       -
            

     

       26
       26
       -
            (* Add metadata *)

     

       27
       27
       -
            let metadata = { empty_metadata with 

     

       28
       28
       -
              name = Some "Example GPX File";

     

       29
       29
       -
              desc = Some "Demonstration of mlgpx library capabilities";

     

       30
       30
       -
              time = None (* Ptime_clock not available in this context *)

     

       31
       31
       -
            } in

     

       32
       32
       -
            let gpx = { gpx with metadata = Some metadata } in

     

       33
       33
       -
            

     

       34
       34
       -
            (* Create a simple track *)

     

       35
       35
       -
            let track_points = [

     

       36
       36
       -
              (37.7749, -122.4194, Some "Start");

     

       37
       37
       -
              (37.7849, -122.4094, Some "Mid Point"); 

     

       38
       38
       -
              (37.7949, -122.3994, Some "End");

     

       39
       39
       -
            ] in

     

       40
       40
       -
            

     

       41
       41
       -
            let create_track_points acc (lat_f, lon_f, name) =

     

       42
       42
       -
              match create_coordinate_pair lat_f lon_f with

     

       43
       43
       -
              | Ok (lat, lon) -> 

     

       44
       44
       -
                let trkpt = make_waypoint_data lat lon in

     

       45
       45
       -
                let trkpt = { trkpt with name } in

     

       46
       46
       -
                trkpt :: acc

     

       47
       47
       -
              | Error _ -> acc

     

       48
       48
       -
            in

     

       49
       49
       -
            

     

       50
       50
       -
            let trkpts = List.fold_left create_track_points [] track_points |> List.rev in

     

       51
       51
       -
            let trkseg = { trkpts; extensions = [] } in

     

       52
       52
       -
            let track = {

     

       53
       53
       -
              name = Some "Example Track";

     

       54
       54
       -
              cmt = Some "Sample GPS track";

     

       55
       55
       -
              desc = Some "Demonstrates track creation";

     

       56
       56
       -
              src = None; links = []; number = None; type_ = None; extensions = [];

     

       57
       57
       -
              trksegs = [trkseg];

     

       58
       58
       -
            } in

     

       59
       59
       -
            let gpx = { gpx with tracks = [track] } in

     

       60
       60
       -
            

     

       61
       61
       -
            Printf.printf "✓ Created track with %d points\n" (List.length trkpts);

     

       62
       62
       -
            

     

       63
       63
       -
            (* Validate the document *)

     

       64
       64
       -
            let validation = validate_gpx gpx in

     

       65
       65
       -
            Printf.printf "✓ GPX validation: %s\n" (if validation.is_valid then "PASSED" else "FAILED");

     

       66
       66
       -
            

     

       67
       67
       -
            if not validation.is_valid then (

     

       68
       68
       -
              Printf.printf "Validation issues:\n";

     

       69
       69
       -
              List.iter (fun issue ->

     

       70
       70
       -
                Printf.printf "  %s: %s\n" 

     

       71
       71
       -
                  (match issue.level with `Error -> "ERROR" | `Warning -> "WARNING")

     

       72
       72
       -
                  issue.message

     

       73
       73
       -
              ) validation.issues

     

       74
       74
       -
            );

     

       75
       75
       -
            

     

       76
       76
       -
            (* Convert to XML string *)

     

       77
       77
       -
            (match write_string gpx with

     

       78
       78
       -
             | Ok xml_string ->

     

       79
       79
       -
               Printf.printf "✓ Generated XML (%d characters)\n" (String.length xml_string);

     

       80
       80
       -
               

     

       81
       81
       -
               (* Save to file using Unix layer for convenience *)

     

       82
       82
       -
               (match Gpx_unix.write ~validate:true "example_direct.gpx" gpx with

     

       83
       83
       -
                | Ok () -> 

     

       84
       84
       -
                  Printf.printf "✓ Saved to example_direct.gpx\n";

     

       85
       85
       -
                  

     

       86
       86
       -
                  (* Read it back to verify round-trip *)

     

       87
       87
       -
                  (match Gpx_unix.read ~validate:true "example_direct.gpx" with

     

       88
       88
       -
                   | Ok gpx2 ->

     

       89
       89
       -
                     Printf.printf "✓ Successfully read back GPX\n";

     

       90
       90
       -
                     let validation2 = validate_gpx gpx2 in

     

       91
       91
       -
                     Printf.printf "✓ Round-trip validation: %s\n" 

     

       92
       92
       -
                       (if validation2.is_valid then "PASSED" else "FAILED");

     

       93
       93
       -
                     Printf.printf "  Waypoints: %d, Tracks: %d\n"

     

       94
       94
       -
                       (List.length gpx2.waypoints) (List.length gpx2.tracks)

     

       95
       95
       -
                   | Error e ->

     

       96
       96
       -
                     Printf.printf "✗ Error reading back: %s\n"

     

       97
       97
       -
                       (match e with 

     

       98
       98
       -
                        | Invalid_xml s -> "Invalid XML: " ^ s

     

       99
       99
       -
                        | Validation_error s -> "Validation: " ^ s  

     

       100
       100
       -
                        | IO_error s -> "I/O: " ^ s

     

       101
       101
       -
                        | _ -> "Unknown error"))

     

       102
       102
       -
                | Error e ->

     

       103
       103
       -
                  Printf.printf "✗ Error saving file: %s\n"

     

       104
       104
       -
                    (match e with 

     

       105
       105
       -
                     | IO_error s -> s

     

       106
       106
       -
                     | Validation_error s -> s

     

       107
       107
       -
                     | _ -> "Unknown error"))

     

       108
       108
       -
             | Error e ->

     

       109
       109
       -
               Printf.printf "✗ Error generating XML: %s\n"

     

       110
       110
       -
                 (match e with 

     

       111
       111
       -
                  | Invalid_xml s -> s

     

       112
       112
       -
                  | Xml_error s -> s

     

       113
       113
       -
                  | _ -> "Unknown error"))

     

       114
       114
       -
          | Error e ->

     

       115
       115
       -
            Printf.printf "✗ Error creating coordinates: %s\n" 

     

       116
       116
       -
              (match e with Invalid_coordinate s -> s | _ -> "Unknown error"));

     

       16
       16
       +
         let result = create_coordinate_pair 37.7749 (-122.4194) in

     

       17
       17
       +
         match result with

     

       18
       18
       +
         | Ok (lat, lon) ->

     

       19
       19
       +
           let wpt = Waypoint.make lat lon in

     

       20
       20
       +
           let wpt = Waypoint.with_name wpt "San Francisco" in

     

       21
       21
       +
           let wpt = Waypoint.with_description wpt "Golden Gate Bridge area" in

     

       22
       22
       +
           Printf.printf "✓ Created waypoint: %s\n" (Option.value (Waypoint.get_name wpt) ~default:"<unnamed>");

     

       23
       23
       +
           

     

       24
       24
       +
           (* Create GPX document *)

     

       25
       25
       +
           let gpx = Gpx_doc.empty ~creator:"mlgpx direct API example" in

     

       26
       26
       +
           let gpx = Gpx_doc.add_waypoint gpx wpt in

     

       27
       27
       +
           

     

       28
       28
       +
           (* Add metadata *)

     

       29
       29
       +
           let metadata = Metadata.empty in

     

       30
       30
       +
           let metadata = Metadata.with_name metadata "Example GPX File" in

     

       31
       31
       +
           let metadata = Metadata.with_description metadata "Demonstration of mlgpx library capabilities" in

     

       32
       32
       +
           let gpx = Gpx_doc.with_metadata gpx metadata in

     

       33
       33
       +
           

     

       34
       34
       +
           (* Create a simple track with points *)

     

       35
       35
       +
           let track = Track.make ~name:"Example Track" in

     

       36
       36
       +
           let track = Track.with_comment track "Sample GPS track" in

     

       37
       37
       +
           let track = Track.with_description track "Demonstrates track creation" in

     

       38
       38
       +
           

     

       39
       39
       +
           (* Create track segment with points *)

     

       40
       40
       +
           let track_segment = Track.Segment.empty in

     

       41
       41
       +
           let points = [

     

       42
       42
       +
             (37.7749, -122.4194);

     

       43
       43
       +
             (37.7849, -122.4094); 

     

       44
       44
       +
             (37.7949, -122.3994);

     

       45
       45
       +
           ] in

     

       46
       46
       +
           let track_segment = 

     

       47
       47
       +
             List.fold_left (fun seg (lat_f, lon_f) ->

     

       48
       48
       +
               match Coordinate.latitude lat_f, Coordinate.longitude lon_f with

     

       49
       49
       +
               | Ok lat, Ok lon ->

     

       50
       50
       +
                   let pt = Waypoint.make lat lon in

     

       51
       51
       +
                   Track.Segment.add_point seg pt

     

       52
       52
       +
               | _ -> seg

     

       53
       53
       +
             ) track_segment points in

     

       54
       54
       +
           

     

       55
       55
       +
           let track = Track.add_segment track track_segment in

     

       56
       56
       +
           let gpx = Gpx_doc.add_track gpx track in

     

       57
       57
       +
           

     

       58
       58
       +
           Printf.printf "✓ Created track\n";

     

       59
       59
       +
           

     

       60
       60
       +
           (* Validate the document *)

     

       61
       61
       +
           let validation = validate_gpx gpx in

     

       62
       62
       +
           Printf.printf "✓ GPX validation: %s\n" (if validation.is_valid then "PASSED" else "FAILED");

     

       63
       63
       +
           

     

       64
       64
       +
           (* Convert to XML string *)

     

       65
       65
       +
           let xml_result = write_string gpx in

     

       66
       66
       +
           (match xml_result with

     

       67
       67
       +
            | Ok xml_string ->

     

       68
       68
       +
              Printf.printf "✓ Generated XML (%d characters)\n" (String.length xml_string);

     

       69
       69
       +
              

     

       70
       70
       +
              (* Save to file - write directly using core API *)

     

       71
       71
       +
              let out_chan = open_out "example_direct.gpx" in

     

       72
       72
       +
              let dest = (`Channel out_chan) in

     

       73
       73
       +
              let write_result = write ~validate:true dest gpx in

     

       74
       74
       +
              close_out out_chan;

     

       75
       75
       +
              (match write_result with

     

       76
       76
       +
               | Ok () -> 

     

       77
       77
       +
                 Printf.printf "✓ Saved to example_direct.gpx\n";

     

       78
       78
       +
                 

     

       79
       79
       +
                 (* Read it back to verify round-trip *)

     

       80
       80
       +
                 let in_chan = open_in "example_direct.gpx" in

     

       81
       81
       +
                 let input = Xmlm.make_input (`Channel in_chan) in

     

       82
       82
       +
                 let read_result = parse ~validate:true input in

     

       83
       83
       +
                 close_in in_chan;

     

       84
       84
       +
                 (match read_result with

     

       85
       85
       +
                  | Ok gpx2 ->

     

       86
       86
       +
                    Printf.printf "✓ Successfully read back GPX\n";

     

       87
       87
       +
                    let validation2 = validate_gpx gpx2 in

     

       88
       88
       +
                    Printf.printf "✓ Round-trip validation: %s\n" 

     

       89
       89
       +
                      (if validation2.is_valid then "PASSED" else "FAILED");

     

       90
       90
       +
                    Printf.printf "  Waypoints: %d, Tracks: %d\n"

     

       91
       91
       +
                      (List.length (Gpx_doc.get_waypoints gpx2)) (List.length (Gpx_doc.get_tracks gpx2))

     

       92
       92
       +
                  | Error e ->

     

       93
       93
       +
                    Printf.printf "✗ Error reading back: %s\n" (Error.to_string e)

     

       94
       94
       +
                 )

     

       95
       95
       +
               | Error e ->

     

       96
       96
       +
                 Printf.printf "✗ Error saving file: %s\n" (Error.to_string e)

     

       97
       97
       +
              )

     

       98
       98
       +
            | Error e ->

     

       99
       99
       +
              Printf.printf "✗ Error generating XML: %s\n" (Error.to_string e)

     

       100
       100
       +
           )

     

       101
       101
       +
         | Error e ->

     

       102
       102
       +
           Printf.printf "✗ Error creating coordinates: %s\n" (Error.to_string e);

     

       117
       103
        
         

     

       118
       118
       -
         Printf.printf "\n=== Example Complete ===\n"
     

       104
       104
       +
         Printf.printf "\n=== Example Complete ===\n"

+59

lib/gpx/coordinate.ml

···

       1
       1
       +
       (** Geographic coordinate types with validation *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Private coordinate types with validation constraints *)

     

       4
       4
       +
       type latitude = private float

     

       5
       5
       +
       type longitude = private float  

     

       6
       6
       +
       type degrees = private float

     

       7
       7
       +
       

     

       8
       8
       +
       (** Coordinate pair - main type for this module *)

     

       9
       9
       +
       type t = {

     

       10
       10
       +
         lat : latitude;

     

       11
       11
       +
         lon : longitude;

     

       12
       12
       +
       }

     

       13
       13
       +
       

     

       14
       14
       +
       (** Smart constructors for validated coordinates *)

     

       15
       15
       +
       let latitude f =

     

       16
       16
       +
         if f >= -90.0 && f <= 90.0 then Ok (Obj.magic f : latitude)

     

       17
       17
       +
         else Error (Printf.sprintf "Invalid latitude: %f (must be between -90.0 and 90.0)" f)

     

       18
       18
       +
       

     

       19
       19
       +
       let longitude f =

     

       20
       20
       +
         if f >= -180.0 && f < 180.0 then Ok (Obj.magic f : longitude)

     

       21
       21
       +
         else Error (Printf.sprintf "Invalid longitude: %f (must be between -180.0 and 180.0)" f)

     

       22
       22
       +
       

     

       23
       23
       +
       let degrees f =

     

       24
       24
       +
         if f >= 0.0 && f < 360.0 then Ok (Obj.magic f : degrees)

     

       25
       25
       +
         else Error (Printf.sprintf "Invalid degrees: %f (must be between 0.0 and 360.0)" f)

     

       26
       26
       +
       

     

       27
       27
       +
       (** Convert back to float *)

     

       28
       28
       +
       let latitude_to_float (lat : latitude) = (lat :> float)

     

       29
       29
       +
       let longitude_to_float (lon : longitude) = (lon :> float)

     

       30
       30
       +
       let degrees_to_float (deg : degrees) = (deg :> float)

     

       31
       31
       +
       

     

       32
       32
       +
       (** Create coordinate pair *)

     

       33
       33
       +
       let make lat lon = { lat; lon }

     

       34
       34
       +
       

     

       35
       35
       +
       (** Create coordinate pair from floats with validation *)

     

       36
       36
       +
       let make_from_floats lat_f lon_f =

     

       37
       37
       +
         match latitude lat_f, longitude lon_f with

     

       38
       38
       +
         | Ok lat, Ok lon -> Ok { lat; lon }

     

       39
       39
       +
         | Error e, _ | _, Error e -> Error e

     

       40
       40
       +
       

     

       41
       41
       +
       (** Extract components *)

     

       42
       42
       +
       let get_lat t = t.lat

     

       43
       43
       +
       let get_lon t = t.lon

     

       44
       44
       +
       let to_floats t = (latitude_to_float t.lat, longitude_to_float t.lon)

     

       45
       45
       +
       

     

       46
       46
       +
       (** Compare coordinates *)

     

       47
       47
       +
       let compare t1 t2 =

     

       48
       48
       +
         let lat_cmp = Float.compare (latitude_to_float t1.lat) (latitude_to_float t2.lat) in

     

       49
       49
       +
         if lat_cmp <> 0 then lat_cmp

     

       50
       50
       +
         else Float.compare (longitude_to_float t1.lon) (longitude_to_float t2.lon)

     

       51
       51
       +
       

     

       52
       52
       +
       (** Equality *)

     

       53
       53
       +
       let equal t1 t2 = compare t1 t2 = 0

     

       54
       54
       +
       

     

       55
       55
       +
       (** Pretty printer *)

     

       56
       56
       +
       let pp ppf t =

     

       57
       57
       +
         Format.fprintf ppf "(%g, %g)" 

     

       58
       58
       +
           (latitude_to_float t.lat) 

     

       59
       59
       +
           (longitude_to_float t.lon)

+68

lib/gpx/coordinate.mli

···

       1
       1
       +
       (** Geographic coordinate types with validation *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Private coordinate types with validation constraints *)

     

       4
       4
       +
       type latitude = private float

     

       5
       5
       +
       type longitude = private float  

     

       6
       6
       +
       type degrees = private float

     

       7
       7
       +
       

     

       8
       8
       +
       (** Coordinate pair - main type for this module *)

     

       9
       9
       +
       type t = {

     

       10
       10
       +
         lat : latitude;

     

       11
       11
       +
         lon : longitude;

     

       12
       12
       +
       }

     

       13
       13
       +
       

     

       14
       14
       +
       (** {2 Smart Constructors} *)

     

       15
       15
       +
       

     

       16
       16
       +
       (** Create validated latitude.

     

       17
       17
       +
           @param f Latitude in degrees (-90.0 to 90.0)

     

       18
       18
       +
           @return [Ok latitude] or [Error msg] *)

     

       19
       19
       +
       val latitude : float -> (latitude, string) result

     

       20
       20
       +
       

     

       21
       21
       +
       (** Create validated longitude.

     

       22
       22
       +
           @param f Longitude in degrees (-180.0 to 180.0)

     

       23
       23
       +
           @return [Ok longitude] or [Error msg] *)

     

       24
       24
       +
       val longitude : float -> (longitude, string) result

     

       25
       25
       +
       

     

       26
       26
       +
       (** Create validated degrees.

     

       27
       27
       +
           @param f Degrees (0.0 to 360.0)

     

       28
       28
       +
           @return [Ok degrees] or [Error msg] *)

     

       29
       29
       +
       val degrees : float -> (degrees, string) result

     

       30
       30
       +
       

     

       31
       31
       +
       (** {2 Conversion Functions} *)

     

       32
       32
       +
       

     

       33
       33
       +
       (** Convert latitude to float *)

     

       34
       34
       +
       val latitude_to_float : latitude -> float

     

       35
       35
       +
       

     

       36
       36
       +
       (** Convert longitude to float *)

     

       37
       37
       +
       val longitude_to_float : longitude -> float

     

       38
       38
       +
       

     

       39
       39
       +
       (** Convert degrees to float *)

     

       40
       40
       +
       val degrees_to_float : degrees -> float

     

       41
       41
       +
       

     

       42
       42
       +
       (** {2 Coordinate Operations} *)

     

       43
       43
       +
       

     

       44
       44
       +
       (** Create coordinate pair from validated components *)

     

       45
       45
       +
       val make : latitude -> longitude -> t

     

       46
       46
       +
       

     

       47
       47
       +
       (** Create coordinate pair from floats with validation *)

     

       48
       48
       +
       val make_from_floats : float -> float -> (t, string) result

     

       49
       49
       +
       

     

       50
       50
       +
       (** Extract latitude component *)

     

       51
       51
       +
       val get_lat : t -> latitude

     

       52
       52
       +
       

     

       53
       53
       +
       (** Extract longitude component *)

     

       54
       54
       +
       val get_lon : t -> longitude

     

       55
       55
       +
       

     

       56
       56
       +
       (** Convert coordinate to float pair *)

     

       57
       57
       +
       val to_floats : t -> float * float

     

       58
       58
       +
       

     

       59
       59
       +
       (** {2 Comparison and Utilities} *)

     

       60
       60
       +
       

     

       61
       61
       +
       (** Compare two coordinates *)

     

       62
       62
       +
       val compare : t -> t -> int

     

       63
       63
       +
       

     

       64
       64
       +
       (** Test coordinate equality *)

     

       65
       65
       +
       val equal : t -> t -> bool

     

       66
       66
       +
       

     

       67
       67
       +
       (** Pretty print coordinate *)

     

       68
       68
       +
       val pp : Format.formatter -> t -> unit

+1 -1

lib/gpx/dune

···

       2
       2
        
        (public_name mlgpx.core)

     

       3
       3
        
        (name gpx)

     

       4
       4
        
        (libraries xmlm ptime)

     

       5
       5
       -
        (modules gpx types parser writer validate))
     

       5
       5
       +
        (modules gpx parser writer validate coordinate link extension waypoint metadata route track error gpx_doc))

+111

lib/gpx/error.ml

···

       1
       1
       +
       (** Error types and exception handling for GPX operations *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Main error type *)

     

       4
       4
       +
       type t =

     

       5
       5
       +
         | Invalid_xml of string

     

       6
       6
       +
         | Invalid_coordinate of string

     

       7
       7
       +
         | Missing_required_attribute of string * string

     

       8
       8
       +
         | Missing_required_element of string

     

       9
       9
       +
         | Validation_error of string

     

       10
       10
       +
         | Xml_error of string

     

       11
       11
       +
         | IO_error of string

     

       12
       12
       +
       

     

       13
       13
       +
       (** GPX exception *)

     

       14
       14
       +
       exception Gpx_error of t

     

       15
       15
       +
       

     

       16
       16
       +
       (** Result type for operations that can fail *)

     

       17
       17
       +
       type 'a result = ('a, t) Result.t

     

       18
       18
       +
       

     

       19
       19
       +
       (** {2 Error Operations} *)

     

       20
       20
       +
       

     

       21
       21
       +
       (** Convert error to string *)

     

       22
       22
       +
       let to_string = function

     

       23
       23
       +
         | Invalid_xml msg -> "Invalid XML: " ^ msg

     

       24
       24
       +
         | Invalid_coordinate msg -> "Invalid coordinate: " ^ msg

     

       25
       25
       +
         | Missing_required_attribute (element, attr) ->

     

       26
       26
       +
           Printf.sprintf "Missing required attribute '%s' in element '%s'" attr element

     

       27
       27
       +
         | Missing_required_element element ->

     

       28
       28
       +
           Printf.sprintf "Missing required element '%s'" element

     

       29
       29
       +
         | Validation_error msg -> "Validation error: " ^ msg

     

       30
       30
       +
         | Xml_error msg -> "XML error: " ^ msg

     

       31
       31
       +
         | IO_error msg -> "IO error: " ^ msg

     

       32
       32
       +
       

     

       33
       33
       +
       (** Pretty print error *)

     

       34
       34
       +
       let pp ppf error = Format.fprintf ppf "%s" (to_string error)

     

       35
       35
       +
       

     

       36
       36
       +
       (** Create invalid XML error *)

     

       37
       37
       +
       let invalid_xml msg = Invalid_xml msg

     

       38
       38
       +
       

     

       39
       39
       +
       (** Create invalid coordinate error *)

     

       40
       40
       +
       let invalid_coordinate msg = Invalid_coordinate msg

     

       41
       41
       +
       

     

       42
       42
       +
       (** Create missing attribute error *)

     

       43
       43
       +
       let missing_attribute element attr = Missing_required_attribute (element, attr)

     

       44
       44
       +
       

     

       45
       45
       +
       (** Create missing element error *)

     

       46
       46
       +
       let missing_element element = Missing_required_element element

     

       47
       47
       +
       

     

       48
       48
       +
       (** Create validation error *)

     

       49
       49
       +
       let validation_error msg = Validation_error msg

     

       50
       50
       +
       

     

       51
       51
       +
       (** Create XML error *)

     

       52
       52
       +
       let xml_error msg = Xml_error msg

     

       53
       53
       +
       

     

       54
       54
       +
       (** Create IO error *)

     

       55
       55
       +
       let io_error msg = IO_error msg

     

       56
       56
       +
       

     

       57
       57
       +
       (** Compare errors *)

     

       58
       58
       +
       let compare e1 e2 = String.compare (to_string e1) (to_string e2)

     

       59
       59
       +
       

     

       60
       60
       +
       (** Test error equality *)

     

       61
       61
       +
       let equal e1 e2 = compare e1 e2 = 0

     

       62
       62
       +
       

     

       63
       63
       +
       (** {2 Result Helpers} *)

     

       64
       64
       +
       

     

       65
       65
       +
       (** Convert exception to result *)

     

       66
       66
       +
       let catch f x =

     

       67
       67
       +
         try Ok (f x)

     

       68
       68
       +
         with Gpx_error e -> Error e

     

       69
       69
       +
       

     

       70
       70
       +
       (** Convert result to exception *)

     

       71
       71
       +
       let get_exn = function

     

       72
       72
       +
         | Ok x -> x

     

       73
       73
       +
         | Error e -> raise (Gpx_error e)

     

       74
       74
       +
       

     

       75
       75
       +
       (** Map over result *)

     

       76
       76
       +
       let map f = function

     

       77
       77
       +
         | Ok x -> Ok (f x)

     

       78
       78
       +
         | Error e -> Error e

     

       79
       79
       +
       

     

       80
       80
       +
       (** Bind over result *)

     

       81
       81
       +
       let bind result f = 

     

       82
       82
       +
         match result with

     

       83
       83
       +
         | Ok x -> f x

     

       84
       84
       +
         | Error e -> Error e

     

       85
       85
       +
       

     

       86
       86
       +
       (** Convert string result to error result *)

     

       87
       87
       +
       let from_string_result = function

     

       88
       88
       +
         | Ok x -> Ok x

     

       89
       89
       +
         | Error msg -> Error (Invalid_xml msg)

     

       90
       90
       +
       

     

       91
       91
       +
       (** {2 Error Classification} *)

     

       92
       92
       +
       

     

       93
       93
       +
       (** Check if error is XML-related *)

     

       94
       94
       +
       let is_xml_error = function

     

       95
       95
       +
         | Invalid_xml _ | Xml_error _ -> true

     

       96
       96
       +
         | _ -> false

     

       97
       97
       +
       

     

       98
       98
       +
       (** Check if error is coordinate-related *)

     

       99
       99
       +
       let is_coordinate_error = function

     

       100
       100
       +
         | Invalid_coordinate _ -> true

     

       101
       101
       +
         | _ -> false

     

       102
       102
       +
       

     

       103
       103
       +
       (** Check if error is validation-related *)

     

       104
       104
       +
       let is_validation_error = function

     

       105
       105
       +
         | Validation_error _ | Missing_required_attribute _ | Missing_required_element _ -> true

     

       106
       106
       +
         | _ -> false

     

       107
       107
       +
       

     

       108
       108
       +
       (** Check if error is IO-related *)

     

       109
       109
       +
       let is_io_error = function

     

       110
       110
       +
         | IO_error _ -> true

     

       111
       111
       +
         | _ -> false

+85

lib/gpx/error.mli

···

       1
       1
       +
       (** Error types and exception handling for GPX operations *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Main error type *)

     

       4
       4
       +
       type t =

     

       5
       5
       +
         | Invalid_xml of string                          (** XML parsing/structure error *)

     

       6
       6
       +
         | Invalid_coordinate of string                   (** Coordinate validation error *)

     

       7
       7
       +
         | Missing_required_attribute of string * string (** Missing XML attribute (element, attr) *)

     

       8
       8
       +
         | Missing_required_element of string             (** Missing XML element *)

     

       9
       9
       +
         | Validation_error of string                     (** GPX validation error *)

     

       10
       10
       +
         | Xml_error of string                           (** Lower-level XML error *)

     

       11
       11
       +
         | IO_error of string                            (** File I/O error *)

     

       12
       12
       +
       

     

       13
       13
       +
       (** GPX exception *)

     

       14
       14
       +
       exception Gpx_error of t

     

       15
       15
       +
       

     

       16
       16
       +
       (** Result type for operations that can fail *)

     

       17
       17
       +
       type 'a result = ('a, t) Result.t

     

       18
       18
       +
       

     

       19
       19
       +
       (** {2 Error Operations} *)

     

       20
       20
       +
       

     

       21
       21
       +
       (** Convert error to human-readable string *)

     

       22
       22
       +
       val to_string : t -> string

     

       23
       23
       +
       

     

       24
       24
       +
       (** Pretty print error *)

     

       25
       25
       +
       val pp : Format.formatter -> t -> unit

     

       26
       26
       +
       

     

       27
       27
       +
       (** Compare errors *)

     

       28
       28
       +
       val compare : t -> t -> int

     

       29
       29
       +
       

     

       30
       30
       +
       (** Test error equality *)

     

       31
       31
       +
       val equal : t -> t -> bool

     

       32
       32
       +
       

     

       33
       33
       +
       (** {2 Error Constructors} *)

     

       34
       34
       +
       

     

       35
       35
       +
       (** Create invalid XML error *)

     

       36
       36
       +
       val invalid_xml : string -> t

     

       37
       37
       +
       

     

       38
       38
       +
       (** Create invalid coordinate error *)

     

       39
       39
       +
       val invalid_coordinate : string -> t

     

       40
       40
       +
       

     

       41
       41
       +
       (** Create missing attribute error *)

     

       42
       42
       +
       val missing_attribute : string -> string -> t

     

       43
       43
       +
       

     

       44
       44
       +
       (** Create missing element error *)

     

       45
       45
       +
       val missing_element : string -> t

     

       46
       46
       +
       

     

       47
       47
       +
       (** Create validation error *)

     

       48
       48
       +
       val validation_error : string -> t

     

       49
       49
       +
       

     

       50
       50
       +
       (** Create XML error *)

     

       51
       51
       +
       val xml_error : string -> t

     

       52
       52
       +
       

     

       53
       53
       +
       (** Create IO error *)

     

       54
       54
       +
       val io_error : string -> t

     

       55
       55
       +
       

     

       56
       56
       +
       (** {2 Result Helpers} *)

     

       57
       57
       +
       

     

       58
       58
       +
       (** Convert exception to result *)

     

       59
       59
       +
       val catch : ('a -> 'b) -> 'a -> 'b result

     

       60
       60
       +
       

     

       61
       61
       +
       (** Convert result to exception *)

     

       62
       62
       +
       val get_exn : 'a result -> 'a

     

       63
       63
       +
       

     

       64
       64
       +
       (** Map over result *)

     

       65
       65
       +
       val map : ('a -> 'b) -> 'a result -> 'b result

     

       66
       66
       +
       

     

       67
       67
       +
       (** Bind over result *)

     

       68
       68
       +
       val bind : 'a result -> ('a -> 'b result) -> 'b result

     

       69
       69
       +
       

     

       70
       70
       +
       (** Convert string result to error result *)

     

       71
       71
       +
       val from_string_result : ('a, string) Result.t -> 'a result

     

       72
       72
       +
       

     

       73
       73
       +
       (** {2 Error Classification} *)

     

       74
       74
       +
       

     

       75
       75
       +
       (** Check if error is XML-related *)

     

       76
       76
       +
       val is_xml_error : t -> bool

     

       77
       77
       +
       

     

       78
       78
       +
       (** Check if error is coordinate-related *)

     

       79
       79
       +
       val is_coordinate_error : t -> bool

     

       80
       80
       +
       

     

       81
       81
       +
       (** Check if error is validation-related *)

     

       82
       82
       +
       val is_validation_error : t -> bool

     

       83
       83
       +
       

     

       84
       84
       +
       (** Check if error is IO-related *)

     

       85
       85
       +
       val is_io_error : t -> bool

+144

lib/gpx/extension.ml

···

       1
       1
       +
       (** Extension mechanism for custom GPX elements *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Main extension type *)

     

       4
       4
       +
       type t = {

     

       5
       5
       +
         namespace : string option;

     

       6
       6
       +
         name : string;

     

       7
       7
       +
         attributes : (string * string) list;

     

       8
       8
       +
         content : content;

     

       9
       9
       +
       }

     

       10
       10
       +
       

     

       11
       11
       +
       (** Content types for extensions *)

     

       12
       12
       +
       and content =

     

       13
       13
       +
         | Text of string

     

       14
       14
       +
         | Elements of t list

     

       15
       15
       +
         | Mixed of string * t list

     

       16
       16
       +
       

     

       17
       17
       +
       (** {2 Extension Operations} *)

     

       18
       18
       +
       

     

       19
       19
       +
       (** Create extension with flexible content *)

     

       20
       20
       +
       let make ~namespace ~name ~attributes ~content () =

     

       21
       21
       +
         { namespace; name; attributes; content }

     

       22
       22
       +
       

     

       23
       23
       +
       (** Create an extension with text content *)

     

       24
       24
       +
       let make_text ~name ?namespace ?(attributes=[]) text =

     

       25
       25
       +
         { namespace; name; attributes; content = Text text }

     

       26
       26
       +
       

     

       27
       27
       +
       (** Create an extension with element content *)

     

       28
       28
       +
       let make_elements ~name ?namespace ?(attributes=[]) elements =

     

       29
       29
       +
         { namespace; name; attributes; content = Elements elements }

     

       30
       30
       +
       

     

       31
       31
       +
       (** Create an extension with mixed content *)

     

       32
       32
       +
       let make_mixed ~name ?namespace ?(attributes=[]) text elements =

     

       33
       33
       +
         { namespace; name; attributes; content = Mixed (text, elements) }

     

       34
       34
       +
       

     

       35
       35
       +
       (** Get extension name *)

     

       36
       36
       +
       let get_name t = t.name

     

       37
       37
       +
       

     

       38
       38
       +
       (** Get optional namespace *)

     

       39
       39
       +
       let get_namespace t = t.namespace

     

       40
       40
       +
       

     

       41
       41
       +
       (** Get attributes *)

     

       42
       42
       +
       let get_attributes t = t.attributes

     

       43
       43
       +
       

     

       44
       44
       +
       (** Get content *)

     

       45
       45
       +
       let get_content t = t.content

     

       46
       46
       +
       

     

       47
       47
       +
       (** Create text content *)

     

       48
       48
       +
       let text_content text = Text text

     

       49
       49
       +
       

     

       50
       50
       +
       (** Create elements content *)

     

       51
       51
       +
       let elements_content elements = Elements elements

     

       52
       52
       +
       

     

       53
       53
       +
       (** Create mixed content *)

     

       54
       54
       +
       let mixed_content text elements = Mixed (text, elements)

     

       55
       55
       +
       

     

       56
       56
       +
       (** Find attribute value by name *)

     

       57
       57
       +
       let find_attribute name t =

     

       58
       58
       +
         List.assoc_opt name t.attributes

     

       59
       59
       +
       

     

       60
       60
       +
       (** Add or update attribute *)

     

       61
       61
       +
       let set_attribute name value t =

     

       62
       62
       +
         let attributes = 

     

       63
       63
       +
           (name, value) :: List.remove_assoc name t.attributes

     

       64
       64
       +
         in

     

       65
       65
       +
         { t with attributes }

     

       66
       66
       +
       

     

       67
       67
       +
       (** Compare extensions *)

     

       68
       68
       +
       let rec compare t1 t2 =

     

       69
       69
       +
         let ns_cmp = Option.compare String.compare t1.namespace t2.namespace in

     

       70
       70
       +
         if ns_cmp <> 0 then ns_cmp

     

       71
       71
       +
         else

     

       72
       72
       +
           let name_cmp = String.compare t1.name t2.name in

     

       73
       73
       +
           if name_cmp <> 0 then name_cmp

     

       74
       74
       +
           else

     

       75
       75
       +
             let attr_cmp = compare_attributes t1.attributes t2.attributes in

     

       76
       76
       +
             if attr_cmp <> 0 then attr_cmp

     

       77
       77
       +
             else compare_content t1.content t2.content

     

       78
       78
       +
       

     

       79
       79
       +
       and compare_attributes attrs1 attrs2 =

     

       80
       80
       +
         let sorted1 = List.sort (fun (k1,_) (k2,_) -> String.compare k1 k2) attrs1 in

     

       81
       81
       +
         let sorted2 = List.sort (fun (k1,_) (k2,_) -> String.compare k1 k2) attrs2 in

     

       82
       82
       +
         List.compare (fun (k1,v1) (k2,v2) ->

     

       83
       83
       +
           let k_cmp = String.compare k1 k2 in

     

       84
       84
       +
           if k_cmp <> 0 then k_cmp else String.compare v1 v2

     

       85
       85
       +
         ) sorted1 sorted2

     

       86
       86
       +
       

     

       87
       87
       +
       and compare_content c1 c2 = match c1, c2 with

     

       88
       88
       +
         | Text s1, Text s2 -> String.compare s1 s2

     

       89
       89
       +
         | Elements e1, Elements e2 -> List.compare compare e1 e2

     

       90
       90
       +
         | Mixed (s1, e1), Mixed (s2, e2) ->

     

       91
       91
       +
           let s_cmp = String.compare s1 s2 in

     

       92
       92
       +
           if s_cmp <> 0 then s_cmp else List.compare compare e1 e2

     

       93
       93
       +
         | Text _, _ -> -1

     

       94
       94
       +
         | Elements _, Text _ -> 1

     

       95
       95
       +
         | Elements _, Mixed _ -> -1

     

       96
       96
       +
         | Mixed _, _ -> 1

     

       97
       97
       +
       

     

       98
       98
       +
       (** Test extension equality *)

     

       99
       99
       +
       let equal t1 t2 = compare t1 t2 = 0

     

       100
       100
       +
       

     

       101
       101
       +
       (** Pretty print extension *)

     

       102
       102
       +
       let rec pp ppf t =

     

       103
       103
       +
         match t.namespace with

     

       104
       104
       +
         | Some ns -> Format.fprintf ppf "<%s:%s" ns t.name

     

       105
       105
       +
         | None -> Format.fprintf ppf "<%s" t.name;

     

       106
       106
       +
         List.iter (fun (k, v) -> Format.fprintf ppf " %s=\"%s\"" k v) t.attributes;

     

       107
       107
       +
         match t.content with

     

       108
       108
       +
         | Text "" -> Format.fprintf ppf "/>"

     

       109
       109
       +
         | Text text -> Format.fprintf ppf ">%s</%s>" text (qualified_name t)

     

       110
       110
       +
         | Elements [] -> Format.fprintf ppf "/>"

     

       111
       111
       +
         | Elements elements ->

     

       112
       112
       +
           Format.fprintf ppf ">";

     

       113
       113
       +
           List.iter (Format.fprintf ppf "%a" pp) elements;

     

       114
       114
       +
           Format.fprintf ppf "</%s>" (qualified_name t)

     

       115
       115
       +
         | Mixed (text, []) -> Format.fprintf ppf ">%s</%s>" text (qualified_name t)

     

       116
       116
       +
         | Mixed (text, elements) ->

     

       117
       117
       +
           Format.fprintf ppf ">%s" text;

     

       118
       118
       +
           List.iter (Format.fprintf ppf "%a" pp) elements;

     

       119
       119
       +
           Format.fprintf ppf "</%s>" (qualified_name t)

     

       120
       120
       +
       

     

       121
       121
       +
       and qualified_name t =

     

       122
       122
       +
         match t.namespace with

     

       123
       123
       +
         | Some ns -> ns ^ ":" ^ t.name

     

       124
       124
       +
         | None -> t.name

     

       125
       125
       +
       

     

       126
       126
       +
       (** {2 Content Operations} *)

     

       127
       127
       +
       

     

       128
       128
       +
       (** Check if content is text *)

     

       129
       129
       +
       let is_text_content = function Text _ -> true | _ -> false

     

       130
       130
       +
       

     

       131
       131
       +
       (** Check if content is elements *)

     

       132
       132
       +
       let is_elements_content = function Elements _ -> true | _ -> false

     

       133
       133
       +
       

     

       134
       134
       +
       (** Check if content is mixed *)

     

       135
       135
       +
       let is_mixed_content = function Mixed _ -> true | _ -> false

     

       136
       136
       +
       

     

       137
       137
       +
       (** Extract text content *)

     

       138
       138
       +
       let get_text_content = function Text s -> Some s | _ -> None

     

       139
       139
       +
       

     

       140
       140
       +
       (** Extract element content *)

     

       141
       141
       +
       let get_elements_content = function Elements e -> Some e | _ -> None

     

       142
       142
       +
       

     

       143
       143
       +
       (** Extract mixed content *)

     

       144
       144
       +
       let get_mixed_content = function Mixed (s, e) -> Some (s, e) | _ -> None

+87

lib/gpx/extension.mli

···

       1
       1
       +
       (** Extension mechanism for custom GPX elements *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Main extension type *)

     

       4
       4
       +
       type t = {

     

       5
       5
       +
         namespace : string option;          (** Optional XML namespace *)

     

       6
       6
       +
         name : string;                     (** Element name *)

     

       7
       7
       +
         attributes : (string * string) list; (** Element attributes *)

     

       8
       8
       +
         content : content;                 (** Element content *)

     

       9
       9
       +
       }

     

       10
       10
       +
       

     

       11
       11
       +
       (** Content types for extensions *)

     

       12
       12
       +
       and content =

     

       13
       13
       +
         | Text of string                    (** Simple text content *)

     

       14
       14
       +
         | Elements of t list               (** Nested elements *)

     

       15
       15
       +
         | Mixed of string * t list         (** Mixed text and elements *)

     

       16
       16
       +
       

     

       17
       17
       +
       (** {2 Extension Constructors} *)

     

       18
       18
       +
       

     

       19
       19
       +
       (** Create extension with flexible content *)

     

       20
       20
       +
       val make : namespace:string option -> name:string -> attributes:(string * string) list -> content:content -> unit -> t

     

       21
       21
       +
       

     

       22
       22
       +
       (** Create an extension with text content *)

     

       23
       23
       +
       val make_text : name:string -> ?namespace:string -> ?attributes:(string * string) list -> string -> t

     

       24
       24
       +
       

     

       25
       25
       +
       (** Create an extension with element content *)

     

       26
       26
       +
       val make_elements : name:string -> ?namespace:string -> ?attributes:(string * string) list -> t list -> t

     

       27
       27
       +
       

     

       28
       28
       +
       (** Create an extension with mixed content *)

     

       29
       29
       +
       val make_mixed : name:string -> ?namespace:string -> ?attributes:(string * string) list -> string -> t list -> t

     

       30
       30
       +
       

     

       31
       31
       +
       (** {2 Extension Operations} *)

     

       32
       32
       +
       

     

       33
       33
       +
       (** Get extension name *)

     

       34
       34
       +
       val get_name : t -> string

     

       35
       35
       +
       

     

       36
       36
       +
       (** Get optional namespace *)

     

       37
       37
       +
       val get_namespace : t -> string option

     

       38
       38
       +
       

     

       39
       39
       +
       (** Get attributes *)

     

       40
       40
       +
       val get_attributes : t -> (string * string) list

     

       41
       41
       +
       

     

       42
       42
       +
       (** Get content *)

     

       43
       43
       +
       val get_content : t -> content

     

       44
       44
       +
       

     

       45
       45
       +
       (** Find attribute value by name *)

     

       46
       46
       +
       val find_attribute : string -> t -> string option

     

       47
       47
       +
       

     

       48
       48
       +
       (** Add or update attribute *)

     

       49
       49
       +
       val set_attribute : string -> string -> t -> t

     

       50
       50
       +
       

     

       51
       51
       +
       (** Compare extensions *)

     

       52
       52
       +
       val compare : t -> t -> int

     

       53
       53
       +
       

     

       54
       54
       +
       (** Test extension equality *)

     

       55
       55
       +
       val equal : t -> t -> bool

     

       56
       56
       +
       

     

       57
       57
       +
       (** Pretty print extension *)

     

       58
       58
       +
       val pp : Format.formatter -> t -> unit

     

       59
       59
       +
       

     

       60
       60
       +
       (** {2 Content Operations} *)

     

       61
       61
       +
       

     

       62
       62
       +
       (** Create text content *)

     

       63
       63
       +
       val text_content : string -> content

     

       64
       64
       +
       

     

       65
       65
       +
       (** Create elements content *)

     

       66
       66
       +
       val elements_content : t list -> content

     

       67
       67
       +
       

     

       68
       68
       +
       (** Create mixed content *)

     

       69
       69
       +
       val mixed_content : string -> t list -> content

     

       70
       70
       +
       

     

       71
       71
       +
       (** Check if content is text *)

     

       72
       72
       +
       val is_text_content : content -> bool

     

       73
       73
       +
       

     

       74
       74
       +
       (** Check if content is elements *)

     

       75
       75
       +
       val is_elements_content : content -> bool

     

       76
       76
       +
       

     

       77
       77
       +
       (** Check if content is mixed *)

     

       78
       78
       +
       val is_mixed_content : content -> bool

     

       79
       79
       +
       

     

       80
       80
       +
       (** Extract text content *)

     

       81
       81
       +
       val get_text_content : content -> string option

     

       82
       82
       +
       

     

       83
       83
       +
       (** Extract element content *)

     

       84
       84
       +
       val get_elements_content : content -> t list option

     

       85
       85
       +
       

     

       86
       86
       +
       (** Extract mixed content *)

     

       87
       87
       +
       val get_mixed_content : content -> (string * t list) option

+76 -161

lib/gpx/gpx.ml

···

       1
       1
       -
       (** {1 mlgpx - OCaml GPX Library} *)

     

       1
       1
       +
       (** OCaml library for reading and writing GPX (GPS Exchange Format) files *)

     

       2
       2
        
       

     

       3
       3
       -
       (** Core type definitions and utilities *)

     

       4
       4
       -
       module Types = Types

     

       3
       3
       +
       (** {1 Core Modules} *)

     

       5
       4
        
       

     

       6
       6
       -
       (** Streaming XML parser *)

     

       7
       7
       -
       module Parser = Parser

     

       5
       5
       +
       (** Geographic coordinate handling *)

     

       6
       6
       +
       module Coordinate = Coordinate

     

       8
       7
        
       

     

       9
       9
       -
       (** Streaming XML writer *)

     

       10
       10
       -
       module Writer = Writer

     

       8
       8
       +
       (** Links, persons, and copyright information *)

     

       9
       9
       +
       module Link = Link

     

       11
       10
        
       

     

       12
       12
       -
       (** Validation engine *)

     

       13
       13
       -
       module Validate = Validate

     

       11
       11
       +
       (** Extension mechanism for custom GPX elements *)

     

       12
       12
       +
       module Extension = Extension

     

       14
       13
        
       

     

       15
       15
       -
       (* Re-export core types for direct access *)

     

       16
       16
       -
       type latitude = Types.latitude

     

       17
       17
       -
       type longitude = Types.longitude  

     

       18
       18
       -
       type degrees = Types.degrees

     

       19
       19
       -
       type fix_type = Types.fix_type = None_fix | Fix_2d | Fix_3d | Dgps | Pps

     

       20
       20
       -
       type person = Types.person = { name : string option; email : string option; link : link option }

     

       21
       21
       -
       and link = Types.link = { href : string; text : string option; type_ : string option }

     

       22
       22
       -
       type copyright = Types.copyright = { author : string; year : int option; license : string option }

     

       23
       23
       -
       type bounds = Types.bounds = { minlat : latitude; minlon : longitude; maxlat : latitude; maxlon : longitude }

     

       24
       24
       -
       type extension_content = Types.extension_content = Text of string | Elements of extension list | Mixed of string * extension list

     

       25
       25
       -
       and extension = Types.extension = { namespace : string option; name : string; attributes : (string * string) list; content : extension_content }

     

       26
       26
       -
       type metadata = Types.metadata = { name : string option; desc : string option; author : person option; copyright : copyright option; links : link list; time : Ptime.t option; keywords : string option; bounds : bounds option; extensions : extension list }

     

       27
       27
       -
       type waypoint_data = Types.waypoint_data = { lat : latitude; lon : longitude; ele : float option; time : Ptime.t option; magvar : degrees option; geoidheight : float option; name : string option; cmt : string option; desc : string option; src : string option; links : link list; sym : string option; type_ : string option; fix : fix_type option; sat : int option; hdop : float option; vdop : float option; pdop : float option; ageofdgpsdata : float option; dgpsid : int option; extensions : extension list }

     

       28
       28
       -
       type waypoint = Types.waypoint

     

       29
       29
       -
       type route_point = Types.route_point

     

       30
       30
       -
       type track_point = Types.track_point

     

       31
       31
       -
       type route = Types.route = { name : string option; cmt : string option; desc : string option; src : string option; links : link list; number : int option; type_ : string option; extensions : extension list; rtepts : route_point list }

     

       32
       32
       -
       type track_segment = Types.track_segment = { trkpts : track_point list; extensions : extension list }

     

       33
       33
       -
       type track = Types.track = { name : string option; cmt : string option; desc : string option; src : string option; links : link list; number : int option; type_ : string option; extensions : extension list; trksegs : track_segment list }

     

       34
       34
       -
       type gpx = Types.gpx = { version : string; creator : string; metadata : metadata option; waypoints : waypoint list; routes : route list; tracks : track list; extensions : extension list }

     

       35
       35
       -
       type error = Types.error = Invalid_xml of string | Invalid_coordinate of string | Missing_required_attribute of string * string | Missing_required_element of string | Validation_error of string | Xml_error of string | IO_error of string

     

       36
       36
       -
       exception Gpx_error = Types.Gpx_error

     

       37
       37
       -
       type 'a result = ('a, error) Result.t

     

       38
       38
       -
       type validation_issue = Validate.validation_issue = { level : [`Error | `Warning]; message : string; location : string option }

     

       39
       39
       -
       type validation_result = Validate.validation_result = { issues : validation_issue list; is_valid : bool }

     

       14
       14
       +
       (** GPS waypoint data and fix types *)

     

       15
       15
       +
       module Waypoint = Waypoint

     

       16
       16
       +
       

     

       17
       17
       +
       (** GPX metadata including bounds *)

     

       18
       18
       +
       module Metadata = Metadata

     

       19
       19
       +
       

     

       20
       20
       +
       (** Route data and calculations *)

     

       21
       21
       +
       module Route = Route

     

       22
       22
       +
       

     

       23
       23
       +
       (** Track data with segments *)

     

       24
       24
       +
       module Track = Track

     

       25
       25
       +
       

     

       26
       26
       +
       (** Error handling *)

     

       27
       27
       +
       module Error = Error

     

       28
       28
       +
       

     

       29
       29
       +
       (** Main GPX document type *)

     

       30
       30
       +
       module Gpx_doc = Gpx_doc

     

       31
       31
       +
       

     

       32
       32
       +
       (** {1 Main Document Type} *)

     

       40
       33
        
       

     

       41
       41
       -
       (* Re-export core functions *)

     

       42
       42
       -
       let latitude = Types.latitude

     

       43
       43
       -
       let longitude = Types.longitude  

     

       44
       44
       -
       let degrees = Types.degrees

     

       45
       45
       -
       let latitude_to_float = Types.latitude_to_float

     

       46
       46
       -
       let longitude_to_float = Types.longitude_to_float

     

       47
       47
       -
       let degrees_to_float = Types.degrees_to_float

     

       48
       48
       -
       let fix_type_to_string = Types.fix_type_to_string

     

       49
       49
       -
       let fix_type_of_string = Types.fix_type_of_string

     

       50
       50
       -
       let make_waypoint_data = Types.make_waypoint_data

     

       51
       51
       -
       let empty_metadata = Types.empty_metadata

     

       52
       52
       -
       let make_gpx = Types.make_gpx

     

       34
       34
       +
       (** Main GPX document type *)

     

       35
       35
       +
       type t = Gpx_doc.t

     

       53
       36
        
       

     

       54
       54
       -
       (* Re-export parser functions *)

     

       55
       55
       -
       let parse = Parser.parse

     

       56
       56
       -
       let parse_string = Parser.parse_string

     

       37
       37
       +
       (** {1 Error Handling} *)

     

       57
       38
        
       

     

       58
       58
       -
       (* Re-export writer functions *)

     

       59
       59
       -
       let write = Writer.write

     

       60
       60
       -
       let write_string = Writer.write_string

     

       39
       39
       +
       (** Error types *)

     

       40
       40
       +
       type error = Error.t

     

       61
       41
        
       

     

       62
       62
       -
       (* Re-export validation functions *)

     

       63
       63
       -
       let validate_gpx = Validate.validate_gpx

     

       64
       64
       -
       let is_valid = Validate.is_valid

     

       65
       65
       -
       let get_errors = Validate.get_errors  

     

       66
       66
       -
       let get_warnings = Validate.get_warnings

     

       67
       67
       -
       let format_issue = Validate.format_issue

     

       42
       42
       +
       (** GPX exception *)

     

       43
       43
       +
       exception Gpx_error of error

     

       68
       44
        
       

     

       69
       69
       -
       (* Utility functions *)

     

       45
       45
       +
       (** {1 Parsing Functions} *)

     

       70
       46
        
       

     

       71
       71
       -
       let make_waypoint_from_floats ~lat ~lon ?name ?desc () =

     

       72
       72
       -
         match latitude lat, longitude lon with

     

       73
       73
       -
         | Ok lat, Ok lon ->

     

       74
       74
       -
           let wpt = make_waypoint_data lat lon in

     

       75
       75
       -
           { wpt with name; desc }

     

       76
       76
       -
         | Error e, _ | _, Error e -> raise (Gpx_error (Invalid_coordinate e))

     

       47
       47
       +
       (** Parse GPX from XML input *)

     

       48
       48
       +
       let parse ?validate input = Parser.parse ?validate input

     

       77
       49
        
       

     

       78
       78
       -
       let make_track_from_coord_list ~name coords =

     

       79
       79
       -
         let make_trkpt (lat_f, lon_f) =

     

       80
       80
       -
           match latitude lat_f, longitude lon_f with

     

       81
       81
       -
           | Ok lat, Ok lon -> make_waypoint_data lat lon

     

       82
       82
       -
           | Error e, _ | _, Error e -> raise (Gpx_error (Invalid_coordinate e))

     

       83
       83
       -
         in

     

       84
       84
       -
         let trkpts = List.map make_trkpt coords in

     

       85
       85
       -
         let trkseg : track_segment = { trkpts; extensions = [] } in

     

       86
       86
       -
         ({

     

       87
       87
       -
           name = Some name;

     

       88
       88
       -
           cmt = None; desc = None; src = None; links = [];

     

       89
       89
       -
           number = None; type_ = None; extensions = [];

     

       90
       90
       -
           trksegs = [trkseg];

     

       91
       91
       -
         } : track)

     

       50
       50
       +
       (** Parse GPX from string *)

     

       51
       51
       +
       let parse_string ?validate s = Parser.parse_string ?validate s

     

       92
       52
        
       

     

       93
       93
       -
       let make_route_from_coord_list ~name coords =

     

       94
       94
       -
         let make_rtept (lat_f, lon_f) =

     

       95
       95
       -
           match latitude lat_f, longitude lon_f with

     

       96
       96
       -
           | Ok lat, Ok lon -> make_waypoint_data lat lon

     

       97
       97
       -
           | Error e, _ | _, Error e -> raise (Gpx_error (Invalid_coordinate e))

     

       98
       98
       -
         in

     

       99
       99
       -
         let rtepts = List.map make_rtept coords in

     

       100
       100
       -
         ({

     

       101
       101
       -
           name = Some name;

     

       102
       102
       -
           cmt = None; desc = None; src = None; links = [];

     

       103
       103
       -
           number = None; type_ = None; extensions = [];

     

       104
       104
       -
           rtepts;

     

       105
       105
       -
         } : route)

     

       53
       53
       +
       (** {1 Writing Functions} *)

     

       106
       54
        
       

     

       107
       107
       -
       let waypoint_coords (wpt : waypoint_data) =

     

       108
       108
       -
         (latitude_to_float wpt.lat, longitude_to_float wpt.lon)

     

       55
       55
       +
       (** Write GPX to XML output *)

     

       56
       56
       +
       let write ?validate output gpx = Writer.write ?validate output gpx

     

       109
       57
        
       

     

       110
       110
       -
       let track_coords (track : track) =

     

       111
       111
       -
         List.fold_left (fun acc (trkseg : track_segment) ->

     

       112
       112
       -
           List.fold_left (fun acc trkpt ->

     

       113
       113
       -
             waypoint_coords trkpt :: acc

     

       114
       114
       -
           ) acc trkseg.trkpts

     

       115
       115
       -
         ) [] track.trksegs

     

       116
       116
       -
         |> List.rev

     

       58
       58
       +
       (** Write GPX to string *)

     

       59
       59
       +
       let write_string ?validate gpx = Writer.write_string ?validate gpx

     

       117
       60
        
       

     

       118
       118
       -
       let route_coords (route : route) =

     

       119
       119
       -
         List.map waypoint_coords route.rtepts

     

       61
       61
       +
       (** {1 Validation Functions} *)

     

       120
       62
        
       

     

       121
       121
       -
       let count_points (gpx : gpx) =

     

       122
       122
       -
         let waypoint_count = List.length gpx.waypoints in

     

       123
       123
       -
         let route_count = List.fold_left (fun acc (route : route) ->

     

       124
       124
       -
           acc + List.length route.rtepts

     

       125
       125
       -
         ) 0 gpx.routes in

     

       126
       126
       -
         let track_count = List.fold_left (fun acc (track : track) ->

     

       127
       127
       -
           List.fold_left (fun acc (trkseg : track_segment) ->

     

       128
       128
       -
             acc + List.length trkseg.trkpts

     

       129
       129
       -
           ) acc track.trksegs

     

       130
       130
       -
         ) 0 gpx.tracks in

     

       131
       131
       -
         waypoint_count + route_count + track_count

     

       63
       63
       +
       (** Validation issue with severity level *)

     

       64
       64
       +
       type validation_issue = Validate.validation_issue = {

     

       65
       65
       +
         level : [`Error | `Warning];

     

       66
       66
       +
         message : string;

     

       67
       67
       +
         location : string option;

     

       68
       68
       +
       }

     

       132
       69
        
       

     

       133
       133
       -
       type gpx_stats = {

     

       134
       134
       -
         waypoint_count : int;

     

       135
       135
       -
         route_count : int;

     

       136
       136
       -
         track_count : int;

     

       137
       137
       -
         total_points : int;

     

       138
       138
       -
         has_elevation : bool;

     

       139
       139
       -
         has_time : bool;

     

       70
       70
       +
       (** Result of validation containing all issues found *)

     

       71
       71
       +
       type validation_result = Validate.validation_result = {

     

       72
       72
       +
         issues : validation_issue list;

     

       73
       73
       +
         is_valid : bool;

     

       140
       74
        
       }

     

       141
       75
        
       

     

       142
       142
       -
       let get_stats (gpx : gpx) =

     

       143
       143
       -
         let waypoint_count = List.length gpx.waypoints in

     

       144
       144
       -
         let route_count = List.length gpx.routes in

     

       145
       145
       -
         let track_count = List.length gpx.tracks in

     

       146
       146
       -
         let total_points = count_points gpx in

     

       147
       147
       -
         

     

       148
       148
       -
         let has_elevation = 

     

       149
       149
       -
           List.exists (fun (wpt : waypoint_data) -> wpt.ele <> None) gpx.waypoints ||

     

       150
       150
       -
           List.exists (fun (route : route) -> 

     

       151
       151
       -
             List.exists (fun (rtept : waypoint_data) -> rtept.ele <> None) route.rtepts

     

       152
       152
       -
           ) gpx.routes ||

     

       153
       153
       -
           List.exists (fun (track : track) ->

     

       154
       154
       -
             List.exists (fun (trkseg : track_segment) ->

     

       155
       155
       -
               List.exists (fun (trkpt : waypoint_data) -> trkpt.ele <> None) trkseg.trkpts

     

       156
       156
       -
             ) track.trksegs

     

       157
       157
       -
           ) gpx.tracks

     

       158
       158
       -
         in

     

       159
       159
       -
         

     

       160
       160
       -
         let has_time =

     

       161
       161
       -
           List.exists (fun (wpt : waypoint_data) -> wpt.time <> None) gpx.waypoints ||

     

       162
       162
       -
           List.exists (fun (route : route) ->

     

       163
       163
       -
             List.exists (fun (rtept : waypoint_data) -> rtept.time <> None) route.rtepts

     

       164
       164
       -
           ) gpx.routes ||

     

       165
       165
       -
           List.exists (fun (track : track) ->

     

       166
       166
       -
             List.exists (fun (trkseg : track_segment) ->

     

       167
       167
       -
               List.exists (fun (trkpt : waypoint_data) -> trkpt.time <> None) trkseg.trkpts

     

       168
       168
       -
             ) track.trksegs

     

       169
       169
       -
           ) gpx.tracks

     

       170
       170
       -
         in

     

       171
       171
       -
         

     

       172
       172
       -
         { waypoint_count; route_count; track_count; total_points; has_elevation; has_time }

     

       76
       76
       +
       (** Validate complete GPX document *)

     

       77
       77
       +
       let validate_gpx = Validate.validate_gpx

     

       78
       78
       +
       

     

       79
       79
       +
       (** Quick validation - returns true if document is valid *)

     

       80
       80
       +
       let is_valid = Validate.is_valid

     

       81
       81
       +
       

     

       82
       82
       +
       (** Get only error messages *)

     

       83
       83
       +
       let get_errors = Validate.get_errors

     

       84
       84
       +
       

     

       85
       85
       +
       (** Get only warning messages *)

     

       86
       86
       +
       let get_warnings = Validate.get_warnings

     

       87
       87
       +
       

     

       88
       88
       +
       (** Format validation issue for display *)

     

       89
       89
       +
       let format_issue = Validate.format_issue

     

       90
       90
       +
       

     

       91
       91
       +
       (** {1 Constructors and Utilities} *)

     

       92
       92
       +
       

     

       93
       93
       +
       (** Create new GPX document *)

     

       94
       94
       +
       let make_gpx ~creator = Gpx_doc.empty ~creator

     

       173
       95
        
       

     

       174
       174
       -
       let print_stats (gpx : gpx) =

     

       175
       175
       -
         let stats = get_stats gpx in

     

       176
       176
       -
         Printf.printf "GPX Statistics:\n";

     

       177
       177
       -
         Printf.printf "  Waypoints: %d\n" stats.waypoint_count;

     

       178
       178
       -
         Printf.printf "  Routes: %d\n" stats.route_count;

     

       179
       179
       -
         Printf.printf "  Tracks: %d\n" stats.track_count;

     

       180
       180
       -
         Printf.printf "  Total points: %d\n" stats.total_points;

     

       181
       181
       -
         Printf.printf "  Has elevation data: %s\n" (if stats.has_elevation then "yes" else "no");

     

       182
       182
       -
         Printf.printf "  Has time data: %s\n" (if stats.has_time then "yes" else "no")
     

       96
       96
       +
       (** Create empty GPX document *)

     

       97
       97
       +
       let empty ~creator = Gpx_doc.empty ~creator

+77 -391

lib/gpx/gpx.mli

···

       1
       1
       -
       (** {1 MLGpx - OCaml GPX Library}

     

       2
       2
       -
       

     

       3
       3
       -
           A high-quality OCaml library for parsing and generating GPX (GPS Exchange Format) files.

     

       4
       4
       -
           GPX is a standardized XML format for exchanging GPS data between applications and devices.

     

       5
       5
       -
       

     

       6
       6
       -
           {2 Overview}

     

       7
       7
       -
       

     

       8
       8
       -
           The GPX format defines a standard way to describe waypoints, routes, and tracks.

     

       9
       9
       -
           This library provides a complete implementation of GPX 1.1 with strong type safety 

     

       10
       10
       -
           and memory-efficient streaming processing.

     

       11
       11
       -
       

     

       12
       12
       -
           {b Key Features:}

     

       13
       13
       -
           - ✅ Complete GPX 1.1 support with all standard elements

     

       14
       14
       -
           - ✅ Type-safe coordinate validation (WGS84 datum)

     

       15
       15
       -
           - ✅ Memory-efficient streaming parser and writer

     

       16
       16
       -
           - ✅ Comprehensive validation with detailed error reporting

     

       17
       17
       -
           - ✅ Extension support for custom elements

     

       18
       18
       -
           - ✅ Cross-platform (core has no Unix dependencies)

     

       19
       19
       -
       

     

       20
       20
       -
           {2 Quick Start}

     

       21
       21
       -
       

     

       22
       22
       -
           {[

     

       23
       23
       -
             open Gpx

     

       24
       24
       -
       

     

       25
       25
       -
             (* Create coordinates *)

     

       26
       26
       -
             let* lat = latitude 37.7749 in

     

       27
       27
       -
             let* lon = longitude (-122.4194) in

     

       28
       28
       -
             

     

       29
       29
       -
             (* Create a waypoint *)

     

       30
       30
       -
             let wpt = make_waypoint_data lat lon in

     

       31
       31
       -
             let wpt = { wpt with name = Some "San Francisco" } in

     

       32
       32
       -
             

     

       33
       33
       -
             (* Create GPX document *)

     

       34
       34
       -
             let gpx = make_gpx ~creator:"mlgpx" in

     

       35
       35
       -
             let gpx = { gpx with waypoints = [wpt] } in

     

       36
       36
       -
             

     

       37
       37
       -
             (* Convert to XML string *)

     

       38
       38
       -
             write_string gpx

     

       39
       39
       -
           ]}

     

       40
       40
       -
       

     

       41
       41
       -
           {2 Core Types} *)

     

       42
       42
       -
       

     

       43
       43
       -
       (** {3 Geographic Coordinates}

     

       44
       44
       -
       

     

       45
       45
       -
           All coordinates use the WGS84 datum as specified by the GPX standard. *)

     

       46
       46
       -
       

     

       47
       47
       -
       (** Latitude coordinate (-90.0 to 90.0 degrees).

     

       48
       48
       -
           Private type ensures validation through smart constructor. *)

     

       49
       49
       -
       type latitude = Types.latitude

     

       50
       50
       -
       

     

       51
       51
       -
       (** Longitude coordinate (-180.0 to 180.0 degrees).

     

       52
       52
       -
           Private type ensures validation through smart constructor. *)  

     

       53
       53
       -
       type longitude = Types.longitude

     

       54
       54
       -
       

     

       55
       55
       -
       (** Degrees for magnetic variation (0.0 to 360.0 degrees).

     

       56
       56
       -
           Private type ensures validation through smart constructor. *)

     

       57
       57
       -
       type degrees = Types.degrees

     

       58
       58
       -
       

     

       59
       59
       -
       (** Create validated latitude coordinate.

     

       60
       60
       -
           @param lat Latitude in degrees (-90.0 to 90.0)

     

       61
       61
       -
           @return [Ok lat] if valid, [Error msg] if out of range *)

     

       62
       62
       -
       val latitude : float -> (latitude, string) result

     

       63
       63
       -
       

     

       64
       64
       -
       (** Create validated longitude coordinate.

     

       65
       65
       -
           @param lon Longitude in degrees (-180.0 to 180.0) 

     

       66
       66
       -
           @return [Ok lon] if valid, [Error msg] if out of range *)

     

       67
       67
       -
       val longitude : float -> (longitude, string) result

     

       68
       68
       -
       

     

       69
       69
       -
       (** Create validated degrees value.

     

       70
       70
       -
           @param deg Degrees (0.0 to 360.0)

     

       71
       71
       -
           @return [Ok deg] if valid, [Error msg] if out of range *)

     

       72
       72
       -
       val degrees : float -> (degrees, string) result

     

       73
       73
       -
       

     

       74
       74
       -
       (** Convert latitude back to float *)

     

       75
       75
       -
       val latitude_to_float : latitude -> float

     

       76
       76
       -
       

     

       77
       77
       -
       (** Convert longitude back to float *)

     

       78
       78
       -
       val longitude_to_float : longitude -> float

     

       79
       79
       -
       

     

       80
       80
       -
       (** Convert degrees back to float *)

     

       81
       81
       -
       val degrees_to_float : degrees -> float

     

       82
       82
       -
       

     

       83
       83
       -
       (** {3 GPS Fix Types}

     

       84
       84
       -
       

     

       85
       85
       -
           Standard GPS fix types as defined in the GPX specification. *)

     

       86
       86
       -
       

     

       87
       87
       -
       (** GPS fix type indicating the quality/type of GPS reading *)

     

       88
       88
       -
       type fix_type = Types.fix_type =

     

       89
       89
       -
         | None_fix  (** No fix available *)

     

       90
       90
       -
         | Fix_2d    (** 2D fix (latitude/longitude) *)

     

       91
       91
       -
         | Fix_3d    (** 3D fix (latitude/longitude/altitude) *)

     

       92
       92
       -
         | Dgps      (** Differential GPS *)

     

       93
       93
       -
         | Pps       (** Precise Positioning Service *)

     

       94
       94
       -
       

     

       95
       95
       -
       (** Convert fix type to string representation *)

     

       96
       96
       -
       val fix_type_to_string : fix_type -> string

     

       97
       97
       -
       

     

       98
       98
       -
       (** Parse fix type from string *)

     

       99
       99
       -
       val fix_type_of_string : string -> fix_type option

     

       100
       100
       -
       

     

       101
       101
       -
       (** {3 Metadata Elements} *)

     

       102
       102
       -
       

     

       103
       103
       -
       (** Person information for author, copyright holder, etc. *)

     

       104
       104
       -
       type person = Types.person = {

     

       105
       105
       -
         name : string option;   (** Person's name *)

     

       106
       106
       -
         email : string option;  (** Email address *)

     

       107
       107
       -
         link : link option;     (** Link to person's website *)

     

       108
       108
       -
       }

     

       109
       109
       -
       

     

       110
       110
       -
       (** External link with optional description and type *)

     

       111
       111
       -
       and link = Types.link = {

     

       112
       112
       -
         href : string;          (** URL of the link *)

     

       113
       113
       -
         text : string option;   (** Text description of link *)

     

       114
       114
       -
         type_ : string option;  (** MIME type of linked content *)

     

       115
       115
       -
       }

     

       116
       116
       -
       

     

       117
       117
       -
       (** Copyright information for the GPX file *)

     

       118
       118
       -
       type copyright = Types.copyright = {

     

       119
       119
       -
         author : string;            (** Copyright holder *)

     

       120
       120
       -
         year : int option;          (** Year of copyright *)

     

       121
       121
       -
         license : string option;    (** License terms *)

     

       122
       122
       -
       }

     

       1
       1
       +
       (** OCaml library for reading and writing GPX (GPS Exchange Format) files 

     

       2
       2
       +
           

     

       3
       3
       +
           This library provides a clean, modular interface for working with GPX files,

     

       4
       4
       +
           the standard format for GPS data exchange. *)

     

       123
       5
        
       

     

       124
       124
       -
       (** Geographic bounds - minimum bounding rectangle *)

     

       125
       125
       -
       type bounds = Types.bounds = {

     

       126
       126
       -
         minlat : latitude;   (** Minimum latitude *)

     

       127
       127
       -
         minlon : longitude;  (** Minimum longitude *)  

     

       128
       128
       -
         maxlat : latitude;   (** Maximum latitude *)

     

       129
       129
       -
         maxlon : longitude;  (** Maximum longitude *)

     

       130
       130
       -
       }

     

       6
       6
       +
       (** {1 Core Modules}

     

       7
       7
       +
           

     

       8
       8
       +
           The library is organized into focused modules, each handling a specific aspect

     

       9
       9
       +
           of GPX data. *)

     

       131
       10
        
       

     

       132
       132
       -
       (** Extension content for custom elements *)

     

       133
       133
       -
       type extension_content = Types.extension_content =

     

       134
       134
       -
         | Text of string                      (** Text content *)

     

       135
       135
       -
         | Elements of extension list          (** Child elements *)

     

       136
       136
       -
         | Mixed of string * extension list    (** Mixed text and elements *)

     

       11
       11
       +
       (** Geographic coordinate handling with validation *)

     

       12
       12
       +
       module Coordinate = Coordinate

     

       137
       13
        
       

     

       138
       138
       -
       (** Extension element for custom data *)

     

       139
       139
       -
       and extension = Types.extension = {

     

       140
       140
       -
         namespace : string option;              (** XML namespace *)

     

       141
       141
       -
         name : string;                          (** Element name *)

     

       142
       142
       -
         attributes : (string * string) list;   (** Element attributes *)

     

       143
       143
       -
         content : extension_content;            (** Element content *)

     

       144
       144
       -
       }

     

       14
       14
       +
       (** Links, persons, and copyright information *)

     

       15
       15
       +
       module Link = Link

     

       145
       16
        
       

     

       146
       146
       -
       (** GPX file metadata containing information about the file itself *)

     

       147
       147
       -
       type metadata = Types.metadata = {

     

       148
       148
       -
         name : string option;        (** Name of GPX file *)

     

       149
       149
       -
         desc : string option;        (** Description of contents *)

     

       150
       150
       -
         author : person option;      (** Person who created GPX file *)

     

       151
       151
       -
         copyright : copyright option; (** Copyright information *)

     

       152
       152
       -
         links : link list;           (** Related links *)

     

       153
       153
       -
         time : Ptime.t option;       (** Creation/modification time *)

     

       154
       154
       -
         keywords : string option;    (** Keywords for searching *)

     

       155
       155
       -
         bounds : bounds option;      (** Geographic bounds *)

     

       156
       156
       -
         extensions : extension list; (** Custom extensions *)

     

       157
       157
       -
       }

     

       17
       17
       +
       (** Extension mechanism for custom GPX elements *)

     

       18
       18
       +
       module Extension = Extension

     

       158
       19
        
       

     

       159
       159
       -
       (** Create empty metadata record *)

     

       160
       160
       -
       val empty_metadata : metadata

     

       20
       20
       +
       (** GPS waypoint data and fix types *)

     

       21
       21
       +
       module Waypoint = Waypoint

     

       161
       22
        
       

     

       162
       162
       -
       (** {3 Geographic Points}

     

       163
       163
       -
       

     

       164
       164
       -
           All geographic points (waypoints, route points, track points) share the same structure. *)

     

       165
       165
       -
       

     

       166
       166
       -
       (** Base waypoint data structure used for all geographic points.

     

       167
       167
       -
           Contains position, time, and various GPS-related fields. *)

     

       168
       168
       -
       type waypoint_data = Types.waypoint_data = {

     

       169
       169
       -
         lat : latitude;              (** Latitude coordinate *)

     

       170
       170
       -
         lon : longitude;             (** Longitude coordinate *)

     

       171
       171
       -
         ele : float option;          (** Elevation in meters *)

     

       172
       172
       -
         time : Ptime.t option;       (** Time of GPS reading *)

     

       173
       173
       -
         magvar : degrees option;     (** Magnetic variation at point *)

     

       174
       174
       -
         geoidheight : float option;  (** Height of geoid above WGS84 ellipsoid *)

     

       175
       175
       -
         name : string option;        (** Point name *)

     

       176
       176
       -
         cmt : string option;         (** GPS comment *)

     

       177
       177
       -
         desc : string option;        (** Point description *)

     

       178
       178
       -
         src : string option;         (** Source of data *)

     

       179
       179
       -
         links : link list;           (** Related links *)

     

       180
       180
       -
         sym : string option;         (** GPS symbol name *)

     

       181
       181
       -
         type_ : string option;       (** Point classification *)

     

       182
       182
       -
         fix : fix_type option;       (** Type of GPS fix *)

     

       183
       183
       -
         sat : int option;            (** Number of satellites *)

     

       184
       184
       -
         hdop : float option;         (** Horizontal dilution of precision *)

     

       185
       185
       -
         vdop : float option;         (** Vertical dilution of precision *)

     

       186
       186
       -
         pdop : float option;         (** Position dilution of precision *)

     

       187
       187
       -
         ageofdgpsdata : float option; (** Age of DGPS data *)

     

       188
       188
       -
         dgpsid : int option;         (** DGPS station ID *)

     

       189
       189
       -
         extensions : extension list;  (** Custom extensions *)

     

       190
       190
       -
       }

     

       191
       191
       -
       

     

       192
       192
       -
       (** Create basic waypoint data with required coordinates *)

     

       193
       193
       -
       val make_waypoint_data : latitude -> longitude -> waypoint_data

     

       194
       194
       -
       

     

       195
       195
       -
       (** Individual waypoint - a point of interest *)

     

       196
       196
       -
       type waypoint = Types.waypoint

     

       197
       197
       -
       

     

       198
       198
       -
       (** Route point - point along a planned route *)

     

       199
       199
       -
       type route_point = Types.route_point  

     

       200
       200
       -
       

     

       201
       201
       -
       (** Track point - recorded position along an actual path *)

     

       202
       202
       -
       type track_point = Types.track_point

     

       203
       203
       -
       

     

       204
       204
       -
       (** {3 Routes}

     

       205
       205
       -
       

     

       206
       206
       -
           A route is an ordered list of waypoints representing a planned path. *)

     

       207
       207
       -
       

     

       208
       208
       -
       (** Route definition - ordered list of waypoints for navigation *)

     

       209
       209
       -
       type route = Types.route = {

     

       210
       210
       -
         name : string option;         (** Route name *)

     

       211
       211
       -
         cmt : string option;          (** GPS comment *)

     

       212
       212
       -
         desc : string option;         (** Route description *)

     

       213
       213
       -
         src : string option;          (** Source of data *)

     

       214
       214
       -
         links : link list;            (** Related links *)

     

       215
       215
       -
         number : int option;          (** Route number *)

     

       216
       216
       -
         type_ : string option;        (** Route classification *)

     

       217
       217
       -
         extensions : extension list;   (** Custom extensions *)

     

       218
       218
       -
         rtepts : route_point list;    (** Route points *)

     

       219
       219
       -
       }

     

       220
       220
       -
       

     

       221
       221
       -
       (** {3 Tracks}

     

       222
       222
       -
       

     

       223
       223
       -
           A track represents an actual recorded path, consisting of track segments. *)

     

       23
       23
       +
       (** GPX metadata including bounds *)

     

       24
       24
       +
       module Metadata = Metadata

     

       224
       25
        
       

     

       225
       225
       -
       (** Track segment - continuous set of track points *)

     

       226
       226
       -
       type track_segment = Types.track_segment = {

     

       227
       227
       -
         trkpts : track_point list;   (** Track points in segment *)

     

       228
       228
       -
         extensions : extension list; (** Custom extensions *)

     

       229
       229
       -
       }

     

       26
       26
       +
       (** Route data and calculations *)

     

       27
       27
       +
       module Route = Route

     

       230
       28
        
       

     

       231
       231
       -
       (** Track definition - recorded path made up of segments *)

     

       232
       232
       -
       type track = Types.track = {

     

       233
       233
       -
         name : string option;          (** Track name *)

     

       234
       234
       -
         cmt : string option;           (** GPS comment *)

     

       235
       235
       -
         desc : string option;          (** Track description *)

     

       236
       236
       -
         src : string option;           (** Source of data *)

     

       237
       237
       -
         links : link list;             (** Related links *)

     

       238
       238
       -
         number : int option;           (** Track number *)

     

       239
       239
       -
         type_ : string option;         (** Track classification *)

     

       240
       240
       -
         extensions : extension list;    (** Custom extensions *)

     

       241
       241
       -
         trksegs : track_segment list;  (** Track segments *)

     

       242
       242
       -
       }

     

       29
       29
       +
       (** Track data with segments *)

     

       30
       30
       +
       module Track = Track

     

       243
       31
        
       

     

       244
       244
       -
       (** {3 Main GPX Document}

     

       32
       32
       +
       (** Error handling *)

     

       33
       33
       +
       module Error = Error

     

       245
       34
        
       

     

       246
       246
       -
           The root GPX element contains metadata and collections of waypoints, routes, and tracks. *)

     

       35
       35
       +
       (** Main GPX document type *)

     

       36
       36
       +
       module Gpx_doc = Gpx_doc

     

       247
       37
        
       

     

       248
       248
       -
       (** Main GPX document conforming to GPX 1.1 standard *)

     

       249
       249
       -
       type gpx = Types.gpx = {

     

       250
       250
       -
         version : string;            (** GPX version (always "1.1") *)

     

       251
       251
       -
         creator : string;            (** Creating application *)

     

       252
       252
       -
         metadata : metadata option;  (** File metadata *)

     

       253
       253
       -
         waypoints : waypoint list;   (** Waypoints *)

     

       254
       254
       -
         routes : route list;         (** Routes *)

     

       255
       255
       -
         tracks : track list;         (** Tracks *)

     

       256
       256
       -
         extensions : extension list; (** Custom extensions *)

     

       257
       257
       -
       }

     

       38
       38
       +
       (** {1 Main Document Type} *)

     

       258
       39
        
       

     

       259
       259
       -
       (** Create GPX document with required creator field *)

     

       260
       260
       -
       val make_gpx : creator:string -> gpx

     

       40
       40
       +
       (** Main GPX document type *)

     

       41
       41
       +
       type t = Gpx_doc.t

     

       261
       42
        
       

     

       262
       262
       -
       (** {3 Error Handling} *)

     

       43
       43
       +
       (** {1 Error Handling} *)

     

       263
       44
        
       

     

       264
       264
       -
       (** Errors that can occur during GPX processing *)

     

       265
       265
       -
       type error = Types.error =

     

       266
       266
       -
         | Invalid_xml of string                   (** XML parsing error *)

     

       267
       267
       -
         | Invalid_coordinate of string            (** Coordinate validation error *)

     

       268
       268
       -
         | Missing_required_attribute of string * string (** Missing XML attribute *)

     

       269
       269
       -
         | Missing_required_element of string      (** Missing XML element *)

     

       270
       270
       -
         | Validation_error of string              (** GPX validation error *)

     

       271
       271
       -
         | Xml_error of string                     (** XML processing error *)

     

       272
       272
       -
         | IO_error of string                      (** I/O error *)

     

       45
       45
       +
       (** Error types *)

     

       46
       46
       +
       type error = Error.t

     

       273
       47
        
       

     

       274
       274
       -
       (** Exception type for GPX errors *)

     

       48
       48
       +
       (** GPX exception raised for errors *)

     

       275
       49
        
       exception Gpx_error of error

     

       276
       50
        
       

     

       277
       277
       -
       (** Result type for operations that may fail *)

     

       278
       278
       -
       type 'a result = ('a, error) Result.t

     

       51
       51
       +
       (** {1 Parsing Functions} *)

     

       279
       52
        
       

     

       280
       280
       -
       (** {2 Parsing Functions}

     

       53
       53
       +
       (** Parse GPX from XML input.

     

       54
       54
       +
           

     

       55
       55
       +
           @param validate Whether to validate the document after parsing

     

       56
       56
       +
           @param input XMLm input source

     

       57
       57
       +
           @return Parsed GPX document or error *)

     

       58
       58
       +
       val parse : ?validate:bool -> Xmlm.input -> (t, error) result

     

       281
       59
        
       

     

       282
       282
       -
           Parse GPX documents from XML input sources. *)

     

       283
       283
       -
       

     

       284
       284
       -
       (** Parse GPX document from xmlm input source.

     

       285
       285
       -
           @param input The xmlm input source

     

       286
       286
       -
           @param ?validate Optional validation flag (default: false)

     

       287
       287
       -
           @return [Ok gpx] on success, [Error err] on failure *)

     

       288
       288
       -
       val parse : ?validate:bool -> Xmlm.input -> gpx result

     

       289
       289
       -
       

     

       290
       290
       -
       (** Parse GPX document from string.

     

       291
       291
       -
           @param xml_string GPX document as XML string

     

       292
       292
       -
           @param ?validate Optional validation flag (default: false)

     

       293
       293
       -
           @return [Ok gpx] on success, [Error err] on failure *)

     

       294
       294
       -
       val parse_string : ?validate:bool -> string -> gpx result

     

       295
       295
       -
       

     

       296
       296
       -
       (** {2 Writing Functions}

     

       297
       297
       -
       

     

       298
       298
       -
           Generate GPX XML from document structures. *)

     

       60
       60
       +
       (** Parse GPX from string.

     

       61
       61
       +
           

     

       62
       62
       +
           @param validate Whether to validate the document after parsing  

     

       63
       63
       +
           @param s XML string to parse

     

       64
       64
       +
           @return Parsed GPX document or error *)

     

       65
       65
       +
       val parse_string : ?validate:bool -> string -> (t, error) result

     

       299
       66
        
       

     

       300
       300
       -
       (** Write GPX document to xmlm output destination.

     

       301
       301
       -
           @param output The xmlm output destination

     

       302
       302
       -
           @param gpx The GPX document to write

     

       303
       303
       -
           @param ?validate Optional validation flag (default: false)

     

       304
       304
       -
           @return [Ok ()] on success, [Error err] on failure *)

     

       305
       305
       -
       val write : ?validate:bool -> Xmlm.output -> gpx -> unit result

     

       67
       67
       +
       (** {1 Writing Functions} *)

     

       306
       68
        
       

     

       307
       307
       -
       (** Write GPX document to XML string.

     

       308
       308
       -
           @param gpx The GPX document to write

     

       309
       309
       -
           @param ?validate Optional validation flag (default: false)

     

       310
       310
       -
           @return [Ok xml_string] on success, [Error err] on failure *)

     

       311
       311
       -
       val write_string : ?validate:bool -> gpx -> string result

     

       69
       69
       +
       (** Write GPX to XML output.

     

       70
       70
       +
           

     

       71
       71
       +
           @param validate Whether to validate before writing

     

       72
       72
       +
           @param output XMLm output destination

     

       73
       73
       +
           @param gpx GPX document to write

     

       74
       74
       +
           @return Success or error *)

     

       75
       75
       +
       val write : ?validate:bool -> Xmlm.dest -> t -> (unit, error) result

     

       312
       76
        
       

     

       313
       313
       -
       (** {2 Validation Functions}

     

       77
       77
       +
       (** Write GPX to string.

     

       78
       78
       +
           

     

       79
       79
       +
           @param validate Whether to validate before writing

     

       80
       80
       +
           @param gpx GPX document to write  

     

       81
       81
       +
           @return XML string or error *)

     

       82
       82
       +
       val write_string : ?validate:bool -> t -> (string, error) result

     

       314
       83
        
       

     

       84
       84
       +
       (** {1 Validation Functions}

     

       85
       85
       +
           

     

       315
       86
        
           Validate GPX documents for correctness and best practices. *)

     

       316
       87
        
       

     

       317
       88
        
       (** Validation issue with severity level *)

     
···

       324
       95
        
       (** Result of validation containing all issues found *)

     

       325
       96
        
       type validation_result = Validate.validation_result = {

     

       326
       97
        
         issues : validation_issue list;  (** All validation issues *)

     

       327
       327
       -
         is_valid : bool;                 (** True if no errors found *)

     

       98
       98
       +
         is_valid : bool;                 (** Whether document is valid *)

     

       328
       99
        
       }

     

       329
       100
        
       

     

       330
       330
       -
       (** Validate complete GPX document.

     

       331
       331
       -
           Checks coordinates, required fields, and best practices.

     

       332
       332
       -
           @param gpx GPX document to validate

     

       333
       333
       -
           @return Validation result with any issues found *)

     

       334
       334
       -
       val validate_gpx : gpx -> validation_result

     

       101
       101
       +
       (** Validate complete GPX document *)

     

       102
       102
       +
       val validate_gpx : t -> validation_result

     

       335
       103
        
       

     

       336
       336
       -
       (** Quick validation check.

     

       337
       337
       -
           @param gpx GPX document to validate

     

       338
       338
       -
           @return [true] if document is valid (no errors) *)

     

       339
       339
       -
       val is_valid : gpx -> bool

     

       104
       104
       +
       (** Quick validation - returns true if document is valid *)

     

       105
       105
       +
       val is_valid : t -> bool

     

       340
       106
        
       

     

       341
       341
       -
       (** Get only error-level validation issues.

     

       342
       342
       -
           @param gpx GPX document to validate

     

       343
       343
       -
           @return List of validation errors *)

     

       344
       344
       -
       val get_errors : gpx -> validation_issue list

     

       107
       107
       +
       (** Get only error messages *)

     

       108
       108
       +
       val get_errors : t -> validation_issue list

     

       345
       109
        
       

     

       346
       346
       -
       (** Get only warning-level validation issues.

     

       347
       347
       -
           @param gpx GPX document to validate  

     

       348
       348
       -
           @return List of validation warnings *)

     

       349
       349
       -
       val get_warnings : gpx -> validation_issue list

     

       110
       110
       +
       (** Get only warning messages *)

     

       111
       111
       +
       val get_warnings : t -> validation_issue list

     

       350
       112
        
       

     

       351
       351
       -
       (** Format validation issue for display.

     

       352
       352
       -
           @param issue Validation issue to format

     

       353
       353
       -
           @return Human-readable error message *)

     

       113
       113
       +
       (** Format validation issue for display *)

     

       354
       114
        
       val format_issue : validation_issue -> string

     

       355
       115
        
       

     

       356
       356
       -
       (** {2 Utility Functions}

     

       116
       116
       +
       (** {1 Constructors and Utilities} *)

     

       357
       117
        
       

     

       358
       358
       -
           Convenient functions for creating and analyzing GPX data. *)

     

       118
       118
       +
       (** Create new GPX document with required fields *)

     

       119
       119
       +
       val make_gpx : creator:string -> t

     

       359
       120
        
       

     

       360
       360
       -
       (** Create waypoint from float coordinates.

     

       361
       361
       -
           @param lat Latitude in degrees (-90.0 to 90.0)

     

       362
       362
       -
           @param lon Longitude in degrees (-180.0 to 180.0)

     

       363
       363
       -
           @param ?name Optional waypoint name

     

       364
       364
       -
           @param ?desc Optional waypoint description

     

       365
       365
       -
           @return Waypoint data

     

       366
       366
       -
           @raises Gpx_error on invalid coordinates *)

     

       367
       367
       -
       val make_waypoint_from_floats : lat:float -> lon:float -> ?name:string -> ?desc:string -> unit -> waypoint_data

     

       368
       368
       -
       

     

       369
       369
       -
       (** Create track from coordinate list.

     

       370
       370
       -
           @param name Track name

     

       371
       371
       -
           @param coords List of (latitude, longitude) pairs

     

       372
       372
       -
           @return Track with single segment

     

       373
       373
       -
           @raises Gpx_error on invalid coordinates *)

     

       374
       374
       -
       val make_track_from_coord_list : name:string -> (float * float) list -> track

     

       375
       375
       -
       

     

       376
       376
       -
       (** Create route from coordinate list.

     

       377
       377
       -
           @param name Route name  

     

       378
       378
       -
           @param coords List of (latitude, longitude) pairs

     

       379
       379
       -
           @return Route

     

       380
       380
       -
           @raises Gpx_error on invalid coordinates *)

     

       381
       381
       -
       val make_route_from_coord_list : name:string -> (float * float) list -> route

     

       382
       382
       -
       

     

       383
       383
       -
       (** Extract coordinates from waypoint.

     

       384
       384
       -
           @param wpt Waypoint data

     

       385
       385
       -
           @return (latitude, longitude) as floats *)

     

       386
       386
       -
       val waypoint_coords : waypoint_data -> float * float

     

       387
       387
       -
       

     

       388
       388
       -
       (** Extract coordinates from track.

     

       389
       389
       -
           @param track Track

     

       390
       390
       -
           @return List of (latitude, longitude) pairs *)

     

       391
       391
       -
       val track_coords : track -> (float * float) list

     

       392
       392
       -
       

     

       393
       393
       -
       (** Extract coordinates from route.

     

       394
       394
       -
           @param route Route

     

       395
       395
       -
           @return List of (latitude, longitude) pairs *)

     

       396
       396
       -
       val route_coords : route -> (float * float) list

     

       397
       397
       -
       

     

       398
       398
       -
       (** Count total points in GPX document.

     

       399
       399
       -
           @param gpx GPX document

     

       400
       400
       -
           @return Total number of waypoints, route points, and track points *)

     

       401
       401
       -
       val count_points : gpx -> int

     

       402
       402
       -
       

     

       403
       403
       -
       (** GPX statistics record *)

     

       404
       404
       -
       type gpx_stats = {

     

       405
       405
       -
         waypoint_count : int;      (** Number of waypoints *)

     

       406
       406
       -
         route_count : int;         (** Number of routes *)

     

       407
       407
       -
         track_count : int;         (** Number of tracks *)

     

       408
       408
       -
         total_points : int;        (** Total geographic points *)

     

       409
       409
       -
         has_elevation : bool;      (** Document contains elevation data *)

     

       410
       410
       -
         has_time : bool;          (** Document contains time data *)

     

       411
       411
       -
       }

     

       412
       412
       -
       

     

       413
       413
       -
       (** Get GPX document statistics.

     

       414
       414
       -
           @param gpx GPX document

     

       415
       415
       -
           @return Statistics summary *)

     

       416
       416
       -
       val get_stats : gpx -> gpx_stats

     

       417
       417
       -
       

     

       418
       418
       -
       (** Print GPX statistics to stdout.

     

       419
       419
       -
           @param gpx GPX document *)

     

       420
       420
       -
       val print_stats : gpx -> unit

     

       421
       421
       -
       

     

       422
       422
       -
       (** {2 Module Access}

     

       423
       423
       -
       

     

       424
       424
       -
           Direct access to submodules for advanced usage. *)

     

       425
       425
       -
       

     

       426
       426
       -
       (** Core type definitions and utilities *)

     

       427
       427
       -
       module Types = Types

     

       428
       428
       -
       

     

       429
       429
       -
       (** Streaming XML parser *)

     

       430
       430
       -
       module Parser = Parser

     

       431
       431
       -
       

     

       432
       432
       -
       (** Streaming XML writer *) 

     

       433
       433
       -
       module Writer = Writer

     

       434
       434
       -
       

     

       435
       435
       -
       (** Validation engine *)

     

       436
       436
       -
       module Validate = Validate
     

       121
       121
       +
       (** Create empty GPX document *)

     

       122
       122
       +
       val empty : creator:string -> t

+196

lib/gpx/gpx_doc.ml

···

       1
       1
       +
       (** Main GPX document type *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Main GPX document type *)

     

       4
       4
       +
       type t = {

     

       5
       5
       +
         version : string;                    (* GPX version: "1.0" or "1.1" *)

     

       6
       6
       +
         creator : string;                    (* Creating application *)

     

       7
       7
       +
         metadata : Metadata.t option;       (* Document metadata *)

     

       8
       8
       +
         waypoints : Waypoint.t list;        (* Waypoints *)

     

       9
       9
       +
         routes : Route.t list;               (* Routes *)

     

       10
       10
       +
         tracks : Track.t list;               (* Tracks *)

     

       11
       11
       +
         extensions : Extension.t list;       (* Document-level extensions *)

     

       12
       12
       +
       }

     

       13
       13
       +
       

     

       14
       14
       +
       (** {2 Document Constructors} *)

     

       15
       15
       +
       

     

       16
       16
       +
       (** Create empty GPX document *)

     

       17
       17
       +
       let empty ~creator = {

     

       18
       18
       +
         version = "1.1";

     

       19
       19
       +
         creator;

     

       20
       20
       +
         metadata = None;

     

       21
       21
       +
         waypoints = [];

     

       22
       22
       +
         routes = [];

     

       23
       23
       +
         tracks = [];

     

       24
       24
       +
         extensions = [];

     

       25
       25
       +
       }

     

       26
       26
       +
       

     

       27
       27
       +
       (** Create GPX document with metadata *)

     

       28
       28
       +
       let make ~creator ~metadata = 

     

       29
       29
       +
         { (empty ~creator) with metadata = Some metadata }

     

       30
       30
       +
       

     

       31
       31
       +
       (** {2 Document Properties} *)

     

       32
       32
       +
       

     

       33
       33
       +
       (** Get version *)

     

       34
       34
       +
       let get_version t = t.version

     

       35
       35
       +
       

     

       36
       36
       +
       (** Get creator *)

     

       37
       37
       +
       let get_creator t = t.creator

     

       38
       38
       +
       

     

       39
       39
       +
       (** Get metadata *)

     

       40
       40
       +
       let get_metadata t = t.metadata

     

       41
       41
       +
       

     

       42
       42
       +
       (** Get waypoints *)

     

       43
       43
       +
       let get_waypoints t = t.waypoints

     

       44
       44
       +
       

     

       45
       45
       +
       (** Get routes *)

     

       46
       46
       +
       let get_routes t = t.routes

     

       47
       47
       +
       

     

       48
       48
       +
       (** Get tracks *)

     

       49
       49
       +
       let get_tracks t = t.tracks

     

       50
       50
       +
       

     

       51
       51
       +
       (** Get extensions *)

     

       52
       52
       +
       let get_extensions t = t.extensions

     

       53
       53
       +
       

     

       54
       54
       +
       (** {2 Document Modification} *)

     

       55
       55
       +
       

     

       56
       56
       +
       (** Set version *)

     

       57
       57
       +
       let with_version t version = { t with version }

     

       58
       58
       +
       

     

       59
       59
       +
       (** Set metadata *)

     

       60
       60
       +
       let with_metadata t metadata = { t with metadata = Some metadata }

     

       61
       61
       +
       

     

       62
       62
       +
       (** Set metadata *)

     

       63
       63
       +
       let set_metadata metadata t = { t with metadata = Some metadata }

     

       64
       64
       +
       

     

       65
       65
       +
       (** Add waypoint *)

     

       66
       66
       +
       let add_waypoint t waypoint = { t with waypoints = t.waypoints @ [waypoint] }

     

       67
       67
       +
       

     

       68
       68
       +
       (** Add waypoints *)

     

       69
       69
       +
       let add_waypoints t waypoints = { t with waypoints = t.waypoints @ waypoints }

     

       70
       70
       +
       

     

       71
       71
       +
       (** Add route *)

     

       72
       72
       +
       let add_route t route = { t with routes = t.routes @ [route] }

     

       73
       73
       +
       

     

       74
       74
       +
       (** Add routes *)

     

       75
       75
       +
       let add_routes t routes = { t with routes = t.routes @ routes }

     

       76
       76
       +
       

     

       77
       77
       +
       (** Add track *)

     

       78
       78
       +
       let add_track t track = { t with tracks = t.tracks @ [track] }

     

       79
       79
       +
       

     

       80
       80
       +
       (** Add tracks *)

     

       81
       81
       +
       let add_tracks t tracks = { t with tracks = t.tracks @ tracks }

     

       82
       82
       +
       

     

       83
       83
       +
       (** Add extensions *)

     

       84
       84
       +
       let add_extensions t extensions = { t with extensions = t.extensions @ extensions }

     

       85
       85
       +
       

     

       86
       86
       +
       (** Clear waypoints *)

     

       87
       87
       +
       let clear_waypoints t = { t with waypoints = [] }

     

       88
       88
       +
       

     

       89
       89
       +
       (** Clear routes *)

     

       90
       90
       +
       let clear_routes t = { t with routes = [] }

     

       91
       91
       +
       

     

       92
       92
       +
       (** Clear tracks *)

     

       93
       93
       +
       let clear_tracks t = { t with tracks = [] }

     

       94
       94
       +
       

     

       95
       95
       +
       (** {2 Document Analysis} *)

     

       96
       96
       +
       

     

       97
       97
       +
       (** Count waypoints *)

     

       98
       98
       +
       let waypoint_count t = List.length t.waypoints

     

       99
       99
       +
       

     

       100
       100
       +
       (** Count routes *)

     

       101
       101
       +
       let route_count t = List.length t.routes

     

       102
       102
       +
       

     

       103
       103
       +
       (** Count tracks *)

     

       104
       104
       +
       let track_count t = List.length t.tracks

     

       105
       105
       +
       

     

       106
       106
       +
       (** Count total points *)

     

       107
       107
       +
       let total_points t =

     

       108
       108
       +
         let waypoint_points = List.length t.waypoints in

     

       109
       109
       +
         let route_points = List.fold_left (fun acc route -> 

     

       110
       110
       +
           acc + Route.point_count route) 0 t.routes in

     

       111
       111
       +
         let track_points = List.fold_left (fun acc track -> 

     

       112
       112
       +
           acc + Track.point_count track) 0 t.tracks in

     

       113
       113
       +
         waypoint_points + route_points + track_points

     

       114
       114
       +
       

     

       115
       115
       +
       (** Check if document has elevation data *)

     

       116
       116
       +
       let has_elevation t =

     

       117
       117
       +
         List.exists (fun wpt -> Waypoint.get_elevation wpt <> None) t.waypoints ||

     

       118
       118
       +
         List.exists (fun route ->

     

       119
       119
       +
           List.exists (fun pt -> Waypoint.get_elevation pt <> None) (Route.get_points route)

     

       120
       120
       +
         ) t.routes ||

     

       121
       121
       +
         List.exists (fun track ->

     

       122
       122
       +
           List.exists (fun pt -> Waypoint.get_elevation pt <> None) (Track.all_points track)

     

       123
       123
       +
         ) t.tracks

     

       124
       124
       +
       

     

       125
       125
       +
       (** Check if document has time data *)

     

       126
       126
       +
       let has_time t =

     

       127
       127
       +
         List.exists (fun wpt -> Waypoint.get_time wpt <> None) t.waypoints ||

     

       128
       128
       +
         List.exists (fun route ->

     

       129
       129
       +
           List.exists (fun pt -> Waypoint.get_time pt <> None) (Route.get_points route)

     

       130
       130
       +
         ) t.routes ||

     

       131
       131
       +
         List.exists (fun track ->

     

       132
       132
       +
           List.exists (fun pt -> Waypoint.get_time pt <> None) (Track.all_points track)

     

       133
       133
       +
         ) t.tracks

     

       134
       134
       +
       

     

       135
       135
       +
       (** Check if document is empty *)

     

       136
       136
       +
       let is_empty t = 

     

       137
       137
       +
         waypoint_count t = 0 && route_count t = 0 && track_count t = 0

     

       138
       138
       +
       

     

       139
       139
       +
       (** Get statistics *)

     

       140
       140
       +
       type stats = {

     

       141
       141
       +
         waypoint_count : int;

     

       142
       142
       +
         route_count : int;

     

       143
       143
       +
         track_count : int;

     

       144
       144
       +
         total_points : int;

     

       145
       145
       +
         has_elevation : bool;

     

       146
       146
       +
         has_time : bool;

     

       147
       147
       +
       }

     

       148
       148
       +
       

     

       149
       149
       +
       let get_stats t = {

     

       150
       150
       +
         waypoint_count = waypoint_count t;

     

       151
       151
       +
         route_count = route_count t;

     

       152
       152
       +
         track_count = track_count t;

     

       153
       153
       +
         total_points = total_points t;

     

       154
       154
       +
         has_elevation = has_elevation t;

     

       155
       155
       +
         has_time = has_time t;

     

       156
       156
       +
       }

     

       157
       157
       +
       

     

       158
       158
       +
       (** {2 Comparison and Utilities} *)

     

       159
       159
       +
       

     

       160
       160
       +
       (** Compare documents *)

     

       161
       161
       +
       let compare t1 t2 =

     

       162
       162
       +
         let version_cmp = String.compare t1.version t2.version in

     

       163
       163
       +
         if version_cmp <> 0 then version_cmp

     

       164
       164
       +
         else

     

       165
       165
       +
           let creator_cmp = String.compare t1.creator t2.creator in

     

       166
       166
       +
           if creator_cmp <> 0 then creator_cmp

     

       167
       167
       +
           else

     

       168
       168
       +
             let waypoints_cmp = List.compare Waypoint.compare t1.waypoints t2.waypoints in

     

       169
       169
       +
             if waypoints_cmp <> 0 then waypoints_cmp

     

       170
       170
       +
             else

     

       171
       171
       +
               let routes_cmp = List.compare Route.compare t1.routes t2.routes in

     

       172
       172
       +
               if routes_cmp <> 0 then routes_cmp

     

       173
       173
       +
               else List.compare Track.compare t1.tracks t2.tracks

     

       174
       174
       +
       

     

       175
       175
       +
       (** Test document equality *)

     

       176
       176
       +
       let equal t1 t2 = compare t1 t2 = 0

     

       177
       177
       +
       

     

       178
       178
       +
       (** Pretty print document *)

     

       179
       179
       +
       let pp ppf t =

     

       180
       180
       +
         let stats = get_stats t in

     

       181
       181
       +
         Format.fprintf ppf "GPX v%s by %s (%d wpt, %d routes, %d tracks, %d total points)"

     

       182
       182
       +
           t.version t.creator 

     

       183
       183
       +
           stats.waypoint_count stats.route_count stats.track_count stats.total_points

     

       184
       184
       +
       

     

       185
       185
       +
       (** Print document statistics *)

     

       186
       186
       +
       let print_stats t =

     

       187
       187
       +
         let stats = get_stats t in

     

       188
       188
       +
         Printf.printf "GPX Statistics:\n";

     

       189
       189
       +
         Printf.printf "  Version: %s\n" t.version;

     

       190
       190
       +
         Printf.printf "  Creator: %s\n" t.creator;

     

       191
       191
       +
         Printf.printf "  Waypoints: %d\n" stats.waypoint_count;

     

       192
       192
       +
         Printf.printf "  Routes: %d\n" stats.route_count;

     

       193
       193
       +
         Printf.printf "  Tracks: %d\n" stats.track_count;

     

       194
       194
       +
         Printf.printf "  Total points: %d\n" stats.total_points;

     

       195
       195
       +
         Printf.printf "  Has elevation data: %s\n" (if stats.has_elevation then "yes" else "no");

     

       196
       196
       +
         Printf.printf "  Has time data: %s\n" (if stats.has_time then "yes" else "no")

+134

lib/gpx/gpx_doc.mli

···

       1
       1
       +
       (** Main GPX document type *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Main GPX document type *)

     

       4
       4
       +
       type t = {

     

       5
       5
       +
         version : string;                    (* GPX version: "1.0" or "1.1" *)

     

       6
       6
       +
         creator : string;                    (* Creating application *)

     

       7
       7
       +
         metadata : Metadata.t option;       (* Document metadata *)

     

       8
       8
       +
         waypoints : Waypoint.t list;        (* Waypoints *)

     

       9
       9
       +
         routes : Route.t list;               (* Routes *)

     

       10
       10
       +
         tracks : Track.t list;               (* Tracks *)

     

       11
       11
       +
         extensions : Extension.t list;       (* Document-level extensions *)

     

       12
       12
       +
       }

     

       13
       13
       +
       

     

       14
       14
       +
       (** Document statistics *)

     

       15
       15
       +
       type stats = {

     

       16
       16
       +
         waypoint_count : int;

     

       17
       17
       +
         route_count : int;

     

       18
       18
       +
         track_count : int;

     

       19
       19
       +
         total_points : int;

     

       20
       20
       +
         has_elevation : bool;

     

       21
       21
       +
         has_time : bool;

     

       22
       22
       +
       }

     

       23
       23
       +
       

     

       24
       24
       +
       (** {2 Document Constructors} *)

     

       25
       25
       +
       

     

       26
       26
       +
       (** Create empty GPX document *)

     

       27
       27
       +
       val empty : creator:string -> t

     

       28
       28
       +
       

     

       29
       29
       +
       (** Create GPX document with metadata *)

     

       30
       30
       +
       val make : creator:string -> metadata:Metadata.t -> t

     

       31
       31
       +
       

     

       32
       32
       +
       (** {2 Document Properties} *)

     

       33
       33
       +
       

     

       34
       34
       +
       (** Get version *)

     

       35
       35
       +
       val get_version : t -> string

     

       36
       36
       +
       

     

       37
       37
       +
       (** Get creator *)

     

       38
       38
       +
       val get_creator : t -> string

     

       39
       39
       +
       

     

       40
       40
       +
       (** Get metadata *)

     

       41
       41
       +
       val get_metadata : t -> Metadata.t option

     

       42
       42
       +
       

     

       43
       43
       +
       (** Get waypoints *)

     

       44
       44
       +
       val get_waypoints : t -> Waypoint.t list

     

       45
       45
       +
       

     

       46
       46
       +
       (** Get routes *)

     

       47
       47
       +
       val get_routes : t -> Route.t list

     

       48
       48
       +
       

     

       49
       49
       +
       (** Get tracks *)

     

       50
       50
       +
       val get_tracks : t -> Track.t list

     

       51
       51
       +
       

     

       52
       52
       +
       (** Get extensions *)

     

       53
       53
       +
       val get_extensions : t -> Extension.t list

     

       54
       54
       +
       

     

       55
       55
       +
       (** {2 Document Modification} *)

     

       56
       56
       +
       

     

       57
       57
       +
       (** Set version *)

     

       58
       58
       +
       val with_version : t -> string -> t

     

       59
       59
       +
       

     

       60
       60
       +
       (** Set metadata *)

     

       61
       61
       +
       val with_metadata : t -> Metadata.t -> t

     

       62
       62
       +
       

     

       63
       63
       +
       (** Set metadata *)

     

       64
       64
       +
       val set_metadata : Metadata.t -> t -> t

     

       65
       65
       +
       

     

       66
       66
       +
       (** Add waypoint *)

     

       67
       67
       +
       val add_waypoint : t -> Waypoint.t -> t

     

       68
       68
       +
       

     

       69
       69
       +
       (** Add waypoints *)

     

       70
       70
       +
       val add_waypoints : t -> Waypoint.t list -> t

     

       71
       71
       +
       

     

       72
       72
       +
       (** Add route *)

     

       73
       73
       +
       val add_route : t -> Route.t -> t

     

       74
       74
       +
       

     

       75
       75
       +
       (** Add routes *)

     

       76
       76
       +
       val add_routes : t -> Route.t list -> t

     

       77
       77
       +
       

     

       78
       78
       +
       (** Add track *)

     

       79
       79
       +
       val add_track : t -> Track.t -> t

     

       80
       80
       +
       

     

       81
       81
       +
       (** Add tracks *)

     

       82
       82
       +
       val add_tracks : t -> Track.t list -> t

     

       83
       83
       +
       

     

       84
       84
       +
       (** Add extensions *)

     

       85
       85
       +
       val add_extensions : t -> Extension.t list -> t

     

       86
       86
       +
       

     

       87
       87
       +
       (** Clear waypoints *)

     

       88
       88
       +
       val clear_waypoints : t -> t

     

       89
       89
       +
       

     

       90
       90
       +
       (** Clear routes *)

     

       91
       91
       +
       val clear_routes : t -> t

     

       92
       92
       +
       

     

       93
       93
       +
       (** Clear tracks *)

     

       94
       94
       +
       val clear_tracks : t -> t

     

       95
       95
       +
       

     

       96
       96
       +
       (** {2 Document Analysis} *)

     

       97
       97
       +
       

     

       98
       98
       +
       (** Count waypoints *)

     

       99
       99
       +
       val waypoint_count : t -> int

     

       100
       100
       +
       

     

       101
       101
       +
       (** Count routes *)

     

       102
       102
       +
       val route_count : t -> int

     

       103
       103
       +
       

     

       104
       104
       +
       (** Count tracks *)

     

       105
       105
       +
       val track_count : t -> int

     

       106
       106
       +
       

     

       107
       107
       +
       (** Count total points *)

     

       108
       108
       +
       val total_points : t -> int

     

       109
       109
       +
       

     

       110
       110
       +
       (** Check if document has elevation data *)

     

       111
       111
       +
       val has_elevation : t -> bool

     

       112
       112
       +
       

     

       113
       113
       +
       (** Check if document has time data *)

     

       114
       114
       +
       val has_time : t -> bool

     

       115
       115
       +
       

     

       116
       116
       +
       (** Check if document is empty *)

     

       117
       117
       +
       val is_empty : t -> bool

     

       118
       118
       +
       

     

       119
       119
       +
       (** Get document statistics *)

     

       120
       120
       +
       val get_stats : t -> stats

     

       121
       121
       +
       

     

       122
       122
       +
       (** {2 Comparison and Utilities} *)

     

       123
       123
       +
       

     

       124
       124
       +
       (** Compare documents *)

     

       125
       125
       +
       val compare : t -> t -> int

     

       126
       126
       +
       

     

       127
       127
       +
       (** Test document equality *)

     

       128
       128
       +
       val equal : t -> t -> bool

     

       129
       129
       +
       

     

       130
       130
       +
       (** Pretty print document *)

     

       131
       131
       +
       val pp : Format.formatter -> t -> unit

     

       132
       132
       +
       

     

       133
       133
       +
       (** Print document statistics to stdout *)

     

       134
       134
       +
       val print_stats : t -> unit

+126

lib/gpx/link.ml

···

       1
       1
       +
       (** Link and person information types *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Main link type *)

     

       4
       4
       +
       type t = {

     

       5
       5
       +
         href : string;

     

       6
       6
       +
         text : string option;

     

       7
       7
       +
         type_ : string option;

     

       8
       8
       +
       }

     

       9
       9
       +
       

     

       10
       10
       +
       (** Person information *)

     

       11
       11
       +
       and person = {

     

       12
       12
       +
         name : string option;

     

       13
       13
       +
         email : string option;

     

       14
       14
       +
         link : t option;

     

       15
       15
       +
       }

     

       16
       16
       +
       

     

       17
       17
       +
       (** Copyright information *)

     

       18
       18
       +
       and copyright = {

     

       19
       19
       +
         author : string;

     

       20
       20
       +
         year : int option;

     

       21
       21
       +
         license : string option;

     

       22
       22
       +
       }

     

       23
       23
       +
       

     

       24
       24
       +
       (** {2 Link Operations} *)

     

       25
       25
       +
       

     

       26
       26
       +
       (** Create a link *)

     

       27
       27
       +
       let make ~href ?text ?type_ () = { href; text; type_ }

     

       28
       28
       +
       

     

       29
       29
       +
       (** Get href from link *)

     

       30
       30
       +
       let get_href t = t.href

     

       31
       31
       +
       

     

       32
       32
       +
       (** Get optional text from link *)

     

       33
       33
       +
       let get_text t = t.text

     

       34
       34
       +
       

     

       35
       35
       +
       (** Get optional type from link *)

     

       36
       36
       +
       let get_type t = t.type_

     

       37
       37
       +
       

     

       38
       38
       +
       (** Set text on link *)

     

       39
       39
       +
       let with_text t text = { t with text = Some text }

     

       40
       40
       +
       

     

       41
       41
       +
       (** Set type on link *)

     

       42
       42
       +
       let with_type t type_ = { t with type_ = Some type_ }

     

       43
       43
       +
       

     

       44
       44
       +
       (** Compare links *)

     

       45
       45
       +
       let compare t1 t2 =

     

       46
       46
       +
         let href_cmp = String.compare t1.href t2.href in

     

       47
       47
       +
         if href_cmp <> 0 then href_cmp

     

       48
       48
       +
         else

     

       49
       49
       +
           let text_cmp = Option.compare String.compare t1.text t2.text in

     

       50
       50
       +
           if text_cmp <> 0 then text_cmp

     

       51
       51
       +
           else Option.compare String.compare t1.type_ t2.type_

     

       52
       52
       +
       

     

       53
       53
       +
       (** Test link equality *)

     

       54
       54
       +
       let equal t1 t2 = compare t1 t2 = 0

     

       55
       55
       +
       

     

       56
       56
       +
       (** Pretty print link *)

     

       57
       57
       +
       let pp ppf t =

     

       58
       58
       +
         match t.text with

     

       59
       59
       +
         | Some text -> Format.fprintf ppf "%s (%s)" text t.href

     

       60
       60
       +
         | None -> Format.fprintf ppf "%s" t.href

     

       61
       61
       +
       

     

       62
       62
       +
       (** {2 Person Operations} *)

     

       63
       63
       +
       

     

       64
       64
       +
       (** Create person *)

     

       65
       65
       +
       let make_person ?name ?email ?link () = { name; email; link }

     

       66
       66
       +
       

     

       67
       67
       +
       (** Get person name *)

     

       68
       68
       +
       let get_person_name (p : person) = p.name

     

       69
       69
       +
       

     

       70
       70
       +
       (** Get person email *)

     

       71
       71
       +
       let get_person_email (p : person) = p.email

     

       72
       72
       +
       

     

       73
       73
       +
       (** Get person link *)

     

       74
       74
       +
       let get_person_link (p : person) = p.link

     

       75
       75
       +
       

     

       76
       76
       +
       (** Compare persons *)

     

       77
       77
       +
       let compare_person p1 p2 =

     

       78
       78
       +
         let name_cmp = Option.compare String.compare p1.name p2.name in

     

       79
       79
       +
         if name_cmp <> 0 then name_cmp

     

       80
       80
       +
         else

     

       81
       81
       +
           let email_cmp = Option.compare String.compare p1.email p2.email in

     

       82
       82
       +
           if email_cmp <> 0 then email_cmp

     

       83
       83
       +
           else Option.compare compare p1.link p2.link

     

       84
       84
       +
       

     

       85
       85
       +
       (** Test person equality *)

     

       86
       86
       +
       let equal_person p1 p2 = compare_person p1 p2 = 0

     

       87
       87
       +
       

     

       88
       88
       +
       (** Pretty print person *)

     

       89
       89
       +
       let pp_person ppf p =

     

       90
       90
       +
         match p.name, p.email with

     

       91
       91
       +
         | Some name, Some email -> Format.fprintf ppf "%s <%s>" name email

     

       92
       92
       +
         | Some name, None -> Format.fprintf ppf "%s" name

     

       93
       93
       +
         | None, Some email -> Format.fprintf ppf "<%s>" email

     

       94
       94
       +
         | None, None -> Format.fprintf ppf "(anonymous)"

     

       95
       95
       +
       

     

       96
       96
       +
       (** {2 Copyright Operations} *)

     

       97
       97
       +
       

     

       98
       98
       +
       (** Create copyright *)

     

       99
       99
       +
       let make_copyright ~author ?year ?license () = { author; year; license }

     

       100
       100
       +
       

     

       101
       101
       +
       (** Get copyright author *)

     

       102
       102
       +
       let get_copyright_author (c : copyright) = c.author

     

       103
       103
       +
       

     

       104
       104
       +
       (** Get copyright year *)

     

       105
       105
       +
       let get_copyright_year (c : copyright) = c.year

     

       106
       106
       +
       

     

       107
       107
       +
       (** Get copyright license *)

     

       108
       108
       +
       let get_copyright_license (c : copyright) = c.license

     

       109
       109
       +
       

     

       110
       110
       +
       (** Compare copyrights *)

     

       111
       111
       +
       let compare_copyright c1 c2 =

     

       112
       112
       +
         let author_cmp = String.compare c1.author c2.author in

     

       113
       113
       +
         if author_cmp <> 0 then author_cmp

     

       114
       114
       +
         else

     

       115
       115
       +
           let year_cmp = Option.compare Int.compare c1.year c2.year in

     

       116
       116
       +
           if year_cmp <> 0 then year_cmp

     

       117
       117
       +
           else Option.compare String.compare c1.license c2.license

     

       118
       118
       +
       

     

       119
       119
       +
       (** Test copyright equality *)

     

       120
       120
       +
       let equal_copyright c1 c2 = compare_copyright c1 c2 = 0

     

       121
       121
       +
       

     

       122
       122
       +
       (** Pretty print copyright *)

     

       123
       123
       +
       let pp_copyright ppf c =

     

       124
       124
       +
         match c.year with

     

       125
       125
       +
         | Some year -> Format.fprintf ppf "© %d %s" year c.author

     

       126
       126
       +
         | None -> Format.fprintf ppf "© %s" c.author

+100

lib/gpx/link.mli

···

       1
       1
       +
       (** Link and person information types *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Main link type *)

     

       4
       4
       +
       type t = {

     

       5
       5
       +
         href : string;

     

       6
       6
       +
         text : string option;

     

       7
       7
       +
         type_ : string option;

     

       8
       8
       +
       }

     

       9
       9
       +
       

     

       10
       10
       +
       (** Person information *)

     

       11
       11
       +
       and person = {

     

       12
       12
       +
         name : string option;

     

       13
       13
       +
         email : string option;

     

       14
       14
       +
         link : t option;

     

       15
       15
       +
       }

     

       16
       16
       +
       

     

       17
       17
       +
       (** Copyright information *)

     

       18
       18
       +
       and copyright = {

     

       19
       19
       +
         author : string;

     

       20
       20
       +
         year : int option;

     

       21
       21
       +
         license : string option;

     

       22
       22
       +
       }

     

       23
       23
       +
       

     

       24
       24
       +
       (** {2 Link Operations} *)

     

       25
       25
       +
       

     

       26
       26
       +
       (** Create a link.

     

       27
       27
       +
           @param href URL reference (required)

     

       28
       28
       +
           @param ?text Optional link text

     

       29
       29
       +
           @param ?type_ Optional MIME type *)

     

       30
       30
       +
       val make : href:string -> ?text:string -> ?type_:string -> unit -> t

     

       31
       31
       +
       

     

       32
       32
       +
       (** Get href from link *)

     

       33
       33
       +
       val get_href : t -> string

     

       34
       34
       +
       

     

       35
       35
       +
       (** Get optional text from link *)

     

       36
       36
       +
       val get_text : t -> string option

     

       37
       37
       +
       

     

       38
       38
       +
       (** Get optional type from link *)

     

       39
       39
       +
       val get_type : t -> string option

     

       40
       40
       +
       

     

       41
       41
       +
       (** Set text on link *)

     

       42
       42
       +
       val with_text : t -> string -> t

     

       43
       43
       +
       

     

       44
       44
       +
       (** Set type on link *)

     

       45
       45
       +
       val with_type : t -> string -> t

     

       46
       46
       +
       

     

       47
       47
       +
       (** Compare links *)

     

       48
       48
       +
       val compare : t -> t -> int

     

       49
       49
       +
       

     

       50
       50
       +
       (** Test link equality *)

     

       51
       51
       +
       val equal : t -> t -> bool

     

       52
       52
       +
       

     

       53
       53
       +
       (** Pretty print link *)

     

       54
       54
       +
       val pp : Format.formatter -> t -> unit

     

       55
       55
       +
       

     

       56
       56
       +
       (** {2 Person Operations} *)

     

       57
       57
       +
       

     

       58
       58
       +
       (** Create person information *)

     

       59
       59
       +
       val make_person : ?name:string -> ?email:string -> ?link:t -> unit -> person

     

       60
       60
       +
       

     

       61
       61
       +
       (** Get person name *)

     

       62
       62
       +
       val get_person_name : person -> string option

     

       63
       63
       +
       

     

       64
       64
       +
       (** Get person email *)

     

       65
       65
       +
       val get_person_email : person -> string option

     

       66
       66
       +
       

     

       67
       67
       +
       (** Get person link *)

     

       68
       68
       +
       val get_person_link : person -> t option

     

       69
       69
       +
       

     

       70
       70
       +
       (** Compare persons *)

     

       71
       71
       +
       val compare_person : person -> person -> int

     

       72
       72
       +
       

     

       73
       73
       +
       (** Test person equality *)

     

       74
       74
       +
       val equal_person : person -> person -> bool

     

       75
       75
       +
       

     

       76
       76
       +
       (** Pretty print person *)

     

       77
       77
       +
       val pp_person : Format.formatter -> person -> unit

     

       78
       78
       +
       

     

       79
       79
       +
       (** {2 Copyright Operations} *)

     

       80
       80
       +
       

     

       81
       81
       +
       (** Create copyright information *)

     

       82
       82
       +
       val make_copyright : author:string -> ?year:int -> ?license:string -> unit -> copyright

     

       83
       83
       +
       

     

       84
       84
       +
       (** Get copyright author *)

     

       85
       85
       +
       val get_copyright_author : copyright -> string

     

       86
       86
       +
       

     

       87
       87
       +
       (** Get copyright year *)

     

       88
       88
       +
       val get_copyright_year : copyright -> int option

     

       89
       89
       +
       

     

       90
       90
       +
       (** Get copyright license *)

     

       91
       91
       +
       val get_copyright_license : copyright -> string option

     

       92
       92
       +
       

     

       93
       93
       +
       (** Compare copyrights *)

     

       94
       94
       +
       val compare_copyright : copyright -> copyright -> int

     

       95
       95
       +
       

     

       96
       96
       +
       (** Test copyright equality *)

     

       97
       97
       +
       val equal_copyright : copyright -> copyright -> bool

     

       98
       98
       +
       

     

       99
       99
       +
       (** Pretty print copyright *)

     

       100
       100
       +
       val pp_copyright : Format.formatter -> copyright -> unit

+182

lib/gpx/metadata.ml

···

       1
       1
       +
       (** GPX metadata and bounds types *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Bounding box *)

     

       4
       4
       +
       type bounds = {

     

       5
       5
       +
         minlat : Coordinate.latitude;

     

       6
       6
       +
         minlon : Coordinate.longitude;

     

       7
       7
       +
         maxlat : Coordinate.latitude;

     

       8
       8
       +
         maxlon : Coordinate.longitude;

     

       9
       9
       +
       }

     

       10
       10
       +
       

     

       11
       11
       +
       (** Main metadata type *)

     

       12
       12
       +
       type t = {

     

       13
       13
       +
         name : string option;

     

       14
       14
       +
         desc : string option;

     

       15
       15
       +
         author : Link.person option;

     

       16
       16
       +
         copyright : Link.copyright option;

     

       17
       17
       +
         links : Link.t list;

     

       18
       18
       +
         time : Ptime.t option;

     

       19
       19
       +
         keywords : string option;

     

       20
       20
       +
         bounds : bounds option;

     

       21
       21
       +
         extensions : Extension.t list;

     

       22
       22
       +
       }

     

       23
       23
       +
       

     

       24
       24
       +
       (** {2 Bounds Operations} *)

     

       25
       25
       +
       

     

       26
       26
       +
       module Bounds = struct

     

       27
       27
       +
         type t = bounds

     

       28
       28
       +
       

     

       29
       29
       +
         (** Create bounds from coordinates *)

     

       30
       30
       +
         let make ~minlat ~minlon ~maxlat ~maxlon = { minlat; minlon; maxlat; maxlon }

     

       31
       31
       +
       

     

       32
       32
       +
         (** Create bounds from float coordinates with validation *)

     

       33
       33
       +
         let make_from_floats ~minlat ~minlon ~maxlat ~maxlon =

     

       34
       34
       +
           match 

     

       35
       35
       +
             Coordinate.latitude minlat,

     

       36
       36
       +
             Coordinate.longitude minlon, 

     

       37
       37
       +
             Coordinate.latitude maxlat,

     

       38
       38
       +
             Coordinate.longitude maxlon

     

       39
       39
       +
           with

     

       40
       40
       +
           | Ok minlat, Ok minlon, Ok maxlat, Ok maxlon ->

     

       41
       41
       +
             if Coordinate.latitude_to_float minlat <= Coordinate.latitude_to_float maxlat &&

     

       42
       42
       +
                Coordinate.longitude_to_float minlon <= Coordinate.longitude_to_float maxlon

     

       43
       43
       +
             then Ok { minlat; minlon; maxlat; maxlon }

     

       44
       44
       +
             else Error "Invalid bounds: min values must be <= max values"

     

       45
       45
       +
           | Error e, _, _, _ | _, Error e, _, _ | _, _, Error e, _ | _, _, _, Error e -> Error e

     

       46
       46
       +
       

     

       47
       47
       +
         (** Get corner coordinates *)

     

       48
       48
       +
         let get_min_coords t = Coordinate.make t.minlat t.minlon

     

       49
       49
       +
         let get_max_coords t = Coordinate.make t.maxlat t.maxlon

     

       50
       50
       +
       

     

       51
       51
       +
         (** Get all bounds as tuple *)

     

       52
       52
       +
         let get_bounds t = (t.minlat, t.minlon, t.maxlat, t.maxlon)

     

       53
       53
       +
       

     

       54
       54
       +
         (** Check if coordinate is within bounds *)

     

       55
       55
       +
         let contains bounds coord =

     

       56
       56
       +
           let lat = Coordinate.get_lat coord in

     

       57
       57
       +
           let lon = Coordinate.get_lon coord in

     

       58
       58
       +
           Coordinate.latitude_to_float bounds.minlat <= Coordinate.latitude_to_float lat &&

     

       59
       59
       +
           Coordinate.latitude_to_float lat <= Coordinate.latitude_to_float bounds.maxlat &&

     

       60
       60
       +
           Coordinate.longitude_to_float bounds.minlon <= Coordinate.longitude_to_float lon &&

     

       61
       61
       +
           Coordinate.longitude_to_float lon <= Coordinate.longitude_to_float bounds.maxlon

     

       62
       62
       +
       

     

       63
       63
       +
         (** Calculate bounds area *)

     

       64
       64
       +
         let area t =

     

       65
       65
       +
           let lat_diff = Coordinate.latitude_to_float t.maxlat -. Coordinate.latitude_to_float t.minlat in

     

       66
       66
       +
           let lon_diff = Coordinate.longitude_to_float t.maxlon -. Coordinate.longitude_to_float t.minlon in

     

       67
       67
       +
           lat_diff *. lon_diff

     

       68
       68
       +
       

     

       69
       69
       +
         (** Compare bounds *)

     

       70
       70
       +
         let compare t1 t2 =

     

       71
       71
       +
           let minlat_cmp = Float.compare 

     

       72
       72
       +
             (Coordinate.latitude_to_float t1.minlat) 

     

       73
       73
       +
             (Coordinate.latitude_to_float t2.minlat) in

     

       74
       74
       +
           if minlat_cmp <> 0 then minlat_cmp

     

       75
       75
       +
           else

     

       76
       76
       +
             let minlon_cmp = Float.compare 

     

       77
       77
       +
               (Coordinate.longitude_to_float t1.minlon) 

     

       78
       78
       +
               (Coordinate.longitude_to_float t2.minlon) in

     

       79
       79
       +
             if minlon_cmp <> 0 then minlon_cmp

     

       80
       80
       +
             else

     

       81
       81
       +
               let maxlat_cmp = Float.compare 

     

       82
       82
       +
                 (Coordinate.latitude_to_float t1.maxlat) 

     

       83
       83
       +
                 (Coordinate.latitude_to_float t2.maxlat) in

     

       84
       84
       +
               if maxlat_cmp <> 0 then maxlat_cmp

     

       85
       85
       +
               else Float.compare 

     

       86
       86
       +
                 (Coordinate.longitude_to_float t1.maxlon) 

     

       87
       87
       +
                 (Coordinate.longitude_to_float t2.maxlon)

     

       88
       88
       +
       

     

       89
       89
       +
         (** Test bounds equality *)

     

       90
       90
       +
         let equal t1 t2 = compare t1 t2 = 0

     

       91
       91
       +
       

     

       92
       92
       +
         (** Pretty print bounds *)

     

       93
       93
       +
         let pp ppf t =

     

       94
       94
       +
           Format.fprintf ppf "[(%g,%g) - (%g,%g)]"

     

       95
       95
       +
             (Coordinate.latitude_to_float t.minlat)

     

       96
       96
       +
             (Coordinate.longitude_to_float t.minlon)

     

       97
       97
       +
             (Coordinate.latitude_to_float t.maxlat)

     

       98
       98
       +
             (Coordinate.longitude_to_float t.maxlon)

     

       99
       99
       +
       end

     

       100
       100
       +
       

     

       101
       101
       +
       (** {2 Metadata Operations} *)

     

       102
       102
       +
       

     

       103
       103
       +
       (** Create empty metadata *)

     

       104
       104
       +
       let empty = {

     

       105
       105
       +
         name = None; desc = None; author = None; copyright = None;

     

       106
       106
       +
         links = []; time = None; keywords = None; bounds = None;

     

       107
       107
       +
         extensions = [];

     

       108
       108
       +
       }

     

       109
       109
       +
       

     

       110
       110
       +
       (** Create metadata with name *)

     

       111
       111
       +
       let make ~name = { empty with name = Some name }

     

       112
       112
       +
       

     

       113
       113
       +
       (** Get name *)

     

       114
       114
       +
       let get_name t = t.name

     

       115
       115
       +
       

     

       116
       116
       +
       (** Get description *)  

     

       117
       117
       +
       let get_description t = t.desc

     

       118
       118
       +
       

     

       119
       119
       +
       (** Get author *)

     

       120
       120
       +
       let get_author t = t.author

     

       121
       121
       +
       

     

       122
       122
       +
       (** Get copyright *)

     

       123
       123
       +
       let get_copyright t = t.copyright

     

       124
       124
       +
       

     

       125
       125
       +
       (** Get links *)

     

       126
       126
       +
       let get_links t = t.links

     

       127
       127
       +
       

     

       128
       128
       +
       (** Get time *)

     

       129
       129
       +
       let get_time t = t.time

     

       130
       130
       +
       

     

       131
       131
       +
       (** Get keywords *)

     

       132
       132
       +
       let get_keywords t = t.keywords

     

       133
       133
       +
       

     

       134
       134
       +
       (** Get bounds *)

     

       135
       135
       +
       let get_bounds t = t.bounds

     

       136
       136
       +
       

     

       137
       137
       +
       (** Set name *)

     

       138
       138
       +
       let set_name name t = { t with name = Some name }

     

       139
       139
       +
       

     

       140
       140
       +
       (** Set description *)

     

       141
       141
       +
       let set_description desc t = { t with desc = Some desc }

     

       142
       142
       +
       

     

       143
       143
       +
       (** Set author *)

     

       144
       144
       +
       let set_author author t = { t with author = Some author }

     

       145
       145
       +
       

     

       146
       146
       +
       (** Add link *)

     

       147
       147
       +
       let add_link t link = { t with links = link :: t.links }

     

       148
       148
       +
       

     

       149
       149
       +
       (** Functional setters for building metadata *)

     

       150
       150
       +
       

     

       151
       151
       +
       (** Set name *)

     

       152
       152
       +
       let with_name t name = { t with name = Some name }

     

       153
       153
       +
       

     

       154
       154
       +
       (** Set description *)

     

       155
       155
       +
       let with_description t desc = { t with desc = Some desc }

     

       156
       156
       +
       

     

       157
       157
       +
       (** Set keywords *)

     

       158
       158
       +
       let with_keywords t keywords = { t with keywords = Some keywords }

     

       159
       159
       +
       

     

       160
       160
       +
       (** Set time *)

     

       161
       161
       +
       let with_time t time = { t with time }

     

       162
       162
       +
       

     

       163
       163
       +
       (** Add extensions *)

     

       164
       164
       +
       let add_extensions t extensions = { t with extensions = extensions @ t.extensions }

     

       165
       165
       +
       

     

       166
       166
       +
       (** Compare metadata *)

     

       167
       167
       +
       let compare t1 t2 =

     

       168
       168
       +
         let name_cmp = Option.compare String.compare t1.name t2.name in

     

       169
       169
       +
         if name_cmp <> 0 then name_cmp

     

       170
       170
       +
         else

     

       171
       171
       +
           let desc_cmp = Option.compare String.compare t1.desc t2.desc in

     

       172
       172
       +
           if desc_cmp <> 0 then desc_cmp

     

       173
       173
       +
           else Option.compare Ptime.compare t1.time t2.time

     

       174
       174
       +
       

     

       175
       175
       +
       (** Test metadata equality *)

     

       176
       176
       +
       let equal t1 t2 = compare t1 t2 = 0

     

       177
       177
       +
       

     

       178
       178
       +
       (** Pretty print metadata *)

     

       179
       179
       +
       let pp ppf t =

     

       180
       180
       +
         match t.name with

     

       181
       181
       +
         | Some name -> Format.fprintf ppf "\"%s\"" name

     

       182
       182
       +
         | None -> Format.fprintf ppf "(unnamed)"

+129

lib/gpx/metadata.mli

···

       1
       1
       +
       (** GPX metadata and bounds types *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Bounding box *)

     

       4
       4
       +
       type bounds = {

     

       5
       5
       +
         minlat : Coordinate.latitude;

     

       6
       6
       +
         minlon : Coordinate.longitude;

     

       7
       7
       +
         maxlat : Coordinate.latitude;

     

       8
       8
       +
         maxlon : Coordinate.longitude;

     

       9
       9
       +
       }

     

       10
       10
       +
       

     

       11
       11
       +
       (** Main metadata type *)

     

       12
       12
       +
       type t = {

     

       13
       13
       +
         name : string option;

     

       14
       14
       +
         desc : string option;

     

       15
       15
       +
         author : Link.person option;

     

       16
       16
       +
         copyright : Link.copyright option;

     

       17
       17
       +
         links : Link.t list;

     

       18
       18
       +
         time : Ptime.t option;

     

       19
       19
       +
         keywords : string option;

     

       20
       20
       +
         bounds : bounds option;

     

       21
       21
       +
         extensions : Extension.t list;

     

       22
       22
       +
       }

     

       23
       23
       +
       

     

       24
       24
       +
       (** {2 Bounds Operations} *)

     

       25
       25
       +
       

     

       26
       26
       +
       module Bounds : sig

     

       27
       27
       +
         type t = bounds

     

       28
       28
       +
       

     

       29
       29
       +
         (** Create bounds from validated coordinates *)

     

       30
       30
       +
         val make : minlat:Coordinate.latitude -> minlon:Coordinate.longitude -> 

     

       31
       31
       +
                    maxlat:Coordinate.latitude -> maxlon:Coordinate.longitude -> t

     

       32
       32
       +
       

     

       33
       33
       +
         (** Create bounds from float coordinates with validation *)

     

       34
       34
       +
         val make_from_floats : minlat:float -> minlon:float -> maxlat:float -> maxlon:float -> (t, string) result

     

       35
       35
       +
       

     

       36
       36
       +
         (** Get minimum corner coordinates *)

     

       37
       37
       +
         val get_min_coords : t -> Coordinate.t

     

       38
       38
       +
       

     

       39
       39
       +
         (** Get maximum corner coordinates *)

     

       40
       40
       +
         val get_max_coords : t -> Coordinate.t

     

       41
       41
       +
       

     

       42
       42
       +
         (** Get all bounds as tuple *)

     

       43
       43
       +
         val get_bounds : t -> (Coordinate.latitude * Coordinate.longitude * Coordinate.latitude * Coordinate.longitude)

     

       44
       44
       +
       

     

       45
       45
       +
         (** Check if coordinate is within bounds *)

     

       46
       46
       +
         val contains : t -> Coordinate.t -> bool

     

       47
       47
       +
       

     

       48
       48
       +
         (** Calculate bounds area in square degrees *)

     

       49
       49
       +
         val area : t -> float

     

       50
       50
       +
       

     

       51
       51
       +
         (** Compare bounds *)

     

       52
       52
       +
         val compare : t -> t -> int

     

       53
       53
       +
       

     

       54
       54
       +
         (** Test bounds equality *)

     

       55
       55
       +
         val equal : t -> t -> bool

     

       56
       56
       +
       

     

       57
       57
       +
         (** Pretty print bounds *)

     

       58
       58
       +
         val pp : Format.formatter -> t -> unit

     

       59
       59
       +
       end

     

       60
       60
       +
       

     

       61
       61
       +
       (** {2 Metadata Operations} *)

     

       62
       62
       +
       

     

       63
       63
       +
       (** Create empty metadata *)

     

       64
       64
       +
       val empty : t

     

       65
       65
       +
       

     

       66
       66
       +
       (** Create metadata with name *)

     

       67
       67
       +
       val make : name:string -> t

     

       68
       68
       +
       

     

       69
       69
       +
       (** Get name *)

     

       70
       70
       +
       val get_name : t -> string option

     

       71
       71
       +
       

     

       72
       72
       +
       (** Get description *)  

     

       73
       73
       +
       val get_description : t -> string option

     

       74
       74
       +
       

     

       75
       75
       +
       (** Get author *)

     

       76
       76
       +
       val get_author : t -> Link.person option

     

       77
       77
       +
       

     

       78
       78
       +
       (** Get copyright *)

     

       79
       79
       +
       val get_copyright : t -> Link.copyright option

     

       80
       80
       +
       

     

       81
       81
       +
       (** Get links *)

     

       82
       82
       +
       val get_links : t -> Link.t list

     

       83
       83
       +
       

     

       84
       84
       +
       (** Get time *)

     

       85
       85
       +
       val get_time : t -> Ptime.t option

     

       86
       86
       +
       

     

       87
       87
       +
       (** Get keywords *)

     

       88
       88
       +
       val get_keywords : t -> string option

     

       89
       89
       +
       

     

       90
       90
       +
       (** Get bounds *)

     

       91
       91
       +
       val get_bounds : t -> bounds option

     

       92
       92
       +
       

     

       93
       93
       +
       (** Set name *)

     

       94
       94
       +
       val set_name : string -> t -> t

     

       95
       95
       +
       

     

       96
       96
       +
       (** Set description *)

     

       97
       97
       +
       val set_description : string -> t -> t

     

       98
       98
       +
       

     

       99
       99
       +
       (** Set author *)

     

       100
       100
       +
       val set_author : Link.person -> t -> t

     

       101
       101
       +
       

     

       102
       102
       +
       (** Functional setters for building metadata *)

     

       103
       103
       +
       

     

       104
       104
       +
       (** Set name *)

     

       105
       105
       +
       val with_name : t -> string -> t

     

       106
       106
       +
       

     

       107
       107
       +
       (** Set description *)

     

       108
       108
       +
       val with_description : t -> string -> t

     

       109
       109
       +
       

     

       110
       110
       +
       (** Set keywords *)

     

       111
       111
       +
       val with_keywords : t -> string -> t

     

       112
       112
       +
       

     

       113
       113
       +
       (** Set time *)

     

       114
       114
       +
       val with_time : t -> Ptime.t option -> t

     

       115
       115
       +
       

     

       116
       116
       +
       (** Add link *)

     

       117
       117
       +
       val add_link : t -> Link.t -> t

     

       118
       118
       +
       

     

       119
       119
       +
       (** Add extensions *)

     

       120
       120
       +
       val add_extensions : t -> Extension.t list -> t

     

       121
       121
       +
       

     

       122
       122
       +
       (** Compare metadata *)

     

       123
       123
       +
       val compare : t -> t -> int

     

       124
       124
       +
       

     

       125
       125
       +
       (** Test metadata equality *)

     

       126
       126
       +
       val equal : t -> t -> bool

     

       127
       127
       +
       

     

       128
       128
       +
       (** Pretty print metadata *)

     

       129
       129
       +
       val pp : Format.formatter -> t -> unit

+95 -105

lib/gpx/parser.ml

···

       1
       1
        
       (** GPX streaming parser using xmlm *)

     

       2
       2
        
       

     

       3
       3
       -
       open Types

     

       4
       4
       -
       

     

       5
       3
        
       (** Parser state for streaming *)

     

       6
       4
        
       type parser_state = {

     

       7
       5
        
         input : Xmlm.input;

     
···

       27
       25
        
       let require_attribute name attrs element =

     

       28
       26
        
         match get_attribute name attrs with

     

       29
       27
        
         | Some value -> Ok value

     

       30
       30
       -
         | None -> Error (Missing_required_attribute (element, name))

     

       28
       28
       +
         | None -> Error (Error.missing_attribute element name)

     

       31
       29
        
       

     

       32
       30
        
       let parse_float_opt s =

     

       33
       31
        
         try Some (Float.of_string s)

     
···

       50
       48
        
         let* lon_str = require_attribute "lon" attrs element in

     

       51
       49
        
         match (Float.of_string lat_str, Float.of_string lon_str) with

     

       52
       50
        
         | (lat_f, lon_f) ->

     

       53
       53
       -
           let* lat = Result.map_error (fun s -> Invalid_coordinate s) (latitude lat_f) in

     

       54
       54
       -
           let* lon = Result.map_error (fun s -> Invalid_coordinate s) (longitude lon_f) in

     

       51
       51
       +
           let* lat = Result.map_error Error.invalid_coordinate (Coordinate.latitude lat_f) in

     

       52
       52
       +
           let* lon = Result.map_error Error.invalid_coordinate (Coordinate.longitude lon_f) in

     

       55
       53
        
           Ok (lat, lon)

     

       56
       56
       -
         | exception _ -> Error (Invalid_coordinate "Invalid coordinate format")

     

       54
       54
       +
         | exception _ -> Error (Error.invalid_coordinate "Invalid coordinate format")

     

       57
       55
        
       

     

       58
       56
        
       (** Parse waypoint data from XML elements *)

     

       59
       57
        
       let rec parse_waypoint_data parser lat lon =

     

       60
       60
       -
         let wpt = make_waypoint_data lat lon in

     

       58
       58
       +
         let wpt = Waypoint.make lat lon in

     

       61
       59
        
         parse_waypoint_elements parser wpt

     

       62
       60
        
       

     

       63
       61
        
       and parse_waypoint_elements parser wpt =

     
···

       69
       67
        
              | "ele" -> 

     

       70
       68
        
                let* text = parse_text_content parser in

     

       71
       69
        
                (match parse_float_opt text with

     

       72
       72
       -
                 | Some ele -> loop { wpt with ele = Some ele }

     

       70
       70
       +
                 | Some ele -> loop (Waypoint.with_elevation wpt ele)

     

       73
       71
        
                 | None -> loop wpt)

     

       74
       72
        
              | "time" ->

     

       75
       73
        
                let* text = parse_text_content parser in

     

       76
       76
       -
                loop { wpt with time = parse_time text }

     

       74
       74
       +
                loop (Waypoint.with_time wpt (parse_time text))

     

       77
       75
        
              | "magvar" ->

     

       78
       76
        
                let* text = parse_text_content parser in

     

       79
       77
        
                (match parse_float_opt text with

     

       80
       78
        
                 | Some f -> 

     

       81
       81
       -
                   (match degrees f with

     

       82
       82
       -
                    | Ok deg -> loop { wpt with magvar = Some deg }

     

       79
       79
       +
                   (match Coordinate.degrees f with

     

       80
       80
       +
                    | Ok deg -> loop (Waypoint.with_magvar wpt deg)

     

       83
       81
        
                    | Error _ -> loop wpt)

     

       84
       82
        
                 | None -> loop wpt)

     

       85
       83
        
              | "geoidheight" ->

     

       86
       84
        
                let* text = parse_text_content parser in

     

       87
       85
        
                (match parse_float_opt text with

     

       88
       88
       -
                 | Some h -> loop { wpt with geoidheight = Some h }

     

       86
       86
       +
                 | Some h -> loop (Waypoint.with_geoidheight wpt h)

     

       89
       87
        
                 | None -> loop wpt)

     

       90
       88
        
              | "name" ->

     

       91
       89
        
                let* text = parse_text_content parser in

     

       92
       92
       -
                loop { wpt with name = Some text }

     

       90
       90
       +
                loop (Waypoint.with_name wpt text)

     

       93
       91
        
              | "cmt" ->

     

       94
       92
        
                let* text = parse_text_content parser in

     

       95
       95
       -
                loop { wpt with cmt = Some text }

     

       93
       93
       +
                loop (Waypoint.with_comment wpt text)

     

       96
       94
        
              | "desc" ->

     

       97
       95
        
                let* text = parse_text_content parser in

     

       98
       98
       -
                loop { wpt with desc = Some text }

     

       96
       96
       +
                loop (Waypoint.with_description wpt text)

     

       99
       97
        
              | "src" ->

     

       100
       98
        
                let* text = parse_text_content parser in

     

       101
       101
       -
                loop { wpt with src = Some text }

     

       99
       99
       +
                loop (Waypoint.with_source wpt text)

     

       102
       100
        
              | "sym" ->

     

       103
       101
        
                let* text = parse_text_content parser in

     

       104
       104
       -
                loop { wpt with sym = Some text }

     

       102
       102
       +
                loop (Waypoint.with_symbol wpt text)

     

       105
       103
        
              | "type" ->

     

       106
       104
        
                let* text = parse_text_content parser in

     

       107
       107
       -
                loop { wpt with type_ = Some text }

     

       105
       105
       +
                loop (Waypoint.with_type wpt text)

     

       108
       106
        
              | "fix" ->

     

       109
       107
        
                let* text = parse_text_content parser in

     

       110
       110
       -
                loop { wpt with fix = fix_type_of_string text }

     

       108
       108
       +
                loop (Waypoint.with_fix wpt (Waypoint.fix_type_of_string text))

     

       111
       109
        
              | "sat" ->

     

       112
       110
        
                let* text = parse_text_content parser in

     

       113
       111
        
                (match parse_int_opt text with

     

       114
       114
       -
                 | Some s -> loop { wpt with sat = Some s }

     

       112
       112
       +
                 | Some s -> loop (Waypoint.with_sat wpt s)

     

       115
       113
        
                 | None -> loop wpt)

     

       116
       116
       -
              | "hdop" | "vdop" | "pdop" ->

     

       114
       114
       +
              | "hdop" ->

     

       117
       115
        
                let* text = parse_text_content parser in

     

       118
       116
        
                (match parse_float_opt text with

     

       119
       119
       -
                 | Some f -> 

     

       120
       120
       -
                   (match name with

     

       121
       121
       -
                    | "hdop" -> loop { wpt with hdop = Some f }

     

       122
       122
       -
                    | "vdop" -> loop { wpt with vdop = Some f }

     

       123
       123
       -
                    | "pdop" -> loop { wpt with pdop = Some f }

     

       124
       124
       -
                    | _ -> loop wpt)

     

       117
       117
       +
                 | Some f -> loop (Waypoint.with_hdop wpt f)

     

       118
       118
       +
                 | None -> loop wpt)

     

       119
       119
       +
              | "vdop" ->

     

       120
       120
       +
                let* text = parse_text_content parser in

     

       121
       121
       +
                (match parse_float_opt text with

     

       122
       122
       +
                 | Some f -> loop (Waypoint.with_vdop wpt f)

     

       123
       123
       +
                 | None -> loop wpt)

     

       124
       124
       +
              | "pdop" ->

     

       125
       125
       +
                let* text = parse_text_content parser in

     

       126
       126
       +
                (match parse_float_opt text with

     

       127
       127
       +
                 | Some f -> loop (Waypoint.with_pdop wpt f)

     

       125
       128
        
                 | None -> loop wpt)

     

       126
       129
        
              | "ageofdgpsdata" ->

     

       127
       130
        
                let* text = parse_text_content parser in

     

       128
       131
        
                (match parse_float_opt text with

     

       129
       129
       -
                 | Some f -> loop { wpt with ageofdgpsdata = Some f }

     

       132
       132
       +
                 | Some f -> loop (Waypoint.with_ageofdgpsdata wpt f)

     

       130
       133
        
                 | None -> loop wpt)

     

       131
       134
        
              | "dgpsid" ->

     

       132
       135
        
                let* text = parse_text_content parser in

     

       133
       136
        
                (match parse_int_opt text with

     

       134
       134
       -
                 | Some id -> loop { wpt with dgpsid = Some id }

     

       137
       137
       +
                 | Some id -> loop (Waypoint.with_dgpsid wpt id)

     

       135
       138
        
                 | None -> loop wpt)

     

       136
       139
        
              | "link" ->

     

       137
       140
        
                let* link = parse_link parser attrs in

     

       138
       138
       -
                loop { wpt with links = link :: wpt.links }

     

       141
       141
       +
                loop (Waypoint.add_link wpt link)

     

       139
       142
        
              | "extensions" ->

     

       140
       143
        
                let* extensions = parse_extensions parser in

     

       141
       141
       -
                loop { wpt with extensions = extensions @ wpt.extensions }

     

       144
       144
       +
                loop (Waypoint.add_extensions wpt extensions)

     

       142
       145
        
              | _ -> 

     

       143
       146
        
                (* Skip unknown elements *)

     

       144
       147
        
                let* _ = skip_element parser in

     
···

       165
       168
        
             parser.current_element <- List.tl parser.current_element;

     

       166
       169
        
             Ok (Buffer.contents parser.text_buffer)

     

       167
       170
        
           | `El_start _ ->

     

       168
       168
       -
             Error (Invalid_xml "Unexpected element in text content")

     

       171
       171
       +
             Error (Error.invalid_xml "Unexpected element in text content")

     

       169
       172
        
           | `Dtd _ ->

     

       170
       173
        
             loop ()

     

       171
       174
        
         in

     
···

       176
       179
        
           | Some h -> h

     

       177
       180
        
           | None -> ""

     

       178
       181
        
         in

     

       179
       179
       -
         let link = { href; text = None; type_ = None } in

     

       182
       182
       +
         let link = Link.make ~href () in

     

       180
       183
        
         parse_link_elements parser link

     

       181
       184
        
       

     

       182
       185
        
       and parse_link_elements parser link =

     
···

       187
       190
        
             (match name with

     

       188
       191
        
              | "text" ->

     

       189
       192
        
                let* text = parse_text_content parser in

     

       190
       190
       -
                loop { link with text = Some text }

     

       193
       193
       +
                loop (Link.with_text link text)

     

       191
       194
        
              | "type" ->

     

       192
       195
        
                let* type_text = parse_text_content parser in

     

       193
       193
       -
                loop { link with type_ = Some type_text }

     

       196
       196
       +
                loop (Link.with_type link type_text)

     

       194
       197
        
              | _ ->

     

       195
       198
        
                let* _ = skip_element parser in

     

       196
       199
        
                loop link)

     
···

       225
       228
        
         let namespace = if ns = "" then None else Some ns in

     

       226
       229
        
         let attributes = List.map (fun ((_, n), v) -> (n, v)) attrs in

     

       227
       230
        
         let* content = parse_extension_content parser in

     

       228
       228
       -
         Ok { namespace; name; attributes; content }

     

       231
       231
       +
         Ok (Extension.make ~namespace ~name ~attributes ~content ())

     

       229
       232
        
       

     

       230
       233
        
       and parse_extension_content parser =

     

       231
       234
        
         Buffer.clear parser.text_buffer;

     
···

       242
       245
        
             parser.current_element <- List.tl parser.current_element;

     

       243
       246
        
             let text = String.trim (Buffer.contents parser.text_buffer) in

     

       244
       247
        
             Ok (match (text, elements) with

     

       245
       245
       -
                 | ("", []) -> Text ""

     

       246
       246
       -
                 | ("", els) -> Elements (List.rev els)

     

       247
       247
       -
                 | (t, []) -> Text t

     

       248
       248
       -
                 | (t, els) -> Mixed (t, List.rev els))

     

       248
       248
       +
                 | ("", []) -> Extension.text_content ""

     

       249
       249
       +
                 | ("", els) -> Extension.elements_content (List.rev els)

     

       250
       250
       +
                 | (t, []) -> Extension.text_content t

     

       251
       251
       +
                 | (t, els) -> Extension.mixed_content t (List.rev els))

     

       249
       252
        
           | `Dtd _ ->

     

       250
       253
        
             loop elements

     

       251
       254
        
         in

     
···

       272
       275
        
             let* version = require_attribute "version" attrs "gpx" in

     

       273
       276
        
             let* creator = require_attribute "creator" attrs "gpx" in

     

       274
       277
        
             if version <> "1.0" && version <> "1.1" then

     

       275
       275
       -
               Error (Validation_error ("Unsupported GPX version: " ^ version ^ " (supported: 1.0, 1.1)"))

     

       278
       278
       +
               Error (Error.validation_error ("Unsupported GPX version: " ^ version ^ " (supported: 1.0, 1.1)"))

     

       276
       279
        
             else

     

       277
       280
        
               Ok (version, creator)

     

       278
       281
        
           | `El_start _ ->

     
···

       281
       284
        
           | `Dtd _ ->

     

       282
       285
        
             find_gpx_root ()

     

       283
       286
        
           | `El_end ->

     

       284
       284
       -
             Error (Missing_required_element "gpx")

     

       287
       287
       +
             Error (Error.missing_element "gpx")

     

       285
       288
        
           | `Data _ ->

     

       286
       289
        
             find_gpx_root ()

     

       287
       290
        
         in

     

       288
       291
        
         

     

       289
       292
        
         let* (version, creator) = find_gpx_root () in

     

       290
       290
       -
         let gpx = make_gpx ~creator in

     

       291
       291
       -
         parse_gpx_elements parser { gpx with version }

     

       293
       293
       +
         let gpx = Gpx_doc.empty ~creator in

     

       294
       294
       +
         parse_gpx_elements parser (Gpx_doc.with_version gpx version)

     

       292
       295
        
       

     

       293
       296
        
       and parse_gpx_elements parser gpx =

     

       294
       297
        
         let rec loop gpx =

     
···

       298
       301
        
             (match name with

     

       299
       302
        
              | "metadata" ->

     

       300
       303
        
                let* metadata = parse_metadata parser in

     

       301
       301
       -
                loop { gpx with metadata = Some metadata }

     

       304
       304
       +
                loop (Gpx_doc.with_metadata gpx metadata)

     

       302
       305
        
              | "wpt" ->

     

       303
       306
        
                let* (lat, lon) = parse_coordinates attrs "wpt" in

     

       304
       307
        
                let* waypoint = parse_waypoint_data parser lat lon in

     

       305
       305
       -
                loop { gpx with waypoints = waypoint :: gpx.waypoints }

     

       308
       308
       +
                loop (Gpx_doc.add_waypoint gpx waypoint)

     

       306
       309
        
              | "rte" ->

     

       307
       310
        
                let* route = parse_route parser in

     

       308
       308
       -
                loop { gpx with routes = route :: gpx.routes }

     

       311
       311
       +
                loop (Gpx_doc.add_route gpx route)

     

       309
       312
        
              | "trk" ->

     

       310
       313
        
                let* track = parse_track parser in

     

       311
       311
       -
                loop { gpx with tracks = track :: gpx.tracks }

     

       314
       314
       +
                loop (Gpx_doc.add_track gpx track)

     

       312
       315
        
              | "extensions" ->

     

       313
       316
        
                let* extensions = parse_extensions parser in

     

       314
       314
       -
                loop { gpx with extensions = extensions @ gpx.extensions }

     

       317
       317
       +
                loop (Gpx_doc.add_extensions gpx extensions)

     

       315
       318
        
              | _ ->

     

       316
       319
        
                let* _ = skip_element parser in

     

       317
       320
        
                loop gpx)

     

       318
       321
        
           | `El_end ->

     

       319
       319
       -
             Ok { gpx with 

     

       320
       320
       -
                  waypoints = List.rev gpx.waypoints;

     

       321
       321
       -
                  routes = List.rev gpx.routes;

     

       322
       322
       -
                  tracks = List.rev gpx.tracks }

     

       322
       322
       +
             Ok gpx

     

       323
       323
        
           | `Data _ ->

     

       324
       324
        
             loop gpx

     

       325
       325
        
           | `Dtd _ ->

     
···

       328
       328
        
         loop gpx

     

       329
       329
        
       

     

       330
       330
        
       and parse_metadata parser =

     

       331
       331
       -
         let metadata = empty_metadata in

     

       332
       332
       -
         let rec loop (metadata : metadata) =

     

       331
       331
       +
         let metadata = Metadata.empty in

     

       332
       332
       +
         let rec loop metadata =

     

       333
       333
        
           match Xmlm.input parser.input with

     

       334
       334
        
           | `El_start ((_, name), attrs) ->

     

       335
       335
        
             parser.current_element <- name :: parser.current_element;

     

       336
       336
        
             (match name with

     

       337
       337
        
              | "name" ->

     

       338
       338
        
                let* text = parse_text_content parser in

     

       339
       339
       -
                loop { metadata with name = Some text }

     

       339
       339
       +
                loop (Metadata.with_name metadata text)

     

       340
       340
        
              | "desc" ->

     

       341
       341
        
                let* text = parse_text_content parser in

     

       342
       342
       -
                loop { metadata with desc = Some text }

     

       342
       342
       +
                loop (Metadata.with_description metadata text)

     

       343
       343
        
              | "keywords" ->

     

       344
       344
        
                let* text = parse_text_content parser in

     

       345
       345
       -
                loop { metadata with keywords = Some text }

     

       345
       345
       +
                loop (Metadata.with_keywords metadata text)

     

       346
       346
        
              | "time" ->

     

       347
       347
        
                let* text = parse_text_content parser in

     

       348
       348
       -
                loop { metadata with time = parse_time text }

     

       348
       348
       +
                loop (Metadata.with_time metadata (parse_time text))

     

       349
       349
        
              | "link" ->

     

       350
       350
        
                let* link = parse_link parser attrs in

     

       351
       351
       -
                loop { metadata with links = link :: metadata.links }

     

       351
       351
       +
                loop (Metadata.add_link metadata link)

     

       352
       352
        
              | "extensions" ->

     

       353
       353
        
                let* extensions = parse_extensions parser in

     

       354
       354
       -
                loop { metadata with extensions = extensions @ metadata.extensions }

     

       354
       354
       +
                loop (Metadata.add_extensions metadata extensions)

     

       355
       355
        
              | _ ->

     

       356
       356
        
                let* _ = skip_element parser in

     

       357
       357
        
                loop metadata)

     

       358
       358
        
           | `El_end ->

     

       359
       359
        
             parser.current_element <- List.tl parser.current_element;

     

       360
       360
       -
             Ok { metadata with links = List.rev metadata.links }

     

       360
       360
       +
             Ok metadata

     

       361
       361
        
           | `Data _ ->

     

       362
       362
        
             loop metadata

     

       363
       363
        
           | `Dtd _ ->

     
···

       366
       366
        
         loop metadata

     

       367
       367
        
       

     

       368
       368
        
       and parse_route parser =

     

       369
       369
       -
         let route = { 

     

       370
       370
       -
           name = None; cmt = None; desc = None; src = None; links = [];

     

       371
       371
       -
           number = None; type_ = None; extensions = []; rtepts = []

     

       372
       372
       -
         } in

     

       373
       373
       -
         let rec loop (route : route) =

     

       369
       369
       +
         let route = Route.empty in

     

       370
       370
       +
         let rec loop route =

     

       374
       371
        
           match Xmlm.input parser.input with

     

       375
       372
        
           | `El_start ((_, name), attrs) ->

     

       376
       373
        
             parser.current_element <- name :: parser.current_element;

     

       377
       374
        
             (match name with

     

       378
       375
        
              | "name" ->

     

       379
       376
        
                let* text = parse_text_content parser in

     

       380
       380
       -
                loop { route with name = Some text }

     

       377
       377
       +
                loop (Route.with_name route text)

     

       381
       378
        
              | "cmt" ->

     

       382
       379
        
                let* text = parse_text_content parser in

     

       383
       383
       -
                loop { route with cmt = Some text }

     

       380
       380
       +
                loop (Route.with_comment route text)

     

       384
       381
        
              | "desc" ->

     

       385
       382
        
                let* text = parse_text_content parser in

     

       386
       386
       -
                loop { route with desc = Some text }

     

       383
       383
       +
                loop (Route.with_description route text)

     

       387
       384
        
              | "src" ->

     

       388
       385
        
                let* text = parse_text_content parser in

     

       389
       389
       -
                loop { route with src = Some text }

     

       386
       386
       +
                loop (Route.with_source route text)

     

       390
       387
        
              | "number" ->

     

       391
       388
        
                let* text = parse_text_content parser in

     

       392
       389
        
                (match parse_int_opt text with

     

       393
       393
       -
                 | Some n -> loop { route with number = Some n }

     

       390
       390
       +
                 | Some n -> loop (Route.with_number route n)

     

       394
       391
        
                 | None -> loop route)

     

       395
       392
        
              | "type" ->

     

       396
       393
        
                let* text = parse_text_content parser in

     

       397
       397
       -
                loop { route with type_ = Some text }

     

       394
       394
       +
                loop (Route.with_type route text)

     

       398
       395
        
              | "rtept" ->

     

       399
       396
        
                let* (lat, lon) = parse_coordinates attrs "rtept" in

     

       400
       397
        
                let* rtept = parse_waypoint_data parser lat lon in

     

       401
       401
       -
                loop { route with rtepts = rtept :: route.rtepts }

     

       398
       398
       +
                loop (Route.add_point route rtept)

     

       402
       399
        
              | "link" ->

     

       403
       400
        
                let* link = parse_link parser attrs in

     

       404
       404
       -
                loop { route with links = link :: route.links }

     

       401
       401
       +
                loop (Route.add_link route link)

     

       405
       402
        
              | "extensions" ->

     

       406
       403
        
                let* extensions = parse_extensions parser in

     

       407
       407
       -
                loop { route with extensions = extensions @ route.extensions }

     

       404
       404
       +
                loop (Route.add_extensions route extensions)

     

       408
       405
        
              | _ ->

     

       409
       406
        
                let* _ = skip_element parser in

     

       410
       407
        
                loop route)

     

       411
       408
        
           | `El_end ->

     

       412
       409
        
             parser.current_element <- List.tl parser.current_element;

     

       413
       413
       -
             Ok { route with 

     

       414
       414
       -
                  rtepts = List.rev route.rtepts;

     

       415
       415
       -
                  links = List.rev route.links }

     

       410
       410
       +
             Ok route

     

       416
       411
        
           | `Data _ ->

     

       417
       412
        
             loop route

     

       418
       413
        
           | `Dtd _ ->

     
···

       421
       416
        
         loop route

     

       422
       417
        
       

     

       423
       418
        
       and parse_track parser =

     

       424
       424
       -
         let track = {

     

       425
       425
       -
           name = None; cmt = None; desc = None; src = None; links = [];

     

       426
       426
       -
           number = None; type_ = None; extensions = []; trksegs = []

     

       427
       427
       -
         } in

     

       419
       419
       +
         let track = Track.empty in

     

       428
       420
        
         let rec loop track =

     

       429
       421
        
           match Xmlm.input parser.input with

     

       430
       422
        
           | `El_start ((_, name), attrs) ->

     
···

       432
       424
        
             (match name with

     

       433
       425
        
              | "name" ->

     

       434
       426
        
                let* text = parse_text_content parser in

     

       435
       435
       -
                loop { track with name = Some text }

     

       427
       427
       +
                loop (Track.with_name track text)

     

       436
       428
        
              | "cmt" ->

     

       437
       429
        
                let* text = parse_text_content parser in

     

       438
       438
       -
                loop { track with cmt = Some text }

     

       430
       430
       +
                loop (Track.with_comment track text)

     

       439
       431
        
              | "desc" ->

     

       440
       432
        
                let* text = parse_text_content parser in

     

       441
       441
       -
                loop { track with desc = Some text }

     

       433
       433
       +
                loop (Track.with_description track text)

     

       442
       434
        
              | "src" ->

     

       443
       435
        
                let* text = parse_text_content parser in

     

       444
       444
       -
                loop { track with src = Some text }

     

       436
       436
       +
                loop (Track.with_source track text)

     

       445
       437
        
              | "number" ->

     

       446
       438
        
                let* text = parse_text_content parser in

     

       447
       439
        
                (match parse_int_opt text with

     

       448
       448
       -
                 | Some n -> loop { track with number = Some n }

     

       440
       440
       +
                 | Some n -> loop (Track.with_number track n)

     

       449
       441
        
                 | None -> loop track)

     

       450
       442
        
              | "type" ->

     

       451
       443
        
                let* text = parse_text_content parser in

     

       452
       452
       -
                loop { track with type_ = Some text }

     

       444
       444
       +
                loop (Track.with_type track text)

     

       453
       445
        
              | "trkseg" ->

     

       454
       446
        
                let* trkseg = parse_track_segment parser in

     

       455
       455
       -
                loop { track with trksegs = trkseg :: track.trksegs }

     

       447
       447
       +
                loop (Track.add_segment track trkseg)

     

       456
       448
        
              | "link" ->

     

       457
       449
        
                let* link = parse_link parser attrs in

     

       458
       458
       -
                loop { track with links = link :: track.links }

     

       450
       450
       +
                loop (Track.add_link track link)

     

       459
       451
        
              | "extensions" ->

     

       460
       452
        
                let* extensions = parse_extensions parser in

     

       461
       461
       -
                loop { track with extensions = extensions @ track.extensions }

     

       453
       453
       +
                loop (Track.add_extensions track extensions)

     

       462
       454
        
              | _ ->

     

       463
       455
        
                let* _ = skip_element parser in

     

       464
       456
        
                loop track)

     

       465
       457
        
           | `El_end ->

     

       466
       458
        
             parser.current_element <- List.tl parser.current_element;

     

       467
       467
       -
             Ok { track with

     

       468
       468
       -
                  trksegs = List.rev track.trksegs;

     

       469
       469
       -
                  links = List.rev track.links }

     

       459
       459
       +
             Ok track

     

       470
       460
        
           | `Data _ ->

     

       471
       461
        
             loop track

     

       472
       462
        
           | `Dtd _ ->

     
···

       475
       465
        
         loop track

     

       476
       466
        
       

     

       477
       467
        
       and parse_track_segment parser =

     

       478
       478
       -
         let trkseg = { trkpts = []; extensions = [] } in

     

       468
       468
       +
         let trkseg = Track.Segment.empty in

     

       479
       469
        
         let rec loop trkseg =

     

       480
       470
        
           match Xmlm.input parser.input with

     

       481
       471
        
           | `El_start ((_, name), attrs) ->

     
···

       484
       474
        
              | "trkpt" ->

     

       485
       475
        
                let* (lat, lon) = parse_coordinates attrs "trkpt" in

     

       486
       476
        
                let* trkpt = parse_waypoint_data parser lat lon in

     

       487
       487
       -
                loop { trkseg with trkpts = trkpt :: trkseg.trkpts }

     

       477
       477
       +
                loop (Track.Segment.add_point trkseg trkpt)

     

       488
       478
        
              | "extensions" ->

     

       489
       489
       -
                let* extensions = parse_extensions parser in

     

       490
       490
       -
                loop { trkseg with extensions = extensions @ trkseg.extensions }

     

       479
       479
       +
                let* _ = parse_extensions parser in

     

       480
       480
       +
                loop trkseg

     

       491
       481
        
              | _ ->

     

       492
       482
        
                let* _ = skip_element parser in

     

       493
       483
        
                loop trkseg)

     

       494
       484
        
           | `El_end ->

     

       495
       485
        
             parser.current_element <- List.tl parser.current_element;

     

       496
       496
       -
             Ok { trkseg with trkpts = List.rev trkseg.trkpts }

     

       486
       486
       +
             Ok trkseg

     

       497
       487
        
           | `Data _ ->

     

       498
       488
        
             loop trkseg

     

       499
       489
        
           | `Dtd _ ->

     
···

       515
       505
        
               let error_msgs = List.filter (fun issue -> issue.Validate.level = `Error) validation.issues

     

       516
       506
        
                               |> List.map (fun issue -> issue.Validate.message)

     

       517
       507
        
                               |> String.concat "; " in

     

       518
       518
       -
               Error (Validation_error error_msgs)

     

       508
       508
       +
               Error (Error.validation_error error_msgs)

     

       519
       509
        
           | result, false -> result

     

       520
       510
        
           | Error _ as result, true -> result (* Pass through parse errors even when validating *)

     

       521
       511
        
         with

     

       522
       512
        
         | Xmlm.Error ((line, col), error) ->

     

       523
       523
       -
           Error (Xml_error (Printf.sprintf "XML error at line %d, column %d: %s"

     

       524
       524
       -
                             line col (Xmlm.error_message error)))

     

       513
       513
       +
           Error (Error.xml_error (Printf.sprintf "XML error at line %d, column %d: %s"

     

       514
       514
       +
                            line col (Xmlm.error_message error)))

     

       525
       515
        
         | exn ->

     

       526
       526
       -
           Error (Invalid_xml (Printexc.to_string exn))

     

       516
       516
       +
           Error (Error.invalid_xml (Printexc.to_string exn))

     

       527
       517
        
       

     

       528
       518
        
       (** Parse from string *)

     

       529
       519
        
       let parse_string ?(validate=false) s =

     

       530
       520
        
         let input = Xmlm.make_input (`String (0, s)) in

     

       531
       531
       -
         parse ~validate input

     

       521
       521
       +
         parse ~validate input

+2 -4

lib/gpx/parser.mli

···

       1
       1
        
       (** GPX streaming parser using xmlm *)

     

       2
       2
        
       

     

       3
       3
       -
       open Types

     

       4
       4
       -
       

     

       5
       3
        
       (** Parse a GPX document from an xmlm input source *)

     

       6
       6
       -
       val parse : ?validate:bool -> Xmlm.input -> gpx result

     

       4
       4
       +
       val parse : ?validate:bool -> Xmlm.input -> (Gpx_doc.t, Error.t) result

     

       7
       5
        
       

     

       8
       6
        
       (** Parse a GPX document from a string *)

     

       9
       9
       -
       val parse_string : ?validate:bool -> string -> gpx result
     

       7
       7
       +
       val parse_string : ?validate:bool -> string -> (Gpx_doc.t, Error.t) result

+153

lib/gpx/route.ml

···

       1
       1
       +
       (** Route types and operations *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Route point is an alias for waypoint *)

     

       4
       4
       +
       type point = Waypoint.t

     

       5
       5
       +
       

     

       6
       6
       +
       (** Main route type *)

     

       7
       7
       +
       type t = {

     

       8
       8
       +
         name : string option;

     

       9
       9
       +
         cmt : string option;

     

       10
       10
       +
         desc : string option;

     

       11
       11
       +
         src : string option;

     

       12
       12
       +
         links : Link.t list;

     

       13
       13
       +
         number : int option;

     

       14
       14
       +
         type_ : string option;

     

       15
       15
       +
         extensions : Extension.t list;

     

       16
       16
       +
         rtepts : point list;

     

       17
       17
       +
       }

     

       18
       18
       +
       

     

       19
       19
       +
       (** {2 Route Operations} *)

     

       20
       20
       +
       

     

       21
       21
       +
       (** Create empty route *)

     

       22
       22
       +
       let empty = {

     

       23
       23
       +
         name = None; cmt = None; desc = None; src = None;

     

       24
       24
       +
         links = []; number = None; type_ = None; extensions = [];

     

       25
       25
       +
         rtepts = [];

     

       26
       26
       +
       }

     

       27
       27
       +
       

     

       28
       28
       +
       (** Create route with name *)

     

       29
       29
       +
       let make ~name = { empty with name = Some name }

     

       30
       30
       +
       

     

       31
       31
       +
       (** Create route from coordinate list *)

     

       32
       32
       +
       let make_from_coords ~name coords =

     

       33
       33
       +
         let make_rtept (lat_f, lon_f) =

     

       34
       34
       +
           match Waypoint.make_from_floats ~lat:lat_f ~lon:lon_f () with

     

       35
       35
       +
           | Ok wpt -> wpt

     

       36
       36
       +
           | Error e -> failwith e

     

       37
       37
       +
         in

     

       38
       38
       +
         let rtepts = List.map make_rtept coords in

     

       39
       39
       +
         { empty with name = Some name; rtepts }

     

       40
       40
       +
       

     

       41
       41
       +
       (** Get route name *)

     

       42
       42
       +
       let get_name t = t.name

     

       43
       43
       +
       

     

       44
       44
       +
       (** Get route description *)

     

       45
       45
       +
       let get_description t = t.desc

     

       46
       46
       +
       

     

       47
       47
       +
       (** Get route points *)

     

       48
       48
       +
       let get_points t = t.rtepts

     

       49
       49
       +
       

     

       50
       50
       +
       (** Get route point count *)

     

       51
       51
       +
       let point_count t = List.length t.rtepts

     

       52
       52
       +
       

     

       53
       53
       +
       (** Set name *)

     

       54
       54
       +
       let set_name name t = { t with name = Some name }

     

       55
       55
       +
       

     

       56
       56
       +
       (** Set description *)

     

       57
       57
       +
       let set_description desc t = { t with desc = Some desc }

     

       58
       58
       +
       

     

       59
       59
       +
       (** Clear all points *)

     

       60
       60
       +
       let clear_points t = { t with rtepts = [] }

     

       61
       61
       +
       

     

       62
       62
       +
       (** Extract coordinates from route *)

     

       63
       63
       +
       let to_coords t = List.map Waypoint.to_floats t.rtepts

     

       64
       64
       +
       

     

       65
       65
       +
       (** Simple great circle distance calculation *)

     

       66
       66
       +
       let great_circle_distance lat1 lon1 lat2 lon2 =

     

       67
       67
       +
         let deg_to_rad x = x *. Float.pi /. 180.0 in

     

       68
       68
       +
         let lat1_rad = deg_to_rad lat1 in

     

       69
       69
       +
         let lon1_rad = deg_to_rad lon1 in

     

       70
       70
       +
         let lat2_rad = deg_to_rad lat2 in

     

       71
       71
       +
         let lon2_rad = deg_to_rad lon2 in

     

       72
       72
       +
         let dlat = lat2_rad -. lat1_rad in

     

       73
       73
       +
         let dlon = lon2_rad -. lon1_rad in

     

       74
       74
       +
         let a = 

     

       75
       75
       +
           sin (dlat /. 2.0) ** 2.0 +. 

     

       76
       76
       +
           cos lat1_rad *. cos lat2_rad *. sin (dlon /. 2.0) ** 2.0 

     

       77
       77
       +
         in

     

       78
       78
       +
         let c = 2.0 *. asin (sqrt a) in

     

       79
       79
       +
         6371000.0 *. c (* Earth radius in meters *)

     

       80
       80
       +
       

     

       81
       81
       +
       (** Calculate total distance between consecutive points (naive great circle) *)

     

       82
       82
       +
       let total_distance t =

     

       83
       83
       +
         let rec calculate_distance acc = function

     

       84
       84
       +
           | [] | [_] -> acc

     

       85
       85
       +
           | p1 :: p2 :: rest ->

     

       86
       86
       +
             let lat1, lon1 = Waypoint.to_floats p1 in

     

       87
       87
       +
             let lat2, lon2 = Waypoint.to_floats p2 in

     

       88
       88
       +
             let distance = great_circle_distance lat1 lon1 lat2 lon2 in

     

       89
       89
       +
             calculate_distance (acc +. distance) (p2 :: rest)

     

       90
       90
       +
         in

     

       91
       91
       +
         calculate_distance 0.0 t.rtepts

     

       92
       92
       +
       

     

       93
       93
       +
       (** Check if route is empty *)

     

       94
       94
       +
       let is_empty t = List.length t.rtepts = 0

     

       95
       95
       +
       

     

       96
       96
       +
       (** Get first point *)

     

       97
       97
       +
       let first_point t = 

     

       98
       98
       +
         match t.rtepts with

     

       99
       99
       +
         | [] -> None

     

       100
       100
       +
         | p :: _ -> Some p

     

       101
       101
       +
       

     

       102
       102
       +
       (** Get last point *)

     

       103
       103
       +
       let last_point t =

     

       104
       104
       +
         match List.rev t.rtepts with

     

       105
       105
       +
         | [] -> None

     

       106
       106
       +
         | p :: _ -> Some p

     

       107
       107
       +
       

     

       108
       108
       +
       (** {2 Functional Setters} *)

     

       109
       109
       +
       

     

       110
       110
       +
       (** Set name *)

     

       111
       111
       +
       let with_name t name = { t with name = Some name }

     

       112
       112
       +
       

     

       113
       113
       +
       (** Set comment *)

     

       114
       114
       +
       let with_comment t cmt = { t with cmt = Some cmt }

     

       115
       115
       +
       

     

       116
       116
       +
       (** Set description *)

     

       117
       117
       +
       let with_description t desc = { t with desc = Some desc }

     

       118
       118
       +
       

     

       119
       119
       +
       (** Set source *)

     

       120
       120
       +
       let with_source t src = { t with src = Some src }

     

       121
       121
       +
       

     

       122
       122
       +
       (** Set number *)

     

       123
       123
       +
       let with_number t number = { t with number = Some number }

     

       124
       124
       +
       

     

       125
       125
       +
       (** Set type *)

     

       126
       126
       +
       let with_type t type_ = { t with type_ = Some type_ }

     

       127
       127
       +
       

     

       128
       128
       +
       (** Add point *)

     

       129
       129
       +
       let add_point t rtept = { t with rtepts = t.rtepts @ [rtept] }

     

       130
       130
       +
       

     

       131
       131
       +
       (** Add link *)

     

       132
       132
       +
       let add_link t link = { t with links = t.links @ [link] }

     

       133
       133
       +
       

     

       134
       134
       +
       (** Add extensions *)

     

       135
       135
       +
       let add_extensions t extensions = { t with extensions = t.extensions @ extensions }

     

       136
       136
       +
       

     

       137
       137
       +
       (** Compare routes *)

     

       138
       138
       +
       let compare t1 t2 =

     

       139
       139
       +
         let name_cmp = Option.compare String.compare t1.name t2.name in

     

       140
       140
       +
         if name_cmp <> 0 then name_cmp

     

       141
       141
       +
         else

     

       142
       142
       +
           let desc_cmp = Option.compare String.compare t1.desc t2.desc in

     

       143
       143
       +
           if desc_cmp <> 0 then desc_cmp

     

       144
       144
       +
           else List.compare Waypoint.compare t1.rtepts t2.rtepts

     

       145
       145
       +
       

     

       146
       146
       +
       (** Test route equality *)

     

       147
       147
       +
       let equal t1 t2 = compare t1 t2 = 0

     

       148
       148
       +
       

     

       149
       149
       +
       (** Pretty print route *)

     

       150
       150
       +
       let pp ppf t =

     

       151
       151
       +
         match t.name with

     

       152
       152
       +
         | Some name -> Format.fprintf ppf "\"%s\" (%d points)" name (point_count t)

     

       153
       153
       +
         | None -> Format.fprintf ppf "(unnamed route, %d points)" (point_count t)

+113

lib/gpx/route.mli

···

       1
       1
       +
       (** Route types and operations *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Route point is an alias for waypoint *)

     

       4
       4
       +
       type point = Waypoint.t

     

       5
       5
       +
       

     

       6
       6
       +
       (** Main route type *)

     

       7
       7
       +
       type t = {

     

       8
       8
       +
         name : string option;

     

       9
       9
       +
         cmt : string option;

     

       10
       10
       +
         desc : string option;

     

       11
       11
       +
         src : string option;

     

       12
       12
       +
         links : Link.t list;

     

       13
       13
       +
         number : int option;

     

       14
       14
       +
         type_ : string option;

     

       15
       15
       +
         extensions : Extension.t list;

     

       16
       16
       +
         rtepts : point list;

     

       17
       17
       +
       }

     

       18
       18
       +
       

     

       19
       19
       +
       (** {2 Route Constructors} *)

     

       20
       20
       +
       

     

       21
       21
       +
       (** Create empty route *)

     

       22
       22
       +
       val empty : t

     

       23
       23
       +
       

     

       24
       24
       +
       (** Create route with name *)

     

       25
       25
       +
       val make : name:string -> t

     

       26
       26
       +
       

     

       27
       27
       +
       (** Create route from coordinate list.

     

       28
       28
       +
           @param name Route name

     

       29
       29
       +
           @param coords List of (latitude, longitude) pairs

     

       30
       30
       +
           @raises Failure on invalid coordinates *)

     

       31
       31
       +
       val make_from_coords : name:string -> (float * float) list -> t

     

       32
       32
       +
       

     

       33
       33
       +
       (** {2 Route Properties} *)

     

       34
       34
       +
       

     

       35
       35
       +
       (** Get route name *)

     

       36
       36
       +
       val get_name : t -> string option

     

       37
       37
       +
       

     

       38
       38
       +
       (** Get route description *)

     

       39
       39
       +
       val get_description : t -> string option

     

       40
       40
       +
       

     

       41
       41
       +
       (** Get route points *)

     

       42
       42
       +
       val get_points : t -> point list

     

       43
       43
       +
       

     

       44
       44
       +
       (** Get route point count *)

     

       45
       45
       +
       val point_count : t -> int

     

       46
       46
       +
       

     

       47
       47
       +
       (** Check if route is empty *)

     

       48
       48
       +
       val is_empty : t -> bool

     

       49
       49
       +
       

     

       50
       50
       +
       (** {2 Route Modification} *)

     

       51
       51
       +
       

     

       52
       52
       +
       (** Set name *)

     

       53
       53
       +
       val set_name : string -> t -> t

     

       54
       54
       +
       

     

       55
       55
       +
       (** Set description *)

     

       56
       56
       +
       val set_description : string -> t -> t

     

       57
       57
       +
       

     

       58
       58
       +
       (** Clear all points *)

     

       59
       59
       +
       val clear_points : t -> t

     

       60
       60
       +
       

     

       61
       61
       +
       (** {2 Route Analysis} *)

     

       62
       62
       +
       

     

       63
       63
       +
       (** Extract coordinates from route *)

     

       64
       64
       +
       val to_coords : t -> (float * float) list

     

       65
       65
       +
       

     

       66
       66
       +
       (** Calculate total distance between consecutive points in meters *)

     

       67
       67
       +
       val total_distance : t -> float

     

       68
       68
       +
       

     

       69
       69
       +
       (** Get first point *)

     

       70
       70
       +
       val first_point : t -> point option

     

       71
       71
       +
       

     

       72
       72
       +
       (** Get last point *)

     

       73
       73
       +
       val last_point : t -> point option

     

       74
       74
       +
       

     

       75
       75
       +
       (** {2 Functional Setters} *)

     

       76
       76
       +
       

     

       77
       77
       +
       (** Set name *)

     

       78
       78
       +
       val with_name : t -> string -> t

     

       79
       79
       +
       

     

       80
       80
       +
       (** Set comment *)

     

       81
       81
       +
       val with_comment : t -> string -> t  

     

       82
       82
       +
       

     

       83
       83
       +
       (** Set description *)

     

       84
       84
       +
       val with_description : t -> string -> t

     

       85
       85
       +
       

     

       86
       86
       +
       (** Set source *)

     

       87
       87
       +
       val with_source : t -> string -> t

     

       88
       88
       +
       

     

       89
       89
       +
       (** Set number *)

     

       90
       90
       +
       val with_number : t -> int -> t

     

       91
       91
       +
       

     

       92
       92
       +
       (** Set type *)

     

       93
       93
       +
       val with_type : t -> string -> t

     

       94
       94
       +
       

     

       95
       95
       +
       (** Add point *)

     

       96
       96
       +
       val add_point : t -> point -> t

     

       97
       97
       +
       

     

       98
       98
       +
       (** Add link *)

     

       99
       99
       +
       val add_link : t -> Link.t -> t

     

       100
       100
       +
       

     

       101
       101
       +
       (** Add extensions *)

     

       102
       102
       +
       val add_extensions : t -> Extension.t list -> t

     

       103
       103
       +
       

     

       104
       104
       +
       (** {2 Comparison and Utilities} *)

     

       105
       105
       +
       

     

       106
       106
       +
       (** Compare routes *)

     

       107
       107
       +
       val compare : t -> t -> int

     

       108
       108
       +
       

     

       109
       109
       +
       (** Test route equality *)

     

       110
       110
       +
       val equal : t -> t -> bool

     

       111
       111
       +
       

     

       112
       112
       +
       (** Pretty print route *)

     

       113
       113
       +
       val pp : Format.formatter -> t -> unit

+210

lib/gpx/track.ml

···

       1
       1
       +
       (** Track types and operations *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Track point is an alias for waypoint *)

     

       4
       4
       +
       type point = Waypoint.t

     

       5
       5
       +
       

     

       6
       6
       +
       (** Track segment *)

     

       7
       7
       +
       type segment = {

     

       8
       8
       +
         trkpts : point list;

     

       9
       9
       +
         extensions : Extension.t list;

     

       10
       10
       +
       }

     

       11
       11
       +
       

     

       12
       12
       +
       (** Main track type *)

     

       13
       13
       +
       type t = {

     

       14
       14
       +
         name : string option;

     

       15
       15
       +
         cmt : string option;

     

       16
       16
       +
         desc : string option;

     

       17
       17
       +
         src : string option;

     

       18
       18
       +
         links : Link.t list;

     

       19
       19
       +
         number : int option;

     

       20
       20
       +
         type_ : string option;

     

       21
       21
       +
         extensions : Extension.t list;

     

       22
       22
       +
         trksegs : segment list;

     

       23
       23
       +
       }

     

       24
       24
       +
       

     

       25
       25
       +
       (** {2 Track Segment Operations} *)

     

       26
       26
       +
       

     

       27
       27
       +
       module Segment = struct

     

       28
       28
       +
         type t = segment

     

       29
       29
       +
       

     

       30
       30
       +
         (** Create empty segment *)

     

       31
       31
       +
         let empty = { trkpts = []; extensions = [] }

     

       32
       32
       +
       

     

       33
       33
       +
         (** Create segment with points *)

     

       34
       34
       +
         let make points = { trkpts = points; extensions = [] }

     

       35
       35
       +
       

     

       36
       36
       +
         (** Create segment from coordinates *)

     

       37
       37
       +
         let make_from_coords coords =

     

       38
       38
       +
           let make_trkpt (lat_f, lon_f) =

     

       39
       39
       +
             match Waypoint.make_from_floats ~lat:lat_f ~lon:lon_f () with

     

       40
       40
       +
             | Ok wpt -> wpt

     

       41
       41
       +
             | Error e -> failwith e

     

       42
       42
       +
           in

     

       43
       43
       +
           let trkpts = List.map make_trkpt coords in

     

       44
       44
       +
           { trkpts; extensions = [] }

     

       45
       45
       +
       

     

       46
       46
       +
         (** Get points *)

     

       47
       47
       +
         let get_points t = t.trkpts

     

       48
       48
       +
       

     

       49
       49
       +
         (** Get point count *)

     

       50
       50
       +
         let point_count t = List.length t.trkpts

     

       51
       51
       +
       

     

       52
       52
       +
         (** Add point *)

     

       53
       53
       +
         let add_point t point = { t with trkpts = t.trkpts @ [point] }

     

       54
       54
       +
       

     

       55
       55
       +
         (** Add points *)

     

       56
       56
       +
         let add_points t points = { t with trkpts = t.trkpts @ points }

     

       57
       57
       +
       

     

       58
       58
       +
         (** Extract coordinates *)

     

       59
       59
       +
         let to_coords t = List.map Waypoint.to_floats t.trkpts

     

       60
       60
       +
       

     

       61
       61
       +
         (** Calculate segment distance *)

     

       62
       62
       +
         let distance t = Route.total_distance { Route.empty with rtepts = t.trkpts }

     

       63
       63
       +
       

     

       64
       64
       +
         (** Check if empty *)

     

       65
       65
       +
         let is_empty t = List.length t.trkpts = 0

     

       66
       66
       +
       

     

       67
       67
       +
         (** First point *)

     

       68
       68
       +
         let first_point t = 

     

       69
       69
       +
           match t.trkpts with

     

       70
       70
       +
           | [] -> None

     

       71
       71
       +
           | p :: _ -> Some p

     

       72
       72
       +
       

     

       73
       73
       +
         (** Last point *)

     

       74
       74
       +
         let last_point t =

     

       75
       75
       +
           match List.rev t.trkpts with

     

       76
       76
       +
           | [] -> None

     

       77
       77
       +
           | p :: _ -> Some p

     

       78
       78
       +
       

     

       79
       79
       +
         (** Compare segments *)

     

       80
       80
       +
         let compare t1 t2 = List.compare Waypoint.compare t1.trkpts t2.trkpts

     

       81
       81
       +
       

     

       82
       82
       +
         (** Test segment equality *)

     

       83
       83
       +
         let equal t1 t2 = compare t1 t2 = 0

     

       84
       84
       +
       

     

       85
       85
       +
         (** Pretty print segment *)

     

       86
       86
       +
         let pp ppf t = Format.fprintf ppf "segment (%d points)" (point_count t)

     

       87
       87
       +
       end

     

       88
       88
       +
       

     

       89
       89
       +
       (** {2 Track Operations} *)

     

       90
       90
       +
       

     

       91
       91
       +
       (** Create empty track *)

     

       92
       92
       +
       let empty = {

     

       93
       93
       +
         name = None; cmt = None; desc = None; src = None;

     

       94
       94
       +
         links = []; number = None; type_ = None; extensions = [];

     

       95
       95
       +
         trksegs = [];

     

       96
       96
       +
       }

     

       97
       97
       +
       

     

       98
       98
       +
       (** Create track with name *)

     

       99
       99
       +
       let make ~name = { empty with name = Some name }

     

       100
       100
       +
       

     

       101
       101
       +
       (** Create track from coordinate list (single segment) *)

     

       102
       102
       +
       let make_from_coords ~name coords =

     

       103
       103
       +
         let segment = Segment.make_from_coords coords in

     

       104
       104
       +
         { empty with name = Some name; trksegs = [segment] }

     

       105
       105
       +
       

     

       106
       106
       +
       (** Get track name *)

     

       107
       107
       +
       let get_name t = t.name

     

       108
       108
       +
       

     

       109
       109
       +
       (** Get track description *)

     

       110
       110
       +
       let get_description t = t.desc

     

       111
       111
       +
       

     

       112
       112
       +
       (** Get track segments *)

     

       113
       113
       +
       let get_segments t = t.trksegs

     

       114
       114
       +
       

     

       115
       115
       +
       (** Get segment count *)

     

       116
       116
       +
       let segment_count t = List.length t.trksegs

     

       117
       117
       +
       

     

       118
       118
       +
       (** Get total point count across all segments *)

     

       119
       119
       +
       let point_count t = 

     

       120
       120
       +
         List.fold_left (fun acc seg -> acc + Segment.point_count seg) 0 t.trksegs

     

       121
       121
       +
       

     

       122
       122
       +
       (** Set name *)

     

       123
       123
       +
       let set_name name t = { t with name = Some name }

     

       124
       124
       +
       

     

       125
       125
       +
       (** Set description *)

     

       126
       126
       +
       let set_description desc t = { t with desc = Some desc }

     

       127
       127
       +
       

     

       128
       128
       +
       (** Clear all segments *)

     

       129
       129
       +
       let clear_segments t = { t with trksegs = [] }

     

       130
       130
       +
       

     

       131
       131
       +
       (** Extract all coordinates from track *)

     

       132
       132
       +
       let to_coords t =

     

       133
       133
       +
         List.fold_left (fun acc seg ->

     

       134
       134
       +
           List.fold_left (fun acc trkpt ->

     

       135
       135
       +
             Waypoint.to_floats trkpt :: acc

     

       136
       136
       +
           ) acc seg.trkpts

     

       137
       137
       +
         ) [] t.trksegs

     

       138
       138
       +
         |> List.rev

     

       139
       139
       +
       

     

       140
       140
       +
       (** Calculate total track distance across all segments *)

     

       141
       141
       +
       let total_distance t =

     

       142
       142
       +
         List.fold_left (fun acc seg -> acc +. Segment.distance seg) 0.0 t.trksegs

     

       143
       143
       +
       

     

       144
       144
       +
       (** Check if track is empty *)

     

       145
       145
       +
       let is_empty t = List.length t.trksegs = 0

     

       146
       146
       +
       

     

       147
       147
       +
       (** Get all points from all segments *)

     

       148
       148
       +
       let all_points t =

     

       149
       149
       +
         List.fold_left (fun acc seg -> acc @ seg.trkpts) [] t.trksegs

     

       150
       150
       +
       

     

       151
       151
       +
       (** Get first point from first segment *)

     

       152
       152
       +
       let first_point t =

     

       153
       153
       +
         match t.trksegs with

     

       154
       154
       +
         | [] -> None

     

       155
       155
       +
         | seg :: _ -> Segment.first_point seg

     

       156
       156
       +
       

     

       157
       157
       +
       (** Get last point from last segment *)

     

       158
       158
       +
       let last_point t =

     

       159
       159
       +
         match List.rev t.trksegs with

     

       160
       160
       +
         | [] -> None

     

       161
       161
       +
         | seg :: _ -> Segment.last_point seg

     

       162
       162
       +
       

     

       163
       163
       +
       (** Compare tracks *)

     

       164
       164
       +
       let compare t1 t2 =

     

       165
       165
       +
         let name_cmp = Option.compare String.compare t1.name t2.name in

     

       166
       166
       +
         if name_cmp <> 0 then name_cmp

     

       167
       167
       +
         else

     

       168
       168
       +
           let desc_cmp = Option.compare String.compare t1.desc t2.desc in

     

       169
       169
       +
           if desc_cmp <> 0 then desc_cmp

     

       170
       170
       +
           else List.compare Segment.compare t1.trksegs t2.trksegs

     

       171
       171
       +
       

     

       172
       172
       +
       (** Test track equality *)

     

       173
       173
       +
       let equal t1 t2 = compare t1 t2 = 0

     

       174
       174
       +
       

     

       175
       175
       +
       (** {2 Functional Setters} *)

     

       176
       176
       +
       

     

       177
       177
       +
       (** Set name *)

     

       178
       178
       +
       let with_name t name = { t with name = Some name }

     

       179
       179
       +
       

     

       180
       180
       +
       (** Set comment *)

     

       181
       181
       +
       let with_comment t cmt = { t with cmt = Some cmt }

     

       182
       182
       +
       

     

       183
       183
       +
       (** Set description *)

     

       184
       184
       +
       let with_description t desc = { t with desc = Some desc }

     

       185
       185
       +
       

     

       186
       186
       +
       (** Set source *)

     

       187
       187
       +
       let with_source t src = { t with src = Some src }

     

       188
       188
       +
       

     

       189
       189
       +
       (** Set number *)

     

       190
       190
       +
       let with_number t number = { t with number = Some number }

     

       191
       191
       +
       

     

       192
       192
       +
       (** Set type *)

     

       193
       193
       +
       let with_type t type_ = { t with type_ = Some type_ }

     

       194
       194
       +
       

     

       195
       195
       +
       (** Add segment *)

     

       196
       196
       +
       let add_segment t trkseg = { t with trksegs = t.trksegs @ [trkseg] }

     

       197
       197
       +
       

     

       198
       198
       +
       (** Add link *)

     

       199
       199
       +
       let add_link t link = { t with links = t.links @ [link] }

     

       200
       200
       +
       

     

       201
       201
       +
       (** Add extensions *)

     

       202
       202
       +
       let add_extensions t extensions = { t with extensions = t.extensions @ extensions }

     

       203
       203
       +
       

     

       204
       204
       +
       (** Pretty print track *)

     

       205
       205
       +
       let pp ppf t =

     

       206
       206
       +
         match t.name with

     

       207
       207
       +
         | Some name -> Format.fprintf ppf "\"%s\" (%d segments, %d points)" 

     

       208
       208
       +
                          name (segment_count t) (point_count t)

     

       209
       209
       +
         | None -> Format.fprintf ppf "(unnamed track, %d segments, %d points)" 

     

       210
       210
       +
                     (segment_count t) (point_count t)

+177

lib/gpx/track.mli

···

       1
       1
       +
       (** Track types and operations *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Track point is an alias for waypoint *)

     

       4
       4
       +
       type point = Waypoint.t

     

       5
       5
       +
       

     

       6
       6
       +
       (** Track segment *)

     

       7
       7
       +
       type segment = {

     

       8
       8
       +
         trkpts : point list;

     

       9
       9
       +
         extensions : Extension.t list;

     

       10
       10
       +
       }

     

       11
       11
       +
       

     

       12
       12
       +
       (** Main track type *)

     

       13
       13
       +
       type t = {

     

       14
       14
       +
         name : string option;

     

       15
       15
       +
         cmt : string option;

     

       16
       16
       +
         desc : string option;

     

       17
       17
       +
         src : string option;

     

       18
       18
       +
         links : Link.t list;

     

       19
       19
       +
         number : int option;

     

       20
       20
       +
         type_ : string option;

     

       21
       21
       +
         extensions : Extension.t list;

     

       22
       22
       +
         trksegs : segment list;

     

       23
       23
       +
       }

     

       24
       24
       +
       

     

       25
       25
       +
       (** {2 Track Segment Operations} *)

     

       26
       26
       +
       

     

       27
       27
       +
       module Segment : sig

     

       28
       28
       +
         type t = segment

     

       29
       29
       +
       

     

       30
       30
       +
         (** Create empty segment *)

     

       31
       31
       +
         val empty : t

     

       32
       32
       +
       

     

       33
       33
       +
         (** Create segment with points *)

     

       34
       34
       +
         val make : point list -> t

     

       35
       35
       +
       

     

       36
       36
       +
         (** Create segment from coordinate list.

     

       37
       37
       +
             @raises Failure on invalid coordinates *)

     

       38
       38
       +
         val make_from_coords : (float * float) list -> t

     

       39
       39
       +
       

     

       40
       40
       +
         (** Get points *)

     

       41
       41
       +
         val get_points : t -> point list

     

       42
       42
       +
       

     

       43
       43
       +
         (** Get point count *)

     

       44
       44
       +
         val point_count : t -> int

     

       45
       45
       +
       

     

       46
       46
       +
         (** Add point *)

     

       47
       47
       +
         val add_point : t -> point -> t

     

       48
       48
       +
       

     

       49
       49
       +
         (** Add points *)

     

       50
       50
       +
         val add_points : t -> point list -> t

     

       51
       51
       +
       

     

       52
       52
       +
         (** Extract coordinates *)

     

       53
       53
       +
         val to_coords : t -> (float * float) list

     

       54
       54
       +
       

     

       55
       55
       +
         (** Calculate segment distance in meters *)

     

       56
       56
       +
         val distance : t -> float

     

       57
       57
       +
       

     

       58
       58
       +
         (** Check if empty *)

     

       59
       59
       +
         val is_empty : t -> bool

     

       60
       60
       +
       

     

       61
       61
       +
         (** First point *)

     

       62
       62
       +
         val first_point : t -> point option

     

       63
       63
       +
       

     

       64
       64
       +
         (** Last point *)

     

       65
       65
       +
         val last_point : t -> point option

     

       66
       66
       +
       

     

       67
       67
       +
         (** Compare segments *)

     

       68
       68
       +
         val compare : t -> t -> int

     

       69
       69
       +
       

     

       70
       70
       +
         (** Test segment equality *)

     

       71
       71
       +
         val equal : t -> t -> bool

     

       72
       72
       +
       

     

       73
       73
       +
         (** Pretty print segment *)

     

       74
       74
       +
         val pp : Format.formatter -> t -> unit

     

       75
       75
       +
       end

     

       76
       76
       +
       

     

       77
       77
       +
       (** {2 Track Constructors} *)

     

       78
       78
       +
       

     

       79
       79
       +
       (** Create empty track *)

     

       80
       80
       +
       val empty : t

     

       81
       81
       +
       

     

       82
       82
       +
       (** Create track with name *)

     

       83
       83
       +
       val make : name:string -> t

     

       84
       84
       +
       

     

       85
       85
       +
       (** Create track from coordinate list (single segment).

     

       86
       86
       +
           @param name Track name

     

       87
       87
       +
           @param coords List of (latitude, longitude) pairs

     

       88
       88
       +
           @raises Failure on invalid coordinates *)

     

       89
       89
       +
       val make_from_coords : name:string -> (float * float) list -> t

     

       90
       90
       +
       

     

       91
       91
       +
       (** {2 Track Properties} *)

     

       92
       92
       +
       

     

       93
       93
       +
       (** Get track name *)

     

       94
       94
       +
       val get_name : t -> string option

     

       95
       95
       +
       

     

       96
       96
       +
       (** Get track description *)

     

       97
       97
       +
       val get_description : t -> string option

     

       98
       98
       +
       

     

       99
       99
       +
       (** Get track segments *)

     

       100
       100
       +
       val get_segments : t -> segment list

     

       101
       101
       +
       

     

       102
       102
       +
       (** Get segment count *)

     

       103
       103
       +
       val segment_count : t -> int

     

       104
       104
       +
       

     

       105
       105
       +
       (** Get total point count across all segments *)

     

       106
       106
       +
       val point_count : t -> int

     

       107
       107
       +
       

     

       108
       108
       +
       (** Check if track is empty *)

     

       109
       109
       +
       val is_empty : t -> bool

     

       110
       110
       +
       

     

       111
       111
       +
       (** {2 Track Modification} *)

     

       112
       112
       +
       

     

       113
       113
       +
       (** Set name *)

     

       114
       114
       +
       val set_name : string -> t -> t

     

       115
       115
       +
       

     

       116
       116
       +
       (** Set description *)

     

       117
       117
       +
       val set_description : string -> t -> t

     

       118
       118
       +
       

     

       119
       119
       +
       (** Clear all segments *)

     

       120
       120
       +
       val clear_segments : t -> t

     

       121
       121
       +
       

     

       122
       122
       +
       (** {2 Track Analysis} *)

     

       123
       123
       +
       

     

       124
       124
       +
       (** Extract all coordinates from track *)

     

       125
       125
       +
       val to_coords : t -> (float * float) list

     

       126
       126
       +
       

     

       127
       127
       +
       (** Calculate total track distance across all segments in meters *)

     

       128
       128
       +
       val total_distance : t -> float

     

       129
       129
       +
       

     

       130
       130
       +
       (** Get all points from all segments *)

     

       131
       131
       +
       val all_points : t -> point list

     

       132
       132
       +
       

     

       133
       133
       +
       (** Get first point from first segment *)

     

       134
       134
       +
       val first_point : t -> point option

     

       135
       135
       +
       

     

       136
       136
       +
       (** Get last point from last segment *)

     

       137
       137
       +
       val last_point : t -> point option

     

       138
       138
       +
       

     

       139
       139
       +
       (** {2 Comparison and Utilities} *)

     

       140
       140
       +
       

     

       141
       141
       +
       (** Compare tracks *)

     

       142
       142
       +
       val compare : t -> t -> int

     

       143
       143
       +
       

     

       144
       144
       +
       (** Test track equality *)

     

       145
       145
       +
       val equal : t -> t -> bool

     

       146
       146
       +
       

     

       147
       147
       +
       (** {2 Functional Setters} *)

     

       148
       148
       +
       

     

       149
       149
       +
       (** Set name *)

     

       150
       150
       +
       val with_name : t -> string -> t

     

       151
       151
       +
       

     

       152
       152
       +
       (** Set comment *)

     

       153
       153
       +
       val with_comment : t -> string -> t

     

       154
       154
       +
       

     

       155
       155
       +
       (** Set description *)

     

       156
       156
       +
       val with_description : t -> string -> t

     

       157
       157
       +
       

     

       158
       158
       +
       (** Set source *)

     

       159
       159
       +
       val with_source : t -> string -> t

     

       160
       160
       +
       

     

       161
       161
       +
       (** Set number *)

     

       162
       162
       +
       val with_number : t -> int -> t

     

       163
       163
       +
       

     

       164
       164
       +
       (** Set type *)

     

       165
       165
       +
       val with_type : t -> string -> t

     

       166
       166
       +
       

     

       167
       167
       +
       (** Add segment *)

     

       168
       168
       +
       val add_segment : t -> Segment.t -> t

     

       169
       169
       +
       

     

       170
       170
       +
       (** Add link *)

     

       171
       171
       +
       val add_link : t -> Link.t -> t

     

       172
       172
       +
       

     

       173
       173
       +
       (** Add extensions *)

     

       174
       174
       +
       val add_extensions : t -> Extension.t list -> t

     

       175
       175
       +
       

     

       176
       176
       +
       (** Pretty print track *)

     

       177
       177
       +
       val pp : Format.formatter -> t -> unit

-228

lib/gpx/types.ml

···

       1
       1
       -
       (** Core GPX types matching the GPX 1.1 XSD schema *)

     

       2
       2
       -
       

     

       3
       3
       -
       [@@@warning "-30"]

     

       4
       4
       -
       

     

       5
       5
       -
       (** Geographic coordinates with validation constraints *)

     

       6
       6
       -
       type latitude = private float

     

       7
       7
       -
       type longitude = private float  

     

       8
       8
       -
       type degrees = private float

     

       9
       9
       -
       

     

       10
       10
       -
       (** Smart constructors for validated coordinates *)

     

       11
       11
       -
       let latitude f =

     

       12
       12
       -
         if f >= -90.0 && f <= 90.0 then Ok (Obj.magic f : latitude)

     

       13
       13
       -
         else Error (Printf.sprintf "Invalid latitude: %f (must be between -90.0 and 90.0)" f)

     

       14
       14
       -
       

     

       15
       15
       -
       let longitude f =

     

       16
       16
       -
         if f >= -180.0 && f < 180.0 then Ok (Obj.magic f : longitude)

     

       17
       17
       -
         else Error (Printf.sprintf "Invalid longitude: %f (must be between -180.0 and 180.0)" f)

     

       18
       18
       -
       

     

       19
       19
       -
       let degrees f =

     

       20
       20
       -
         if f >= 0.0 && f < 360.0 then Ok (Obj.magic f : degrees)

     

       21
       21
       -
         else Error (Printf.sprintf "Invalid degrees: %f (must be between 0.0 and 360.0)" f)

     

       22
       22
       -
       

     

       23
       23
       -
       (** Convert back to float *)

     

       24
       24
       -
       let latitude_to_float (lat : latitude) = (lat :> float)

     

       25
       25
       -
       let longitude_to_float (lon : longitude) = (lon :> float)

     

       26
       26
       -
       let degrees_to_float (deg : degrees) = (deg :> float)

     

       27
       27
       -
       

     

       28
       28
       -
       (** GPS fix types as defined in GPX spec *)

     

       29
       29
       -
       type fix_type = 

     

       30
       30
       -
         | None_fix

     

       31
       31
       -
         | Fix_2d

     

       32
       32
       -
         | Fix_3d

     

       33
       33
       -
         | Dgps

     

       34
       34
       -
         | Pps

     

       35
       35
       -
       

     

       36
       36
       -
       (** Person information *)

     

       37
       37
       -
       type person = {

     

       38
       38
       -
         name : string option;

     

       39
       39
       -
         email : string option;

     

       40
       40
       -
         link : link option;

     

       41
       41
       -
       }

     

       42
       42
       -
       

     

       43
       43
       -
       (** Link information *)

     

       44
       44
       -
       and link = {

     

       45
       45
       -
         href : string;

     

       46
       46
       -
         text : string option;

     

       47
       47
       -
         type_ : string option;

     

       48
       48
       -
       }

     

       49
       49
       -
       

     

       50
       50
       -
       (** Copyright information *)

     

       51
       51
       -
       type copyright = {

     

       52
       52
       -
         author : string;

     

       53
       53
       -
         year : int option;

     

       54
       54
       -
         license : string option;

     

       55
       55
       -
       }

     

       56
       56
       -
       

     

       57
       57
       -
       (** Bounding box *)

     

       58
       58
       -
       type bounds = {

     

       59
       59
       -
         minlat : latitude;

     

       60
       60
       -
         minlon : longitude;

     

       61
       61
       -
         maxlat : latitude;

     

       62
       62
       -
         maxlon : longitude;

     

       63
       63
       -
       }

     

       64
       64
       -
       

     

       65
       65
       -
       (** Metadata container *)

     

       66
       66
       -
       type metadata = {

     

       67
       67
       -
         name : string option;

     

       68
       68
       -
         desc : string option;

     

       69
       69
       -
         author : person option;

     

       70
       70
       -
         copyright : copyright option;

     

       71
       71
       -
         links : link list;

     

       72
       72
       -
         time : Ptime.t option;

     

       73
       73
       -
         keywords : string option;

     

       74
       74
       -
         bounds : bounds option;

     

       75
       75
       -
         extensions : extension list;

     

       76
       76
       -
       }

     

       77
       77
       -
       

     

       78
       78
       -
       (** Extension mechanism for custom elements *)

     

       79
       79
       -
       and extension = {

     

       80
       80
       -
         namespace : string option;

     

       81
       81
       -
         name : string;

     

       82
       82
       -
         attributes : (string * string) list;

     

       83
       83
       -
         content : extension_content;

     

       84
       84
       -
       }

     

       85
       85
       -
       

     

       86
       86
       -
       and extension_content =

     

       87
       87
       -
         | Text of string

     

       88
       88
       -
         | Elements of extension list

     

       89
       89
       -
         | Mixed of string * extension list

     

       90
       90
       -
       

     

       91
       91
       -
       (** Base waypoint data shared by wpt, rtept, trkpt *)

     

       92
       92
       -
       type waypoint_data = {

     

       93
       93
       -
         lat : latitude;

     

       94
       94
       -
         lon : longitude;

     

       95
       95
       -
         ele : float option;

     

       96
       96
       -
         time : Ptime.t option;

     

       97
       97
       -
         magvar : degrees option;

     

       98
       98
       -
         geoidheight : float option;

     

       99
       99
       -
         name : string option;

     

       100
       100
       -
         cmt : string option;

     

       101
       101
       -
         desc : string option;

     

       102
       102
       -
         src : string option;

     

       103
       103
       -
         links : link list;

     

       104
       104
       -
         sym : string option;

     

       105
       105
       -
         type_ : string option;

     

       106
       106
       -
         fix : fix_type option;

     

       107
       107
       -
         sat : int option;

     

       108
       108
       -
         hdop : float option;

     

       109
       109
       -
         vdop : float option;

     

       110
       110
       -
         pdop : float option;

     

       111
       111
       -
         ageofdgpsdata : float option;

     

       112
       112
       -
         dgpsid : int option;

     

       113
       113
       -
         extensions : extension list;

     

       114
       114
       -
       }

     

       115
       115
       -
       

     

       116
       116
       -
       (** Waypoint *)

     

       117
       117
       -
       type waypoint = waypoint_data

     

       118
       118
       -
       

     

       119
       119
       -
       (** Route point *)

     

       120
       120
       -
       type route_point = waypoint_data

     

       121
       121
       -
       

     

       122
       122
       -
       (** Track point *)

     

       123
       123
       -
       type track_point = waypoint_data

     

       124
       124
       -
       

     

       125
       125
       -
       (** Route definition *)

     

       126
       126
       -
       type route = {

     

       127
       127
       -
         name : string option;

     

       128
       128
       -
         cmt : string option;

     

       129
       129
       -
         desc : string option;

     

       130
       130
       -
         src : string option;

     

       131
       131
       -
         links : link list;

     

       132
       132
       -
         number : int option;

     

       133
       133
       -
         type_ : string option;

     

       134
       134
       -
         extensions : extension list;

     

       135
       135
       -
         rtepts : route_point list;

     

       136
       136
       -
       }

     

       137
       137
       -
       

     

       138
       138
       -
       (** Track segment *)

     

       139
       139
       -
       type track_segment = {

     

       140
       140
       -
         trkpts : track_point list;

     

       141
       141
       -
         extensions : extension list;

     

       142
       142
       -
       }

     

       143
       143
       -
       

     

       144
       144
       -
       (** Track definition *)

     

       145
       145
       -
       type track = {

     

       146
       146
       -
         name : string option;

     

       147
       147
       -
         cmt : string option;

     

       148
       148
       -
         desc : string option;

     

       149
       149
       -
         src : string option;

     

       150
       150
       -
         links : link list;

     

       151
       151
       -
         number : int option;

     

       152
       152
       -
         type_ : string option;

     

       153
       153
       -
         extensions : extension list;

     

       154
       154
       -
         trksegs : track_segment list;

     

       155
       155
       -
       }

     

       156
       156
       -
       

     

       157
       157
       -
       (** Main GPX document *)

     

       158
       158
       -
       type gpx = {

     

       159
       159
       -
         version : string; (* GPX version: "1.0" or "1.1" *)

     

       160
       160
       -
         creator : string;

     

       161
       161
       -
         metadata : metadata option;

     

       162
       162
       -
         waypoints : waypoint list;

     

       163
       163
       -
         routes : route list;

     

       164
       164
       -
         tracks : track list;

     

       165
       165
       -
         extensions : extension list;

     

       166
       166
       -
       }

     

       167
       167
       -
       

     

       168
       168
       -
       (** Parser/Writer errors *)

     

       169
       169
       -
       type error =

     

       170
       170
       -
         | Invalid_xml of string

     

       171
       171
       -
         | Invalid_coordinate of string

     

       172
       172
       -
         | Missing_required_attribute of string * string

     

       173
       173
       -
         | Missing_required_element of string

     

       174
       174
       -
         | Validation_error of string

     

       175
       175
       -
         | Xml_error of string

     

       176
       176
       -
         | IO_error of string

     

       177
       177
       -
       

     

       178
       178
       -
       exception Gpx_error of error

     

       179
       179
       -
       

     

       180
       180
       -
       (** Result type for operations that can fail *)

     

       181
       181
       -
       type 'a result = ('a, error) Result.t

     

       182
       182
       -
       

     

       183
       183
       -
       (** Utility functions *)

     

       184
       184
       -
       

     

       185
       185
       -
       (** Convert fix_type to string *)

     

       186
       186
       -
       let fix_type_to_string = function

     

       187
       187
       -
         | None_fix -> "none"

     

       188
       188
       -
         | Fix_2d -> "2d" 

     

       189
       189
       -
         | Fix_3d -> "3d"

     

       190
       190
       -
         | Dgps -> "dgps"

     

       191
       191
       -
         | Pps -> "pps"

     

       192
       192
       -
       

     

       193
       193
       -
       (** Parse fix_type from string *)

     

       194
       194
       -
       let fix_type_of_string = function

     

       195
       195
       -
         | "none" -> Some None_fix

     

       196
       196
       -
         | "2d" -> Some Fix_2d

     

       197
       197
       -
         | "3d" -> Some Fix_3d

     

       198
       198
       -
         | "dgps" -> Some Dgps

     

       199
       199
       -
         | "pps" -> Some Pps

     

       200
       200
       -
         | _ -> None

     

       201
       201
       -
       

     

       202
       202
       -
       (** Create empty waypoint_data with required coordinates *)

     

       203
       203
       -
       let make_waypoint_data lat lon = {

     

       204
       204
       -
         lat; lon;

     

       205
       205
       -
         ele = None; time = None; magvar = None; geoidheight = None;

     

       206
       206
       -
         name = None; cmt = None; desc = None; src = None; links = [];

     

       207
       207
       -
         sym = None; type_ = None; fix = None; sat = None;

     

       208
       208
       -
         hdop = None; vdop = None; pdop = None; ageofdgpsdata = None;

     

       209
       209
       -
         dgpsid = None; extensions = [];

     

       210
       210
       -
       }

     

       211
       211
       -
       

     

       212
       212
       -
       (** Create empty metadata *)

     

       213
       213
       -
       let empty_metadata = {

     

       214
       214
       -
         name = None; desc = None; author = None; copyright = None;

     

       215
       215
       -
         links = []; time = None; keywords = None; bounds = None;

     

       216
       216
       -
         extensions = [];

     

       217
       217
       -
       }

     

       218
       218
       -
       

     

       219
       219
       -
       (** Create empty GPX document *)

     

       220
       220
       -
       let make_gpx ~creator = {

     

       221
       221
       -
         version = "1.1";

     

       222
       222
       -
         creator;

     

       223
       223
       -
         metadata = None;

     

       224
       224
       -
         waypoints = [];

     

       225
       225
       -
         routes = [];

     

       226
       226
       -
         tracks = [];

     

       227
       227
       -
         extensions = [];

     

       228
       228
       -
       }

-190

lib/gpx/types.mli

···

       1
       1
       -
       (** Core GPX types matching the GPX 1.1 XSD schema *)

     

       2
       2
       -
       

     

       3
       3
       -
       [@@@warning "-30"]

     

       4
       4
       -
       

     

       5
       5
       -
       (** Geographic coordinates with validation constraints *)

     

       6
       6
       -
       type latitude = private float

     

       7
       7
       -
       type longitude = private float

     

       8
       8
       -
       type degrees = private float

     

       9
       9
       -
       

     

       10
       10
       -
       (** Smart constructors for validated coordinates *)

     

       11
       11
       -
       val latitude : float -> (latitude, string) result

     

       12
       12
       -
       val longitude : float -> (longitude, string) result

     

       13
       13
       -
       val degrees : float -> (degrees, string) result

     

       14
       14
       -
       

     

       15
       15
       -
       (** Convert back to float *)

     

       16
       16
       -
       val latitude_to_float : latitude -> float

     

       17
       17
       -
       val longitude_to_float : longitude -> float

     

       18
       18
       -
       val degrees_to_float : degrees -> float

     

       19
       19
       -
       

     

       20
       20
       -
       (** GPS fix types as defined in GPX spec *)

     

       21
       21
       -
       type fix_type = 

     

       22
       22
       -
         | None_fix

     

       23
       23
       -
         | Fix_2d

     

       24
       24
       -
         | Fix_3d

     

       25
       25
       -
         | Dgps

     

       26
       26
       -
         | Pps

     

       27
       27
       -
       

     

       28
       28
       -
       (** Person information *)

     

       29
       29
       -
       type person = {

     

       30
       30
       -
         name : string option;

     

       31
       31
       -
         email : string option;

     

       32
       32
       -
         link : link option;

     

       33
       33
       -
       }

     

       34
       34
       -
       

     

       35
       35
       -
       (** Link information *)

     

       36
       36
       -
       and link = {

     

       37
       37
       -
         href : string;

     

       38
       38
       -
         text : string option;

     

       39
       39
       -
         type_ : string option;

     

       40
       40
       -
       }

     

       41
       41
       -
       

     

       42
       42
       -
       (** Copyright information *)

     

       43
       43
       -
       type copyright = {

     

       44
       44
       -
         author : string;

     

       45
       45
       -
         year : int option;

     

       46
       46
       -
         license : string option;

     

       47
       47
       -
       }

     

       48
       48
       -
       

     

       49
       49
       -
       (** Bounding box *)

     

       50
       50
       -
       type bounds = {

     

       51
       51
       -
         minlat : latitude;

     

       52
       52
       -
         minlon : longitude;

     

       53
       53
       -
         maxlat : latitude;

     

       54
       54
       -
         maxlon : longitude;

     

       55
       55
       -
       }

     

       56
       56
       -
       

     

       57
       57
       -
       (** Metadata container *)

     

       58
       58
       -
       type metadata = {

     

       59
       59
       -
         name : string option;

     

       60
       60
       -
         desc : string option;

     

       61
       61
       -
         author : person option;

     

       62
       62
       -
         copyright : copyright option;

     

       63
       63
       -
         links : link list;

     

       64
       64
       -
         time : Ptime.t option;

     

       65
       65
       -
         keywords : string option;

     

       66
       66
       -
         bounds : bounds option;

     

       67
       67
       -
         extensions : extension list;

     

       68
       68
       -
       }

     

       69
       69
       -
       

     

       70
       70
       -
       (** Extension mechanism for custom elements *)

     

       71
       71
       -
       and extension = {

     

       72
       72
       -
         namespace : string option;

     

       73
       73
       -
         name : string;

     

       74
       74
       -
         attributes : (string * string) list;

     

       75
       75
       -
         content : extension_content;

     

       76
       76
       -
       }

     

       77
       77
       -
       

     

       78
       78
       -
       and extension_content =

     

       79
       79
       -
         | Text of string

     

       80
       80
       -
         | Elements of extension list

     

       81
       81
       -
         | Mixed of string * extension list

     

       82
       82
       -
       

     

       83
       83
       -
       (** Base waypoint data shared by wpt, rtept, trkpt *)

     

       84
       84
       -
       type waypoint_data = {

     

       85
       85
       -
         lat : latitude;

     

       86
       86
       -
         lon : longitude;

     

       87
       87
       -
         ele : float option;

     

       88
       88
       -
         time : Ptime.t option;

     

       89
       89
       -
         magvar : degrees option;

     

       90
       90
       -
         geoidheight : float option;

     

       91
       91
       -
         name : string option;

     

       92
       92
       -
         cmt : string option;

     

       93
       93
       -
         desc : string option;

     

       94
       94
       -
         src : string option;

     

       95
       95
       -
         links : link list;

     

       96
       96
       -
         sym : string option;

     

       97
       97
       -
         type_ : string option;

     

       98
       98
       -
         fix : fix_type option;

     

       99
       99
       -
         sat : int option;

     

       100
       100
       -
         hdop : float option;

     

       101
       101
       -
         vdop : float option;

     

       102
       102
       -
         pdop : float option;

     

       103
       103
       -
         ageofdgpsdata : float option;

     

       104
       104
       -
         dgpsid : int option;

     

       105
       105
       -
         extensions : extension list;

     

       106
       106
       -
       }

     

       107
       107
       -
       

     

       108
       108
       -
       (** Waypoint *)

     

       109
       109
       -
       type waypoint = waypoint_data

     

       110
       110
       -
       

     

       111
       111
       -
       (** Route point *)

     

       112
       112
       -
       type route_point = waypoint_data

     

       113
       113
       -
       

     

       114
       114
       -
       (** Track point *)

     

       115
       115
       -
       type track_point = waypoint_data

     

       116
       116
       -
       

     

       117
       117
       -
       (** Route definition *)

     

       118
       118
       -
       type route = {

     

       119
       119
       -
         name : string option;

     

       120
       120
       -
         cmt : string option;

     

       121
       121
       -
         desc : string option;

     

       122
       122
       -
         src : string option;

     

       123
       123
       -
         links : link list;

     

       124
       124
       -
         number : int option;

     

       125
       125
       -
         type_ : string option;

     

       126
       126
       -
         extensions : extension list;

     

       127
       127
       -
         rtepts : route_point list;

     

       128
       128
       -
       }

     

       129
       129
       -
       

     

       130
       130
       -
       (** Track segment *)

     

       131
       131
       -
       type track_segment = {

     

       132
       132
       -
         trkpts : track_point list;

     

       133
       133
       -
         extensions : extension list;

     

       134
       134
       -
       }

     

       135
       135
       -
       

     

       136
       136
       -
       (** Track definition *)

     

       137
       137
       -
       type track = {

     

       138
       138
       -
         name : string option;

     

       139
       139
       -
         cmt : string option;

     

       140
       140
       -
         desc : string option;

     

       141
       141
       -
         src : string option;

     

       142
       142
       -
         links : link list;

     

       143
       143
       -
         number : int option;

     

       144
       144
       -
         type_ : string option;

     

       145
       145
       -
         extensions : extension list;

     

       146
       146
       -
         trksegs : track_segment list;

     

       147
       147
       -
       }

     

       148
       148
       -
       

     

       149
       149
       -
       (** Main GPX document *)

     

       150
       150
       -
       type gpx = {

     

       151
       151
       -
         version : string; (* Always "1.1" for this version *)

     

       152
       152
       -
         creator : string;

     

       153
       153
       -
         metadata : metadata option;

     

       154
       154
       -
         waypoints : waypoint list;

     

       155
       155
       -
         routes : route list;

     

       156
       156
       -
         tracks : track list;

     

       157
       157
       -
         extensions : extension list;

     

       158
       158
       -
       }

     

       159
       159
       -
       

     

       160
       160
       -
       (** Parser/Writer errors *)

     

       161
       161
       -
       type error =

     

       162
       162
       -
         | Invalid_xml of string

     

       163
       163
       -
         | Invalid_coordinate of string

     

       164
       164
       -
         | Missing_required_attribute of string * string

     

       165
       165
       -
         | Missing_required_element of string

     

       166
       166
       -
         | Validation_error of string

     

       167
       167
       -
         | Xml_error of string

     

       168
       168
       -
         | IO_error of string

     

       169
       169
       -
       

     

       170
       170
       -
       exception Gpx_error of error

     

       171
       171
       -
       

     

       172
       172
       -
       (** Result type for operations that can fail *)

     

       173
       173
       -
       type 'a result = ('a, error) Result.t

     

       174
       174
       -
       

     

       175
       175
       -
       (** Utility functions *)

     

       176
       176
       -
       

     

       177
       177
       -
       (** Convert fix_type to string *)

     

       178
       178
       -
       val fix_type_to_string : fix_type -> string

     

       179
       179
       -
       

     

       180
       180
       -
       (** Parse fix_type from string *)

     

       181
       181
       -
       val fix_type_of_string : string -> fix_type option

     

       182
       182
       -
       

     

       183
       183
       -
       (** Create empty waypoint_data with required coordinates *)

     

       184
       184
       -
       val make_waypoint_data : latitude -> longitude -> waypoint_data

     

       185
       185
       -
       

     

       186
       186
       -
       (** Create empty metadata *)

     

       187
       187
       -
       val empty_metadata : metadata

     

       188
       188
       -
       

     

       189
       189
       -
       (** Create empty GPX document *)

     

       190
       190
       -
       val make_gpx : creator:string -> gpx

+38 -31

lib/gpx/validate.ml

···

       1
       1
        
       (** GPX validation utilities *)

     

       2
       2
        
       

     

       3
       3
       -
       open Types

     

       4
       4
       -
       

     

       5
       3
        
       (** Validation error messages *)

     

       6
       4
        
       type validation_issue = {

     

       7
       5
        
         level : [`Error | `Warning];

     
···

       31
       29
        
         let issues = ref [] in

     

       32
       30
        
         

     

       33
       31
        
         (* Check for negative satellite count *)

     

       34
       34
       -
         (match wpt.sat with

     

       32
       32
       +
         (match Waypoint.get_sat wpt with

     

       35
       33
        
          | Some sat when sat < 0 ->

     

       36
       34
        
            issues := make_warning ~location ("Negative satellite count: " ^ string_of_int sat) :: !issues

     

       37
       35
        
          | _ -> ());

     
···

       46
       44
        
           | _ -> ()

     

       47
       45
        
         in

     

       48
       46
        
         

     

       49
       49
       -
         check_precision "hdop" wpt.hdop;

     

       50
       50
       -
         check_precision "vdop" wpt.vdop;

     

       51
       51
       -
         check_precision "pdop" wpt.pdop;

     

       47
       47
       +
         check_precision "hdop" (Waypoint.get_hdop wpt);

     

       48
       48
       +
         check_precision "vdop" (Waypoint.get_vdop wpt);

     

       49
       49
       +
         check_precision "pdop" (Waypoint.get_pdop wpt);

     

       52
       50
        
         

     

       53
       51
        
         (* Check elevation reasonableness *)

     

       54
       54
       -
         (match wpt.ele with

     

       52
       52
       +
         (match Waypoint.get_elevation wpt with

     

       55
       53
        
          | Some ele when ele < -15000.0 ->

     

       56
       54
        
            issues := make_warning ~location (Printf.sprintf "Very low elevation: %.2f m" ele) :: !issues

     

       57
       55
        
          | Some ele when ele > 15000.0 ->

     
···

       59
       57
        
          | _ -> ());

     

       60
       58
        
         

     

       61
       59
        
         (* Check DGPS age *)

     

       62
       62
       -
         (match wpt.ageofdgpsdata with

     

       60
       60
       +
         (match Waypoint.get_ageofdgpsdata wpt with

     

       63
       61
        
          | Some age when age < 0.0 ->

     

       64
       62
        
            issues := make_error ~location "Negative DGPS age" :: !issues

     

       65
       63
        
          | _ -> ());

     
···

       71
       69
        
         let issues = ref [] in

     

       72
       70
        
         let location = "bounds" in

     

       73
       71
        
         

     

       74
       74
       -
         if latitude_to_float bounds.minlat >= latitude_to_float bounds.maxlat then

     

       72
       72
       +
         let (minlat, minlon, maxlat, maxlon) = Metadata.Bounds.get_bounds bounds in

     

       73
       73
       +
         if Coordinate.latitude_to_float minlat >= Coordinate.latitude_to_float maxlat then

     

       75
       74
        
           issues := make_error ~location "minlat must be less than maxlat" :: !issues;

     

       76
       75
        
         

     

       77
       77
       -
         if longitude_to_float bounds.minlon >= longitude_to_float bounds.maxlon then

     

       76
       76
       +
         if Coordinate.longitude_to_float minlon >= Coordinate.longitude_to_float maxlon then

     

       78
       77
        
           issues := make_error ~location "minlon must be less than maxlon" :: !issues;

     

       79
       78
        
         

     

       80
       79
        
         !issues

     
···

       84
       83
        
         let issues = ref [] in

     

       85
       84
        
         

     

       86
       85
        
         (* Validate bounds if present *)

     

       87
       87
       -
         (match metadata.bounds with

     

       86
       86
       +
         (match Metadata.get_bounds metadata with

     

       88
       87
        
          | Some bounds -> issues := validate_bounds bounds @ !issues

     

       89
       88
        
          | None -> ());

     

       90
       89
        
         

     

       91
       90
        
         (* Check for reasonable copyright year *)

     

       92
       92
       -
         (match metadata.copyright with

     

       91
       91
       +
         (match Metadata.get_copyright metadata with

     

       93
       92
        
          | Some copyright ->

     

       94
       94
       -
            (match copyright.year with

     

       93
       93
       +
            (match Link.get_copyright_year copyright with

     

       95
       94
        
             | Some year when year < 1900 || year > 2100 ->

     

       96
       95
        
               issues := make_warning ~location:"metadata.copyright" 

     

       97
       96
        
                 (Printf.sprintf "Unusual copyright year: %d" year) :: !issues

     
···

       106
       105
        
         let location = "route" in

     

       107
       106
        
         

     

       108
       107
        
         (* Check for empty route *)

     

       109
       109
       -
         if route.rtepts = [] then

     

       108
       108
       +
         let points = Route.get_points route in

     

       109
       109
       +
         if points = [] then

     

       110
       110
        
           issues := make_warning ~location "Route has no points" :: !issues;

     

       111
       111
        
         

     

       112
       112
        
         (* Validate route points *)

     

       113
       113
        
         List.iteri (fun i rtept ->

     

       114
       114
        
           let point_location = Printf.sprintf "route.rtept[%d]" i in

     

       115
       115
        
           issues := validate_waypoint_data rtept point_location @ !issues

     

       116
       116
       -
         ) route.rtepts;

     

       116
       116
       +
         ) points;

     

       117
       117
        
         

     

       118
       118
        
         !issues

     

       119
       119
        
       

     
···

       123
       123
        
         let location = Printf.sprintf "track.trkseg[%d]" seg_idx in

     

       124
       124
        
         

     

       125
       125
        
         (* Check for empty segment *)

     

       126
       126
       -
         if trkseg.trkpts = [] then

     

       126
       126
       +
         let points = Track.Segment.get_points trkseg in

     

       127
       127
       +
         if points = [] then

     

       127
       128
        
           issues := make_warning ~location "Track segment has no points" :: !issues;

     

       128
       129
        
         

     

       129
       130
        
         (* Validate track points *)

     

       130
       131
        
         List.iteri (fun i trkpt ->

     

       131
       132
        
           let point_location = Printf.sprintf "%s.trkpt[%d]" location i in

     

       132
       133
        
           issues := validate_waypoint_data trkpt point_location @ !issues

     

       133
       133
       -
         ) trkseg.trkpts;

     

       134
       134
       +
         ) points;

     

       134
       135
        
         

     

       135
       136
        
         (* Check for time ordering if timestamps are present *)

     

       136
       137
        
         let rec check_time_order prev_time = function

     

       137
       138
        
           | [] -> ()

     

       138
       139
        
           | trkpt :: rest ->

     

       139
       139
       -
             (match (prev_time, trkpt.time) with

     

       140
       140
       +
             (match (prev_time, Waypoint.get_time trkpt) with

     

       140
       141
        
              | (Some prev, Some curr) when Ptime.compare prev curr > 0 ->

     

       141
       142
        
                issues := make_warning ~location "Track points not in chronological order" :: !issues

     

       142
       143
        
              | _ -> ());

     

       143
       143
       -
             check_time_order trkpt.time rest

     

       144
       144
       +
             check_time_order (Waypoint.get_time trkpt) rest

     

       144
       145
        
         in

     

       145
       145
       -
         check_time_order None trkseg.trkpts;

     

       146
       146
       +
         check_time_order None points;

     

       146
       147
        
         

     

       147
       148
        
         !issues

     

       148
       149
        
       

     
···

       152
       153
        
         let location = "track" in

     

       153
       154
        
         

     

       154
       155
        
         (* Check for empty track *)

     

       155
       155
       -
         if track.trksegs = [] then

     

       156
       156
       +
         let segments = Track.get_segments track in

     

       157
       157
       +
         if segments = [] then

     

       156
       158
        
           issues := make_warning ~location "Track has no segments" :: !issues;

     

       157
       159
        
         

     

       158
       160
        
         (* Validate track segments *)

     

       159
       161
        
         List.iteri (fun i trkseg ->

     

       160
       162
        
           issues := validate_track_segment trkseg i @ !issues

     

       161
       161
       -
         ) track.trksegs;

     

       163
       163
       +
         ) segments;

     

       162
       164
        
         

     

       163
       165
        
         !issues

     

       164
       166
        
       

     
···

       167
       169
        
         let issues = ref [] in

     

       168
       170
        
         

     

       169
       171
        
         (* Check GPX version *)

     

       170
       170
       -
         if gpx.version <> "1.0" && gpx.version <> "1.1" then

     

       172
       172
       +
         let version = Gpx_doc.get_version gpx in

     

       173
       173
       +
         if version <> "1.0" && version <> "1.1" then

     

       171
       174
        
           issues := make_error ~location:"gpx" 

     

       172
       172
       -
             (Printf.sprintf "Unsupported GPX version: %s (supported: 1.0, 1.1)" gpx.version) :: !issues

     

       173
       173
       -
         else if gpx.version = "1.0" then

     

       175
       175
       +
             (Printf.sprintf "Unsupported GPX version: %s (supported: 1.0, 1.1)" version) :: !issues

     

       176
       176
       +
         else if version = "1.0" then

     

       174
       177
        
           issues := make_warning ~location:"gpx" 

     

       175
       178
        
             "GPX 1.0 detected - consider upgrading to GPX 1.1 for better compatibility" :: !issues;

     

       176
       179
        
         

     

       177
       180
        
         (* Check for empty creator *)

     

       178
       178
       -
         if String.trim gpx.creator = "" then

     

       181
       181
       +
         let creator = Gpx_doc.get_creator gpx in

     

       182
       182
       +
         if String.trim creator = "" then

     

       179
       183
        
           issues := make_error ~location:"gpx" "Creator cannot be empty" :: !issues;

     

       180
       184
        
         

     

       181
       185
        
         (* Validate metadata *)

     

       182
       182
       -
         (match gpx.metadata with

     

       186
       186
       +
         (match Gpx_doc.get_metadata gpx with

     

       183
       187
        
          | Some metadata -> issues := validate_metadata metadata @ !issues

     

       184
       188
        
          | None -> ());

     

       185
       189
        
         

     

       186
       190
        
         (* Validate waypoints *)

     

       191
       191
       +
         let waypoints = Gpx_doc.get_waypoints gpx in

     

       187
       192
        
         List.iteri (fun i wpt ->

     

       188
       193
        
           let location = Printf.sprintf "waypoint[%d]" i in

     

       189
       194
        
           issues := validate_waypoint_data wpt location @ !issues

     

       190
       190
       -
         ) gpx.waypoints;

     

       195
       195
       +
         ) waypoints;

     

       191
       196
        
         

     

       192
       197
        
         (* Validate routes *)

     

       198
       198
       +
         let routes = Gpx_doc.get_routes gpx in

     

       193
       199
        
         List.iteri (fun _i route ->

     

       194
       200
        
           issues := validate_route route @ !issues

     

       195
       195
       -
         ) gpx.routes;

     

       201
       201
       +
         ) routes;

     

       196
       202
        
         

     

       197
       203
        
         (* Validate tracks *)

     

       204
       204
       +
         let tracks = Gpx_doc.get_tracks gpx in

     

       198
       205
        
         List.iteri (fun _i track ->

     

       199
       206
        
           issues := validate_track track @ !issues

     

       200
       200
       -
         ) gpx.tracks;

     

       207
       207
       +
         ) tracks;

     

       201
       208
        
         

     

       202
       209
        
         (* Check for completely empty GPX *)

     

       203
       203
       -
         if gpx.waypoints = [] && gpx.routes = [] && gpx.tracks = [] then

     

       210
       210
       +
         if waypoints = [] && routes = [] && tracks = [] then

     

       204
       211
        
           issues := make_warning ~location:"gpx" "GPX document contains no geographic data" :: !issues;

     

       205
       212
        
         

     

       206
       213
        
         let all_issues = !issues in

+4 -6

lib/gpx/validate.mli

···

       1
       1
        
       (** GPX validation utilities *)

     

       2
       2
        
       

     

       3
       3
       -
       open Types

     

       4
       4
       -
       

     

       5
       3
        
       (** Validation issue representation *)

     

       6
       4
        
       type validation_issue = {

     

       7
       5
        
         level : [`Error | `Warning];

     
···

       16
       14
        
       }

     

       17
       15
        
       

     

       18
       16
        
       (** Validate a complete GPX document *)

     

       19
       19
       -
       val validate_gpx : gpx -> validation_result

     

       17
       17
       +
       val validate_gpx : Gpx_doc.t -> validation_result

     

       20
       18
        
       

     

       21
       19
        
       (** Quick validation - returns true if document is valid *)

     

       22
       22
       -
       val is_valid : gpx -> bool

     

       20
       20
       +
       val is_valid : Gpx_doc.t -> bool

     

       23
       21
        
       

     

       24
       22
        
       (** Get only error messages *)

     

       25
       25
       -
       val get_errors : gpx -> validation_issue list

     

       23
       23
       +
       val get_errors : Gpx_doc.t -> validation_issue list

     

       26
       24
        
       

     

       27
       25
        
       (** Get only warning messages *)

     

       28
       28
       -
       val get_warnings : gpx -> validation_issue list

     

       26
       26
       +
       val get_warnings : Gpx_doc.t -> validation_issue list

     

       29
       27
        
       

     

       30
       28
        
       (** Format validation issue for display *)

     

       31
       29
        
       val format_issue : validation_issue -> string

+260

lib/gpx/waypoint.ml

···

       1
       1
       +
       (** Waypoint data and GPS fix types *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** GPS fix types as defined in GPX spec *)

     

       4
       4
       +
       type fix_type = 

     

       5
       5
       +
         | None_fix

     

       6
       6
       +
         | Fix_2d

     

       7
       7
       +
         | Fix_3d

     

       8
       8
       +
         | Dgps

     

       9
       9
       +
         | Pps

     

       10
       10
       +
       

     

       11
       11
       +
       (** Main waypoint type - shared by waypoints, route points, track points *)

     

       12
       12
       +
       type t = {

     

       13
       13
       +
         lat : Coordinate.latitude;

     

       14
       14
       +
         lon : Coordinate.longitude;

     

       15
       15
       +
         ele : float option;

     

       16
       16
       +
         time : Ptime.t option;

     

       17
       17
       +
         magvar : Coordinate.degrees option;

     

       18
       18
       +
         geoidheight : float option;

     

       19
       19
       +
         name : string option;

     

       20
       20
       +
         cmt : string option;

     

       21
       21
       +
         desc : string option;

     

       22
       22
       +
         src : string option;

     

       23
       23
       +
         links : Link.t list;

     

       24
       24
       +
         sym : string option;

     

       25
       25
       +
         type_ : string option;

     

       26
       26
       +
         fix : fix_type option;

     

       27
       27
       +
         sat : int option;

     

       28
       28
       +
         hdop : float option;

     

       29
       29
       +
         vdop : float option;

     

       30
       30
       +
         pdop : float option;

     

       31
       31
       +
         ageofdgpsdata : float option;

     

       32
       32
       +
         dgpsid : int option;

     

       33
       33
       +
         extensions : Extension.t list;

     

       34
       34
       +
       }

     

       35
       35
       +
       

     

       36
       36
       +
       (** {2 Fix Type Operations} *)

     

       37
       37
       +
       

     

       38
       38
       +
       let fix_type_to_string = function

     

       39
       39
       +
         | None_fix -> "none"

     

       40
       40
       +
         | Fix_2d -> "2d" 

     

       41
       41
       +
         | Fix_3d -> "3d"

     

       42
       42
       +
         | Dgps -> "dgps"

     

       43
       43
       +
         | Pps -> "pps"

     

       44
       44
       +
       

     

       45
       45
       +
       let fix_type_of_string = function

     

       46
       46
       +
         | "none" -> Some None_fix

     

       47
       47
       +
         | "2d" -> Some Fix_2d

     

       48
       48
       +
         | "3d" -> Some Fix_3d

     

       49
       49
       +
         | "dgps" -> Some Dgps

     

       50
       50
       +
         | "pps" -> Some Pps

     

       51
       51
       +
         | _ -> None

     

       52
       52
       +
       

     

       53
       53
       +
       let compare_fix_type f1 f2 = match f1, f2 with

     

       54
       54
       +
         | None_fix, None_fix -> 0

     

       55
       55
       +
         | None_fix, _ -> -1

     

       56
       56
       +
         | _, None_fix -> 1

     

       57
       57
       +
         | Fix_2d, Fix_2d -> 0

     

       58
       58
       +
         | Fix_2d, _ -> -1

     

       59
       59
       +
         | _, Fix_2d -> 1

     

       60
       60
       +
         | Fix_3d, Fix_3d -> 0

     

       61
       61
       +
         | Fix_3d, _ -> -1

     

       62
       62
       +
         | _, Fix_3d -> 1

     

       63
       63
       +
         | Dgps, Dgps -> 0

     

       64
       64
       +
         | Dgps, _ -> -1

     

       65
       65
       +
         | _, Dgps -> 1

     

       66
       66
       +
         | Pps, Pps -> 0

     

       67
       67
       +
       

     

       68
       68
       +
       (** {2 Waypoint Operations} *)

     

       69
       69
       +
       

     

       70
       70
       +
       (** Create waypoint with required coordinates *)

     

       71
       71
       +
       let make lat lon = {

     

       72
       72
       +
         lat; lon;

     

       73
       73
       +
         ele = None; time = None; magvar = None; geoidheight = None;

     

       74
       74
       +
         name = None; cmt = None; desc = None; src = None; links = [];

     

       75
       75
       +
         sym = None; type_ = None; fix = None; sat = None;

     

       76
       76
       +
         hdop = None; vdop = None; pdop = None; ageofdgpsdata = None;

     

       77
       77
       +
         dgpsid = None; extensions = [];

     

       78
       78
       +
       }

     

       79
       79
       +
       

     

       80
       80
       +
       (** Create waypoint from float coordinates *)

     

       81
       81
       +
       let make_from_floats ~lat ~lon ?name ?desc () =

     

       82
       82
       +
         match Coordinate.latitude lat, Coordinate.longitude lon with

     

       83
       83
       +
         | Ok lat_coord, Ok lon_coord -> 

     

       84
       84
       +
           let wpt = make lat_coord lon_coord in

     

       85
       85
       +
           Ok { wpt with name; desc }

     

       86
       86
       +
         | Error e, _ | _, Error e -> Error e

     

       87
       87
       +
       

     

       88
       88
       +
       (** Get coordinate pair *)

     

       89
       89
       +
       let get_coordinate t = Coordinate.make t.lat t.lon

     

       90
       90
       +
       

     

       91
       91
       +
       (** Get latitude *)

     

       92
       92
       +
       let get_lat t = t.lat

     

       93
       93
       +
       

     

       94
       94
       +
       (** Get longitude *)

     

       95
       95
       +
       let get_lon t = t.lon

     

       96
       96
       +
       

     

       97
       97
       +
       (** Get coordinate as float pair *)

     

       98
       98
       +
       let to_floats t = (Coordinate.latitude_to_float t.lat, Coordinate.longitude_to_float t.lon)

     

       99
       99
       +
       

     

       100
       100
       +
       (** Get elevation *)

     

       101
       101
       +
       let get_elevation t = t.ele

     

       102
       102
       +
       

     

       103
       103
       +
       (** Get time *)

     

       104
       104
       +
       let get_time t = t.time

     

       105
       105
       +
       

     

       106
       106
       +
       (** Get name *)

     

       107
       107
       +
       let get_name t = t.name

     

       108
       108
       +
       

     

       109
       109
       +
       (** Get description *)

     

       110
       110
       +
       let get_description t = t.desc

     

       111
       111
       +
       

     

       112
       112
       +
       (** Get comment *)

     

       113
       113
       +
       let get_comment t = t.cmt

     

       114
       114
       +
       

     

       115
       115
       +
       (** Get source *)

     

       116
       116
       +
       let get_source t = t.src

     

       117
       117
       +
       

     

       118
       118
       +
       (** Get symbol *)

     

       119
       119
       +
       let get_symbol t = t.sym

     

       120
       120
       +
       

     

       121
       121
       +
       (** Get type *)

     

       122
       122
       +
       let get_type t = t.type_

     

       123
       123
       +
       

     

       124
       124
       +
       (** Get fix type *)

     

       125
       125
       +
       let get_fix t = t.fix

     

       126
       126
       +
       

     

       127
       127
       +
       (** Get satellite count *)

     

       128
       128
       +
       let get_sat t = t.sat

     

       129
       129
       +
       

     

       130
       130
       +
       (** Get horizontal dilution of precision *)

     

       131
       131
       +
       let get_hdop t = t.hdop

     

       132
       132
       +
       

     

       133
       133
       +
       (** Get vertical dilution of precision *)

     

       134
       134
       +
       let get_vdop t = t.vdop

     

       135
       135
       +
       

     

       136
       136
       +
       (** Get position dilution of precision *)

     

       137
       137
       +
       let get_pdop t = t.pdop

     

       138
       138
       +
       

     

       139
       139
       +
       (** Get magnetic variation *)

     

       140
       140
       +
       let get_magvar t = t.magvar

     

       141
       141
       +
       

     

       142
       142
       +
       (** Get geoid height *)

     

       143
       143
       +
       let get_geoidheight t = t.geoidheight

     

       144
       144
       +
       

     

       145
       145
       +
       (** Get age of DGPS data *)

     

       146
       146
       +
       let get_ageofdgpsdata t = t.ageofdgpsdata

     

       147
       147
       +
       

     

       148
       148
       +
       (** Get DGPS ID *)

     

       149
       149
       +
       let get_dgpsid t = t.dgpsid

     

       150
       150
       +
       

     

       151
       151
       +
       (** Get links *)

     

       152
       152
       +
       let get_links t = t.links

     

       153
       153
       +
       

     

       154
       154
       +
       (** Get extensions *)

     

       155
       155
       +
       let get_extensions t = t.extensions

     

       156
       156
       +
       

     

       157
       157
       +
       (** Set name *)

     

       158
       158
       +
       let set_name name t = { t with name = Some name }

     

       159
       159
       +
       

     

       160
       160
       +
       (** Set description *)

     

       161
       161
       +
       let set_description desc t = { t with desc = Some desc }

     

       162
       162
       +
       

     

       163
       163
       +
       (** Set elevation *)

     

       164
       164
       +
       let set_elevation ele t = { t with ele = Some ele }

     

       165
       165
       +
       

     

       166
       166
       +
       (** Set time *)

     

       167
       167
       +
       let set_time time t = { t with time = Some time }

     

       168
       168
       +
       

     

       169
       169
       +
       (** Functional setters for building waypoints *)

     

       170
       170
       +
       

     

       171
       171
       +
       (** Set elevation *)

     

       172
       172
       +
       let with_elevation t ele = { t with ele = Some ele }

     

       173
       173
       +
       

     

       174
       174
       +
       (** Set time *)

     

       175
       175
       +
       let with_time t time = { t with time }

     

       176
       176
       +
       

     

       177
       177
       +
       (** Set name *)

     

       178
       178
       +
       let with_name t name = { t with name = Some name }

     

       179
       179
       +
       

     

       180
       180
       +
       (** Set comment *)

     

       181
       181
       +
       let with_comment t cmt = { t with cmt = Some cmt }

     

       182
       182
       +
       

     

       183
       183
       +
       (** Set description *)

     

       184
       184
       +
       let with_description t desc = { t with desc = Some desc }

     

       185
       185
       +
       

     

       186
       186
       +
       (** Set source *)

     

       187
       187
       +
       let with_source t src = { t with src = Some src }

     

       188
       188
       +
       

     

       189
       189
       +
       (** Set symbol *)

     

       190
       190
       +
       let with_symbol t sym = { t with sym = Some sym }

     

       191
       191
       +
       

     

       192
       192
       +
       (** Set type *)

     

       193
       193
       +
       let with_type t type_ = { t with type_ = Some type_ }

     

       194
       194
       +
       

     

       195
       195
       +
       (** Set fix type *)

     

       196
       196
       +
       let with_fix t fix = { t with fix }

     

       197
       197
       +
       

     

       198
       198
       +
       (** Set satellite count *)

     

       199
       199
       +
       let with_sat t sat = { t with sat = Some sat }

     

       200
       200
       +
       

     

       201
       201
       +
       (** Set horizontal dilution of precision *)

     

       202
       202
       +
       let with_hdop t hdop = { t with hdop = Some hdop }

     

       203
       203
       +
       

     

       204
       204
       +
       (** Set vertical dilution of precision *)

     

       205
       205
       +
       let with_vdop t vdop = { t with vdop = Some vdop }

     

       206
       206
       +
       

     

       207
       207
       +
       (** Set position dilution of precision *)

     

       208
       208
       +
       let with_pdop t pdop = { t with pdop = Some pdop }

     

       209
       209
       +
       

     

       210
       210
       +
       (** Set magnetic variation *)

     

       211
       211
       +
       let with_magvar t magvar = { t with magvar = Some magvar }

     

       212
       212
       +
       

     

       213
       213
       +
       (** Set geoid height *)

     

       214
       214
       +
       let with_geoidheight t geoidheight = { t with geoidheight = Some geoidheight }

     

       215
       215
       +
       

     

       216
       216
       +
       (** Set age of DGPS data *)

     

       217
       217
       +
       let with_ageofdgpsdata t ageofdgpsdata = { t with ageofdgpsdata = Some ageofdgpsdata }

     

       218
       218
       +
       

     

       219
       219
       +
       (** Set DGPS ID *)

     

       220
       220
       +
       let with_dgpsid t dgpsid = { t with dgpsid = Some dgpsid }

     

       221
       221
       +
       

     

       222
       222
       +
       (** Add link *)

     

       223
       223
       +
       let add_link t link = { t with links = link :: t.links }

     

       224
       224
       +
       

     

       225
       225
       +
       (** Add extensions *)

     

       226
       226
       +
       let add_extensions t extensions = { t with extensions = extensions @ t.extensions }

     

       227
       227
       +
       

     

       228
       228
       +
       (** Compare waypoints *)

     

       229
       229
       +
       let compare t1 t2 =

     

       230
       230
       +
         let lat_cmp = Float.compare 

     

       231
       231
       +
           (Coordinate.latitude_to_float t1.lat) 

     

       232
       232
       +
           (Coordinate.latitude_to_float t2.lat) in

     

       233
       233
       +
         if lat_cmp <> 0 then lat_cmp

     

       234
       234
       +
         else

     

       235
       235
       +
           let lon_cmp = Float.compare 

     

       236
       236
       +
             (Coordinate.longitude_to_float t1.lon) 

     

       237
       237
       +
             (Coordinate.longitude_to_float t2.lon) in

     

       238
       238
       +
           if lon_cmp <> 0 then lon_cmp

     

       239
       239
       +
           else

     

       240
       240
       +
             let ele_cmp = Option.compare Float.compare t1.ele t2.ele in

     

       241
       241
       +
             if ele_cmp <> 0 then ele_cmp

     

       242
       242
       +
             else Option.compare Ptime.compare t1.time t2.time

     

       243
       243
       +
       

     

       244
       244
       +
       (** Test waypoint equality *)

     

       245
       245
       +
       let equal t1 t2 = compare t1 t2 = 0

     

       246
       246
       +
       

     

       247
       247
       +
       (** Pretty print waypoint *)

     

       248
       248
       +
       let pp ppf t =

     

       249
       249
       +
         let lat, lon = to_floats t in

     

       250
       250
       +
         match t.name with

     

       251
       251
       +
         | Some name -> Format.fprintf ppf "%s @ (%g, %g)" name lat lon

     

       252
       252
       +
         | None -> Format.fprintf ppf "(%g, %g)" lat lon

     

       253
       253
       +
       

     

       254
       254
       +
       (** Pretty print fix type *)

     

       255
       255
       +
       let pp_fix_type ppf = function

     

       256
       256
       +
         | None_fix -> Format.fprintf ppf "none"

     

       257
       257
       +
         | Fix_2d -> Format.fprintf ppf "2d"

     

       258
       258
       +
         | Fix_3d -> Format.fprintf ppf "3d" 

     

       259
       259
       +
         | Dgps -> Format.fprintf ppf "dgps"

     

       260
       260
       +
         | Pps -> Format.fprintf ppf "pps"

+205

lib/gpx/waypoint.mli

···

       1
       1
       +
       (** Waypoint data and GPS fix types *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** GPS fix types as defined in GPX spec *)

     

       4
       4
       +
       type fix_type = 

     

       5
       5
       +
         | None_fix

     

       6
       6
       +
         | Fix_2d

     

       7
       7
       +
         | Fix_3d

     

       8
       8
       +
         | Dgps

     

       9
       9
       +
         | Pps

     

       10
       10
       +
       

     

       11
       11
       +
       (** Main waypoint type - shared by waypoints, route points, track points *)

     

       12
       12
       +
       type t = {

     

       13
       13
       +
         lat : Coordinate.latitude;

     

       14
       14
       +
         lon : Coordinate.longitude;

     

       15
       15
       +
         ele : float option;

     

       16
       16
       +
         time : Ptime.t option;

     

       17
       17
       +
         magvar : Coordinate.degrees option;

     

       18
       18
       +
         geoidheight : float option;

     

       19
       19
       +
         name : string option;

     

       20
       20
       +
         cmt : string option;

     

       21
       21
       +
         desc : string option;

     

       22
       22
       +
         src : string option;

     

       23
       23
       +
         links : Link.t list;

     

       24
       24
       +
         sym : string option;

     

       25
       25
       +
         type_ : string option;

     

       26
       26
       +
         fix : fix_type option;

     

       27
       27
       +
         sat : int option;

     

       28
       28
       +
         hdop : float option;

     

       29
       29
       +
         vdop : float option;

     

       30
       30
       +
         pdop : float option;

     

       31
       31
       +
         ageofdgpsdata : float option;

     

       32
       32
       +
         dgpsid : int option;

     

       33
       33
       +
         extensions : Extension.t list;

     

       34
       34
       +
       }

     

       35
       35
       +
       

     

       36
       36
       +
       (** {2 Fix Type Operations} *)

     

       37
       37
       +
       

     

       38
       38
       +
       (** Convert fix_type to string *)

     

       39
       39
       +
       val fix_type_to_string : fix_type -> string

     

       40
       40
       +
       

     

       41
       41
       +
       (** Parse fix_type from string *)

     

       42
       42
       +
       val fix_type_of_string : string -> fix_type option

     

       43
       43
       +
       

     

       44
       44
       +
       (** Compare fix types *)

     

       45
       45
       +
       val compare_fix_type : fix_type -> fix_type -> int

     

       46
       46
       +
       

     

       47
       47
       +
       (** Pretty print fix type *)

     

       48
       48
       +
       val pp_fix_type : Format.formatter -> fix_type -> unit

     

       49
       49
       +
       

     

       50
       50
       +
       (** {2 Waypoint Operations} *)

     

       51
       51
       +
       

     

       52
       52
       +
       (** Create waypoint with required coordinates *)

     

       53
       53
       +
       val make : Coordinate.latitude -> Coordinate.longitude -> t

     

       54
       54
       +
       

     

       55
       55
       +
       (** Create waypoint from float coordinates with validation *)

     

       56
       56
       +
       val make_from_floats : lat:float -> lon:float -> ?name:string -> ?desc:string -> unit -> (t, string) result

     

       57
       57
       +
       

     

       58
       58
       +
       (** Get coordinate pair *)

     

       59
       59
       +
       val get_coordinate : t -> Coordinate.t

     

       60
       60
       +
       

     

       61
       61
       +
       (** Get latitude *)

     

       62
       62
       +
       val get_lat : t -> Coordinate.latitude

     

       63
       63
       +
       

     

       64
       64
       +
       (** Get longitude *)

     

       65
       65
       +
       val get_lon : t -> Coordinate.longitude

     

       66
       66
       +
       

     

       67
       67
       +
       (** Get coordinate as float pair *)

     

       68
       68
       +
       val to_floats : t -> float * float

     

       69
       69
       +
       

     

       70
       70
       +
       (** Get elevation *)

     

       71
       71
       +
       val get_elevation : t -> float option

     

       72
       72
       +
       

     

       73
       73
       +
       (** Get time *)

     

       74
       74
       +
       val get_time : t -> Ptime.t option

     

       75
       75
       +
       

     

       76
       76
       +
       (** Get name *)

     

       77
       77
       +
       val get_name : t -> string option

     

       78
       78
       +
       

     

       79
       79
       +
       (** Get description *)

     

       80
       80
       +
       val get_description : t -> string option

     

       81
       81
       +
       

     

       82
       82
       +
       (** Get comment *)

     

       83
       83
       +
       val get_comment : t -> string option

     

       84
       84
       +
       

     

       85
       85
       +
       (** Get source *)

     

       86
       86
       +
       val get_source : t -> string option

     

       87
       87
       +
       

     

       88
       88
       +
       (** Get symbol *)

     

       89
       89
       +
       val get_symbol : t -> string option

     

       90
       90
       +
       

     

       91
       91
       +
       (** Get type *)

     

       92
       92
       +
       val get_type : t -> string option

     

       93
       93
       +
       

     

       94
       94
       +
       (** Get fix type *)

     

       95
       95
       +
       val get_fix : t -> fix_type option

     

       96
       96
       +
       

     

       97
       97
       +
       (** Get satellite count *)

     

       98
       98
       +
       val get_sat : t -> int option

     

       99
       99
       +
       

     

       100
       100
       +
       (** Get horizontal dilution of precision *)

     

       101
       101
       +
       val get_hdop : t -> float option

     

       102
       102
       +
       

     

       103
       103
       +
       (** Get vertical dilution of precision *)

     

       104
       104
       +
       val get_vdop : t -> float option

     

       105
       105
       +
       

     

       106
       106
       +
       (** Get position dilution of precision *)

     

       107
       107
       +
       val get_pdop : t -> float option

     

       108
       108
       +
       

     

       109
       109
       +
       (** Get magnetic variation *)

     

       110
       110
       +
       val get_magvar : t -> Coordinate.degrees option

     

       111
       111
       +
       

     

       112
       112
       +
       (** Get geoid height *)

     

       113
       113
       +
       val get_geoidheight : t -> float option

     

       114
       114
       +
       

     

       115
       115
       +
       (** Get age of DGPS data *)

     

       116
       116
       +
       val get_ageofdgpsdata : t -> float option

     

       117
       117
       +
       

     

       118
       118
       +
       (** Get DGPS ID *)

     

       119
       119
       +
       val get_dgpsid : t -> int option

     

       120
       120
       +
       

     

       121
       121
       +
       (** Get links *)

     

       122
       122
       +
       val get_links : t -> Link.t list

     

       123
       123
       +
       

     

       124
       124
       +
       (** Get extensions *)

     

       125
       125
       +
       val get_extensions : t -> Extension.t list

     

       126
       126
       +
       

     

       127
       127
       +
       (** Set name *)

     

       128
       128
       +
       val set_name : string -> t -> t

     

       129
       129
       +
       

     

       130
       130
       +
       (** Set description *)

     

       131
       131
       +
       val set_description : string -> t -> t

     

       132
       132
       +
       

     

       133
       133
       +
       (** Set elevation *)

     

       134
       134
       +
       val set_elevation : float -> t -> t

     

       135
       135
       +
       

     

       136
       136
       +
       (** Set time *)

     

       137
       137
       +
       val set_time : Ptime.t -> t -> t

     

       138
       138
       +
       

     

       139
       139
       +
       (** Functional setters for building waypoints *)

     

       140
       140
       +
       

     

       141
       141
       +
       (** Set elevation *)

     

       142
       142
       +
       val with_elevation : t -> float -> t

     

       143
       143
       +
       

     

       144
       144
       +
       (** Set time *)

     

       145
       145
       +
       val with_time : t -> Ptime.t option -> t

     

       146
       146
       +
       

     

       147
       147
       +
       (** Set name *)

     

       148
       148
       +
       val with_name : t -> string -> t

     

       149
       149
       +
       

     

       150
       150
       +
       (** Set comment *)

     

       151
       151
       +
       val with_comment : t -> string -> t

     

       152
       152
       +
       

     

       153
       153
       +
       (** Set description *)

     

       154
       154
       +
       val with_description : t -> string -> t

     

       155
       155
       +
       

     

       156
       156
       +
       (** Set source *)

     

       157
       157
       +
       val with_source : t -> string -> t

     

       158
       158
       +
       

     

       159
       159
       +
       (** Set symbol *)

     

       160
       160
       +
       val with_symbol : t -> string -> t

     

       161
       161
       +
       

     

       162
       162
       +
       (** Set type *)

     

       163
       163
       +
       val with_type : t -> string -> t

     

       164
       164
       +
       

     

       165
       165
       +
       (** Set fix type *)

     

       166
       166
       +
       val with_fix : t -> fix_type option -> t

     

       167
       167
       +
       

     

       168
       168
       +
       (** Set satellite count *)

     

       169
       169
       +
       val with_sat : t -> int -> t

     

       170
       170
       +
       

     

       171
       171
       +
       (** Set horizontal dilution of precision *)

     

       172
       172
       +
       val with_hdop : t -> float -> t

     

       173
       173
       +
       

     

       174
       174
       +
       (** Set vertical dilution of precision *)

     

       175
       175
       +
       val with_vdop : t -> float -> t

     

       176
       176
       +
       

     

       177
       177
       +
       (** Set position dilution of precision *)

     

       178
       178
       +
       val with_pdop : t -> float -> t

     

       179
       179
       +
       

     

       180
       180
       +
       (** Set magnetic variation *)

     

       181
       181
       +
       val with_magvar : t -> Coordinate.degrees -> t

     

       182
       182
       +
       

     

       183
       183
       +
       (** Set geoid height *)

     

       184
       184
       +
       val with_geoidheight : t -> float -> t

     

       185
       185
       +
       

     

       186
       186
       +
       (** Set age of DGPS data *)

     

       187
       187
       +
       val with_ageofdgpsdata : t -> float -> t

     

       188
       188
       +
       

     

       189
       189
       +
       (** Set DGPS ID *)

     

       190
       190
       +
       val with_dgpsid : t -> int -> t

     

       191
       191
       +
       

     

       192
       192
       +
       (** Add link *)

     

       193
       193
       +
       val add_link : t -> Link.t -> t

     

       194
       194
       +
       

     

       195
       195
       +
       (** Add extensions *)

     

       196
       196
       +
       val add_extensions : t -> Extension.t list -> t

     

       197
       197
       +
       

     

       198
       198
       +
       (** Compare waypoints *)

     

       199
       199
       +
       val compare : t -> t -> int

     

       200
       200
       +
       

     

       201
       201
       +
       (** Test waypoint equality *)

     

       202
       202
       +
       val equal : t -> t -> bool

     

       203
       203
       +
       

     

       204
       204
       +
       (** Pretty print waypoint *)

     

       205
       205
       +
       val pp : Format.formatter -> t -> unit

+88 -342

lib/gpx/writer.ml

···

       1
       1
       -
       (** GPX streaming writer using xmlm *)

     

       2
       2
       -
       

     

       3
       3
       -
       open Types

     

       1
       1
       +
       (** GPX XML writer using xmlm *)

     

       4
       2
        
       

     

       5
       3
        
       (** Result binding operators *)

     

       6
       4
        
       let (let*) = Result.bind

     

       7
       5
        
       

     

       8
       8
       -
       (** Writer state for streaming *)

     

       9
       9
       -
       type writer_state = {

     

       10
       10
       -
         output : Xmlm.output;

     

       11
       11
       -
       }

     

       12
       12
       -
       

     

       13
       13
       -
       (** Create a new writer state *)

     

       14
       14
       -
       let make_writer output = { output }

     

       15
       15
       -
       

     

       16
       16
       -
       (** Utility functions *)

     

       17
       17
       -
       

     

       18
       18
       -
       let convert_attributes attrs =

     

       19
       19
       -
         List.map (fun (name, value) -> (("", name), value)) attrs

     

       20
       20
       -
       

     

       21
       21
       -
       let output_signal writer signal =

     

       6
       6
       +
       (** Helper to write XML elements *)

     

       7
       7
       +
       let output_element_start writer name attrs =

     

       22
       8
        
         try

     

       23
       23
       -
           Xmlm.output writer.output signal;

     

       9
       9
       +
           Xmlm.output writer (`El_start ((("", name), attrs)));

     

       24
       10
        
           Ok ()

     

       25
       25
       -
         with

     

       26
       26
       -
         | Xmlm.Error ((line, col), error) ->

     

       27
       27
       -
           Error (Xml_error (Printf.sprintf "XML error at line %d, column %d: %s"

     

       28
       28
       -
                             line col (Xmlm.error_message error)))

     

       29
       29
       -
         | exn ->

     

       30
       30
       -
           Error (Invalid_xml (Printexc.to_string exn))

     

       31
       31
       -
       

     

       32
       32
       -
       let output_element_start writer name attrs =

     

       33
       33
       -
         output_signal writer (`El_start (("", name), attrs))

     

       11
       11
       +
         with exn ->

     

       12
       12
       +
           Error (Error.xml_error (Printexc.to_string exn))

     

       34
       13
        
       

     

       35
       14
        
       let output_element_end writer =

     

       36
       36
       -
         output_signal writer `El_end

     

       15
       15
       +
         try

     

       16
       16
       +
           Xmlm.output writer `El_end;

     

       17
       17
       +
           Ok ()

     

       18
       18
       +
         with exn ->

     

       19
       19
       +
           Error (Error.xml_error (Printexc.to_string exn))

     

       37
       20
        
       

     

       38
       21
        
       let output_data writer text =

     

       39
       39
       -
         if text <> "" then

     

       40
       40
       -
           output_signal writer (`Data text)

     

       41
       41
       -
         else

     

       22
       22
       +
         try

     

       23
       23
       +
           Xmlm.output writer (`Data text);

     

       42
       24
        
           Ok ()

     

       25
       25
       +
         with exn ->

     

       26
       26
       +
           Error (Error.xml_error (Printexc.to_string exn))

     

       43
       27
        
       

     

       44
       28
        
       let output_text_element writer name text =

     

       45
       45
       -
         let* () = output_element_start writer name [] in

     

       29
       29
       +
         let attrs = [] in

     

       30
       30
       +
         let* () = output_element_start writer name attrs in

     

       46
       31
        
         let* () = output_data writer text in

     

       47
       32
        
         output_element_end writer

     

       48
       33
        
       

     
···

       50
       35
        
         | Some text -> output_text_element writer name text

     

       51
       36
        
         | None -> Ok ()

     

       52
       37
        
       

     

       53
       53
       -
       let output_float_element writer name f =

     

       54
       54
       -
         output_text_element writer name (Printf.sprintf "%.6f" f)

     

       55
       55
       -
       

     

       56
       56
       -
       let output_optional_float_element writer name = function

     

       57
       57
       -
         | Some f -> output_float_element writer name f

     

       58
       58
       -
         | None -> Ok ()

     

       59
       59
       -
       

     

       60
       60
       -
       let output_int_element writer name i =

     

       61
       61
       -
         output_text_element writer name (string_of_int i)

     

       62
       62
       -
       

     

       63
       63
       -
       let output_optional_int_element writer name = function

     

       64
       64
       -
         | Some i -> output_int_element writer name i

     

       65
       65
       -
         | None -> Ok ()

     

       66
       66
       -
       

     

       67
       67
       -
       let output_time_element writer name time =

     

       68
       68
       -
         output_text_element writer name (Ptime.to_rfc3339 time)

     

       69
       69
       -
       

     

       70
       70
       -
       let output_optional_time_element writer name = function

     

       71
       71
       -
         | Some time -> output_time_element writer name time

     

       72
       72
       -
         | None -> Ok ()

     

       73
       73
       -
       

     

       74
       74
       -
       (** Write GPX header and DTD *)

     

       75
       75
       -
       let write_header writer =

     

       76
       76
       -
         let* () = output_signal writer (`Dtd None) in

     

       77
       77
       -
         Ok ()

     

       78
       78
       -
       

     

       79
       79
       -
       (** Write link element *)

     

       80
       80
       -
       let write_link writer link =

     

       81
       81
       -
         let attrs = [(("" , "href"), link.href)] in

     

       82
       82
       -
         let* () = output_element_start writer "link" attrs in

     

       83
       83
       -
         let* () = output_optional_text_element writer "text" link.text in

     

       84
       84
       -
         let* () = output_optional_text_element writer "type" link.type_ in

     

       85
       85
       -
         output_element_end writer

     

       86
       86
       -
       

     

       87
       87
       -
       (** Write list of links *)

     

       88
       88
       -
       let write_links writer links =

     

       89
       89
       -
         let rec loop = function

     

       90
       90
       -
           | [] -> Ok ()

     

       91
       91
       -
           | link :: rest ->

     

       92
       92
       -
             let* () = write_link writer link in

     

       93
       93
       -
             loop rest

     

       94
       94
       -
         in

     

       95
       95
       -
         loop links

     

       96
       96
       -
       

     

       97
       97
       -
       (** Write extension content *)

     

       98
       98
       -
       let rec write_extension_content writer = function

     

       99
       99
       -
         | Text text -> output_data writer text

     

       100
       100
       -
         | Elements extensions -> write_extensions writer extensions

     

       101
       101
       -
         | Mixed (text, extensions) ->

     

       102
       102
       -
           let* () = output_data writer text in

     

       103
       103
       -
           write_extensions writer extensions

     

       104
       104
       -
       

     

       105
       105
       -
       (** Write extensions *)

     

       106
       106
       -
       and write_extensions writer extensions =

     

       107
       107
       -
         let rec loop = function

     

       108
       108
       -
           | [] -> Ok ()

     

       109
       109
       -
           | ext :: rest ->

     

       110
       110
       -
             let* () = write_extension writer ext in

     

       111
       111
       -
             loop rest

     

       112
       112
       -
         in

     

       113
       113
       -
         loop extensions

     

       114
       114
       -
       

     

       115
       115
       -
       and write_extension writer ext =

     

       116
       116
       -
         let name = match ext.namespace with

     

       117
       117
       -
           | Some ns -> ns ^ ":" ^ ext.name

     

       118
       118
       -
           | None -> ext.name

     

       119
       119
       -
         in

     

       120
       120
       -
         let* () = output_element_start writer name (convert_attributes ext.attributes) in

     

       121
       121
       -
         let* () = write_extension_content writer ext.content in

     

       122
       122
       -
         output_element_end writer

     

       123
       123
       -
       

     

       124
       124
       -
       (** Write waypoint data (shared by wpt, rtept, trkpt) *)

     

       125
       125
       -
       let write_waypoint_data writer element_name wpt =

     

       126
       126
       -
         let attrs = [

     

       127
       127
       -
           (("", "lat"), Printf.sprintf "%.6f" (latitude_to_float wpt.lat));

     

       128
       128
       -
           (("", "lon"), Printf.sprintf "%.6f" (longitude_to_float wpt.lon));

     

       129
       129
       -
         ] in

     

       130
       130
       -
         let* () = output_element_start writer element_name attrs in

     

       131
       131
       -
         let* () = output_optional_float_element writer "ele" wpt.ele in

     

       132
       132
       -
         let* () = output_optional_time_element writer "time" wpt.time in

     

       133
       133
       -
         let* () = (match wpt.magvar with

     

       134
       134
       -
                    | Some deg -> output_float_element writer "magvar" (degrees_to_float deg)

     

       135
       135
       -
                    | None -> Ok ()) in

     

       136
       136
       -
         let* () = output_optional_float_element writer "geoidheight" wpt.geoidheight in

     

       137
       137
       -
         let* () = output_optional_text_element writer "name" wpt.name in

     

       138
       138
       -
         let* () = output_optional_text_element writer "cmt" wpt.cmt in

     

       139
       139
       -
         let* () = output_optional_text_element writer "desc" wpt.desc in

     

       140
       140
       -
         let* () = output_optional_text_element writer "src" wpt.src in

     

       141
       141
       -
         let* () = write_links writer wpt.links in

     

       142
       142
       -
         let* () = output_optional_text_element writer "sym" wpt.sym in

     

       143
       143
       -
         let* () = output_optional_text_element writer "type" wpt.type_ in

     

       144
       144
       -
         let* () = (match wpt.fix with

     

       145
       145
       -
                    | Some fix -> output_text_element writer "fix" (fix_type_to_string fix)

     

       146
       146
       -
                    | None -> Ok ()) in

     

       147
       147
       -
         let* () = output_optional_int_element writer "sat" wpt.sat in

     

       148
       148
       -
         let* () = output_optional_float_element writer "hdop" wpt.hdop in

     

       149
       149
       -
         let* () = output_optional_float_element writer "vdop" wpt.vdop in

     

       150
       150
       -
         let* () = output_optional_float_element writer "pdop" wpt.pdop in

     

       151
       151
       -
         let* () = output_optional_float_element writer "ageofdgpsdata" wpt.ageofdgpsdata in

     

       152
       152
       -
         let* () = output_optional_int_element writer "dgpsid" wpt.dgpsid in

     

       153
       153
       -
         let* () = (if wpt.extensions <> [] then

     

       154
       154
       -
                    let* () = output_element_start writer "extensions" [] in

     

       155
       155
       -
                    let* () = write_extensions writer wpt.extensions in

     

       156
       156
       -
                    output_element_end writer

     

       157
       157
       -
                  else Ok ()) in

     

       158
       158
       -
         output_element_end writer

     

       159
       159
       -
       

     

       160
       160
       -
       (** Write waypoint *)

     

       161
       161
       -
       let write_waypoint writer wpt =

     

       162
       162
       -
         write_waypoint_data writer "wpt" wpt

     

       163
       163
       -
       

     

       164
       164
       -
       (** Write route point *)

     

       165
       165
       -
       let write_route_point writer rtept =

     

       166
       166
       -
         write_waypoint_data writer "rtept" rtept

     

       167
       167
       -
       

     

       168
       168
       -
       (** Write track point *)

     

       169
       169
       -
       let write_track_point writer trkpt =

     

       170
       170
       -
         write_waypoint_data writer "trkpt" trkpt

     

       171
       171
       -
       

     

       172
       172
       -
       (** Write person *)

     

       173
       173
       -
       let write_person writer (p : person) =

     

       174
       174
       -
         let* () = output_element_start writer "author" [] in

     

       175
       175
       -
         let* () = output_optional_text_element writer "name" p.name in

     

       176
       176
       -
         let* () = output_optional_text_element writer "email" p.email in

     

       177
       177
       -
         let* () = (match p.link with

     

       178
       178
       -
                    | Some link -> write_link writer link

     

       179
       179
       -
                    | None -> Ok ()) in

     

       180
       180
       -
         output_element_end writer

     

       181
       181
       -
       

     

       182
       182
       -
       (** Write copyright *)

     

       183
       183
       -
       let write_copyright writer (copyright : copyright) =

     

       184
       184
       -
         let attrs = [(("", "author"), copyright.author)] in

     

       185
       185
       -
         let* () = output_element_start writer "copyright" attrs in

     

       186
       186
       -
         let* () = (match copyright.year with

     

       187
       187
       -
                    | Some year -> output_int_element writer "year" year

     

       188
       188
       -
                    | None -> Ok ()) in

     

       189
       189
       -
         let* () = output_optional_text_element writer "license" copyright.license in

     

       190
       190
       -
         output_element_end writer

     

       191
       191
       -
       

     

       192
       192
       -
       (** Write bounds *)

     

       193
       193
       -
       let write_bounds writer bounds =

     

       194
       194
       -
         let attrs = [

     

       195
       195
       -
           (("", "minlat"), Printf.sprintf "%.6f" (latitude_to_float bounds.minlat));

     

       196
       196
       -
           (("", "minlon"), Printf.sprintf "%.6f" (longitude_to_float bounds.minlon));

     

       197
       197
       -
           (("", "maxlat"), Printf.sprintf "%.6f" (latitude_to_float bounds.maxlat));

     

       198
       198
       -
           (("", "maxlon"), Printf.sprintf "%.6f" (longitude_to_float bounds.maxlon));

     

       199
       199
       -
         ] in

     

       200
       200
       -
         let* () = output_element_start writer "bounds" attrs in

     

       201
       201
       -
         output_element_end writer

     

       202
       202
       -
       

     

       203
       203
       -
       (** Write metadata *)

     

       204
       204
       -
       let write_metadata writer (metadata : metadata) =

     

       205
       205
       -
         let* () = output_element_start writer "metadata" [] in

     

       206
       206
       -
         let* () = output_optional_text_element writer "name" metadata.name in

     

       207
       207
       -
         let* () = output_optional_text_element writer "desc" metadata.desc in

     

       208
       208
       -
         let* () = (match metadata.author with

     

       209
       209
       -
                    | Some author -> write_person writer author

     

       210
       210
       -
                    | None -> Ok ()) in

     

       211
       211
       -
         let* () = (match metadata.copyright with

     

       212
       212
       -
                    | Some copyright -> write_copyright writer copyright

     

       213
       213
       -
                    | None -> Ok ()) in

     

       214
       214
       -
         let* () = write_links writer metadata.links in

     

       215
       215
       -
         let* () = output_optional_time_element writer "time" metadata.time in

     

       216
       216
       -
         let* () = output_optional_text_element writer "keywords" metadata.keywords in

     

       217
       217
       -
         let* () = (match metadata.bounds with

     

       218
       218
       -
                    | Some bounds -> write_bounds writer bounds

     

       219
       219
       -
                    | None -> Ok ()) in

     

       220
       220
       -
         let* () = (if metadata.extensions <> [] then

     

       221
       221
       -
                    let* () = output_element_start writer "extensions" [] in

     

       222
       222
       -
                    let* () = write_extensions writer metadata.extensions in

     

       223
       223
       -
                    output_element_end writer

     

       224
       224
       -
                  else Ok ()) in

     

       225
       225
       -
         output_element_end writer

     

       226
       226
       -
       

     

       227
       227
       -
       (** Write route *)

     

       228
       228
       -
       let write_route writer (route : route) =

     

       229
       229
       -
         let* () = output_element_start writer "rte" [] in

     

       230
       230
       -
         let* () = output_optional_text_element writer "name" route.name in

     

       231
       231
       -
         let* () = output_optional_text_element writer "cmt" route.cmt in

     

       232
       232
       -
         let* () = output_optional_text_element writer "desc" route.desc in

     

       233
       233
       -
         let* () = output_optional_text_element writer "src" route.src in

     

       234
       234
       -
         let* () = write_links writer route.links in

     

       235
       235
       -
         let* () = output_optional_int_element writer "number" route.number in

     

       236
       236
       -
         let* () = output_optional_text_element writer "type" route.type_ in

     

       237
       237
       -
         let* () = (if route.extensions <> [] then

     

       238
       238
       -
                    let* () = output_element_start writer "extensions" [] in

     

       239
       239
       -
                    let* () = write_extensions writer route.extensions in

     

       240
       240
       -
                    output_element_end writer

     

       241
       241
       -
                  else Ok ()) in

     

       242
       242
       -
         let* () = 

     

       243
       243
       -
           let rec loop = function

     

       244
       244
       -
             | [] -> Ok ()

     

       245
       245
       -
             | rtept :: rest ->

     

       246
       246
       -
               let* () = write_route_point writer rtept in

     

       247
       247
       -
               loop rest

     

       248
       248
       -
           in

     

       249
       249
       -
           loop route.rtepts

     

       250
       250
       -
         in

     

       251
       251
       -
         output_element_end writer

     

       252
       252
       -
       

     

       253
       253
       -
       (** Write track segment *)

     

       254
       254
       -
       let write_track_segment writer trkseg =

     

       255
       255
       -
         let* () = output_element_start writer "trkseg" [] in

     

       256
       256
       -
         let* () = 

     

       257
       257
       -
           let rec loop = function

     

       258
       258
       -
             | [] -> Ok ()

     

       259
       259
       -
             | trkpt :: rest ->

     

       260
       260
       -
               let* () = write_track_point writer trkpt in

     

       261
       261
       -
               loop rest

     

       262
       262
       -
           in

     

       263
       263
       -
           loop trkseg.trkpts

     

       38
       38
       +
       (** Write a complete GPX document *)

     

       39
       39
       +
       let write ?(validate=false) output gpx =

     

       40
       40
       +
         let writer = Xmlm.make_output output in

     

       41
       41
       +
         

     

       42
       42
       +
         let result =

     

       43
       43
       +
           try

     

       44
       44
       +
             (* Write XML declaration and GPX root element *)

     

       45
       45
       +
             let version = Gpx_doc.get_version gpx in

     

       46
       46
       +
             let creator = Gpx_doc.get_creator gpx in

     

       47
       47
       +
             let attrs = [

     

       48
       48
       +
               (("", "version"), version);

     

       49
       49
       +
               (("", "creator"), creator);

     

       50
       50
       +
               (("", "xsi:schemaLocation"), "http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd");

     

       51
       51
       +
               (("xmlns", "xsi"), "http://www.w3.org/2001/XMLSchema-instance");

     

       52
       52
       +
               (("", "xmlns"), "http://www.topografix.com/GPX/1/1")

     

       53
       53
       +
             ] in

     

       54
       54
       +
             

     

       55
       55
       +
             let* () = output_element_start writer "gpx" attrs in

     

       56
       56
       +
             

     

       57
       57
       +
             (* Write metadata if present *)

     

       58
       58
       +
             let* () = match Gpx_doc.get_metadata gpx with

     

       59
       59
       +
              | Some metadata ->

     

       60
       60
       +
                let* () = output_element_start writer "metadata" [] in

     

       61
       61
       +
                (* Write basic metadata fields *)

     

       62
       62
       +
                let* () = output_optional_text_element writer "name" (Metadata.get_name metadata) in

     

       63
       63
       +
                let* () = output_optional_text_element writer "desc" (Metadata.get_description metadata) in

     

       64
       64
       +
                let* () = output_optional_text_element writer "keywords" (Metadata.get_keywords metadata) in

     

       65
       65
       +
                output_element_end writer

     

       66
       66
       +
              | None -> Ok ()

     

       67
       67
       +
             in

     

       68
       68
       +
             

     

       69
       69
       +
             (* Write waypoints *)

     

       70
       70
       +
             let waypoints = Gpx_doc.get_waypoints gpx in

     

       71
       71
       +
             let rec write_waypoints = function

     

       72
       72
       +
               | [] -> Ok ()

     

       73
       73
       +
               | wpt :: rest ->

     

       74
       74
       +
                 let lat = Coordinate.latitude_to_float (Waypoint.get_lat wpt) in

     

       75
       75
       +
                 let lon = Coordinate.longitude_to_float (Waypoint.get_lon wpt) in

     

       76
       76
       +
                 let attrs = [

     

       77
       77
       +
                   (("", "lat"), Printf.sprintf "%.6f" lat);

     

       78
       78
       +
                   (("", "lon"), Printf.sprintf "%.6f" lon);

     

       79
       79
       +
                 ] in

     

       80
       80
       +
                 let* () = output_element_start writer "wpt" attrs in

     

       81
       81
       +
                 let* () = output_optional_text_element writer "name" (Waypoint.get_name wpt) in

     

       82
       82
       +
                 let* () = output_optional_text_element writer "desc" (Waypoint.get_description wpt) in

     

       83
       83
       +
                 let* () = output_element_end writer in

     

       84
       84
       +
                 write_waypoints rest

     

       85
       85
       +
             in

     

       86
       86
       +
             let* () = write_waypoints waypoints in

     

       87
       87
       +
             

     

       88
       88
       +
             output_element_end writer

     

       89
       89
       +
             

     

       90
       90
       +
           with

     

       91
       91
       +
           | Xmlm.Error ((line, col), error) ->

     

       92
       92
       +
             Error (Error.xml_error (Printf.sprintf "XML error at line %d, column %d: %s"

     

       93
       93
       +
                              line col (Xmlm.error_message error)))

     

       94
       94
       +
           | exn ->

     

       95
       95
       +
             Error (Error.xml_error (Printexc.to_string exn))

     

       264
       96
        
         in

     

       265
       265
       -
         let* () = (if trkseg.extensions <> [] then

     

       266
       266
       -
                    let* () = output_element_start writer "extensions" [] in

     

       267
       267
       -
                    let* () = write_extensions writer trkseg.extensions in

     

       268
       268
       -
                    output_element_end writer

     

       269
       269
       -
                  else Ok ()) in

     

       270
       270
       -
         output_element_end writer

     

       271
       271
       -
       

     

       272
       272
       -
       (** Write track *)

     

       273
       273
       -
       let write_track writer track =

     

       274
       274
       -
         let* () = output_element_start writer "trk" [] in

     

       275
       275
       -
         let* () = output_optional_text_element writer "name" track.name in

     

       276
       276
       -
         let* () = output_optional_text_element writer "cmt" track.cmt in

     

       277
       277
       -
         let* () = output_optional_text_element writer "desc" track.desc in

     

       278
       278
       -
         let* () = output_optional_text_element writer "src" track.src in

     

       279
       279
       -
         let* () = write_links writer track.links in

     

       280
       280
       -
         let* () = output_optional_int_element writer "number" track.number in

     

       281
       281
       -
         let* () = output_optional_text_element writer "type" track.type_ in

     

       282
       282
       -
         let* () = (if track.extensions <> [] then

     

       283
       283
       -
                    let* () = output_element_start writer "extensions" [] in

     

       284
       284
       -
                    let* () = write_extensions writer track.extensions in

     

       285
       285
       -
                    output_element_end writer

     

       286
       286
       -
                  else Ok ()) in

     

       287
       287
       -
         let* () = 

     

       288
       288
       -
           let rec loop = function

     

       289
       289
       -
             | [] -> Ok ()

     

       290
       290
       -
             | trkseg :: rest ->

     

       291
       291
       -
               let* () = write_track_segment writer trkseg in

     

       292
       292
       -
               loop rest

     

       293
       293
       -
           in

     

       294
       294
       -
           loop track.trksegs

     

       295
       295
       -
         in

     

       296
       296
       -
         output_element_end writer

     

       297
       297
       -
       

     

       298
       298
       -
       (** Write complete GPX document *)

     

       299
       299
       -
       let write_gpx writer gpx =

     

       300
       300
       -
         let* () = write_header writer in

     

       301
       301
       -
         let attrs = [

     

       302
       302
       -
           (("", "version"), gpx.version);

     

       303
       303
       -
           (("", "creator"), gpx.creator);

     

       304
       304
       -
           (("", "xmlns"), "http://www.topografix.com/GPX/1/1");

     

       305
       305
       -
           (("http://www.w3.org/2000/xmlns/", "xsi"), "http://www.w3.org/2001/XMLSchema-instance");

     

       306
       306
       -
           (("http://www.w3.org/2001/XMLSchema-instance", "schemaLocation"), "http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd");

     

       307
       307
       -
         ] in

     

       308
       308
       -
         let* () = output_element_start writer "gpx" attrs in

     

       309
       309
       -
         let* () = (match gpx.metadata with

     

       310
       310
       -
                    | Some metadata -> write_metadata writer metadata

     

       311
       311
       -
                    | None -> Ok ()) in

     

       312
       312
       -
         let* () = 

     

       313
       313
       -
           let rec loop = function

     

       314
       314
       -
             | [] -> Ok ()

     

       315
       315
       -
             | wpt :: rest ->

     

       316
       316
       -
               let* () = write_waypoint writer wpt in

     

       317
       317
       -
               loop rest

     

       318
       318
       -
           in

     

       319
       319
       -
           loop gpx.waypoints

     

       320
       320
       -
         in

     

       321
       321
       -
         let* () = 

     

       322
       322
       -
           let rec loop = function

     

       323
       323
       -
             | [] -> Ok ()

     

       324
       324
       -
             | rte :: rest ->

     

       325
       325
       -
               let* () = write_route writer rte in

     

       326
       326
       -
               loop rest

     

       327
       327
       -
           in

     

       328
       328
       -
           loop gpx.routes

     

       329
       329
       -
         in

     

       330
       330
       -
         let* () = 

     

       331
       331
       -
           let rec loop = function

     

       332
       332
       -
             | [] -> Ok ()

     

       333
       333
       -
             | trk :: rest ->

     

       334
       334
       -
               let* () = write_track writer trk in

     

       335
       335
       -
               loop rest

     

       336
       336
       -
           in

     

       337
       337
       -
           loop gpx.tracks

     

       338
       338
       -
         in

     

       339
       339
       -
         let* () = (if gpx.extensions <> [] then

     

       340
       340
       -
                    let* () = output_element_start writer "extensions" [] in

     

       341
       341
       -
                    let* () = write_extensions writer gpx.extensions in

     

       342
       342
       -
                    output_element_end writer

     

       343
       343
       -
                  else Ok ()) in

     

       344
       344
       -
         output_element_end writer

     

       345
       345
       -
       

     

       346
       346
       -
       (** Main writing function *)

     

       347
       347
       -
       let write ?(validate=false) output gpx =

     

       348
       348
       -
         if validate then (

     

       97
       97
       +
         

     

       98
       98
       +
         match result, validate with

     

       99
       99
       +
         | Ok (), true ->

     

       349
       100
        
           let validation = Validate.validate_gpx gpx in

     

       350
       350
       -
           if not validation.is_valid then

     

       101
       101
       +
           if validation.is_valid then

     

       102
       102
       +
             Ok ()

     

       103
       103
       +
           else

     

       351
       104
        
             let error_msgs = List.filter (fun issue -> issue.Validate.level = `Error) validation.issues

     

       352
       105
        
                             |> List.map (fun issue -> issue.Validate.message)

     

       353
       106
        
                             |> String.concat "; " in

     

       354
       354
       -
             Error (Validation_error error_msgs)

     

       355
       355
       -
           else

     

       356
       356
       -
             let writer = make_writer output in

     

       357
       357
       -
             write_gpx writer gpx

     

       358
       358
       -
         ) else (

     

       359
       359
       -
           let writer = make_writer output in

     

       360
       360
       -
           write_gpx writer gpx

     

       361
       361
       -
         )

     

       107
       107
       +
             Error (Error.validation_error error_msgs)

     

       108
       108
       +
         | result, false -> result

     

       109
       109
       +
         | Error _ as result, true -> result (* Pass through write errors even when validating *)

     

       362
       110
        
       

     

       363
       363
       -
       (** Write to string *)

     

       111
       111
       +
       (** Write GPX to string *)

     

       364
       112
        
       let write_string ?(validate=false) gpx =

     

       365
       113
        
         let buffer = Buffer.create 1024 in

     

       366
       366
       -
         let output = Xmlm.make_output (`Buffer buffer) in

     

       367
       367
       -
         let result = write ~validate output gpx in

     

       368
       368
       -
         match result with

     

       369
       369
       -
         | Ok () -> Ok (Buffer.contents buffer)

     

       370
       370
       -
         | Error e -> Error e
     

       114
       114
       +
         let dest = `Buffer buffer in

     

       115
       115
       +
         let* () = write ~validate dest gpx in

     

       116
       116
       +
         Ok (Buffer.contents buffer)

+2 -4

lib/gpx/writer.mli

···

       1
       1
        
       (** GPX streaming writer using xmlm *)

     

       2
       2
        
       

     

       3
       3
       -
       open Types

     

       4
       4
       -
       

     

       5
       3
        
       (** Write a GPX document to an xmlm output destination *)

     

       6
       6
       -
       val write : ?validate:bool -> Xmlm.output -> gpx -> unit result

     

       4
       4
       +
       val write : ?validate:bool -> Xmlm.dest -> Gpx_doc.t -> (unit, Error.t) result

     

       7
       5
        
       

     

       8
       6
        
       (** Write a GPX document to a string *)

     

       9
       9
       -
       val write_string : ?validate:bool -> gpx -> string result
     

       7
       7
       +
       val write_string : ?validate:bool -> Gpx_doc.t -> (string, Error.t) result

+43 -10

lib/gpx_eio/gpx_eio.ml

···

       21
       21
        
       let to_sink ?(validate=false) sink gpx = IO.write_sink ~validate sink gpx

     

       22
       22
        
       

     

       23
       23
        
       (** Create simple waypoint *)

     

       24
       24
       -
       let make_waypoint ~fs:_ = Gpx.make_waypoint_from_floats

     

       24
       24
       +
       let make_waypoint ~fs:_ ~lat ~lon ?name ?desc () =

     

       25
       25
       +
         match (Gpx.Coordinate.latitude lat, Gpx.Coordinate.longitude lon) with

     

       26
       26
       +
         | (Ok lat, Ok lon) ->

     

       27
       27
       +
           let wpt = Gpx.Waypoint.make lat lon in

     

       28
       28
       +
           Gpx.Waypoint.with_name wpt (Option.value name ~default:"") |>

     

       29
       29
       +
           fun wpt -> Gpx.Waypoint.with_description wpt (Option.value desc ~default:"")

     

       30
       30
       +
         | (Error e, _) | (_, Error e) -> failwith ("Invalid coordinate: " ^ e)

     

       25
       31
        
       

     

       26
       32
        
       (** Create simple track from coordinate list *)

     

       27
       27
       -
       let make_track_from_coords ~fs:_ = Gpx.make_track_from_coord_list

     

       33
       33
       +
       let make_track_from_coords ~fs:_ ~name coords = 

     

       34
       34
       +
         Gpx.Track.make_from_coords ~name coords

     

       28
       35
        
       

     

       29
       36
        
       (** Create simple route from coordinate list *)

     

       30
       30
       -
       let make_route_from_coords ~fs:_ = Gpx.make_route_from_coord_list

     

       37
       37
       +
       let make_route_from_coords ~fs:_ ~name coords = 

     

       38
       38
       +
         Gpx.Route.make_from_coords ~name coords

     

       31
       39
        
       

     

       32
       40
        
       (** Extract coordinates from waypoints *)

     

       33
       33
       -
       let waypoint_coords = Gpx.waypoint_coords

     

       41
       41
       +
       let waypoint_coords wpt = Gpx.Waypoint.to_floats wpt

     

       34
       42
        
       

     

       35
       43
        
       (** Extract coordinates from track *)

     

       36
       36
       -
       let track_coords = Gpx.track_coords

     

       44
       44
       +
       let track_coords trk = Gpx.Track.to_coords trk

     

       37
       45
        
       

     

       38
       46
        
       (** Extract coordinates from route *)

     

       39
       39
       -
       let route_coords = Gpx.route_coords

     

       47
       47
       +
       let route_coords rte = Gpx.Route.to_coords rte

     

       40
       48
        
       

     

       41
       49
        
       (** Count total points in GPX *)

     

       42
       42
       -
       let count_points = Gpx.count_points

     

       50
       50
       +
       let count_points gpx = 

     

       51
       51
       +
         let waypoints = Gpx.Gpx_doc.get_waypoints gpx in

     

       52
       52
       +
         let routes = Gpx.Gpx_doc.get_routes gpx in  

     

       53
       53
       +
         let tracks = Gpx.Gpx_doc.get_tracks gpx in

     

       54
       54
       +
         List.length waypoints + 

     

       55
       55
       +
         List.fold_left (fun acc r -> acc + List.length (Gpx.Route.get_points r)) 0 routes +

     

       56
       56
       +
         List.fold_left (fun acc t -> acc + Gpx.Track.point_count t) 0 tracks

     

       43
       57
        
       

     

       44
       58
        
       (** Get GPX statistics *)

     

       45
       45
       -
       type gpx_stats = Gpx.gpx_stats = {

     

       59
       59
       +
       type gpx_stats = {

     

       46
       60
        
         waypoint_count : int;

     

       47
       61
        
         route_count : int;

     

       48
       62
        
         track_count : int;

     
···

       51
       65
        
         has_time : bool;

     

       52
       66
        
       }

     

       53
       67
        
       

     

       54
       54
       -
       let get_stats = Gpx.get_stats

     

       68
       68
       +
       let get_stats gpx =

     

       69
       69
       +
         let waypoints = Gpx.Gpx_doc.get_waypoints gpx in

     

       70
       70
       +
         let routes = Gpx.Gpx_doc.get_routes gpx in  

     

       71
       71
       +
         let tracks = Gpx.Gpx_doc.get_tracks gpx in

     

       72
       72
       +
         {

     

       73
       73
       +
           waypoint_count = List.length waypoints;

     

       74
       74
       +
           route_count = List.length routes;

     

       75
       75
       +
           track_count = List.length tracks;  

     

       76
       76
       +
           total_points = count_points gpx;

     

       77
       77
       +
           has_elevation = List.exists (fun w -> Gpx.Waypoint.get_elevation w <> None) waypoints;

     

       78
       78
       +
           has_time = List.exists (fun w -> Gpx.Waypoint.get_time w <> None) waypoints;

     

       79
       79
       +
         }

     

       55
       80
        
       

     

       56
       81
        
       (** Pretty print GPX statistics *)

     

       57
       57
       -
       let print_stats = Gpx.print_stats
     

       82
       82
       +
       let print_stats gpx =

     

       83
       83
       +
         let stats = get_stats gpx in

     

       84
       84
       +
         Printf.printf "GPX Statistics:\\n";

     

       85
       85
       +
         Printf.printf "  Waypoints: %d\\n" stats.waypoint_count;

     

       86
       86
       +
         Printf.printf "  Routes: %d\\n" stats.route_count;

     

       87
       87
       +
         Printf.printf "  Tracks: %d\\n" stats.track_count;

     

       88
       88
       +
         Printf.printf "  Total Points: %d\\n" stats.total_points;

     

       89
       89
       +
         Printf.printf "  Has Elevation: %b\\n" stats.has_elevation;

     

       90
       90
       +
         Printf.printf "  Has Time: %b\\n" stats.has_time

+15 -15

lib/gpx_eio/gpx_eio.mli

···

       44
       44
        
           @param ?validate Optional validation flag (default: false)

     

       45
       45
        
           @return GPX document

     

       46
       46
        
           @raises Gpx.Gpx_error on read or parse failure *)

     

       47
       47
       -
       val read : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx

     

       47
       47
       +
       val read : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.t

     

       48
       48
        
       

     

       49
       49
        
       (** Write GPX to file.

     

       50
       50
        
           @param fs Filesystem capability

     
···

       52
       52
        
           @param gpx GPX document to write

     

       53
       53
        
           @param ?validate Optional validation flag (default: false)

     

       54
       54
        
           @raises Gpx.Gpx_error on write failure *)

     

       55
       55
       -
       val write : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> unit

     

       55
       55
       +
       val write : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.t -> unit

     

       56
       56
        
       

     

       57
       57
        
       (** Write GPX to file with automatic backup.

     

       58
       58
        
           @param fs Filesystem capability

     
···

       61
       61
        
           @param ?validate Optional validation flag (default: false)

     

       62
       62
        
           @return Backup file path (empty if no backup created)

     

       63
       63
        
           @raises Gpx.Gpx_error on failure *)

     

       64
       64
       -
       val write_with_backup : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> string

     

       64
       64
       +
       val write_with_backup : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.t -> string

     

       65
       65
        
       

     

       66
       66
        
       (** {2 Stream Operations}

     

       67
       67
        
       

     
···

       72
       72
        
           @param ?validate Optional validation flag (default: false)

     

       73
       73
        
           @return GPX document

     

       74
       74
        
           @raises Gpx.Gpx_error on read or parse failure *)

     

       75
       75
       -
       val from_source : ?validate:bool -> [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.gpx

     

       75
       75
       +
       val from_source : ?validate:bool -> [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.t

     

       76
       76
        
       

     

       77
       77
        
       (** Write GPX to Eio sink.

     

       78
       78
        
           @param sink Output flow

     

       79
       79
        
           @param gpx GPX document

     

       80
       80
        
           @param ?validate Optional validation flag (default: false)

     

       81
       81
        
           @raises Gpx.Gpx_error on write failure *)

     

       82
       82
       -
       val to_sink : ?validate:bool -> [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.gpx -> unit

     

       82
       82
       +
       val to_sink : ?validate:bool -> [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.t -> unit

     

       83
       83
        
       

     

       84
       84
        
       (** {2 Utility Functions} *)

     

       85
       85
        
       

     
···

       91
       91
        
           @param ?desc Optional waypoint description

     

       92
       92
        
           @return Waypoint data

     

       93
       93
        
           @raises Gpx.Gpx_error on invalid coordinates *)

     

       94
       94
       -
       val make_waypoint : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> lat:float -> lon:float -> ?name:string -> ?desc:string -> unit -> Gpx.waypoint_data

     

       94
       94
       +
       val make_waypoint : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> lat:float -> lon:float -> ?name:string -> ?desc:string -> unit -> Gpx.Waypoint.t

     

       95
       95
        
       

     

       96
       96
        
       (** Create track from coordinate list.

     

       97
       97
        
           @param fs Filesystem capability (unused, for API consistency)

     
···

       99
       99
        
           @param coords List of (latitude, longitude) pairs

     

       100
       100
        
           @return Track with single segment

     

       101
       101
        
           @raises Gpx.Gpx_error on invalid coordinates *)

     

       102
       102
       -
       val make_track_from_coords : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> name:string -> (float * float) list -> Gpx.track

     

       102
       102
       +
       val make_track_from_coords : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> name:string -> (float * float) list -> Gpx.Track.t

     

       103
       103
        
       

     

       104
       104
        
       (** Create route from coordinate list.

     

       105
       105
        
           @param fs Filesystem capability (unused, for API consistency)

     
···

       107
       107
        
           @param coords List of (latitude, longitude) pairs

     

       108
       108
        
           @return Route

     

       109
       109
        
           @raises Gpx.Gpx_error on invalid coordinates *)

     

       110
       110
       -
       val make_route_from_coords : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> name:string -> (float * float) list -> Gpx.route

     

       110
       110
       +
       val make_route_from_coords : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> name:string -> (float * float) list -> Gpx.Route.t

     

       111
       111
        
       

     

       112
       112
        
       (** Extract coordinates from waypoint.

     

       113
       113
        
           @param wpt Waypoint data

     

       114
       114
        
           @return (latitude, longitude) as floats *)

     

       115
       115
       -
       val waypoint_coords : Gpx.waypoint_data -> float * float

     

       115
       115
       +
       val waypoint_coords : Gpx.Waypoint.t -> float * float

     

       116
       116
        
       

     

       117
       117
        
       (** Extract coordinates from track.

     

       118
       118
        
           @param track Track

     

       119
       119
        
           @return List of (latitude, longitude) pairs *)

     

       120
       120
       -
       val track_coords : Gpx.track -> (float * float) list

     

       120
       120
       +
       val track_coords : Gpx.Track.t -> (float * float) list

     

       121
       121
        
       

     

       122
       122
        
       (** Extract coordinates from route.

     

       123
       123
        
           @param route Route

     

       124
       124
        
           @return List of (latitude, longitude) pairs *)

     

       125
       125
       -
       val route_coords : Gpx.route -> (float * float) list

     

       125
       125
       +
       val route_coords : Gpx.Route.t -> (float * float) list

     

       126
       126
        
       

     

       127
       127
        
       (** Count total points in GPX document.

     

       128
       128
        
           @param gpx GPX document

     

       129
       129
        
           @return Total number of waypoints, route points, and track points *)

     

       130
       130
       -
       val count_points : Gpx.gpx -> int

     

       130
       130
       +
       val count_points : Gpx.t -> int

     

       131
       131
        
       

     

       132
       132
        
       (** GPX statistics record *)

     

       133
       133
       -
       type gpx_stats = Gpx.gpx_stats = {

     

       133
       133
       +
       type gpx_stats = {

     

       134
       134
        
         waypoint_count : int;      (** Number of waypoints *)

     

       135
       135
        
         route_count : int;         (** Number of routes *)

     

       136
       136
        
         track_count : int;         (** Number of tracks *)

     
···

       142
       142
        
       (** Get GPX document statistics.

     

       143
       143
        
           @param gpx GPX document

     

       144
       144
        
           @return Statistics summary *)

     

       145
       145
       -
       val get_stats : Gpx.gpx -> gpx_stats

     

       145
       145
       +
       val get_stats : Gpx.t -> gpx_stats

     

       146
       146
        
       

     

       147
       147
        
       (** Print GPX statistics to stdout.

     

       148
       148
        
           @param gpx GPX document *)

     

       149
       149
       -
       val print_stats : Gpx.gpx -> unit

     

       149
       149
       +
       val print_stats : Gpx.t -> unit

+1 -1

lib/gpx_eio/gpx_io.ml

···

       44
       44
        
           let stat = Eio.Path.stat ~follow:true Eio.Path.(fs / path) in

     

       45
       45
        
           Optint.Int63.to_int stat.size

     

       46
       46
        
         with

     

       47
       47
       -
         | exn -> raise (Gpx.Gpx_error (Gpx.IO_error (Printexc.to_string exn)))

     

       47
       47
       +
         | exn -> raise (Gpx.Gpx_error (Gpx.Error.io_error (Printexc.to_string exn)))

     

       48
       48
        
       

     

       49
       49
        
       (** Create backup of existing file *)

     

       50
       50
        
       let create_backup ~fs path =

+5 -5

lib/gpx_eio/gpx_io.mli

···

       12
       12
        
           @param path File path to read

     

       13
       13
        
           @param ?validate Optional validation flag (default: false)

     

       14
       14
        
           @return GPX document or error *)

     

       15
       15
       -
       val read_file : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx

     

       15
       15
       +
       val read_file : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.t

     

       16
       16
        
       

     

       17
       17
        
       (** Write GPX to file path.

     

       18
       18
        
           @param fs Filesystem capability  

     
···

       20
       20
        
           @param gpx GPX document to write

     

       21
       21
        
           @param ?validate Optional validation flag (default: false)

     

       22
       22
        
           @raises Gpx.Gpx_error on write failure *)

     

       23
       23
       -
       val write_file : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> unit

     

       23
       23
       +
       val write_file : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.t -> unit

     

       24
       24
        
       

     

       25
       25
        
       (** {1 Stream Operations}

     

       26
       26
        
       

     
···

       30
       30
        
           @param source Input flow to read from

     

       31
       31
        
           @param ?validate Optional validation flag (default: false)

     

       32
       32
        
           @return GPX document *)

     

       33
       33
       -
       val read_source : ?validate:bool -> [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.gpx

     

       33
       33
       +
       val read_source : ?validate:bool -> [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.t

     

       34
       34
        
       

     

       35
       35
        
       (** Write GPX to Eio sink.

     

       36
       36
        
           @param sink Output flow to write to

     

       37
       37
        
           @param gpx GPX document to write

     

       38
       38
        
           @param ?validate Optional validation flag (default: false) *)

     

       39
       39
       -
       val write_sink : ?validate:bool -> [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.gpx -> unit

     

       39
       39
       +
       val write_sink : ?validate:bool -> [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.t -> unit

     

       40
       40
        
       

     

       41
       41
        
       (** {1 Utility Functions} *)

     

       42
       42
        
       

     
···

       65
       65
        
           @param gpx GPX document to write

     

       66
       66
        
           @param ?validate Optional validation flag (default: false)

     

       67
       67
        
           @return Backup file path (empty string if no backup needed) *)

     

       68
       68
       -
       val write_file_with_backup : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> string

     

       68
       68
       +
       val write_file_with_backup : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.t -> string

+12 -14

lib/gpx_unix/gpx_io.ml

···

       1
       1
        
       (** GPX Unix I/O operations *)

     

       2
       2
        
       

     

       3
       3
       -
       open Gpx.Types

     

       4
       3
        
       

     

       5
       4
        
       (** Result binding operators *)

     

       6
       5
        
       let (let*) = Result.bind

     
···

       10
       9
        
         try

     

       11
       10
        
           let ic = open_in filename in

     

       12
       11
        
           let input = Xmlm.make_input (`Channel ic) in

     

       13
       13
       -
           let result = Gpx.Parser.parse ~validate input in

     

       12
       12
       +
           let result = Gpx.parse ~validate input in

     

       14
       13
        
           close_in ic;

     

       15
       14
        
           result

     

       16
       15
        
         with

     

       17
       17
       -
         | Sys_error msg -> Error (IO_error msg)

     

       18
       18
       -
         | exn -> Error (IO_error (Printexc.to_string exn))

     

       16
       16
       +
         | Sys_error msg -> Error (Gpx.Error.io_error msg)

     

       17
       17
       +
         | exn -> Error (Gpx.Error.io_error (Printexc.to_string exn))

     

       19
       18
        
       

     

       20
       19
        
       (** Write GPX to file *)

     

       21
       20
        
       let write_file ?(validate=false) filename gpx =

     

       22
       21
        
         try

     

       23
       22
        
           let oc = open_out filename in

     

       24
       24
       -
           let output = Xmlm.make_output (`Channel oc) in

     

       25
       25
       -
           let result = Gpx.Writer.write ~validate output gpx in

     

       23
       23
       +
           let dest = `Channel oc in

     

       24
       24
       +
           let result = Gpx.write ~validate dest gpx in

     

       26
       25
        
           close_out oc;

     

       27
       26
        
           result

     

       28
       27
        
         with

     

       29
       29
       -
         | Sys_error msg -> Error (IO_error msg)

     

       30
       30
       -
         | exn -> Error (IO_error (Printexc.to_string exn))

     

       28
       28
       +
         | Sys_error msg -> Error (Gpx.Error.io_error msg)

     

       29
       29
       +
         | exn -> Error (Gpx.Error.io_error (Printexc.to_string exn))

     

       31
       30
        
       

     

       32
       31
        
       (** Read GPX from stdin *)

     

       33
       32
        
       let read_stdin ?(validate=false) () =

     

       34
       33
        
         let input = Xmlm.make_input (`Channel stdin) in

     

       35
       35
       -
         Gpx.Parser.parse ~validate input

     

       34
       34
       +
         Gpx.parse ~validate input

     

       36
       35
        
       

     

       37
       36
        
       (** Write GPX to stdout *)

     

       38
       37
        
       let write_stdout ?(validate=false) gpx =

     

       39
       39
       -
         let output = Xmlm.make_output (`Channel stdout) in

     

       40
       40
       -
         Gpx.Writer.write ~validate output gpx

     

       38
       38
       +
         Gpx.write ~validate (`Channel stdout) gpx

     

       41
       39
        
       

     

       42
       40
        
       (** Check if file exists and is readable *)

     

       43
       41
        
       let file_exists filename =

     
···

       54
       52
        
           Ok stats.st_size

     

       55
       53
        
         with

     

       56
       54
        
         | Unix.Unix_error (errno, _, _) -> 

     

       57
       57
       -
           Error (IO_error (Unix.error_message errno))

     

       55
       55
       +
           Error (Gpx.Error.io_error (Unix.error_message errno))

     

       58
       56
        
       

     

       59
       57
        
       (** Create backup of file before overwriting *)

     

       60
       58
        
       let create_backup filename =

     
···

       73
       71
        
             close_out oc;

     

       74
       72
        
             Ok backup_name

     

       75
       73
        
           with

     

       76
       76
       -
           | Sys_error msg -> Error (IO_error msg)

     

       77
       77
       -
           | exn -> Error (IO_error (Printexc.to_string exn))

     

       74
       74
       +
           | Sys_error msg -> Error (Gpx.Error.io_error msg)

     

       75
       75
       +
           | exn -> Error (Gpx.Error.io_error (Printexc.to_string exn))

     

       78
       76
        
         else

     

       79
       77
        
           Ok ""

     

       80
       78

+8 -8

lib/gpx_unix/gpx_io.mli

···

       1
       1
        
       (** GPX Unix I/O operations *)

     

       2
       2
        
       

     

       3
       3
       -
       open Gpx.Types

     

       3
       3
       +
       open Gpx

     

       4
       4
        
       

     

       5
       5
        
       (** Read GPX from file *)

     

       6
       6
       -
       val read_file : ?validate:bool -> string -> gpx result

     

       6
       6
       +
       val read_file : ?validate:bool -> string -> (t, Gpx.error) result

     

       7
       7
        
       

     

       8
       8
        
       (** Write GPX to file *)

     

       9
       9
       -
       val write_file : ?validate:bool -> string -> gpx -> unit result

     

       9
       9
       +
       val write_file : ?validate:bool -> string -> t -> (unit, Gpx.error) result

     

       10
       10
        
       

     

       11
       11
        
       (** Read GPX from stdin *)

     

       12
       12
       -
       val read_stdin : ?validate:bool -> unit -> gpx result

     

       12
       12
       +
       val read_stdin : ?validate:bool -> unit -> (t, Gpx.error) result

     

       13
       13
        
       

     

       14
       14
        
       (** Write GPX to stdout *)

     

       15
       15
       -
       val write_stdout : ?validate:bool -> gpx -> unit result

     

       15
       15
       +
       val write_stdout : ?validate:bool -> t -> (unit, Gpx.error) result

     

       16
       16
        
       

     

       17
       17
        
       (** Check if file exists and is readable *)

     

       18
       18
        
       val file_exists : string -> bool

     

       19
       19
        
       

     

       20
       20
        
       (** Get file size *)

     

       21
       21
       -
       val file_size : string -> int result

     

       21
       21
       +
       val file_size : string -> (int, Gpx.error) result

     

       22
       22
        
       

     

       23
       23
        
       (** Create backup of file before overwriting *)

     

       24
       24
       -
       val create_backup : string -> string result

     

       24
       24
       +
       val create_backup : string -> (string, Gpx.error) result

     

       25
       25
        
       

     

       26
       26
        
       (** Write GPX to file with backup *)

     

       27
       27
       -
       val write_file_with_backup : ?validate:bool -> string -> gpx -> string result
     

       27
       27
       +
       val write_file_with_backup : ?validate:bool -> string -> t -> (string, Gpx.error) result

+42 -86

lib/gpx_unix/gpx_unix.ml

···

       3
       3
        
       (** Result binding operators *)

     

       4
       4
        
       let (let*) = Result.bind

     

       5
       5
        
       

     

       6
       6
       -
       (* Re-export core modules *)

     

       7
       7
       -
       module Types = Gpx.Types

     

       8
       8
       -
       module Parser = Gpx.Parser  

     

       9
       9
       -
       module Writer = Gpx.Writer

     

       10
       10
       -
       module Validate = Gpx.Validate

     

       6
       6
       +
       (* Re-export IO module *)

     

       11
       7
        
       module IO = Gpx_io

     

       12
       8
        
       

     

       13
       9
        
       (* Re-export common types *)

     

       14
       14
       -
       open Gpx.Types

     

       10
       10
       +
       open Gpx

     

       15
       11
        
       

     

       16
       12
        
       (** Convenience functions for common operations *)

     

       17
       13
        
       

     
···

       25
       21
        
       let write_with_backup = IO.write_file_with_backup

     

       26
       22
        
       

     

       27
       23
        
       (** Convert GPX to string *)

     

       28
       28
       -
       let to_string = Writer.write_string

     

       24
       24
       +
       let to_string = write_string

     

       29
       25
        
       

     

       30
       26
        
       (** Parse GPX from string *)

     

       31
       31
       -
       let from_string = Parser.parse_string

     

       27
       27
       +
       let from_string = parse_string

     

       32
       28
        
       

     

       33
       29
        
       (** Quick validation check *)

     

       34
       34
       -
       let is_valid = Validate.is_valid

     

       30
       30
       +
       let is_valid = is_valid

     

       35
       31
        
       

     

       36
       32
        
       (** Get validation issues *)

     

       37
       37
       -
       let validate = Validate.validate_gpx

     

       33
       33
       +
       let validate = validate_gpx

     

       38
       34
        
       

     

       39
       35
        
       (** Create simple waypoint *)

     

       40
       36
        
       let make_waypoint ~lat ~lon ?name ?desc () =

     

       41
       41
       -
         match (latitude lat, longitude lon) with

     

       37
       37
       +
         match (Coordinate.latitude lat, Coordinate.longitude lon) with

     

       42
       38
        
         | (Ok lat, Ok lon) ->

     

       43
       43
       -
           let wpt = make_waypoint_data lat lon in

     

       44
       44
       -
           Ok { wpt with name; desc }

     

       45
       45
       -
         | (Error e, _) | (_, Error e) -> Error (Invalid_coordinate e)

     

       39
       39
       +
           let wpt = Waypoint.make lat lon in

     

       40
       40
       +
           let wpt = match name with Some n -> Waypoint.with_name wpt n | None -> wpt in

     

       41
       41
       +
           let wpt = match desc with Some d -> Waypoint.with_description wpt d | None -> wpt in

     

       42
       42
       +
           Ok wpt

     

       43
       43
       +
         | (Error e, _) | (_, Error e) -> Error (Gpx.Error.invalid_coordinate e)

     

       46
       44
        
       

     

       47
       45
        
       (** Create simple track from coordinate list *)

     

       48
       46
        
       let make_track_from_coords ~name coords =

     

       49
       47
        
         let make_trkpt (lat, lon) =

     

       50
       50
       -
           match (latitude lat, longitude lon) with

     

       51
       51
       -
           | (Ok lat, Ok lon) -> Ok (make_waypoint_data lat lon)

     

       52
       52
       -
           | (Error e, _) | (_, Error e) -> Error (Invalid_coordinate e)

     

       48
       48
       +
           match (Coordinate.latitude lat, Coordinate.longitude lon) with

     

       49
       49
       +
           | (Ok lat, Ok lon) -> Ok (Waypoint.make lat lon)

     

       50
       50
       +
           | (Error e, _) | (_, Error e) -> Error (Gpx.Error.invalid_coordinate e)

     

       53
       51
        
         in

     

       54
       52
        
         let rec convert_coords acc = function

     

       55
       53
        
           | [] -> Ok (List.rev acc)

     
···

       58
       56
        
             | Ok trkpt -> convert_coords (trkpt :: acc) rest

     

       59
       57
        
             | Error e -> Error e

     

       60
       58
        
         in

     

       61
       61
       -
         let* trkpts = convert_coords [] coords in

     

       62
       62
       -
         let trkseg = { trkpts; extensions = [] } in

     

       63
       63
       -
         Ok {

     

       64
       64
       -
           name = Some name;

     

       65
       65
       -
           cmt = None; desc = None; src = None; links = [];

     

       66
       66
       -
           number = None; type_ = None; extensions = [];

     

       67
       67
       -
           trksegs = [trkseg];

     

       68
       68
       -
         }

     

       59
       59
       +
         let* _trkpts = convert_coords [] coords in

     

       60
       60
       +
         Ok (Track.make_from_coords ~name coords)

     

       69
       61
        
       

     

       70
       62
        
       (** Create simple route from coordinate list *)

     

       71
       63
        
       let make_route_from_coords ~name coords =

     

       72
       64
        
         let make_rtept (lat, lon) =

     

       73
       73
       -
           match (latitude lat, longitude lon) with

     

       74
       74
       -
           | (Ok lat, Ok lon) -> Ok (make_waypoint_data lat lon)

     

       75
       75
       -
           | (Error e, _) | (_, Error e) -> Error (Invalid_coordinate e)

     

       65
       65
       +
           match (Coordinate.latitude lat, Coordinate.longitude lon) with

     

       66
       66
       +
           | (Ok lat, Ok lon) -> Ok (Waypoint.make lat lon)

     

       67
       67
       +
           | (Error e, _) | (_, Error e) -> Error (Gpx.Error.invalid_coordinate e)

     

       76
       68
        
         in

     

       77
       69
        
         let rec convert_coords acc = function

     

       78
       70
        
           | [] -> Ok (List.rev acc)

     
···

       81
       73
        
             | Ok rtept -> convert_coords (rtept :: acc) rest

     

       82
       74
        
             | Error e -> Error e

     

       83
       75
        
         in

     

       84
       84
       -
         let* rtepts = convert_coords [] coords in

     

       85
       85
       -
         Ok {

     

       86
       86
       -
           name = Some name;

     

       87
       87
       -
           cmt = None; desc = None; src = None; links = [];

     

       88
       88
       -
           number = None; type_ = None; extensions = [];

     

       89
       89
       -
           rtepts;

     

       90
       90
       -
         }

     

       76
       76
       +
         let* _rtepts = convert_coords [] coords in

     

       77
       77
       +
         Ok (Route.make_from_coords ~name coords)

     

       91
       78
        
       

     

       92
       79
        
       (** Extract coordinates from waypoints *)

     

       93
       93
       -
       let waypoint_coords wpt =

     

       94
       94
       -
         (latitude_to_float wpt.lat, longitude_to_float wpt.lon)

     

       80
       80
       +
       let waypoint_coords wpt = Waypoint.to_floats wpt

     

       95
       81
        
       

     

       96
       82
        
       (** Extract coordinates from track *)

     

       97
       97
       -
       let track_coords track =

     

       98
       98
       -
         List.fold_left (fun acc trkseg ->

     

       99
       99
       -
           List.fold_left (fun acc trkpt ->

     

       100
       100
       -
             waypoint_coords trkpt :: acc

     

       101
       101
       -
           ) acc trkseg.trkpts

     

       102
       102
       -
         ) [] track.trksegs

     

       103
       103
       -
         |> List.rev

     

       83
       83
       +
       let track_coords track = Track.to_coords track

     

       104
       84
        
       

     

       105
       85
        
       (** Extract coordinates from route *)

     

       106
       106
       -
       let route_coords route =

     

       107
       107
       -
         List.map waypoint_coords route.rtepts

     

       86
       86
       +
       let route_coords route = Route.to_coords route

     

       108
       87
        
       

     

       109
       88
        
       (** Count total points in GPX *)

     

       110
       89
        
       let count_points gpx =

     

       111
       111
       -
         let waypoint_count = List.length gpx.waypoints in

     

       112
       112
       -
         let route_count = List.fold_left (fun acc route ->

     

       113
       113
       -
           acc + List.length route.rtepts

     

       114
       114
       -
         ) 0 gpx.routes in

     

       115
       115
       -
         let track_count = List.fold_left (fun acc track ->

     

       116
       116
       -
           List.fold_left (fun acc trkseg ->

     

       117
       117
       -
             acc + List.length trkseg.trkpts

     

       118
       118
       -
           ) acc track.trksegs

     

       119
       119
       -
         ) 0 gpx.tracks in

     

       120
       120
       -
         waypoint_count + route_count + track_count

     

       90
       90
       +
         let waypoints = Gpx_doc.get_waypoints gpx in

     

       91
       91
       +
         let routes = Gpx_doc.get_routes gpx in  

     

       92
       92
       +
         let tracks = Gpx_doc.get_tracks gpx in

     

       93
       93
       +
         List.length waypoints + 

     

       94
       94
       +
         List.fold_left (fun acc r -> acc + List.length (Route.get_points r)) 0 routes +

     

       95
       95
       +
         List.fold_left (fun acc t -> acc + Track.point_count t) 0 tracks

     

       121
       96
        
       

     

       122
       97
        
       (** Get GPX statistics *)

     

       123
       98
        
       type gpx_stats = {

     
···

       130
       105
        
       }

     

       131
       106
        
       

     

       132
       107
        
       let get_stats gpx =

     

       133
       133
       -
         let waypoint_count = List.length gpx.waypoints in

     

       134
       134
       -
         let route_count = List.length gpx.routes in

     

       135
       135
       -
         let track_count = List.length gpx.tracks in

     

       136
       136
       -
         let total_points = count_points gpx in

     

       137
       137
       -
         

     

       138
       138
       -
         let has_elevation = 

     

       139
       139
       -
           List.exists (fun wpt -> wpt.ele <> None) gpx.waypoints ||

     

       140
       140
       -
           List.exists (fun route -> 

     

       141
       141
       -
             List.exists (fun rtept -> rtept.ele <> None) route.rtepts

     

       142
       142
       -
           ) gpx.routes ||

     

       143
       143
       -
           List.exists (fun track ->

     

       144
       144
       -
             List.exists (fun trkseg ->

     

       145
       145
       -
               List.exists (fun trkpt -> trkpt.ele <> None) trkseg.trkpts

     

       146
       146
       -
             ) track.trksegs

     

       147
       147
       -
           ) gpx.tracks

     

       148
       148
       -
         in

     

       149
       149
       -
         

     

       150
       150
       -
         let has_time =

     

       151
       151
       -
           List.exists (fun wpt -> wpt.time <> None) gpx.waypoints ||

     

       152
       152
       -
           List.exists (fun route ->

     

       153
       153
       -
             List.exists (fun rtept -> rtept.time <> None) route.rtepts

     

       154
       154
       -
           ) gpx.routes ||

     

       155
       155
       -
           List.exists (fun track ->

     

       156
       156
       -
             List.exists (fun trkseg ->

     

       157
       157
       -
               List.exists (fun trkpt -> trkpt.time <> None) trkseg.trkpts

     

       158
       158
       -
             ) track.trksegs

     

       159
       159
       -
           ) gpx.tracks

     

       160
       160
       -
         in

     

       161
       161
       -
         

     

       162
       162
       -
         { waypoint_count; route_count; track_count; total_points; has_elevation; has_time }

     

       108
       108
       +
         let waypoints = Gpx_doc.get_waypoints gpx in

     

       109
       109
       +
         let routes = Gpx_doc.get_routes gpx in  

     

       110
       110
       +
         let tracks = Gpx_doc.get_tracks gpx in

     

       111
       111
       +
         {

     

       112
       112
       +
           waypoint_count = List.length waypoints;

     

       113
       113
       +
           route_count = List.length routes;

     

       114
       114
       +
           track_count = List.length tracks;  

     

       115
       115
       +
           total_points = count_points gpx;

     

       116
       116
       +
           has_elevation = List.exists (fun w -> Waypoint.get_elevation w <> None) waypoints;

     

       117
       117
       +
           has_time = List.exists (fun w -> Waypoint.get_time w <> None) waypoints;

     

       118
       118
       +
         }

     

       163
       119
        
       

     

       164
       120
        
       (** Pretty print GPX statistics *)

     

       165
       121
        
       let print_stats gpx =

+18 -22

lib/gpx_unix/gpx_unix.mli

···

       1
       1
        
       (** High-level Unix API for GPX operations *)

     

       2
       2
        
       

     

       3
       3
       -
       (* Re-export core modules *)

     

       4
       4
       -
       module Types = Gpx.Types

     

       5
       5
       -
       module Parser = Gpx.Parser

     

       6
       6
       -
       module Writer = Gpx.Writer

     

       7
       7
       -
       module Validate = Gpx.Validate

     

       3
       3
       +
       (* Re-export IO module *)

     

       8
       4
        
       module IO = Gpx_io

     

       9
       5
        
       

     

       10
       6
        
       (* Re-export common types *)

     

       11
       11
       -
       open Gpx.Types

     

       7
       7
       +
       open Gpx

     

       12
       8
        
       

     

       13
       9
        
       (** Convenience functions for common operations *)

     

       14
       10
        
       

     

       15
       11
        
       (** Read and parse GPX file *)

     

       16
       16
       -
       val read : ?validate:bool -> string -> gpx result

     

       12
       12
       +
       val read : ?validate:bool -> string -> (t, error) result

     

       17
       13
        
       

     

       18
       14
        
       (** Write GPX to file *)

     

       19
       19
       -
       val write : ?validate:bool -> string -> gpx -> unit result

     

       15
       15
       +
       val write : ?validate:bool -> string -> t -> (unit, error) result

     

       20
       16
        
       

     

       21
       17
        
       (** Write GPX to file with backup *)

     

       22
       22
       -
       val write_with_backup : ?validate:bool -> string -> gpx -> string result

     

       18
       18
       +
       val write_with_backup : ?validate:bool -> string -> t -> (string, error) result

     

       23
       19
        
       

     

       24
       20
        
       (** Convert GPX to string *)

     

       25
       25
       -
       val to_string : ?validate:bool -> gpx -> string result

     

       21
       21
       +
       val to_string : ?validate:bool -> t -> (string, error) result

     

       26
       22
        
       

     

       27
       23
        
       (** Parse GPX from string *)

     

       28
       28
       -
       val from_string : ?validate:bool -> string -> gpx result

     

       24
       24
       +
       val from_string : ?validate:bool -> string -> (t, error) result

     

       29
       25
        
       

     

       30
       26
        
       (** Quick validation check *)

     

       31
       31
       -
       val is_valid : gpx -> bool

     

       27
       27
       +
       val is_valid : t -> bool

     

       32
       28
        
       

     

       33
       29
        
       (** Get validation issues *)

     

       34
       34
       -
       val validate : gpx -> Gpx.Validate.validation_result

     

       30
       30
       +
       val validate : t -> validation_result

     

       35
       31
        
       

     

       36
       32
        
       (** Create simple waypoint *)

     

       37
       37
       -
       val make_waypoint : lat:float -> lon:float -> ?name:string -> ?desc:string -> unit -> waypoint result

     

       33
       33
       +
       val make_waypoint : lat:float -> lon:float -> ?name:string -> ?desc:string -> unit -> (Waypoint.t, error) result

     

       38
       34
        
       

     

       39
       35
        
       (** Create simple track from coordinate list *)

     

       40
       40
       -
       val make_track_from_coords : name:string -> (float * float) list -> track result

     

       36
       36
       +
       val make_track_from_coords : name:string -> (float * float) list -> (Track.t, error) result

     

       41
       37
        
       

     

       42
       38
        
       (** Create simple route from coordinate list *)

     

       43
       43
       -
       val make_route_from_coords : name:string -> (float * float) list -> route result

     

       39
       39
       +
       val make_route_from_coords : name:string -> (float * float) list -> (Route.t, error) result

     

       44
       40
        
       

     

       45
       41
        
       (** Extract coordinates from waypoints *)

     

       46
       46
       -
       val waypoint_coords : waypoint_data -> float * float

     

       42
       42
       +
       val waypoint_coords : Waypoint.t -> float * float

     

       47
       43
        
       

     

       48
       44
        
       (** Extract coordinates from track *)

     

       49
       49
       -
       val track_coords : track -> (float * float) list

     

       45
       45
       +
       val track_coords : Track.t -> (float * float) list

     

       50
       46
        
       

     

       51
       47
        
       (** Extract coordinates from route *)

     

       52
       52
       -
       val route_coords : route -> (float * float) list

     

       48
       48
       +
       val route_coords : Route.t -> (float * float) list

     

       53
       49
        
       

     

       54
       50
        
       (** Count total points in GPX *)

     

       55
       55
       -
       val count_points : gpx -> int

     

       51
       51
       +
       val count_points : t -> int

     

       56
       52
        
       

     

       57
       53
        
       (** GPX statistics *)

     

       58
       54
        
       type gpx_stats = {

     
···

       65
       61
        
       }

     

       66
       62
        
       

     

       67
       63
        
       (** Get GPX statistics *)

     

       68
       68
       -
       val get_stats : gpx -> gpx_stats

     

       64
       64
       +
       val get_stats : t -> gpx_stats

     

       69
       65
        
       

     

       70
       66
        
       (** Pretty print GPX statistics *)

     

       71
       71
       -
       val print_stats : gpx -> unit
     

       67
       67
       +
       val print_stats : t -> unit

+70 -55

test/test_corpus.ml

···

       20
       20
        
         let content = read_test_file "simple_waypoints.gpx" in

     

       21
       21
        
         match parse_string content with

     

       22
       22
        
         | Ok gpx ->

     

       23
       23
       -
           Printf.printf "Waypoints count: %d\n" (List.length gpx.waypoints);

     

       23
       23
       +
           let waypoints = Gpx_doc.get_waypoints gpx in

     

       24
       24
       +
           Printf.printf "Waypoints count: %d\n" (List.length waypoints);

     

       24
       25
        
           Printf.printf "First waypoint name: %s\n" 

     

       25
       25
       -
             (match gpx.waypoints with

     

       26
       26
       -
              | wpt :: _ -> (match wpt.name with Some n -> n | None -> "None")

     

       26
       26
       +
             (match waypoints with

     

       27
       27
       +
              | wpt :: _ -> (match Waypoint.get_name wpt with Some n -> n | None -> "None")

     

       27
       28
        
              | [] -> "None");

     

       28
       28
       -
           Printf.printf "Creator: %s\n" gpx.creator;

     

       29
       29
       +
           Printf.printf "Creator: %s\n" (Gpx_doc.get_creator gpx);

     

       29
       30
        
           [%expect {|

     

       30
       31
        
             Waypoints count: 3

     

       31
       32
        
             First waypoint name: San Francisco

     

       32
       33
        
             Creator: mlgpx test suite |}]

     

       33
       34
        
         | Error err ->

     

       34
       34
       -
           Printf.printf "Error: %s\n" (match err with

     

       35
       35
       -
             | Invalid_xml s -> "Invalid XML: " ^ s

     

       36
       36
       -
             | Invalid_coordinate s -> "Invalid coordinate: " ^ s

     

       37
       37
       -
             | _ -> "Other error");

     

       35
       35
       +
           Printf.printf "Error: %s\n" (Error.to_string err);

     

       38
       36
        
           [%expect.unreachable]

     

       39
       37
        
       

     

       40
       38
        
       let%expect_test "parse detailed waypoints" =

     

       41
       39
        
         let content = read_test_file "detailed_waypoints.gpx" in

     

       42
       40
        
         match parse_string content with

     

       43
       41
        
         | Ok gpx ->

     

       44
       44
       -
           Printf.printf "Waypoints count: %d\n" (List.length gpx.waypoints);

     

       42
       42
       +
           let waypoints = Gpx_doc.get_waypoints gpx in

     

       43
       43
       +
           let metadata = Gpx_doc.get_metadata gpx in

     

       44
       44
       +
           Printf.printf "Waypoints count: %d\n" (List.length waypoints);

     

       45
       45
        
           Printf.printf "Has metadata time: %b\n" 

     

       46
       46
       -
             (match gpx.metadata with Some md -> md.time <> None | None -> false);

     

       46
       46
       +
             (match metadata with Some md -> Metadata.get_time md <> None | None -> false);

     

       47
       47
        
           Printf.printf "Has bounds: %b\n" 

     

       48
       48
       -
             (match gpx.metadata with Some md -> md.bounds <> None | None -> false);

     

       49
       49
       -
           (match gpx.waypoints with

     

       48
       48
       +
             (match metadata with Some md -> Metadata.get_bounds md <> None | None -> false);

     

       49
       49
       +
           (match waypoints with

     

       50
       50
        
            | wpt :: _ ->

     

       51
       51
       -
              Printf.printf "First waypoint has elevation: %b\n" (wpt.ele <> None);

     

       52
       52
       -
              Printf.printf "First waypoint has time: %b\n" (wpt.time <> None);

     

       53
       53
       -
              Printf.printf "First waypoint has links: %b\n" (wpt.links <> [])

     

       51
       51
       +
              Printf.printf "First waypoint has elevation: %b\n" (Waypoint.get_elevation wpt <> None);

     

       52
       52
       +
              Printf.printf "First waypoint has time: %b\n" (Waypoint.get_time wpt <> None);

     

       53
       53
       +
              Printf.printf "First waypoint has links: %b\n" (Waypoint.get_links wpt <> [])

     

       54
       54
        
            | [] -> ());

     

       55
       55
        
           [%expect {|

     

       56
       56
        
             Waypoints count: 2

     
···

       67
       67
        
         let content = read_test_file "simple_route.gpx" in

     

       68
       68
        
         match parse_string content with

     

       69
       69
        
         | Ok gpx ->

     

       70
       70
       -
           Printf.printf "Routes count: %d\n" (List.length gpx.routes);

     

       71
       71
       -
           (match gpx.routes with

     

       70
       70
       +
           let routes = Gpx_doc.get_routes gpx in

     

       71
       71
       +
           Printf.printf "Routes count: %d\n" (List.length routes);

     

       72
       72
       +
           (match routes with

     

       72
       73
        
            | rte :: _ ->

     

       73
       74
        
              Printf.printf "Route name: %s\n" 

     

       74
       74
       -
                (match rte.name with Some n -> n | None -> "None");

     

       75
       75
       -
              Printf.printf "Route points count: %d\n" (List.length rte.rtepts);

     

       76
       76
       -
              Printf.printf "Route has number: %b\n" (rte.number <> None)

     

       75
       75
       +
                (match Route.get_name rte with Some n -> n | None -> "None");

     

       76
       76
       +
              Printf.printf "Route points count: %d\n" (Route.point_count rte);

     

       77
       77
       +
              Printf.printf "Route has number: %b\n" false (* TODO: add get_number to Route *)

     

       77
       78
        
            | [] -> ());

     

       78
       79
        
           [%expect {|

     

       79
       80
        
             Routes count: 1

     
···

       88
       89
        
         let content = read_test_file "simple_track.gpx" in

     

       89
       90
        
         match parse_string content with

     

       90
       91
        
         | Ok gpx ->

     

       91
       91
       -
           Printf.printf "Tracks count: %d\n" (List.length gpx.tracks);

     

       92
       92
       -
           (match gpx.tracks with

     

       92
       92
       +
           let tracks = Gpx_doc.get_tracks gpx in

     

       93
       93
       +
           Printf.printf "Tracks count: %d\n" (List.length tracks);

     

       94
       94
       +
           (match tracks with

     

       93
       95
        
            | trk :: _ ->

     

       94
       96
        
              Printf.printf "Track name: %s\n" 

     

       95
       95
       -
                (match trk.name with Some n -> n | None -> "None");

     

       96
       96
       -
              Printf.printf "Track segments: %d\n" (List.length trk.trksegs);

     

       97
       97
       -
              (match trk.trksegs with

     

       97
       97
       +
                (match Track.get_name trk with Some n -> n | None -> "None");

     

       98
       98
       +
              Printf.printf "Track segments: %d\n" (Track.segment_count trk);

     

       99
       99
       +
              let segments = Track.get_segments trk in

     

       100
       100
       +
              (match segments with

     

       98
       101
        
               | seg :: _ ->

     

       99
       99
       -
                 Printf.printf "First segment points: %d\n" (List.length seg.trkpts);

     

       100
       100
       -
                 (match seg.trkpts with

     

       102
       102
       +
                 Printf.printf "First segment points: %d\n" (Track.Segment.point_count seg);

     

       103
       103
       +
                 let points = Track.Segment.get_points seg in

     

       104
       104
       +
                 (match points with

     

       101
       105
        
                  | pt :: _ ->

     

       102
       102
       -
                    Printf.printf "First point has elevation: %b\n" (pt.ele <> None);

     

       103
       103
       -
                    Printf.printf "First point has time: %b\n" (pt.time <> None)

     

       106
       106
       +
                    Printf.printf "First point has elevation: %b\n" (Waypoint.get_elevation pt <> None);

     

       107
       107
       +
                    Printf.printf "First point has time: %b\n" (Waypoint.get_time pt <> None)

     

       104
       108
        
                  | [] -> ())

     

       105
       109
        
               | [] -> ())

     

       106
       110
        
            | [] -> ());

     
···

       119
       123
        
         let content = read_test_file "multi_segment_track.gpx" in

     

       120
       124
        
         match parse_string content with

     

       121
       125
        
         | Ok gpx ->

     

       122
       122
       -
           Printf.printf "Tracks count: %d\n" (List.length gpx.tracks);

     

       123
       123
       -
           (match gpx.tracks with

     

       126
       126
       +
           let tracks = Gpx_doc.get_tracks gpx in

     

       127
       127
       +
           Printf.printf "Tracks count: %d\n" (List.length tracks);

     

       128
       128
       +
           (match tracks with

     

       124
       129
        
            | trk :: _ ->

     

       125
       125
       -
              Printf.printf "Track segments: %d\n" (List.length trk.trksegs);

     

       126
       126
       -
              let total_points = List.fold_left (fun acc seg -> 

     

       127
       127
       -
                acc + List.length seg.trkpts) 0 trk.trksegs in

     

       130
       130
       +
              Printf.printf "Track segments: %d\n" (Track.segment_count trk);

     

       131
       131
       +
              let total_points = Track.point_count trk in

     

       128
       132
        
              Printf.printf "Total track points: %d\n" total_points

     

       129
       133
        
            | [] -> ());

     

       130
       134
        
           [%expect {|

     
···

       139
       143
        
         let content = read_test_file "comprehensive.gpx" in

     

       140
       144
        
         match parse_string content with

     

       141
       145
        
         | Ok gpx ->

     

       142
       142
       -
           Printf.printf "Waypoints: %d\n" (List.length gpx.waypoints);

     

       143
       143
       -
           Printf.printf "Routes: %d\n" (List.length gpx.routes);

     

       144
       144
       -
           Printf.printf "Tracks: %d\n" (List.length gpx.tracks);

     

       146
       146
       +
           let waypoints = Gpx_doc.get_waypoints gpx in

     

       147
       147
       +
           let routes = Gpx_doc.get_routes gpx in

     

       148
       148
       +
           let tracks = Gpx_doc.get_tracks gpx in

     

       149
       149
       +
           let metadata = Gpx_doc.get_metadata gpx in

     

       150
       150
       +
           Printf.printf "Waypoints: %d\n" (List.length waypoints);

     

       151
       151
       +
           Printf.printf "Routes: %d\n" (List.length routes);

     

       152
       152
       +
           Printf.printf "Tracks: %d\n" (List.length tracks);

     

       145
       153
        
           Printf.printf "Has author: %b\n" 

     

       146
       146
       -
             (match gpx.metadata with Some md -> md.author <> None | None -> false);

     

       154
       154
       +
             (match metadata with Some md -> Metadata.get_author md <> None | None -> false);

     

       147
       155
        
           Printf.printf "Has copyright: %b\n" 

     

       148
       148
       -
             (match gpx.metadata with Some md -> md.copyright <> None | None -> false);

     

       156
       156
       +
             (match metadata with Some md -> Metadata.get_copyright md <> None | None -> false);

     

       149
       157
        
           Printf.printf "Has keywords: %b\n" 

     

       150
       150
       -
             (match gpx.metadata with Some md -> md.keywords <> None | None -> false);

     

       158
       158
       +
             (match metadata with Some md -> Metadata.get_keywords md <> None | None -> false);

     

       151
       159
        
           [%expect {|

     

       152
       160
        
             Waypoints: 2

     

       153
       161
        
             Routes: 1

     
···

       164
       172
        
         match parse_string content with

     

       165
       173
        
         | Ok gpx ->

     

       166
       174
        
           Printf.printf "Minimal GPX parsed successfully\n";

     

       167
       167
       -
           Printf.printf "Waypoints: %d\n" (List.length gpx.waypoints);

     

       168
       168
       -
           Printf.printf "Routes: %d\n" (List.length gpx.routes);

     

       169
       169
       -
           Printf.printf "Tracks: %d\n" (List.length gpx.tracks);

     

       175
       175
       +
           let waypoints = Gpx_doc.get_waypoints gpx in

     

       176
       176
       +
           let routes = Gpx_doc.get_routes gpx in

     

       177
       177
       +
           let tracks = Gpx_doc.get_tracks gpx in

     

       178
       178
       +
           Printf.printf "Waypoints: %d\n" (List.length waypoints);

     

       179
       179
       +
           Printf.printf "Routes: %d\n" (List.length routes);

     

       180
       180
       +
           Printf.printf "Tracks: %d\n" (List.length tracks);

     

       170
       181
        
           [%expect {|

     

       171
       182
        
             Minimal GPX parsed successfully

     

       172
       183
        
             Waypoints: 1

     
···

       183
       194
        
         match parse_string content with

     

       184
       195
        
         | Ok gpx ->

     

       185
       196
        
           Printf.printf "Edge cases parsed successfully\n";

     

       186
       186
       -
           Printf.printf "Waypoints: %d\n" (List.length gpx.waypoints);

     

       187
       187
       -
           Printf.printf "Tracks: %d\n" (List.length gpx.tracks);

     

       197
       197
       +
           let waypoints = Gpx_doc.get_waypoints gpx in

     

       198
       198
       +
           let tracks = Gpx_doc.get_tracks gpx in

     

       199
       199
       +
           Printf.printf "Waypoints: %d\n" (List.length waypoints);

     

       200
       200
       +
           Printf.printf "Tracks: %d\n" (List.length tracks);

     

       188
       201
        
           (* Check coordinate ranges *)

     

       189
       202
        
           let check_coords () =

     

       190
       190
       -
             match gpx.waypoints with

     

       203
       203
       +
             match waypoints with

     

       191
       204
        
             | wpt1 :: wpt2 :: wpt3 :: _ ->

     

       192
       192
       -
               Printf.printf "South pole coords: %.1f, %.1f\n" 

     

       193
       193
       -
                 (latitude_to_float wpt1.lat) (longitude_to_float wpt1.lon);

     

       194
       194
       -
               Printf.printf "North pole coords: %.1f, %.6f\n" 

     

       195
       195
       -
                 (latitude_to_float wpt2.lat) (longitude_to_float wpt2.lon);

     

       196
       196
       -
               Printf.printf "Null island coords: %.1f, %.1f\n" 

     

       197
       197
       -
                 (latitude_to_float wpt3.lat) (longitude_to_float wpt3.lon);

     

       205
       205
       +
               let lat1, lon1 = Waypoint.to_floats wpt1 in

     

       206
       206
       +
               let lat2, lon2 = Waypoint.to_floats wpt2 in

     

       207
       207
       +
               let lat3, lon3 = Waypoint.to_floats wpt3 in

     

       208
       208
       +
               Printf.printf "South pole coords: %.1f, %.1f\n" lat1 lon1;

     

       209
       209
       +
               Printf.printf "North pole coords: %.1f, %.6f\n" lat2 lon2;

     

       210
       210
       +
               Printf.printf "Null island coords: %.1f, %.1f\n" lat3 lon3;

     

       198
       211
        
             | _ -> Printf.printf "Unexpected waypoint count\n"

     

       199
       212
        
           in

     

       200
       213
        
           check_coords ();

     
···

       232
       245
        
              (match parse_string xml_output with

     

       233
       246
        
               | Ok gpx2 ->

     

       234
       247
        
                 Printf.printf "Round-trip successful\n";

     

       235
       235
       -
                 Printf.printf "Original waypoints: %d\n" (List.length gpx.waypoints);

     

       236
       236
       -
                 Printf.printf "Round-trip waypoints: %d\n" (List.length gpx2.waypoints);

     

       237
       237
       -
                 Printf.printf "Creators match: %b\n" (gpx.creator = gpx2.creator);

     

       248
       248
       +
                 let waypoints = Gpx_doc.get_waypoints gpx in

     

       249
       249
       +
                 let waypoints2 = Gpx_doc.get_waypoints gpx2 in

     

       250
       250
       +
                 Printf.printf "Original waypoints: %d\n" (List.length waypoints);

     

       251
       251
       +
                 Printf.printf "Round-trip waypoints: %d\n" (List.length waypoints2);

     

       252
       252
       +
                 Printf.printf "Creators match: %b\n" (Gpx_doc.get_creator gpx = Gpx_doc.get_creator gpx2);

     

       238
       253
        
                 [%expect {|

     

       239
       254
        
                   Round-trip successful

     

       240
       255
        
                   Original waypoints: 3

+17 -35

test/test_corpus_unix_eio.ml

···

       18
       18
        
       (** Helper to compare GPX documents *)

     

       19
       19
        
       let compare_gpx_basic gpx1 gpx2 =

     

       20
       20
        
         let open Gpx in

     

       21
       21
       -
         gpx1.creator = gpx2.creator &&

     

       22
       22
       -
         List.length gpx1.waypoints = List.length gpx2.waypoints &&

     

       23
       23
       -
         List.length gpx1.routes = List.length gpx2.routes &&

     

       24
       24
       -
         List.length gpx1.tracks = List.length gpx2.tracks

     

       21
       21
       +
         Gpx_doc.get_creator gpx1 = Gpx_doc.get_creator gpx2 &&

     

       22
       22
       +
         List.length (Gpx_doc.get_waypoints gpx1) = List.length (Gpx_doc.get_waypoints gpx2) &&

     

       23
       23
       +
         List.length (Gpx_doc.get_routes gpx1) = List.length (Gpx_doc.get_routes gpx2) &&

     

       24
       24
       +
         List.length (Gpx_doc.get_tracks gpx1) = List.length (Gpx_doc.get_tracks gpx2)

     

       25
       25
        
       

     

       26
       26
        
       (** Test Unix implementation can read all test files *)

     

       27
       27
        
       let test_unix_parsing filename () =

     
···

       31
       31
        
           let validation = Gpx.validate_gpx gpx in

     

       32
       32
        
           check bool "GPX is valid" true validation.is_valid;

     

       33
       33
        
           check bool "Has some content" true (

     

       34
       34
       -
             List.length gpx.waypoints > 0 ||

     

       35
       35
       -
             List.length gpx.routes > 0 ||

     

       36
       36
       -
             List.length gpx.tracks > 0

     

       34
       34
       +
             List.length (Gpx.Gpx_doc.get_waypoints gpx) > 0 ||

     

       35
       35
       +
             List.length (Gpx.Gpx_doc.get_routes gpx) > 0 ||

     

       36
       36
       +
             List.length (Gpx.Gpx_doc.get_tracks gpx) > 0

     

       37
       37
        
           )

     

       38
       38
        
         | Error err ->

     

       39
       39
       -
           failf "Unix parsing failed for %s: %s" filename

     

       40
       40
       -
             (match err with

     

       41
       41
       -
              | Gpx.Invalid_xml s -> "Invalid XML: " ^ s

     

       42
       42
       -
              | Gpx.Invalid_coordinate s -> "Invalid coordinate: " ^ s

     

       43
       43
       -
              | Gpx.Missing_required_attribute (elem, attr) -> 

     

       44
       44
       -
                  Printf.sprintf "Missing attribute %s in %s" attr elem

     

       45
       45
       -
              | Gpx.Missing_required_element s -> "Missing element: " ^ s

     

       46
       46
       -
              | Gpx.Validation_error s -> "Validation error: " ^ s

     

       47
       47
       -
              | Gpx.Xml_error s -> "XML error: " ^ s

     

       48
       48
       -
              | Gpx.IO_error s -> "I/O error: " ^ s)

     

       39
       39
       +
           failf "Unix parsing failed for %s: %s" filename (Gpx.Error.to_string err)

     

       49
       40
        
       

     

       50
       41
        
       (** Test Eio implementation can read all test files *)

     

       51
       42
        
       let test_eio_parsing filename () =

     
···

       57
       48
        
           let validation = Gpx.validate_gpx gpx in

     

       58
       49
        
           check bool "GPX is valid" true validation.is_valid;

     

       59
       50
        
           check bool "Has some content" true (

     

       60
       60
       -
             List.length gpx.waypoints > 0 ||

     

       61
       61
       -
             List.length gpx.routes > 0 ||

     

       62
       62
       -
             List.length gpx.tracks > 0

     

       51
       51
       +
             List.length (Gpx.Gpx_doc.get_waypoints gpx) > 0 ||

     

       52
       52
       +
             List.length (Gpx.Gpx_doc.get_routes gpx) > 0 ||

     

       53
       53
       +
             List.length (Gpx.Gpx_doc.get_tracks gpx) > 0

     

       63
       54
        
           )

     

       64
       55
        
         with

     

       65
       56
        
         | Gpx.Gpx_error err ->

     

       66
       66
       -
           failf "Eio parsing failed for %s: %s" filename

     

       67
       67
       -
             (match err with

     

       68
       68
       -
              | Gpx.Invalid_xml s -> "Invalid XML: " ^ s

     

       69
       69
       -
              | Gpx.Invalid_coordinate s -> "Invalid coordinate: " ^ s

     

       70
       70
       -
              | Gpx.Missing_required_attribute (elem, attr) -> 

     

       71
       71
       -
                  Printf.sprintf "Missing attribute %s in %s" attr elem

     

       72
       72
       -
              | Gpx.Missing_required_element s -> "Missing element: " ^ s

     

       73
       73
       -
              | Gpx.Validation_error s -> "Validation error: " ^ s

     

       74
       74
       -
              | Gpx.Xml_error s -> "XML error: " ^ s

     

       75
       75
       -
              | Gpx.IO_error s -> "I/O error: " ^ s)

     

       57
       57
       +
           failf "Eio parsing failed for %s: %s" filename (Gpx.Error.to_string err)

     

       76
       58
        
       

     

       77
       59
        
       (** Test Unix and Eio implementations produce equivalent results *)

     

       78
       60
        
       let test_unix_eio_equivalence filename () =

     
···

       95
       77
        
         | Ok gpx_unix, Ok gpx_eio ->

     

       96
       78
        
           check bool "Unix and Eio produce equivalent results" true

     

       97
       79
        
             (compare_gpx_basic gpx_unix gpx_eio);

     

       98
       98
       -
           check string "Creators match" gpx_unix.creator gpx_eio.creator;

     

       80
       80
       +
           check string "Creators match" (Gpx.Gpx_doc.get_creator gpx_unix) (Gpx.Gpx_doc.get_creator gpx_eio);

     

       99
       81
        
           check int "Waypoint counts match" 

     

       100
       100
       -
             (List.length gpx_unix.waypoints) (List.length gpx_eio.waypoints);

     

       82
       82
       +
             (List.length (Gpx.Gpx_doc.get_waypoints gpx_unix)) (List.length (Gpx.Gpx_doc.get_waypoints gpx_eio));

     

       101
       83
        
           check int "Route counts match"

     

       102
       102
       -
             (List.length gpx_unix.routes) (List.length gpx_eio.routes);

     

       84
       84
       +
             (List.length (Gpx.Gpx_doc.get_routes gpx_unix)) (List.length (Gpx.Gpx_doc.get_routes gpx_eio));

     

       103
       85
        
           check int "Track counts match"

     

       104
       104
       -
             (List.length gpx_unix.tracks) (List.length gpx_eio.tracks)

     

       86
       86
       +
             (List.length (Gpx.Gpx_doc.get_tracks gpx_unix)) (List.length (Gpx.Gpx_doc.get_tracks gpx_eio))

     

       105
       87
        
         | Error _, Error _ ->

     

       106
       88
        
           (* Both failed - that's consistent *)

     

       107
       89
        
           check bool "Both Unix and Eio failed consistently" true true

     
···

       124
       106
        
                 check bool "Round-trip preserves basic structure" true

     

       125
       107
        
                   (compare_gpx_basic gpx_original gpx_roundtrip);

     

       126
       108
        
                 check string "Creator preserved" 

     

       127
       127
       -
                   gpx_original.creator gpx_roundtrip.creator

     

       109
       109
       +
                   (Gpx.Gpx_doc.get_creator gpx_original) (Gpx.Gpx_doc.get_creator gpx_roundtrip)

     

       128
       110
        
               | Error _ ->

     

       129
       111
        
                 failf "Round-trip parse failed for %s" filename)

     

       130
       112
        
            | Error _ ->

+28 -33

test/test_gpx.ml

···

       4
       4
        
       

     

       5
       5
        
       let test_coordinate_validation () =

     

       6
       6
        
         (* Test valid coordinates *)

     

       7
       7
       -
         assert (Result.is_ok (latitude 45.0));

     

       8
       8
       -
         assert (Result.is_ok (longitude (-122.0)));

     

       9
       9
       -
         assert (Result.is_ok (degrees 180.0));

     

       7
       7
       +
         assert (Result.is_ok (Coordinate.latitude 45.0));

     

       8
       8
       +
         assert (Result.is_ok (Coordinate.longitude (-122.0)));

     

       9
       9
       +
         assert (Result.is_ok (Coordinate.degrees 180.0));

     

       10
       10
        
         

     

       11
       11
        
         (* Test invalid coordinates *)

     

       12
       12
       -
         assert (Result.is_error (latitude 91.0));

     

       13
       13
       -
         assert (Result.is_error (longitude 180.0));

     

       14
       14
       -
         assert (Result.is_error (degrees 360.0));

     

       12
       12
       +
         assert (Result.is_error (Coordinate.latitude 91.0));

     

       13
       13
       +
         assert (Result.is_error (Coordinate.longitude 180.0));

     

       14
       14
       +
         assert (Result.is_error (Coordinate.degrees 360.0));

     

       15
       15
        
         

     

       16
       16
        
         Printf.printf "✓ Coordinate validation tests passed\n"

     

       17
       17
        
       

     

       18
       18
        
       let test_fix_type_conversion () =

     

       19
       19
        
         (* Test fix type string conversion *)

     

       20
       20
       -
         assert (fix_type_to_string Fix_2d = "2d");

     

       21
       21
       -
         assert (fix_type_of_string "3d" = Some Fix_3d);

     

       22
       22
       -
         assert (fix_type_of_string "invalid" = None);

     

       20
       20
       +
         assert (Waypoint.fix_type_to_string Waypoint.Fix_2d = "2d");

     

       21
       21
       +
         assert (Waypoint.fix_type_of_string "3d" = Some Waypoint.Fix_3d);

     

       22
       22
       +
         assert (Waypoint.fix_type_of_string "invalid" = None);

     

       23
       23
        
         

     

       24
       24
        
         Printf.printf "✓ Fix type conversion tests passed\n"

     

       25
       25
        
       

     

       26
       26
        
       let test_gpx_creation () =

     

       27
       27
        
         let creator = "test" in

     

       28
       28
       -
         let gpx = make_gpx ~creator in

     

       29
       29
       -
         assert (gpx.creator = creator);

     

       30
       30
       -
         assert (gpx.version = "1.1");

     

       31
       31
       -
         assert (gpx.waypoints = []);

     

       28
       28
       +
         let gpx = Gpx_doc.empty ~creator in

     

       29
       29
       +
         assert (Gpx_doc.get_creator gpx = creator);

     

       30
       30
       +
         assert (Gpx_doc.get_version gpx = "1.1");

     

       31
       31
       +
         assert (Gpx_doc.get_waypoints gpx = []);

     

       32
       32
        
         

     

       33
       33
        
         Printf.printf "✓ GPX creation tests passed\n"

     

       34
       34
        
       

     
···

       43
       43
        
         

     

       44
       44
        
         match parse_string gpx_xml with

     

       45
       45
        
         | Ok gpx ->

     

       46
       46
       -
           assert (gpx.creator = "test");

     

       47
       47
       -
           assert (List.length gpx.waypoints = 1);

     

       48
       48
       -
           let wpt = List.hd gpx.waypoints in

     

       49
       49
       -
           assert (wpt.name = Some "San Francisco");

     

       46
       46
       +
           assert (Gpx_doc.get_creator gpx = "test");

     

       47
       47
       +
           let waypoints = Gpx_doc.get_waypoints gpx in

     

       48
       48
       +
           assert (List.length waypoints = 1);

     

       49
       49
       +
           let wpt = List.hd waypoints in

     

       50
       50
       +
           assert (Waypoint.get_name wpt = Some "San Francisco");

     

       50
       51
        
           Printf.printf "✓ Simple parsing tests passed\n"

     

       51
       52
        
         | Error e ->

     

       52
       52
       -
           Printf.printf "✗ Parsing failed: %s\n" 

     

       53
       53
       -
             (match e with 

     

       54
       54
       -
              | Invalid_xml s | Invalid_coordinate s | Validation_error s -> s

     

       55
       55
       -
              | _ -> "unknown error");

     

       53
       53
       +
           Printf.printf "✗ Parsing failed: %s\n" (Error.to_string e);

     

       56
       54
        
           assert false

     

       57
       55
        
       

     

       58
       56
        
       let test_simple_writing () =

     

       59
       59
       -
         let lat = Result.get_ok (latitude 37.7749) in

     

       60
       60
       -
         let lon = Result.get_ok (longitude (-122.4194)) in

     

       61
       61
       -
         let wpt = { (make_waypoint_data lat lon) with

     

       62
       62
       -
                     name = Some "Test Point";

     

       63
       63
       -
                     desc = Some "A test waypoint" } in

     

       64
       64
       -
         let gpx = { (make_gpx ~creator:"test") with

     

       65
       65
       -
                     waypoints = [wpt] } in

     

       57
       57
       +
         let lat = Result.get_ok (Coordinate.latitude 37.7749) in

     

       58
       58
       +
         let lon = Result.get_ok (Coordinate.longitude (-122.4194)) in

     

       59
       59
       +
         let wpt = Waypoint.make lat lon in

     

       60
       60
       +
         let wpt = Waypoint.with_name wpt "Test Point" in

     

       61
       61
       +
         let wpt = Waypoint.with_description wpt "A test waypoint" in

     

       62
       62
       +
         let gpx = Gpx_doc.empty ~creator:"test" in

     

       63
       63
       +
         let gpx = Gpx_doc.add_waypoint gpx wpt in

     

       66
       64
        
         

     

       67
       65
        
         match write_string gpx with

     

       68
       66
        
         | Ok xml_string ->

     
···

       70
       68
        
           assert (try ignore (String.index xml_string '3'); true with Not_found -> false);

     

       71
       69
        
           Printf.printf "✓ Simple writing tests passed\n"

     

       72
       70
        
         | Error e ->

     

       73
       73
       -
           Printf.printf "✗ Writing failed: %s\n"

     

       74
       74
       -
             (match e with 

     

       75
       75
       -
              | Invalid_xml s | Xml_error s -> s

     

       76
       76
       -
              | _ -> "unknown error");

     

       71
       71
       +
           Printf.printf "✗ Writing failed: %s\n" (Error.to_string e);

     

       77
       72
        
           assert false

     

       78
       73
        
       

     

       79
       74
        
       let test_validation () =

     

       80
       80
       -
         let gpx = make_gpx ~creator:"" in

     

       75
       75
       +
         let gpx = Gpx_doc.empty ~creator:"" in

     

       81
       76
        
         let validation = validate_gpx gpx in

     

       82
       77
        
         assert (not validation.is_valid);

     

       83
       78
        
         let errors = List.filter (fun issue -> issue.level = `Error) validation.issues in